diff --git a/Changes b/Changes index 703fcfd..5a67417 100644 --- a/Changes +++ b/Changes @@ -1,9 +1,55 @@ Revision history for Perl extension NetAddr::IP + +4.010 Sat Sep 27 17:00:28 PDT 2008 + in NetAddr::IP::Util v0.19 + updated test for ENDIANess in siteconf + + add test in inet_aton to detect overange IP dot quad values + missed by some broken Socket implementations + i.e. 256.1.1.1 would fail to return undef + +NOTE: Versions 4.008 and 4.009 had limited release to tester only + and were not uploaded to CPAN. All of the v4.008, 4.009 + changes are incorporated in v4.010 + +4.009 Tue Sep 2 19:09:57 PDT 2008 + In NetAddr::IP::Lite v1.07, + in the off chance that NetAddr::IP::Lite objects are created + and the caller later loads NetAddr::IP and expects to use + those objects, let the AUTOLOAD routine find and redirect + NetAddr::IP::Lite method and subroutine calles to NetAddr::IP. + + updated Lite/t/v4-wnew.t so that non-existent + domains are "really" not there + +4.008 Sat Jun 7 14:01:55 PDT 2008 + inherit method "new_from_aton" from NetAddr::IP::Lite + add related documentation + + Inherited methods from Lite.pm updated as follows: + + comparisons of the form <, >, <=, >= + 10.0.0.0/24 {operator} 10.0.0.0/16 + return now return the comparision of the cidr value + when the address portion is equal. +NOTE: this comparison returns the comparison of the NUMERIC + value of the CIDR. This produces the counter intuitive result + that /24 > /16. There is logic to this, really! For proper + operation of commands like "Compact" and "Coalesce", lists of + netaddr objects must sort in ascending order. However, this + conflicts with the requirement for larger netblocks to sort + FIRST so as to include smaller ones. This logic extends to + any requirement for a sort of netaddr objects. It should be + further noted that the mixing of netaddr objects with varying + IP addresses and CIDR allocations can lead to unexpected + results since the comparisons done first on the IP portion + and then on the CIDR portion. The documentation has been + updated appropriately. + Thanks to Peter DeVries for spotting this discrepancy + 4.007 Wed Jun 6 16:41:11 VET 2007 Update copyright dates - Wed Jun 6 21:50:20 VET 2007 - Added patch from Daryl O'Shea to remove remaining $`. Thanks Daryl. 4.006 Wed Jun 6 15:58:04 VET 2007 @@ -12,7 +58,7 @@ http://issues.apache.org/SpamAssassin/show_bug.cgi?id=5312 4.004 Wed Aug 16 16:01:54 PDT 2006 - update to include/exclude files in corrupted distro + update to include/exclude files in corrupted distro 4.003 Sun Aug 6 10:48:25 PDT 2006 correct SYNOPSIS documentation @@ -29,10 +75,10 @@ remove unused global variable $isV6 update Lite.pm to v1.02 - $isV6 global converted to a lexical variable within sub "_xnew" - $Class global removed and replaced by calls to UNIVERSAL::isa - Thanks to julian@mehnle.net for spotting problems related to - using the Lite.pm with mod_perl + $isV6 global converted to a lexical variable within sub "_xnew" + $Class global removed and replaced by calls to UNIVERSAL::isa + Thanks to julian@mehnle.net for spotting problems related to + using the Lite.pm with mod_perl 4.001 Thu Jul 6 14:09:01 PDT 2006 various bug fixes courtesy of Luis Munoz: diff --git a/IP.pm b/IP.pm index 52c7777..fac7c59 100644 --- a/IP.pm +++ b/IP.pm @@ -4,8 +4,8 @@ use strict; #use diagnostics; -use NetAddr::IP::Lite 1.02 qw(Zero Ones V4mask V4net); -use NetAddr::IP::Util qw( +use NetAddr::IP::Lite 1.07 qw(Zero Ones V4mask V4net); +use NetAddr::IP::Util 1.04 qw( sub128 inet_aton inet_any2n @@ -31,7 +31,7 @@ @ISA = qw(Exporter NetAddr::IP::Lite); -$VERSION = do { sprintf " %d.%03d", (q$Revision: 4.7 $ =~ /\d+/g) }; +$VERSION = do { sprintf " %d.%03d", (q$Revision: 4.10 $ =~ /\d+/g) }; =pod @@ -48,12 +48,14 @@ Ones V4mask V4net - :aton + :aton DEPRECATED :old_storable :old_nth ); my $ip = new NetAddr::IP 'loopback'; + or + my $ip = new_from_aton NetAddr::IP::Lite (inet_aton('127.0.0.1')); print "The address is ", $ip->addr, " with mask ", $ip->mask, "\n" ; @@ -72,11 +74,15 @@ ::FFFF:FFFF = V4net(); -* To accept addresses in the format as returned by inet_aton, invoke the module -as: +###### DEPRECATED, will be remove in version 5 ############ + + * To accept addresses in the format as returned by + inet_aton, invoke the module as: use NetAddr::IP qw(:aton); +###### USE new_from_aton instead ########################## + * To enable usage of legacy data files containing NetAddr::IP objects stored using the L module. @@ -184,8 +190,17 @@ Internally, all network objects are represented in 128 bit format. The numeric representation of the network is compared through the corresponding operation. Comparisons are tried first on the address portion -of the object and if that is equal then the cidr portion of the masks are -compared. +of the object and if that is equal then the NUMERIC cidr portion of the +masks are compared. This leads to the counterintuitive result that + + /24 > /16 + +Comparision should not be done on netaddr objects with different CIDR as +this may produce indeterminate - unexpected results, +rather the determination of which netblock is larger or smaller should be +done by comparing + + $ip1->masklen <=> $ip2->masklen =item B @@ -342,10 +357,16 @@ =item C<-Enew6([$addr, [ $mask]])> -These methods creates a new address with the supplied address in +=item C<-Enew_from_aton($netaddr)> + +The first two methods create a new address with the supplied address in C<$addr> and an optional netmask C<$mask>, which can be omitted to get a /32 or /128 netmask for IPv4 / IPv6 addresses respectively +B takes a packed IPv4 address and assumes a /32 mask. This +function replaces the DEPRECATED :aton functionality which is fundamentally +broken. + C<-Enew6> marks the address as being in ipV6 address space even if the format would suggest otherwise. @@ -621,7 +642,42 @@ return _compV6($addr); } -=pod +=item C<-Efull()> + +Returns the address part in FULL notation for +ipV4 and ipV6 respectively. + + i.e. for ipV4 + 0000:0000:0000:0000:0000:0000:127.0.0.1 + + for ipV6 + 0000:0000:0000:0000:0000:0000:0000:0000 + +To force ipV4 addresses into full ipV6 format use: + +=item C<-Efull6()> + +Returns the address part in FULL ipV6 notation + +=cut + +sub full($) { + if (! $_[0]->{isv6} && isIPv4($_[0]->{addr})) { + my @hex = (unpack("n8",$_[0]->{addr})); + $hex[9] = $hex[7] & 0xff; + $hex[8] = $hex[7] >> 8; + $hex[7] = $hex[6] & 0xff; + $hex[6] >>= 8; + return sprintf("%04X:%04X:%04X:%04X:%04X:%04X:%d.%d.%d.%d",@hex); + } else { + &full6; + } +} + +sub full6($) { + my @hex = (unpack("n8",$_[0]->{addr})); + return sprintf("%04X:%04X:%04X:%04X:%04X:%04X:%04X:%04X",@hex); +} =item C<$me-Econtains($other)> @@ -734,12 +790,17 @@ =cut sub compactref($) { - my @r = sort @{$_[0]} - or return []; - return [] unless @r; - foreach(0..$#r) { - $r[$_]->{addr} = $r[$_]->network->{addr}; +# my @r = sort { NetAddr::IP::Lite::comp_addr_mask($a,$b) } @{$_[0]} # use overload 'cmp' function +# or return []; +# return [] unless @r; + + return [] unless (my @unr = @{$_[0]}); + + foreach(0..$#unr) { + $unr[$_]->{addr} = $unr[$_]->network->{addr}; } + my @r = sort @unr; + my $changed; do { $changed = 0; @@ -1059,7 +1120,7 @@ =head1 HISTORY -$Id: IP.pm,v 4.7 2007/06/06 20:43:38 luisemunoz Exp $ +$Id: IP.pm,v 4.8 2008/06/07 20:43:38 luisemunoz Exp $ =over @@ -1691,6 +1752,33 @@ Additional methods added to force operations into ipV6 space even when ipV4 notation is used. +=item 4.05 + + NetAddr::IP :aton DEPRECATED ! + new method "new_from_aton" + +THE FOLLOWING CHANGES MAY BREAK SOME CODE ! + + Inherited methods from Lite.pm updated as follows: + + comparisons of the form <, >, <=, >= + + 10.0.0.0/24 {operator} 10.0.0.0/16 + + return now return the comparision of the cidr value + when the address portion is equal. + Thanks to Peter DeVries for spotting this bug. + + ... and leading us to discover that this next fix is required + + comparisons of the form <=>, cmp + now return the correct value 1, or -1 + when the address portion is equal and the CIDR value is not + i.e. where /16 is > /24, etc... + + This is the OPPOSITE of the previous return values for + comparison of the CIDR portion of the address object + =back =head1 AUTHORS @@ -1706,7 +1794,7 @@ =head1 LICENSE This software is (c) Luis E. Muñoz, 1999 - 2007, and (c) Michael -Robinton, 2006 - 2007. It can be used under the terms of the Perl +Robinton, 2006 - 2008. It can be used under the terms of the Perl artistic license provided that proper credit for the work of the authors is preserved in the form of this copyright notice and license for this module. diff --git a/Lite/Changes b/Lite/Changes index 23e835e..6802eb9 100644 --- a/Lite/Changes +++ b/Lite/Changes @@ -1,5 +1,47 @@ Revision history for Perl extension NetAddr::IP::Lite +1.08 Sat Sep 27 12:27:28 PDT 2008 + in Util v0.19 + updated test for ENDIANess in siteconf + + add test in inet_aton to detect overange IP dot quad values + missed by some broken Socket implementations + i.e. 256.1.1.1 + +1.07 Tue Sep 2 19:09:57 PDT 2008 + in the off chance that NetAddr::IP::Lite objects are created + and the caller later loads NetAddr::IP and expects to use + those objects, let the AUTOLOAD routine find and redirect + NetAddr::IP::Lite method and subroutine calles to NetAddr::IP. + + updated t/v4-wnew.t so that non-existent + domains are "really" not there + +1.06 Sat Jun 7 12:57:18 PDT 2008 + add method "new_from_aton" and related documentation + + comparisons of the form <, >, <=, >= + 10.0.0.0/24 {operator} 10.0.0.0/16 + return now return the comparision of the cidr value + when the address portion is equal. +NOTE: this comparison returns the comparison of the NUMERIC + value of the CIDR. This produces the counter intuitive result + that /24 > /16. There is logic to this, really! For proper + operation of commands like "Compact" and "Coalesce", lists of + netaddr objects must sort in ascending order. However, this + conflicts with the requirement for larger netblocks to sort + FIRST so as to include smaller ones. This logic extends to + any requirement for a sort of netaddr objects. It should be + further noted that the mixing of netaddr objects with varying + IP addresses and CIDR allocations can lead to unexpected + results since the comparisons done first on the IP portion + and then on the CIDR portion. The documentation has been + updated appropriately. + Thanks to Peter DeVries for spotting this discrepancy + +1.05 undocumented +1.04 undocumented + 1.03 Sun Aug 6 10:48:25 PDT 2006 update Util.pm v0.18 documentation @@ -23,10 +65,10 @@ 0.12 Sun Jun 25 16:13:00 PDT 2006 imported missing 'bcd2bin' - fixed Util->new() issues with long digit strings + fixed Util->new() issues with long digit strings ->new('::fffff') and non hex digits ->new('::foo'). - Thanks to Radoslaw Zielinski - for spotting these 3 bugs + Thanks to Radoslaw Zielinski + for spotting these 3 bugs 0.11 Wed Jun 14 14:53:21 PDT 2006 add 'sub new6' and related functionality to methods diff --git a/Lite/Lite.pm b/Lite/Lite.pm index fd049de..22c7646 100644 --- a/Lite/Lite.pm +++ b/Lite/Lite.pm @@ -6,7 +6,7 @@ use strict; #use diagnostics; #use warnings; -use NetAddr::IP::Util 0.17 qw( +use NetAddr::IP::Util 1.04 qw( inet_any2n addconst sub128 @@ -25,9 +25,9 @@ mask4to6 ipv4to6 ); -use vars qw(@ISA @EXPORT_OK $VERSION $Accept_Binary_IP $Old_nth); +use vars qw(@ISA @EXPORT_OK $VERSION $Accept_Binary_IP $Old_nth $AUTOLOAD); -$VERSION = do { my @r = (q$Revision: 1.5 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +$VERSION = do { my @r = (q$Revision: 1.8 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; require Exporter; @@ -53,11 +53,13 @@ Ones V4mask V4net - :aton + :aton DEPRECATED ! :old_nth ); my $ip = new NetAddr::IP::Lite '127.0.0.1'; + or from a packed IPv4 address + my $ip = new_from_aton NetAddr::IP::Lite (inet_aton('127.0.0.1')); print "The address is ", $ip->addr, " with mask ", $ip->mask, "\n" ; @@ -106,6 +108,49 @@ The supported operations are described below: +=cut + +# in the off chance that NetAddr::IP::Lite objects are created +# and the caller later loads NetAddr::IP and expects to use +# those objects, let the AUTOLOAD routine find and redirect +# NetAddr::IP::Lite method and subroutine calles to NetAddr::IP. +# + +my $parent = 'NetAddr::IP'; + +# test function +# +# input: subroutine name in NetAddr::IP +# output: t/f if sub name exists in NetAddr::IP namespace +# +#sub sub_exists { +# my $other = $parent .'::'; +# return exists ${$other}{$_[0]}; +#} + +sub DESTROY {}; + +sub AUTOLOAD { + no strict; + my ($pkg,$func) = ($AUTOLOAD =~ /(.*)::([^:]+)$/); + my $other = $parent .'::'; + + if ($pkg =~ /^$other/o && exists ${$other}{$func}) { + $other .= $func; + goto &{$other}; + } + + my @stack = caller(0); + + if ( $pkg eq ref $_[0] ) { + $other = qq|Can't locate object method "$func" via|; + } + else { + $other = qq|Undefined subroutine \&$AUTOLOAD not found in|; + } + die $other . qq| package "$parent" or "$pkg" (did you forgot to load a module?) at $stack[1] line $stack[2].\n|; +} + =head2 Overloaded Operators =cut @@ -159,19 +204,19 @@ }, '>' => sub { - return &comp_addr > 0 ? 1 : 0; + return &comp_addr_mask > 0 ? 1 : 0; }, '<' => sub { - return &comp_addr < 0 ? 1 : 0; + return &comp_addr_mask < 0 ? 1 : 0; }, '>=' => sub { - return &comp_addr < 0 ? 0 : 1; + return &comp_addr_mask < 0 ? 0 : 1; }, '<=' => sub { - return &comp_addr > 0 ? 0 : 1; + return &comp_addr_mask > 0 ? 0 : 1; }, '<=>' => \&comp_addr_mask, @@ -187,11 +232,11 @@ return hasbits($rv) ? 1 : 0; } -sub comp_addr { - my($c,$rv) = sub128($_[0]->{addr},$_[1]->{addr}); - return -1 unless $c; - return hasbits($rv) ? 1 : 0; -} +#sub comp_addr { +# my($c,$rv) = sub128($_[0]->{addr},$_[1]->{addr}); +# return -1 unless $c; +# return hasbits($rv) ? 1 : 0; +#} =pod @@ -248,10 +293,19 @@ =item B, E, E=, E=, E=E and C> Internally, all network objects are represented in 128 bit format. -The numeric representation of the network is compared through the +The numeric representation of the network is compared through the corresponding operation. Comparisons are tried first on the address portion -of the object and if that is equal then the cidr portion of the masks are -compared. +of the object and if that is equal then the NUMERIC cidr portion of the +masks are compared. This leads to the counterintuitive result that + + /24 > /16 + +Comparision should not be done on netaddr objects with different CIDR as +this may produce indeterminate - unexpected results, +rather the determination of which netblock is larger or smaller should be +done by comparing + + $ip1->masklen <=> $ip2->masklen =item B @@ -382,10 +436,16 @@ =item C<-Enew6([$addr, [ $mask]])> -These methods creates a new address with the supplied address in +=item C<-Enew_from_aton($netaddr)> + +The first two methods create a new address with the supplied address in C<$addr> and an optional netmask C<$mask>, which can be omitted to get a /32 or /128 netmask for IPv4 / IPv6 addresses respectively +B takes a packed IPv4 address and assumes a /32 mask. This +function replaces the DEPRECATED :aton functionality which is fundamentally +broken. + C<-Enew6> marks the address as being in ipV6 address space even if the format would suggest otherwise. @@ -410,10 +470,13 @@ specified for them. The default is to not attempt to recognize this format, as it seems to be seldom used. +###### DEPRECATED, will be remove in version 5 ############ To accept addresses in that format, invoke the module as in use NetAddr::IP::Lite ':aton' +###### USE new_from_aton instead ########################## + If called with no arguments, 'default' is assumed. C<$addr> can be any of the following and possibly more... @@ -500,6 +563,21 @@ goto &_xnew; } +sub new_from_aton($$) { + my $proto = shift; + my $class = ref $proto || $proto || __PACKAGE__; + my $ip = shift; + return undef unless defined $ip; + my $addrlen = length($ip); + return undef unless $addrlen == 4; + my $self = { + addr => ipv4to6($ip), + mask => &Ones, + isv6 => 0, + }; + return bless $self, $class; +} + sub new6($;$$) { unshift @_, 1; goto &_xnew; @@ -1032,7 +1110,7 @@ Ones V4mask V4net - :aton + :aton DEPRECATED :old_nth =head1 AUTHOR @@ -1047,7 +1125,9 @@ =head1 LICENSE -This software is (c) Luis E. Mu�oz, 1999 - 2005, and (c) Michael Robinton, 2006. + This software is (c) Luis E. Mu�oz, 1999 - 2005 + and (c) Michael Robinton, 2006 - 2008. + 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. diff --git a/Lite/README b/Lite/README index f03dea1..8d08793 100644 --- a/Lite/README +++ b/Lite/README @@ -7,11 +7,13 @@ Ones V4mask V4net - :aton + :aton DEPRECATED ! :old_nth ); my $ip = new NetAddr::IP::Lite '127.0.0.1'; + or from a packed IPv4 address + my $ip = new_from_aton NetAddr::IP::Lite (inet_aton('127.0.0.1')); print "The address is ", $ip->addr, " with mask ", $ip->mask, "\n" ; @@ -59,6 +61,7 @@ The supported operations are described below: Overloaded Operators + Assignment ("=") Has been optimized to copy one NetAddr::IP::Lite object to another very quickly. @@ -66,7 +69,8 @@ "->copy()" The assignment ("=") operation is only put in to operation when the copied object is further mutated by another overloaded operation. - See overload SPECIAL SYMBOLS FOR "use overload" for details. + See the overload manpage SPECIAL SYMBOLS FOR "use overload" for + details. "->copy()" actually creates a new object when called. @@ -104,8 +108,18 @@ Internally, all network objects are represented in 128 bit format. The numeric representation of the network is compared through the corresponding operation. Comparisons are tried first on the address - portion of the object and if that is equal then the cidr portion of - the masks are compared. + portion of the object and if that is equal then the NUMERIC cidr + portion of the masks are compared. This leads to the + counterintuitive result that + + /24 > /16 + + Comparision should not be done on netaddr objects with different + CIDR as this may produce indeterminate - unexpected results, rather + the determination of which netblock is larger or smaller should be + done by comparing + + $ip1->masklen <=> $ip2->masklen Addition of a constant Adding a constant to a NetAddr::IP::Lite object changes its address @@ -135,11 +149,17 @@ opposite of auto-incrementing it, as you would expect. Methods + "->new([$addr, [ $mask|IPv6 ]])" "->new6([$addr, [ $mask]])" - These methods creates a new address with the supplied address in - $addr and an optional netmask $mask, which can be omitted to get a - /32 or /128 netmask for IPv4 / IPv6 addresses respectively + "->new_from_aton($netaddr)" + The first two methods create a new address with the supplied address + in "$addr" and an optional netmask "$mask", which can be omitted to + get a /32 or /128 netmask for IPv4 / IPv6 addresses respectively + + new_from_aton takes a packed IPv4 address and assumes a /32 mask. + This function replaces the DEPRECATED :aton functionality which is + fundamentally broken. "->new6" marks the address as being in ipV6 address space even if the format would suggest otherwise. @@ -153,7 +173,7 @@ See "STRINGIFICATION" below. - $addr can be almost anything that can be resolved to an IP address + "$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. @@ -165,13 +185,16 @@ specified for them. The default is to not attempt to recognize this format, as it seems to be seldom used. - To accept addresses in that format, invoke the module as in + ###### DEPRECATED, will be remove in version 5 ############ To + accept addresses in that format, invoke the module as in use NetAddr::IP::Lite ':aton' + ###### USE new_from_aton instead ########################## + If called with no arguments, 'default' is assumed. - $addr can be any of the following and possibly more... + "$addr" can be any of the following and possibly more... n.n n.n/mm @@ -265,14 +288,14 @@ subnet. "$me->contains($other)" - Returns true when $me completely contains $other. False is returned - otherwise and "undef" is returned if $me and $other are not both - "NetAddr::IP::Lite" objects. + Returns true when "$me" completely contains "$other". False is + returned otherwise and "undef" is returned if "$me" and "$other" are + not both "NetAddr::IP::Lite" objects. "$me->within($other)" - The complement of "->contains()". Returns true when $me is - completely contained within $other, undef if $me and $other are not - both "NetAddr::IP::Lite" objects. + The complement of "->contains()". Returns true when "$me" is + completely contained within "$other", undef if "$me" and "$other" + are not both "NetAddr::IP::Lite" objects. "->first()" Returns a new object representing the first usable IP address within @@ -285,7 +308,7 @@ "->nth($index)" Returns a new object representing the *n*-th usable IP address within the subnet (ie, the *n*-th host address). If no address is - available (for example, when the network is too small for $index + available (for example, when the network is too small for "$index" hosts), "undef" is returned. Version 4.00 of NetAddr::IP and version 1.00 of NetAddr::IP::Lite @@ -340,7 +363,7 @@ Ones V4mask V4net - :aton + :aton DEPRECATED :old_nth AUTHOR @@ -352,11 +375,12 @@ by using it you accept any and all the liability. LICENSE - This software is (c) Luis E. Mu�oz, 1999 - 2005, and (c) Michael - Robinton, 2006. 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. Mu�oz, 1999 - 2005 + and (c) Michael Robinton, 2006 - 2008. + + 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), NetAddr::IP(3), NetAddr::IP::Util(3) diff --git a/Lite/Util/Changes b/Lite/Util/Changes index abee5d2..ba46bc6 100644 --- a/Lite/Util/Changes +++ b/Lite/Util/Changes @@ -1,5 +1,12 @@ Revision history for Perl extension NetAddr::IP::Util +0.19 Sat Sep 27 13:36:58 PDT 2008 + updated test for ENDIANess in siteconf + + add test in inet_aton to detect overange IP dot quad values + missed by some broken Socket implementations + i.e. 256.1.1.1 + 0.18 Sun Aug 6 10:48:25 PDT 2006 correct shiftleft documentation correct mask4to6 documentation diff --git a/Lite/Util/Util.pm b/Lite/Util/Util.pm index 48122df..225b3ed 100644 --- a/Lite/Util/Util.pm +++ b/Lite/Util/Util.pm @@ -13,7 +13,7 @@ @ISA = qw(Exporter DynaLoader); -$VERSION = do { my @r = (q$Revision: 1.5 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +$VERSION = do { my @r = (q$Revision: 1.9 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; my @export_ok = qw( inet_aton @@ -104,14 +104,31 @@ require NetAddr::IP::UtilPP; import NetAddr::IP::UtilPP qw( :all ); require Socket; - import Socket qw(inet_ntoa inet_aton); + import Socket qw(inet_ntoa); + *yinet_aton = \&Socket::inet_aton; $Mode = 'Pure Perl'; } else { $Mode = 'CC XS'; } +# if Socket lib is broken in some way, check for overange values +# +my $overange = yinet_aton('256.1') ? 1:0; + sub mode() { $Mode }; + +sub inet_aton { + if (! $overange || $_[0] =~ /[^0-9\.]/) { # hostname + return &yinet_aton; + } + my @dq = split(/\./,$_[0]); + foreach (@dq) { + return undef if $_ > 255; + } + return &yinet_aton; +} + sub DESTROY {}; 1; @@ -263,9 +280,9 @@ sub ipv6_aton { my($ipv6) = @_; return undef unless $ipv6; - if ($ipv6 =~ /^(.*):(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/) { # mixed hex, dot-quad - return undef if $2 > 255 || $3 > 255 || $4 > 255 || $5 > 255; - $ipv6 = sprintf("%s:%X%02X:%X%02X",$1,$2,$3,$4,$5); # convert to pure hex + if ($ipv6 =~ /:(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/) { # mixed hex, dot-quad + return undef if $1 > 255 || $2 > 255 || $3 > 255 || $4 > 255; + $ipv6 = sprintf("%s:%X%02X:%X%02X",$`,$1,$2,$3,$4); # convert to pure hex } my $c; return undef if diff --git a/Lite/Util/siteconf b/Lite/Util/siteconf index 3316dc8..e4fa466 100755 --- a/Lite/Util/siteconf +++ b/Lite/Util/siteconf @@ -1716,20 +1716,26 @@ #include #include "localStuff.h" -typedef union -{ - int16_t i; - char c[2]; -} endian; - int main() { + union { + short s; + char c[sizeof(short)]; + } e; - endian e; - - e.i = 1; - return - (int)e.c[0]; + e.s = 0x0102; + if (sizeof (short) == 2) + { + if (e.c[0] == 1 && e.c[1] == 2) + return 0; /* BIG ENDIAN */ + else + { + if (e.c[0] == 2 && e.c[1] == 1) + return 1; /* LITTLE ENDIAN */ + } + return -1; /* UNKNOWN */ + } } _ACEOF @@ -1743,7 +1749,7 @@ (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 - };} && [ $ac_status -ne 1 ]; then + };} && ! [ $ac_status -lt 0 ]; then if [ $ac_status -eq 0 ]; then cat >>localStuff.h <<\_ACEOF #define host_is_BIG_ENDIAN diff --git a/Lite/Util/xs_include/miniSocket.inc b/Lite/Util/xs_include/miniSocket.inc index eb9b26d..079cf82 100644 --- a/Lite/Util/xs_include/miniSocket.inc +++ b/Lite/Util/xs_include/miniSocket.inc @@ -70,7 +70,7 @@ #include void -inet_aton(host) +yinet_aton(host) char * host CODE: { diff --git a/Lite/t/v4-new.t b/Lite/t/v4-new.t index e629f89..263098b 100644 --- a/Lite/t/v4-new.t +++ b/Lite/t/v4-new.t @@ -42,10 +42,14 @@ plan tests => (4 * scalar @a * scalar @m) + 4; -ok(! defined NetAddr::IP::Lite->new('256.1.1.1'), "Invalid IP returns undef"); -ok(! defined NetAddr::IP::Lite->new('256.256.1.1'), "Invalid IP returns undef"); -ok(! defined NetAddr::IP::Lite->new('256.256.256.1'), "Invalid IP returns undef"); -ok(! defined NetAddr::IP::Lite->new('256.256.256.256'), "Invalid IP returns undef"); +foreach my $invalid qw( + 256.1.1.1 + 256.256.1.1 + 256.256.256.1 + 256.256.256.256 +) { + ok (! defined NetAddr::IP::Lite->new($invalid), "Invalid IP $invalid returns undef"); +} for my $a (@a) { for my $m (@m) { @@ -61,4 +65,3 @@ }; } } - diff --git a/Lite/t/v4-new_from_aton.t b/Lite/t/v4-new_from_aton.t new file mode 100644 index 0000000..39801b6 --- /dev/null +++ b/Lite/t/v4-new_from_aton.t @@ -0,0 +1,27 @@ +use NetAddr::IP::Util qw( + inet_aton + ipv6_n2x +); +use NetAddr::IP::Lite; +use Test::More; +use diagnostics; + +plan tests => 12 + 3; + +ok(! defined NetAddr::IP::Lite->new_from_aton(''), "blank netaddr returns undef"); +ok(! defined NetAddr::IP::Lite->new_from_aton(undef), "undefined netaddr returns undef"); +ok(! defined NetAddr::IP::Lite->new_from_aton('1.2.3.4'), "Dot Quad IP returns undef"); + +foreach (qw( + 0.0.0.0 + 127.0.0.1 + 255.255.255.255 +)) { + my $naddr = inet_aton($_); + my $ip = new_from_aton NetAddr::IP::Lite($naddr); + ok(defined $ip, "$_ is defined"); + ok($ip->bits == 32, "$_ is 32 bits wide"); + ok($ip->mask eq '255.255.255.255', "mask is all ones"); + ok($ip->version == 4, "version is IPv4"); +} + diff --git a/Lite/t/v4-wnew.t b/Lite/t/v4-wnew.t index 22facb9..92f8aaf 100644 --- a/Lite/t/v4-wnew.t +++ b/Lite/t/v4-wnew.t @@ -2,8 +2,8 @@ use NetAddr::IP::Lite; my @good = (qw(default any broadcast loopback)); -my @bad = map { ("$_.neveranydomainlikethis", - "nohostlikethis.$_") } @good; +my @bad = map { ("$_.neveranydomainlikethis.cpan.org", + "nohostlikethis.${_}.cpan.org") } @good; ok(defined NetAddr::IP::Lite->new($_), "defined ->new($_)") for @good; diff --git a/MANIFEST b/MANIFEST index 0545e59..e56355e 100644 --- a/MANIFEST +++ b/MANIFEST @@ -42,6 +42,7 @@ Lite/t/v4-contains.t Lite/t/v4-last.t Lite/t/v4-new-first.t +Lite/t/v4-new_from_aton.t Lite/t/v4-new.t Lite/t/v4-num.t Lite/t/v4-numeric.t @@ -95,6 +96,8 @@ MANIFEST This list of files MANIFEST.SKIP README +t/full.t +t/full6.t t/imhoff.t t/loops.t t/masklen.t diff --git a/META.yml b/META.yml index 7c8eb84..c188cf4 100644 --- a/META.yml +++ b/META.yml @@ -1,11 +1,14 @@ -# http://module-build.sourceforge.net/META-spec.html -#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# -name: NetAddr-IP -version: 4.007 -version_from: IP.pm -installdirs: site -requires: +--- #YAML:1.0 +name: NetAddr-IP +version: 4.010 +abstract: Manages IPv4 and IPv6 addresses and subnets +license: ~ +author: + - Luis E. Muñoz +generated_by: ExtUtils::MakeMaker version 6.42 +distribution_type: module +requires: Test::More: 0 - -distribution_type: module -generated_by: ExtUtils::MakeMaker version 6.30 +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.3.html + version: 1.3 diff --git a/Makefile.PL b/Makefile.PL index 424780d..ef2a761 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -75,6 +75,12 @@ use NetAddr::IP ':aton'; +Versions before 4.08 recognized the above syntax. This behavior is +fundamentally broken, is DEPRECATED and WILL BE REMOVED in version 5.0 +Use this method to create new objects from 'aton's + + \$ip = new_from_aton NetAddr::IP(inet_aton('1.2.3.4')) + EOF ; diff --git a/t/full.t b/t/full.t new file mode 100644 index 0000000..d3011e7 --- /dev/null +++ b/t/full.t @@ -0,0 +1,25 @@ +use Test::More; + +# $Id: short.t,v 1.1.1.1 2006/08/14 15:36:06 lem Exp $ + +my %cases = +( + '127.1' => '0000:0000:0000:0000:0000:0000:127.0.0.1', + '123.23.4.210' => '0000:0000:0000:0000:0000:0000:123.23.4.210', + 'DEAD:BEEF::1' => 'dead:beef:0000:0000:0000:0000:0000:0001', + '1:2:3:4:5:6:7:8' => '0001:0002:0003:0004:0005:0006:0007:0008', + '1234:5678:90AB:CDEF:0123:4567:890A:BCDE' => '1234:5678:90ab:cdef:0123:4567:890a:bcde', +); + +my $tests = keys %cases; +plan tests => 1 + $tests; + +SKIP: { + use_ok('NetAddr::IP') or skip "Failed to load NetAddr::IP", $tests; + for my $c (sort keys %cases) + { + my $ip = new NetAddr::IP $c; + my $rv = lc $ip->full; + is($rv, $cases{$c}, "full($c) returns $rv"); + } +} diff --git a/t/full6.t b/t/full6.t new file mode 100644 index 0000000..3934731 --- /dev/null +++ b/t/full6.t @@ -0,0 +1,25 @@ +use Test::More; + +# $Id: short.t,v 1.1.1.1 2006/08/14 15:36:06 lem Exp $ + +my %cases = +( + '127.1' => '0000:0000:0000:0000:0000:0000:7f00:0001', + '123.23.4.210' => '0000:0000:0000:0000:0000:0000:7b17:04d2', + 'DEAD:BEEF::1' => 'dead:beef:0000:0000:0000:0000:0000:0001', + '1:2:3:4:5:6:7:8' => '0001:0002:0003:0004:0005:0006:0007:0008', + '1234:5678:90AB:CDEF:0123:4567:890A:BCDE' => '1234:5678:90ab:cdef:0123:4567:890a:bcde', +); + +my $tests = keys %cases; +plan tests => 1 + $tests; + +SKIP: { + use_ok('NetAddr::IP') or skip "Failed to load NetAddr::IP", $tests; + for my $c (sort keys %cases) + { + my $ip = new NetAddr::IP $c; + my $rv = lc $ip->full6; + is($rv, $cases{$c}, "full6($c ) returns $rv"); + } +} diff --git a/t/relops.t b/t/relops.t index a2761c5..8d392c0 100644 --- a/t/relops.t +++ b/t/relops.t @@ -1,7 +1,5 @@ use NetAddr::IP; -# $Id: relops.t,v 1.1.1.1 2006/08/14 15:36:06 lem Exp $ - BEGIN { @gt = ( [ '255.255.255.255/32', '0.0.0.0/0' ], @@ -38,22 +36,22 @@ use Test::More tests => @gt + @ngt + (2 * @cmp); for my $a (@gt) { - $a_ip = new NetAddr::IP $a->[0]; - $b_ip = new NetAddr::IP $a->[1]; + $a_ip = new NetAddr::IP::Lite $a->[0]; + $b_ip = new NetAddr::IP::Lite $a->[1]; ok($a_ip > $b_ip, "$a_ip > $b_ip"); } for my $a (@ngt) { - $a_ip = new NetAddr::IP $a->[0]; - $b_ip = new NetAddr::IP $a->[1]; + $a_ip = new NetAddr::IP::Lite $a->[0]; + $b_ip = new NetAddr::IP::Lite $a->[1]; ok(!($a_ip > $b_ip), "$a_ip !> $b_ip"); } for $a (@cmp) { - $a_ip = new NetAddr::IP $a->[0]; - $b_ip = new NetAddr::IP $a->[1]; + $a_ip = new NetAddr::IP::Lite $a->[0]; + $b_ip = new NetAddr::IP::Lite $a->[1]; is($a_ip <=> $b_ip, $a->[2], "$a_ip <=> $b_ip is $a->[2]"); is($a_ip cmp $b_ip, $a->[2], "$a_ip cmp $b_ip is $a->[2]");