diff --git a/IP.pm b/IP.pm index 5cd66a4..cf898d5 100644 --- a/IP.pm +++ b/IP.pm @@ -1,844 +1,977 @@ -#!/usr/bin/perl -w - -package NetAddr::IP; - -require 5.005_62; -use Carp; -use Socket; -use strict; -use warnings; - -our $VERSION = '3.00'; - -# 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); -} - -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$/i) { - vec($bmask, 0, $bits) = 0x0; - } - elsif ($mask =~ m/^broadcast$/i) { - vec($bmask, 0, $bits) = _ones $bits; - } - elsif ($mask =~ m/^loopback$/i) { - vec($bmask, 0, 8) = 255; - } - elsif ($mask =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) { - 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 _v4 ($$) { - my $ip = shift; - my $mask = shift; - - my $addr = ''; - - if ($ip =~ m!^default$!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) = 0; - vec($addr, 2, 8) = 0; - vec($addr, 3, 8) = $2; - } - elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)$/) { - vec($addr, 0, 8) = $1; - vec($addr, 1, 8) = $2; - vec($addr, 2, 8) = 0; - vec($addr, 3, 8) = $3; - } - elsif ($ip =~ m/^([xb\d]+)$/) { - vec($addr, 0, 32) = $1; - } - 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 { addr => $addr, mask => $mask, bits => 32 }; -} - -sub new ($$;$) { - my $type = $_[0]; - my $class = ref($type) || $type || "NetAddr::IP"; - my $ip = $_[1]; - my $mask; - - if (@_ == 2) { - if ($ip =~ m!^(.+)/(.+)$!) { - $ip = $1; - $mask = $2; - } - elsif ($ip =~ m!^(default|broadcast|loopback)$!) { - $mask = $ip; - } - } - - if (defined $_[2]) { - $mask = _parse_mask $_[2], 32; - } - elsif (defined $mask) { - $mask = _parse_mask $mask, 32; - } - else { - $mask = _parse_mask 32, 32; - } - - return bless _v4($ip, $mask), $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}; - - return [ "$a" | ~ "$m", $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 broadcast ($) { - my $self = shift; - return $self->_fnew($self->_broadcast); -} - -sub network ($) { - my $self = shift; - return $self->_fnew($self->_network); -} - - # 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 (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")) - { - $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 pointrepresentations. - - 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; - my $bits = $self->{bits}; - my $a = $self->{addr}; - my $m = $self->{mask}; - - my $h = ''; - my $addr = ''; - - vec($h, 0, $bits) = 0x1; # Turn on just the first bit - - return $self->_fnew([ ("$a" & "$m") | "$h", - $self->{mask}, $bits ]); -} - -sub last ($) { - my $self = shift; - my $bits = $self->{bits}; - my $a = $self->{addr}; - my $m = $self->{mask}; - - my $h = ''; - my $addr = ''; - - vec($h, 0, $bits) = _ones $bits; - - return $self->_fnew([ ("$a" & "$m") | ("$h" & ~"$m"), - $self->{mask}, $bits ]); -} - -sub num ($) { - my $self = shift; - return ~vec($self->{mask}, 0, $self->{bits}); -} - -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"; - } - -=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<-Enew($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. - -=item C<-Ebroadcast()> - -Returns the broadcast address for a subnet. - -=item C<-Enetwork()> - -Returns the "network" address for a subnet. - -=item C<-Eaddr()> - -Returns the address part of the object as a dotted-quad. - -=item C<-Emask()> - -Returns the mask as a dotted-quad. - -=item C<-Emasklen()> - -Returns the number of one bits in the mask. - -=item C<-Ecidr()> - -Returns the address and mask in CIDR notation. - -=item C<$me-Econtains($other)> - -Returns true when C<$me> completely contains C<$other>. False is -returned otherwise and C is returned if C<$me> and C<$other> -are of different versions. - -=item C<$me-Ewithin($other)> - -The complement of C<-Econtains()>. Returns true when C<$me> is -completely con tained within C<$other>. - -=item C<-Esplit($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<-Esplitref($bits)> - -A (faster) version of C<-Esplit()> 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<-Ehostenum()> - -Returns the list of hosts within a subnet. - -=item C<-Ehostenumref()> - -Faster version of C<-Ehostenum()>, returning a reference to a list. - -=item C<$me-Ecompact($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. - -=item C<$me-Ecompactref(\@list)> - -As usual, a faster version of =item C<-Ecompact()> that returns a -reference to a list. Note that this method takes a reference to a list -instead. - -=item C<-Efirst()> - -Returns a new object representing the first useable IP address within -the subnet (ie, the first host address). - -=item C<-Elast()> - -Returns a new object representing the last useable IP address within -the subnet (ie, one less than the broadcast address). - - -=item C<-Enum()> - -Returns the number of useable addresses IP addresses within the -subnet, not counting the broadcast address. - -=back - -=head2 EXPORT - -None by default. - - -=head1 HISTORY - -=over - -=item 0.01 - -=over - - -=item * - -original version; Basic testing and release to CPAN as -version 0.01. This is considered beta software. - -=back - - -=item 0.02 - -=over - - -=item * - -Multiple changes to fix endiannes issues. This code is now -moderately tested on Wintel and Sun/Solaris boxes. - -=back - - -=item 0.03 - -=over - - -=item * - -Added -Efirst and -Elast methods. Version changed to 0.03. - -=back - - -=item 1.00 - -=over - - -=item * - -Implemented -Enew_subnet. Version changed to 1.00. - -=item * - -less croak()ing when improper input is fed to the module. A -more consistent 'undef' is returned now instead to allow the -user to better handle the error. - -=back - - -=item 1.10 - -=over - - -=item * - -As per Marnix A. Van Ammers [mav6@ns02.comp.pge.com] -suggestion, changed the syntax of the loop in host_enum to -be the same of the enum method. - -=item * - -Fixed the MS-DOS ^M at the end-of-line problem. This should -make the module easier to use for *nix users. - -=back - - -=item 1.20 - -=over - - -=item * - -Implemented -Ecompact and -Eexpand methods. - -=item * - -Applying for official name - -=back - - -=item 1.21 - -=over - - -=item * - -Added -Eaddr_number and -Emask_bits. Currently we return -normal numbers (not BigInts). Please test this in your -platform and report any problems! - -=back - - -=item 2.00 - -=over - - -=item * - -Released under the new *official* name of NetAddr::IP - -=back - - -=item 2.10 - -=over - - -=item * - -Added support for -Enew($min, $max, $bits) form - -=item * - -Added -Eto_numeric. This helps serializing objects - -=back - - -=item 2.20 - -=over - - -=item * - -Chris Dowling reported that the sort method introduced in -v1.20 for -Eexpand and -Ecompact doesn't always return a -number under perl versions < 5.6.0. His fix was applied and -redistributed. Thanks Chris! - -=item * - -This module is hopefully released with no CR-LF issues! - -=item * - -Fixed a warning about uninitialized values during make test - -=back - - -=item 2.21 - -=over - - -=item * - -Dennis Boylan pointed out a bug under Linux and perhaps -other platforms as well causing the error "Sort subroutine -didn't return single value at -/usr/lib/perl5/site_perl/5.6.0/NetAddr/IP.pm line 299, EE -line 2." or similar. This was fixed. - -=back - - -=item 2.22 - -=over - - -=item * - -Some changes suggested by Jeroen Ruigrok and Anton Berezin -were included. Thanks guys! - -=back - - -=item 2.23 - -=over - - -=item * - -Bug fix for /XXX.XXX.XXX.XXX netmasks under v5.6.1 suggested -by Tim Wuyts. Thanks! - -=item * - -Tested the module under MACHTYPE=hppa1.0-hp-hpux11.00. It is -now konwn to work under Linux (Intel/AMD), Digital Unix -(Alpha), Solaris (Sun), HP-UX11 (HP-PA-RISC), Windows -9x/NT/2K (using ActiveState on Intel). - -=back - - -=item 2.24 - -=over - - -=item * - -A spurious warning when expand()ing with -w under certain -circumstances was removed. This involved using /31s, /32s -and the same netmask as the input. Thanks to Elie Rosenblum -for pointing it out. - -=item * - -Slight change in license terms to ease redistribution as a -Debian package. - -=back - - -=item 3.00 - -=over - -This is a major rewrite, supposed to fix a number of issues pointed -out in earlier versions. - -The goals for this version include getting rid of BigInts, speeding up -and also cleaning up the code, which is written in a modular enough -way so as to allow IPv6 functionality in the future, taking benefit -from most of the methods. - -Note that no effort has been made to remain backwards compatible with -earlier versions. In particular, certain semantics of the earlier -versions have been removed in favor of faster performance. - -This version was tested under Win98/2K (ActiveState 5.6.0/5.6.1), -HP-UX11 on PA-RISC (5.6.0), RedHat Linux 6.2 (5.6.0), Digital Unix on -Alpha (5.6.0), Solaris on Sparc (5.6.0) and possibly others. - -=back - -=back - - -=head1 AUTHOR - -Luis E. Munoz - -=head1 WARRANTY - -This software comes with the same warranty as perl itself (ie, none), so -by using it you accept any and all the liability. - -=head1 LICENSE - -This software is (c) Luis E. Munoz. It can be used under the terms of -the perl artistic license provided that proper credit for the work of -the author is preserved in the form of this copyright notice and -license for this module. - -=head1 SEE ALSO - -perl(1). - -=cut +#!/usr/bin/perl -w + +package NetAddr::IP; + +require 5.005_62; +use Carp; +use Socket; +use strict; +use warnings; +use overload + '""' => 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; + }, + + '@{}' => sub { return [ $_[0]->hostenum ]; }; + +our $VERSION = '3.02'; + +# 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); +} + +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$/i) { + vec($bmask, 0, $bits) = 0x0; + } + elsif ($mask =~ m/^broadcast$/i) { + vec($bmask, 0, $bits) = _ones $bits; + } + elsif ($mask =~ m/^loopback$/i) { + vec($bmask, 0, 8) = 255; + } + elsif ($mask =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) { + 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 _v4 ($$) { + my $ip = shift; + my $mask = shift; + + my $addr = ''; + + if ($ip =~ m!^default$!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) = 0; + vec($addr, 2, 8) = 0; + vec($addr, 3, 8) = $2; + } + elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)$/) { + vec($addr, 0, 8) = $1; + vec($addr, 1, 8) = $2; + vec($addr, 2, 8) = 0; + vec($addr, 3, 8) = $3; + } + elsif ($ip =~ m/^([xb\d]+)$/) { + vec($addr, 0, 32) = $1; + } + 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 { addr => $addr, mask => $mask, bits => 32 }; +} + +sub new ($$;$) { + my $type = $_[0]; + my $class = ref($type) || $type || "NetAddr::IP"; + my $ip = $_[1]; + my $mask; + + $ip = 'default' unless defined $ip; + + if (@_ == 2) { + if ($ip =~ m!^(.+)/(.+)$!) { + $ip = $1; + $mask = $2; + } + elsif ($ip =~ m!^(default|broadcast|loopback)$!) { + $mask = $ip; + } + } + + if (defined $_[2]) { + $mask = _parse_mask $_[2], 32; + } + elsif (defined $mask) { + $mask = _parse_mask $mask, 32; + } + else { + $mask = _parse_mask 32, 32; + } + + return bless _v4($ip, $mask), $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}; + + return [ "$a" | ~ "$m", $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 broadcast ($) { + my $self = shift; + return $self->_fnew($self->_broadcast); +} + +sub network ($) { + my $self = shift; + return $self->_fnew($self->_network); +} + +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 pointrepresentations. + + 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; + my $bits = $self->{bits}; + my $a = $self->{addr}; + my $m = $self->{mask}; + + my $h = ''; + my $addr = ''; + + vec($h, 0, $bits) = 0x1; # Turn on just the first bit + + return $self->_fnew([ ("$a" & "$m") | "$h", + $self->{mask}, $bits ]); +} + +sub last ($) { + my $self = shift; + my $bits = $self->{bits}; + my $a = $self->{addr}; + my $m = $self->{mask}; + + my $h = ''; + my $addr = ''; + + vec($h, 0, $bits) = _ones $bits; + + return $self->_fnew([ ("$a" & "$m") | ("$h" & ~"$m"), + $self->{mask}, $bits ]); +} + + # 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<-Enew([$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. + +If called with no arguments, 'default' is assumed. + +=item C<-Ebroadcast()> + +Returns a new object refering to the broadcast address of a given +subnet. + +=item C<-Enetwork()> + +Returns a new object refering to the network address of a given +subnet. + +=item C<-Eaddr()> + +Returns a scalar with the address part of the object as a dotted-quad. + +=item C<-Emask()> + +Returns a scalar with the mask as a dotted-quad. + +=item C<-Emasklen()> + +Returns a scalar the number of one bits in the mask. + +=item C<-Ecidr()> + +Returns a scalar with the address and mask in CIDR notation. + +=item C<-Enumeric()> + +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<$me-Econtains($other)> + +Returns true when C<$me> completely contains C<$other>. False is +returned otherwise and C is returned if C<$me> and C<$other> +are of different versions. + +=item C<$me-Ewithin($other)> + +The complement of C<-Econtains()>. Returns true when C<$me> is +completely con tained within C<$other>. + +=item C<-Esplit($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<-Esplitref($bits)> + +A (faster) version of C<-Esplit()> 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<-Ehostenum()> + +Returns the list of hosts within a subnet. + +=item C<-Ehostenumref()> + +Faster version of C<-Ehostenum()>, returning a reference to a list. + +=item C<$me-Ecompact($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. + +Note that in versions prior to 3.02, if fed with the same IP subnets +multiple times, these subnets would be returned. From 3.02 on, a more +"correct" approach has been adopted and only one address would be +returned. + +=item C<$me-Ecompactref(\@list)> + +As usual, a faster version of =item C<-Ecompact()> that returns a +reference to a list. Note that this method takes a reference to a list +instead. + +=item C<-Efirst()> + +Returns a new object representing the first useable IP address within +the subnet (ie, the first host address). + +=item C<-Elast()> + +Returns a new object representing the last useable IP address within +the subnet (ie, one less than the broadcast address). + + +=item C<-Enum()> + +Returns the number of useable addresses IP addresses within the +subnet, not counting the broadcast address. + +=back + +In addition to the methods, some functions are overloaded to ease +manipulation of the objects. The available operations are: + +=over + +=item B + +An object can be used just as a string. For instance, the following code + + my $ip = new NetAddr::IP 'loopback'; + print "$ip\n"; + +Will print the string 127.0.0.1/8. + +=item B + +You can test for equality with either C or C<==>. + +=item B + +You can do something along the lines of + + my $net = new NetAddr::IP $cidr_spec; + for my $ip (@$net) { + print "Host $ip is in $net\n"; + } + +However, note that this might generate a very large amount of items +in the list. You must be careful when doing this kind of expansion. + +=back + +=head2 EXPORT + +None by default. + + +=head1 HISTORY + +=over + +=item 0.01 + +=over + + +=item * + +original version; Basic testing and release to CPAN as +version 0.01. This is considered beta software. + +=back + + +=item 0.02 + +=over + + +=item * + +Multiple changes to fix endiannes issues. This code is now +moderately tested on Wintel and Sun/Solaris boxes. + +=back + + +=item 0.03 + +=over + + +=item * + +Added -Efirst and -Elast methods. Version changed to 0.03. + +=back + + +=item 1.00 + +=over + + +=item * + +Implemented -Enew_subnet. Version changed to 1.00. + +=item * + +less croak()ing when improper input is fed to the module. A +more consistent 'undef' is returned now instead to allow the +user to better handle the error. + +=back + + +=item 1.10 + +=over + + +=item * + +As per Marnix A. Van Ammers [mav6@ns02.comp.pge.com] +suggestion, changed the syntax of the loop in host_enum to +be the same of the enum method. + +=item * + +Fixed the MS-DOS ^M at the end-of-line problem. This should +make the module easier to use for *nix users. + +=back + + +=item 1.20 + +=over + + +=item * + +Implemented -Ecompact and -Eexpand methods. + +=item * + +Applying for official name + +=back + + +=item 1.21 + +=over + + +=item * + +Added -Eaddr_number and -Emask_bits. Currently we return +normal numbers (not BigInts). Please test this in your +platform and report any problems! + +=back + + +=item 2.00 + +=over + + +=item * + +Released under the new *official* name of NetAddr::IP + +=back + + +=item 2.10 + +=over + + +=item * + +Added support for -Enew($min, $max, $bits) form + +=item * + +Added -Eto_numeric. This helps serializing objects + +=back + + +=item 2.20 + +=over + + +=item * + +Chris Dowling reported that the sort method introduced in +v1.20 for -Eexpand and -Ecompact doesn't always return a +number under perl versions < 5.6.0. His fix was applied and +redistributed. Thanks Chris! + +=item * + +This module is hopefully released with no CR-LF issues! + +=item * + +Fixed a warning about uninitialized values during make test + +=back + + +=item 2.21 + +=over + + +=item * + +Dennis Boylan pointed out a bug under Linux and perhaps +other platforms as well causing the error "Sort subroutine +didn't return single value at +/usr/lib/perl5/site_perl/5.6.0/NetAddr/IP.pm line 299, EE +line 2." or similar. This was fixed. + +=back + + +=item 2.22 + +=over + + +=item * + +Some changes suggested by Jeroen Ruigrok and Anton Berezin +were included. Thanks guys! + +=back + + +=item 2.23 + +=over + + +=item * + +Bug fix for /XXX.XXX.XXX.XXX netmasks under v5.6.1 suggested +by Tim Wuyts. Thanks! + +=item * + +Tested the module under MACHTYPE=hppa1.0-hp-hpux11.00. It is +now konwn to work under Linux (Intel/AMD), Digital Unix +(Alpha), Solaris (Sun), HP-UX11 (HP-PA-RISC), Windows +9x/NT/2K (using ActiveState on Intel). + +=back + + +=item 2.24 + +=over + + +=item * + +A spurious warning when expand()ing with -w under certain +circumstances was removed. This involved using /31s, /32s +and the same netmask as the input. Thanks to Elie Rosenblum +for pointing it out. + +=item * + +Slight change in license terms to ease redistribution as a +Debian package. + +=back + + +=item 3.00 + +=over + +This is a major rewrite, supposed to fix a number of issues pointed +out in earlier versions. + +The goals for this version include getting rid of BigInts, speeding up +and also cleaning up the code, which is written in a modular enough +way so as to allow IPv6 functionality in the future, taking benefit +from most of the methods. + +Note that no effort has been made to remain backwards compatible with +earlier versions. In particular, certain semantics of the earlier +versions have been removed in favor of faster performance. + +This version was tested under Win98/2K (ActiveState 5.6.0/5.6.1), +HP-UX11 on PA-RISC (5.6.0), RedHat Linux 6.2 (5.6.0), Digital Unix on +Alpha (5.6.0), Solaris on Sparc (5.6.0) and possibly others. + +=back + +=item 3.01 + +=over + +=item * + +Added C<-Enumeric()>. + +=item * + +C<-Enew()> called with no parameters creates a B +NetAddr::IP object. + +=back + +=item 3.02 + +=over + +=item * + +Fxed C<-Ecompact()> for cases of equal subnets or +mutually-contained IP addresses as pointed out by Peter Wirdemo. Note +that now only distinct IP addresses will be returned by this method. + +=item * + +Fixed the docs as suggested by Thomas Linden. + +=item * + +Introduced overloading to ease certain common operations. + +=item * + + Fixed compatibility issue with C<-Enum()> on 64-bit processors. + +=back + + +=back + + +=head1 AUTHOR + +Luis E. Munoz + +=head1 WARRANTY + +This software comes with the same warranty as perl itself (ie, none), so +by using it you accept any and all the liability. + +=head1 LICENSE + +This software is (c) Luis E. Munoz. It can be used under the terms of +the perl artistic license provided that proper credit for the work of +the author is preserved in the form of this copyright notice and +license for this module. + +=head1 SEE ALSO + +perl(1). + +=cut diff --git a/MANIFEST b/MANIFEST index c5dee34..d17657b 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,18 +1,22 @@ -IP.pm -MANIFEST -Makefile.PL -README -t/00-load.t -t/masklen.t -t/v4-base.t -t/v4-cidr.t -t/v4-basem.t -t/v4-compact.t -t/v4-contains.t -t/v4-first.t -t/v4-hostenum.t -t/v4-new.t -t/v4-num.t -t/v4-snew.t -t/v4-split-bulk.t -t/v4-split-list.t +IP.pm +MANIFEST +Makefile.PL +README +t/00-load.t +t/v4-new.t +t/v4-num.t +t/v4-snew.t +t/over-qq.t +t/masklen.t +t/v4-base.t +t/v4-cidr.t +t/over-arr.t +t/v4-basem.t +t/v4-first.t +t/v4-compact.t +t/v4-numeric.t +t/v4-compplus.t +t/v4-contains.t +t/v4-hostenum.t +t/v4-split-bulk.t +t/v4-split-list.t diff --git a/Makefile.PL b/Makefile.PL index 5ba066f..27cc5df 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -1,8 +1,8 @@ -use ExtUtils::MakeMaker; -# See lib/ExtUtils/MakeMaker.pm for details of how to influence -# the contents of the Makefile that is written. -WriteMakefile( - 'NAME' => 'NetAddr::IP', - 'VERSION_FROM' => 'IP.pm', # finds $VERSION - 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1 -); +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. +WriteMakefile( + 'NAME' => 'NetAddr::IP', + 'VERSION_FROM' => 'IP.pm', # finds $VERSION + 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1 +); diff --git a/README b/README index 7ceca74..54cedb5 100644 --- a/README +++ b/README @@ -2,16 +2,19 @@ NetAddr::IP - Manages IPv4 addresses and subnets 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"; - } - + 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"; + DESCRIPTION This module provides a number of methods useful for handling IPv4 addresses ans subnets. Hopefully, its methods are also usable for IPv6 @@ -19,7 +22,7 @@ Methods so far include: - `->new($addr, [ $mask ])' + `->new([$addr, [ $mask ]])' This method creates a new IPv4 address with the supplied address in `$addr' and an optional netmask `$mask', which can be omitted to get a /32 mask. @@ -28,23 +31,35 @@ in all the notations I have seen over time. It can optionally contain the mask in CIDR notation. + If called with no arguments, 'default' is assumed. + `->broadcast()' - Returns the broadcast address for a subnet. + Returns a new object refering to the broadcast address of a given + subnet. `->network()' - Returns the "network" address for a subnet. + Returns a new object refering to the network address of a given + subnet. `->addr()' - Returns the address part of the object as a dotted-quad. + Returns a scalar with the address part of the object as a + dotted-quad. `->mask()' - Returns the mask as a dotted-quad. + Returns a scalar with the mask as a dotted-quad. `->masklen()' - Returns the number of one bits in the mask. + Returns a scalar the number of one bits in the mask. `->cidr()' - Returns the address and mask in CIDR notation. + Returns a scalar with the address and mask in CIDR notation. + + `->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. `$me->contains($other)' Returns true when `$me' completely contains `$other'. False is @@ -80,6 +95,11 @@ all the addresses and subnets into the largest (ie, least specific) subnets possible that contain exactly all of the given objects. + Note that in versions prior to 3.02, if fed with the same IP subnets + multiple times, these subnets would be returned. From 3.02 on, a + more "correct" approach has been adopted and only one address would + be returned. + `$me->compactref(\@list)' As usual, a faster version of =item `->compact()' that returns a reference to a list. Note that this method takes a reference to a @@ -97,6 +117,32 @@ Returns the number of useable addresses IP addresses within the subnet, not counting the broadcast address. + In addition to the methods, some functions are overloaded to ease + manipulation of the objects. The available operations are: + + Stringification + An object can be used just as a string. For instance, the following + code + + my $ip = new NetAddr::IP 'loopback'; + print "$ip\n"; + + Will print the string 127.0.0.1/8. + + Equality + You can test for equality with either `eq' or `=='. + + Dereferencing as an ARRAY + You can do something along the lines of + + my $net = new NetAddr::IP $cidr_spec; + for my $ip (@$net) { + print "Host $ip is in $net\n"; + } + + However, note that this might generate a very large amount of items + in the list. You must be careful when doing this kind of expansion. + EXPORT None by default. @@ -204,6 +250,25 @@ (5.6.0), Digital Unix on Alpha (5.6.0), Solaris on Sparc (5.6.0) and possibly others. + 3.01 + * Added `->numeric()'. + + * `->new()' called with no parameters creates a default + NetAddr::IP object. + + 3.02 + * Fxed `->compact()' for cases of equal subnets or + mutually-contained IP addresses as pointed out by Peter Wirdemo. + Note that now only distinct IP addresses will be returned by + this method. + + * Fixed the docs as suggested by Thomas Linden. + + * Introduced overloading to ease certain common operations. + + * + Fixed compatibility issue with C<-Enum()> on 64-bit processors. + AUTHOR Luis E. Munoz diff --git a/t/00-load.t b/t/00-load.t index 5495874..432f894 100644 --- a/t/00-load.t +++ b/t/00-load.t @@ -1,20 +1,20 @@ -# Before `make install' is performed this script should be runnable with -# `make test'. After `make install' it should work as `perl test.pl' - -######################### We start with some black magic to print on failure. - -# Change 1..1 below to 1..last_test_to_print . -# (It may become useful if the test is moved to ./t subdirectory.) - -BEGIN { $| = 1; print "1..1\n"; } -END {print "not ok 1\n" unless $loaded;} -use NetAddr::IP; -$loaded = 1; -print "ok 1\n"; - -######################### End of black magic. - -# Insert your test code below (better if it prints "ok 13" -# (correspondingly "not ok 13") depending on the success of chunk 13 -# of the test code): - +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### We start with some black magic to print on failure. + +# Change 1..1 below to 1..last_test_to_print . +# (It may become useful if the test is moved to ./t subdirectory.) + +BEGIN { $| = 1; print "1..1\n"; } +END {print "not ok 1\n" unless $loaded;} +use NetAddr::IP; +$loaded = 1; +print "ok 1\n"; + +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + diff --git a/t/masklen.t b/t/masklen.t index 4af9b61..175e013 100644 --- a/t/masklen.t +++ b/t/masklen.t @@ -1,19 +1,19 @@ -use NetAddr::IP; - -my @masks = 0 .. 32; - -$| = 1; - -print '1..', scalar @masks, "\n"; - -my $count = 1; - -for my $m (@masks) { - my $ip = new NetAddr::IP '10.0.0.1', $m; - if ($ip->masklen == $m) { - print "ok ", $count ++, "\n"; - } - else { - print "not ok ", $count ++, "\n"; - } -} +use NetAddr::IP; + +my @masks = 0 .. 32; + +$| = 1; + +print '1..', scalar @masks, "\n"; + +my $count = 1; + +for my $m (@masks) { + my $ip = new NetAddr::IP '10.0.0.1', $m; + if ($ip->masklen == $m) { + print "ok ", $count ++, "\n"; + } + else { + print "not ok ", $count ++, "\n"; + } +} diff --git a/t/over-arr.t b/t/over-arr.t new file mode 100644 index 0000000..b9c839d --- /dev/null +++ b/t/over-arr.t @@ -0,0 +1,24 @@ +use NetAddr::IP; + +my @addr = ( [ '10.0.0.0/24', '10.0.0.1/32' ], + [ '192.168.0.0/24', '192.168.0.1/32' ], + [ '127.0.0.1/32', '127.0.0.1/32' ] ); + +$| = 1; + +print "1..", 1 * scalar @addr, "\n"; + +my $count = 1; + +for my $a (@addr) { + my $ip = new NetAddr::IP $a->[0]; + + if (@$ip[0]->cidr eq $a->[1]) { + print "ok $count\n"; + } + else { + print "not ok $count\n"; + } + + ++$count; +} diff --git a/t/over-qq.t b/t/over-qq.t new file mode 100644 index 0000000..5f8426b --- /dev/null +++ b/t/over-qq.t @@ -0,0 +1,53 @@ +use NetAddr::IP; + +my @addr = ('10.0.0.0/8', '192.168.0.0/16', '127.0.0.1/32'); + +$| = 1; + +print "1..", 5 * scalar @addr, "\n"; + +my $count = 1; + +for my $a (@addr) { + my $ip = new NetAddr::IP $a; + if ($a eq "$ip") { + print "ok $count\n"; + } + else { + print "not ok $count\n"; + } + ++ $count; + + if ($a eq $ip) { + print "ok $count\n"; + } + else { + print "not ok $count\n"; + } + ++ $count; + + if ($ip eq $a) { + print "ok $count\n"; + } + else { + print "not ok $count\n"; + } + ++ $count; + + if ($ip eq $ip) { + print "ok $count\n"; + } + else { + print "not ok $count\n"; + } + ++ $count; + + if ($ip == $ip) { + print "ok $count\n"; + } + else { + print "not ok $count\n"; + } + ++ $count; + +} diff --git a/t/v4-base.t b/t/v4-base.t index 6dc557d..e1facd5 100644 --- a/t/v4-base.t +++ b/t/v4-base.t @@ -1,19 +1,19 @@ -use NetAddr::IP; - -my @addr = (qw( 127.0.0.1 10.0.0.1 )); -my @mask = (qw( 255.0.0.0 255.255.0.0 255.255.255.0 255.255.255.255 )); - -$| = 1; -print "1..", (2 * scalar @addr * scalar @mask), "\n"; - -my $count = 1; - -for my $a (@addr) { - for my $m (@mask) { - my $ip = new NetAddr::IP $a, $m; - print (($ip->addr ne $a ? 'not ' : ''), "ok ", $count++, "\n"); - print (($ip->mask ne $m ? 'not ' : ''), "ok ", $count++, "\n"); - } -} - - +use NetAddr::IP; + +my @addr = (qw( 127.0.0.1 10.0.0.1 )); +my @mask = (qw( 255.0.0.0 255.255.0.0 255.255.255.0 255.255.255.255 )); + +$| = 1; +print "1..", (2 * scalar @addr * scalar @mask), "\n"; + +my $count = 1; + +for my $a (@addr) { + for my $m (@mask) { + my $ip = new NetAddr::IP $a, $m; + print (($ip->addr ne $a ? 'not ' : ''), "ok ", $count++, "\n"); + print (($ip->mask ne $m ? 'not ' : ''), "ok ", $count++, "\n"); + } +} + + diff --git a/t/v4-basem.t b/t/v4-basem.t index c340df7..3346a39 100644 --- a/t/v4-basem.t +++ b/t/v4-basem.t @@ -1,24 +1,24 @@ -use NetAddr::IP; - -my $nets = { - '10.0.0.16' => [ 24, '10.0.0.255', '10.0.0.0' ], - '127.0.0.1' => [ 8, '127.255.255.255', '127.0.0.0' ], - '192.168.0.10' => [ 17, '192.168.127.255', '192.168.0.0' ], -}; - -$| = 1; -print "1..", (2 * scalar keys %$nets), "\n"; - -my $count = 1; - -for my $a (keys %$nets) { - my $ip = new NetAddr::IP $a, $nets->{$a}->[0]; - print '', (($ip->broadcast->addr ne $nets->{$a}->[1] ? - 'not ' : ''), - "ok ", $count++, "\n"); - print '', (($ip->network->addr ne $nets->{$a}->[2] ? - 'not ' : ''), - "ok ", $count++, "\n"); -} - - +use NetAddr::IP; + +my $nets = { + '10.0.0.16' => [ 24, '10.0.0.255', '10.0.0.0' ], + '127.0.0.1' => [ 8, '127.255.255.255', '127.0.0.0' ], + '192.168.0.10' => [ 17, '192.168.127.255', '192.168.0.0' ], +}; + +$| = 1; +print "1..", (2 * scalar keys %$nets), "\n"; + +my $count = 1; + +for my $a (keys %$nets) { + my $ip = new NetAddr::IP $a, $nets->{$a}->[0]; + print '', (($ip->broadcast->addr ne $nets->{$a}->[1] ? + 'not ' : ''), + "ok ", $count++, "\n"); + print '', (($ip->network->addr ne $nets->{$a}->[2] ? + 'not ' : ''), + "ok ", $count++, "\n"); +} + + diff --git a/t/v4-cidr.t b/t/v4-cidr.t index 70bae56..7ebd20e 100644 --- a/t/v4-cidr.t +++ b/t/v4-cidr.t @@ -1,29 +1,28 @@ -#use NetAddr::IP; -require "IP.pm"; - -$| = 1; - -my @addr = (qw( - 0.0.0.0/0 - 1.0.0.0/1 - 2.0.0.0/2 - 10.0.0.0/8 - 10.0.120.0/24 - 161.196.66.0/25 - 255.255.255.255/32 - )); - -print '1..', scalar @addr, "\n"; - -my $count = 1; - -for my $a (@addr) { - my $ip = new NetAddr::IP $a; - if ($ip->cidr eq $a) { - print "ok ", $count ++, "\n"; - } - else { - print "not ok ", $count ++, "\n"; - print "$a -> ", $ip->cidr, " [", $ip->mask, "]\n"; - } -} +use NetAddr::IP; + +$| = 1; + +my @addr = (qw( + 0.0.0.0/0 + 1.0.0.0/1 + 2.0.0.0/2 + 10.0.0.0/8 + 10.0.120.0/24 + 161.196.66.0/25 + 255.255.255.255/32 + )); + +print '1..', scalar @addr, "\n"; + +my $count = 1; + +for my $a (@addr) { + my $ip = new NetAddr::IP $a; + if ($ip->cidr eq $a) { + print "ok ", $count ++, "\n"; + } + else { + print "not ok ", $count ++, "\n"; + print "$a -> ", $ip->cidr, " [", $ip->mask, "]\n"; + } +} diff --git a/t/v4-compact.t b/t/v4-compact.t index e8f1878..a8a7191 100644 --- a/t/v4-compact.t +++ b/t/v4-compact.t @@ -1,38 +1,54 @@ -use NetAddr::IP; - -my @r = ( - [ '10.0.0.0', '255.255.255.0'], - [ '11.0.0.0', '255.255.255.0'], - [ '12.0.0.0', '255.255.255.0'], - [ '20.0.0.0', '255.255.0.0'], - [ '30.0.0.0', '255.255.0.0'], - [ '40.0.0.0', '255.255.0.0'], - ); - -$| = 1; - -print "1..1\n"; - -my @ips; - -for my $ip ('10.0.0.0', '11.0.0.0', '12.0.0.0') { - push @ips, NetAddr::IP->new($ip, 24)->split(32); -} - -for my $ip ('20.0.0.0', '30.0.0.0', '40.0.0.0') { - push @ips, NetAddr::IP->new($ip, 16)->split(28); -} - -my @c = NetAddr::IP::compact(@ips); -my @m; - -for my $c (@c) { - push @m, grep { $c->addr eq $_->[0] and $c->mask eq $_->[1] } @r; -} - -if (@m == @c) { - print "ok 1\n"; -} -else { - print "not ok 1\n"; -} +use NetAddr::IP; + +my @r = ( + [ '10.0.0.0', '255.255.255.0'], + [ '11.0.0.0', '255.255.255.0'], + [ '12.0.0.0', '255.255.255.0'], + [ '20.0.0.0', '255.255.0.0'], + [ '30.0.0.0', '255.255.0.0'], + [ '40.0.0.0', '255.255.0.0'], + ); + +$| = 1; + +print "1..2\n"; + +my @ips; + +for my $ip ('10.0.0.0', '11.0.0.0', '12.0.0.0') { + push @ips, NetAddr::IP->new($ip, 24)->split(32); +} + +for my $ip ('20.0.0.0', '30.0.0.0', '40.0.0.0') { + push @ips, NetAddr::IP->new($ip, 16)->split(28); +} + +my @c = NetAddr::IP::compact(@ips); +my @m; + +for my $c (@c) { + push @m, grep { $c->addr eq $_->[0] and $c->mask eq $_->[1] } @r; +} + +if (@m == @c) { + print "ok 1\n"; +} +else { + print "not ok 1\n"; +} + +@ips = (); + +for my $ip (qw(1.1.1.1 1.1.1.1 1.1.1.1 1.1.1.1)) { + push(@ips, NetAddr::IP->new($ip)); +} + +@c = NetAddr::IP::compact(@ips); + +if (@c == 1 and $c[0]->cidr() eq '1.1.1.1/32') { + print "ok 2\n"; +} +else { + print "not ok 2\n"; +} + diff --git a/t/v4-compplus.t b/t/v4-compplus.t new file mode 100644 index 0000000..f572bf6 --- /dev/null +++ b/t/v4-compplus.t @@ -0,0 +1,33 @@ +use NetAddr::IP; + +$| = 1; + +print "1..50\n"; + +my $count = 1; + +for my $bits (8 .. 32) { + my $large = new NetAddr::IP '10.0.0.0/8'; + my $small = new NetAddr::IP '10.0.0.0', $bits; + + my @c = NetAddr::IP::compact($large, $small); + + if (@c == 1) { + print "ok $count\n"; + } + else { + print "not ok $count\n"; + } + + ++$count; + + if ($c[0]->cidr eq '10.0.0.0/8') { + print "ok $count\n"; + } + else { + print "not ok $count\n"; + } + + ++$count; +} + diff --git a/t/v4-contains.t b/t/v4-contains.t index 9bd2a0c..57816bb 100644 --- a/t/v4-contains.t +++ b/t/v4-contains.t @@ -1,61 +1,61 @@ -use NetAddr::IP; -#require "IP.pm"; - -my @yes_pairs = ( - [ [ '127.0.0.0', '255.0.0.0' ], - [ '127.0.0.1', '255.255.255.255'] ], - [ [ '10.0.0.0', '255.255.255.0' ], - [ '10.0.0.128', '255.255.255.128' ] ], - [ [ '10.0.0.0', '255.0.0.0' ], - [ '10.0.0.0', '255.0.0.0' ]], - [ [ '10.0.0.0', '255.0.0.0' ], - [ '10.0.0.1', '255.0.0.0' ]], - [ [ '10.0.0.0', '255.255.255.254' ], - [ '10.0.0.1', '255.255.255.254' ]], - [ [ '10.0.0.0', '255.255.255.254' ], - [ '10.0.0.1', '255.255.255.255' ]], - [ [ '10.0.0.1', '255.0.0.0' ], - [ '10.0.0.1', '255.255.255.255' ]], - [ [ 'default', 'default' ], - [ '10.0.0.1', '255.255.255.254' ]], - [ [ 'default', 'default' ], - [ 'broadcast', undef ]], - [ [ 'loopback', '255.0.0.0' ], - [ '127.0.0.0', '255.0.0.0' ] ], - ); - -my @no_pairs = ( - [ [ '127.0.0.1', '255.255.255.255' ], - [ '127.0.0.0', '255.0.0.0' ] ], - [ [ '10.0.0.0', '255.0.0.0' ], - [ '11.0.0.0', '255.0.0.0' ] ], - [ [ '10.0.1.0', '255.255.255.0' ], - [ '10.0.2.0', '255.255.255.0' ] ], - [ [ '10.0.0.1', '255.255.255.254' ], - [ 'default', '0' ] ], - ); - -$| = 1; -print "1..", 2 * (scalar @yes_pairs + scalar @no_pairs), "\n"; - -my $count = 1; - -for my $p (@yes_pairs) { - my $ip_a = new NetAddr::IP $p->[0]->[0], $p->[0]->[1]; - my $ip_b = new NetAddr::IP $p->[1]->[0], $p->[1]->[1]; - print (($ip_a->contains($ip_b) ? '' : 'not '), 'ok ', $count++, "\n"); - print (($ip_b->within($ip_a) ? '' : 'not '), 'ok ', $count++, "\n"); - -# print "a = ", $ip_a->addr, "/", $ip_a->mask, "\n"; -# print "b = ", $ip_b->addr, "/", $ip_b->mask, "\n"; - -} - -for my $p (@no_pairs) { - my $ip_a = new NetAddr::IP $p->[0]->[0], $p->[0]->[1]; - my $ip_b = new NetAddr::IP $p->[1]->[0], $p->[1]->[1]; - print (($ip_a->contains($ip_b) ? 'not ' : ''), 'ok ', $count++, "\n"); - print (($ip_b->within($ip_a) ? 'not ' : ''), 'ok ', $count++, "\n"); -} - - +use NetAddr::IP; +#require "IP.pm"; + +my @yes_pairs = ( + [ [ '127.0.0.0', '255.0.0.0' ], + [ '127.0.0.1', '255.255.255.255'] ], + [ [ '10.0.0.0', '255.255.255.0' ], + [ '10.0.0.128', '255.255.255.128' ] ], + [ [ '10.0.0.0', '255.0.0.0' ], + [ '10.0.0.0', '255.0.0.0' ]], + [ [ '10.0.0.0', '255.0.0.0' ], + [ '10.0.0.1', '255.0.0.0' ]], + [ [ '10.0.0.0', '255.255.255.254' ], + [ '10.0.0.1', '255.255.255.254' ]], + [ [ '10.0.0.0', '255.255.255.254' ], + [ '10.0.0.1', '255.255.255.255' ]], + [ [ '10.0.0.1', '255.0.0.0' ], + [ '10.0.0.1', '255.255.255.255' ]], + [ [ 'default', 'default' ], + [ '10.0.0.1', '255.255.255.254' ]], + [ [ 'default', 'default' ], + [ 'broadcast', undef ]], + [ [ 'loopback', '255.0.0.0' ], + [ '127.0.0.0', '255.0.0.0' ] ], + ); + +my @no_pairs = ( + [ [ '127.0.0.1', '255.255.255.255' ], + [ '127.0.0.0', '255.0.0.0' ] ], + [ [ '10.0.0.0', '255.0.0.0' ], + [ '11.0.0.0', '255.0.0.0' ] ], + [ [ '10.0.1.0', '255.255.255.0' ], + [ '10.0.2.0', '255.255.255.0' ] ], + [ [ '10.0.0.1', '255.255.255.254' ], + [ 'default', '0' ] ], + ); + +$| = 1; +print "1..", 2 * (scalar @yes_pairs + scalar @no_pairs), "\n"; + +my $count = 1; + +for my $p (@yes_pairs) { + my $ip_a = new NetAddr::IP $p->[0]->[0], $p->[0]->[1]; + my $ip_b = new NetAddr::IP $p->[1]->[0], $p->[1]->[1]; + print (($ip_a->contains($ip_b) ? '' : 'not '), 'ok ', $count++, "\n"); + print (($ip_b->within($ip_a) ? '' : 'not '), 'ok ', $count++, "\n"); + +# print "a = ", $ip_a->addr, "/", $ip_a->mask, "\n"; +# print "b = ", $ip_b->addr, "/", $ip_b->mask, "\n"; + +} + +for my $p (@no_pairs) { + my $ip_a = new NetAddr::IP $p->[0]->[0], $p->[0]->[1]; + my $ip_b = new NetAddr::IP $p->[1]->[0], $p->[1]->[1]; + print (($ip_a->contains($ip_b) ? 'not ' : ''), 'ok ', $count++, "\n"); + print (($ip_b->within($ip_a) ? 'not ' : ''), 'ok ', $count++, "\n"); +} + + diff --git a/t/v4-first.t b/t/v4-first.t index 3109b29..08c4902 100644 --- a/t/v4-first.t +++ b/t/v4-first.t @@ -1,24 +1,24 @@ -use NetAddr::IP; - -my $nets = { - '10.0.0.16' => [ 24, '10.0.0.1', '10.0.0.255'], - '10.128.0.1' => [ 8, '10.0.0.1', '10.255.255.255'], - '10.0.0.5' => [ 30, '10.0.0.5', '10.0.0.7' ], -}; - -$| = 1; -print "1..", (2 * scalar keys %$nets), "\n"; - -my $count = 1; - -for my $a (keys %$nets) { - my $ip = new NetAddr::IP $a, $nets->{$a}->[0]; - print '', (($ip->first->addr ne $nets->{$a}->[1] ? - 'not ' : ''), - "ok ", $count++, "\n"); - print '', (($ip->last->addr ne $nets->{$a}->[2] ? - 'not ' : ''), - "ok ", $count++, "\n"); -} - - +use NetAddr::IP; + +my $nets = { + '10.0.0.16' => [ 24, '10.0.0.1', '10.0.0.255'], + '10.128.0.1' => [ 8, '10.0.0.1', '10.255.255.255'], + '10.0.0.5' => [ 30, '10.0.0.5', '10.0.0.7' ], +}; + +$| = 1; +print "1..", (2 * scalar keys %$nets), "\n"; + +my $count = 1; + +for my $a (keys %$nets) { + my $ip = new NetAddr::IP $a, $nets->{$a}->[0]; + print '', (($ip->first->addr ne $nets->{$a}->[1] ? + 'not ' : ''), + "ok ", $count++, "\n"); + print '', (($ip->last->addr ne $nets->{$a}->[2] ? + 'not ' : ''), + "ok ", $count++, "\n"); +} + + diff --git a/t/v4-hostenum.t b/t/v4-hostenum.t index 366d427..a050f4b 100644 --- a/t/v4-hostenum.t +++ b/t/v4-hostenum.t @@ -1,48 +1,48 @@ -use NetAddr::IP; - -my %addr = ( - '10.0.0.0' => [ '255.255.255.252', - [ - '10.0.0.1', '10.0.0.2', - ]], - '11.0.0.0' => [ '255.255.255.255', - [ - '11.0.0.0', - ]], - '12.0.0.0' => [ '255.255.255.0', - []], - ); - -for my $o (1..254) { - push @{$addr{'12.0.0.0'}->[1]}, '12.0.0.' . $o; -} - -my $count = $| = 1; -print "1..", (2 * scalar keys %addr), "\n"; - -for my $a (keys %addr) { - my $ip = new NetAddr::IP $a, $addr{$a}->[0]; - my @r = $ip->hostenum; - my @m = (); - - if (scalar @r == @{$addr{$a}->[1]}) { - print "ok ", $count++, "\n"; - } - else { - print "not ok ", $count++, " (number $a)\n"; - } - - for my $r (@r) { - push @m, grep { $_ eq $r->addr } @{$addr{$a}->[1]}; - } - - if (scalar @m == scalar @r) { - print "ok ", $count++, "\n"; - } - else { - print "not ok ", $count++, " (match $a)\n"; - print "henum=", join(', ', (map { $_->addr } @r)), "\n"; - print "match=", join(', ', @m), "\n"; - - } -} +use NetAddr::IP; + +my %addr = ( + '10.0.0.0' => [ '255.255.255.252', + [ + '10.0.0.1', '10.0.0.2', + ]], + '11.0.0.0' => [ '255.255.255.255', + [ + '11.0.0.0', + ]], + '12.0.0.0' => [ '255.255.255.0', + []], + ); + +for my $o (1..254) { + push @{$addr{'12.0.0.0'}->[1]}, '12.0.0.' . $o; +} + +my $count = $| = 1; +print "1..", (2 * scalar keys %addr), "\n"; + +for my $a (keys %addr) { + my $ip = new NetAddr::IP $a, $addr{$a}->[0]; + my @r = $ip->hostenum; + my @m = (); + + if (scalar @r == @{$addr{$a}->[1]}) { + print "ok ", $count++, "\n"; + } + else { + print "not ok ", $count++, " (number $a)\n"; + } + + for my $r (@r) { + push @m, grep { $_ eq $r->addr } @{$addr{$a}->[1]}; + } + + if (scalar @m == scalar @r) { + print "ok ", $count++, "\n"; + } + else { + print "not ok ", $count++, " (match $a)\n"; + print "henum=", join(', ', (map { $_->addr } @r)), "\n"; + print "match=", join(', ', @m), "\n"; + + } +} diff --git a/t/v4-new.t b/t/v4-new.t index d506c58..0495957 100644 --- a/t/v4-new.t +++ b/t/v4-new.t @@ -1,55 +1,55 @@ -use NetAddr::IP; -#require "IP.pm"; - -my @a = ( - [ 'localhost', '127.0.0.1' ], - [ '127.1', '127.0.0.1' ], - [ '10.10.1', '10.10.0.1' ], - [ 0x01010101, '1.1.1.1' ], - [ 1, '0.0.0.1' ], - [ 'default', '0.0.0.0' ], - ); - -my @m = ( - [ 0, '0.0.0.0' ], - [ 1, '128.0.0.0' ], - [ 2, '192.0.0.0' ], - [ 4, '240.0.0.0' ], - [ 8, '255.0.0.0' ], - [ 16, '255.255.0.0' ], - [ 17, '255.255.128.0' ], - [ 24, '255.255.255.0' ], - [ 'default', '0.0.0.0' ], - [ 32, '255.255.255.255' ], - [ 0xffffff00, '255.255.255.0' ], - [ '255.255.128.0', '255.255.128.0' ], - [ 0b11111111111111110000000000000000, '255.255.0.0' ], - ); - -$| = 1; - -print '1..', (2 * scalar @a * scalar @m), "\n"; - -my $count = 1; - -for my $a (@a) { - for my $m (@m) { - my $ip = new NetAddr::IP $a->[0], $m->[0]; - if ($ip->addr eq $a->[1]) { - print "ok ", $count++, "\n"; - } - else { - print "not ok ", $count++, "\n"; - } - - if ($ip->mask eq $m->[1]) { - print "ok ", $count++, "\n"; - } - else { - print "not ok ", $count++, "\n"; - } - -# print "mask=", $ip->mask, "\n"; - - } -} +use NetAddr::IP; +#require "IP.pm"; + +my @a = ( + [ 'localhost', '127.0.0.1' ], + [ '127.1', '127.0.0.1' ], + [ '10.10.1', '10.10.0.1' ], + [ 0x01010101, '1.1.1.1' ], + [ 1, '0.0.0.1' ], + [ 'default', '0.0.0.0' ], + ); + +my @m = ( + [ 0, '0.0.0.0' ], + [ 1, '128.0.0.0' ], + [ 2, '192.0.0.0' ], + [ 4, '240.0.0.0' ], + [ 8, '255.0.0.0' ], + [ 16, '255.255.0.0' ], + [ 17, '255.255.128.0' ], + [ 24, '255.255.255.0' ], + [ 'default', '0.0.0.0' ], + [ 32, '255.255.255.255' ], + [ 0xffffff00, '255.255.255.0' ], + [ '255.255.128.0', '255.255.128.0' ], + [ 0b11111111111111110000000000000000, '255.255.0.0' ], + ); + +$| = 1; + +print '1..', (2 * scalar @a * scalar @m), "\n"; + +my $count = 1; + +for my $a (@a) { + for my $m (@m) { + my $ip = new NetAddr::IP $a->[0], $m->[0]; + if ($ip->addr eq $a->[1]) { + print "ok ", $count++, "\n"; + } + else { + print "not ok ", $count++, "\n"; + } + + if ($ip->mask eq $m->[1]) { + print "ok ", $count++, "\n"; + } + else { + print "not ok ", $count++, "\n"; + } + +# print "mask=", $ip->mask, "\n"; + + } +} diff --git a/t/v4-num.t b/t/v4-num.t index acedbb2..868040a 100644 --- a/t/v4-num.t +++ b/t/v4-num.t @@ -1,22 +1,22 @@ -use NetAddr::IP; - -my $nets = { - '10.0.0.16' => [ 24, 255 ], - '10.128.0.1' => [ 8, 2 ** 24 - 1 ], - '10.0.0.5' => [ 30, 3 ], -}; - -$| = 1; -print "1..", (scalar keys %$nets), "\n"; - -my $count = 1; - -for my $a (keys %$nets) { - my $ip = new NetAddr::IP $a, $nets->{$a}->[0]; - - print '', (($ip->num != $nets->{$a}->[1] ? - 'not ' : ''), - "ok ", $count++, "\n"); -} - - +use NetAddr::IP; + +my $nets = { + '10.0.0.16' => [ 24, 255 ], + '10.128.0.1' => [ 8, 2 ** 24 - 1 ], + '10.0.0.5' => [ 30, 3 ], +}; + +$| = 1; +print "1..", (scalar keys %$nets), "\n"; + +my $count = 1; + +for my $a (keys %$nets) { + my $ip = new NetAddr::IP $a, $nets->{$a}->[0]; + + print '', (($ip->num != $nets->{$a}->[1] ? + 'not ' : ''), + "ok ", $count++, "\n"); +} + + diff --git a/t/v4-numeric.t b/t/v4-numeric.t new file mode 100644 index 0000000..0f14d75 --- /dev/null +++ b/t/v4-numeric.t @@ -0,0 +1,36 @@ +use NetAddr::IP; + +my $nets = { + '10.0.0.0/20' => [ 167772160, 4294963200 ], + '10.0.15.0/24' => [ 167776000, 4294967040 ], + '192.168.0.0/24' => [ 3232235520, 4294967040], + 'broadcast' => [ 4294967295, 4294967295], + 'default' => [ 0, 0 ], +}; + +$| = 1; +print "1..", 4 * (scalar keys %$nets), "\n"; + +my $count = 1; + +for my $a (keys %$nets) { + my $ip = new NetAddr::IP $a; + my ($addr, $mask) = $ip->numeric; + + my $nip = new NetAddr::IP $addr, $mask; + + print '', ($nip ? '' : 'not '), 'ok ', $count++, "\n"; + + print '', ($nip and $nip->cidr eq $ip->cidr) ? '' : 'not ', + 'ok ', $count ++, "\n"; + + print '', (($addr != $nets->{$a}->[0] ? 'not ' : ''), + "ok ", $count++, "\n"); + + print '', (($mask != $nets->{$a}->[1] ? 'not ' : ''), + "ok ", $count++, "\n"); + + +} + + diff --git a/t/v4-snew.t b/t/v4-snew.t index 6975b13..782f2e1 100644 --- a/t/v4-snew.t +++ b/t/v4-snew.t @@ -1,30 +1,30 @@ -use NetAddr::IP; - -my %w = ('broadcast' => [ '255.255.255.255', '255.255.255.255' ], - 'default' => [ '0.0.0.0', '0.0.0.0' ], - 'loopback' => [ '127.0.0.1', '255.0.0.0' ], - ); - -$| = 1; - -print '1..', (2 * scalar keys %w), "\n"; - -my $count = 1; - -for my $a (keys %w) { - my $ip = new NetAddr::IP $a; - - if ($ip->addr eq $w{$a}->[0]) { - print "ok ", $count++, "\n"; - } - else { - print "not ok ", $count++, "\n"; - } - - if ($ip->mask eq $w{$a}->[1]) { - print "ok ", $count++, "\n"; - } - else { - print "not ok ", $count++, "\n"; - } -} +use NetAddr::IP; + +my %w = ('broadcast' => [ '255.255.255.255', '255.255.255.255' ], + 'default' => [ '0.0.0.0', '0.0.0.0' ], + 'loopback' => [ '127.0.0.1', '255.0.0.0' ], + ); + +$| = 1; + +print '1..', (2 * scalar keys %w), "\n"; + +my $count = 1; + +for my $a (keys %w) { + my $ip = new NetAddr::IP $a; + + if ($ip->addr eq $w{$a}->[0]) { + print "ok ", $count++, "\n"; + } + else { + print "not ok ", $count++, "\n"; + } + + if ($ip->mask eq $w{$a}->[1]) { + print "ok ", $count++, "\n"; + } + else { + print "not ok ", $count++, "\n"; + } +} diff --git a/t/v4-split-bulk.t b/t/v4-split-bulk.t index 1eb50a1..33d8a7c 100644 --- a/t/v4-split-bulk.t +++ b/t/v4-split-bulk.t @@ -1,23 +1,23 @@ -use NetAddr::IP; - -my @addr = ( [ '10.0.0.0', 20, 32, 4096 ], - [ '10.0.0.0', 22, 32, 1024 ], - [ '10.0.0.0', 24, 32, 256 ], - [ '10.0.0.0', 19, 32, 8192 ] - ); - -my $count = $| = 1; -print "1..", (scalar @addr), "\n"; - -for my $a (@addr) { - my $ip = new NetAddr::IP $a->[0], $a->[1]; - my $r = $ip->splitref($a->[2]); - - if (scalar @$r == $a->[3]) { - print "ok ", $count++, "\n"; - } - else { - print "not ok ", $count++, " (number $a)\n"; - } - -} +use NetAddr::IP; + +my @addr = ( [ '10.0.0.0', 20, 32, 4096 ], + [ '10.0.0.0', 22, 32, 1024 ], + [ '10.0.0.0', 24, 32, 256 ], + [ '10.0.0.0', 19, 32, 8192 ] + ); + +my $count = $| = 1; +print "1..", (scalar @addr), "\n"; + +for my $a (@addr) { + my $ip = new NetAddr::IP $a->[0], $a->[1]; + my $r = $ip->splitref($a->[2]); + + if (scalar @$r == $a->[3]) { + print "ok ", $count++, "\n"; + } + else { + print "not ok ", $count++, " (number $a)\n"; + } + +} diff --git a/t/v4-split-list.t b/t/v4-split-list.t index c1cca47..1113244 100644 --- a/t/v4-split-list.t +++ b/t/v4-split-list.t @@ -1,52 +1,52 @@ -use NetAddr::IP; - -my %addr = ( - '10.0.0.10' => [ '255.255.252.0', 24, - [ - '10.0.0.0', '10.0.1.0', - '10.0.2.0', '10.0.3.0' - ]], - '10.0.0.1' => [ '255.255.255.254', 32, - [ - '10.0.0.0', '10.0.0.1', - ]], - '10.0.0.2' => [ '255.255.255.255', 32, - [ - '10.0.0.2', - ]], - '10.0.0.3' => [ '255.255.255.252', 32, - [ - '10.0.0.0', '10.0.0.1', - '10.0.0.2', '10.0.0.3', - ]], - ); - -my $count = $| = 1; -print "1..", (2 * scalar keys %addr), "\n"; - -for my $a (keys %addr) { - my $ip = new NetAddr::IP $a, $addr{$a}->[0]; - my @r = $ip->split($addr{$a}->[1]); - my @m = (); - - if (scalar @r == @{$addr{$a}->[2]}) { - print "ok ", $count++, "\n"; - } - else { - print "not ok ", $count++, " (number $a)\n"; - } - - for my $r (@r) { - push @m, grep { $_ eq $r->addr } @{$addr{$a}->[2]}; - } - - if (scalar @m == scalar @r) { - print "ok ", $count++, "\n"; - } - else { - print "not ok ", $count++, " (match $a)\n"; - print "split=", join(', ', (map { $_->addr } @r)), "\n"; - print "match=", join(', ', @m), "\n"; - - } -} +use NetAddr::IP; + +my %addr = ( + '10.0.0.10' => [ '255.255.252.0', 24, + [ + '10.0.0.0', '10.0.1.0', + '10.0.2.0', '10.0.3.0' + ]], + '10.0.0.1' => [ '255.255.255.254', 32, + [ + '10.0.0.0', '10.0.0.1', + ]], + '10.0.0.2' => [ '255.255.255.255', 32, + [ + '10.0.0.2', + ]], + '10.0.0.3' => [ '255.255.255.252', 32, + [ + '10.0.0.0', '10.0.0.1', + '10.0.0.2', '10.0.0.3', + ]], + ); + +my $count = $| = 1; +print "1..", (2 * scalar keys %addr), "\n"; + +for my $a (keys %addr) { + my $ip = new NetAddr::IP $a, $addr{$a}->[0]; + my @r = $ip->split($addr{$a}->[1]); + my @m = (); + + if (scalar @r == @{$addr{$a}->[2]}) { + print "ok ", $count++, "\n"; + } + else { + print "not ok ", $count++, " (number $a)\n"; + } + + for my $r (@r) { + push @m, grep { $_ eq $r->addr } @{$addr{$a}->[2]}; + } + + if (scalar @m == scalar @r) { + print "ok ", $count++, "\n"; + } + else { + print "not ok ", $count++, " (match $a)\n"; + print "split=", join(', ', (map { $_->addr } @r)), "\n"; + print "match=", join(', ', @m), "\n"; + + } +}