ip.pm

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

	return undef unless defined $mask;
    }
    elsif (defined $mask) {
	$mask 		= _parse_mask $mask, 32;
	return undef unless defined $mask;
    }
    else {
	$hasmask	= 0;
	$mask 		= _parse_mask 32, 32;
	return undef unless defined $mask;
    }

    my $self = _v4($ip, $mask, $hasmask);

    return undef unless $self;

    return bless $self, $class;
}

sub new4 ($$;$) {
    new($_[0], $_[1], $_[2]);
}

				# Output a vec() as a dotted-quad

sub _to_quad ($) {
    my $vec = shift;
    return vec($vec, 0, 8) . '.' . 
	vec($vec, 1, 8) . '.' .
	    vec($vec, 2, 8) . '.' . 
		vec($vec, 3, 8);
}

				# Get the network address

sub _network ($) {
    my $self	= shift;
    my $a = $self->{addr};
    my $m = $self->{mask};

    return [ "$a" & "$m", $self->{mask}, $self->{bits} ];
}

				# Should be obvious

sub _broadcast ($) {
    my $self	= shift;
    my $a = $self->{addr};
    my $m = $self->{mask};
    my $c = '';

    vec($c, 0, $self->{bits}) = _ones $self->{bits};
    vec($c, 0, $self->{bits}) ^= vec($m, 0, $self->{bits});

    return [ "$a" | ~ "$m" | $c, $self->{mask}, $self->{bits} ];
}

				# This will become an lvalue later

sub mask ($) {
    my $self	= shift;
    _to_quad $self->{mask};
}

				# idem

sub addr ($) {
    my $self	= shift;
    _to_quad $self->{addr};
}

sub cidr ($) {
    my $self	= shift;
    return $self->addr . '/' . $self->masklen;
}

sub do_prefix ($$$) {
    my $mask	= shift;
    my $faddr	= shift;
    my $laddr	= shift;

    if ($mask > 24) {
        return "$faddr->[0].$faddr->[1].$faddr->[2].$faddr->[3]-$laddr->[3]";
    }
    elsif ($mask == 24) {
        return "$faddr->[0].$faddr->[1].$faddr->[2].";
    }
    elsif ($mask > 16) {
        return "$faddr->[0].$faddr->[1].$faddr->[2]-$laddr->[2].";
    }
    elsif ($mask == 16) {
        return "$faddr->[0].$faddr->[1].";
    }
    elsif ($mask > 8) {
        return "$faddr->[0].$faddr->[1]-$laddr->[1].";
    }
    elsif ($mask == 8) {
        return "$faddr->[0].";
    }
    else {
        return "$faddr->[0]-$laddr->[0]";
    }
}

sub nprefix ($) {
    my $self = shift;
    my $mask = $self->masklen;

    return undef if $self->{bits} > 32;
    return $self->addr if $mask == 32;

    my @faddr = split (/\./, $self->first->addr);
    my @laddr = split (/\./, $self->last->addr);

    return do_prefix $mask, \@faddr, \@laddr;
}

sub prefix ($) {
    my $self = shift;
    my $mask = $self->masklen;

    return undef if $self->{bits} > 32;
    return $self->addr if $mask == 32;

    my @faddr = split (/\./, $self->first->addr);
    my @laddr = split (/\./, $self->broadcast->addr);

    return do_prefix $mask, \@faddr, \@laddr;
}

sub range ($) {
    my $self = shift;
    my $mask = $self->masklen;

    return undef if $self->{bits} > 32;
    return $self->network->addr . ' - ' . $self->broadcast->addr;
}

sub broadcast ($) {
    my $self	= shift;
    return $self->_fnew($self->_broadcast);
}

sub network ($) {
    my $self	= shift;
    return $self->_fnew($self->_network);
}

sub wildcard ($) {
    my $self	= shift;
    return wantarray() ? ($self->addr, _to_quad ~$self->{mask}) :
	_to_quad ~$self->{mask};
			      
}

sub numeric ($) {
    my $self	= shift;
    return 
	wantarray() ? ( vec($self->{addr}, 0, 32), 
			vec($self->{mask}, 0, 32) ) :
			    vec($self->{addr}, 0, 32);
}

				# Return the shortest possible subnet
				# list that completely contains all
				# the given addresses or subnets.

