ip.pm

Network Administration Visualized 网络管理可视化源码

#!/usr/bin/env perl

package NetAddr::IP;

require 5.005_62;
use Carp;
use Socket;
use strict;
use warnings;

our $VERSION = '3.11';

				#############################################
				# These are the overload methods, placed here
				# for convenience.
				#############################################

use overload

    '+'		=> \&plus,

    '-'		=> \&minus,

    '++'	=> \&plusplus,

    '--'	=> \&minusminus,

    "="		=> sub {
	return _fnew NetAddr::IP [ $_[0]->{addr}, $_[0]->{mask}, 
				   $_[0]->{bits} ];
    },
    
    '""'	=> sub { 
	$_[0]->cidr(); 
    },

    'eq'	=> sub { 
	my $a = ref $_[0] eq 'NetAddr::IP' ? $_[0]->cidr : $_[0];
	my $b = ref $_[1] eq 'NetAddr::IP' ? $_[1]->cidr : $_[1];
	$a eq $b;
    },

    '=='	=> sub { 
	return 0 unless ref $_[0] eq 'NetAddr::IP';
	return 0 unless ref $_[1] eq 'NetAddr::IP';
	$_[0]->cidr eq $_[1]->cidr;
    },
				# The comparisons below are not portable
				# when attempted with the full bit vector.
				# This is why we break them down and do it
				# one octet at a time. String comparison
				# is not portable because of endianness.
    '>'		=> sub {
	
	return undef unless $_[0]->{bits} == $_[1]->{bits};
	return scalar($_[0]->numeric()) > scalar($_[1]->numeric());

#  	return 0 if ($_[0]->{bits} != $_[1]->{bits});
#  	for my $b (0 .. $_[0]->{bits}/8 - 1) {
#  	    return 1 if vec($_[0]->{addr}, $b, 8) 
#  		> vec($_[1]->{addr}, $b, 8);
#  	}
#  	for my $b (0 .. $_[0]->{bits}/8 - 1) {
#  	    return 1 if vec($_[0]->{mask}, $b, 8) 
#  		> vec($_[1]->{mask}, $b, 8);
#  	}
#	return 0;
    },

    '<'		=> sub {

	return undef unless $_[0]->{bits} == $_[1]->{bits};
	return scalar($_[0]->numeric()) < scalar($_[1]->numeric());

#  	return 0 if ($_[0]->{bits} != $_[1]->{bits});
#  	for my $b (0 .. $_[0]->{bits}/8 - 1) {
#  	    return 1 if vec($_[0]->{addr}, $b, 8) 
#  		< vec($_[1]->{addr}, $b, 8);
#  	}
#  	for my $b (0 .. $_[0]->{bits}/8 - 1) {
#  	    return 1 if vec($_[0]->{mask}, $b, 8) 
#  		< vec($_[1]->{mask}, $b, 8);
#  	}
#  	return 0;
    },

    '>='	=> sub {

	return undef unless $_[0]->{bits} == $_[1]->{bits};
	return scalar($_[0]->numeric()) >= scalar($_[1]->numeric());

#  	return 0 if ($_[0]->{bits} != $_[1]->{bits});
#  	for my $b (0 .. $_[0]->{bits}/8 - 1) {
#  	    return 1 if vec($_[0]->{addr}, $b, 8) 
#  		>= vec($_[1]->{addr}, $b, 8);
#  	}
#  	for my $b (0 .. $_[0]->{bits}/8 - 1) {
#  	    return 1 if vec($_[0]->{mask}, $b, 8) 
#  		>= vec($_[1]->{mask}, $b, 8);
#  	}
#  	return 0;
    },

    '<='	=> sub {

	return undef unless $_[0]->{bits} == $_[1]->{bits};
	return scalar($_[0]->numeric()) <= scalar($_[1]->numeric());

#  	return 0 if ($_[0]->{bits} != $_[1]->{bits});
#  	for my $b (0 .. $_[0]->{bits}/8 - 1) {
#  	    return 1 if vec($_[0]->{addr}, $b, 8) 
#  		<= vec($_[1]->{addr}, $b, 8);
#  	}
#  	for my $b (0 .. $_[0]->{bits}/8 - 1) {
#  	    return 1 if vec($_[0]->{mask}, $b, 8) 
#  		<= vec($_[1]->{mask}, $b, 8);
#  	}
#  	return 0;
    },

    '<=>'		=> sub {

	return undef unless $_[0]->{bits} == $_[1]->{bits};
	return scalar($_[0]->numeric()) <=> scalar($_[1]->numeric());

#  	return undef if ($_[0]->{bits} != $_[1]->{bits});
#  	for my $b (0 .. $_[0]->{bits}/8 - 1) {
#  	    my $r = vec($_[0]->{addr}, $b, 8) 
#  		<=> vec($_[1]->{addr}, $b, 8);
#  	    return $r if $r;
#  	}
#  	for my $b (0 .. $_[0]->{bits}/8 - 1) {
#  	    my $r = vec($_[0]->{mask}, $b, 8) 
#  		<=> vec($_[1]->{mask}, $b, 8);
#  	    return $r if $r;
#  	}
#  	return 0;
    },

    'cmp'		=> sub {

	return undef unless $_[0]->{bits} == $_[1]->{bits};
	return scalar($_[0]->numeric()) <=> scalar($_[1]->numeric());

#  	return undef if ($_[0]->{bits} != $_[1]->{bits});
#  	for my $b (0 .. $_[0]->{bits}/8 - 1) {
#  	    my $r = vec($_[0]->{addr}, $b, 8) 
#  		<=> vec($_[1]->{addr}, $b, 8);
#  	    return $r if $r;
#  	}
#  	for my $b (0 .. $_[0]->{bits}/8 - 1) {
#  	    my $r = vec($_[0]->{mask}, $b, 8) 
#  		<=> vec($_[1]->{mask}, $b, 8);
#  	    return $r if $r;
#  	}
#  	return 0;
    },

    '@{}'	=> sub { 
	return [ $_[0]->hostenum ]; 
    };

				#############################################
				# End of the overload methods.
				#############################################


