diff --git a/IP.pm b/IP.pm index 4909d4d..1a5608a 100644 --- a/IP.pm +++ b/IP.pm @@ -139,7 +139,7 @@ ############################################# -our $VERSION = '3.03'; +our $VERSION = '3.04'; # Preloaded methods go here. @@ -275,6 +275,14 @@ 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; @@ -312,6 +320,102 @@ 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 (my $a = gethostbyname($ip)) { if (inet_ntoa($a) =~ m!^(\d+)\.(\d+)\.(\d+)\.(\d+)$!) { vec($addr, 0, 8) = $1; @@ -321,7 +425,8 @@ } } else { - croak "Cannot obtain an IP address out of $ip"; +# croak "Cannot obtain an IP address out of $ip"; + return undef; } return { addr => $addr, mask => $mask, bits => 32 }; @@ -355,7 +460,11 @@ $mask = _parse_mask 32, 32; } - return bless _v4($ip, $mask), $class; + my $self = _v4($ip, $mask); + + return undef unless $self; + + return bless $self, $class; } sub new4 ($$;$) { @@ -411,6 +520,60 @@ 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 - 1)->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->last->addr); + + return do_prefix $mask, \@faddr, \@laddr; +} + sub broadcast ($) { my $self = shift; return $self->_fnew($self->_broadcast); @@ -698,6 +861,9 @@ in all the notations I have seen over time. It can optionally contain the mask in CIDR notation. +B 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<-Ebroadcast()> @@ -726,6 +892,17 @@ Returns a scalar with the address and mask in CIDR notation. +=item C<-Eprefix()> + +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<-Enprefix()> + +Just as C<-Eprefix()>, but does not include the broadcast address. + =item C<-Enumeric()> When called in a scalar context, will return a numeric representation @@ -1171,6 +1348,23 @@ =back +=item 3.04 + +=over + +=item * + +Got rid of C when invalid input was fed to C<-Enew()>. + +=item * + +As suggested by Andrew Gaskill, added support for prefix +notation. Thanks for the code of the initial C<-Eprefix()> +function. + +=back + +=back =head1 AUTHOR diff --git a/MANIFEST b/MANIFEST index a57648d..762eba8 100644 --- a/MANIFEST +++ b/MANIFEST @@ -18,6 +18,8 @@ t/wildcard.t t/v4-compact.t t/v4-numeric.t +t/v4-sprefix.t +t/v4-xprefix.t t/v4-compplus.t t/v4-contains.t t/v4-hostenum.t diff --git a/README b/README index 6e58a9e..5f06b73 100644 --- a/README +++ b/README @@ -1,314 +1,32 @@ NAME NetAddr::IP - Manages IPv4 addresses and subnets -SYNOPSIS - use NetAddr::IP; +This module provides a simple interface to manipulate IP addresses as +objects. Among the operations that can be done are comparison, tests +for addresses within subnets, enumeration, splitting, summarization +and others. - my $ip = new NetAddr::IP 'loopback'; +NetAddr::IP objects also "stringify" themselves automatically to +unclutter I/O functions. - print "The address is ", $ip->addr, " with mask ", $ip->mask, "\n" ; +To install, follow the traditional incantations: - if ($ip->within(new NetAddr::IP "127.0.0.0", "255.0.0.0")) { - print "Is a loopback address\n"; - } +perl Makefile.PL +make +make test +make install - # 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 - addresses. - - Methods so far include: - - `->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. - - `$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. - - `->broadcast()' - Returns a new object refering to the broadcast address of a given - subnet. - - `->network()' - Returns a new object refering to the network address of a given - subnet. - - `->addr()' - Returns a scalar with the address part of the object as a - dotted-quad. - - `->mask()' - Returns a scalar with the mask as a dotted-quad. - - `->masklen()' - Returns a scalar the number of one bits in the mask. - - `->cidr()' - 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. - - `->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. - - `$me->contains($other)' - Returns true when `$me' completely contains `$other'. False is - returned otherwise and `undef' is returned if `$me' and `$other' are - of different versions. - - `$me->within($other)' - The complement of `->contains()'. Returns true when `$me' is - completely con tained within `$other'. - - `->split($bits)' - Returns a list of objects, representing subnets of `$bits' mask - produced by splitting the original object, which is left unchanged. - Note that `$bits' must be longer than the original object's mask in - order for it to be splittable. - - Note that `$bits' can be given as an integer (the length of the - mask) or as a dotted-quad. If omitted, a host mask is assumed. - - `->splitref($bits)' - A (faster) version of `->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. - - `->hostenum()' - Returns the list of hosts within a subnet. - - `->hostenumref()' - Faster version of `->hostenum()', returning a reference to a list. - - `$me->compact($addr1, $addr2, ...)' - Given a list of objects (including `$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. - - `$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 - list instead. - - `->first()' - Returns a new object representing the first useable IP address - within the subnet (ie, the first host address). - - `->last()' - Returns a new object representing the last useable IP address within - the subnet (ie, one less than the broadcast address). - - `->num()' - 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. - - Sum and auto-increment - You can add a constant to an object. This will return a new object - referring to the host address obtained by incrementing (or - decrementing) the given address. YOu can do this with the operators - +, -, += and -=. - - The auto-increment or auto-decrement operators will return a new - object pointing to the next or previous host address in the subnet. - These are the ++ and -- operators. - - EXPORT - - None by default. - -HISTORY - 0.01 - * original version; Basic testing and release to CPAN as version - 0.01. This is considered beta software. - - 0.02 - * Multiple changes to fix endiannes issues. This code is now - moderately tested on Wintel and Sun/Solaris boxes. - - 0.03 - * Added ->first and ->last methods. Version changed to 0.03. - - 1.00 - * Implemented ->new_subnet. Version changed to 1.00. - - * 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. - - 1.10 - * 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. - - * Fixed the MS-DOS ^M at the end-of-line problem. This should make - the module easier to use for *nix users. - - 1.20 - * Implemented ->compact and ->expand methods. - - * Applying for official name - - 1.21 - * Added ->addr_number and ->mask_bits. Currently we return normal - numbers (not BigInts). Please test this in your platform and - report any problems! - - 2.00 - * Released under the new *official* name of NetAddr::IP - - 2.10 - * Added support for ->new($min, $max, $bits) form - - * Added ->to_numeric. This helps serializing objects - - 2.20 - * Chris Dowling reported that the sort method introduced in v1.20 - for ->expand and ->compact doesn't always return a number under - perl versions < 5.6.0. His fix was applied and redistributed. - Thanks Chris! - - * This module is hopefully released with no CR-LF issues! - - * Fixed a warning about uninitialized values during make test - - 2.21 - * 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, <> line - 2." or similar. This was fixed. - - 2.22 - * Some changes suggested by Jeroen Ruigrok and Anton Berezin were - included. Thanks guys! - - 2.23 - * Bug fix for /XXX.XXX.XXX.XXX netmasks under v5.6.1 suggested by - Tim Wuyts. Thanks! - - * 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). - - 2.24 - * 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. - - * Slight change in license terms to ease redistribution as a - Debian package. - - 3.00 - 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. - - 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. - - 3.03 - * Added more comparison operators. - - * As per Peter Wirdemo's suggestion, added `->wildcard()' for - producing subnets in wildcard format. - - * Added `++' and `+' to provide for efficient iteration operations - over all the hosts of a subnet without `->expand()'ing it. - -AUTHOR - Luis E. Munoz +This module has been tested under many platforms, using perl 5.6.0 or +newer. WARRANTY - This software comes with the same warranty as perl itself (ie, - none), so by using it you accept any and all the liability. + This software comes with the same warranty as perl itself (ie, none), so + by using it you accept any and all the liability. 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. + 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. -SEE ALSO - perl(1). diff --git a/t/v4-compact.t b/t/v4-compact.t index b0dd00e..a8a7191 100644 --- a/t/v4-compact.t +++ b/t/v4-compact.t @@ -11,7 +11,7 @@ $| = 1; -print "1..4\n"; +print "1..2\n"; my @ips; @@ -52,23 +52,3 @@ print "not ok 2\n"; } -@c = NetAddr::IP::compact( - NetAddr::IP->new('broadcast'), - NetAddr::IP->new('default') - ); - -if (@c == 1) { - print "ok 3\n"; -} -else { - print "not ok 3\n"; -} - -if ($c[0]->cidr eq '0.0.0.0/0') { - print "ok 4\n"; -} -else { - print "not ok 4\n"; -} - - diff --git a/t/v4-snew.t b/t/v4-snew.t index 782f2e1..0fe5049 100644 --- a/t/v4-snew.t +++ b/t/v4-snew.t @@ -3,6 +3,15 @@ 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' ], + '10.' => [ '10.0.0.0', '255.0.0.0' ], + '11.11.' => [ '11.11.0.0', '255.255.0.0' ], + '12.12.12.' => [ '12.12.12.0', '255.255.255.0' ], + '13.13.13.13' => [ '13.13.13.13', '255.255.255.255' ], + '0-127' => [ '0.0.0.0', '128.0.0.0' ], + '128-255' => [ '128.0.0.0', '128.0.0.0' ], + '0-63' => [ '0.0.0.0', '192.0.0.0' ], + '128-191' => [ '128.0.0.0', '192.0.0.0' ], + '10.128.0-127' => [ '10.128.0.0', '255.255.128.0' ], ); $| = 1; diff --git a/t/v4-sprefix.t b/t/v4-sprefix.t new file mode 100644 index 0000000..88d9e58 --- /dev/null +++ b/t/v4-sprefix.t @@ -0,0 +1,49 @@ +use NetAddr::IP; + +my @addr = ( + [ '10.', '10.0.0.0/8' ], + [ '11.11.', '11.11.0.0/16' ], + [ '12.12.12.', '12.12.12.0/24' ], + [ '13.13.13.13', '13.13.13.13/32' ], + ); + +$| = 1; +print "1..", (3 * scalar @addr), "\n"; + +my $count = 1; + +for my $a (@addr) { + my $ip = new NetAddr::IP $a->[0]; + + if ($ip->cidr eq $a->[1]) { + print "ok $count\n"; + } + else { + print "not ok $count\n"; + } + + ++ $count; + + my $p = new NetAddr::IP $ip->cidr; + + if ($p->prefix eq $a->[0]) { + print "ok $count\n"; + } + else { + print "not ok $count\n"; + } + + ++ $count; + + if ($p->nprefix eq $a->[0]) { + print "ok $count\n"; + } + else { + print "not ok $count\n"; + } + + ++ $count; + +} + + diff --git a/t/v4-xprefix.t b/t/v4-xprefix.t new file mode 100644 index 0000000..b37620d --- /dev/null +++ b/t/v4-xprefix.t @@ -0,0 +1,46 @@ +use NetAddr::IP; + +my @addr = ( + [ '0.0.0.0/1', '0-127' ], + [ '128.0.0.0/1', '128-255' ], + [ '0.0.0.0/2', '0-63' ], + [ '128.0.0.0/2', '128-191' ], + [ '10.128.0.0/17', '10.128.0-127.' ] + ); + +$| = 1; +print "1..", (2 * scalar @addr), "\n"; + +my $count = 1; + +for my $a (@addr) { + my $ip = new NetAddr::IP $a->[0]; + +# print "$a->[0] is ", $ip->prefix, "\n"; + + if ($ip->prefix eq $a->[1]) { + print "ok $count\n"; + } + else { + print "not ok $count\n"; + } + + ++ $count; + + my $p = new NetAddr::IP $ip->prefix; + +# print $ip->prefix, " is $p\n"; + + + if ($p->cidr eq $a->[0]) { + print "ok $count\n"; + } + else { + print "not ok $count\n"; + } + + ++ $count; + +} + +