sub compactref ($) {
    my @addr = sort 
#    { (vec($a->{addr}, 0, $a->{bits}) <=> vec($b->{addr}, 0, $a->{bits}))
#	  || (vec($a->{mask}, 0, $a->{bits}) 
#	      <=> vec($b->{mask}, 0, $a->{bits}))
#	  } 
    @{$_[0]} or
	return [];

    my $bits = $addr[0]->{bits};
    my $changed;

    do {
	$changed = 0;
	for (my $i = 0;
	     $i <= $#addr - 1;
	     $i ++)
	{
	    my $lip = $addr[$i];
	    my $hip = $addr[$i + 1];

	    if ($lip->contains($hip)) {
		splice(@addr, $i + 1, 1);
		++ $changed;
		-- $i;
	    }
	    elsif (vec($lip->{mask}, 0, $bits) 
		== vec($hip->{mask}, 0, $bits)) 
	    {
		my $la = $lip->{addr};
		my $ha = $hip->{addr};
		my $nb = '';
		my $na = '';
		my $nm = '';

		vec($nb, 0, $bits) = 
		    vec($na, 0, $bits) = 
			vec($la, 0, $bits);
		vec($nb, 0, $bits) ^= vec($ha, 0, $bits);
		vec($na, 0, $bits) ^= vec($nb, 0, $bits);
		vec($nm, 0, $bits) = vec($lip->{mask}, 0, $bits);
		vec($nm, 0, $bits) <<= 1;


#		if ((vec($la, 0, $bits) & vec($nm, 0, $bits))
#		    == (vec($ha, 0, $bits) & vec($nm, 0, $bits)))

		if (("$la" & "$nm") eq ("$ha" & "$nm"))
		{
		    if ("$la" eq "$ha") {
			splice(@addr, $i + 1, 1);
		    }
		    else {
			$addr[$i] = ($lip->_fnew([ "$na" & "$nm", 
						   $nm, $bits ]));
			splice(@addr, $i + 1, 1);
		    }

#		    print $lip->addr, "/", $lip->mask, " + ", $hip->addr, 
#		    "/", $hip->mask, " = ", $addr[$i]->addr, "/", 
#		    $addr[$i]->mask, "\n";

		    -- $i;
		    ++ $changed;
		}
	    }
	}
    } while ($changed);

    return \@addr;
}

sub compact {
    return @{compactref(\@_)};
}

				# Splits the current object in
				# smaller subnets, of $bits bits
				# netmask.

sub splitref ($;$) {
    my $self	= shift;
    my $mask	= _parse_mask shift || $self->{bits}, $self->{bits};

    my $bits	= $self->{bits};

    my @ret;

    if (vec($self->{mask}, 0, $bits) 
	<= vec($mask, 0, $bits))
    {

	my $delta	= '';
	my $num		= '';
	my $v		= '';

	vec($num, 0, $bits) = _ones $bits;
	vec($num, 0, $bits) ^= vec($mask, 0, $bits);
	vec($num, 0, $bits) ++;

	vec($delta, 0, $bits) = (vec($self->{mask}, 0, $bits) 
				 ^ vec($mask, 0, $bits));

	my $net	= $self->network->{addr}; 
	$net = "$net" & "$mask";

	my $to = $self->broadcast->{addr}; 
	$to = "$to" & "$mask";

				# XXX - Note that most likely, 
				# this loop will NOT work on IPv6... 
				# $net, $to and $num might very well 
				# be too large for most integer or 
				# floating point representations.

	for (my $i	= vec($net, 0, $bits);
	     $i 	<= vec($to, 0, $bits);
	     $i 	+= vec($num, 0, $bits))
	{
	    vec($v, 0, $bits) = $i;
	    push @ret, $self->_fnew([ $v, $mask, $bits ]);
	}
    }

    return \@ret;
}

sub split ($;$) {
    return @{$_[0]->splitref($_[1])};
}

sub hostenumref ($) {
    my $r = $_[0]->splitref(32);
    if ($_[0]->mask ne '255.255.255.255') {
	splice(@$r, 0, 1);
	splice(@$r, scalar @$r - 1, 1);
    }
    return $r;
}

sub hostenum ($) {
    return @{$_[0]->hostenumref};
}


				# Returns TRUE if $a completely
				# contains $b and both are of the
				# same length (ie, V4 or V6).
sub contains ($$) {
    my $a	= shift;
    my $b	= shift;

    my $bits	= $a->{bits};

    my $mask;
    
				# Both must be of the same length...
    return undef
	unless $bits == $b->{bits};

				# $a must be less specific than $b...
    return 0
	unless ($mask = vec($a->{mask}, 0, $bits))
	    <= vec($b->{mask}, 0, $bits);

				# A default address always contains
    return 1 if ($mask == 0x0);

    return 
	((vec($a->{addr}, 0, $bits) & $mask)
	 == (vec($b->{addr}, 0, $bits) & $mask));
}

sub within ($$) {
    return contains($_[1], $_[0]);
}