# Preloaded methods go here.

				# This is a variant to ->new() that
				# creates and blesses a new object
				# without the fancy parsing of
				# IP formats and shorthands.

sub _fnew ($$) {
    my $type	= shift;
    my $class	= ref($type) || $type || "NetAddr::IP";
    my $r_addr	= shift;

    return 
	bless { addr => $r_addr->[0],
		mask => $r_addr->[1],
		bits => $r_addr->[2] },
	$class;
}

				# Returns 2 ** $bits -1 (ie,
				# $bits one bits)
sub _ones ($) {
    my $bits	= shift;
    return ~vec('', 0, $bits);
}

				# Addition of a constant to an
				# object
sub plus {
    my $ip	= shift;
    my $const	= shift;

    return $ip unless $const;

    my $a = $ip->{addr};
    my $m = $ip->{mask};
    my $b = $ip->{bits};

    my $hp = "$a" & ~"$m";
    my $np = "$a" & "$m";

    vec($hp, 0, $b) += $const;

    return _fnew NetAddr::IP [ "$np" | ("$hp" & ~"$m"), $m, $b];
}

sub minus {
    my $ip	= shift;
    my $const	= shift;

    return plus($ip, -$const, @_);
}

				# Auto-increment an object
sub plusplus {
    my $ip	= shift;

    my $a = $ip->{addr};
    my $m = $ip->{mask};

    my $hp = "$a" & ~"$m";
    my $np = "$a" & "$m";

    vec($hp, 0, 32) ++;

    $ip->{addr} = "$np" | ("$hp" & ~"$m");
    return $ip;
}

sub minusminus {
    my $ip	= shift;

    my $a = $ip->{addr};
    my $m = $ip->{mask};

    my $hp = "$a" & ~"$m";
    my $np = "$a" & "$m";

    vec($hp, 0, 32) --;

    $ip->{addr} = "$np" | ("$hp" & ~"$m");
    return $ip;
}

sub masklen ($) {
    my $self	= shift;
    my $bits	= 0;

    for (my $i = 0;
	 $i < $self->{bits};
	 $i ++) 
    {
	$bits += vec($self->{mask}, $i, 1);
    }

    return $bits;
}

