diff --git a/Changes b/Changes index d304d1d..cbd427b 100644 --- a/Changes +++ b/Changes @@ -1,9 +1,50 @@ Revision history for Perl extension NetAddr::IP +4.017 Sun Nov 23 19:32:59 PST 2008 + Extended the capability of 'splitref' to allow splitting of + objects into multiple pieces with differing CIDR masks. + Returned object list can be split from bottom to top + or from top to bottom depending on which method is called + + split, rsplit, splitref, rsplitref + + Thanks to kashmish for the idea on + improving functionality of 'split'. + + Thanks to Rob Riepel + for a faster and more accurate _compV6 function. + + in Util_PP v1.5 + correct documentation error + add threads reporting (empty string) + + in Util v1.25 + add threads reporting that returns a comma separated + string of build headers. + + added what is hopefully thread safe operation via + serializaton. Must be invoked by "--with-threads" + + in Lite v1.12 + corrected missing Zeros subroutine + Zeros and Zero both will work + + in Lite v1.12 + added minus (-) overloading to allow the subtraction + of two NetAddr::IP objects to get the difference between + the object->{addr}'s as a numeric value + Thanks to Rob Riepel + for the initial code and inspiration for this enhancement + +4.016 Wed Nov 5 18:13:20 PST 2008 + in Util/ version 1.24 + Clean up Makefile.PL to check actual required link + libraries against the perl build for consistency + 4.015 Sun Nov 2 10:10:38 PST 2008 - in Util v1.23 add missing headers in configure and localconf.h + in Util v1.23 add missing headers in configure and localconf.h for Solaris inet_xton - thanks to Karl Bunch for spotting the bug. + thanks to Karl Bunch for spotting the bug. 4.014 Sat Nov 1 15:13:48 PST 2008 in Lite.pm v1.11, add test for characters not allowed by diff --git a/IP.pm b/IP.pm index f16beb7..8f377ea 100644 --- a/IP.pm +++ b/IP.pm @@ -4,8 +4,8 @@ use strict; #use diagnostics; -use NetAddr::IP::Lite 1.11 qw(Zero Ones V4mask V4net); -use NetAddr::IP::Util 1.22 qw( +use NetAddr::IP::Lite 1.12 qw(Zero Zeros Ones V4mask V4net); +use NetAddr::IP::Util 1.25 qw( sub128 inet_aton inet_any2n @@ -22,16 +22,19 @@ use vars qw( @EXPORT_OK + @EXPORT_FAIL @ISA $VERSION + $_netlimit ); require Exporter; -@EXPORT_OK = qw(Compact Coalesce Zero Ones V4mask V4net); +@EXPORT_OK = qw(Compact Coalesce Zero Zeros Ones V4mask V4net netlimit); +@EXPORT_FAIL = qw($_netlimit); @ISA = qw(Exporter NetAddr::IP::Lite); -$VERSION = do { sprintf " %d.%03d", (q$Revision: 4.15 $ =~ /\d+/g) }; +$VERSION = do { sprintf " %d.%03d", (q$Revision: 4.17 $ =~ /\d+/g) }; =pod @@ -44,10 +47,11 @@ use NetAddr::IP qw( Compact Coalesce - Zero + Zeros Ones V4mask V4net + netlimit :aton DEPRECATED :old_storable :old_nth @@ -71,7 +75,7 @@ * The following four functions return ipV6 representations of: :: = Zeros(); - FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF: = Ones(); + FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF = Ones(); FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:: = V4mask(); ::FFFF:FFFF = V4net(); @@ -90,7 +94,7 @@ use NetAddr::IP qw(:old_storable); -* To compact many smaller subnets (see: C<$me-Ecompact($addr1, $addr2,...)> +* To compact many smaller subnets (see: C<$me-Ecompact($addr1,$addr2,...)> @compacted_object_list = Compact(@object_list) @@ -100,6 +104,33 @@ $arrayref = Coalesce($masklen, $number, @list_of_subnets) +* To set a limit on the size of B processed or returned by +NetAddr::IP. +Set the maximum number of nets beyond which NetAddr::IP will return and +error as a power of 2 (default 16 or 65536 nets). Each 2**16 consumes approximately 4 megs of +memory. A 2**20 consumes 64 megs of memory, A 2**24 consumes 1 gigabyte of +memory. + + use NetAddr::IP qw(netlimit); + netlimit 20; + +The maximum B allowed is a 2**24. Attempts to set limits below the +default of 16 or above the maximum of 24 are ignored. + +Returns true on success otherwise undef. + +=cut + +$_netlimit = 2 ** 16; # default + +sub netlimit($) { + return undef unless $_[0]; + return undef if $_[0] =~ /\D/; + return undef if $_[0] < 16; + return undef if $_[0] > 24; + $_netlimit = 2 ** $_[0]; +}; + =head1 INSTALLATION Un-tar the distribution in an appropriate directory and type: @@ -167,7 +198,7 @@ An object can be used just as a string. For instance, the following code my $ip = new NetAddr::IP '192.168.1.123'; - print "$ip\n"; + print "$ip\n"; Will print the string 192.168.1.123/32. @@ -195,7 +226,7 @@ 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 + /24 > /16 Comparision should not be done on netaddr objects with different CIDR as this may produce indeterminate - unexpected results, @@ -204,25 +235,39 @@ $ip1->masklen <=> $ip2->masklen -=item B +=item B)> -Adding a constant to a NetAddr::IP object changes its address part to -point to the one so many hosts above the start address. For instance, -this code: +Add a 32 bit signed constant to the address part of a NetAddr object. +This operation changes the address part to point so many hosts above the +current objects start address. For instance, this code: - print NetAddr::IP->new('127.0.0.1') + 5; + print NetAddr::IP::Lite->new('127.0.0.1') + 5; will output 127.0.0.6/8. The address will wrap around at the broadcast back to the network address. This code: - print NetAddr::IP->new('10.0.0.1/24') + 255; + print NetAddr::IP::Lite->new('10.0.0.1/24') + 255; -outputs 10.0.0.0/24. + outputs 10.0.0.0/24. -=item B +Returns the the unchanged object when the conastant is missing or out of +range. + + 2147483647 <= constant >= -2147483648 + +=item B)> The complement of the addition of a constant. +=item B)> + +Returns the difference between the address parts of two NetAddr::IP::Lite +objects address parts as a 32 bit signed number. + +Returns B if the difference is out of range. + +(See range restrictions on Addition above) + =item B Auto-incrementing a NetAddr::IP object causes the address part to be @@ -263,7 +308,7 @@ sub import { if (grep { $_ eq ':old_storable' } @_) { - @_ = grep { $_ ne ':old_storable' } @_; + @_ = grep { $_ ne ':old_storable' } @_; } else { *{STORABLE_freeze} = sub { @@ -308,7 +353,7 @@ } sub hostenumref($) { - my $r = $_[0]->splitref(); + my $r = _splitref(0,$_[0]); unless ((notcontiguous($_[0]->{mask}))[1] == 128) { splice(@$r, 0, 1); splice(@$r, scalar @$r - 1, 1); @@ -316,6 +361,28 @@ return $r; } +sub splitref { + unshift @_, 0; # mark as no reverse + goto &_splitref; +} + +sub rsplitref { + unshift @_, 1; # mark as reversed + goto &_splitref; +} + +sub split { + unshift @_, 0; # mark as no reverse + my $rv = &_splitref; + return $rv ? @$rv : (); +} + +sub rsplit { + unshift @_, 1; # mark as reversed + my $rv = &_splitref; + return $rv ? @$rv : (); +} + sub DESTROY {}; 1; @@ -327,25 +394,25 @@ my $laddr = shift; if ($mask > 24) { - return "$faddr->[0].$faddr->[1].$faddr->[2].$faddr->[3]-$laddr->[3]"; + return "$faddr->[0].$faddr->[1].$faddr->[2].$faddr->[3]-$laddr->[3]"; } elsif ($mask == 24) { - return "$faddr->[0].$faddr->[1].$faddr->[2]."; + return "$faddr->[0].$faddr->[1].$faddr->[2]."; } elsif ($mask > 16) { - return "$faddr->[0].$faddr->[1].$faddr->[2]-$laddr->[2]."; + return "$faddr->[0].$faddr->[1].$faddr->[2]-$laddr->[2]."; } elsif ($mask == 16) { - return "$faddr->[0].$faddr->[1]."; + return "$faddr->[0].$faddr->[1]."; } elsif ($mask > 8) { - return "$faddr->[0].$faddr->[1]-$laddr->[1]."; + return "$faddr->[0].$faddr->[1]-$laddr->[1]."; } elsif ($mask == 8) { - return "$faddr->[0]."; + return "$faddr->[0]."; } else { - return "$faddr->[0]-$laddr->[0]"; + return "$faddr->[0]-$laddr->[0]"; } } @@ -620,25 +687,35 @@ } -sub _compV6 { - my @addr = split(':',shift); - my $found = 0; - my $v; - foreach(0..$#addr) { - ($v = $addr[$_]) =~ s/^0+//; - $addr[$_] = $v || 0; - } - @_ = reverse(1..$#addr); - foreach(@_) { - if ($addr[$_] || $addr[$_ -1]) { - last if $found; - next; - } - $addr[$_] = $addr[$_ -1] = ''; - $found = '1'; - } - (my $rv = join(':',@addr)) =~ s/:+:/::/; - return $rv; +#sub _old_compV6 { +# my @addr = split(':',shift); +# my $found = 0; +# my $v; +# foreach(0..$#addr) { +# ($v = $addr[$_]) =~ s/^0+//; +# $addr[$_] = $v || 0; +# } +# @_ = reverse(1..$#addr); +# foreach(@_) { +# if ($addr[$_] || $addr[$_ -1]) { +# last if $found; +# next; +# } +# $addr[$_] = $addr[$_ -1] = ''; +# $found = '1'; +# } +# (my $rv = join(':',@addr)) =~ s/:+:/::/; +# return $rv; +#} + +# thanks to Rob Riepel +# for this faster and more compact solution 11-17-08 +sub _compV6 ($) { + my $ip = shift; + return $ip unless my @candidates = $ip =~ /((?:^|:)0(?::0)+(?::|$))/g; + my $longest = (sort { length($b) <=> length($a) } @candidates)[0]; + $ip =~ s/$longest/::/; + return $ip; } sub short($) { @@ -701,56 +778,198 @@ Note that C<$me> and C<$other> must be C objects. -=item C<-Esplit($bits)> +=item C<-Esplitref($bits,[optional $bits1,$bits2,...])> -Returns a list of objects, representing subnets of C<$bits> mask +Returns a reference to a list of objects, representing subnets of C mask produced by splitting the original object, which is left unchanged. Note that C<$bits> must be longer than the original 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. +ERROR conditions: + + ->splitref will DIE with the message 'netlimit exceeded' + if the number of return objects exceeds 'netlimit'. + See function 'netlimit' above (default 2**16 or 65536 nets). + + ->splitref returns undef when C or the (bits list) + will not fit within the original object. + + ->splitref returns undef if a supplied ipV4, ipV6, or NetAddr + mask in inappropriately formated, + +B may be a CIDR mask, a dot quad or ipV6 string or a NetAddr::IP object. +If C is missing, the object is split for into all available addresses +within the ipV4 or ipV6 object ( auto-mask of CIDR 32, 128 respectively ). + +With optional additional C list, the original object is split into +parts sized based on the list. NOTE: a short list will replicate the last +item. If the last item is too large to for what remains of the object after +splitting off the first parts of the list, a "best fits" list of remaining +objects will be returned based on an increasing sort of the CIDR values of +the C list. + + i.e. my $ip = new NetAddr::IP('192.168.0.0'); + my $objptr = $ip->split(28, 29, 28, 29, 26); + + has split plan 28 29 28 29 26 26 26 28 + and returns this list of objects + + 192.168.0.0/28 + 192.168.0.16/29 + 192.168.0.24/28 + 192.168.0.40/29 + 192.168.0.48/26 + 192.168.0.112/26 + 192.168.0.176/26 + 192.168.0.240/28 + +NOTE: that /26 replicates twice beyond the original request and /28 fills +the remaining return object requirement. + +=item C<-Ersplitref($bits,[optional $bits1,$bits2,...])> + +C<-Ersplitref> is the same as C<-Esplitref> above except that the split plan is +applided to the original object in reverse order. + + i.e. my $ip = new NetAddr::IP('192.168.0.0'); + my @objects = $ip->split(28, 29, 28, 29, 26); + + has split plan 28 26 26 26 29 28 29 28 + and returns this list of objects + + 192.168.0.0/28 + 192.168.0.16/26 + 192.168.0.80/26 + 192.168.0.144/26 + 192.168.0.208/29 + 192.168.0.216/28 + 192.168.0.232/29 + 192.168.0.240/28 + +=item C<-Esplit($bits,[optional $bits1,$bits2,...])> + +Similar to C<-Esplitref> above but returns the list rather than a list +reference. You may not want to use this if a large numnber of objects is +expected. + +=item C<-Ersplit($bits,[optional $bits1,$bits2,...])> + +Similar to C<-Ersplitref> above but returns the list rather than a list +reference. You may not want to use this if a large numnber of objects is +expected. =cut -sub split ($;$) { - return @{$_[0]->splitref($_[1])}; +# input: $naip, +# @bits, list of masks for splits +# +# returns: empty array request will not fit in submitted net +# (\@bits,undef) if there is just one plan item i.e. return original net +# (\@bits,\%masks) for a real plan +# +sub _splitplan { + my($ip,@bits) = @_; + my $addr = $ip->addr(); + my $isV6 = $ip->{isv6}; + unless (@bits) { + $bits[0] = $isV6 ? 128 : 32; + } + my $basem = $ip->masklen(); + + my(%nets,$dif); + my $denom = 0; + + my($x,$maddr); + foreach(@bits) { + if (ref $_) { # is a NetAddr::IP + $x = $_->{isv6} ? $_->{addr} : $_->{addr} | V4mask; + ($x,$maddr) = notcontiguous($x); + return () if $x; # spurious bits + $_ = $isV6 ? $maddr : $maddr - 96; + } + elsif ( $_ =~ /^d+$/ ) { # is a negative number of the form -nnnn + ; + } + elsif ($_ = NetAddr::IP->new($addr,$_,$isV6)) { # will be undefined if bad mask and will fall into oops! + $_ = $_->masklen(); + } + else { + return (); # oops! + } + $dif = $_ - $basem; # for normalization + return () if $dif < 0; # overange nets not allowed + return (\@bits,undef) unless ($dif || $#bits); # return if original net = mask alone + $denom = $dif if $dif > $denom; + next if exists $nets{$_}; + $nets{$_} = $_ - $basem; # for normalization + } + +# $denom is the normalization denominator, since these are all exponents +# normalization can use add/subtract to accomplish normalization +# +# keys of %nets are the masks used by this split +# values of %nets are the normalized weighting for +# calculating when the split is "full" or complete +# %masks values contain the actual masks for each split subnet +# @bits contains the masks in the order the user actually wants them +# + my %masks; # calculate masks + my $maskbase = $isV6 ? 128 : 32; + foreach( keys %nets ) { + $nets{$_} = 2 ** ($denom - $nets{$_}); + $masks{$_} = shiftleft(Ones, $maskbase - $_); + } + + my @plan; + my $idx = 0; + $denom = 2 ** $denom; + PLAN: + while ($denom > 0) { # make a net plan + my $nexmask = ($idx < $#bits) ? $bits[$idx] : $bits[$#bits]; + ++$idx; + unless (($denom -= $nets{$nexmask}) < 0) { + return () if (push @plan, $nexmask) > $_netlimit; + next; + } +# a fractional net is needed that is not in the mask list or the replicant + $denom += $nets{$nexmask}; # restore mistake + TRY: + foreach (sort { $a <=> $b } keys %nets) { + next TRY if $nexmask > $_; + do { + next TRY if $denom - $nets{$_} < 0; + return () if (push @plan, $_) > $_netlimit; + $denom -= $nets{$_}; + } while $denom; + } + die 'ERROR: miscalculated weights' if $denom; + } + return () if $idx < @bits; # overrange original subnet request + return (\@plan,\%masks); } -=pod +# input: $rev, # t/f +# $naip, +# @bits # list of masks for split +# +sub _splitref { + my $rev = shift; + my($plan,$masks) = &_splitplan; + return undef unless $plan; + my $net = $_[0]->network(); + return [$net] unless $masks; + my $addr = $net->{addr}; + my $isV6 = $net->{isv6}; + my @plan = $rev ? reverse @$plan : @$plan; +# print "plan @plan\n"; -=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. - -Return undef if the number of subnets > 2 ** 32 - -=cut - -sub splitref($;$) { - my $net = $_[0]->network; - my $mask = $_[1] || ''; - if ($mask) { - return undef unless ($mask = NetAddr::IP->new($net->addr,$mask)->{mask}); - } else { - $mask = Ones(); - } - my $scidr = (notcontiguous($mask))[1]; - my $nnets = $scidr - (notcontiguous($net->{mask}))[1]; - return undef if $nnets < 0 || $nnets > 32; - return [$net] if $nnets == 0; - $nnets = 2 ** $nnets; # number of nets - my $nsize = (sub128(Zero,$mask))[1]; - my @ret = unpack('L3N',$nsize); - return undef if $ret[0] || $ret[1] || $ret[2]; - $nsize = $ret[3]; - @ret = (); - - while ($nnets-- > 0) { - push @ret, $net->_new($net->{addr},$mask); - $net->{addr} = (addconst($net->{addr},$nsize))[1]; +# create splits + my @ret; + while ($_ = shift @plan) { + my $mask = $masks->{$_}; + push @ret, $net->_new($addr,$mask,$isV6); + last unless @plan; + $addr = (sub128($addr,$mask))[1]; } return \@ret; } @@ -761,6 +980,12 @@ Returns the list of hosts within a subnet. +ERROR conditions: + + ->hostenum will DIE with the message 'netlimit exceeded' + if the number of return objects exceeds 'netlimit'. + See function 'netlimit' above (default 2**16 or 65536 nets). + =cut sub hostenum ($) { @@ -977,39 +1202,39 @@ if ($mlen != 32) { - if ($mlen > 24) - { - $d = 2 ** (32 - $mlen) - 1; + if ($mlen > 24) + { + $d = 2 ** (32 - $mlen) - 1; $r[3] = '(?:' . join('|', ($o[3]..$o[3] + $d)) . ')'; - } - else - { - $r[3] = $octet; - if ($mlen > 16) - { - $d = 2 ** (24 - $mlen) - 1; + } + else + { + $r[3] = $octet; + if ($mlen > 16) + { + $d = 2 ** (24 - $mlen) - 1; $r[2] = '(?:' . join('|', ($o[2]..$o[2] + $d)) . ')'; - } - else - { - $r[2] = $octet; - if ($mlen > 8) - { - $d = 2 ** (16 - $mlen) - 1; + } + else + { + $r[2] = $octet; + if ($mlen > 8) + { + $d = 2 ** (16 - $mlen) - 1; $r[1] = '(?:' . join('|', ($o[1]..$o[1] + $d)) . ')'; - } - else - { - $r[1] = $octet; - if ($mlen > 0) - { - $d = 2 ** (8 - $mlen) - 1; + } + else + { + $r[1] = $octet; + if ($mlen > 0) + { + $d = 2 ** (8 - $mlen) - 1; $r[0] = '(?:' . join('|', ($o[0] .. $o[0] + $d)) . ')'; - } - else { $r[0] = $octet; } - } - } - } + } + else { $r[0] = $octet; } + } + } + } } ### no digit before nor after (look-behind, look-ahead) @@ -1122,10 +1347,11 @@ Compact Coalesce - Zero + Zeros Ones V4mask - V4net + V4net + netlimit =head1 HISTORY @@ -1770,24 +1996,63 @@ Inherited methods from Lite.pm updated as follows: - comparisons of the form <, >, <=, >= + comparisons of the form <, >, <=, >= - 10.0.0.0/24 {operator} 10.0.0.0/16 + 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. + 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 + ... 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... + 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 +=item 4.08 + + added method ->new_from_aton to supplement broken + :aton functionality which is now DEPRECATED and + will eventually go away. + +=item 4.13 + + added 'no octal' method ->new_no + +=item 4.17 + + add support for PTHREADS in the event that perl is + built with . This must be invoked at build + time with the switch --with-threads + + WARNING: --with-threads is not tested in a threads + environment. Reports welcome and solicited. + + update _compV6 which runs faster and produces more + compact ipV6 addresses. + ....and + added minus (-) overloading to allow the subtraction + of two NetAddr::IP objects to get the difference between + the object->{addr}'s as a numeric value + + Thanks to Rob Riepel for + the _compV6 code and the inspiration for (-) overloading. + + Extended the capability of 'splitref' to allow splitting of + objects into multiple pieces with differing CIDR masks. + Returned object list can be split from bottom to top + or from top to bottom depending on which routine is called + + split, rsplit, splitref, rsplitref + + Thanks to kashmish for the idea on + improving functionality of 'split'. + =back =head1 AUTHORS @@ -1814,3 +2079,4 @@ =cut +1; diff --git a/Lite/Changes b/Lite/Changes index 195b2f3..5fdaede 100644 --- a/Lite/Changes +++ b/Lite/Changes @@ -1,7 +1,16 @@ Revision history for Perl extension NetAddr::IP::Lite +1.12 Sun Nov 23 19:32:59 PST 2008 + repaired missing sub Zeros + + added minus (-) overloading to allow the subtraction + of two NetAddr::IP objects to get the difference between + the object->{addr}'s as a numeric value + Thanks to Rob Riepel + for the initial code and inspiration for this enhancement + 1.11 Sat Nov 1 15:13:48 PST 2008 - add test for characters not allowed by rfc952before + add test for characters not allowed by rfc952 before the call to gethostbyname in sub new() for those people that insist on using deprecated functionality :aton and OS's that fail to notice calls to gethostbyname diff --git a/Lite/Lite.pm b/Lite/Lite.pm index 321de37..ebbc3df 100644 --- a/Lite/Lite.pm +++ b/Lite/Lite.pm @@ -25,15 +25,15 @@ mask4to6 ipv4to6 ); -use vars qw(@ISA @EXPORT_OK $VERSION $Accept_Binary_IP $Old_nth $AUTOLOAD); +use vars qw(@ISA @EXPORT_OK $VERSION $Accept_Binary_IP $Old_nth $AUTOLOAD *Zero); -$VERSION = do { my @r = (q$Revision: 1.11 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +$VERSION = do { my @r = (q$Revision: 1.12 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; require Exporter; @ISA = qw(Exporter); -@EXPORT_OK = qw(Zero Ones V4mask V4net); +@EXPORT_OK = qw(Zeros Zero Ones V4mask V4net); # Set to true, to enable recognizing of ipV4 && ipV6 binary notation IP # addresses. Thanks to Steve Snodgrass for reporting. This can be done @@ -41,6 +41,7 @@ $Accept_Binary_IP = 0; $Old_nth = 0; +*Zero = \&Zeros; =head1 NAME @@ -75,7 +76,7 @@ The following four functions return ipV6 representations of: :: = Zeros(); - FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF: = Ones(); + FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF = Ones(); FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:: = V4mask(); ::FFFF:FFFF = V4net(); @@ -166,7 +167,7 @@ my $_v4mask = pack('L4',0xffffffff,0xffffffff,0xffffffff,0); my $_v4net = ~ $_v4mask; -sub Zero() { +sub Zeros() { return $_zero; } sub Ones() { @@ -313,11 +314,11 @@ $ip1->masklen <=> $ip2->masklen -=item B +=item B)> -Adding a constant to a NetAddr::IP::Lite object changes its address part to -point to the one so many hosts above the start address. For instance, -this code: +Add a 32 bit signed constant to the address part of a NetAddr object. +This operation changes the address part to point so many hosts above the +current objects start address. For instance, this code: print NetAddr::IP::Lite->new('127.0.0.1') + 5; @@ -328,13 +329,19 @@ outputs 10.0.0.0/24. +Returns the the unchanged object when the conastant is missing or out of range. + + 2147483647 <= constant >= -2147483648 + =cut sub plus { my $ip = shift; my $const = shift; - return $ip unless $const; + return $ip unless $const && + $const < 2147483648 && + $const > -2147483649; my $a = $ip->{addr}; my $m = $ip->{mask}; @@ -347,17 +354,35 @@ return _new($ip,$new,$m); } -=item B +=item B)> The complement of the addition of a constant. +=item B)> + +Returns the difference between the address parts of two NetAddr::IP::Lite +objects address parts as a 32 bit signed number. + +Returns B if the difference is out of range. + =cut +my $_smsk = pack('L3N',0xffffffff,0xffffffff,0xffffffff,0x80000000); + sub minus { my $ip = shift; - my $const = shift; - - return plus($ip, -$const); + my $arg = shift; + unless (ref $arg) { + return plus($ip, -$arg); + } + my($carry,$dif) = sub128($ip->{addr},$arg->{addr}); + if ($carry) { # value is positive + return undef if hasbits($dif & $_smsk); # all sign bits should be 0's + return (unpack('L3N',$dif))[3]; + } else { + return undef if hasbits(($dif & $_smsk) ^ $_smsk); # sign is 1's + return (unpack('L3N',$dif))[3] - 4294967296; + } } # Auto-increment an object @@ -446,8 +471,6 @@ =item C<-Enew_from_aton($netaddr)> -=item C<-Enew_no([$addr, [ $mask]])> - 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. @@ -530,15 +553,15 @@ =cut my %fip4 = ( - default => Zero, - any => Zero, + default => Zeros, + any => Zeros, broadcast => inet_any2n('255.255.255.255'), loopback => inet_any2n('127.0.0.1'), unspecified => undef, ); my %fip4m = ( - default => Zero, - any => Zero, + default => Zeros, + any => Zeros, broadcast => Ones, loopback => mask4to6(inet_aton('255.0.0.0')), unspecified => undef, # not applicable for ipV4 @@ -546,16 +569,16 @@ ); my %fip6 = ( - default => Zero, - any => Zero, + default => Zeros, + any => Zeros, broadcast => undef, # not applicable for ipV6 loopback => inet_any2n('::1'), - unspecified => Zero, + unspecified => Zeros, ); my %fip6m = ( - default => Zero, - any => Zero, + default => Zeros, + any => Zeros, broadcast => undef, # not applicable for ipV6 loopback => Ones, unspecified => Ones, @@ -1142,7 +1165,7 @@ =head1 EXPORT_OK - Zero + Zeros Ones V4mask V4net diff --git a/Lite/README b/Lite/README index 3d3a00a..b291cde 100644 --- a/Lite/README +++ b/Lite/README @@ -29,7 +29,7 @@ The following four functions return ipV6 representations of: :: = Zeros(); - FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF: = Ones(); + FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF = Ones(); FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:: = V4mask(); ::FFFF:FFFF = V4net(); @@ -123,10 +123,11 @@ $ip1->masklen <=> $ip2->masklen - Addition of a constant - Adding a constant to a NetAddr::IP::Lite object changes its address - part to point to the one so many hosts above the start address. For - instance, this code: + Addition of a constant ("+") + Add a 32 bit signed constant to the address part of a NetAddr + object. This operation changes the address part to point so many + hosts above the current objects start address. For instance, this + code: print NetAddr::IP::Lite->new('127.0.0.1') + 5; @@ -137,9 +138,20 @@ outputs 10.0.0.0/24. - Substraction of a constant + Returns the the unchanged object when the conastant is missing or + out of range. + + 2147483647 <= constant >= -2147483648 + + Substraction of a constant ("+") The complement of the addition of a constant. + Difference ("-") + Returns the difference between the address parts of two + NetAddr::IP::Lite objects address parts as a 32 bit signed number. + + Returns undef if the difference is out of range. + Auto-increment Auto-incrementing a NetAddr::IP::Lite object causes the address part to be adjusted to the next host address within the subnet. It will @@ -156,7 +168,6 @@ "->new6([$addr, [ $mask]])" "->new_no([$addr, [ $mask]])" "->new_from_aton($netaddr)" - "->new_no([$addr, [ $mask]])" 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. @@ -368,7 +379,7 @@ use NetAddr::IP::Lite qw(:old_nth); EXPORT_OK - Zero + Zeros Ones V4mask V4net diff --git a/Lite/Util/Changes b/Lite/Util/Changes index e124155..de776d9 100644 --- a/Lite/Util/Changes +++ b/Lite/Util/Changes @@ -1,5 +1,17 @@ Revision history for Perl extension NetAddr::IP::Util +1.25 Tue Nov 18 19:08:56 PST 2008 + correct documentation error in Util_PP v1.5 + + add threads reporting to Util.xs and Util_PP + + added what is hopefully thread safe operation via + serializaton. Must be invoked by "--with-threads" + +1.24 Wed Nov 5 18:13:20 PST 2008 + Clean up Makefile.PL to check actual required link + libraries against the perl build for consistency + 1.23 Sun Nov 2 10:10:38 PST 2008 add missing headers in configure and localconf.h for Solaris inet_xton thanks to Karl Bunch for spotting the bug. diff --git a/Lite/Util/Makefile.PL b/Lite/Util/Makefile.PL index 1187a93..36c57bd 100644 --- a/Lite/Util/Makefile.PL +++ b/Lite/Util/Makefile.PL @@ -15,10 +15,11 @@ # # get any command line arguments # -my ($useXS); +my($withthreads,$useXS); GetOptions( - 'xs!' => \$useXS, - 'pm' => sub { + 'with-threads' => \$withthreads, + 'xs!' => \$useXS, + 'pm' => sub { warn "\n\t".'WARNING: Use of "--pm" is deprecated, use "-noxs" instead'."\n\n"; $useXS = 0; }, @@ -36,14 +37,14 @@ my %makeparms = ( NAME => $pkg, VERSION_FROM => $module, # finds $VERSION - depend => {$cfile => q[xs_include/miniSocket.inc localconf.h config.h], + depend => {$cfile => q[xs_include/miniSocket.inc localconf.h config.h localperl.h], }, # PREREQ_PM => {Test::More => 0, # }, LIBS => [], XS => {}, C => [], - clean => { FILES => "*.bs *.o *.c *~ tmp* Util_IS.pm config.log config.h config.status auto*"}, + clean => { FILES => "*.bs *.o *.c *~ tmp* Util_IS.pm config.log config.h config.status localperl.h auto*"}, dist => {COMPRESS=>'gzip', SUFFIX=>'gz'} ); @@ -55,6 +56,7 @@ if (test_cc()) { print "You have a working compiler.\n"; $useXS = 1; + $withthreads = 1 if $withthreads; # $makeparms{'MYEXTLIB'} = 'netdns$(LIB_EXT)', } else { @@ -79,14 +81,50 @@ # turn the XS bits on. delete $makeparms{'XS'}; delete $makeparms{'C'}; + + unless (-e './config.h') { + system('./configure'); + } + my @LIBS; + open(F,'config.h') or die "could not open config.h\n"; + foreach() { + if ($_ =~ /^#define LIBS([ a-zA-Z-]+)/) { + @LIBS = ($1 =~ /[a-zA-Z0-9-]+/g); + + $makeparms{LIBS} = [$1]; + last; + } + } + close F; my $link = ''; - foreach(qw(-lnsl -lsocket)) { + foreach(@libs) { if ($Config{libs} =~ /$_\b/) { $link .= $_ .' '; } } chop $link; $makeparms{LIBS} = [$link]; + + open(F,'>localperl.h') or die "could not open localperl.h for write\n"; + print F q| +/* Written by Makefile.PL + * + * Do not modify this file, modify Makefile.PL instead + * + */ +|; + print F q|#define I_REALLY_WANT_ALPHA_THREADS 1 +| if $withthreads; + print F q|#define LOCAL_PERL_WANTS_PTHREAD_H 1 +| if $Config{i_pthread} eq 'define'; + print F q|#define LOCAL_PERL_USE_THREADS 1 +| if $Config{usethreads} eq 'define'; + print F q|#define LOCAL_PERL_USE_I_THREADS 1 +| if $Config{useithreads} eq 'define'; + print F q|#define LOCAL_PERL_USE_5005THREADS 1 +| if $Config{use5005threads} eq 'define'; + close F; + $begin = q| config :: config.h @$(NOOP) diff --git a/Lite/Util/README b/Lite/Util/README index cd210b6..1c83167 100644 --- a/Lite/Util/README +++ b/Lite/Util/README @@ -26,6 +26,7 @@ bin2bcd bcd2bin mode + threads ); use NetAddr::IP::Util qw(:all :inet :ipv4 :ipv6 :math) @@ -73,6 +74,7 @@ $bcdtext = bin2bcd($bits128); $bits128 = bcd2bin($bcdtxt); $modetext = mode; + $threadtxt = threads; INSTALLATION Un-tar the distribution in an appropriate directory and type: @@ -100,6 +102,7 @@ and & or | xor ^ + ~ compliment in the same manner as 'vec' strings. @@ -297,6 +300,21 @@ returns: "Pure Perl" or "CC XS" + * $threadtxt = threads + Returns the build flags for various thread options as a comma + seperated string. + + input: none + returns: empty string + or some combination of the following: + + HAVE_PTHREAD_H perl built with + HAVE_THREAD_H perl built with + LOCAL_PERL_WANTS_PTHREAD_H $Config{i_pthread} + LOCAL_PERL_USE_THREADS $Config{usethreads} + LOCAL_PERL_USE_I_THREADS $Config{useithreads} + LOCAL_PERL_USE_5005_THREADS $Config{use5005threads} + EXAMPLES # convert any textual IP address into a 128 bit vector # @@ -411,6 +429,7 @@ bin2bcd bcd2bin mode + threads AUTHOR Michael Robinton diff --git a/Lite/Util/Util.pm b/Lite/Util/Util.pm index 0843751..5e4a81e 100644 --- a/Lite/Util/Util.pm +++ b/Lite/Util/Util.pm @@ -13,9 +13,9 @@ @ISA = qw(Exporter DynaLoader); -$VERSION = do { my @r = (q$Revision: 1.22 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +$VERSION = do { my @r = (q$Revision: 1.25 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; -my @export_ok = qw( +@EXPORT_OK = qw( inet_aton inet_ntoa ipv6_aton @@ -39,17 +39,16 @@ ipanyto6 maskanyto6 ipv6to4 -); -@EXPORT_OK = (@export_ok,qw( - comp128 bin2bcdn bcdn2txt bcdn2bin simple_pack -)); + comp128 + threads +); %EXPORT_TAGS = ( - all => [@export_ok], + all => [@EXPORT_OK], inet => [qw( inet_aton inet_ntoa @@ -129,7 +128,7 @@ return &yinet_aton; } -sub DESTROY {}; +# sub DESTROY {}; is in the XS file 1; __END__ @@ -164,6 +163,7 @@ bin2bcd bcd2bin mode + threads ); use NetAddr::IP::Util qw(:all :inet :ipv4 :ipv6 :math) @@ -211,6 +211,7 @@ $bcdtext = bin2bcd($bits128); $bits128 = bcd2bin($bcdtxt); $modetext = mode; + $threadtxt = threads; =head1 INSTALLATION @@ -240,6 +241,7 @@ and & or | xor ^ + ~ compliment in the same manner as 'vec' strings. @@ -588,6 +590,22 @@ returns: "Pure Perl" or "CC XS" +=item * $threadtxt = threads + +Returns the build flags for various thread options +as a comma seperated string. + + input: none + returns: empty string + or some combination of the following: + + HAVE_PTHREAD_H perl built with + HAVE_THREAD_H perl built with + LOCAL_PERL_WANTS_PTHREAD_H $Config{i_pthread} + LOCAL_PERL_USE_THREADS $Config{usethreads} + LOCAL_PERL_USE_I_THREADS $Config{useithreads} + LOCAL_PERL_USE_5005_THREADS $Config{use5005threads} + =back =head1 EXAMPLES @@ -708,6 +726,7 @@ bin2bcd bcd2bin mode + threads =head1 AUTHOR diff --git a/Lite/Util/Util.xs b/Lite/Util/Util.xs index bef2903..a1fa7f6 100644 --- a/Lite/Util/Util.xs +++ b/Lite/Util/Util.xs @@ -37,7 +37,6 @@ #include #endif -#include "config.h" #include "localconf.h" #ifdef __cplusplus @@ -47,6 +46,11 @@ /* workaround for OS's without inet_aton */ #include "xs_include/inet_aton.c" +/* if kernel threading is in use, provide mutex locks for global variables */ +#ifdef LOCAL_USE_THREADS +lcl_mutx_init m_lock = DEFAULT_MUTEX_INIT; +#endif + typedef union { u_int32_t u[4]; @@ -55,6 +59,8 @@ n128 c128, a128; +char errorbuffer[256], *eb = errorbuffer; /* error buff */ + u_int32_t wa[4], wb[4]; /* working registers */ struct @@ -172,7 +178,7 @@ for (/* -- */;len>0;len--) { #ifdef host_is_LITTLE_ENDIAN *d++ = (((*s & 0xff000000) >> 24) | ((*s & 0x00ff0000) >> 8) | \ - ((*s & 0x0000ff00) << 8) | ((*s & 0x000000ff) << 24)); + ((*s & 0x0000ff00) << 8) | ((*s & 0x000000ff) << 24)); #else # ifdef host_is_BIG_ENDIAN *d++ = *s; @@ -193,7 +199,7 @@ register u_int32_t * a = ap; for (/* -- */;len >0;len--) { *a++ = (((*a & 0xff000000) >> 24) | ((*a & 0x00ff0000) >> 8) | \ - ((*a & 0x0000ff00) << 8) | ((*a & 0x000000ff) << 24)); + ((*a & 0x0000ff00) << 8) | ((*a & 0x000000ff) << 24)); } #endif } @@ -321,28 +327,28 @@ c = *cp++; for (lo=0;lo<2;lo+=1) { if (lo) { - if (hasdigits) /* suppress leading zero multiplications */ - _128x10plusbcd(a128.u,c128.u, c & 0xF); - else { + if (hasdigits) /* suppress leading zero multiplications */ + _128x10plusbcd(a128.u,c128.u, c & 0xF); + else { if (c & 0xF) { - hasdigits = 1; + hasdigits = 1; a128.u[3] = c & 0xF; - } - } + } + } } else { - if (hasdigits) /* suppress leading zero multiplications */ - _128x10plusbcd(a128.u,c128.u, c >> 4); - else { - if (c & 0XF0) { - hasdigits = 1; + if (hasdigits) /* suppress leading zero multiplications */ + _128x10plusbcd(a128.u,c128.u, c >> 4); + else { + if (c & 0XF0) { + hasdigits = 1; a128.u[3] = c >> 4; } - } + } } i++; if (i >= len) - break; + break; } } } @@ -374,18 +380,18 @@ add3 = 3; msk8 = 8; - for (j=0;j<8;j++) { /* prep bcd digits for X2 */ - tmp = bcd8 + add3; - if (tmp & msk8) - bcd8 = tmp; - add3 <<= 4; - msk8 <<= 4; - } - tmp = bcd8 & 0x80000000; /* propagated carry */ + for (j=0;j<8;j++) { /* prep bcd digits for X2 */ + tmp = bcd8 + add3; + if (tmp & msk8) + bcd8 = tmp; + add3 <<= 4; + msk8 <<= 4; + } + tmp = bcd8 & 0x80000000; /* propagated carry */ bcd8 <<= 1; /* x 2 */ if (carry) - bcd8 += 1; - n.bcd[i] = bcd8; + bcd8 += 1; + n.bcd[i] = bcd8; carry = tmp; } } @@ -437,19 +443,28 @@ STRLEN len; int i; PPCODE: +#ifdef LOCAL_USE_THREADS + lcl_mutx_lck(&m_lock); +#endif ap = (unsigned char *) SvPV(s,len); if (len != 16) { if (ix == 2) - strcpy((char *)wa,"ipv6to4"); + strcpy(eb,"ipv6to4"); else if (ix == 1) - strcpy((char *)wa,"shiftleft"); + strcpy(eb,"shiftleft"); else - strcpy((char *)wa,"comp128"); + strcpy(eb,"comp128"); +#ifdef LOCAL_USE_THREADS + lcl_mutx_ulck(&m_lock); +#endif croak("Bad arg length for %s%s, length is %d, should be %d", - "NetAddr::IP::Util::",(char *)wa,len *8,128); + "NetAddr::IP::Util::",eb,len *8,128); } if (ix == 2) { XPUSHs(sv_2mortal(newSVpvn((char *)(ap +12),4))); +#ifdef LOCAL_USE_THREADS + lcl_mutx_ulck(&m_lock); +#endif XSRETURN(1); } else if (ix == 1) { @@ -460,6 +475,9 @@ memcpy(wa,ap,16); } else if (i < 0 || i > 128) { +#ifdef LOCAL_USE_THREADS + lcl_mutx_ulck(&m_lock); +#endif croak("Bad arg value for %s, is %d, should be 0 thru 128", "NetAddr::IP::Util::shiftleft",i); } @@ -477,6 +495,9 @@ fastcomp128(wa); } XPUSHs(sv_2mortal(newSVpvn((char *)wa,16))); +#ifdef LOCAL_USE_THREADS + lcl_mutx_ulck(&m_lock); +#endif XSRETURN(1); void @@ -489,22 +510,27 @@ unsigned char * ap, *bp; STRLEN len; PPCODE: +#ifdef LOCAL_USE_THREADS + lcl_mutx_lck(&m_lock); +#endif ap = (unsigned char *) SvPV(as,len); if (len != 16) { Bail: if (ix == 1) - strcpy((char *)wa,"sub128"); + strcpy(eb,"sub128"); else - strcpy((char *)wa,"add128"); + strcpy(eb,"add128"); +#ifdef LOCAL_USE_THREADS + lcl_mutx_ulck(&m_lock); +#endif croak("Bad arg length for %s%s, length is %d, should be %d", - "NetAddr::IP::Util::",(char *)wa,len *8,128); + "NetAddr::IP::Util::",eb,len *8,128); } bp = (unsigned char *) SvPV(bs,len); if (len != 16) { goto Bail; } - netswap_copy(wa,ap,4); netswap_copy(wb,bp,4); if (ix == 1) { @@ -517,8 +543,14 @@ if (GIMME_V == G_ARRAY) { netswap(a128.u,4); XPUSHs(sv_2mortal(newSVpvn((char *)a128.c,16))); +#ifdef LOCAL_USE_THREADS + lcl_mutx_ulck(&m_lock); +#endif XSRETURN(2); } +#ifdef LOCAL_USE_THREADS + lcl_mutx_ulck(&m_lock); +#endif XSRETURN(1); void @@ -529,18 +561,30 @@ unsigned char * ap; STRLEN len; PPCODE: +#ifdef LOCAL_USE_THREADS + lcl_mutx_lck(&m_lock); +#endif ap = (unsigned char *) SvPV(s,len); if (len != 16) { +#ifdef LOCAL_USE_THREADS + lcl_mutx_ulck(&m_lock); +#endif croak("Bad arg length for %s, length is %d, should be %d", "NetAddr::IP::Util::addconst",len *8,128); - } + } netswap_copy(wa,ap,4); XPUSHs(sv_2mortal(newSViv((I32)addercon(wa,cnst)))); if (GIMME_V == G_ARRAY) { netswap(a128.u,4); XPUSHs(sv_2mortal(newSVpvn((char *)a128.c,16))); +#ifdef LOCAL_USE_THREADS + lcl_mutx_ulck(&m_lock); +#endif XSRETURN(2); } +#ifdef LOCAL_USE_THREADS + lcl_mutx_ulck(&m_lock); +#endif XSRETURN(1); int @@ -552,14 +596,20 @@ unsigned char * bp; STRLEN len; CODE: +#ifdef LOCAL_USE_THREADS + lcl_mutx_lck(&m_lock); +#endif bp = (unsigned char *) SvPV(s,len); if (len != 16) { if (ix == 1) - strcpy((char *)wa,"isIPv4"); + strcpy(eb,"isIPv4"); else - strcpy((char *)wa,"hasbits"); + strcpy(eb,"hasbits"); +#ifdef LOCAL_USE_THREADS + lcl_mutx_ulck(&m_lock); +#endif croak("Bad arg length for %s%s, length is %d, should be %d", - "NetAddr::IP::Util::",(char *)wa,len *8,128); + "NetAddr::IP::Util::",eb,len *8,128); } if (ix == 1) { RETVAL = _isipv4(bp); @@ -567,6 +617,9 @@ else { RETVAL = have128(bp); } +#ifdef LOCAL_USE_THREADS + lcl_mutx_ulck(&m_lock); +#endif OUTPUT: RETVAL @@ -580,17 +633,26 @@ unsigned char * cp; STRLEN len; PPCODE: +#ifdef LOCAL_USE_THREADS + lcl_mutx_lck(&m_lock); +#endif cp = (unsigned char *) SvPV(s,len); if (ix == 0) { if (len != 16) { +#ifdef LOCAL_USE_THREADS + lcl_mutx_ulck(&m_lock); +#endif croak("Bad arg length for %s, length is %d, should be %d", "NetAddr::IP::Util::bin2bcd",len *8,128); - } + } (void) _bin2bcd(cp); XPUSHs(sv_2mortal(newSVpvn((char *)n.txt,_bcd2txt((unsigned char *)n.bcd)))); } else if (ix == 1) { if (len != 16) { +#ifdef LOCAL_USE_THREADS + lcl_mutx_ulck(&m_lock); +#endif croak("Bad arg length for %s, length is %d, should be %d", "NetAddr::IP::Util::bin2bcdn",len *8,128); } @@ -598,11 +660,17 @@ } else { if (len > 20) { +#ifdef LOCAL_USE_THREADS + lcl_mutx_ulck(&m_lock); +#endif croak("Bad arg length for %s, length is %d, should %d digits or less", "NetAddr::IP::Util::bcdn2txt",len *2,40); } XPUSHs(sv_2mortal(newSVpvn((char *)n.txt,_bcd2txt(cp)))); } +#ifdef LOCAL_USE_THREADS + lcl_mutx_ulck(&m_lock); +#endif XSRETURN(1); #* @@ -621,23 +689,32 @@ unsigned char * cp, badc; STRLEN len; PPCODE: +#ifdef LOCAL_USE_THREADS + lcl_mutx_lck(&m_lock); +#endif cp = (unsigned char *) SvPV(s,len); if (len > 40) { if (ix == 0) - strcpy((char *)wa,"bcd2bin"); + strcpy(eb,"bcd2bin"); else if (ix ==1) - strcpy((char *)wa,"simple_pack"); + strcpy(eb,"simple_pack"); Badigits: +#ifdef LOCAL_USE_THREADS + lcl_mutx_ulck(&m_lock); +#endif croak("Bad arg length for %s%s, length is %d, should be %d digits or less", - "NetAddr::IP::Util::",(char *)wa,len,40); + "NetAddr::IP::Util::",eb,len,40); } if (ix == 2) { if (len > 20) { len <<= 1; /* times 2 */ - strcpy((char *)wa,"bcdn2bin"); + strcpy(eb,"bcdn2bin"); goto Badigits; } if (items < 2) { +#ifdef LOCAL_USE_THREADS + lcl_mutx_ulck(&m_lock); +#endif croak("Bad usage, should have %s('packedbcd,length)", "NetAddr::IP::Util::bcdn2bin"); } @@ -645,17 +722,22 @@ _bcdn2bin(cp,(int)len); netswap(a128.u,4); XPUSHs(sv_2mortal(newSVpvn((char *)a128.c,16))); +#ifdef LOCAL_USE_THREADS + lcl_mutx_ulck(&m_lock); +#endif XSRETURN(1); } - badc = _simple_pack(cp,(int)len); if (badc) { if (ix == 1) - strcpy((char *)wa,"simple_pack"); + strcpy(eb,"simple_pack"); else - strcpy((char *)wa,"bcd2bin"); - croak("Bad char in string for %s%s, character is '%c', allowed are 0-9", - "NetAddr::IP::Util::",(char *)wa,badc); + strcpy(eb,"bcd2bin"); +#ifdef LOCAL_USE_THREADS + lcl_mutx_ulck(&m_lock); +#endif + croak("Bad char in string for %s%s, character is '%c', allowed are 0-9", + "NetAddr::IP::Util::",eb,badc); } if (ix == 0) { _bcdn2bin(n.bcd,40); @@ -665,6 +747,9 @@ else { /* ix == 1 */ XPUSHs(sv_2mortal(newSVpvn((char *)n.bcd,20))); } +#ifdef LOCAL_USE_THREADS + lcl_mutx_ulck(&m_lock); +#endif XSRETURN(1); void @@ -674,18 +759,30 @@ unsigned char * ap, count; STRLEN len; PPCODE: +#ifdef LOCAL_USE_THREADS + lcl_mutx_lck(&m_lock); +#endif ap = (unsigned char *) SvPV(s,len); if (len != 16) { +#ifdef LOCAL_USE_THREADS + lcl_mutx_ulck(&m_lock); +#endif croak("Bad arg length for %s, length is %d, should be %d", "NetAddr::IP::Util::countbits",len *8,128); - } + } netswap_copy(wa,ap,4); count = _countbits(wa); XPUSHs(sv_2mortal(newSViv((I32)have128(wa)))); if (GIMME_V == G_ARRAY) { XPUSHs(sv_2mortal(newSViv((I32)count))); +#ifdef LOCAL_USE_THREADS + lcl_mutx_ulck(&m_lock); +#endif XSRETURN(2); } +#ifdef LOCAL_USE_THREADS + lcl_mutx_ulck(&m_lock); +#endif XSRETURN(1); void @@ -697,20 +794,29 @@ unsigned char * ip; STRLEN len; PPCODE: +#ifdef LOCAL_USE_THREADS + lcl_mutx_lck(&m_lock); +#endif ip = (unsigned char *) SvPV(s,len); if (len != 4) { if (ix == 1) - strcpy((char *)wa,"mask4to6"); + strcpy(eb,"mask4to6"); else - strcpy((char *)wa,"ipv4to6"); + strcpy(eb,"ipv4to6"); +#ifdef LOCAL_USE_THREADS + lcl_mutx_ulck(&m_lock); +#endif croak("Bad arg length for %s%s, length is %d, should be 32", - "NetAddr::IP::Util::",(char *)wa,len *8); + "NetAddr::IP::Util::",eb,len *8); } if (ix == 0) extendipv4(ip); else extendmask4(ip); XPUSHs(sv_2mortal(newSVpvn((char *)wa,16))); +#ifdef LOCAL_USE_THREADS + lcl_mutx_ulck(&m_lock); +#endif XSRETURN(1); void @@ -722,6 +828,9 @@ unsigned char * ip; STRLEN len; PPCODE: +#ifdef LOCAL_USE_THREADS + lcl_mutx_lck(&m_lock); +#endif ip = (unsigned char *) SvPV(s,len); if (len == 16) /* if already 128 bits, return input */ XPUSHs(sv_2mortal(newSVpvn((char *)ip,16))); @@ -734,10 +843,56 @@ } else { if (ix == 1) - strcpy((char *)wa,"maskanyto6"); + strcpy(eb,"maskanyto6"); else - strcpy((char *)wa,"ipanyto6"); + strcpy(eb,"ipanyto6"); +#ifdef LOCAL_USE_THREADS + lcl_mutx_ulck(&m_lock); +#endif croak("Bad arg length for %s%s, length is %d, should be 32 or 128", - "NetAddr::IP::Util::",(char *)wa,len *8); + "NetAddr::IP::Util::",eb,len *8); } +#ifdef LOCAL_USE_THREADS + lcl_mutx_ulck(&m_lock); +#endif XSRETURN(1); + +void +threads() + PPCODE: +#ifdef LOCAL_USE_THREADS + lcl_mutx_lck(&m_lock); +# ifdef HAVE_PTHREAD_H + strcpy(eb,"HAVE_PTHREAD_H"); +# else +# ifdef HAVE_THREAD_H + strcpy(eb,"HAVE_THREAD_H"); /* gotta have one of them */ +# else +# strcpy(eb,"thread error, look at code"); +# endif +# endif +# ifdef xLOCAL_PERL_WANTS_PTHREAD_H + strcat(eb,",LOCAL_PERL_WANTS_PTHREAD_H"); +# endif +# ifdef xLOCAL_PERL_USE_THREADS + strcat(eb,",LOCAL_PERL_USE_THREADS"); +# endif +# ifdef xLOCAL_PERL_USE_I_THREADS + strcat(eb,",LOCAL_PERL_USE_I_THREADS"); +# endif +# ifdef xLOCAL_PERL_USE_5005_THREADS + strcat(eb,",LOCAL_PERL_USE_5005_THREADS"); +# endif + XPUSHs(sv_2mortal(newSVpv(eb,0))); + lcl_mutx_ulck(&m_lock); +#else + XPUSHs(sv_2mortal(newSVpv("",0))); +#endif + XSRETURN(1); + +void +DESTROY() + CODE: +#ifdef LOCAL_USE_THREADS + lcl_mutx_dsty(&m_lock); +#endif diff --git a/Lite/Util/config.h.in b/Lite/Util/config.h.in index 30d4823..ffb94d4 100644 --- a/Lite/Util/config.h.in +++ b/Lite/Util/config.h.in @@ -3,21 +3,24 @@ /* Define to 1 if you have the header file. */ #undef HAVE_ARPA_INET_H -/* Define to 1 if function 'gethostbyname' is present' */ +/* Define to 1 if function 'gethostbyname' is present */ #undef HAVE_GETHOSTBYNAME -/* Define to 1 if function 'inet_addr' is present' */ +/* Define to 1 if function 'inet_addr' is present */ #undef HAVE_INET_ADDR -/* Define to 1 if function 'inet_aton' is present' */ +/* Define to 1 if function 'inet_aton' is present */ #undef HAVE_INET_ATON -/* Define to 1 if function 'inet_pton' is present' */ +/* Define to 1 if function 'inet_pton' is present */ #undef HAVE_INET_PTON /* Define to 1 if you have the header file. */ #undef HAVE_INTTYPES_H +/* Define if library library 'nsl' is present */ +#undef HAVE_LIBNSL + /* Define to 1 if you have the header file. */ #undef HAVE_MEMORY_H @@ -27,6 +30,9 @@ /* Define to 1 if you have the header file. */ #undef HAVE_NETINET_IN_H +/* Define to 1 if you have . */ +#undef HAVE_PTHREAD_H + /* Define to 1 if you have the header file. */ #undef HAVE_STDINT_H @@ -48,9 +54,15 @@ /* Define to 1 if you have the header file. */ #undef HAVE_SYS_TYPES_H +/* Define to 1 if you have . */ +#undef HAVE_THREAD_H + /* Define to 1 if you have the header file. */ #undef HAVE_UNISTD_H +/* Extra libraries */ +#undef LIBS + /* Define to the address where bug reports for this package should be sent. */ #undef PACKAGE_BUGREPORT diff --git a/Lite/Util/configure b/Lite/Util/configure index 30a15b0..9e9da08 100755 --- a/Lite/Util/configure +++ b/Lite/Util/configure @@ -3873,6 +3873,11 @@ + + + + + { echo "$as_me:$LINENO: checking for library containing gethostbyname" >&5 echo $ECHO_N "checking for library containing gethostbyname... $ECHO_C" >&6; } if test "${ac_cv_search_gethostbyname+set}" = set; then @@ -4231,7 +4236,450 @@ fi -# my additions + +if test "${ac_cv_header_pthread_h+set}" = set; then + { echo "$as_me:$LINENO: checking for pthread.h" >&5 +echo $ECHO_N "checking for pthread.h... $ECHO_C" >&6; } +if test "${ac_cv_header_pthread_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +fi +{ echo "$as_me:$LINENO: result: $ac_cv_header_pthread_h" >&5 +echo "${ECHO_T}$ac_cv_header_pthread_h" >&6; } +else + # Is the header compilable? +{ echo "$as_me:$LINENO: checking pthread.h usability" >&5 +echo $ECHO_N "checking pthread.h usability... $ECHO_C" >&6; } +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +#include +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 + (eval "$ac_compile") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + ac_header_compiler=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_header_compiler=no +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +{ echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +echo "${ECHO_T}$ac_header_compiler" >&6; } + +# Is the header present? +{ echo "$as_me:$LINENO: checking pthread.h presence" >&5 +echo $ECHO_N "checking pthread.h presence... $ECHO_C" >&6; } +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include +_ACEOF +if { (ac_try="$ac_cpp conftest.$ac_ext" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 + (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } >/dev/null && { + test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || + test ! -s conftest.err + }; then + ac_header_preproc=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_header_preproc=no +fi + +rm -f conftest.err conftest.$ac_ext +{ echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +echo "${ECHO_T}$ac_header_preproc" >&6; } + +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in + yes:no: ) + { echo "$as_me:$LINENO: WARNING: pthread.h: accepted by the compiler, rejected by the preprocessor!" >&5 +echo "$as_me: WARNING: pthread.h: accepted by the compiler, rejected by the preprocessor!" >&2;} + { echo "$as_me:$LINENO: WARNING: pthread.h: proceeding with the compiler's result" >&5 +echo "$as_me: WARNING: pthread.h: proceeding with the compiler's result" >&2;} + ac_header_preproc=yes + ;; + no:yes:* ) + { echo "$as_me:$LINENO: WARNING: pthread.h: present but cannot be compiled" >&5 +echo "$as_me: WARNING: pthread.h: present but cannot be compiled" >&2;} + { echo "$as_me:$LINENO: WARNING: pthread.h: check for missing prerequisite headers?" >&5 +echo "$as_me: WARNING: pthread.h: check for missing prerequisite headers?" >&2;} + { echo "$as_me:$LINENO: WARNING: pthread.h: see the Autoconf documentation" >&5 +echo "$as_me: WARNING: pthread.h: see the Autoconf documentation" >&2;} + { echo "$as_me:$LINENO: WARNING: pthread.h: section \"Present But Cannot Be Compiled\"" >&5 +echo "$as_me: WARNING: pthread.h: section \"Present But Cannot Be Compiled\"" >&2;} + { echo "$as_me:$LINENO: WARNING: pthread.h: proceeding with the preprocessor's result" >&5 +echo "$as_me: WARNING: pthread.h: proceeding with the preprocessor's result" >&2;} + { echo "$as_me:$LINENO: WARNING: pthread.h: in the future, the compiler will take precedence" >&5 +echo "$as_me: WARNING: pthread.h: in the future, the compiler will take precedence" >&2;} + + ;; +esac +{ echo "$as_me:$LINENO: checking for pthread.h" >&5 +echo $ECHO_N "checking for pthread.h... $ECHO_C" >&6; } +if test "${ac_cv_header_pthread_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_cv_header_pthread_h=$ac_header_preproc +fi +{ echo "$as_me:$LINENO: result: $ac_cv_header_pthread_h" >&5 +echo "${ECHO_T}$ac_cv_header_pthread_h" >&6; } + +fi +if test $ac_cv_header_pthread_h = yes; then + + +cat >>confdefs.h <<\_ACEOF +#define HAVE_PTHREAD_H 1 +_ACEOF + + { echo "$as_me:$LINENO: checking for library containing pthread_mutex_init" >&5 +echo $ECHO_N "checking for library containing pthread_mutex_init... $ECHO_C" >&6; } +if test "${ac_cv_search_pthread_mutex_init+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_func_search_save_LIBS=$LIBS +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char pthread_mutex_init (); +int +main () +{ +return pthread_mutex_init (); + ; + return 0; +} +_ACEOF +for ac_lib in '' pthreads; do + if test -z "$ac_lib"; then + ac_res="none required" + else + ac_res=-l$ac_lib + LIBS="-l$ac_lib $ac_func_search_save_LIBS" + fi + rm -f conftest.$ac_objext conftest$ac_exeext +if { (ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 + (eval "$ac_link") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && + $as_test_x conftest$ac_exeext; then + ac_cv_search_pthread_mutex_init=$ac_res +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + +fi + +rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ + conftest$ac_exeext + if test "${ac_cv_search_pthread_mutex_init+set}" = set; then + break +fi +done +if test "${ac_cv_search_pthread_mutex_init+set}" = set; then + : +else + ac_cv_search_pthread_mutex_init=no +fi +rm conftest.$ac_ext +LIBS=$ac_func_search_save_LIBS +fi +{ echo "$as_me:$LINENO: result: $ac_cv_search_pthread_mutex_init" >&5 +echo "${ECHO_T}$ac_cv_search_pthread_mutex_init" >&6; } +ac_res=$ac_cv_search_pthread_mutex_init +if test "$ac_res" != no; then + test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" + +fi + + { echo "$as_me:$LINENO: ...have pthreads, do not check for thread.h" >&5 +echo "$as_me: ...have pthreads, do not check for thread.h" >&6;} +else + + if test "${ac_cv_header_thread_h+set}" = set; then + { echo "$as_me:$LINENO: checking for thread.h" >&5 +echo $ECHO_N "checking for thread.h... $ECHO_C" >&6; } +if test "${ac_cv_header_thread_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +fi +{ echo "$as_me:$LINENO: result: $ac_cv_header_thread_h" >&5 +echo "${ECHO_T}$ac_cv_header_thread_h" >&6; } +else + # Is the header compilable? +{ echo "$as_me:$LINENO: checking thread.h usability" >&5 +echo $ECHO_N "checking thread.h usability... $ECHO_C" >&6; } +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +#include +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 + (eval "$ac_compile") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + ac_header_compiler=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_header_compiler=no +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +{ echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +echo "${ECHO_T}$ac_header_compiler" >&6; } + +# Is the header present? +{ echo "$as_me:$LINENO: checking thread.h presence" >&5 +echo $ECHO_N "checking thread.h presence... $ECHO_C" >&6; } +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include +_ACEOF +if { (ac_try="$ac_cpp conftest.$ac_ext" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 + (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } >/dev/null && { + test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || + test ! -s conftest.err + }; then + ac_header_preproc=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_header_preproc=no +fi + +rm -f conftest.err conftest.$ac_ext +{ echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +echo "${ECHO_T}$ac_header_preproc" >&6; } + +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in + yes:no: ) + { echo "$as_me:$LINENO: WARNING: thread.h: accepted by the compiler, rejected by the preprocessor!" >&5 +echo "$as_me: WARNING: thread.h: accepted by the compiler, rejected by the preprocessor!" >&2;} + { echo "$as_me:$LINENO: WARNING: thread.h: proceeding with the compiler's result" >&5 +echo "$as_me: WARNING: thread.h: proceeding with the compiler's result" >&2;} + ac_header_preproc=yes + ;; + no:yes:* ) + { echo "$as_me:$LINENO: WARNING: thread.h: present but cannot be compiled" >&5 +echo "$as_me: WARNING: thread.h: present but cannot be compiled" >&2;} + { echo "$as_me:$LINENO: WARNING: thread.h: check for missing prerequisite headers?" >&5 +echo "$as_me: WARNING: thread.h: check for missing prerequisite headers?" >&2;} + { echo "$as_me:$LINENO: WARNING: thread.h: see the Autoconf documentation" >&5 +echo "$as_me: WARNING: thread.h: see the Autoconf documentation" >&2;} + { echo "$as_me:$LINENO: WARNING: thread.h: section \"Present But Cannot Be Compiled\"" >&5 +echo "$as_me: WARNING: thread.h: section \"Present But Cannot Be Compiled\"" >&2;} + { echo "$as_me:$LINENO: WARNING: thread.h: proceeding with the preprocessor's result" >&5 +echo "$as_me: WARNING: thread.h: proceeding with the preprocessor's result" >&2;} + { echo "$as_me:$LINENO: WARNING: thread.h: in the future, the compiler will take precedence" >&5 +echo "$as_me: WARNING: thread.h: in the future, the compiler will take precedence" >&2;} + + ;; +esac +{ echo "$as_me:$LINENO: checking for thread.h" >&5 +echo $ECHO_N "checking for thread.h... $ECHO_C" >&6; } +if test "${ac_cv_header_thread_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_cv_header_thread_h=$ac_header_preproc +fi +{ echo "$as_me:$LINENO: result: $ac_cv_header_thread_h" >&5 +echo "${ECHO_T}$ac_cv_header_thread_h" >&6; } + +fi +if test $ac_cv_header_thread_h = yes; then + + +cat >>confdefs.h <<\_ACEOF +#define HAVE_THREAD_H 1 +_ACEOF + + { echo "$as_me:$LINENO: checking for library containing mutex_init" >&5 +echo $ECHO_N "checking for library containing mutex_init... $ECHO_C" >&6; } +if test "${ac_cv_search_mutex_init+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_func_search_save_LIBS=$LIBS +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char mutex_init (); +int +main () +{ +return mutex_init (); + ; + return 0; +} +_ACEOF +for ac_lib in '' thread; do + if test -z "$ac_lib"; then + ac_res="none required" + else + ac_res=-l$ac_lib + LIBS="-l$ac_lib $ac_func_search_save_LIBS" + fi + rm -f conftest.$ac_objext conftest$ac_exeext +if { (ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 + (eval "$ac_link") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && + $as_test_x conftest$ac_exeext; then + ac_cv_search_mutex_init=$ac_res +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + +fi + +rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ + conftest$ac_exeext + if test "${ac_cv_search_mutex_init+set}" = set; then + break +fi +done +if test "${ac_cv_search_mutex_init+set}" = set; then + : +else + ac_cv_search_mutex_init=no +fi +rm conftest.$ac_ext +LIBS=$ac_func_search_save_LIBS +fi +{ echo "$as_me:$LINENO: result: $ac_cv_search_mutex_init" >&5 +echo "${ECHO_T}$ac_cv_search_mutex_init" >&6; } +ac_res=$ac_cv_search_mutex_init +if test "$ac_res" != no; then + test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" + +fi + + +fi + + + +fi + + + { echo "$as_me:$LINENO: checking whether byte ordering is bigendian" >&5 echo $ECHO_N "checking whether byte ordering is bigendian... $ECHO_C" >&6; } if test "${ac_cv_c_bigendian+set}" = set; then @@ -6899,6 +7347,8 @@ + + cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure @@ -6996,6 +7446,15 @@ + if test "$LIBS" != ""; then + +cat >>confdefs.h <<_ACEOF +#define LIBS $LIBS +_ACEOF + + fi + + : ${CONFIG_STATUS=./config.status} ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" diff --git a/Lite/Util/configure.ac b/Lite/Util/configure.ac index 51e520a..78bda55 100644 --- a/Lite/Util/configure.ac +++ b/Lite/Util/configure.ac @@ -18,23 +18,36 @@ # Checks for library functions. AC_PROG_GCC_TRADITIONAL -AH_TEMPLATE([HAVE_GETHOSTBYNAME],[Define to 1 if function 'gethostbyname' is present']) +AH_TEMPLATE([LIBS],[Extra libraries needed for this build]) +AH_TEMPLATE([HAVE_LIBNSL],[Define if library library 'nsl' is present]) + +AH_TEMPLATE([HAVE_GETHOSTBYNAME],[Define to 1 if function 'gethostbyname' is present]) AC_SEARCH_LIBS([gethostbyname],[nsl],[ AC_DEFINE([HAVE_GETHOSTBYNAME])]) -AH_TEMPLATE([HAVE_INET_ATON],[Define to 1 if function 'inet_aton' is present']) +AH_TEMPLATE([HAVE_INET_ATON],[Define to 1 if function 'inet_aton' is present]) AC_SEARCH_LIBS([inet_aton],[socket],[ AC_DEFINE([HAVE_INET_ATON])]) -AH_TEMPLATE([HAVE_INET_PTON],[Define to 1 if function 'inet_pton' is present']) +AH_TEMPLATE([HAVE_INET_PTON],[Define to 1 if function 'inet_pton' is present]) AC_SEARCH_LIBS([inet_pton],[socket],[ AC_DEFINE([HAVE_INET_PTON])]) -AH_TEMPLATE([HAVE_INET_ADDR],[Define to 1 if function 'inet_addr' is present']) +AH_TEMPLATE([HAVE_INET_ADDR],[Define to 1 if function 'inet_addr' is present]) AC_SEARCH_LIBS([inet_addr],[socket],[ AC_DEFINE([HAVE_INET_ADDR])]) -# my additions + +AC_CHECK_HEADER([pthread.h],[ + AC_DEFINE([HAVE_PTHREAD_H],[1],[Define to 1 if you have .]) + AC_SEARCH_LIBS([pthread_mutex_init],[pthreads],[],[]) + AC_MSG_NOTICE([...have pthreads, do not check for thread.h])],[ + AC_CHECK_HEADER([thread.h],[ + AC_DEFINE([HAVE_THREAD_H],[1],[Define to 1 if you have .]) + AC_SEARCH_LIBS([mutex_init],[thread],[],[])] + ) +]) + AC_C_BIGENDIAN AC_CHECK_SIZEOF([uint8_t]) AC_CHECK_SIZEOF([uint16_t]) @@ -43,4 +56,10 @@ AC_CHECK_SIZEOF([u_int16_t]) AC_CHECK_SIZEOF([u_int32_t]) +AC_CONFIG_COMMANDS_PRE([ + if test "$LIBS" != ""; then + AC_DEFINE_UNQUOTED([LIBS],[$LIBS],[Extra libraries]) + fi +]) + AC_OUTPUT diff --git a/Lite/Util/lib/NetAddr/IP/UtilPP.pm b/Lite/Util/lib/NetAddr/IP/UtilPP.pm index d661a0a..a6b7a1d 100644 --- a/Lite/Util/lib/NetAddr/IP/UtilPP.pm +++ b/Lite/Util/lib/NetAddr/IP/UtilPP.pm @@ -12,7 +12,7 @@ @ISA = qw(Exporter); -$VERSION = do { my @r = (q$Revision: 1.4 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +$VERSION = do { my @r = (q$Revision: 1.5 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; @EXPORT_OK = qw( hasbits @@ -34,6 +34,7 @@ bcdn2txt bcdn2bin simple_pack + threads ); %EXPORT_TAGS = ( @@ -66,6 +67,7 @@ ipv6to4 bin2bcd bcd2bin + threads ); use NetAddr::IP::UtilPP qw(:all) @@ -87,6 +89,7 @@ $netaddr = ipv6to4($pv6naddr); $bcdtext = bin2bcd($bits128); $bits128 = bcd2bin($bcdtxt); + $threadtxt = threads(); =head1 DESCRIPTION @@ -310,7 +313,7 @@ goto &slowadd128; } -=item * ($cidr,$spurious) = notcontiguous($mask128); +=item * ($spurious,$cidr) = notcontiguous($mask128); This function counts the bit positions remaining in the mask when the rightmost '0's are removed. @@ -467,6 +470,17 @@ goto &_bcd2bin; } +=item * $threadtxt = threads(); + +Returns an empty string in Pure Perl mode. See the description for XS mode +for more detail. + +=cut + +sub threads { + return ''; +} + =back =cut @@ -661,6 +675,7 @@ bcdn2txt bcdn2bin simple_pack + threads =head1 AUTHOR @@ -668,7 +683,7 @@ =head1 COPYRIGHT -Copyright 2006 - 2007, Michael Robinton +Copyright 2006 - 2008, Michael Robinton This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License (except as noted diff --git a/Lite/Util/localconf.h b/Lite/Util/localconf.h index 376c60c..0cf375f 100644 --- a/Lite/Util/localconf.h +++ b/Lite/Util/localconf.h @@ -3,6 +3,8 @@ * */ +#include "config.h" + #ifdef WORDS_BIGENDIAN #define host_is_BIG_ENDIAN 1 #else @@ -73,3 +75,58 @@ #define SIZEOF_U_INT32_T SIZEOF_UINT32_T typedef uint32_t u_int32_t; #endif + +#include "localperl.h" + +/* + * defined if the C program should include + * LOCAL_PERL_WANTS_PTHREAD_H + * + * defined if perl was compiled to use threads + * LOCAL_PERL_USE_THREADS + * + * defined if perl was compiled to use interpreter threads + * LOCAL_PERL_USE_I_THREADS + * + * defined if perl was compiled to use 5005 threads + * LOCAL_PERL_USE_5005_THREADS + * + * + * THREAD code is definetly ALPHA in Util.xs + * Benchmarks indicate that it runs up to 50% slower + * Use at your own risk for now + * + * does not yet address the FreeBSD mutex mtx_xxx functions + * mtx_lock + * mtx_unlock + * mtx_destroy + * #include + * #include + * #include + */ + +#if defined I_REALLY_WANT_ALPHA_THREADS +#if defined (HAVE_PTHREAD_H) && defined (LOCAL_PERL_WANTS_PTHREAD_H) +#include +#define LOCAL_USE_THREADS +#define DEFAULT_MUTEX_INIT PTHREAD_MUTEX_INITIALIZER +#define lcl_mutx_init pthread_mutex_t +#define lcl_mutx_lck(m) pthread_mutex_lock(m) +#define lcl_mutx_ulck(m) pthread_mutex_unlock(m) +#define lcl_mutx_dsty(m) pthread_mutex_destroy(m) +# ifdef HAVE_THREAD_H +# undef HAVE_THREAD_H +# endif +#endif + +#if defined (HAVE_THREAD_H) && defined (LOCAL_PERL_USE_THREADS) +#include +#include +#define LOCAL_USE_THREADS +#define DEFAULT_MUTEX_INIT DEFAULTMUTEX +#define lcl_mutx_init mutex_t +#define lcl_mutx_lck(m) mutex_lock(m) +#define lcl_mutx_ulck(m) mutex_unlock(m) +#define lcl_mutx_dsty(m) mutex_destroy(m) +#endif +#endif diff --git a/Lite/Util/t/mode.t b/Lite/Util/t/mode.t index 0069f5e..9b78e12 100644 --- a/Lite/Util/t/mode.t +++ b/Lite/Util/t/mode.t @@ -8,7 +8,10 @@ BEGIN { $| = 1; print "1..2\n"; } END {print "not ok 1\n" unless $loaded;} -use NetAddr::IP::Util qw(mode); +use NetAddr::IP::Util qw( + mode + threads +); $loaded = 1; print "ok 1\n"; @@ -18,5 +21,9 @@ # (correspondingly "not ok 13") depending on the success of chunk 13 # of the test code): -print STDERR "\t\toperating mode ", mode, "\n"; +my $mode = mode(); +my $thrd = threads(); +my $txt = "\tmode $mode"; +$txt .= " => $thrd" if $thrd; +print STDERR $txt,"\n"; print "ok 2\n"; diff --git a/Lite/t/constants.t b/Lite/t/constants.t new file mode 100644 index 0000000..fd1602d --- /dev/null +++ b/Lite/t/constants.t @@ -0,0 +1,19 @@ + +#use diagnostics; +use Test::More tests => 15; +use NetAddr::IP::Lite qw(Zeros Zero Ones V4mask V4net); + +my %const = ( + '0::' => Zeros, + '::' => Zero, + 'FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF' => Ones, + 'FFFF:FFFF:FFFF:FFFF:FFFF:FFFF::' => V4mask, + '::FFFF:FFFF' => V4net, +); + +my($ip,$rv); +foreach (sort keys %const) { + ok(($ip = new NetAddr::IP::Lite($_)),"netaddr $_"); + ok($ip->{addr} eq $const{$_},"match $_"); + ok(($rv = length($const{$_})) == 16, "length $_ is $rv"); +} diff --git a/Lite/t/overminus.t b/Lite/t/overminus.t new file mode 100644 index 0000000..50254cd --- /dev/null +++ b/Lite/t/overminus.t @@ -0,0 +1,45 @@ + +#use diagnostics; +use Test::More tests => 32; +use NetAddr::IP::Lite; + +my $ip80 = new NetAddr::IP::Lite('::1:8000:0/80'); +my $ip7f = $ip80 - 1; +my $maxplus = 2147483647; +my $maxminus = 2147483648; + +my $rv; + +my $ipmax = $ip80 + $maxplus; +ok(($rv = sprintf("%s",$ipmax)) eq '0:0:0:0:0:1:FFFF:FFFF/80',"ip80 maxplus eq $rv eq 0:0:0:0:0:1:FFFF:FFFF/80"); + +my $ipmin = $ip80 - $maxminus; +ok(($rv = sprintf("%s",$ipmin)) eq '0:0:0:0:0:1:0:0/80',"ip80 maxminus� eq $rv eq 0:0:0:0:0:1:0:0/80"); + +my $over = $maxplus +1; +ok(($rv = sprintf("%s",$ip80 + $over)) eq '0:0:0:0:0:1:8000:0/80',"ip80 +overange unchanged, $rv"); + +$over = $maxminus +1; +ok(($rv = sprintf("%s",$ip80 - $over)) eq '0:0:0:0:0:1:8000:0/80',"ip80 -overange unchanged, $rv"); + + +ok(($rv = sprintf("%s",$ip80)) eq '0:0:0:0:0:1:8000:0/80',"ip80 eq $rv eq 0:0:0:0:0:1:8000:0/80"); +ok(($rv = sprintf("%s",$ip7f)) eq '0:0:0:0:0:1:7FFF:FFFF/80',"ip7f eq $rv eq 0:0:0:0:0:1:7FFF:FFFF/80"); + +ok(($rv = $ip80 - $ip7f) == 1,"ip80 - ip7f = $rv"); +ok(($rv = $ip7f - $ip80) == -1,"ip7f - ip80 = $rv"); + +ok(($rv = $ipmax - $ip80) == $maxplus,"ipmax - ip80 = $rv should be $maxplus"); +ok(($rv = $ipmin - $ip80) == -$maxminus,"ipmin - ip80 = $rv should be \-$maxminus"); + +++$ipmax; +--$ipmin; +ok(! defined($ipmax - $ip80),'undefined $ipmax - $ip80 is overange'); +ok(! defined($ipmin - $ip80),'undefined $ipmin - $ip80 is -overange'); + +my $ipx = $ip80->copy + 256; +foreach (1..10) { + ok(($rv = $ipx - $ip80) == $_ * 256,"$ipx - $ip80 = ". $_*256 ." should be $rv"); + ok(($rv = $ip80 - $ipx) == - $_ * 256,"$ip80 - $ipx = ". -$_*256 ." should be $rv"); + $ipx += 256; +} diff --git a/MANIFEST b/MANIFEST index d78f3c3..332567f 100644 --- a/MANIFEST +++ b/MANIFEST @@ -11,6 +11,7 @@ Lite/t/bits.t Lite/t/broadcast.t Lite/t/cidr.t +Lite/t/constants.t Lite/t/contains.t Lite/t/copy.t Lite/t/firstlast.t @@ -30,6 +31,7 @@ Lite/t/over_copy.t Lite/t/over_equal.t Lite/t/over_math.t +Lite/t/overminus.t Lite/t/pathological.t Lite/t/range.t Lite/t/relops.t @@ -99,6 +101,7 @@ MANIFEST This list of files MANIFEST.SKIP README +t/constants.t t/full.t t/full6.t t/imhoff.t @@ -110,6 +113,7 @@ t/over-qq.t t/relops.t t/short.t +t/splitref.t t/v4-coalesce.t t/v4-compact.t t/v4-compplus.t @@ -117,10 +121,12 @@ t/v4-re.t t/v4-split-bulk.t t/v4-split-list.t +t/v4-splitplan.t t/v4-sprefix.t t/v4-xprefix.t t/v6-re.t t/v6-split-bulk.t +t/v6-splitplan.t t/wildcard.t TODO META.yml Module meta-data (added by MakeMaker) diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP index 738c068..9c60227 100644 --- a/MANIFEST.SKIP +++ b/MANIFEST.SKIP @@ -25,3 +25,6 @@ Util\.(bs|[co])$ localStuff\.h$ config\.log$ +config\.h$ +config\.status +localperl\.h diff --git a/META.yml b/META.yml index 792cb79..b297c09 100644 --- a/META.yml +++ b/META.yml @@ -1,6 +1,6 @@ --- #YAML:1.0 name: NetAddr-IP -version: 4.015 +version: 4.017 abstract: Manages IPv4 and IPv6 addresses and subnets license: ~ author: diff --git a/Makefile.PL b/Makefile.PL index 02c6dbe..de47a08 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -2,9 +2,15 @@ # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. -my $checker = 0; +my $check0 = 0; +my $check1 = 0; +my $now = time; +my $then = (stat('./Makefile.old'))[9]; +# set number of seconds to view +my $view = $then +86400 < $now ? 5:0; -print qq{ +unless (grep { m/-noxs/ } @ARGV) { + print q{ This build requires a C compiler by default except on Windows where the Pure Perl version is mandatory. The Pure Perl version does not require compilation of XS code can be used @@ -12,12 +18,34 @@ perl Makefile.PL -noxs -} unless grep { m/-noxs/ } @ARGV; +}; + sleep $view if $view; +} + +unless (grep { m/with-threads/ } @ARGV) { + print q{ +This version of NetAddr::IP incorporates ALPHA support for THREADS +on the underlying platform (not perl threads). If perl was built +with or then this module can be linked to +those libraries if desired. Documentation about perl suggests this +might be a good idea maybe??? The additional thread code is designed +to make the XS library thread safe via serialization with mutex locks. +However, there is no assurance that the present NetAddr::IP threads +code works as expected or improves anything at all. I confess I +don't know that much about threads. + +Use at your own risk as follows: + + perl Makefile.PL --with-threads + +}; + sleep $view if $view; +} eval q{ use Test::Pod; - $checker = 1; }; + $check0 = 1; }; -unless ($checker) +unless ($check0) { print <can('signature_target') ? (SIGN => 1) : ()), diff --git a/t/constants.t b/t/constants.t new file mode 100644 index 0000000..0c89474 --- /dev/null +++ b/t/constants.t @@ -0,0 +1,20 @@ + +#use diagnostics; +use Test::More tests => 15; +use NetAddr::IP qw(Zeros Zero Ones V4mask V4net); + +my %const = ( + '0::' => Zeros, + '::' => Zero, + 'FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF' => Ones, + 'FFFF:FFFF:FFFF:FFFF:FFFF:FFFF::' => V4mask, + '::FFFF:FFFF' => V4net, +); + +my($ip,$rv); +foreach (sort keys %const) { + ok(($ip = new NetAddr::IP($_)),"netaddr $_"); + ok($ip->{addr} eq $const{$_},"match $_"); + ok(($rv = length($const{$_})) == 16, "length $_ is $rv"); +} + diff --git a/t/short.t b/t/short.t index 40d2692..5c2be50 100644 --- a/t/short.t +++ b/t/short.t @@ -2,17 +2,41 @@ # $Id: short.t,v 1.1.1.1 2006/08/14 15:36:06 lem Exp $ -my %cases = -( - '127.1' => '127.0.0.1', - '127.0.1.1' => '127.0.1.1', - '127.1.0.1' => '127.1.0.1', - 'DEAD:BEEF::1' => 'dead:beef::1', - '::1' => '::1', - '::' => '::', - '2001:620:600::1' => '2001:620:600::1', - '2001:620:600:0:1::1' => '2001:620:600:0:1::1', - '2001:620:601:0:1::1' => '2001:620:601::1:0:0:1', +my %cases = qw( + 127.1 127.0.0.1 + 127.0.1.1 127.0.1.1 + 127.1.0.1 127.1.0.1 + DEAD:BEEF::1 dead:beef::1 + ::1 0:0::1 + 2001:620:600::1 2001:620:600::1 + 2001:620:600:0:1::1 2001:620:600:0:1::1 + 2001:620:601:0:1::1 2001:620:601::1:0:0:1 + 0:0:33:44::CC:DD 0:0:33:44:0:0:CC:DD + 0:0:33:44::DD 0:0:33:44:0:0:0:DD + 0:0:33:44:AA:: 0:0:33:44:AA:0:0:0 + 0:0:33::BB:0:0 0:0:33:0:0:BB:0:0 + 0:22:33:44:0:BB:CC:0 0:22:33:44:0:BB:CC:0 + 0:22:33:44:0:BB:CC:DD 0:22:33:44:0:BB:CC:DD + 0:22:33:44:AA:BB:CC:0 0:22:33:44:AA:BB:CC:0 + 0:22:33:44:AA:BB:CC:DD 0:22:33:44:AA:BB:CC:DD + 110:0:0:44:AA:: 110:0:0:44:AA:0:0:0 + 11:0:33:44:0:BB:CC:DD 11:0:33:44:0:BB:CC:DD + 11:0:33:44:AA:BB:CC:DD 11:0:33:44:AA:BB:CC:DD + 11:22:0:44:AA::DD 11:22:0:44:AA:0:0:DD + 11:22:33:0:AA:BB:CC:0 11:22:33:0:AA:BB:CC:0 + 11:22:33:44:AA:: 11:22:33:44:AA:0:0:0 + 11:22::CC:DD 11:22:0:0:0:0:CC:DD + 11::44:AA:0:0:DD 11:0:0:44:AA:0:0:DD + 11::44:AA:BB:0:0 11:0:0:44:AA:BB:0:0 + 11::AA:0:0:DD 11:0:0:0:AA:0:0:DD + 11::AA:BB:0:0 11:0:0:0:AA:BB:0:0 + 1:: 1:0:0:0:0:0:0:0 + :: 0:0:0:0:0:0:0:0 + ::33:44:AA:BB:0:0 0:0:33:44:AA:BB:0:0 + ::44:0:0:CC:DD 0:0:0:44:0:0:CC:DD + ::44:AA:BB:0:0 0:0:0:44:AA:BB:0:0 + ::44:AA:BB:CC:DD 0:0:0:44:AA:BB:CC:DD + ::A 0:0:0:0:0:0:0:A ); my $tests = 2 * keys %cases; @@ -24,7 +48,8 @@ { my $ip = new NetAddr::IP $cases{$c}; isa_ok($ip, 'NetAddr::IP', "$cases{$c}"); - unless (is($ip->short, $c, "short() returns $c")) + my $short = uc $ip->short; + unless (is($short, $c, "short($cases{$c}) returns $short")) { diag "ip=$ip"; } diff --git a/t/splitref.t b/t/splitref.t new file mode 100644 index 0000000..f487b2e --- /dev/null +++ b/t/splitref.t @@ -0,0 +1,27 @@ + +use Test::More qw(no_plan); #tests => 28; + +use_ok('NetAddr::IP'); + +my $ip = new NetAddr::IP('ffff:a123:b345:c789::/48'); +my $rv; +ok(($rv = sprintf("%s",$ip)) eq 'FFFF:A123:B345:C789:0:0:0:0/48',"$rv eq FFFF:A123:B345:C789:0:0:0:0/48"); +my $nets = $ip->splitref(48); +ok($nets,'there is a net'); +ok(@$nets == 1,'one item net'); +ok(($rv = sprintf("%s",$ip)) eq 'FFFF:A123:B345:C789:0:0:0:0/48',"$rv eq FFFF:A123:B345:C789:0:0:0:0/48"); + +$nets = $ip->splitref(49,50); +ok($nets,'there are nets'); +ok(($rv = @$nets) == 3,"$rv is 3 item net"); + +my @exp = qw( + FFFF:A123:B345:0:0:0:0:0/49 + FFFF:A123:B345:8000:0:0:0:0/50 + FFFF:A123:B345:C000:0:0:0:0/50 +); + +foreach(0..$#{$nets}) { + ok(($rv = sprintf("%s",$nets->[$_])) eq $exp[$_], "$rv eq $exp[$_]"); +} + diff --git a/t/v4-splitplan.t b/t/v4-splitplan.t new file mode 100644 index 0000000..d8fc69d --- /dev/null +++ b/t/v4-splitplan.t @@ -0,0 +1,73 @@ + +use Test::More tests => 28; + +use_ok('NetAddr::IP'); + +my $ip = new NetAddr::IP('192.168.21.13/15'); +my $rv; +ok(($rv = sprintf("%s",$ip)) eq '192.168.21.13/15',"$rv eq 192.168.21.13/15"); + +my($plan,$masks) = $ip->_splitplan(15); +ok($plan,'there is a plan'); +ok(!$masks,'plan returns the orignal net'); +ok(@$plan == 1,'one item plan'); +ok(($rv = $plan->[0]) == 15,"plan $rv is original cidr 15"); + +my $cmask = new NetAddr::IP('255.126.0.0'); +ok(($rv = sprintf("%s",$cmask)) eq '255.126.0.0/32',"$rv eq 255.126.0.0/32"); + +($plan,$masks) = $ip->_splitplan($cmask); +ok(!$plan,'failing because of bits in mask'); + +$cmask = new NetAddr::IP('255.254.0.0'); +ok(($rv = sprintf("%s",$cmask)) eq '255.254.0.0/32',"$rv eq 255.254.0.0/32"); + +($plan,$masks) = $ip->_splitplan($cmask); +ok($plan,'there is a plan'); + +ok(!$masks,'plan returns the orignal net'); +ok(@$plan == 1,'one item plan'); +ok(($rv = $plan->[0]) == 15,"plan $rv is original cidr 15"); + +$cmask = '255.254.0.0'; # ipV4 text cmask +($plan,$masks) = $ip->_splitplan($cmask); +ok($plan,'there is a plan'); +ok(!$masks,'plan returns the orignal net'); +ok(@$plan == 1,'one item plan'); +ok(($rv = $plan->[0]) == 15,"plan $rv is original cidr 15"); + +$cmask = '255.126.0.0'; # ipV4 text cmask +($plan,$masks) = $ip->_splitplan($cmask); +ok(!$plan,'failing because of bits in mask'); + +$cmask = 'garbage'; +($plan,$masks) = $ip->_splitplan($cmask); +ok(!$plan,'failing because of garbage'); + +$cmask = 14; # cidr is bigger than requested +($plan,$masks) = $ip->_splitplan($cmask); +ok(!$plan,'failing because of 15 overange'); + +# cidr makes more nets than 2**16 +($plan,$masks) = $ip->_splitplan(32); +ok(!$plan,'failing to many nets 32 - 15 = 2**17'); + +($plan,$masks) = $ip->_splitplan(16,16,16); +ok(!$plan,'failing because of 3 * 16 overange'); + +# test for plan that just fits +($plan,$masks) = $ip->_splitplan(31); +ok($plan,'there is a plan 31'); +ok($masks,'plan has masks'); +ok(($rv = @{$plan}) == 2 ** 16,"$rv should = 65536"); + +# set netlimit internal to 4 nets +$NetAddr::IP::_netlimit = 4; +($plan,$masks) = $ip->_splitplan(17); # should fit +ok($plan,"plan of 4 17's"); + +($plan,$masks) = $ip->_splitplan(17,17,17,17,18); +ok(!plan,"fail plan of 4 17's + 18"); + +($plan,$masks) = $ip->_splitplan(18); +ok(!plan,"fail plan of 8 18's"); diff --git a/t/v6-splitplan.t b/t/v6-splitplan.t new file mode 100644 index 0000000..29bb2f2 --- /dev/null +++ b/t/v6-splitplan.t @@ -0,0 +1,72 @@ + +use Test::More tests => 28; + +use_ok('NetAddr::IP'); + +my $ip = new NetAddr::IP('ffff:a123:b345:c789::/48'); +my $rv; +ok(($rv = sprintf("%s",$ip)) eq 'FFFF:A123:B345:C789:0:0:0:0/48',"$rv eq FFFF:A123:B345:C789:0:0:0:0/48"); + +my($plan,$masks) = $ip->_splitplan(48); +ok($plan,'there is a plan'); +ok(!$masks,'plan returns the orignal net'); +ok(@$plan == 1,'one item plan'); +ok(($rv = $plan->[0]) == 48,"plan $rv is original cidr 48"); + +my $cmask = new NetAddr::IP('ffff:7fff:ffff:ffff::'); +ok(($rv = sprintf("%s",$cmask)) eq 'FFFF:7FFF:FFFF:FFFF:0:0:0:0/128',"$rv eq FFFF:7FFF:FFFF:FFFF:0:0:0:0/128"); + +($plan,$masks) = $ip->_splitplan($cmask); +ok(!$plan,'failing because of bits in mask'); + +$cmask = new NetAddr::IP('FFFF:fFFF:FFFF::'); +ok(($rv = sprintf("%s",$cmask)) eq 'FFFF:FFFF:FFFF:0:0:0:0:0/128',"$rv eq FFFF:fFFF:FFFF:0:0:0:0:0/128"); + +($plan,$masks) = $ip->_splitplan($cmask); +ok($plan,'there is a plan'); +ok(!$masks,'plan returns the orignal net'); +ok(@$plan == 1,'one item plan'); +ok(($rv = $plan->[0]) == 48,"plan $rv is original cidr 48"); + +$cmask = 'FFFF:FFFF:FFFF::'; # ipV6 text cmask +($plan,$masks) = $ip->_splitplan($cmask); +ok($plan,'there is a plan'); +ok(!$masks,'plan returns the orignal net'); +ok(@$plan == 1,'one item plan'); +ok(($rv = $plan->[0]) == 48,"plan $rv is original cidr 48"); + +$cmask = 'FFFF:FFF:FFFF::'; # ipV6 text cmask +($plan,$masks) = $ip->_splitplan($cmask); +ok(!$plan,'failing because of bits in mask'); + +$cmask = 'garbage'; +($plan,$masks) = $ip->_splitplan($cmask); +ok(!$plan,'failing because of garbage'); + +$cmask = 47; # cidr is bigger than requested +($plan,$masks) = $ip->_splitplan($cmask); +ok(!$plan,'failing because of 47 overange'); + +# cidr makes more nets than 2**16 +($plan,$masks) = $ip->_splitplan(65); +ok(!$plan,'failing to many nets 65-48 = 2**17'); + +($plan,$masks) = $ip->_splitplan(49,49,49); +ok(!$plan,'failing because of 3 * 49 overange'); + +# test for plan that just fits +($plan,$masks) = $ip->_splitplan(64); +ok($plan,'there is a plan 64'); +ok($masks,'plan has masks'); +ok(($rv = @{$plan}) == 2 ** 16,"$rv should = 65536"); + +# set netlimit internal to 4 nets +$NetAddr::IP::_netlimit = 4; +($plan,$masks) = $ip->_splitplan(50); # should fit +ok($plan,"plan of 4 50's"); + +($plan,$masks) = $ip->_splitplan(50,50,50,50,51); +ok(!plan,"fail plan of 4 50's + 51"); + +($plan,$masks) = $ip->_splitplan(51); +ok(!plan,"fail plan of 8 51's");