sub first ($) {
    my $self	= shift;

    return $self->network + 1;
}

sub nth ($$) {
    my $self    = shift;
    my $count   = shift;

    return undef if ($count < 1 or $count > $self->num ());
    return $self->network + $count;
}

    

sub last ($) {
    my $self	= shift;

    return $self if $self->masklen == $self->{bits};

    return $self->broadcast - 1;
}

				# XXX - The constant below should be
				# constructed dinamically depending on
				# the address size in order to work with
				# V6.
sub num ($) {
    my $self	= shift;
    return ~vec($self->{mask}, 0, $self->{bits}) & 0xFFFFFFFF;
}

1;

__END__

=head1 NAME

NetAddr::IP - Manages IPv4 addresses and subnets

=head1 SYNOPSIS

  use NetAddr::IP;

  my $ip = new NetAddr::IP 'loopback';

  print "The address is ", $ip->addr, " with mask ", $ip->mask, "\n" ;

  if ($ip->within(new NetAddr::IP "127.0.0.0", "255.0.0.0")) {
      print "Is a loopback address\n";
  }

				# This prints 127.0.0.1/32
  print "You can also say $ip...\n";

=head1 DESCRIPTION

This module provides a number of methods useful for handling IPv4
addresses ans subnets. Hopefully, its methods are also usable for IPv6
addresses.

Methods so far include:

=over

=item C<-E<gt>new([$addr, [ $mask ]])>

This method creates a new IPv4 address with the supplied address in
C<$addr> and an optional netmask C<$mask>, which can be omitted to get
a /32 mask.

C<$addr> can be almost anything that can be resolved to an IP address
in all the notations I have seen over time. It can optionally contain
the mask in CIDR notation.

B<prefix> notation is understood, with the limitation that the range
speficied by the prefix must match with a valid subnet.

If called with no arguments, 'default' is assumed.

=item C<-E<gt>broadcast()>

Returns a new object refering to the broadcast address of a given
subnet.

=item C<-E<gt>network()>

Returns a new object refering to the network address of a given
subnet.

=item C<-E<gt>addr()>

Returns a scalar with the address part of the object as a dotted-quad.

=item C<-E<gt>mask()>

Returns a scalar with the mask as a dotted-quad.

=item C<-E<gt>masklen()>

Returns a scalar the number of one bits in the mask.

=item C<-E<gt>cidr()>

Returns a scalar with the address and mask in CIDR notation.

=item C<-E<gt>range()>

Returns a scalar with the base address and the broadcast address
separated by a dash and spaces. This is called range notation.

=item C<-E<gt>prefix()>

Returns a scalar with the address and mask in prefix
representation. This is useful for some programs, which expect its
input to be in this format. This method will include the broadcast
address in the encoding.

=item C<-E<gt>nprefix()>

Just as C<-E<gt>prefix()>, but does not include the broadcast address.

=item C<-E<gt>numeric()>

When called in a scalar context, will return a numeric representation
of the address part of the IP address. When called in an array
contest, it returns a list of two elements. The first element is as
described, the second element is the numeric representation of the
netmask.

=item C<-E<gt>wildcard()>

When called in a scalar context, returns the wildcard bits
corresponding to the mask, in dotted-quad format.

When called in an array context, returns a two-element array. The
first element, is the address part. The second element, is the
wildcard translation of the mask.

=item C<$me-E<gt>contains($other)>

Returns true when C<$me> completely contains C<$other>. False is
returned otherwise and C<undef> is returned if C<$me> and C<$other>
are of different versions.

=item C<$me-E<gt>within($other)>

The complement of C<-E<gt>contains()>. Returns true when C<$me> is
completely con tained within C<$other>.

=item C<-E<gt>split($bits)>

Returns a list of objects, representing subnets of C<$bits> mask
produced by splitting the original object, which is left
unchanged. Note that C<$bits> must be longer than the original
object's mask in order for it to be splittable.

Note that C<$bits> can be given as an integer (the length of the mask)
or as a dotted-quad. If omitted, a host mask is assumed.

=item C<-E<gt>splitref($bits)>

A (faster) version of C<-E<gt>split()> that returns a reference to a
list of objects instead of a real list. This is useful when large
numbers of objects are expected.

=item C<-E<gt>hostenum()>

Returns the list of hosts within a subnet.

=item C<-E<gt>hostenumref()>

Faster version of C<-E<gt>hostenum()>, returning a reference to a list.

=item C<$me-E<gt>compact($addr1, $addr2, ...)>

Given a list of objects (including C<$me>), this method will compact
all the addresses and subnets into the largest (ie, least specific)
subnets possible that contain exactly all of the given objects.