sub _parse_mask ($$) {
    my $mask	= shift;
    my $bits	= shift;

    my $bmask	= '';

    if ($mask =~ m/^default|any$/i) {
	vec($bmask, 0, $bits) = 0x0;
    }
    elsif ($mask =~ m/^broadcast|host$/i) {
	vec($bmask, 0, $bits) = _ones $bits;
    }
    elsif ($mask =~ m/^loopback$/i) {
	vec($bmask, 0, 8) = 255;
	vec($bmask, 1, 8) = 0;
	vec($bmask, 2, 8) = 0;
	vec($bmask, 3, 8) = 0;
    }
    elsif ($mask =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {

	for my $i ($1, $2, $3, $4) {
	    return undef 
		unless grep { $i == $_ }
	    (255, 254, 252, 248, 240, 224, 192, 128, 0);
	}

	return undef if ($1 < $2 or $2 < $3 or $3 < $4);
	
	return undef if $2 != 0 and $1 != 255;
	return undef if $3 != 0 and $2 != 255;
	return undef if $4 != 0 and $3 != 255;
					   
	vec($bmask, 0, 8) = $1;
	vec($bmask, 1, 8) = $2;
	vec($bmask, 2, 8) = $3;
	vec($bmask, 3, 8) = $4;
    }
    elsif ($mask =~ m/^(\d+)$/ and $1 <= 32) {
	if ($1) {
	    vec($bmask, 0, $bits) = _ones $bits;
	    vec($bmask, 0, $bits) <<= ($bits - $1);
	} else {
	    vec($bmask, 0, $bits) = 0x0;
	}
    }
    elsif ($mask =~ m/^(\d+)$/) {
        vec($bmask, 0, $bits) = $1;
    }

    return $bmask;
}

sub _obits ($$) {
    my $lo = shift;
    my $hi = shift;

    return 0xFF if $lo == $hi;
    return (~ ($hi ^ $lo)) & 0xFF;
}

sub _v4 ($$$) {
    my $ip	= shift;
    my $mask	= shift;
    my $present	= shift;

    my $addr = '';

    if ($ip =~ m!^default|any$!i) {
	vec($addr, 0, 32) = 0x0;
    }
    elsif ($ip =~ m!^broadcast$!i) {
	vec($addr, 0, 32) = _ones 32;
    }
    elsif ($ip =~ m!^loopback$!i) {
	vec($addr, 0, 8) = 127;
	vec($addr, 3, 8) = 1;
    }
    elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {
	vec($addr, 0, 8) = $1;
	vec($addr, 1, 8) = $2;
	vec($addr, 2, 8) = $3;
	vec($addr, 3, 8) = $4;
    }
    elsif ($ip =~ m/^(\d+)\.(\d+)$/) {
	vec($addr, 0, 8) = $1;
	vec($addr, 1, 8) = ($present ? $2 : 0);
	vec($addr, 2, 8) = 0;
	vec($addr, 3, 8) = ($present ? 0 : $2);
    }
    elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)$/) {
	vec($addr, 0, 8) = $1;
	vec($addr, 1, 8) = $2;
	vec($addr, 2, 8) = ($present ? $3 : 0);
	vec($addr, 3, 8) = ($present ? 0 : $3);
    }
    elsif ($ip =~ m/^([xb\d]+)$/) {
	vec($addr, 0, 32) = $1;
    }

				# The notations below, include an
				# implicit mask specification.

    elsif ($ip =~ m/^(\d+)\.$/ and $1 >= 0 and $1 <= 255) {
	#print "^(\\d+)\\.\$\n";
	vec($addr, 0, 8) = $1;
	vec($addr, 1, 8) = 0;
	vec($addr, 2, 8) = 0;
	vec($addr, 3, 8) = 0;
	vec($mask, 0, 32) = 0xFF000000;
    }
    elsif ($ip =~ m/^(\d+)\.(\d+)-(\d+)\.?$/ 
	   and $1 >= 0 and $1 <= 255
	   and $2 >= 0 and $2 <= 255
	   and $3 >= 0 and $3 <= 255
	   and $2 <= $3) {
	#print "^(\\d+)\\.(\\d+)-(\\d+)\\.?\$\n";
	vec($addr, 0, 8) = $1;
	vec($addr, 1, 8) = $2;
	vec($addr, 2, 8) = 0;
	vec($addr, 3, 8) = 0;

	vec($mask, 0, 32) = 0x0;
	vec($mask, 0, 8) = 0xFF;
	vec($mask, 1, 8) = _obits $2, $3;
    }
    elsif ($ip =~ m/^(\d+)-(\d+)\.?$/ 
	   and $1 >= 0 and $1 <= 255
	   and $2 >= 0 and $2 <= 255
	   and $1 <= $2) {
	#print "^(\\d+)-(\\d+)\\.?\$\n";
	vec($addr, 0, 8) = $1;
	vec($addr, 1, 8) = 0;
	vec($addr, 2, 8) = 0;
	vec($addr, 3, 8) = 0;

	vec($mask, 0, 32) = 0x0;
	vec($mask, 0, 8) = _obits $1, $2;
    }
    elsif ($ip =~ m/^(\d+)\.(\d+)\.$/ and $1 >= 0 
	   and $1 <= 255 and $2 >= 0 and $2 <= 255) 
    {
	#print "^(\\d+)\\.(\\d+)\\.\$\n";
	vec($addr, 0, 8) = $1;
	vec($addr, 1, 8) = $2;
	vec($addr, 2, 8) = 0;
	vec($addr, 3, 8) = 0;
	vec($mask, 0, 32) = 0xFFFF0000;
    }
    elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)-(\d+)\.?$/ 
	   and $1 >= 0 and $1 <= 255
	   and $2 >= 0 and $2 <= 255
	   and $3 >= 0 and $3 <= 255
	   and $4 >= 0 and $4 <= 255
	   and $3 <= $4) {
	#print "^(\\d+)\\.(\\d+)\\.(\\d+)-(\\d+)\\.?\$\n";
	vec($addr, 0, 8) = $1;
	vec($addr, 1, 8) = $2;
	vec($addr, 2, 8) = $3;
	vec($addr, 3, 8) = 0;

	vec($mask, 0, 32) = 0x0;
	vec($mask, 0, 8) = 0xFF;
	vec($mask, 1, 8) = 0xFF;
	vec($mask, 2, 8) = _obits $3, $4;
    }
    elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)\.$/ and $1 >= 0 
	   and $1 <= 255 and $2 >= 0 and $2 <= 255
	   and $3 >= 0 and $3 <= 255) 
    {
	#print "^(\\d+)\\.(\\d+)\\.(\\d+)\\.\$\n";
	vec($addr, 0, 8) = $1;
	vec($addr, 1, 8) = $2;
	vec($addr, 2, 8) = $3;
	vec($addr, 3, 8) = 0;
	vec($mask, 0, 32) = 0xFFFFFF00;
    }
    elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+)-(\d+)$/ 
	   and $1 >= 0 and $1 <= 255
	   and $2 >= 0 and $2 <= 255
	   and $3 >= 0 and $3 <= 255
	   and $4 >= 0 and $4 <= 255
	   and $5 >= 0 and $5 <= 255
	   and $4 <= $5) {
	#print "^(\\d+)\\.(\\d+)\\.(\\d+)\\.(\\d+)-(\\d+)\$\n";
	vec($addr, 0, 8) = $1;
	vec($addr, 1, 8) = $2;
	vec($addr, 2, 8) = $3;
	vec($addr, 3, 8) = $4;

	vec($mask, 0, 8) = 0xFF;
	vec($mask, 1, 8) = 0xFF;
	vec($mask, 2, 8) = 0xFF;
	vec($mask, 3, 8) = _obits $4, $5;
    }
    elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+)
	   \s*-\s*(\d+)\.(\d+)\.(\d+)\.(\d+)$/x
	   and $1 >= 0 and $1 <= 255
	   and $2 >= 0 and $2 <= 255
	   and $3 >= 0 and $3 <= 255
	   and $4 >= 0 and $4 <= 255
	   and $5 >= 0 and $5 <= 255
	   and $6 >= 0 and $6 <= 255
	   and $7 >= 0 and $7 <= 255
	   and $8 >= 0 and $8 <= 255)
    {
	my $last = '';

	vec($addr, 0, 8) = $1;
	vec($addr, 1, 8) = $2;
	vec($addr, 2, 8) = $3;
	vec($addr, 3, 8) = $4;

	vec($last, 0, 8) = $5;
	vec($last, 1, 8) = $6;
	vec($last, 2, 8) = $7;
	vec($last, 3, 8) = $8;

	vec($mask, 0, 8) = _obits $1, $5;
	vec($mask, 1, 8) = _obits $2, $6;
	vec($mask, 2, 8) = _obits $3, $7;
	vec($mask, 3, 8) = _obits $4, $8;
    }
    elsif (my $a = gethostbyname($ip)) {
	if (inet_ntoa($a) =~ m!^(\d+)\.(\d+)\.(\d+)\.(\d+)$!)  {
	    vec($addr, 0, 8) = $1;
	    vec($addr, 1, 8) = $2;
	    vec($addr, 2, 8) = $3;
	    vec($addr, 3, 8) = $4;
	}
    }
    else {
#	croak "Cannot obtain an IP address out of $ip";
	return undef;
    }

    return { addr => $addr, mask => $mask, bits => 32 };
}

sub new ($$;$) {
    my $type	= $_[0];
    my $class	= ref($type) || $type || "NetAddr::IP";
    my $ip	= $_[1];
    my $hasmask	= 1;
    my $mask;

    $ip = 'default' unless defined $ip;

    if (@_ == 2) {
	if ($ip =~ m!^(.+)/(.+)$!) {
	    $ip		= $1;
	    $mask	= $2;
	}
	elsif ($ip =~ m!^(default|any|broadcast|loopback)$!) {
	    $mask	= $ip;
	}
    }

    if (defined $_[2]) {
	$mask 		= _parse_mask $_[2], 32;