diff --git a/Changes b/Changes new file mode 100644 index 0000000..78cc64a --- /dev/null +++ b/Changes @@ -0,0 +1,14 @@ +Revision history for Perl extension NetAddr::IP + +4.001 Thu Jul 6 14:09:01 PDT 2006 + various bug fixes courtesy of Luis Munoz: + changes to Lite.pm v1.01, Util.pm v0.17 see Changes in those distros. + update t/v6-re.t, addconst called as a scalar, should be called to + return the address value ()[1] + +4.000 Mon Jun 19 21:51:10 PDT 2006 + initial release of version 4.000 which includes + full support of ipV6 addresses and drops the requirement + for Math::BigInt and will run on older versions of Perl + at least back to 5.005_03 + diff --git a/IP.pm b/IP.pm index b906346..479c7d7 100644 --- a/IP.pm +++ b/IP.pm @@ -1,9 +1,39 @@ #!/usr/bin/perl -w -# $Id: IP.pm,v 3.33 2006/05/11 13:46:47 lem Exp $ - package NetAddr::IP; +use strict; +#use diagnostics; +use NetAddr::IP::Lite 1.01 qw(Zero Ones V4mask V4net); +use NetAddr::IP::Util qw( + sub128 + inet_aton + inet_any2n + ipv6_aton + isIPv4 + ipv4to6 + mask4to6 + shiftleft + addconst + hasbits + notcontiguous +); +use AutoLoader qw(AUTOLOAD); + +use vars qw( + @EXPORT_OK + @ISA + $VERSION + $isV6 +); +require Exporter; + +@EXPORT_OK = qw(Compact Coalesce Zero Ones V4mask V4net); + +@ISA = qw(Exporter NetAddr::IP::Lite); + +$VERSION = do { sprintf " %d.%03d", (q$Revision: 4.001 $ =~ /\d+/g) }; + =pod =head1 NAME @@ -12,7 +42,16 @@ =head1 SYNOPSIS - use NetAddr::IP; + use NetAddr::IP qw( + Compact + Coalesce + Zero + Ones + V4mask + V4net + :aton + :old_storable + ); my $ip = new NetAddr::IP 'loopback'; @@ -25,11 +64,62 @@ # This prints 127.0.0.1/32 print "You can also say $ip...\n"; +* The following four functions return ipV6 representations of: + + :: = Zeros(); + FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF: = Ones(); + FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:: = V4mask(); + ::FFFF:FFFF = V4net(); + + +* To accept addresses in the format as returned by inet_aton, invoke the module +as: + + use NetAddr::IP qw(:aton); + +* To enable usage of legacy data files containing NetAddr::IP +objects stored using the L module. + + use NetAddr::IP qw(:old_storable); + +* To compact many smaller subnets (see: C<$me-Ecompact($addr1, $addr2,...)> + + @compacted_object_list = Compact(@object_list) + +* Return a reference to list of C subnets of +C<$masklen> mask length, when C<$number> or more addresses from +C<@list_of_subnets> are found to be contained in said subnet. + + $arrayref = Coalesce($masklen, $number, @list_of_subnets) + +=head1 INSTALLATION + +Un-tar the distribution in an appropriate directory and type: + + perl Makefile.PL + make + make test + make install + +B depends on B which installs by default with its primary functions compiled +using Perl's XS extensions to build a 'C' library. If you do not have a 'C' +complier available or would like the slower Pure Perl version for some other +reason, then type: + + perl Makefile.PL -noxs + make + make test + make install + =head1 DESCRIPTION This module provides an object-oriented abstraction on top of IP -addresses or IP subnets, that allows for easy manipulations. Many -operations are supported, as described below: +addresses or IP subnets, that allows for easy manipulations. +Version 4.xx of NetAdder::IP will will work older +versions of Perl and does B use Math::BigInt as in previous versions. + +The internal representation of all IP objects is in 128 bit IPv6 notation. +IPv4 and IPv6 objects may be freely mixed. =head2 Overloaded Operators @@ -37,25 +127,6 @@ =cut -require 5.006_000; -use Carp; -use Socket; -use strict; -use warnings; -require Exporter; - -our @EXPORT_OK = qw(Compact Coalesce); - -our @ISA = qw(Exporter); - -our $VERSION = do { sprintf "%d.%02d", (q$Revision: 3.33 $ =~ /\d+/g) }; - -# Set to true, to enable recognizing of 4-octet binary notation IP -# addresses. Thanks to Steve Snodgrass for reporting. This can be done -# at the time of use-ing the module. See docs for details. - -our $Accept_Binary_IP = 0; - ############################################# # These are the overload methods, placed here # for convenience. @@ -63,73 +134,6 @@ use overload - '+' => \&plus, - - '-' => \&minus, - - '++' => \&plusplus, - - '--' => \&minusminus, - - "=" => sub { - return _fnew NetAddr::IP [ $_[0]->{addr}, $_[0]->{mask}, - $_[0]->{bits} ]; - }, - - '""' => sub { $_[0]->cidr(); }, - - 'eq' => sub { - my $a = ref $_[0] eq 'NetAddr::IP' ? $_[0]->cidr : $_[0]; - my $b = ref $_[1] eq 'NetAddr::IP' ? $_[1]->cidr : $_[1]; - $a eq $b; - }, - - '==' => sub { - return 0 unless ref $_[0] eq 'NetAddr::IP'; - return 0 unless ref $_[1] eq 'NetAddr::IP'; - $_[0]->cidr eq $_[1]->cidr; - }, - - '>' => sub { - return undef unless $_[0]->{bits} == $_[1]->{bits}; - return ($_[0]->numeric)[1] > ($_[1]->numeric)[1] - if scalar($_[0]->numeric()) == scalar($_[1]->numeric()); - return scalar($_[0]->numeric()) > scalar($_[1]->numeric()); - }, - - '<' => sub { - return undef unless $_[0]->{bits} == $_[1]->{bits}; - return ($_[0]->numeric)[1] < ($_[1]->numeric)[1] - if scalar($_[0]->numeric()) == scalar($_[1]->numeric()); - return scalar($_[0]->numeric()) < scalar($_[1]->numeric()); - }, - - '>=' => sub { - return undef unless $_[0]->{bits} == $_[1]->{bits}; - return scalar($_[0]->numeric()) >= scalar($_[1]->numeric()); - }, - - '<=' => sub { - return undef unless $_[0]->{bits} == $_[1]->{bits}; - return scalar($_[0]->numeric()) <= scalar($_[1]->numeric()); - }, - - '<=>' => sub { - - return undef unless $_[0]->{bits} == $_[1]->{bits}; - return ($_[0]->numeric)[1] <=> ($_[1]->numeric)[1] - if scalar($_[0]->numeric()) == scalar($_[1]->numeric()); - return scalar($_[0]->numeric()) <=> scalar($_[1]->numeric()); - }, - - 'cmp' => sub { - - return undef unless $_[0]->{bits} == $_[1]->{bits}; - return ($_[0]->numeric)[1] <=> ($_[1]->numeric)[1] - if scalar($_[0]->numeric()) == scalar($_[1]->numeric()); - return scalar($_[0]->numeric()) <=> scalar($_[1]->numeric()); - }, - '@{}' => sub { return [ $_[0]->hostenum ]; }; @@ -142,14 +146,22 @@ Has been optimized to copy one NetAddr::IP object to another very quickly. +=item Bcopy()>> + +The B)> operation is only put in to operation when the +copied object is further mutated by another overloaded operation. See +L B for details. + +Bcopy()>> actually creates a new object when called. + =item B An object can be used just as a string. For instance, the following code - my $ip = new NetAddr::IP 'loopback'; + my $ip = new NetAddr::IP '192.168.1.123'; print "$ip\n"; -Will print the string 127.0.0.1/8. +Will print the string 192.168.1.123/32. =item B @@ -157,7 +169,7 @@ comparison with arbitrary strings as well as NetAddr::IP objects. The following example: - if (NetAddr::IP->new('loopback') eq '127.0.0.1/8') + if (NetAddr::IP->new('127.0.0.1','255.0.0.0') eq '127.0.0.1/8') { print "Yes\n"; } Will print out "Yes". @@ -169,29 +181,11 @@ =item B, E, E=, E=, E=E and C> -Those are numeric comparisons. All will return undef if you attempt to -compare a V4 subnet with a V6 subnet, when V6 becomes supported some -day. - -In case the version matches, the numeric representation of the network -is compared through the corresponding operation. The netmask is -ignored for these comparisons, as there is no standard criteria to say -wether 10/8 is larger than 10/10 or not. - -=item B - -You can do something along the lines of - - my $net = new NetAddr::IP $cidr_spec; - for my $ip (@$net) { - print "Host $ip is in $net\n"; - } - -However, note that this might generate a very large amount of items in -the list. You must be careful when doing this kind of expansion, as it -is very easy to consume huge amounts of resources. See below for -smarter ways to do loops and other constructions that are much more -conservative. +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. =item B @@ -199,7 +193,7 @@ point to the one so many hosts above the start address. For instance, this code: - print NetAddr::IP->new('loopback') + 5; + print NetAddr::IP->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: @@ -208,100 +202,16 @@ outputs 10.0.0.0/24. -=cut - -sub plus { - my $ip = shift; - my $const = shift; - - return $ip unless $const; - - my $b = $ip->{bits}; - my $a = $ip->{addr}; - my $m = $ip->{mask}; - - my $hp = "$a" & ~"$m"; - my $np = "$a" & "$m"; - - if ($b == 128) # v6? - { - use Math::BigInt; - - my $num = new Math::BigInt 0; - - for (0 .. 15) - { - $num <<= 8; - $num |= vec($hp, $_, 8); - } - - $num->badd($const); - - for (reverse 0 .. 15) - { - my $x = new Math::BigInt $num; - vec($hp, $_, 8) = $x & 0xFF; - $num >>= 8; - } - } - else # v4 - { - vec($hp, 0, $b) += $const; - } - - return _fnew NetAddr::IP [ "$np" | ("$hp" & ~"$m"), $m, $b]; -} - =item B The complement of the addition of a constant. -=cut - -sub minus { - my $ip = shift; - my $const = shift; - - return plus($ip, -$const, @_); -} - - # Auto-increment an object -=pod - =item B Auto-incrementing a NetAddr::IP object causes the address part to be adjusted to the next host address within the subnet. It will wrap at the broadcast address and start again from the network address. -=cut - -sub plusplus { - my $ip = shift; - - my $a = $ip->{addr}; - my $m = $ip->{mask}; - my $b = $ip->{bits}; - - if ($b == 128) - { - my $nip = NetAddr::IP->new($ip) + 1; - $ip->{$_} = $nip->{$_} for keys %$nip; - } - else - { - my $hp = "$a" & ~"$m"; - my $np = "$a" & "$m"; - - vec($hp, 0, 32) ++; - $ip->{addr} = "$np" | ("$hp" & ~"$m"); - } - - return $ip; -} - -=pod - =item B Auto-decrementing a NetAddr::IP object performs exactly the opposite @@ -309,30 +219,6 @@ =cut -sub minusminus { - my $ip = shift; - - my $a = $ip->{addr}; - my $m = $ip->{mask}; - my $b = $ip->{bits}; - - if ($b == 128) - { - my $nip = NetAddr::IP->new($ip) - 1; - $ip->{$_} = $nip->{$_} for keys %$nip; - } - else - { - my $hp = "$a" & ~"$m"; - my $np = "$a" & "$m"; - - vec($hp, 0, 32) --; - - $ip->{addr} = "$np" | ("$hp" & ~"$m"); - } - return $ip; -} - ############################################# # End of the overload methods. ############################################# @@ -340,75 +226,84 @@ # Preloaded methods go here. - # This is a variant to ->new() that - # creates and blesses a new object - # without the fancy parsing of - # IP formats and shorthands. +=pod -sub _fnew ($$) { - my $type = shift; - my $class = ref($type) || $type || "NetAddr::IP"; - my $r_addr = shift; +=back - return - bless { addr => $r_addr->[0], - mask => $r_addr->[1], - bits => $r_addr->[2] }, - $class; -} +=head2 Serializing and Deserializing - # Returns 2 ** $bits -1 (ie, - # $bits one bits) -sub _ones ($) { - my $bits = shift; - return ~vec('', 0, $bits); -} +This module defines hooks to collaborate with L for +serializing C objects, through compact and human readable +strings. You can revert to the old format by invoking this module as - # Validates that a mask is composed - # of a contiguous set of bits -sub _contiguous ($$) + use NetAddr::IP ':old_storable'; + +You must do this if you have legacy data files containing NetAddr::IP +objects stored using the L module. + +=cut + +sub import { - my $mask = shift; - my $octets = shift; + if (grep { $_ eq ':old_storable' } @_) { + @_ = grep { $_ ne ':old_storable' } @_; + } else { + *{STORABLE_freeze} = sub + { + my $self = shift; + return $self->cidr(); # use stringification + }; + *{STORABLE_thaw} = sub + { + my $self = shift; + my $cloning = shift; # Not used + my $serial = shift; + + my $ip = new NetAddr::IP $serial; + $self->{addr} = $ip->{addr}; + $self->{mask} = $ip->{mask}; + $self->{isv6} = $ip->{isv6}; + return; + }; + } -# return 1 unless defined $mask and defined $octets; - - $octets /= 8; - - for my $o (0 .. $octets) + if (grep { $_ eq ':aton' } @_) { - my $v = vec($mask, $o, 8); -# return unless grep { $v == $_ } -# (255, 254, 252, 248, 240, 224, 192, 128, 0); - return unless $v == 255 or $v == 254 or $v == 252 or - $v == 248 or $v == 240 or $v == 224 or $v == 192 or - $v == 128 or $v == 0; + $NetAddr::IP::Lite::Accept_Binary_IP = 1; + @_ = grep { $_ ne ':aton' } @_; } - - 1; -} - -sub _to_quad ($) { - my $vec = shift; - return vec($vec, 0, 8) . '.' . - vec($vec, 1, 8) . '.' . - vec($vec, 2, 8) . '.' . - vec($vec, 3, 8); -} - -sub _to_ipv6 ($) { - my $vec = shift; - my $r = ''; - - foreach (0..3) { - $r .= ':' . sprintf("%02x%02x:%02x%02x", - vec($vec, 4*$_, 8), vec($vec, 4*$_ + 1, 8), - vec($vec, 4*$_ + 2, 8), vec($vec, 4*$_ + 3, 8)); + if (grep { $_ eq ':old_nth' } @_) + { + $NetAddr::IP::Lite::Old_nth = 1; + @_ = grep { $_ ne ':old_nth' } @_; } - $r =~ s/^://; - return $r; + NetAddr::IP->export_to_level(1, @_); } +sub compact { + return @{compactref(\@_)}; +} + +*Compact = \&compact; + +sub Coalesce { + return &coalesce; +} + +sub hostenumref($) { + my $r = $_[0]->splitref(); + unless ((notcontiguous($_[0]->{mask}))[1] == 128) { + splice(@$r, 0, 1); + splice(@$r, scalar @$r - 1, 1); + } + return $r; +} + +sub DESTROY {}; + +1; +__END__ + sub do_prefix ($$$) { my $mask = shift; my $faddr = shift; @@ -437,447 +332,6 @@ } } -sub _parse_mask ($$) { - my $mask = shift; - my $bits = shift; - - my $bmask = ''; - - if ($bits == 128) { - if (grep(lc $mask eq $_ , qw(unspecified loopback))) { - for (0..3) { - vec($bmask, $_, 32) = 0xFFFFFFFF; - } - } - elsif ($mask =~ /^(\d+)$/ && $1 <= 128) { - foreach (0..3) { - if ($mask >= 32*($_ + 1)) { - vec($bmask, $_, 32) = 0xFFFFFFFF; - } - elsif ($mask > 32*$_) { - vec($bmask, $_, 32) = 0xFFFFFFFF; - vec($bmask, $_, 32) <<= (32*($_ + 1) - $mask); - } - else { - vec($bmask, $_, 32) = 0x0; - } - } - } - else { - $bmask = undef; - } - } - elsif ($mask eq '32') - { - # *Very* common case - # $bmask = "\xff\xff\xff\xff"; - vec($bmask, 0, 32) = 0xffffffff; - } - elsif ($mask =~ m/^(\d+)$/ and $1 <= 32) { - # Another very common case - if ($1) { - vec($bmask, 0, $bits) = _ones $bits; - vec($bmask, 0, $bits) <<= ($bits - $1); - } else { - vec($bmask, 0, $bits) = 0x0; - } - } - elsif (lc $mask eq 'default' or lc $mask eq 'any') { - vec($bmask, 0, $bits) = 0x0; - } - elsif (lc $mask eq 'broadcast' or lc $mask eq 'host') { - vec($bmask, 0, $bits) = _ones $bits; - } - elsif (lc $mask eq 'loopback') { - vec($bmask, 0, 8) = 255; - vec($bmask, 1, 8) = 0; - vec($bmask, 2, 8) = 0; - vec($bmask, 3, 8) = 0; - } - elsif ($mask =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) { - - for my $i ($1, $2, $3, $4) { - return undef - unless grep { $i == $_ } - (255, 254, 252, 248, 240, 224, 192, 128, 0); - } - - return undef if ($1 < $2 or $2 < $3 or $3 < $4); - - return undef if $2 != 0 and $1 != 255; - return undef if $3 != 0 and $2 != 255; - return undef if $4 != 0 and $3 != 255; - - vec($bmask, 0, 8) = $1; - vec($bmask, 1, 8) = $2; - vec($bmask, 2, 8) = $3; - vec($bmask, 3, 8) = $4; - } - elsif ($mask =~ m/^(\d+)$/) { - vec($bmask, 0, $bits) = $1; - } - - $bmask; -} - -sub _obits ($$) { - my $lo = shift; - my $hi = shift; - - return 0xFF if $lo == $hi; - return (~ ($hi ^ $lo)) & 0xFF; -} - -sub _v4 ($$$) { - my $ip = shift; - my $mask = shift; - my $present = shift; - - my $addr = ''; - my $a; - - if ($ip =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/ - and $1 >= 0 and $1 <= 255 - and $2 >= 0 and $2 <= 255 - and $3 >= 0 and $3 <= 255 - and $4 >= 0 and $4 <= 255) - { - # The most frequent case - vec($addr, 0, 8) = $1; - vec($addr, 1, 8) = $2; - vec($addr, 2, 8) = $3; - vec($addr, 3, 8) = $4; - } - elsif ($ip =~ m/^(\d+)\.(\d+)$/ - and $1 >= 0 and $1 <= 255 - and $2 >= 0 and $2 <= 255) - { - vec($addr, 0, 8) = $1; - vec($addr, 1, 8) = ($present ? $2 : 0); - vec($addr, 2, 8) = 0; - vec($addr, 3, 8) = ($present ? 0 : $2); - } - elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)$/ - and $1 >= 0 and $1 <= 255 - and $2 >= 0 and $2 <= 255 - and $3 >= 0 and $3 <= 255) - { - vec($addr, 0, 8) = $1; - vec($addr, 1, 8) = $2; - vec($addr, 2, 8) = ($present ? $3 : 0); - vec($addr, 3, 8) = ($present ? 0 : $3); - } - elsif ($ip =~ m/^([xb\d]+)$/ and $1 >= 0 and $1 < 255 and $present) - { - vec($addr, 0, 8) = $1; - vec($addr, 1, 8) = 0; - vec($addr, 2, 8) = 0; - vec($addr, 3, 8) = 0; - } - elsif ($ip =~ m/^(-?[xb\d]+)$/) - { - my $num = $1; - $num += 2 ** 32 if $num < 0; - vec($addr, 0, 32) = $1; - } - - # The notations below, include an - # implicit mask specification. - - elsif ($ip =~ m/^(\d+)\.$/ and $1 >= 0 and $1 <= 255) { - #print "^(\\d+)\\.\$\n"; - vec($addr, 0, 8) = $1; - vec($addr, 1, 8) = 0; - vec($addr, 2, 8) = 0; - vec($addr, 3, 8) = 0; - vec($mask, 0, 32) = 0xFF000000; - } - elsif ($ip =~ m/^(\d+)\.(\d+)-(\d+)\.?$/ - and $1 >= 0 and $1 <= 255 - and $2 >= 0 and $2 <= 255 - and $3 >= 0 and $3 <= 255 - and $2 <= $3) { - #print "^(\\d+)\\.(\\d+)-(\\d+)\\.?\$\n"; - vec($addr, 0, 8) = $1; - vec($addr, 1, 8) = $2; - vec($addr, 2, 8) = 0; - vec($addr, 3, 8) = 0; - - vec($mask, 0, 32) = 0x0; - vec($mask, 0, 8) = 0xFF; - vec($mask, 1, 8) = _obits $2, $3; - } - elsif ($ip =~ m/^(\d+)-(\d+)\.?$/ - and $1 >= 0 and $1 <= 255 - and $2 >= 0 and $2 <= 255 - and $1 <= $2) { - #print "^(\\d+)-(\\d+)\\.?\$\n"; - vec($addr, 0, 8) = $1; - vec($addr, 1, 8) = 0; - vec($addr, 2, 8) = 0; - vec($addr, 3, 8) = 0; - - vec($mask, 0, 32) = 0x0; - vec($mask, 0, 8) = _obits $1, $2; - } - elsif ($ip =~ m/^(\d+)\.(\d+)\.$/ and $1 >= 0 - and $1 <= 255 and $2 >= 0 and $2 <= 255) - { - #print "^(\\d+)\\.(\\d+)\\.\$\n"; - vec($addr, 0, 8) = $1; - vec($addr, 1, 8) = $2; - vec($addr, 2, 8) = 0; - vec($addr, 3, 8) = 0; - vec($mask, 0, 32) = 0xFFFF0000; - } - elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)-(\d+)\.?$/ - and $1 >= 0 and $1 <= 255 - and $2 >= 0 and $2 <= 255 - and $3 >= 0 and $3 <= 255 - and $4 >= 0 and $4 <= 255 - and $3 <= $4) { - #print "^(\\d+)\\.(\\d+)\\.(\\d+)-(\\d+)\\.?\$\n"; - vec($addr, 0, 8) = $1; - vec($addr, 1, 8) = $2; - vec($addr, 2, 8) = $3; - vec($addr, 3, 8) = 0; - - vec($mask, 0, 32) = 0x0; - vec($mask, 0, 8) = 0xFF; - vec($mask, 1, 8) = 0xFF; - vec($mask, 2, 8) = _obits $3, $4; - } - elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)\.$/ and $1 >= 0 - and $1 <= 255 and $2 >= 0 and $2 <= 255 - and $3 >= 0 and $3 <= 255) - { - #print "^(\\d+)\\.(\\d+)\\.(\\d+)\\.\$\n"; - vec($addr, 0, 8) = $1; - vec($addr, 1, 8) = $2; - vec($addr, 2, 8) = $3; - vec($addr, 3, 8) = 0; - vec($mask, 0, 32) = 0xFFFFFF00; - } - elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+)-(\d+)$/ - and $1 >= 0 and $1 <= 255 - and $2 >= 0 and $2 <= 255 - and $3 >= 0 and $3 <= 255 - and $4 >= 0 and $4 <= 255 - and $5 >= 0 and $5 <= 255 - and $4 <= $5) { - #print "^(\\d+)\\.(\\d+)\\.(\\d+)\\.(\\d+)-(\\d+)\$\n"; - vec($addr, 0, 8) = $1; - vec($addr, 1, 8) = $2; - vec($addr, 2, 8) = $3; - vec($addr, 3, 8) = $4; - - vec($mask, 0, 8) = 0xFF; - vec($mask, 1, 8) = 0xFF; - vec($mask, 2, 8) = 0xFF; - vec($mask, 3, 8) = _obits $4, $5; - } - elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+) - \s*-\s*(\d+)\.(\d+)\.(\d+)\.(\d+)$/x - and $1 >= 0 and $1 <= 255 - and $2 >= 0 and $2 <= 255 - and $3 >= 0 and $3 <= 255 - and $4 >= 0 and $4 <= 255 - and $5 >= 0 and $5 <= 255 - and $6 >= 0 and $6 <= 255 - and $7 >= 0 and $7 <= 255 - and $8 >= 0 and $8 <= 255) - { - my $last = ''; - - vec($addr, 0, 8) = $1; - vec($addr, 1, 8) = $2; - vec($addr, 2, 8) = $3; - vec($addr, 3, 8) = $4; - - vec($last, 0, 8) = $5; - vec($last, 1, 8) = $6; - vec($last, 2, 8) = $7; - vec($last, 3, 8) = $8; - - vec($mask, 0, 8) = _obits $1, $5; - vec($mask, 1, 8) = _obits $2, $6; - vec($mask, 2, 8) = _obits $3, $7; - vec($mask, 3, 8) = _obits $4, $8; - - # Barf on invalid ranges. There can only be one - # octet in the netmask that is neither 0 nor 255. - - return - if grep ({ - vec($mask, $_, 8) != 0 - and vec($mask, $_, 8) != 255 - } (0 .. 3)) > 1; - - # Barf on invalid ranges. No octet on the right - # can be larger that any octet on the left - - for (0 .. 2) - { - return if vec($mask, $_, 8) < vec($mask, $_ + 1, 8); - } - } - elsif ($Accept_Binary_IP - and !$present and length($ip) == 4) { - my @o = unpack("C4", $ip); - - vec($addr, $_, 8) = $o[$_] for 0 .. 3; - vec($mask, 0, 32) = 0xFFFFFFFF; - } - elsif (lc $ip eq 'default' or lc $ip eq 'any') { - vec($addr, 0, 32) = 0x0; - } - elsif (lc $ip eq 'broadcast') { - vec($addr, 0, 32) = _ones 32; - } - elsif (lc $ip eq 'loopback') { - vec($addr, 0, 8) = 127; - vec($addr, 3, 8) = 1; - } - elsif (($a = gethostbyname($ip)) and defined($a) - and ($a ne pack("C4", 0, 0, 0, 0))) { - if ($a and inet_ntoa($a) =~ m!^(\d+)\.(\d+)\.(\d+)\.(\d+)$!) { - vec($addr, 0, 8) = $1; - vec($addr, 1, 8) = $2; - vec($addr, 2, 8) = $3; - vec($addr, 3, 8) = $4; - } - } - else { -# croak "Cannot obtain an IP address out of $ip"; - return; - } - - # Return the completed hash (no explicit return as this seems to be - # faster...) - { addr => $addr, mask => $mask, bits => 32 }; -} - -sub expand_v6 ($) { - my $pat = shift; - - if (length($pat) < 4) { - $pat = ('0' x (4 - length($pat))) . $pat; - } - return $pat; -} - -sub _v6_part ($$$) { - my $addr = shift; - my $four = shift; - my $n = shift; - - my($a, $b); - - return undef unless length($four) == 4; - $four =~ /^(.{2})(.{2})/; - ($a, $b) = ($1, $2); - - vec($addr, 2*$n, 8) = hex($a); - vec($addr, 2*$n + 1, 8) = hex($b); - - return $addr; -} - -sub _v6 ($$$) { - my $ip = lc shift; - my $mask = shift; - my $present = shift; - - my $addr = ''; - my $colons; - my $expanded; - my @ip; - - if ($ip eq 'unspecified') { - $ip = '::'; - } - elsif ($ip eq 'loopback') { - $ip = '::1'; - } - elsif ($ip =~ /:::/ || $ip =~ /::.*::/) { - return; - } - return unless $ip =~ /^[\da-f\:]+$/i; - - $colons = ($ip =~ tr/:/:/); - return unless $colons >= 2 && $colons <= 7; - $expanded = ':0' x (9 - $colons); - $expanded =~ s/0$// if ($ip =~ /[\da-f]+::[\da-f]+/); -# warn "# colons = $colons\n"; -# warn "# expanded = $expanded\n"; - $ip =~ s/::/$expanded/; - $ip = '0' . $ip if $ip =~ /^:/; -# warn "# ip = $ip\n"; - # .:.:.:.:.:.:.:. - @ip = split(/:/, $ip); - grep($_ = expand_v6($_), @ip);; - for (0..$#ip) { - $addr = _v6_part($addr, $ip[$_], $_); - return unless defined $addr; - } - - return { addr => $addr, mask => $mask, bits => 128 }; -} - -sub new4 ($$;$) { - new($_[0], $_[1], $_[2]); -} - -=pod - -=back - -=head2 Serializing and Deserializing - -This module defines hooks to collaborate with L for -serializing C objects, through compact and human readable -strings. You can revert to the old format by invoking this module as - - use NetAddr::IP ':old_storable'; - -You must do this if you have legacy data files containing NetAddr::IP -objects stored using the L module. - -=cut - -sub import -{ - unless (grep { $_ eq ':old_storable' } @_) - { - *{STORABLE_freeze} = sub - { - my $self = shift; - return $self->cidr(); # use stringification - }; - *{STORABLE_thaw} = sub - { - my $self = shift; - my $cloning = shift; # Not used - my $serial = shift; - - my $ip = new NetAddr::IP $serial; - $self->{addr} = $ip->{addr}; - $self->{mask} = $ip->{mask}; - $self->{bits} = $ip->{bits}; - return; - }; - } - - if (grep { $_ eq ':aton' } @_) - { - $Accept_Binary_IP = 1; - } - - @_ = grep { $_ ne ':old_storable' } @_; - @_ = grep { $_ ne ':aton' } @_; - NetAddr::IP->export_to_level(1, @_); -} - =pod =head2 Methods @@ -886,9 +340,23 @@ =item C<-Enew([$addr, [ $mask|IPv6 ]])> -This method creates a new IPv4 address with the supplied address in +=item C<-Enew6([$addr, [ $mask]])> + +These methods creates a new address with the supplied address in C<$addr> and an optional netmask C<$mask>, which can be omitted to get -a /32 mask. +a /32 or /128 netmask for IPv4 / IPv6 addresses respectively + +C<-Enew6> marks the address as being in ipV6 address space even if the +format would suggest otherwise. + + i.e. ->new6('1.2.3.4') will result in ::102:304 + + addresses submitted to ->new in ipV6 notation will + remain in that notation permanently. i.e. + ->new('::1.2.3.4') will result in ::102:304 + whereas new('1.2.3.4') would print out as 1.2.3.4 + + See "STRINGIFICATION" below. C<$addr> can be almost anything that can be resolved to an IP address in all the notations I have seen over time. It can optionally contain @@ -908,68 +376,38 @@ If called with no arguments, 'default' is assumed. -IPv6 addresses according to RFC 1884 are also supported, except IPv4 -compatible IPv6 addresses. +C<$addr> can be any of the following and possibly more... -=cut + n.n + n.n/mm + n.n.n + n.n.n/mm + n.n.n.n + n.n.n.n/mm 32 bit cidr notation + n.n.n.n/m.m.m.m + loopback, localhost, broadcast, any, default + x.x.x.x/host + 0xABCDEF, 0b111111000101011110, (a bcd number) + a netaddr as returned by 'inet_aton' -sub new ($$;$) { - my $type = $_[0]; - my $class = ref($type) || $type || "NetAddr::IP"; - my $ip = $_[1]; - my $hasmask = 1; - my $bits; - my $mask; - $ip = 'default' unless defined $ip; - $bits = index($ip, ':') >= 0 ? 128 : 32; +Any RFC1884 notation - if (@_ == 2) { - if ($ip =~ m!^(.+)/(.+)$!) { - $ip = $1; - $mask = $2; - } - elsif (grep { lc $ip eq $_ } (qw(default any broadcast loopback))) - { - $mask = $ip; - } - } + ::n.n.n.n + ::n.n.n.n/mmm 128 bit cidr notation + ::n.n.n.n/::m.m.m.m + ::x:x + ::x:x/mmm + x:x:x:x:x:x:x:x + x:x:x:x:x:x:x:x/mmm + x:x:x:x:x:x:x:x/m:m:m:m:m:m:m:m any RFC1884 notation + loopback, localhost, unspecified, any, default + ::x:x/host + 0xABCDEF, 0b111111000101011110 within the limits + of perl's number resolution + 123456789012 a 'big' bcd number i.e. Math::BigInt - if (defined $_[2]) { - if ($_[2] =~ /^ipv6$/i) { - if (grep { lc $ip eq $_ } (qw(unspecified loopback))) { - $bits = 128; - $mask = _parse_mask $ip, $bits; - } - else { - return undef; - } - } - else { - $mask = _parse_mask $_[2], $bits; - } - return undef unless defined $mask; - } - elsif (defined $mask) { - $mask = _parse_mask $mask, $bits; - return undef unless defined $mask; - } - else { - $hasmask = 0; - $mask = _parse_mask $bits, $bits; - return undef unless defined $mask; - } - - my $self = $bits == 32 ? _v4($ip, $mask, $hasmask) - : _v6($ip, $mask, $hasmask); - - return unless $self; - return unless _contiguous $self->{mask}, $self->{bits}; - - return bless $self, $class; -} - -=pod +If called with no arguments, 'default' is assumed. =item C<-Ebroadcast()> @@ -978,211 +416,91 @@ where the netmask has zero bits. This is normally used to address all the hosts in a given subnet. -=cut - -sub broadcast ($) { - my $self = shift; - return $self->_fnew($self->_broadcast); -} - -sub _broadcast ($) { - my $self = shift; - my $a = $self->{addr}; - my $m = $self->{mask}; - my $c = ''; - - vec($c, 0, $self->{bits}) = _ones $self->{bits}; - vec($c, 0, $self->{bits}) ^= vec($m, 0, $self->{bits}); - - return [ "$a" | ~ "$m" | $c, $self->{mask}, $self->{bits} ]; -} - -=pod - =item C<-Enetwork()> Returns a new object refering to the network address of a given subnet. A network address has all zero bits where the bits of the netmask are zero. Normally this is used to refer to a subnet. -=cut - -sub network ($) { - my $self = shift; - return $self->_fnew($self->_network); -} - -sub _network ($) { - my $self = shift; - my $a = $self->{addr}; - my $m = $self->{mask}; - - return [ "$a" & "$m", $self->{mask}, $self->{bits} ]; -} - -=pod - =item C<-Eaddr()> -Returns a scalar with the address part of the object as a -dotted-quad. This is useful for printing or for passing the address -part of the NetAddr::IP object to other components that expect an IP -address. - -=cut - -sub addr ($) { - my $self = shift; - $self->{bits} == 32 ? _to_quad $self->{addr} - : _to_ipv6 $self->{addr}; -} - - -=pod +Returns a scalar with the address part of the object as an IPv4 or IPv6 text +string as appropriate. This is useful for printing or for passing the +address part of the NetAddr::IP object to other components that expect an IP +address. If the object is an ipV6 address or was created using ->new6($ip) +it will be reported in ipV6 hex format otherwise it will be reported in dot +quad format only if it resides in ipV4 address space. =item C<-Emask()> -Returns a scalar with the mask as a dotted-quad. - -=cut - -sub mask ($) { - my $self = shift; - $self->{bits} == 32 ? _to_quad $self->{mask} - : _to_ipv6 $self->{mask}; -} - -=pod +Returns a scalar with the mask as an IPv4 or IPv6 text string as +described above. =item C<-Emasklen()> Returns a scalar the number of one bits in the mask. -=cut - -sub masklen ($) { - my $self = shift; - my $bits = 0; - - for (my $i = 0; - $i < $self->{bits}; - $i ++) - { - $bits += vec($self->{mask}, $i, 1); - } - - return $bits; -} - -=pod - =item C<-Ebits()> -Returns the wide of the address in bits. Normally 32 for v4 and 128 for v6. - -=cut - -sub bits { return $_[0]->{bits}; } - -=pod +Returns the width of the address in bits. Normally 32 for v4 and 128 for v6. =item C<-Eversion()> Returns the version of the address or subnet. Currently this can be either 4 or 6. -=cut - -sub version { return $_[0]->{bits} == 32 ? 4 : 6; } - -=pod - =item C<-Ecidr()> Returns a scalar with the address and mask in CIDR notation. A NetAddr::IP object I to the result of this function. - -=cut - -sub cidr ($) { - my $self = shift; - return $self->addr . '/' . $self->masklen; -} - -=pod +(see comments about ->new6() and ->addr() for output formats) =item C<-Eaton()> Returns the address part of the NetAddr::IP object in the same format -as the C function. This should ease a bit the code -required to deal with "old-style" sockets. - -=cut - -sub aton { - my $self = shift; - return pack "C4", split /\./, $self->addr; -} - -=pod +as the C or C function respectively. If the object +was created using ->new6($ip), the address returned will always be in ipV6 +format, even for addresses in ipV4 address space. =item C<-Erange()> Returns a scalar with the base address and the broadcast address separated by a dash and spaces. This is called range notation. -=cut - -sub range ($) { - my $self = shift; - my $mask = $self->masklen; - - return undef if $self->{bits} > 32; - return $self->network->addr . ' - ' . $self->broadcast->addr; -} - -=pod - =item C<-Eprefix()> -Returns a scalar with the address and mask in prefix +Returns a scalar with the address and mask in ipV4 prefix representation. This is useful for some programs, which expect its input to be in this format. This method will include the broadcast address in the encoding. =cut -sub prefix ($) { - my $self = shift; - my $mask = $self->masklen; - - return undef if $self->{bits} > 32; - return $self->addr if $mask == 32; - - my @faddr = split (/\./, $self->first->addr); - my @laddr = split (/\./, $self->broadcast->addr); - +# only applicable to ipV4 +sub prefix($) { + return undef if $_[0]->{isv6}; + my $mask = (notcontiguous($_[0]->{mask}))[1]; + return $_[0]->addr if $mask == 128; + $mask -= 96; + my @faddr = split (/\./, $_[0]->first->addr); + my @laddr = split (/\./, $_[0]->broadcast->addr); return do_prefix $mask, \@faddr, \@laddr; } -=pod - =item C<-Enprefix()> Just as C<-Eprefix()>, but does not include the broadcast address. =cut -sub nprefix ($) { - my $self = shift; - my $mask = $self->masklen; - - return undef if $self->{bits} > 32; - return $self->addr if $mask == 32; - - my @faddr = split (/\./, $self->first->addr); - my @laddr = split (/\./, $self->last->addr); - +# only applicable to ipV4 +sub nprefix($) { + return undef if $_[0]->{isv6}; + my $mask = (notcontiguous($_[0]->{mask}))[1]; + return $_[0]->addr if $mask == 128; + $mask -= 96; + my @faddr = split (/\./, $_[0]->first->addr); + my @laddr = split (/\./, $_[0]->last->addr); return do_prefix $mask, \@faddr, \@laddr; } @@ -1199,41 +517,10 @@ This method is essential for serializing the representation of a subnet. -=cut - -sub numeric ($) { - my $self = shift; - if ($self->version == 4) - { - return - wantarray() ? ( vec($self->{addr}, 0, 32), - vec($self->{mask}, 0, 32) ) : - vec($self->{addr}, 0, 32); - } - else - { - my $n = new Math::BigInt 0; - my $m = new Math::BigInt 0 if wantarray; - for (0 .. 3) - { - $n <<= 32; - $n += vec($self->{addr}, $_, 32); - if (wantarray) - { - $m <<= 32; - $m += vec($self->{mask}, $_, 32); - } - } - return wantarray ? ($n, $m) : $n; - } -} - -=pod - =item C<-Ewildcard()> When called in a scalar context, returns the wildcard bits -corresponding to the mask, in dotted-quad format. +corresponding to the mask, in dotted-quad or ipV6 format as applicable. When called in an array context, returns a two-element array. The first element, is the address part. The second element, is the @@ -1241,21 +528,25 @@ =cut -sub wildcard ($) { - my $self = shift; - return undef if $self->{bits} > 32; - return wantarray() ? ($self->addr, _to_quad ~$self->{mask}) : - _to_quad ~$self->{mask}; - +sub wildcard($) { + my $copy = $_[0]->copy; + $copy->{addr} = ~ $copy->{mask}; + $copy->{addr} &= V4net unless $copy->{isv6}; + if (wantarray) { + return ($_[0]->addr, $copy->addr); + } + return $copy->addr; } =pod =item C<-Eshort()> -Returns the address part in a short or compact notation. (ie, -127.0.0.1 becomes 127.1). Works with both, V4 and V6. Note that -C is now deprecated. +Returns the address part in a short or compact notation. + + (ie, 127.0.0.1 becomes 127.1). + +Works with both, V4 and V6. =cut @@ -1298,23 +589,37 @@ return $addr; } -sub short ($) -{ - my $self = shift; - my $addr = $self->addr; - if ($self->{bits} == 32) - { - my @o = split(/\./, $addr, 4); - splice(@o, 1, 2) if $o[1] == 0 and $o[2] == 0; - return join '.', @o; + +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; } - else - { - return _compact_v6 _to_ipv6 $self->{addr}; - } + $addr[$_] = $addr[$_ -1] = ''; + $found = '1'; + } + (my $rv = join(':',@addr)) =~ s/:+:/::/; + return $rv; } -# *{compact_addr} = \&short; +sub short($) { + my $addr = $_[0]->addr; + if (! $_[0]->{isv6} && isIPv4($_[0]->{addr})) { + my @o = split(/\./, $addr, 4); + splice(@o, 1, 2) if $o[1] == 0 and $o[2] == 0; + return join '.', @o; + } + return _compV6($addr); +} =pod @@ -1322,37 +627,7 @@ Returns true when C<$me> completely contains C<$other>. False is returned otherwise and C is returned if C<$me> and C<$other> -are of different versions. - -Note that C<$me> and C<$other> must be C objects. - -=cut - -sub contains ($$) { - my $a = shift; - my $b = shift; - - my $bits = $a->{bits}; - - my $mask; - - # Both must be of the same length... - return undef - unless $bits == $b->{bits}; - - # $a must be less specific than $b... - my ($a_addr, $a_mask) = $a->numeric; - my ($b_addr, $b_mask) = $b->numeric; - - return 0 unless $a_mask <= $b_mask; - - # A default address always contains - return 1 if ($a_mask == 0x0); - - return ($a_addr & $a_mask) == ($b_addr & $a_mask); -} - -=pod +are not both C objects. =item C<$me-Ewithin($other)> @@ -1361,14 +636,6 @@ Note that C<$me> and C<$other> must be C objects. -=cut - -sub within ($$) { - return contains($_[1], $_[0]); -} - -=pod - =item C<-Esplit($bits)> Returns a list of objects, representing subnets of C<$bits> mask @@ -1393,99 +660,34 @@ 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 $self = shift; - my $mask = _parse_mask shift || $self->{bits}, $self->{bits}; - - my $bits = $self->{bits}; - - my @ret; - - if (vec($self->{mask}, 0, $bits) - <= vec($mask, 0, $bits)) - { - my $num = ''; - my $v = ''; - - my $net = $self->network->{addr}; - $net = "$net" & "$mask"; - - my $to = $self->broadcast->{addr}; - $to = "$to" & "$mask"; - - if ($bits == 128) - { - use Math::BigInt; - - my $n = new Math::BigInt 0; - my $t = new Math::BigInt 0; - my $u = new Math::BigInt 0; - my $x = ''; - - for (0 .. 15) - { - vec($num, $_, 8) = _ones 8; - vec($num, $_, 8) ^= vec($mask, $_, 8); - $n <<= 8; - $t <<= 8; - $u <<= 8; - $n |= vec($net, $_, 8); - $t |= vec($to, $_, 8); - $u |= vec($num, $_, 8); - } - -# warn "# splitref $self $mask\n"; -# warn "# net = ", $self->network, "\n"; -# warn "# bro = ", $self->broadcast, "\n"; - -# warn "# before, n = $n\n"; -# warn "# before, t = $t\n"; -# warn "# before, u = $u\n"; - - $u++; - my $i = $n->copy; - - do { - - my $j = $i->copy; - -# warn "# i = $i\n"; -# warn "# j = $j\n"; -# warn "# n = $n\n"; -# warn "# u = $u\n"; -# warn "# t = $t\n"; -# warn "###\n"; - - for (reverse 0 .. 15) - { - vec($v, $_, 8) = ($j & 0xFF); - $j >>= 8; - } - - push @ret, $self->_fnew([ $v, $mask, $bits ]); -# warn "# add ", $self->_fnew([$v, $mask, $bits]), "\n"; - $i += $u; - } while ($i <= $t); - } - else - { - vec($num, 0, $bits) = _ones $bits; - vec($num, 0, $bits) ^= vec($mask, 0, $bits); - vec($num, 0, $bits) ++; - - for (my $i = vec($net, 0, $bits); - $i <= vec($to, 0, $bits); - $i += vec($num, 0, $bits)) - { - vec($v, 0, $bits) = $i; - push @ret, $self->_fnew([ $v, $mask, $bits ]); - } - } - } - - return \@ret; +sub 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]; + } + return \@ret; } =pod @@ -1506,21 +708,10 @@ Faster version of C<-Ehostenum()>, returning a reference to a list. -=cut - -sub hostenumref ($) { - my $r = $_[0]->splitref(32); - if ($_[0]->mask ne '255.255.255.255') { - splice(@$r, 0, 1); - splice(@$r, scalar @$r - 1, 1); - } - return $r; -} - -=pod - =item C<$me-Ecompact($addr1, $addr2, ...)> +=item C<@compacted_object_list = Compact(@object_list)> + Given a list of objects (including C<$me>), this method will compact all the addresses and subnets into the largest (ie, least specific) subnets possible that contain exactly all of the given objects. @@ -1530,20 +721,61 @@ "correct" approach has been adopted and only one address would be returned. -Note that C<$me> and all C<$addr>-n must be C objects. +Note that C<$me> and all C<$addr>'s must be C objects. + +=item C<$me-Ecompactref(\@list)> + +As usual, a faster version of =item C<-Ecompact()> that returns a +reference to a list. Note that this method takes a reference to a list +instead. + +Note that C<$me> must be a C object. =cut -sub compact { - return @{compactref(\@_)}; +sub compactref($) { + my @r = sort @{$_[0]} + or return []; + return [] unless @r; + foreach(0..$#r) { + $r[$_]->{addr} = $r[$_]->network->{addr}; + } + my $changed; + do { + $changed = 0; + for(my $i=0; $i <= $#r -1;$i++) { + if ($r[$i]->contains($r[$i +1])) { + splice(@r,$i +1,1); + ++$changed; + --$i; + } + elsif ((notcontiguous($r[$i]->{mask}))[1] == (notcontiguous($r[$i +1]->{mask}))[1]) { # masks the same + if (hasbits($r[$i]->network->{addr} ^ $r[$i +1]->network->{addr})) { # if not the same netblock + my $upnet = $r[$i]->copy; + $upnet->{mask} = shiftleft($upnet->{mask},1); + if ($upnet->contains($r[$i +1])) { # adjacent nets in next net up + $r[$i] = $upnet; + splice(@r,$i +1,1); + ++$changed; + --$i; + } + } else { # identical nets + splice(@r,$i +1,1); + ++$changed; + --$i; + } + } + } + } while $changed; + return \@r; } -*Compact = \&compact; - =pod =item C<$me-Ecoalesce($masklen, $number, @list_of_subnets)> +=item C<$arrayref = Coalesce($masklen,$number,@list_of_subnets)> + Will return a reference to list of C subnets of C<$masklen> mask length, when C<$number> or more addresses from C<@list_of_subnets> are found to be contained in said subnet. @@ -1555,22 +787,36 @@ will be counted (actually, the number of IP addresses is counted) towards C<$number>. +Called as a method, the array will include C<$me>. + +WARNING: the list of subnet must be the same type. i.e ipV4 or ipV6 + =cut sub coalesce { my $masklen = shift; + if (ref $masklen && ref $masklen eq __PACKAGE__ ) { # if called as a method + push @_,$masklen; + $masklen = shift; + } + my $number = shift; # Addresses are at @_ + return [] unless @_; my %ret = (); + my $type = $_[0]->{isv6}; + return [] unless defined $type; for my $ip (@_) { + return [] unless $ip->{isv6} == $type; + $type = $ip->{isv6}; my $n = NetAddr::IP->new($ip->addr . '/' . $masklen)->network; if ($ip->masklen > $masklen) { - $ret{$n} += $ip->num + 1; + $ret{$n} += $ip->num + $NetAddr::IP::Lite::Old_nth; } } @@ -1596,158 +842,57 @@ return \@ret; } -*Coalesce = \&coalesce; - -=pod - -=item C<$me-Ecompactref(\@list)> - -As usual, a faster version of =item C<-Ecompact()> that returns a -reference to a list. Note that this method takes a reference to a list -instead. - -Note that C<$me> must be a C object. - -=cut - -sub compactref ($) { - my @addr = sort @{$_[0]} - or return []; - - my $bits = $addr[0]->{bits}; - my $changed; - - do { - $changed = 0; - for (my $i = 0; - $i <= $#addr - 1; - $i ++) - { - my $lip = $addr[$i]; - my $hip = $addr[$i + 1]; - - if ($lip->contains($hip)) { - splice(@addr, $i + 1, 1); - ++ $changed; - -- $i; - } - elsif (vec($lip->{mask}, 0, $bits) - == vec($hip->{mask}, 0, $bits)) - { - my $la = $lip->{addr}; - my $ha = $hip->{addr}; - my $nb = ''; - my $na = ''; - my $nm = ''; - - vec($nb, 0, $bits) = - vec($na, 0, $bits) = - vec($la, 0, $bits); - vec($nb, 0, $bits) ^= vec($ha, 0, $bits); - vec($na, 0, $bits) ^= vec($nb, 0, $bits); - vec($nm, 0, $bits) = vec($lip->{mask}, 0, $bits); - vec($nm, 0, $bits) <<= 1; - - if (("$la" & "$nm") eq ("$ha" & "$nm")) - { - if ("$la" eq "$ha") { - splice(@addr, $i + 1, 1); - } - else { - $addr[$i] = ($lip->_fnew([ "$na" & "$nm", - $nm, $bits ])); - splice(@addr, $i + 1, 1); - } - - -- $i; - ++ $changed; - } - } - } - } while ($changed); - - return \@addr; -} - =pod =item C<-Efirst()> -Returns a new object representing the first useable IP address within +Returns a new object representing the first usable IP address within the subnet (ie, the first host address). -=cut - -sub first ($) { - my $self = shift; - - return $self->network + 1; -} - -=pod - =item C<-Elast()> -Returns a new object representing the last useable IP address within +Returns a new object representing the last usable IP address within the subnet (ie, one less than the broadcast address). -=cut - -sub last ($) { - my $self = shift; - - return $self if $self->masklen == $self->{bits}; - - return $self->broadcast - 1; -} - -=pod - =item C<-Enth($index)> -Returns a new object representing the I-th useable IP address within +Returns a new object representing the I-th usable IP address within the subnet (ie, the I-th host address). If no address is available (for example, when the network is too small for C<$index> hosts), C is returned. -=cut +Version 4.00 of NetAddr::IP and version 1.00 of NetAddr::IP::Lite implements +C<-Enth($index)> and C<-Enum()> exactly as the documentation states. +Previous versions behaved slightly differently and not in a consistent +manner. See the README file for details. -sub nth ($$) { - my $self = shift; - my $count = shift; +To use the old behavior for C<-Enth($index)> and C<-Enum()>: - return undef if ($count < 1 or $count > $self->num ()); - return $self->network + $count; -} - -=pod + use NetAddr::IP::Lite qw(:old_nth); =item C<-Enum()> -Returns the number of useable addresses IP addresses within the -subnet, not counting the broadcast address. +Version 4.00 of NetAddr::IP and version 1.00 of NetAddr::IP::Lite +Returns the number of usable addresses IP addresses within the +subnet, not counting the broadcast or network address. Previous versions +returned th number of IP addresses not counting the broadcast address. -=cut +To use the old behavior for C<-Enth($index)> and C<-Enum()>: -sub num ($) { - my $self = shift; - return ~vec($self->{mask}, 0, $self->{bits}) & 0xFFFFFFFF; -} - -=pod + use NetAddr::IP::Lite qw(:old_nth); =item C<-Ere()> Returns a Perl regular expression that will match an IP address within -the given subnet. This is currently only implemented for IPv4 -addresses. +the given subnet. Defaults to ipV4 notation. Will return an ipV6 regex +if the address in not in ipV4 space. =cut sub re ($) { + goto &re6 unless isIPv4($_[0]->{addr}); my $self = shift->network; # Insure a "zero" host part - return unless $self->bits == 32; my ($addr, $mlen) = ($self->addr, $self->masklen); my @o = split('\.', $addr, 4); @@ -1801,20 +946,120 @@ return "(?:(?re6()> + +Returns a Perl regular expression that will match an IP address within +the given subnet. Always returns an ipV6 regex. + +=cut + +sub re6($) { + my @net = split('',sprintf("%04X%04X%04X%04X%04X%04X%04X%04X",unpack('n8',$_[0]->network->{addr}))); + my @brd = split('',sprintf("%04X%04X%04X%04X%04X%04X%04X%04X",unpack('n8',$_[0]->broadcast->{addr}))); + + my @dig; + + foreach(0..$#net) { + my $n = $net[$_]; + my $b = $brd[$_]; + my $m; + if ($n.'' eq $b.'') { + if ($n =~ /\d/) { + push @dig, $n; + } else { + push @dig, '['.(lc $n).$n.']'; + } + } else { + my $n = $net[$_]; + my $b = $brd[$_]; + if ($n.'' eq 0 && $b =~ /F/) { + push @dig, 'x'; + } + elsif ($n =~ /\d/ && $b =~ /\d/) { + push @dig, '['.$n.'-'.$b.']'; + } + elsif ($n =~ /[A-F]/ && $b =~ /[A-F]/) { + $n .= '-'.$b; + push @dig, '['.(lc $n).$n.']'; + } + elsif ($n =~ /\d/ && $b =~ /[A-F]/) { + $m = ($n == 9) ? 9 : $n .'-9'; + if ($b =~ /A/) { + $m .= 'aA'; + } else { + $b = 'A-'. $b; + $m .= (lc $b). $b; + } + push @dig, '['.$m.']'; + } + elsif ($n =~ /[A-F]/ && $b =~ /\d/) { + if ($n =~ /A/) { + $m = 'aA'; + } else { + $n .= '-F'; + $m = (lc $n).$n; + } + if ($b == 9) { + $m .= 9; + } else { + $m .= $b .'-9'; + } + push @dig, '['.$m.']'; + } + } + } + my @grp; + do { + my $grp = join('',splice(@dig,0,4)); + if ($grp =~ /^0+/) { + my $l = length($&); + if ($l == 4) { + $grp = '0{1,4}'; + } else { + $grp =~ s/^${&}/0\{0,$l\}/; + } + } + if ($grp =~ /x+$/) { + my $l = length($&); + if ($l == 4) { + $grp = '[0-9a-fA-F]{1,4}'; + } else { + $grp =~ s/x+/\[0\-9a\-fA\-F\]\{$l\}/; + } + } + push @grp, $grp; + } while @dig > 0; + return '('. join(':',@grp) .')'; +} + +sub mod_version { + return $VERSION; + &Compact; # suppress warnings about these symbols + &Coalesce; + &STORABLE_freeze; + &STORABLE_thaw; +} + 1; __END__ +=pod + =back -=head2 EXPORT +=head1 EXPORT_OK -None by default. - + Compact + Coalesce + Zero + Ones + V4mask + V4net =head1 HISTORY -$Id: IP.pm,v 3.33 2006/05/11 13:46:47 lem Exp $ +$Id: IP.pm,v 3.28 2005/09/28 23:56:52 lem Exp $ =over @@ -2030,7 +1275,7 @@ =item * -A spurious warning when expand()ing with -w under certain +A spurious warning when expand()ing with C<-w> under certain circumstances was removed. This involved using /31s, /32s and the same netmask as the input. Thanks to Elie Rosenblum for pointing it out. @@ -2423,48 +1668,55 @@ -Enew() for the case of a single host IPv4 address, which seems to be the most common one. +=item 4.00 + +Dependence on Math::BigInt removed, works with earlier versions of Perl. +The module was partitioned into three logical pieces as follows: + +Util.pm Math and logic operation on bit strings and number + that represent IP addresses and masks. Conversions + between various number formats. Implemented in + C_XS for speed and PURE PERL of transportability. + +Lite.pm Operations, simple conversions and comparisons of + IP addresses, notations and formats. + +IP.pm Complex operations and conversions of IP address + notation, nets, subnets, and ranges. + +The internal representation of addresses was changed to 128 bit binary +strings as returned by inet_pton (ipv6_aton in this module). Both +ipV4 and ipV6 notations can be freely mixed and matched. + +Additional methods added to force operations into ipV6 space even when +ipV4 notation is used. + =back -$Log: IP.pm,v $ -Revision 3.33 2006/05/11 13:46:47 lem -Next release to correct goof with signatures +=head1 AUTHORS -Revision 3.32 2006/05/01 17:11:18 lem -Force update as upload failed - -Revision 3.31 2006/05/01 16:47:15 lem -Fixed CPAN #16754, version contained a space - -Revision 3.30 2006/05/01 15:31:19 lem -Moved DNS resolution to the last spot in the chain, before special -keywords, as suggested by Kevin Brintnall - Thanks! - -Revision 3.29 2005/10/05 18:01:30 lem -Change version digits back to previous levels - -Revision 3.28 2005/09/28 23:56:52 lem -Each revision will now add the CVS log to the docs automatically. - - -=head1 AUTHOR - -Luis E. Muñoz +Luis E. Muñoz , +Michael Robinton =head1 WARRANTY -This software comes with the same warranty as perl itself (ie, none), +This software comes with the same warranty as perl itself (ie, none), so by using it you accept any and all the liability. =head1 LICENSE -This software is (c) Luis E. Muñoz. 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. +It can be used under the terms of the perl artistic license provided that +proper credit for the work of the author is preserved in the form of this +copyright notice and license for this module. =head1 SEE ALSO -perl(1). + perl(1) + + L + + L =cut diff --git a/Lite/Changes b/Lite/Changes new file mode 100644 index 0000000..e20e832 --- /dev/null +++ b/Lite/Changes @@ -0,0 +1,81 @@ +Revision history for Perl extension NetAddr::IP::Lite + +1.01 Thu Jul 6 10:46:48 PDT 2006 + update v4-wnew.t to warn user of possible long wait + update Util.pm v0.17 -- see Changes in that distro + +1.00 Mon Jun 26 13:34:00 PDT 2006 + changed behavior of ->nth and ->num + to 'exactly' conform to the documentation + + add :old_nth tag to preserve old behavior + and update tests to check both + +0.12 Sun Jun 25 16:13:00 PDT 2006 + imported missing 'bcd2bin' + + 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 + +0.11 Wed Jun 14 14:53:21 PDT 2006 + add 'sub new6' and related functionality to methods + that print or return v4/6 information or text. + + add $self->{isv6} flag for hint to ipV6 status + + corrected bug in sub num that miscalcluated the number + of IP's in a net for /31 /32 + +0.10 Tue Jun 13 14:07:46 PDT 2006 + bring 'sub new' into full compliance with NetAddr::IP, + correct compatibility with for ==,>,<,=>,>=,<=>,cmp + and update documentation to reflect actual implementation + + add 'copy' function that return a completely new object + + export (Zero Ones V4mask V4net) + + update Util.pm v0.15 so shiftleft returns original + argument when the shift count is zero or undefined + +0.09 Tue Jun 6 08:37:01 PDT 2006 + update Util/Makefile.PM to check for link libraries + that ExtUtils::MakeMaker does not find properly + + remove 'use warnings' from Lite.pm for backwards + compatibility with older perl versions + +0.08 Tue Jun 6 08:33:11 PDT 2006 + update Util.xs for build on windoze + +0.07 Tue Jun 6 08:21:12 PDT 2006 + update NetAddr::IP::Util to v0.12 + +0.06 Mon Jun 5 21:34:28 PDT 2006 + fix Sparc problems in Util v0.11 + 1) add workaround for OS's that do not have inet_aton + + 2) add workaround for compilers that do not understand + #if MACRO1 == MACRO2 + +0.05 Sun May 7 18:06:43 PDT 2006 + updated UtilPP.pm v0.06 to remove unnecessary pack(unpack) sequences + to speed up ipv6->4, ipv4->6 conversions + +0.04 Fri Apr 28 17:36:28 PDT 2006 + left Util/Makefile.pl out of the top level distro + +0.03 Fri Apr 28 17:26:51 PDT 2006 + oops! left prerequsite Util 0.08 in the Makefile + when it is include in this distro + +0.02 Fri Apr 28 16:11:00 PDT 2006 + update Lite.pm to accept ->new('addr/mask') + where addr and mask are both in IP address format + + add test for above t/netaddr.t + +0.01 Wed Apr 26 19:03:18 PDT 2006 + initial release diff --git a/Lite/Lite.pm b/Lite/Lite.pm new file mode 100644 index 0000000..d21ea5b --- /dev/null +++ b/Lite/Lite.pm @@ -0,0 +1,1062 @@ +#!/usr/bin/perl + +package NetAddr::IP::Lite; + +use Carp; +use strict; +#use diagnostics; +#use warnings; +use NetAddr::IP::Util 0.17 qw( + inet_any2n + addconst + sub128 + ipv6to4 + notcontiguous + isIPv4 + shiftleft + inet_n2dx + hasbits + bin2bcd + bcd2bin + inet_aton + inet_any2n + ipv6_aton + ipv6_n2x + mask4to6 + ipv4to6 +); +use vars qw(@ISA @EXPORT_OK $Class $VERSION $isV6 $Accept_Binary_IP $Old_nth); + +$VERSION = do { my @r = (q$Revision: 1.01 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; + +require Exporter; + +@ISA = qw(Exporter); + +@EXPORT_OK = qw(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 +# at the time of use-ing the module. See docs for details. + +$Accept_Binary_IP = 0; +$Old_nth = 0; + +=head1 NAME + +NetAddr::IP::Lite - Manages IPv4 and IPv6 addresses and subnets + +=head1 SYNOPSIS + + use NetAddr::IP::Lite qw( + Zeros + Ones + V4mask + V4net + :aton + :old_nth + ); + + my $ip = new NetAddr::IP::Lite '127.0.0.1'; + + print "The address is ", $ip->addr, " with mask ", $ip->mask, "\n" ; + + if ($ip->within(new NetAddr::IP::Lite "127.0.0.0", "255.0.0.0")) { + print "Is a loopback address\n"; + } + + # This prints 127.0.0.1/32 + print "You can also say $ip...\n"; + + The following four functions return ipV6 representations of: + + :: = Zeros(); + FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF: = Ones(); + FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:: = V4mask(); + ::FFFF:FFFF = V4net(); + +=head1 INSTALLATION + +Un-tar the distribution in an appropriate directory and type: + + perl Makefile.PL + make + make test + make install + +B depends on B which installs by default with its primary functions compiled +using Perl's XS extensions to build a 'C' library. If you do not have a 'C' +complier available or would like the slower Pure Perl version for some other +reason, then type: + + perl Makefile.PL -noxs + make + make test + make install + +=head1 DESCRIPTION + +This module provides an object-oriented abstraction on top of IP +addresses or IP subnets, that allows for easy manipulations. Most of the +operations of NetAddr::IP are supported. This module will work older +versions of Perl and does B use Math::BigInt. + +The internal representation of all IP objects is in 128 bit IPv6 notation. +IPv4 and IPv6 objects may be freely mixed. + +The supported operations are described below: + +=head2 Overloaded Operators + +=cut + +my $_zero = pack('L4',0,0,0,0); +my $_ones = ~$_zero; +my $_v4mask = pack('L4',0xffffffff,0xffffffff,0xffffffff,0); +my $_v4net = ~ $_v4mask; + +sub Zero() { + return $_zero; +} +sub Ones() { + return $_ones; +} +sub V4mask() { + return $_v4mask; +} +sub V4net() { + return $_v4net; +} + + ############################################# + # These are the overload methods, placed here + # for convenience. + ############################################# + +use overload + + '+' => \&plus, + + '-' => \&minus, + + '++' => \&plusplus, + + '--' => \&minusminus, + + "=" => \©, + + '""' => sub { $_[0]->cidr(); }, + + 'eq' => sub { + my $a = ref $_[0] eq $Class ? $_[0]->cidr : $_[0]; + my $b = ref $_[1] eq $Class ? $_[1]->cidr : $_[1]; + $a eq $b; + }, + + '==' => sub { + return 0 unless ref $_[0] eq $Class; + return 0 unless ref $_[1] eq $Class; + $_[0]->cidr eq $_[1]->cidr; + }, + + '>' => sub { + return &comp_addr > 0 ? 1 : 0; + }, + + '<' => sub { + return &comp_addr < 0 ? 1 : 0; + }, + + '>=' => sub { + return &comp_addr < 0 ? 0 : 1; + }, + + '<=' => sub { + return &comp_addr > 0 ? 0 : 1; + }, + + '<=>' => \&comp_addr_mask, + + 'cmp' => \&comp_addr_mask; + +sub comp_addr_mask { + my($c,$rv) = sub128($_[0]->{addr},$_[1]->{addr}); + return -1 unless $c; + return 1 if hasbits($rv); + ($c,$rv) = sub128($_[0]->{mask},$_[1]->{mask}); + 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 + +=over + +=item B)> + +Has been optimized to copy one NetAddr::IP::Lite object to another very quickly. + +=item Bcopy()>> + +The B)> operation is only put in to operation when the +copied object is further mutated by another overloaded operation. See +L B for details. + +Bcopy()>> actually creates a new object when called. + +=cut + +sub copy { + return _new($_[0],$_[0]->{addr}, $_[0]->{mask}); +} + +=item B + +An object can be used just as a string. For instance, the following code + + my $ip = new NetAddr::IP::Lite '192.168.1.123'; + print "$ip\n"; + +Will print the string 192.168.1.123/32. + + my $ip = new6 NetAddr::IP::Lite '192.168.1.123'; + print "$ip\n"; + +Will print the string + +=item B + +You can test for equality with either C or C<==>. C allows the +comparison with arbitrary strings as well as NetAddr::IP::Lite objects. The +following example: + + if (NetAddr::IP::Lite->new('127.0.0.1','255.0.0.0') eq '127.0.0.1/8') + { print "Yes\n"; } + +Will print out "Yes". + +Comparison with C<==> requires both operands to be NetAddr::IP::Lite objects. + +In both cases, a true value is returned if the CIDR representation of +the operands is equal. + +=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 +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. + +=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: + + 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::Lite->new('10.0.0.1/24') + 255; + +outputs 10.0.0.0/24. + +=cut + +sub plus { + my $ip = shift; + my $const = shift; + + return $ip unless $const; + + my $a = $ip->{addr}; + my $m = $ip->{mask}; + + my $lo = $a & ~$m; + my $hi = $a & $m; + + my $new = ((addconst($lo,$const))[1] & ~$m) | $hi; + + return _new($ip,$new,$m); +} + +=item B + +The complement of the addition of a constant. + +=cut + +sub minus { + my $ip = shift; + my $const = shift; + + return plus($ip, -$const); +} + + # Auto-increment an object + +=item B + +Auto-incrementing a NetAddr::IP::Lite object causes the address part to be +adjusted to the next host address within the subnet. It will wrap at +the broadcast address and start again from the network address. + +=cut + +sub plusplus { + my $ip = shift; + + my $a = $ip->{addr}; + my $m = $ip->{mask}; + + my $lo = $a & ~ $m; + my $hi = $a & $m; + + $ip->{addr} = ((addconst($lo,1))[1] & ~ $m) | $hi; + return $ip; +} + +=item B + +Auto-decrementing a NetAddr::IP::Lite object performs exactly the opposite +of auto-incrementing it, as you would expect. + +=cut + +sub minusminus { + my $ip = shift; + + my $a = $ip->{addr}; + my $m = $ip->{mask}; + + my $lo = $a & ~$m; + my $hi = $a & $m; + + $ip->{addr} = ((addconst($lo,-1))[1] & ~$m) | $hi; + return $ip; +} + + ############################################# + # End of the overload methods. + ############################################# + +# Preloaded methods go here. + + # This is a variant to ->new() that + # creates and blesses a new object + # without the fancy parsing of + # IP formats and shorthands. + +# return a blessed IP object without parsing +# input: prototype, naddr, nmask +# returns: blessed IP object +# +sub _new ($$$) { + my $proto = shift; + my $class = ref($proto) || die "reference required"; + $proto = $proto->{isv6}; + my $self = { + addr => $_[0], + mask => $_[1], + isv6 => $proto, + }; + return bless $self, $class; +} + +=pod + +=back + +=head2 Methods + +=over + +=item C<-Enew([$addr, [ $mask|IPv6 ]])> + +=item C<-Enew6([$addr, [ $mask]])> + +These methods creates 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 + +C<-Enew6> marks the address as being in ipV6 address space even if the +format would suggest otherwise. + + i.e. ->new6('1.2.3.4') will result in ::102:304 + + addresses submitted to ->new in ipV6 notation will + remain in that notation permanently. i.e. + ->new('::1.2.3.4') will result in ::102:304 + whereas new('1.2.3.4') would print out as 1.2.3.4 + + See "STRINGIFICATION" below. + +C<$addr> can be almost anything that can be resolved to an IP address +in all the notations I have seen over time. It can optionally contain +the mask in CIDR notation. + +B notation is understood, with the limitation that the range +speficied by the prefix must match with a valid subnet. + +Addresses in the same format returned by C or +C can also be understood, although no mask can be +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 + + use NetAddr::IP::Lite ':aton' + +If called with no arguments, 'default' is assumed. + +C<$addr> can be any of the following and possibly more... + + n.n + n.n/mm + n.n.n + n.n.n/mm + n.n.n.n + n.n.n.n/mm 32 bit cidr notation + n.n.n.n/m.m.m.m + loopback, localhost, broadcast, any, default + x.x.x.x/host + 0xABCDEF, 0b111111000101011110, (a bcd number) + a netaddr as returned by 'inet_aton' + + +Any RFC1884 notation + + ::n.n.n.n + ::n.n.n.n/mmm 128 bit cidr notation + ::n.n.n.n/::m.m.m.m + ::x:x + ::x:x/mmm + x:x:x:x:x:x:x:x + x:x:x:x:x:x:x:x/mmm + x:x:x:x:x:x:x:x/m:m:m:m:m:m:m:m any RFC1884 notation + loopback, localhost, unspecified, any, default + ::x:x/host + 0xABCDEF, 0b111111000101011110 within the limits + of perl's number resolution + 123456789012 a 'big' bcd number i.e. Math::BigInt + +If called with no arguments, 'default' is assumed. + +=cut + +my %fip4 = ( + default => Zero, + any => Zero, + broadcast => inet_any2n('255.255.255.255'), + loopback => inet_any2n('127.0.0.1'), + unspecified => undef, +); +my %fip4m = ( + default => Zero, + any => Zero, + broadcast => Ones, + loopback => mask4to6(inet_aton('255.0.0.0')), + unspecified => undef, # not applicable for ipV4 + host => Ones, +); + +my %fip6 = ( + default => Zero, + any => Zero, + broadcast => undef, # not applicable for ipV6 + loopback => inet_any2n('::1'), + unspecified => Zero, +); + +my %fip6m = ( + default => Zero, + any => Zero, + broadcast => undef, # not applicable for ipV6 + loopback => Ones, + unspecified => Ones, + host => Ones, +); + +my $ff000000 = pack('L3N',0xffffffff,0xffffffff,0xffffffff,0xFF000000); +my $ffff0000 = pack('L3N',0xffffffff,0xffffffff,0xffffffff,0xFFFF0000); +my $ffffff00 = pack('L3N',0xffffffff,0xffffffff,0xffffffff,0xFFFFFF00); + +sub _obits ($$) { + my($lo,$hi) = @_; + + return 0xFF if $lo == $hi; + return (~ ($hi ^ $lo)) & 0xFF; +} + +sub new($;$$) { + $isV6 = 0; + goto &_xnew; +} + +sub new6($;$$) { + $isV6 = 1; + goto &_xnew; +} + +sub _xnew($;$$) { + my $proto = shift; + $Class = ref $proto || $proto || __PACKAGE__; + my $ip = lc shift; + $ip = 'default' unless defined $ip; + my $hasmask = 1; + my($mask,$tmp); + + while (1) { + unless (@_) { + if ($ip =~ m!^(.+)/(.+)$!) { + $ip = $1; + $mask = $2; + } elsif (grep($ip eq $_,qw(default any broadcast loopback unspecified))) { + $isV6 = 1 if $ip eq 'unspecified'; + if ($isV6) { + $mask = $fip6m{$ip}; + return undef unless defined ($ip = $fip6{$ip}); + } else { + $mask = $fip4m{$ip}; + return undef unless defined ($ip = $fip4{$ip}); + } + last; + } + } + elsif (defined $_[0]) { + if ($_[0] =~ /ipv6/i || $isV6) { + if (grep($ip eq $_,qw(default any loopback unspecified))) { + $mask = $fip6m{$ip}; + $ip = $fip6{$ip}; + last; + } else { + return undef; + } + } else { + $mask = lc $_[0]; + } + } + unless (defined $mask) { + $hasmask = 0; + $mask = 'host'; + } + +# parse mask + if ($mask =~ /^(\d+)$/) { + if (index($ip,':') < 0) { # is ipV4 + if ($1 == 32) { # cidr 32 + $mask = Ones; + } + elsif ($mask < 32) { # small cidr + $mask = shiftleft(Ones,32 -$1); + } else { # is a binary mask + $mask = pack('L3N',0xffffffff,0xffffffff,0xffffffff,$1); + } + } else { # is ipV6 + $isV6 = 1; + if ($1 == 128) { # cidr 128 + $mask = Ones; + } + elsif ($mask < 128) { # small cidr + $mask = shiftleft(Ones,128 -$1); + } else { # is a binary mask + $mask = bcd2bin($1); + } + } + } elsif ($mask =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) { # ipv4 form of mask + return undef unless defined ($mask = inet_aton($mask)); + $mask = mask4to6($mask); + } elsif (grep($mask eq $_,qw(default any broadcast loopback unspecified host))) { + if (index($ip,':') < 0 && ! $isV6) { + return undef unless defined ($mask = $fip4m{$mask}); + } else { + return undef unless defined ($mask = $fip6m{$mask}); + } + } else { + return undef unless defined ($mask = ipv6_aton($mask)); # try ipv6 form of mask + } + +# parse IP + + if (index($ip,':') < 0) { # ipv4 address + if ($ip =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) { + ; # the common case + } + elsif (grep($ip eq $_,qw(default any broadcast loopback))) { + return undef unless defined ($ip = $fip4{$ip}); + last; + } + elsif ($ip =~ m/^(\d+)\.(\d+)$/) { + $ip = ($hasmask) + ? "${1}.${2}.0.0" + : "${1}.0.0.${2}"; + } + elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)$/) { + $ip = ($hasmask) + ? "${1}.${2}.${3}.0" + : "${1}.${2}.0.${3}"; + } + elsif ($ip =~ /^(\d+)$/ && $hasmask && $1 >= 0 and $1 < 256) { # pure numeric + $ip = sprintf("%d.0.0.0",$1); + } + elsif ($ip =~ /^0[xb]\d+$/ && $hasmask && + (($tmp = eval "$ip") || 1) && + $tmp >= 0 && $tmp < 256) { + $ip = sprintf("%d.0.0.0",$tmp); + } + elsif ($ip =~ /^-?\d+$/) { + $ip += 2 ** 32 if $ip < 0; + $ip = pack('L3N',0,0,0,$ip); + last; + } + elsif ($ip =~ /^-?0[xb]\d+$/) { + $ip = eval "$ip"; + $ip = pack('L3N',0,0,0,$ip); + last; + } + +# notations below include an implicit mask specification + + elsif ($ip =~ m/^(\d+)\.$/) { + $ip = "${1}.0.0.0"; + $mask = $ff000000; + } + elsif ($ip =~ m/^(\d+)\.(\d+)-(\d+)\.?$/ && $2 <= $3 && $3 < 256) { + $ip = "${1}.${2}.0.0"; + $mask = pack('L3C4',0xffffffff,0xffffffff,0xffffffff,255,_obits($2,$3),0,0); + } + elsif ($ip =~ m/^(\d+)-(\d+)\.?$/ and $1 <= $2 && $2 < 256) { + $ip = "${1}.0.0.0"; + $mask = pack('L3C4',0xffffffff,0xffffffff,0xffffffff,_obits($1,$2),0,0,0) + } + elsif ($ip =~ m/^(\d+)\.(\d+)\.$/) { + $ip = "${1}.${2}.0.0"; + $mask = $ffff0000; + } + elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)-(\d+)\.?$/ && $3 <= $4 && $4 < 256) { + $ip = "${1}.${2}.${3}.0"; + $mask = pack('L3C4',0xffffffff,0xffffffff,0xffffffff,255,255,_obits($3,$4),0); + } + elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)\.$/) { + $ip = "${1}.${2}.${3}.0"; + $mask = $ffffff00; + } + elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+)-(\d+)$/ && $4 <= $5 && $5 < 256) { + $ip = "${1}.${2}.${3}.${4}"; + $mask = pack('L3C4',0xffffffff,0xffffffff,0xffffffff,255,255,255,_obits($4,$5)); + } + elsif ($ip =~ m/^(\d+\.\d+\.\d+\.\d+) + \s*-\s*(\d+\.\d+\.\d+\.\d+)$/x) { + return undef unless ($ip = inet_aton($1)); + return undef unless ($tmp = inet_aton($2)); +# check for left side greater than right side +# save numeric difference in $mask + return undef if ($tmp = unpack('N',$tmp) - unpack('N',$ip)) < 0; + $ip = ipv4to6($ip); + $tmp = pack('L3N',0,0,0,$tmp); + $mask = ~$tmp; + return undef if notcontiguous($mask); +# check for non-aligned left side + return undef if hasbits($ip & $tmp); + last; + } + elsif (($tmp = gethostbyname($ip)) && $tmp ne pack('L',0) ) { + $ip = ipv4to6($tmp); + last; + } + elsif ($Accept_Binary_IP && ! $hasmask) { + if (length($ip) == 4) { + $ip = ipv4to6($ip); + } elsif (length($ip) == 16) { + $isV6 = 1; + } else { + return undef; + } + last; + } else { + return undef; + } + return undef unless defined ($ip = inet_aton($ip)); + $ip = ipv4to6($ip); + last; + } +########## continuing + else { # ipv6 address + $isV6 = 1; + if (defined ($tmp = ipv6_aton($ip))) { + $ip = $tmp; + last; + } + last if grep($ip eq $_,qw(default any loopback unspecified)) && + defined ($ip = $fip6{$ip}); + return undef; + } + } # end while (1) + + return undef if notcontiguous($mask); # invalid if not contiguous + + my $self = { + addr => $ip, + mask => $mask, + isv6 => $isV6, + }; + return bless $self, $Class; +} + +=item C<-Ebroadcast()> + +Returns a new object refering to the broadcast address of a given +subnet. The broadcast address has all ones in all the bit positions +where the netmask has zero bits. This is normally used to address all +the hosts in a given subnet. + +=cut + +sub broadcast ($) { + my $ip = _new($_[0],$_[0]->{addr} | ~$_[0]->{mask},$_[0]->{mask}); + $ip->{addr} &= V4net unless $ip->{isv6}; + return $ip; +} + +=item C<-Enetwork()> + +Returns a new object refering to the network address of a given +subnet. A network address has all zero bits where the bits of the +netmask are zero. Normally this is used to refer to a subnet. + +=cut + +sub network ($) { + return _new($_[0],$_[0]->{addr} & $_[0]->{mask},$_[0]->{mask}); +} + +=item C<-Eaddr()> + +Returns a scalar with the address part of the object as an IPv4 or IPv6 text +string as appropriate. This is useful for printing or for passing the address +part of the NetAddr::IP::Lite object to other components that expect an IP +address. If the object is an ipV6 address or was created using ->new6($ip) +it will be reported in ipV6 hex format otherwise it will be reported in dot +quad format only if it resides in ipV4 address space. + +=cut + +sub addr ($) { + return ($_[0]->{isv6}) + ? ipv6_n2x($_[0]->{addr}) + : inet_n2dx($_[0]->{addr}); +} + +=item C<-Emask()> + +Returns a scalar with the mask as an IPv4 or IPv6 text string as +described above. + +=cut + +sub mask ($) { + return ipv6_n2x($_[0]->{mask}) if $_[0]->{isv6}; + my $mask = isIPv4($_[0]->{addr}) + ? $_[0]->{mask} & V4net + : $_[0]->{mask}; + return inet_n2dx($mask); +} + +=item C<-Emasklen()> + +Returns a scalar the number of one bits in the mask. + +=cut + +sub masklen ($) { + my $len = (notcontiguous($_[0]->{mask}))[1]; + return 0 unless $len; + return $len if $_[0]->{isv6}; + return isIPv4($_[0]->{addr}) + ? $len -96 + : $len; +} + +=item C<-Ebits()> + +Returns the width of the address in bits. Normally 32 for v4 and 128 for v6. + +=cut + +sub bits { + return $_[0]->{isv6} ? 128 : 32; +} + +=item C<-Eversion()> + +Returns the version of the address or subnet. Currently this can be +either 4 or 6. + +=cut + +sub version { + my $self = shift; + return $self->{isv6} ? 6 : 4; +} + +=item C<-Ecidr()> + +Returns a scalar with the address and mask in CIDR notation. A +NetAddr::IP::Lite object I to the result of this function. +(see comments about ->new6() and ->addr() for output formats) + +=cut + +sub cidr ($) { + return $_[0]->addr . '/' . $_[0]->masklen; +} + +=item C<-Eaton()> + +Returns the address part of the NetAddr::IP::Lite object in the same format +as the C or C function respectively. If the object +was created using ->new6($ip), the address returned will always be in ipV6 +format, even for addresses in ipV4 address space. + +=cut + +sub aton { + return $_[0]->{addr} if $_[0]->{isv6}; + return isIPv4($_[0]->{addr}) + ? ipv6to4($_[0]->{addr}) + : $_[0]->{addr}; +} + +=item C<-Erange()> + +Returns a scalar with the base address and the broadcast address +separated by a dash and spaces. This is called range notation. + +=cut + +sub range ($) { + return $_[0]->network->addr . ' - ' . $_[0]->broadcast->addr; +} + +=item C<-Enumeric()> + +When called in a scalar context, will return a numeric representation +of the address part of the IP address. When called in an array +contest, it returns a list of two elements. The first element is as +described, the second element is the numeric representation of the +netmask. + +This method is essential for serializing the representation of a +subnet. + +=cut + +sub numeric ($) { + if (wantarray) { + if (! $_[0]->{isv6} && isIPv4($_[0]->{addr})) { + return ( sprintf("%u",unpack('N',ipv6to4($_[0]->{addr}))), + sprintf("%u",unpack('N',ipv6to4($_[0]->{mask})))); + } + else { + return ( bin2bcd($_[0]->{addr}), + bin2bcd($_[0]->{mask})); + } + } + return (! $_[0]->{isv6} && isIPv4($_[0]->{addr})) + ? sprintf("%u",unpack('N',ipv6to4($_[0]->{addr}))) + : bin2bcd($_[0]->{addr}); +} + +=item C<$me-Econtains($other)> + +Returns true when C<$me> completely contains C<$other>. False is +returned otherwise and C is returned if C<$me> and C<$other> +are not both C objects. + +=cut + +sub contains ($$) { + return within(@_[1,0]); +} + +=item C<$me-Ewithin($other)> + +The complement of C<-Econtains()>. Returns true when C<$me> is +completely contained within C<$other>, undef if C<$me> and C<$other> +are not both C objects. + +=cut + +sub within ($$) { + return undef unless ref($_[0]) eq $Class && ref($_[1]) eq $Class; + return 1 unless hasbits($_[1]->{mask}); # 0x0 contains everything + my $netme = $_[0]->{addr} & $_[0]->{mask}; + my $brdme = $_[0]->{addr} | ~ $_[0]->{mask}; + my $neto = $_[1]->{addr} & $_[1]->{mask}; + my $brdo = $_[1]->{addr} | ~ $_[1]->{mask}; + return (sub128($netme,$neto) && sub128($brdo,$brdme)) + ? 1 : 0; +} + +=item C<-Efirst()> + +Returns a new object representing the first usable IP address within +the subnet (ie, the first host address). + +=cut + +sub first ($) { + return $_[0]->network + 1; +} + +=item C<-Elast()> + +Returns a new object representing the last usable IP address within +the subnet (ie, one less than the broadcast address). + +=cut + +sub last ($) { + return $_[0]->broadcast - 1; +} + +=item C<-Enth($index)> + +Returns a new object representing the I-th usable IP address within +the subnet (ie, the I-th host address). If no address is available +(for example, when the network is too small for C<$index> hosts), +C is returned. + +Version 4.00 of NetAddr::IP and version 1.00 of NetAddr::IP::Lite implements +C<-Enth($index)> and C<-Enum()> exactly as the documentation states. +Previous versions behaved slightly differently and not in a consistent +manner. + +To use the old behavior for C<-Enth($index)> and C<-Enum()>: + + use NetAddr::IP::Lite qw(:old_nth); + + old behavior: + NetAddr::IP->new('10/32')->nth(0) == undef + NetAddr::IP->new('10/32')->nth(1) == undef + NetAddr::IP->new('10/31')->nth(0) == undef + NetAddr::IP->new('10/31')->nth(1) == 10.0.0.1/31 + NetAddr::IP->new('10/30')->nth(0) == undef + NetAddr::IP->new('10/30')->nth(1) == 10.0.0.1/30 + NetAddr::IP->new('10/30')->nth(2) == 10.0.0.2/30 + NetAddr::IP->new('10/30')->nth(3) == 10.0.0.3/30 + +Note that in each case, the broadcast address is represented in the +output set and that the 'zero'th index is alway undef. + + new behavior: + NetAddr::IP->new('10/32')->nth(0) == 10.0.0.0/32 + NetAddr::IP->new('10.1/32'->nth(0) == 10.0.0.1/32 + NetAddr::IP->new('10/31')->nth(0) == undef + NetAddr::IP->new('10/31')->nth(1) == undef + NetAddr::IP->new('10/30')->nth(0) == 10.0.0.1/30 + NetAddr::IP->new('10/30')->nth(1) == 10.0.0.2/30 + NetAddr::IP->new('10/30')->nth(2) == undef + +Note that a /32 net always has 1 usable address while a /31 has none since +it has a network and broadcast address, but no host addresses. The first +index (0) returns the address immediately following the network address. + +=cut + +sub nth ($$) { + my $self = shift; + my $count = shift; + + ++$count unless ($Old_nth); + return undef if ($count < 1 or $count > $self->num ()); + return $self->network + $count; +} + +=item C<-Enum()> + +Version 4.00 of NetAddr::IP and version 1.00 of NetAddr::IP::Lite +Returns the number of usable addresses IP addresses within the +subnet, not counting the broadcast or network address. Previous versions +returned th number of IP addresses not counting the broadcast address. + +To use the old behavior for C<-Enth($index)> and C<-Enum()>: + + use NetAddr::IP::Lite qw(:old_nth); + +=cut + +sub num ($) { + my @net = unpack('L3N',$_[0]->{mask} ^ Ones); + if ($Old_nth) { +# number of ip's less broadcast + return 0xfffffffe if $net[0] || $net[1] || $net[2]; # 2**32 -1 + return $net[3] if $net[3]; + } else { # returns 1 for /32 /128, 0 for /31 /127 else n-2 up to 2**32 +# number of usable IP's === number of ip's less broadcast & network addys + return 0xfffffffd if $net[0] || $net[1] || $net[2]; # 2**32 -2 + return 1 unless $net[3]; + $net[3]--; + } + return $net[3]; +} + +=pod + +=back + +=cut + +sub import { + if (grep { $_ eq ':aton' } @_) { + $Accept_Binary_IP = 1; + @_ = grep { $_ ne ':aton' } @_; + } + if (grep { $_ eq ':old_nth' } @_) { + $Old_nth = 1; + @_ = grep { $_ ne ':old_nth' } @_; + } + NetAddr::IP::Lite->export_to_level(1, @_); +} + +=head1 EXPORT_OK + + Zero + Ones + V4mask + V4net + :aton + :old_nth + +=head1 AUTHOR + +Luis E. Muñoz , +Michael Robinton + +=head1 WARRANTY + +This software comes with the same warranty as perl itself (ie, none), +so by using it you accept any and all the liability. + +=head1 LICENSE + +This software is (c) Luis E. 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. + +=head1 SEE ALSO + +perl(1), NetAddr::IP(3), NetAddr::IP::Util(3) + +=cut + +1; diff --git a/Lite/MANIFEST b/Lite/MANIFEST new file mode 100644 index 0000000..0f69293 --- /dev/null +++ b/Lite/MANIFEST @@ -0,0 +1,96 @@ +README +MANIFEST +MANIFEST.SKIP +Makefile.PL +Lite.pm +Changes +t/addr.t +t/aton.t +t/bits.t +t/broadcast.t +t/cidr.t +t/contains.t +t/copy.t +t/firstlast.t +t/lemasklen.t +t/loops.t +t/mask.t +t/masklen.t +t/netaddr.t +t/network.t +t/new-nth.t +t/old-nth.t +t/new-num.t +t/old-num.t +t/numeric.t +t/over-qq.t +t/over_comp.t +t/over_copy.t +t/over_equal.t +t/over_math.t +t/pathological.t +t/range.t +t/relops.t +t/v4-aton.t +t/v4-badnm.t +t/v4-base.t +t/v4-basem.t +t/v4-cidr.t +t/v4-cnew.t +t/v4-contains.t +t/v4-new-first.t +t/v4-old-first.t +t/v4-last.t +t/v4-new.t +t/v4-num.t +t/v4-numeric.t +t/v4-range.t +t/v4-snew.t +t/v4-wnew.t +t/v6-new-base.t +t/v6-old-base.t +t/v6-contains.t +t/v6-inc.t +t/v6-numeric.t +t/version.t +t/within.t +Util/Changes +Util/docs/rfc1884.txt +Util/GPL +Util/lib/NetAddr/IP/UtilPP.pm +Util/Makefile.PL +Util/MANIFEST +Util/MANIFEST.SKIP +Util/README +Util/t/4to6.t +Util/t/add128.t +Util/t/addconst.t +Util/t/anyto6.t +Util/t/badd.t +Util/t/bcd2bin.t +Util/t/bcdn2bin.t +Util/t/bin.t +Util/t/comp128.t +Util/t/croak.t +Util/t/hasbits.t +Util/t/inet_n2ad.t +Util/t/inet_n2dx.t +Util/t/ipv4_inet.t +Util/t/ipv6_any2n.t +Util/t/ipv6func.t +Util/t/ipv6to4.t +Util/t/isIPv4.t +Util/t/leftshift.t +Util/t/mode.t +Util/t/notcontiguous.t +Util/t/simple_pack.t +Util/t/sub128.t +Util/Util.pm +Util/Util.xs +Util/typemap +Util/siteconf +Util/u_intxx.h +Util/xs_include/miniSocket.inc +Util/xs_include/inet_aton.c + +META.yml Module meta-data (added by MakeMaker) diff --git a/Lite/MANIFEST.SKIP b/Lite/MANIFEST.SKIP new file mode 100644 index 0000000..b318318 --- /dev/null +++ b/Lite/MANIFEST.SKIP @@ -0,0 +1,3 @@ +Makefile +Makefile.old +Util/Util_IS.pm diff --git a/Lite/META.yml b/Lite/META.yml new file mode 100644 index 0000000..3a789b1 --- /dev/null +++ b/Lite/META.yml @@ -0,0 +1,10 @@ +# http://module-build.sourceforge.net/META-spec.html +#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# +name: NetAddr-IP-Lite +version: 0.10 +version_from: Lite.pm +installdirs: site +requires: + +distribution_type: module +generated_by: ExtUtils::MakeMaker version 6.30 diff --git a/Lite/Makefile.PL b/Lite/Makefile.PL new file mode 100644 index 0000000..5614482 --- /dev/null +++ b/Lite/Makefile.PL @@ -0,0 +1,42 @@ +use ExtUtils::MakeMaker; +use Config; + +my $pkg = 'NetAddr::IP::Lite'; +$pkg =~ /[^:]+$/; +my $module = $& .'.pm'; + +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. + +my %makeparms = ( + 'NAME' => $pkg, + 'VERSION_FROM' => $module, # finds $VERSION + 'PREREQ_PM' => {Test::More => 0, + }, + 'clean' => { FILES => "*~ tmp*"}, + 'dist' => {COMPRESS=>'gzip', SUFFIX=>'gz'} +); + +sub MY::top_targets { + package MY; + my $inherited = shift->SUPER::top_targets(@_); + $inherited =~ s/(pure_all\s+::.+)/$1 README/; + $inherited; +} + +sub MY::post_constants { + my $post_constants = q| +MY_POD2TEXT = |. $Config{scriptdirexp} .'/pod2text' .q| +|; +} + +sub MY::postamble { + package MY; + my $postamble = q| +README : |. $module .q| + @$(MY_POD2TEXT) |. $module .q| > README + +|; +} + +WriteMakefile(%makeparms); diff --git a/Lite/README b/Lite/README new file mode 100644 index 0000000..45aafaa --- /dev/null +++ b/Lite/README @@ -0,0 +1,363 @@ +NAME + NetAddr::IP::Lite - Manages IPv4 and IPv6 addresses and subnets + +SYNOPSIS + use NetAddr::IP::Lite qw( + Zeros + Ones + V4mask + V4net + :aton + :old_nth + ); + + my $ip = new NetAddr::IP::Lite '127.0.0.1'; + + print "The address is ", $ip->addr, " with mask ", $ip->mask, "\n" ; + + if ($ip->within(new NetAddr::IP::Lite "127.0.0.0", "255.0.0.0")) { + print "Is a loopback address\n"; + } + + # This prints 127.0.0.1/32 + print "You can also say $ip...\n"; + + The following four functions return ipV6 representations of: + + :: = Zeros(); + FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF: = Ones(); + FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:: = V4mask(); + ::FFFF:FFFF = V4net(); + +INSTALLATION + Un-tar the distribution in an appropriate directory and type: + + perl Makefile.PL + make + make test + make install + + NetAddr::IP::Lite depends on NetAddr::IP::Util which installs by default + with its primary functions compiled using Perl's XS extensions to build + a 'C' library. If you do not have a 'C' complier available or would like + the slower Pure Perl version for some other reason, then type: + + perl Makefile.PL -noxs + make + make test + make install + +DESCRIPTION + This module provides an object-oriented abstraction on top of IP + addresses or IP subnets, that allows for easy manipulations. Most of the + operations of NetAddr::IP are supported. This module will work older + versions of Perl and does not use Math::BigInt. + + The internal representation of all IP objects is in 128 bit IPv6 + notation. IPv4 and IPv6 objects may be freely mixed. + + The supported operations are described below: + + Overloaded Operators + Assignment ("=") + Has been optimized to copy one NetAddr::IP::Lite object to another + very quickly. + + "->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. + + "->copy()" actually creates a new object when called. + + Stringification + An object can be used just as a string. For instance, the following + code + + my $ip = new NetAddr::IP::Lite '192.168.1.123'; + print "$ip\n"; + + Will print the string 192.168.1.123/32. + + my $ip = new6 NetAddr::IP::Lite '192.168.1.123'; + print "$ip\n"; + + Will print the string + + Equality + You can test for equality with either "eq" or "==". "eq" allows the + comparison with arbitrary strings as well as NetAddr::IP::Lite + objects. The following example: + + if (NetAddr::IP::Lite->new('127.0.0.1','255.0.0.0') eq '127.0.0.1/8') + { print "Yes\n"; } + + Will print out "Yes". + + Comparison with "==" requires both operands to be NetAddr::IP::Lite + objects. + + In both cases, a true value is returned if the CIDR representation + of the operands is equal. + + Comparison via >, <, >=, <=, <=> and "cmp" + 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. + + 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: + + 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::Lite->new('10.0.0.1/24') + 255; + + outputs 10.0.0.0/24. + + Substraction of a constant + The complement of the addition of a constant. + + 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 + wrap at the broadcast address and start again from the network + address. + + Auto-decrement + Auto-decrementing a NetAddr::IP::Lite object performs exactly the + 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 + + "->new6" marks the address as being in ipV6 address space even if + the format would suggest otherwise. + + i.e. ->new6('1.2.3.4') will result in ::102:304 + + addresses submitted to ->new in ipV6 notation will + remain in that notation permanently. i.e. + ->new('::1.2.3.4') will result in ::102:304 + whereas new('1.2.3.4') would print out as 1.2.3.4 + + See "STRINGIFICATION" below. + + $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. + + prefix notation is understood, with the limitation that the range + speficied by the prefix must match with a valid subnet. + + Addresses in the same format returned by "inet_aton" or + "gethostbyname" can also be understood, although no mask can be + 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 + + use NetAddr::IP::Lite ':aton' + + If called with no arguments, 'default' is assumed. + + $addr can be any of the following and possibly more... + + n.n + n.n/mm + n.n.n + n.n.n/mm + n.n.n.n + n.n.n.n/mm 32 bit cidr notation + n.n.n.n/m.m.m.m + loopback, localhost, broadcast, any, default + x.x.x.x/host + 0xABCDEF, 0b111111000101011110, (a bcd number) + a netaddr as returned by 'inet_aton' + + Any RFC1884 notation + + ::n.n.n.n + ::n.n.n.n/mmm 128 bit cidr notation + ::n.n.n.n/::m.m.m.m + ::x:x + ::x:x/mmm + x:x:x:x:x:x:x:x + x:x:x:x:x:x:x:x/mmm + x:x:x:x:x:x:x:x/m:m:m:m:m:m:m:m any RFC1884 notation + loopback, localhost, unspecified, any, default + ::x:x/host + 0xABCDEF, 0b111111000101011110 within the limits + of perl's number resolution + 123456789012 a 'big' bcd number i.e. Math::BigInt + + If called with no arguments, 'default' is assumed. + + "->broadcast()" + Returns a new object refering to the broadcast address of a given + subnet. The broadcast address has all ones in all the bit positions + where the netmask has zero bits. This is normally used to address + all the hosts in a given subnet. + + "->network()" + Returns a new object refering to the network address of a given + subnet. A network address has all zero bits where the bits of the + netmask are zero. Normally this is used to refer to a subnet. + + "->addr()" + Returns a scalar with the address part of the object as an IPv4 or + IPv6 text string as appropriate. This is useful for printing or for + passing the address part of the NetAddr::IP::Lite object to other + components that expect an IP address. If the object is an ipV6 + address or was created using ->new6($ip) it will be reported in ipV6 + hex format otherwise it will be reported in dot quad format only if + it resides in ipV4 address space. + + "->mask()" + Returns a scalar with the mask as an IPv4 or IPv6 text string as + described above. + + "->masklen()" + Returns a scalar the number of one bits in the mask. + + "->bits()" + Returns the width of the address in bits. Normally 32 for v4 and 128 + for v6. + + "->version()" + Returns the version of the address or subnet. Currently this can be + either 4 or 6. + + "->cidr()" + Returns a scalar with the address and mask in CIDR notation. A + NetAddr::IP::Lite object *stringifies* to the result of this + function. (see comments about ->new6() and ->addr() for output + formats) + + "->aton()" + Returns the address part of the NetAddr::IP::Lite object in the same + format as the "inet_aton()" or "ipv6_aton" function respectively. If + the object was created using ->new6($ip), the address returned will + always be in ipV6 format, even for addresses in ipV4 address space. + + "->range()" + Returns a scalar with the base address and the broadcast address + separated by a dash and spaces. This is called range notation. + + "->numeric()" + When called in a scalar context, will return a numeric + representation of the address part of the IP address. When called in + an array contest, it returns a list of two elements. The first + element is as described, the second element is the numeric + representation of the netmask. + + This method is essential for serializing the representation of a + 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. + + "$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. + + "->first()" + Returns a new object representing the first usable IP address within + the subnet (ie, the first host address). + + "->last()" + Returns a new object representing the last usable IP address within + the subnet (ie, one less than the broadcast address). + + "->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 + hosts), "undef" is returned. + + Version 4.00 of NetAddr::IP and version 1.00 of NetAddr::IP::Lite + implements "->nth($index)" and "->num()" exactly as the + documentation states. Previous versions behaved slightly differently + and not in a consistent manner. + + To use the old behavior for "->nth($index)" and "->num()": + + use NetAddr::IP::Lite qw(:old_nth); + + old behavior: + NetAddr::IP->new('10/32')->nth(0) == undef + NetAddr::IP->new('10/32')->nth(1) == undef + NetAddr::IP->new('10/31')->nth(0) == undef + NetAddr::IP->new('10/31')->nth(1) == 10.0.0.1/31 + NetAddr::IP->new('10/30')->nth(0) == undef + NetAddr::IP->new('10/30')->nth(1) == 10.0.0.1/30 + NetAddr::IP->new('10/30')->nth(2) == 10.0.0.2/30 + NetAddr::IP->new('10/30')->nth(3) == 10.0.0.3/30 + + Note that in each case, the broadcast address is represented in the + output set and that the 'zero'th index is alway undef. + + new behavior: + NetAddr::IP->new('10/32')->nth(0) == 10.0.0.0/32 + NetAddr::IP->new('10.1/32'->nth(0) == 10.0.0.1/32 + NetAddr::IP->new('10/31')->nth(0) == undef + NetAddr::IP->new('10/31')->nth(1) == undef + NetAddr::IP->new('10/30')->nth(0) == 10.0.0.1/30 + NetAddr::IP->new('10/30')->nth(1) == 10.0.0.2/30 + NetAddr::IP->new('10/30')->nth(2) == undef + + Note that a /32 net always has 1 usable address while a /31 has none + since it has a network and broadcast address, but no host addresses. + The first index (0) returns the address immediately following the + network address. + + "->num()" + Version 4.00 of NetAddr::IP and version 1.00 of NetAddr::IP::Lite + Returns the number of usable addresses IP addresses within the + subnet, not counting the broadcast or network address. Previous + versions returned th number of IP addresses not counting the + broadcast address. + + To use the old behavior for "->nth($index)" and "->num()": + + use NetAddr::IP::Lite qw(:old_nth); + +EXPORT_OK + Zero + Ones + V4mask + V4net + :aton + :old_nth + +AUTHOR + Luis E. Muñoz , Michael Robinton + + +WARRANTY + This software comes with the same warranty as perl itself (ie, none), so + by using it you accept any and all the liability. + +LICENSE + This software is (c) Luis E. 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. + +SEE ALSO + perl(1), NetAddr::IP(3), NetAddr::IP::Util(3) + diff --git a/Lite/Util/Changes b/Lite/Util/Changes new file mode 100644 index 0000000..cc5405f --- /dev/null +++ b/Lite/Util/Changes @@ -0,0 +1,86 @@ +Revision history for Perl extension NetAddr::IP::Util + +0.17 Thu Jul 6 10:46:48 PDT 2006 + update 'siteconf line 1608' to fix empty variable in inet_aton test + update 'siteconf line 1636' to fix empty variable in inet_pton test + add missing colon at t/notcontiguous.t line 66 + +0.16 Sun Jun 25 16:13:00 PDT 2006 + fixed ->new() issues with long digit strings ->new('::fffff') + and non hex digits ->new('::foo'). + Thanks to Radoslaw Zielinski + for spotting those bugs + +0.15 Tue Jun 13 14:42:34 PDT 2006 + UtilPP.pm v0.07 & Util.xs 'shiftleft' so that the orignal + agrument is returned when the shift count is '0' or missing + +0.14 Tue Jun 6 08:37:01 PDT 2006 + add logic to check LIBS => [-lfiles] + individually. ExtUtils::xxx does a bad job and + leaves libs that do not exist in the list + which causes 'siteconf' to blow up on missing libs + on perl 5.053 (and probably others) + +0.13 Tue Jun 6 08:33:11 PDT 2006 + added to xs file, 'hopefully' to allow build on windoze platforms + +0.12 Tue Jun 6 08:21:12 PDT 2006 + add logic to makefile so 'siteconfig' and C libs + are not used in PurePerl mode + +0.11 Mon Jun 5 14:45:09 PDT 2006 + fix Sparc problems + 1) add workaround for OS's that do not have inet_aton + + 2) add workaround for compilers that do not understand + #if MACRO1 == MACRO2 + +0.10 Sat Jun 3 19:07:51 PDT 2006 + add site configuration to supply u_intxx_t vars + for Sun OS and others that don't have them + +0.09 Sun May 7 18:06:43 PDT 2006 + UtilPP.pm v0.06, removed unnecessary pack(unpack) sequences + to speed up ipv4->6, ipv6->4 conversions + +0.08 Wed Apr 26 18:33:12 PDT 2006 + correct documentation error + add ipv6to4 + +0.07 Sun Apr 23 16:11:56 PDT 2006 + correct reporting error in UtilPP v0.04 for + incorrect argument length in ipv4 -> 6 conversions + + add conditional netaddr conversion functions + ipanyto6, maskanyto6 to Util.xs and UtilPP v0.05 + +0.06 Tue Apr 18 16:50:53 PDT 2006 + add ipv4to6, mask4to6 to Util.pm and UtilPP.pm v0.03 + +0.05 Sat Apr 15 15:48:17 PDT 2006 + Fixed some typo's in Makefile.PL that + failed to update README during build + +0.04 Wed Apr 12 15:43:33 PDT 2006 + add Util_IS.pm to guarantee that the XS lib is not + loaded if a previous incarnation of the same version + has previously been installed on the system and the + module is built with -noxs + +0.03 Tue Apr 4 21:55:35 PDT 2006 + udate minisocket to perl-5.9.3, add header + file for backwards compatibility + + add function 'notcontiguous' to return cidr size + and check for spurious bits in the network mask + +0.02 Fri Mar 31 12:44:15 PST 2006 + added test for illegal characters to ipv6_aton + + added UtilPP for Pure Perl functionality for the + WinTel folks that don't have gcc on their systems + +0.01 Tue Mar 28 16:42:44 PST 2006 + initial release + diff --git a/Lite/Util/GPL b/Lite/Util/GPL new file mode 100644 index 0000000..60549be --- /dev/null +++ b/Lite/Util/GPL @@ -0,0 +1,340 @@ + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc. + 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Library General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) 19yy + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) 19yy name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +This General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may +consider it more useful to permit linking proprietary applications with the +library. If this is what you want to do, use the GNU Library General +Public License instead of this License. diff --git a/Lite/Util/MANIFEST b/Lite/Util/MANIFEST new file mode 100644 index 0000000..f5b5ced --- /dev/null +++ b/Lite/Util/MANIFEST @@ -0,0 +1,38 @@ +README +MANIFEST +MANIFEST.SKIP +Makefile.PL +Util.pm +Util.xs +Changes +GPL +siteconf +typemap +u_intxx.h +docs/rfc1884.txt +lib/NetAddr/IP/UtilPP.pm +xs_include/inet_aton.c +xs_include/miniSocket.inc +t/4to6.t +t/add128.t +t/addconst.t +t/anyto6.t +t/badd.t +t/bcd2bin.t +t/bcdn2bin.t +t/bin.t +t/notcontiguous.t +t/comp128.t +t/croak.t +t/hasbits.t +t/inet_n2ad.t +t/inet_n2dx.t +t/ipv4_inet.t +t/ipv6_any2n.t +t/ipv6func.t +t/ipv6to4.t +t/isIPv4.t +t/leftshift.t +t/mode.t +t/simple_pack.t +t/sub128.t diff --git a/Lite/Util/MANIFEST.SKIP b/Lite/Util/MANIFEST.SKIP new file mode 100644 index 0000000..c32b057 --- /dev/null +++ b/Lite/Util/MANIFEST.SKIP @@ -0,0 +1,3 @@ +Util_IS.pm +Makefile +Makefile.old diff --git a/Lite/Util/Makefile.PL b/Lite/Util/Makefile.PL new file mode 100644 index 0000000..9ed7525 --- /dev/null +++ b/Lite/Util/Makefile.PL @@ -0,0 +1,197 @@ +use ExtUtils::MakeMaker qw( + WriteMakefile + prompt +); +use Config; +use Getopt::Long qw( + GetOptions +); + +unlink 'Makefile'; # remove Makefile to stabalize CC test + +# +# get any command line arguments +# +my ($useXS); +GetOptions( + 'xs!' => \$useXS, + 'pm' => sub { + warn "\n\t".'WARNING: Use of "--pm" is deprecated, use "-noxs" instead'."\n\n"; + $useXS = 0; + }, +); + +my $pkg = 'NetAddr::IP::Util'; +$pkg =~ /[^:]+$/; +my $module = $& .'.pm'; +my $cfile = $& .'.c'; + +my %makeparms = ( + NAME => $pkg, + VERSION_FROM => $module, # finds $VERSION + depend => {$cfile => q[xs_include/miniSocket.inc localStuff.h], + }, +# PREREQ_PM => {Test::More => 0, +# }, + LIBS => [], + XS => {}, + C => [], + clean => { FILES => "*.bs *.o *.c *~ tmp* Util_IS.pm localStuff.h config.log"}, + dist => {COMPRESS=>'gzip', SUFFIX=>'gz'} + +); + +# +# Check if we have a C compiler + +unless (defined $useXS) { + if (test_cc()) { + print "You have a working compiler.\n"; + $useXS = 1; +# $makeparms{'MYEXTLIB'} = 'netdns$(LIB_EXT)', + + } else { + $useXS = 0; + print <Util_IS.pm'); +print F q|#!/usr/bin/perl +# +# DO NOT ALTER THIS FILE +# IT IS WRITTEN BY Makefile.PL +# EDIT THAT INSTEAD +# +package NetAddr::IP::Util_IS; +use vars qw($VERSION); +$VERSION = 1.00; + + +sub pure { + return |, (($useXS) ? 0 : 1), q|; +} +sub not_pure { + return |, (($useXS) ? 1 : 0), q|; +} +1; +__END__ + +=head1 NAME + +NetAddr::IP::Util_IS - Tell about Pure Perl + +=head1 SYNOPSIS + + use NetAddr::IP::Util_IS; + + $rv = NetAddr::IP::Util_IS->pure; + $rv = NetAddr::IP::Util_IS->not_pure; + +=head1 DESCRIPTION + +Util_IS indicates whether or not B was compiled in Pure +Perl mode. + +=over 4 + +=item * $rv = NetAddr::IP::Util_IS->pure; + +Returns true if PurePerl mode, else false. + +=item * $rv = NetAddr::IP::Util_IS->not_pure; + +Returns true if NOT PurePerl mode, else false + +=back + +=cut + +1; +|; + +sub test_cc { + # + # The perl/C check borrowed from Graham Barr's + # Scalar-List-Utils distribution. + # + print "Testing if you have a C compiler and the needed header files....\n"; + + unless (open(F, ">compile.c")) { + warn "Cannot write compile.c, skipping test compilation and installing pure Perl version.\n"; + return; + } + + print F <<'EOF'; +int main() { return 0; } +EOF + + close(F) or return; + + my $rv = system("$Config{'make'} compile$Config{obj_ext}"); + + foreach my $file (glob('compile*')) { + unlink($file) || warn "Could not delete $file: $!\n"; + } + + return ($ret == 0); +} + +sub MY::top_targets { + package MY; + my $inherited = shift->SUPER::top_targets(@_); + $inherited =~ s/(pure_all\s+::.+)/$1 README/; + $begin . $inherited; +} + +sub MY::post_constants { + my $post_constants = q| +MY_POD2TEXT = |. $Config{scriptdirexp} .'/pod2text' .q| +|; +} + +sub MY::postamble { + package MY; + my $postamble = q| +README : |. $module .q| + @$(MY_POD2TEXT) |. $module .q| > README + +|; +} + +WriteMakefile(%makeparms); diff --git a/Lite/Util/Makefile.old b/Lite/Util/Makefile.old new file mode 100644 index 0000000..772cb5d --- /dev/null +++ b/Lite/Util/Makefile.old @@ -0,0 +1,765 @@ +# This Makefile is for the NetAddr::IP::Util extension to perl. +# +# It was generated automatically by MakeMaker version +# 6.30 (Revision: Revision: 4535 ) from the contents of +# Makefile.PL. Don't edit this file, edit Makefile.PL instead. +# +# ANY CHANGES MADE HERE WILL BE LOST! +# +# MakeMaker ARGV: () +# +# MakeMaker Parameters: + +# LIBS => [q[-lnsl]] +# NAME => q[NetAddr::IP::Util] +# VERSION_FROM => q[Util.pm] +# clean => { FILES=>q[*.bs *.o *.c *~ tmp* Util_IS.pm localStuff.h config.log] } +# depend => { Util.c=>q[xs_include/miniSocket.inc localStuff.h] } +# dist => { COMPRESS=>q[gzip], SUFFIX=>q[gz] } + +# --- MakeMaker post_initialize section: + + +# --- MakeMaker const_config section: + +# These definitions are from config.sh (via /usr/lib/perl5/i386-linux/Config.pm) + +# They may have been overridden via Makefile.PL or on the command line +AR = ar +CC = cc +CCCDLFLAGS = -fpic +CCDLFLAGS = -rdynamic +DLEXT = so +DLSRC = dl_dlopen.xs +LD = cc +LDDLFLAGS = -shared -L/usr/local/lib +LDFLAGS = -L/usr/local/lib +LIBC = /lib/libc-2.2.2.so +LIB_EXT = .a +OBJ_EXT = .o +OSNAME = linux +OSVERS = 2.4.2 +RANLIB = : +SITELIBEXP = /usr/lib/perl5/site_perl +SITEARCHEXP = /usr/lib/perl5/site_perl/i386-linux +SO = so +EXE_EXT = +FULL_AR = /usr/bin/ar +VENDORARCHEXP = +VENDORLIBEXP = + + +# --- MakeMaker constants section: +AR_STATIC_ARGS = cr +DIRFILESEP = / +DFSEP = $(DIRFILESEP) +NAME = NetAddr::IP::Util +NAME_SYM = NetAddr_IP_Util +VERSION = 0.17 +VERSION_MACRO = VERSION +VERSION_SYM = 0_17 +DEFINE_VERSION = -D$(VERSION_MACRO)=\"$(VERSION)\" +XS_VERSION = 0.17 +XS_VERSION_MACRO = XS_VERSION +XS_DEFINE_VERSION = -D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\" +INST_ARCHLIB = ../../blib/arch +INST_SCRIPT = ../../blib/script +INST_BIN = ../../blib/bin +INST_LIB = ../../blib/lib +INST_MAN1DIR = ../../blib/man1 +INST_MAN3DIR = ../../blib/man3 +MAN1EXT = 1 +MAN3EXT = 3 +INSTALLDIRS = site +DESTDIR = +PREFIX = $(SITEPREFIX) +PERLPREFIX = /usr +SITEPREFIX = /usr +VENDORPREFIX = +INSTALLPRIVLIB = /usr/lib/perl5 +DESTINSTALLPRIVLIB = $(DESTDIR)$(INSTALLPRIVLIB) +INSTALLSITELIB = /usr/lib/perl5/site_perl +DESTINSTALLSITELIB = $(DESTDIR)$(INSTALLSITELIB) +INSTALLVENDORLIB = +DESTINSTALLVENDORLIB = $(DESTDIR)$(INSTALLVENDORLIB) +INSTALLARCHLIB = /usr/lib/perl5/i386-linux +DESTINSTALLARCHLIB = $(DESTDIR)$(INSTALLARCHLIB) +INSTALLSITEARCH = /usr/lib/perl5/site_perl/i386-linux +DESTINSTALLSITEARCH = $(DESTDIR)$(INSTALLSITEARCH) +INSTALLVENDORARCH = +DESTINSTALLVENDORARCH = $(DESTDIR)$(INSTALLVENDORARCH) +INSTALLBIN = /usr/bin +DESTINSTALLBIN = $(DESTDIR)$(INSTALLBIN) +INSTALLSITEBIN = /usr/bin +DESTINSTALLSITEBIN = $(DESTDIR)$(INSTALLSITEBIN) +INSTALLVENDORBIN = +DESTINSTALLVENDORBIN = $(DESTDIR)$(INSTALLVENDORBIN) +INSTALLSCRIPT = /usr/bin +DESTINSTALLSCRIPT = $(DESTDIR)$(INSTALLSCRIPT) +INSTALLMAN1DIR = /usr/man/man1 +DESTINSTALLMAN1DIR = $(DESTDIR)$(INSTALLMAN1DIR) +INSTALLSITEMAN1DIR = $(INSTALLMAN1DIR) +DESTINSTALLSITEMAN1DIR = $(DESTDIR)$(INSTALLSITEMAN1DIR) +INSTALLVENDORMAN1DIR = +DESTINSTALLVENDORMAN1DIR = $(DESTDIR)$(INSTALLVENDORMAN1DIR) +INSTALLMAN3DIR = /usr/man/man3 +DESTINSTALLMAN3DIR = $(DESTDIR)$(INSTALLMAN3DIR) +INSTALLSITEMAN3DIR = $(INSTALLMAN3DIR) +DESTINSTALLSITEMAN3DIR = $(DESTDIR)$(INSTALLSITEMAN3DIR) +INSTALLVENDORMAN3DIR = +DESTINSTALLVENDORMAN3DIR = $(DESTDIR)$(INSTALLVENDORMAN3DIR) +PERL_LIB = /usr/lib/perl5 +PERL_ARCHLIB = /usr/lib/perl5/i386-linux +LIBPERL_A = libperl.a +FIRST_MAKEFILE = Makefile +MAKEFILE_OLD = Makefile.old +MAKE_APERL_FILE = Makefile.aperl +PERLMAINCC = $(CC) +PERL_INC = /usr/lib/perl5/i386-linux/CORE +PERL = /usr/local/bin/perl +FULLPERL = /usr/local/bin/perl +ABSPERL = $(PERL) +PERLRUN = $(PERL) +FULLPERLRUN = $(FULLPERL) +ABSPERLRUN = $(ABSPERL) +PERLRUNINST = $(PERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" +FULLPERLRUNINST = $(FULLPERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" +ABSPERLRUNINST = $(ABSPERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" +PERL_CORE = 0 +PERM_RW = 644 +PERM_RWX = 755 + +MAKEMAKER = /usr/lib/perl5/ExtUtils/MakeMaker.pm +MM_VERSION = 6.30 +MM_REVISION = Revision: 4535 + +# FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle). +# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle) +# PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar) +# DLBASE = Basename part of dynamic library. May be just equal BASEEXT. +FULLEXT = NetAddr/IP/Util +BASEEXT = Util +PARENT_NAME = NetAddr::IP +DLBASE = $(BASEEXT) +VERSION_FROM = Util.pm +OBJECT = $(BASEEXT)$(OBJ_EXT) +LDFROM = $(OBJECT) +LINKTYPE = dynamic +BOOTDEP = + +# Handy lists of source code files: +XS_FILES = Util.xs +C_FILES = Util.c +O_FILES = Util.o +H_FILES = u_intxx.h +MAN1PODS = +MAN3PODS = Util.pm \ + Util_IS.pm \ + lib/NetAddr/IP/UtilPP.pm + +# Where is the Config information that we are using/depend on +CONFIGDEP = $(PERL_ARCHLIB)$(DFSEP)Config.pm $(PERL_INC)$(DFSEP)config.h + +# Where to build things +INST_LIBDIR = $(INST_LIB)/NetAddr/IP +INST_ARCHLIBDIR = $(INST_ARCHLIB)/NetAddr/IP + +INST_AUTODIR = $(INST_LIB)/auto/$(FULLEXT) +INST_ARCHAUTODIR = $(INST_ARCHLIB)/auto/$(FULLEXT) + +INST_STATIC = $(INST_ARCHAUTODIR)/$(BASEEXT)$(LIB_EXT) +INST_DYNAMIC = $(INST_ARCHAUTODIR)/$(DLBASE).$(DLEXT) +INST_BOOT = $(INST_ARCHAUTODIR)/$(BASEEXT).bs + +# Extra linker info +EXPORT_LIST = +PERL_ARCHIVE = +PERL_ARCHIVE_AFTER = + + +TO_INST_PM = Util.pm \ + Util_IS.pm \ + lib/NetAddr/IP/UtilPP.pm + +PM_TO_BLIB = lib/NetAddr/IP/UtilPP.pm \ + ../../blib/lib/NetAddr/IP/UtilPP.pm \ + Util_IS.pm \ + $(INST_LIB)/NetAddr/IP/Util_IS.pm \ + Util.pm \ + $(INST_LIB)/NetAddr/IP/Util.pm + + +# --- MakeMaker platform_constants section: +MM_Unix_VERSION = 1.50 +PERL_MALLOC_DEF = -DPERL_EXTMALLOC_DEF -Dmalloc=Perl_malloc -Dfree=Perl_mfree -Drealloc=Perl_realloc -Dcalloc=Perl_calloc + + +# --- MakeMaker tool_autosplit section: +# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto +AUTOSPLITFILE = $(ABSPERLRUN) -e 'use AutoSplit; autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1)' + + + +# --- MakeMaker tool_xsubpp section: + +XSUBPPDIR = /usr/lib/perl5/ExtUtils +XSUBPP = $(XSUBPPDIR)$(DFSEP)xsubpp +XSUBPPRUN = $(PERLRUN) $(XSUBPP) +XSPROTOARG = +XSUBPPDEPS = /usr/lib/perl5/ExtUtils/typemap typemap $(XSUBPP) +XSUBPPARGS = -typemap /usr/lib/perl5/ExtUtils/typemap -typemap typemap +XSUBPP_EXTRA_ARGS = + + +# --- MakeMaker tools_other section: +SHELL = /bin/sh +CHMOD = chmod +CP = cp +MV = mv +NOOP = $(SHELL) -c true +NOECHO = @ +RM_F = rm -f +RM_RF = rm -rf +TEST_F = test -f +TOUCH = touch +UMASK_NULL = umask 0 +DEV_NULL = > /dev/null 2>&1 +MKPATH = $(ABSPERLRUN) "-MExtUtils::Command" -e mkpath +EQUALIZE_TIMESTAMP = $(ABSPERLRUN) "-MExtUtils::Command" -e eqtime +ECHO = echo +ECHO_N = echo -n +UNINST = 0 +VERBINST = 0 +MOD_INSTALL = $(ABSPERLRUN) -MExtUtils::Install -e 'install({@ARGV}, '\''$(VERBINST)'\'', 0, '\''$(UNINST)'\'');' +DOC_INSTALL = $(ABSPERLRUN) "-MExtUtils::Command::MM" -e perllocal_install +UNINSTALL = $(ABSPERLRUN) "-MExtUtils::Command::MM" -e uninstall +WARN_IF_OLD_PACKLIST = $(ABSPERLRUN) "-MExtUtils::Command::MM" -e warn_if_old_packlist +MACROSTART = +MACROEND = +USEMAKEFILE = -f +FIXIN = $(PERLRUN) "-MExtUtils::MY" -e "MY->fixin(shift)" + + +# --- MakeMaker makemakerdflt section: +makemakerdflt: all + $(NOECHO) $(NOOP) + + +# --- MakeMaker dist section skipped. + +# --- MakeMaker macro section: + + +# --- MakeMaker depend section: +Util.c : xs_include/miniSocket.inc localStuff.h + + +# --- MakeMaker cflags section: + +CCFLAGS = -fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 +OPTIMIZE = -O2 +PERLTYPE = +MPOLLUTE = + + +# --- MakeMaker const_loadlibs section: + +# NetAddr::IP::Util might depend on some other libraries: +# See ExtUtils::Liblist for details +# +EXTRALIBS = +LDLOADLIBS = -lnsl +BSLOADLIBS = + + +# --- MakeMaker const_cccmd section: +CCCMD = $(CC) -c $(PASTHRU_INC) $(INC) \ + $(CCFLAGS) $(OPTIMIZE) \ + $(PERLTYPE) $(MPOLLUTE) $(DEFINE_VERSION) \ + $(XS_DEFINE_VERSION) + +# --- MakeMaker post_constants section: + +MY_POD2TEXT = /usr/bin/pod2text + + +# --- MakeMaker pasthru section: + +PASTHRU = LIBPERL_A="$(LIBPERL_A)"\ + LINKTYPE="$(LINKTYPE)"\ + OPTIMIZE="$(OPTIMIZE)"\ + PREFIX="$(PREFIX)" + + +# --- MakeMaker special_targets section: +.SUFFIXES : .xs .c .C .cpp .i .s .cxx .cc $(OBJ_EXT) + +.PHONY: all config static dynamic test linkext manifest blibdirs clean realclean disttest distdir + + + +# --- MakeMaker c_o section: + +.c.i: + cc -E -c $(PASTHRU_INC) $(INC) \ + $(CCFLAGS) $(OPTIMIZE) \ + $(PERLTYPE) $(MPOLLUTE) $(DEFINE_VERSION) \ + $(XS_DEFINE_VERSION) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.c > $*.i + +.c.s: + $(CCCMD) -S $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.c + +.c$(OBJ_EXT): + $(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.c + +.C$(OBJ_EXT): + $(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.C + +.cpp$(OBJ_EXT): + $(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.cpp + +.cxx$(OBJ_EXT): + $(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.cxx + +.cc$(OBJ_EXT): + $(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.cc + + +# --- MakeMaker xs_c section: + +.xs.c: + $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(XSUBPP_EXTRA_ARGS) $*.xs > $*.xsc && $(MV) $*.xsc $*.c + + +# --- MakeMaker xs_o section: + +.xs$(OBJ_EXT): + $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.xsc && $(MV) $*.xsc $*.c + $(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.c + + +# --- MakeMaker top_targets section: + +config :: localStuff.h + @$(NOOP) + +# siteconf CCname Cfile_ext OBJext EXEext "Cflags" "LDflags" "LDLOADLIBS" +# +localStuff.h : + ./siteconf "$(CC)" ".c" "$(OBJ_EXT)" "$(EXE_EXT)" "$(CCFLAGS)" "$(LDflags)" "$(LDLOADLIBS)" +all :: pure_all manifypods + $(NOECHO) $(NOOP) + + +pure_all :: config pm_to_blib subdirs linkext README + $(NOECHO) $(NOOP) + +subdirs :: $(MYEXTLIB) + $(NOECHO) $(NOOP) + +config :: $(FIRST_MAKEFILE) blibdirs + $(NOECHO) $(NOOP) + +$(O_FILES): $(H_FILES) + +help : + perldoc ExtUtils::MakeMaker + + +# --- MakeMaker blibdirs section: +blibdirs : $(INST_LIBDIR)$(DFSEP).exists $(INST_ARCHLIB)$(DFSEP).exists $(INST_AUTODIR)$(DFSEP).exists $(INST_ARCHAUTODIR)$(DFSEP).exists $(INST_BIN)$(DFSEP).exists $(INST_SCRIPT)$(DFSEP).exists $(INST_MAN1DIR)$(DFSEP).exists $(INST_MAN3DIR)$(DFSEP).exists + $(NOECHO) $(NOOP) + +# Backwards compat with 6.18 through 6.25 +blibdirs.ts : blibdirs + $(NOECHO) $(NOOP) + +$(INST_LIBDIR)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_LIBDIR) + $(NOECHO) $(CHMOD) 755 $(INST_LIBDIR) + $(NOECHO) $(TOUCH) $(INST_LIBDIR)$(DFSEP).exists + +$(INST_ARCHLIB)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_ARCHLIB) + $(NOECHO) $(CHMOD) 755 $(INST_ARCHLIB) + $(NOECHO) $(TOUCH) $(INST_ARCHLIB)$(DFSEP).exists + +$(INST_AUTODIR)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_AUTODIR) + $(NOECHO) $(CHMOD) 755 $(INST_AUTODIR) + $(NOECHO) $(TOUCH) $(INST_AUTODIR)$(DFSEP).exists + +$(INST_ARCHAUTODIR)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR) + $(NOECHO) $(CHMOD) 755 $(INST_ARCHAUTODIR) + $(NOECHO) $(TOUCH) $(INST_ARCHAUTODIR)$(DFSEP).exists + +$(INST_BIN)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_BIN) + $(NOECHO) $(CHMOD) 755 $(INST_BIN) + $(NOECHO) $(TOUCH) $(INST_BIN)$(DFSEP).exists + +$(INST_SCRIPT)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_SCRIPT) + $(NOECHO) $(CHMOD) 755 $(INST_SCRIPT) + $(NOECHO) $(TOUCH) $(INST_SCRIPT)$(DFSEP).exists + +$(INST_MAN1DIR)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_MAN1DIR) + $(NOECHO) $(CHMOD) 755 $(INST_MAN1DIR) + $(NOECHO) $(TOUCH) $(INST_MAN1DIR)$(DFSEP).exists + +$(INST_MAN3DIR)$(DFSEP).exists :: Makefile.PL + $(NOECHO) $(MKPATH) $(INST_MAN3DIR) + $(NOECHO) $(CHMOD) 755 $(INST_MAN3DIR) + $(NOECHO) $(TOUCH) $(INST_MAN3DIR)$(DFSEP).exists + + + +# --- MakeMaker linkext section: + +linkext :: $(LINKTYPE) + $(NOECHO) $(NOOP) + + +# --- MakeMaker dlsyms section: + + +# --- MakeMaker dynamic section: + +dynamic :: $(FIRST_MAKEFILE) $(INST_DYNAMIC) $(INST_BOOT) + $(NOECHO) $(NOOP) + + +# --- MakeMaker dynamic_bs section: +BOOTSTRAP = $(BASEEXT).bs + +# As Mkbootstrap might not write a file (if none is required) +# we use touch to prevent make continually trying to remake it. +# The DynaLoader only reads a non-empty file. +$(BOOTSTRAP) : $(FIRST_MAKEFILE) $(BOOTDEP) $(INST_ARCHAUTODIR)$(DFSEP).exists + $(NOECHO) $(ECHO) "Running Mkbootstrap for $(NAME) ($(BSLOADLIBS))" + $(NOECHO) $(PERLRUN) \ + "-MExtUtils::Mkbootstrap" \ + -e "Mkbootstrap('$(BASEEXT)','$(BSLOADLIBS)');" + $(NOECHO) $(TOUCH) $@ + $(CHMOD) $(PERM_RW) $@ + +$(INST_BOOT) : $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DFSEP).exists + $(NOECHO) $(RM_RF) $@ + - $(CP) $(BOOTSTRAP) $@ + $(CHMOD) $(PERM_RW) $@ + + +# --- MakeMaker dynamic_lib section: + +# This section creates the dynamically loadable $(INST_DYNAMIC) +# from $(OBJECT) and possibly $(MYEXTLIB). +ARMAYBE = : +OTHERLDFLAGS = +INST_DYNAMIC_DEP = +INST_DYNAMIC_FIX = + +$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DFSEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(PERL_ARCHIVE_AFTER) $(INST_DYNAMIC_DEP) + $(RM_F) $@ + $(LD) $(LDDLFLAGS) $(LDFROM) $(OTHERLDFLAGS) -o $@ $(MYEXTLIB) \ + $(PERL_ARCHIVE) $(LDLOADLIBS) $(PERL_ARCHIVE_AFTER) $(EXPORT_LIST) \ + $(INST_DYNAMIC_FIX) + $(CHMOD) $(PERM_RWX) $@ + + +# --- MakeMaker static section: + +## $(INST_PM) has been moved to the all: target. +## It remains here for awhile to allow for old usage: "make static" +static :: $(FIRST_MAKEFILE) $(INST_STATIC) + $(NOECHO) $(NOOP) + + +# --- MakeMaker static_lib section: + +$(INST_STATIC) : $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DFSEP).exists + $(RM_RF) $@ + $(FULL_AR) $(AR_STATIC_ARGS) $@ $(OBJECT) && $(RANLIB) $@ + $(CHMOD) $(PERM_RWX) $@ + $(NOECHO) $(ECHO) "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)/extralibs.ld + + +# --- MakeMaker manifypods section: + +POD2MAN_EXE = $(PERLRUN) "-MExtUtils::Command::MM" -e pod2man "--" +POD2MAN = $(POD2MAN_EXE) + + +manifypods : pure_all \ + lib/NetAddr/IP/UtilPP.pm \ + Util_IS.pm \ + Util.pm \ + lib/NetAddr/IP/UtilPP.pm \ + Util_IS.pm \ + Util.pm + $(NOECHO) $(POD2MAN) --section=3 --perm_rw=$(PERM_RW) \ + lib/NetAddr/IP/UtilPP.pm $(INST_MAN3DIR)/NetAddr::IP::UtilPP.$(MAN3EXT) \ + Util_IS.pm $(INST_MAN3DIR)/NetAddr::IP::Util_IS.$(MAN3EXT) \ + Util.pm $(INST_MAN3DIR)/NetAddr::IP::Util.$(MAN3EXT) + + + + +# --- MakeMaker processPL section: + + +# --- MakeMaker installbin section: + + +# --- MakeMaker subdirs section: + +# none + +# --- MakeMaker clean_subdirs section: +clean_subdirs : + $(NOECHO) $(NOOP) + + +# --- MakeMaker clean section: + +# Delete temporary files but do not touch installed files. We don't delete +# the Makefile here so a later make realclean still has a makefile to use. + +clean :: clean_subdirs + - $(RM_F) \ + perl.exe core.*perl.*.? \ + pm_to_blib.ts core.[0-9][0-9] \ + core.[0-9] $(INST_ARCHAUTODIR)/extralibs.ld \ + $(INST_ARCHAUTODIR)/extralibs.all perl$(EXE_EXT) \ + core.[0-9][0-9][0-9][0-9][0-9] *perl.core \ + *$(LIB_EXT) core.[0-9][0-9][0-9] \ + $(BASEEXT).exp $(BOOTSTRAP) \ + so_locations perl \ + $(BASEEXT).x pm_to_blib \ + core blibdirs.ts \ + perlmain.c $(MAKE_APERL_FILE) \ + mon.out core.[0-9][0-9][0-9][0-9] \ + $(BASEEXT).bso $(BASEEXT).def \ + tmon.out lib$(BASEEXT).def \ + Util.c *$(OBJ_EXT) + - $(RM_RF) \ + *.c *.bs \ + localStuff.h *~ \ + config.log Util_IS.pm \ + blib tmp* \ + *.o + - $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) $(DEV_NULL) + + +# --- MakeMaker realclean_subdirs section: +realclean_subdirs : + $(NOECHO) $(NOOP) + + +# --- MakeMaker realclean section: +# Delete temporary files (via clean) and also delete dist files +realclean purge :: clean realclean_subdirs + - $(RM_F) \ + $(FIRST_MAKEFILE) $(OBJECT) \ + $(MAKEFILE_OLD) + - $(RM_RF) \ + $(DISTVNAME) + + +# --- MakeMaker metafile section: +metafile : create_distdir + $(NOECHO) $(ECHO) Generating META.yml + $(NOECHO) $(ECHO) '# http://module-build.sourceforge.net/META-spec.html' > META_new.yml + $(NOECHO) $(ECHO) '#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#' >> META_new.yml + $(NOECHO) $(ECHO) 'name: NetAddr-IP-Util' >> META_new.yml + $(NOECHO) $(ECHO) 'version: 0.17' >> META_new.yml + $(NOECHO) $(ECHO) 'version_from: Util.pm' >> META_new.yml + $(NOECHO) $(ECHO) 'installdirs: site' >> META_new.yml + $(NOECHO) $(ECHO) 'requires:' >> META_new.yml + $(NOECHO) $(ECHO) '' >> META_new.yml + $(NOECHO) $(ECHO) 'distribution_type: module' >> META_new.yml + $(NOECHO) $(ECHO) 'generated_by: ExtUtils::MakeMaker version 6.30' >> META_new.yml + -$(NOECHO) $(MV) META_new.yml $(DISTVNAME)/META.yml + + +# --- MakeMaker signature section: +signature : + cpansign -s + + +# --- MakeMaker dist_basics section skipped. + +# --- MakeMaker dist_core section skipped. + +# --- MakeMaker distdir section skipped. + +# --- MakeMaker dist_test section skipped. + +# --- MakeMaker dist_ci section skipped. + +# --- MakeMaker distmeta section: +distmeta : create_distdir metafile + $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'eval { maniadd({q{META.yml} => q{Module meta-data (added by MakeMaker)}}) } ' \ + -e ' or print "Could not add META.yml to MANIFEST: $${'\''@'\''}\n"' + + + +# --- MakeMaker distsignature section: +distsignature : create_distdir + $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'eval { maniadd({q{SIGNATURE} => q{Public-key signature (added by MakeMaker)}}) } ' \ + -e ' or print "Could not add SIGNATURE to MANIFEST: $${'\''@'\''}\n"' + $(NOECHO) cd $(DISTVNAME) && $(TOUCH) SIGNATURE + cd $(DISTVNAME) && cpansign -s + + + +# --- MakeMaker install section skipped. + +# --- MakeMaker force section: +# Phony target to force checking subdirectories. +FORCE: + $(NOECHO) $(NOOP) + + +# --- MakeMaker perldepend section: + +PERL_HDRS = \ + $(PERL_INC)/EXTERN.h \ + $(PERL_INC)/INTERN.h \ + $(PERL_INC)/XSUB.h \ + $(PERL_INC)/av.h \ + $(PERL_INC)/cc_runtime.h \ + $(PERL_INC)/config.h \ + $(PERL_INC)/cop.h \ + $(PERL_INC)/cv.h \ + $(PERL_INC)/dosish.h \ + $(PERL_INC)/embed.h \ + $(PERL_INC)/embedvar.h \ + $(PERL_INC)/fakethr.h \ + $(PERL_INC)/form.h \ + $(PERL_INC)/gv.h \ + $(PERL_INC)/handy.h \ + $(PERL_INC)/hv.h \ + $(PERL_INC)/intrpvar.h \ + $(PERL_INC)/iperlsys.h \ + $(PERL_INC)/keywords.h \ + $(PERL_INC)/mg.h \ + $(PERL_INC)/nostdio.h \ + $(PERL_INC)/op.h \ + $(PERL_INC)/opcode.h \ + $(PERL_INC)/patchlevel.h \ + $(PERL_INC)/perl.h \ + $(PERL_INC)/perlio.h \ + $(PERL_INC)/perlsdio.h \ + $(PERL_INC)/perlsfio.h \ + $(PERL_INC)/perlvars.h \ + $(PERL_INC)/perly.h \ + $(PERL_INC)/pp.h \ + $(PERL_INC)/pp_proto.h \ + $(PERL_INC)/proto.h \ + $(PERL_INC)/regcomp.h \ + $(PERL_INC)/regexp.h \ + $(PERL_INC)/regnodes.h \ + $(PERL_INC)/scope.h \ + $(PERL_INC)/sv.h \ + $(PERL_INC)/thrdvar.h \ + $(PERL_INC)/thread.h \ + $(PERL_INC)/unixish.h \ + $(PERL_INC)/util.h + +$(OBJECT) : $(PERL_HDRS) + +Util.c : $(XSUBPPDEPS) + + +# --- MakeMaker makefile section: + +$(OBJECT) : $(FIRST_MAKEFILE) + +# We take a very conservative approach here, but it's worth it. +# We move Makefile to Makefile.old here to avoid gnu make looping. +$(FIRST_MAKEFILE) : Makefile.PL $(CONFIGDEP) + $(NOECHO) $(ECHO) "Makefile out-of-date with respect to $?" + $(NOECHO) $(ECHO) "Cleaning current config before rebuilding Makefile..." + -$(NOECHO) $(RM_F) $(MAKEFILE_OLD) + -$(NOECHO) $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) + - $(MAKE) $(USEMAKEFILE) $(MAKEFILE_OLD) clean $(DEV_NULL) + $(PERLRUN) Makefile.PL + $(NOECHO) $(ECHO) "==> Your Makefile has been rebuilt. <==" + $(NOECHO) $(ECHO) "==> Please rerun the $(MAKE) command. <==" + false + + + +# --- MakeMaker staticmake section: + +# --- MakeMaker makeaperl section --- +MAP_TARGET = ../../perl +FULLPERL = /usr/local/bin/perl + + +# --- MakeMaker test section: + +TEST_VERBOSE=0 +TEST_TYPE=test_$(LINKTYPE) +TEST_FILE = test.pl +TEST_FILES = t/*.t +TESTDB_SW = -d + +testdb :: testdb_$(LINKTYPE) + +test :: $(TEST_TYPE) + +test_dynamic :: pure_all + PERL_DL_NONLAZY=1 $(FULLPERLRUN) "-MExtUtils::Command::MM" "-e" "test_harness($(TEST_VERBOSE), '$(INST_LIB)', '$(INST_ARCHLIB)')" $(TEST_FILES) + +testdb_dynamic :: pure_all + PERL_DL_NONLAZY=1 $(FULLPERLRUN) $(TESTDB_SW) "-I$(INST_LIB)" "-I$(INST_ARCHLIB)" $(TEST_FILE) + +test_ : test_dynamic + +test_static :: pure_all $(MAP_TARGET) + PERL_DL_NONLAZY=1 ./$(MAP_TARGET) "-MExtUtils::Command::MM" "-e" "test_harness($(TEST_VERBOSE), '$(INST_LIB)', '$(INST_ARCHLIB)')" $(TEST_FILES) + +testdb_static :: pure_all $(MAP_TARGET) + PERL_DL_NONLAZY=1 ./$(MAP_TARGET) $(TESTDB_SW) "-I$(INST_LIB)" "-I$(INST_ARCHLIB)" $(TEST_FILE) + + + +# --- MakeMaker ppd section: +# Creates a PPD (Perl Package Description) for a binary distribution. +ppd: + $(NOECHO) $(ECHO) '' > $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' $(DISTNAME)' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) '' >> $(DISTNAME).ppd + + +# --- MakeMaker pm_to_blib section: + +pm_to_blib : $(TO_INST_PM) + $(NOECHO) $(ABSPERLRUN) -MExtUtils::Install -e 'pm_to_blib({@ARGV}, '\''$(INST_LIB)/auto'\'', '\''$(PM_FILTER)'\'')' \ + lib/NetAddr/IP/UtilPP.pm ../../blib/lib/NetAddr/IP/UtilPP.pm \ + Util_IS.pm $(INST_LIB)/NetAddr/IP/Util_IS.pm \ + Util.pm $(INST_LIB)/NetAddr/IP/Util.pm + $(NOECHO) $(TOUCH) pm_to_blib + + +# --- MakeMaker selfdocument section: + + +# --- MakeMaker postamble section: + +README : Util.pm + @$(MY_POD2TEXT) Util.pm > README + + + +# End. diff --git a/Lite/Util/README b/Lite/Util/README new file mode 100644 index 0000000..024aa3d --- /dev/null +++ b/Lite/Util/README @@ -0,0 +1,446 @@ +NAME + NetAddr::IP::Util -- IPv4/6 and 128 bit number utilities + +SYNOPSIS + use NetAddr::IP::Util qw( + inet_aton + inet_ntoa + ipv6_aton + ipv6_n2x + ipv6_n2d + inet_any2n + hasbits + isIPv4 + inet_n2dx + inet_n2ad + ipv4to6 + mask4to6 + ipanyto6 + maskanyto6 + ipv6to4 + shiftleft + addconst + add128 + sub128 + notcontiguous + bin2bcd + bcd2bin + mode + ); + + use NetAddr::IP::Util qw(:all :inet :ipv4 :ipv6 :math) + + :inet => inet_aton, inet_ntoa, ipv6_aton, + ipv6_n2x, ipv6_n2d, inet_any2n, + inet_n2dx, inet_n2ad, ipv4to6, + mask4to6, ipanyto6, maskanyto6, + ipv6to4 + + :ipv4 => inet_aton, inet_ntoa + + :ipv6 => ipv6_aton, ipv6_n2x, ipv6_n2d, + inet_any2n, inet_n2dx, inet_n2ad + ipv4to6, mask4to6, ipanyto6, + maskanyto6, ipv6to4 + + :math => hasbits, isIPv4, addconst, + add128, sub128, notcontiguous, + bin2bcd, bcd2bin, shiftleft + + $dotquad = inet_ntoa($netaddr); + $netaddr = inet_aton($dotquad); + $ipv6naddr = ipv6_aton($ipv6_text); + $hex_text = ipv6_n2x($ipv6naddr); + $dec_text = ipv6_n2d($ipv6naddr); + $ipv6naddr = inet_any2n($dotquad or $ipv6_text); + $rv = hasbits($bits128); + $rv = isIPv4($bits128); + $dotquad or $hex_text = inet_n2dx($ipv6naddr); + $dotquad or $dec_text = inet_n2ad($ipv6naddr); + $ipv6naddr = ipv4to6($netaddr); + $ipv6naddr = mask4to6($netaddr); + $ipv6naddr = ipanyto6($netaddr); + $ipv6naddr = maskanyto6($netaddr); + $netaddr = ipv6to4($pv6naddr); + $bitsX2 = shiftleft($bits128,$n); + $carry = addconst($ipv6naddr,$signed_32con); + ($carry,$ipv6naddr)=addconst($ipv6naddr,$signed_32con); + $carry = add128($ipv6naddr1,$ipv6naddr2); + ($carry,$ipv6naddr)=add128($ipv6naddr1,$ipv6naddr2); + $carry = sub128($ipv6naddr1,$ipv6naddr2); + ($carry,$ipv6naddr)=sub128($ipv6naddr1,$ipv6naddr2); + ($spurious,$cidr) = notcontiguous($mask128); + $bcdtext = bin2bcd($bits128); + $bits128 = bcd2bin($bcdtxt); + $modetext = mode; + +INSTALLATION + Un-tar the distribution in an appropriate directory and type: + + perl Makefile.PL + make + make test + make install + + NetAddr::IP::Util installs by default with its primary functions + compiled using Perl's XS extensions to build a 'C' library. If you do + not have a 'C' complier available or would like the slower Pure Perl + version for some other reason, then type: + + perl Makefile.PL -noxs + make + make test + make install + +DESCRIPTION + NetAddr::IP::Util provides a suite of tools for manipulating and + converting IPv4 and IPv6 addresses into 128 bit string context and back + to text. The strings can be manipulated with Perl's logical operators: + + and & + or | + xor ^ + + in the same manner as 'vec' strings. + + The IPv6 functions support all rfc1884 formats. + + i.e. x:x:x:x:x:x:x:x:x + x:x:x:x:x:x:x:d.d.d.d + ::x:x:x + ::x:d.d.d.d + and so on... + + * $dotquad = inet_ntoa($netaddr); + Convert a packed IPv4 network address to a dot-quad IP address. + + input: packed network address + returns: IP address i.e. 10.4.12.123 + + * $netaddr = inet_aton($dotquad); + Convert a dot-quad IP address into an IPv4 packed network address. + + input: IP address i.e. 192.5.16.32 + returns: packed network address + + * $ipv6addr = ipv6_aton($ipv6_text); + Takes an IPv6 address of the form described in rfc1884 and returns a + 128 bit binary RDATA string. + + input: ipv6 text + returns: 128 bit RDATA string + + * $hex_text = ipv6_n2x($ipv6addr); + Takes an IPv6 RDATA string and returns an 8 segment IPv6 hex address + + input: 128 bit RDATA string + returns: x:x:x:x:x:x:x:x + + * $dec_text = ipv6_n2d($ipv6addr); + Takes an IPv6 RDATA string and returns a mixed hex - decimal IPv6 + address with the 6 uppermost chunks in hex and the lower 32 bits in + dot-quad representation. + + input: 128 bit RDATA string + returns: x:x:x:x:x:x:d.d.d.d + + * $ipv6naddr = inet_any2n($dotquad or $ipv6_text); + This function converts a text IPv4 or IPv6 address in text format in + any standard notation into a 128 bit IPv6 string address. It + prefixes any dot-quad address (if found) with '::' and passes it to + ipv6_aton. + + input: dot-quad or rfc1844 address + returns: 128 bit IPv6 string + + * $rv = hasbits($bits128); + This function returns true if there are one's present in the 128 bit + string and false if all the bits are zero. + + i.e. if (hasbits($bits128)) { + &do_something; + } + + or if (hasbits($bits128 & $mask128) { + &do_something; + } + + This allows the implementation of logical functions of the form of: + + if ($bits128 & $mask128) { + ... + + input: 128 bit IPv6 string + returns: true if any bits are present + + * $rv = isIPv4($bits128); + This function returns true if there are no on bits present in the + IPv6 portion of the 128 bit string and false otherwise. + + * $dotquad or $hex_text = inet_n2dx($ipv6naddr); + This function does the right thing and returns the text for either a + dot-quad IPv4 or a hex notation IPv6 address. + + input: 128 bit IPv6 string + returns: ddd.ddd.ddd.ddd + or x:x:x:x:x:x:x:x + + * $dotquad or $dec_text = inet_n2ad($ipv6naddr); + This function does the right thing and returns the text for either a + dot-quad IPv4 or a hex::decimal notation IPv6 address. + + input: 128 bit IPv6 string + returns: ddd.ddd.ddd.ddd + or x:x:x:x:x:x:ddd.ddd.ddd.dd + + * $ipv6naddr = ipv4to6($netaddr); + Convert an ipv4 network address into an ipv6 network address. + + input: 32 bit network address + returns: 128 bit network address + + * $ipv6naddr = mask4to6($netaddr); + Convert an ipv4 netowrk address into an ipv6 network mask. + + input: 32 bit network/mask address + returns: 128 bit network/mask address + + NOTE: returns the high 96 bits as one's + + * $ipv6naddr = ipanyto6($netaddr); + Similar to ipv4to6 except that this function takes either an IPv4 or + IPv6 input and always returns a 128 bit IPv6 network address. + + input: 32 or 128 bit network address + returns: 128 bit network address + + * $ipv6naddr = maskanyto6($netaddr); + Similar to mask4to6 except that this function takes either an IPv4 + or IPv6 netmask and always returns a 128 bit IPv6 netmask. + + input: 32 or 128 bit network mask + returns: 128 bit network mask + + * $netaddr = ipv6to4($pv6naddr); + Truncate the upper 96 bits of a 128 bit address and return the lower + 32 bits. Returns an IPv4 address as returned by inet_aton. + + input: 128 bit network address + returns: 32 bit inet_aton network address + + * $bitsXn = shiftleft($bits128,$n); + input: 128 bit string variable, + number of shifts [optional] + returns: bits X n shifts + + NOTE: a single shift is performed + if $n is not specified + + * addconst($ipv6naddr,$signed_32con); + Add a signed constant to a 128 bit string variable. + + input: 128 bit IPv6 string, + signed 32 bit integer + returns: scalar carry + array (carry, result) + + * add128($ipv6naddr1,$ipv6naddr2); + Add two 128 bit string variables. + + input: 128 bit string var1, + 128 bit string var2 + returns: scalar carry + array (carry, result) + + * sub128($ipv6naddr1,$ipv6naddr2); + Subtract two 128 bit string variables. + + input: 128 bit string var1, + 128 bit string var2 + returns: scalar carry + array (carry, result) + + Note: The carry from this operation is the result of adding the + one's complement of ARG2 +1 to the ARG1. It is logically NOT borrow. + + i.e. if ARG1 >= ARG2 then carry = 1 + or if ARG1 < ARG2 then carry = 0 + + * ($spurious,$cidr) = notcontiguous($mask128); + This function counts the bit positions remaining in the mask when + the rightmost '0's are removed. + + input: 128 bit netmask + returns true if there are spurious + zero bits remaining in the + mask, false if the mask is + contiguous one's, + 128 bit cidr number + + * $bcdtext = bin2bcd($bits128); + Convert a 128 bit binary string into binary coded decimal text + digits. + + input: 128 bit string variable + returns: string of bcd text digits + + * $bits128 = bcd2bin($bcdtxt); + Convert a bcd text string to 128 bit string variable + + input: string of bcd text digits + returns: 128 bit string variable + + * $modetext = mode; + Returns the operating mode of this module. + + input: none + returns: "Pure Perl" + or "CC XS" + +EXAMPLES + # convert any textual IP address into a 128 bit vector + # + sub text2vec { + my($anyIP,$anyMask) = @_; + + # not IPv4 bit mask + my $notiv4 = ipv6_aton('FFFF:FFFF:FFFF:FFFF:FFFF:FFFF::'); + + my $vecip = inet_any2n($anyIP); + my $mask = inet_any2n($anyMask); + + # extend mask bits for IPv4 + my $bits = 128; # default + unless (hasbits($mask & $notiv4)) { + $mask |= $notiv4; + $bits = 32; + } + return ($vecip, $mask, $bits); + } + + ... alternate implementation, a little faster + + sub text2vec { + my($anyIP,$anyMask) = @_; + + # not IPv4 bit mask + my $notiv4 = ipv6_aton('FFFF:FFFF:FFFF:FFFF:FFFF:FFFF::'); + + my $vecip = inet_any2n($anyIP); + my $mask = inet_any2n($anyMask); + + # extend mask bits for IPv4 + my $bits = 128; # default + if (isIPv4($mask)) { + $mask |= $notiv4; + $bits = 32; + } + return ($vecip, $mask, $bits); + } + + ... elsewhere + $nip = { + addr => $vecip, + mask => $mask, + bits => $bits, + }; + + # return network and broadcast addresses from IP and Mask + # + sub netbroad { + my($nip) = shift; + my $notmask = ~ $nip->{mask}; + my $bcast = $nip->{addr} | $notmask; + my $network = $nip->{addr} & $nip->{mask}; + return ($network, $broadcast); + } + + # check if address is within a network + # + sub within { + my($nip,$net) = @_; + my $addr = $nip->{addr} + my($nw,$bc) = netbroad($net); + # arg1 >= arg2, sub128 returns true + return (sub128($addr,$nw) && sub128($bc,$addr)) + ? 1 : 0; + } + + # add a constant, wrapping at netblock boundries + # to subtract the constant, negate it before calling + # 'addwrap' since 'addconst' will extend the sign bits + # + sub addwrap { + my($nip,$const) = @_; + my $mask = $nip->{addr}; + my $bits = $nip->{bits}; + my $notmask = ~ $mask; + my $hibits = $addr & $mask; + my $addr = addconst($addr,$const); + my $wraponly = $addr & $notmask; + my $newip = { + addr => $hibits | $wraponly, + mask => $mask, + bits => $bits, + }; + # bless $newip as appropriate + return $newip; + } + +EXPORT_OK + inet_aton + inet_ntoa + ipv6_aton + ipv6_n2x + ipv6_n2d + inet_any2n + hasbits + isIPv4 + inet_n2dx + inet_n2ad + ipv4to6 + mask4to6 + ipanyto6 + maskanyto6 + ipv6to4 + shiftleft + addconst + add128 + sub128 + notcontiguous + bin2bcd + bcd2bin + mode + +AUTHOR + Michael Robinton + +ACKNOWLEDGEMENTS + The following functions are used in whole or in part as include files to + Util.xs. The copyright is include in the file. + + file: function: + + miniSocket.inc inet_aton, inet_ntoa + + inet_aton, inet_ntoa are from the perl-5.8.0 release by Larry Wall, + copyright 1989-2002. inet_aton, inet_ntoa code is current through + perl-5.9.3 release. Thank you Larry for making PERL possible for all of + us. + +COPYRIGHT + Copyright 2003 - 2006, Michael Robinton + + LICENSE AND WARRANTY + + This software is (c) Michael Robinton. 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. + + No warranty of any kind is expressed or implied, by using it you accept + any and all the liability. + +AUTHOR + Michael Robinton + diff --git a/Lite/Util/Util.pm b/Lite/Util/Util.pm new file mode 100644 index 0000000..3871d83 --- /dev/null +++ b/Lite/Util/Util.pm @@ -0,0 +1,733 @@ +#!/usr/bin/perl +package NetAddr::IP::Util; + +use strict; +#use diagnostics; +#use lib qw(blib lib); + +use vars qw($VERSION @EXPORT_OK @ISA %EXPORT_TAGS $Mode); +use AutoLoader qw(AUTOLOAD); +use NetAddr::IP::Util_IS; +require DynaLoader; +require Exporter; + +@ISA = qw(Exporter DynaLoader); + +$VERSION = do { my @r = (q$Revision: 0.17 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; + +my @export_ok = qw( + inet_aton + inet_ntoa + ipv6_aton + ipv6_n2x + ipv6_n2d + inet_any2n + hasbits + isIPv4 + inet_n2dx + inet_n2ad + shiftleft + addconst + add128 + sub128 + notcontiguous + bin2bcd + bcd2bin + mode + ipv4to6 + mask4to6 + ipanyto6 + maskanyto6 + ipv6to4 +); +@EXPORT_OK = (@export_ok,qw( + comp128 + bin2bcdn + bcdn2txt + bcdn2bin + simple_pack +)); + +%EXPORT_TAGS = ( + all => [@export_ok], + inet => [qw( + inet_aton + inet_ntoa + ipv6_aton + ipv6_n2x + ipv6_n2d + inet_any2n + inet_n2dx + inet_n2ad + ipv4to6 + mask4to6 + ipanyto6 + maskanyto6 + ipv6to4 + )], + math => [qw( + shiftleft + hasbits + isIPv4 + addconst + add128 + sub128 + notcontiguous + bin2bcd + bcd2bin + )], + ipv4 => [qw( + inet_aton + inet_ntoa + )], + ipv6 => [qw( + ipv6_aton + ipv6_n2x + ipv6_n2d + inet_any2n + inet_n2dx + inet_n2ad + ipv4to6 + mask4to6 + ipanyto6 + maskanyto6 + ipv6to4 + )], +); + +if (NetAddr::IP::Util_IS->not_pure) { + eval { ## attempt to load 'C' version of utilities + bootstrap NetAddr::IP::Util $VERSION; + }; +} +if (NetAddr::IP::Util_IS->pure || $@) { ## load the pure perl version if 'C' lib missing + require NetAddr::IP::UtilPP; + import NetAddr::IP::UtilPP qw( :all ); + require Socket; + import Socket qw(inet_ntoa inet_aton); + $Mode = 'Pure Perl'; +} +else { + $Mode = 'CC XS'; +} + +sub mode() { $Mode }; +sub DESTROY {}; + +1; +__END__ + +=head1 NAME + +NetAddr::IP::Util -- IPv4/6 and 128 bit number utilities + +=head1 SYNOPSIS + + use NetAddr::IP::Util qw( + inet_aton + inet_ntoa + ipv6_aton + ipv6_n2x + ipv6_n2d + inet_any2n + hasbits + isIPv4 + inet_n2dx + inet_n2ad + ipv4to6 + mask4to6 + ipanyto6 + maskanyto6 + ipv6to4 + shiftleft + addconst + add128 + sub128 + notcontiguous + bin2bcd + bcd2bin + mode + ); + + use NetAddr::IP::Util qw(:all :inet :ipv4 :ipv6 :math) + + :inet => inet_aton, inet_ntoa, ipv6_aton, + ipv6_n2x, ipv6_n2d, inet_any2n, + inet_n2dx, inet_n2ad, ipv4to6, + mask4to6, ipanyto6, maskanyto6, + ipv6to4 + + :ipv4 => inet_aton, inet_ntoa + + :ipv6 => ipv6_aton, ipv6_n2x, ipv6_n2d, + inet_any2n, inet_n2dx, inet_n2ad + ipv4to6, mask4to6, ipanyto6, + maskanyto6, ipv6to4 + + :math => hasbits, isIPv4, addconst, + add128, sub128, notcontiguous, + bin2bcd, bcd2bin, shiftleft + + $dotquad = inet_ntoa($netaddr); + $netaddr = inet_aton($dotquad); + $ipv6naddr = ipv6_aton($ipv6_text); + $hex_text = ipv6_n2x($ipv6naddr); + $dec_text = ipv6_n2d($ipv6naddr); + $ipv6naddr = inet_any2n($dotquad or $ipv6_text); + $rv = hasbits($bits128); + $rv = isIPv4($bits128); + $dotquad or $hex_text = inet_n2dx($ipv6naddr); + $dotquad or $dec_text = inet_n2ad($ipv6naddr); + $ipv6naddr = ipv4to6($netaddr); + $ipv6naddr = mask4to6($netaddr); + $ipv6naddr = ipanyto6($netaddr); + $ipv6naddr = maskanyto6($netaddr); + $netaddr = ipv6to4($pv6naddr); + $bitsX2 = shiftleft($bits128,$n); + $carry = addconst($ipv6naddr,$signed_32con); + ($carry,$ipv6naddr)=addconst($ipv6naddr,$signed_32con); + $carry = add128($ipv6naddr1,$ipv6naddr2); + ($carry,$ipv6naddr)=add128($ipv6naddr1,$ipv6naddr2); + $carry = sub128($ipv6naddr1,$ipv6naddr2); + ($carry,$ipv6naddr)=sub128($ipv6naddr1,$ipv6naddr2); + ($spurious,$cidr) = notcontiguous($mask128); + $bcdtext = bin2bcd($bits128); + $bits128 = bcd2bin($bcdtxt); + $modetext = mode; + +=head1 INSTALLATION + +Un-tar the distribution in an appropriate directory and type: + + perl Makefile.PL + make + make test + make install + +B installs by default with its primary functions compiled +using Perl's XS extensions to build a 'C' library. If you do not have a 'C' +complier available or would like the slower Pure Perl version for some other +reason, then type: + + perl Makefile.PL -noxs + make + make test + make install + +=head1 DESCRIPTION + +B provides a suite of tools for manipulating and +converting IPv4 and IPv6 addresses into 128 bit string context and back to +text. The strings can be manipulated with Perl's logical operators: + + and & + or | + xor ^ + +in the same manner as 'vec' strings. + +The IPv6 functions support all rfc1884 formats. + + i.e. x:x:x:x:x:x:x:x:x + x:x:x:x:x:x:x:d.d.d.d + ::x:x:x + ::x:d.d.d.d + and so on... + +=over 4 + +=item * $dotquad = inet_ntoa($netaddr); + +Convert a packed IPv4 network address to a dot-quad IP address. + + input: packed network address + returns: IP address i.e. 10.4.12.123 + +=item * $netaddr = inet_aton($dotquad); + +Convert a dot-quad IP address into an IPv4 packed network address. + + input: IP address i.e. 192.5.16.32 + returns: packed network address + +=item * $ipv6addr = ipv6_aton($ipv6_text); + +Takes an IPv6 address of the form described in rfc1884 +and returns a 128 bit binary RDATA string. + + input: ipv6 text + returns: 128 bit RDATA string + +=cut + +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 $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 + $ipv6 =~ /[^:0-9a-fA-F]/ || # non-hex character + (($c = $ipv6) =~ s/::/x/ && $c =~ /(?:x|:):/) || # double :: ::? + $ipv6 =~ /[0-9a-fA-F]{5,}/; # more than 4 digits + $c = $ipv6 =~ tr/:/:/; # count the colons + return undef if $c < 7 && $ipv6 !~ /::/; + if ($c > 7) { # strip leading or trailing :: + return undef unless + $ipv6 =~ s/^::/:/ || + $ipv6 =~ s/::$/:/; + return undef if --$c > 7; + } + while ($c++ < 7) { # expand compressed fields + $ipv6 =~ s/::/:::/; + } + $ipv6 .= 0 if $ipv6 =~ /:$/; + my @hex = split(/:/,$ipv6); + foreach(0..$#hex) { + $hex[$_] = hex($hex[$_] || 0); + } + pack("n8",@hex); +} + +=item * $hex_text = ipv6_n2x($ipv6addr); + +Takes an IPv6 RDATA string and returns an 8 segment IPv6 hex address + + input: 128 bit RDATA string + returns: x:x:x:x:x:x:x:x + +=cut + +sub ipv6_n2x { + die "Bad arg length for 'ipv6_n2x', length is ". length($_[0]) ." should be 16" + unless length($_[0]) == 16; + return sprintf("%X:%X:%X:%X:%X:%X:%X:%X",unpack("n8",$_[0])); +} + +=item * $dec_text = ipv6_n2d($ipv6addr); + +Takes an IPv6 RDATA string and returns a mixed hex - decimal IPv6 address +with the 6 uppermost chunks in hex and the lower 32 bits in dot-quad +representation. + + input: 128 bit RDATA string + returns: x:x:x:x:x:x:d.d.d.d + +=cut + +sub ipv6_n2d { + die "Bad arg length for 'ipv6_n2x', length is ". length($_[0]) ." should be 16" + unless length($_[0]) == 16; + my @hex = (unpack("n8",$_[0])); + $hex[9] = $hex[7] & 0xff; + $hex[8] = $hex[7] >> 8; + $hex[7] = $hex[6] & 0xff; + $hex[6] >>= 8; + return sprintf("%X:%X:%X:%X:%X:%X:%d.%d.%d.%d",@hex); +} + +=item * $ipv6naddr = inet_any2n($dotquad or $ipv6_text); + +This function converts a text IPv4 or IPv6 address in text format in any +standard notation into a 128 bit IPv6 string address. It prefixes any +dot-quad address (if found) with '::' and passes it to B. + + input: dot-quad or rfc1844 address + returns: 128 bit IPv6 string + +=cut + +sub inet_any2n($) { + my($addr) = @_; + $addr = '' unless $addr; + $addr = '::' . $addr + unless $addr =~ /:/; + return ipv6_aton($addr); +} + +=item * $rv = hasbits($bits128); + +This function returns true if there are one's present in the 128 bit string +and false if all the bits are zero. + + i.e. if (hasbits($bits128)) { + &do_something; + } + + or if (hasbits($bits128 & $mask128) { + &do_something; + } + +This allows the implementation of logical functions of the form of: + + if ($bits128 & $mask128) { + ... + + input: 128 bit IPv6 string + returns: true if any bits are present + +=item * $rv = isIPv4($bits128); + +This function returns true if there are no on bits present in the IPv6 +portion of the 128 bit string and false otherwise. + +=item * $dotquad or $hex_text = inet_n2dx($ipv6naddr); + +This function B and returns the text for either a +dot-quad IPv4 or a hex notation IPv6 address. + + input: 128 bit IPv6 string + returns: ddd.ddd.ddd.ddd + or x:x:x:x:x:x:x:x + +=cut + +sub inet_n2dx($) { + my($nadr) = @_; + if (isIPv4($nadr)) { + ipv6_n2d($nadr) =~ /[^:]+$/; + return $&; + } + return ipv6_n2x($nadr); +} + +=item * $dotquad or $dec_text = inet_n2ad($ipv6naddr); + +This function B and returns the text for either a +dot-quad IPv4 or a hex::decimal notation IPv6 address. + + input: 128 bit IPv6 string + returns: ddd.ddd.ddd.ddd + or x:x:x:x:x:x:ddd.ddd.ddd.dd + +=cut + +sub inet_n2ad($) { + my($nadr) = @_; + my $addr = ipv6_n2d($nadr); + return $addr unless isIPv4($nadr); + $addr =~ /[^:]+$/; + return $&; +} + +=item * $ipv6naddr = ipv4to6($netaddr); + +Convert an ipv4 network address into an ipv6 network address. + + input: 32 bit network address + returns: 128 bit network address + +=item * $ipv6naddr = mask4to6($netaddr); + +Convert an ipv4 netowrk address into an ipv6 network mask. + + input: 32 bit network/mask address + returns: 128 bit network/mask address + +NOTE: returns the high 96 bits as one's + +=item * $ipv6naddr = ipanyto6($netaddr); + +Similar to ipv4to6 except that this function takes either an IPv4 or IPv6 +input and always returns a 128 bit IPv6 network address. + + input: 32 or 128 bit network address + returns: 128 bit network address + +=item * $ipv6naddr = maskanyto6($netaddr); + +Similar to mask4to6 except that this function takes either an IPv4 or IPv6 +netmask and always returns a 128 bit IPv6 netmask. + + input: 32 or 128 bit network mask + returns: 128 bit network mask + +=item * $netaddr = ipv6to4($pv6naddr); + +Truncate the upper 96 bits of a 128 bit address and return the lower +32 bits. Returns an IPv4 address as returned by inet_aton. + + input: 128 bit network address + returns: 32 bit inet_aton network address + +=item * $bitsXn = shiftleft($bits128,$n); + + input: 128 bit string variable, + number of shifts [optional] + returns: bits X n shifts + + NOTE: a single shift is performed + if $n is not specified + +=item * addconst($ipv6naddr,$signed_32con); + +Add a signed constant to a 128 bit string variable. + + input: 128 bit IPv6 string, + signed 32 bit integer + returns: scalar carry + array (carry, result) + +=item * add128($ipv6naddr1,$ipv6naddr2); + +Add two 128 bit string variables. + + input: 128 bit string var1, + 128 bit string var2 + returns: scalar carry + array (carry, result) + +=item * sub128($ipv6naddr1,$ipv6naddr2); + +Subtract two 128 bit string variables. + + input: 128 bit string var1, + 128 bit string var2 + returns: scalar carry + array (carry, result) + +Note: The carry from this operation is the result of adding the one's +complement of ARG2 +1 to the ARG1. It is logically +B. + + i.e. if ARG1 >= ARG2 then carry = 1 + or if ARG1 < ARG2 then carry = 0 + + +=item * ($spurious,$cidr) = notcontiguous($mask128); + +This function counts the bit positions remaining in the mask when the +rightmost '0's are removed. + + input: 128 bit netmask + returns true if there are spurious + zero bits remaining in the + mask, false if the mask is + contiguous one's, + 128 bit cidr number + +=item * $bcdtext = bin2bcd($bits128); + +Convert a 128 bit binary string into binary coded decimal text digits. + + input: 128 bit string variable + returns: string of bcd text digits + +=item * $bits128 = bcd2bin($bcdtxt); + +Convert a bcd text string to 128 bit string variable + + input: string of bcd text digits + returns: 128 bit string variable + +=cut + +#=item * $onescomp=NetAddr::IP::Util::comp128($ipv6addr); +# +#This function is not exported because it is more efficient to use perl " ~ " +#on the bit string directly. This interface to the B routine is published for +#module testing purposes because it is used internally in the B routine. The +#function is very fast, but calling if from perl directly is very slow. It is almost +#33% faster to use B than to do a 1's comp with perl and then call +#B. +# +#=item * $bcdpacked = NetAddr::IP::Util::bin2bcdn($bits128); +# +#Convert a 128 bit binary string into binary coded decimal digits. +#This function is not exported. +# +# input: 128 bit string variable +# returns: string of packed decimal digits +# +# i.e. text = unpack("H*", $bcd); +# +#=item * $bcdtext = NetAddr::IP::Util::bcdn2txt($bcdpacked); +# +#Convert a packed bcd string into text digits, suppress the leading zeros. +#This function is not exported. +# +# input: string of packed decimal digits +# returns: hexdecimal digits +# +#Similar to unpack("H*", $bcd); +# +#=item * $bcdpacked = NetAddr::IP::Util::simple_pack($bcdtext); +# +#Convert a numeric string into a packed bcd string, left fill with zeros +# +# input: string of decimal digits +# returns: string of packed decimal digits +# +#Similar to pack("H*", $bcdtext); + +=item * $modetext = mode; + +Returns the operating mode of this module. + + input: none + returns: "Pure Perl" + or "CC XS" + +=back + +=head1 EXAMPLES + + + # convert any textual IP address into a 128 bit vector + # + sub text2vec { + my($anyIP,$anyMask) = @_; + + # not IPv4 bit mask + my $notiv4 = ipv6_aton('FFFF:FFFF:FFFF:FFFF:FFFF:FFFF::'); + + my $vecip = inet_any2n($anyIP); + my $mask = inet_any2n($anyMask); + + # extend mask bits for IPv4 + my $bits = 128; # default + unless (hasbits($mask & $notiv4)) { + $mask |= $notiv4; + $bits = 32; + } + return ($vecip, $mask, $bits); + } + + ... alternate implementation, a little faster + + sub text2vec { + my($anyIP,$anyMask) = @_; + + # not IPv4 bit mask + my $notiv4 = ipv6_aton('FFFF:FFFF:FFFF:FFFF:FFFF:FFFF::'); + + my $vecip = inet_any2n($anyIP); + my $mask = inet_any2n($anyMask); + + # extend mask bits for IPv4 + my $bits = 128; # default + if (isIPv4($mask)) { + $mask |= $notiv4; + $bits = 32; + } + return ($vecip, $mask, $bits); + } + + + ... elsewhere + $nip = { + addr => $vecip, + mask => $mask, + bits => $bits, + }; + + # return network and broadcast addresses from IP and Mask + # + sub netbroad { + my($nip) = shift; + my $notmask = ~ $nip->{mask}; + my $bcast = $nip->{addr} | $notmask; + my $network = $nip->{addr} & $nip->{mask}; + return ($network, $broadcast); + } + + # check if address is within a network + # + sub within { + my($nip,$net) = @_; + my $addr = $nip->{addr} + my($nw,$bc) = netbroad($net); + # arg1 >= arg2, sub128 returns true + return (sub128($addr,$nw) && sub128($bc,$addr)) + ? 1 : 0; + } + + # add a constant, wrapping at netblock boundries + # to subtract the constant, negate it before calling + # 'addwrap' since 'addconst' will extend the sign bits + # + sub addwrap { + my($nip,$const) = @_; + my $mask = $nip->{addr}; + my $bits = $nip->{bits}; + my $notmask = ~ $mask; + my $hibits = $addr & $mask; + my $addr = addconst($addr,$const); + my $wraponly = $addr & $notmask; + my $newip = { + addr => $hibits | $wraponly, + mask => $mask, + bits => $bits, + }; + # bless $newip as appropriate + return $newip; + } + +=head1 EXPORT_OK + + inet_aton + inet_ntoa + ipv6_aton + ipv6_n2x + ipv6_n2d + inet_any2n + hasbits + isIPv4 + inet_n2dx + inet_n2ad + ipv4to6 + mask4to6 + ipanyto6 + maskanyto6 + ipv6to4 + shiftleft + addconst + add128 + sub128 + notcontiguous + bin2bcd + bcd2bin + mode + +=head1 AUTHOR + +Michael Robinton + +=head1 ACKNOWLEDGEMENTS + +The following functions are used in whole or in part as include files to +Util.xs. The copyright is include in the file. + + file: function: + + miniSocket.inc inet_aton, inet_ntoa + +inet_aton, inet_ntoa are from the perl-5.8.0 release by Larry Wall, copyright +1989-2002. inet_aton, inet_ntoa code is current through perl-5.9.3 release. +Thank you Larry for making PERL possible for all of us. + +=head1 COPYRIGHT + +Copyright 2003 - 2006, Michael Robinton + +LICENSE AND WARRANTY + +This software is (c) Michael Robinton. 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. + +No warranty of any kind is expressed or implied, by using it +you accept any and all the liability. + + +=head1 AUTHOR + +Michael Robinton + +=cut + +1; + diff --git a/Lite/Util/Util.xs b/Lite/Util/Util.xs new file mode 100644 index 0000000..0313b53 --- /dev/null +++ b/Lite/Util/Util.xs @@ -0,0 +1,743 @@ + +/* + * Copyright 2006, Michael Robinton + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +*/ + +#ifdef __cplusplus +extern "C" { +#endif + +#ifdef _CYGWIN +#include +#endif + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#ifdef _CYGWIN +#include +#endif + +/* take care of missing u_int32_t definitions windoze/sun */ +#include "u_intxx.h" + +/* needed for testing with 'printf' +#include + */ + +#ifdef __cplusplus +} +#endif + +/* workaround for OS's without inet_aton */ +#include "xs_include/inet_aton.c" + +typedef union +{ + u_int32_t u[4]; + unsigned char c[16]; +} n128; + +n128 c128, a128; + +u_int32_t wa[4], wb[4]; /* working registers */ + +struct +{ /* character array of 40 bytes */ + char txt[20]; /* 20 bytes */ + u_int32_t bcd[5]; /* 20 bytes, 40 digits */ +} n; + +#define zero ('0' & 0x7f) + +void +extendipv4(void * aa) +{ + register u_int32_t * a = wa; + *a++ = 0; + *a++ = 0; + *a++ = 0; + *a = *((u_int32_t *)aa); +} + +void +extendmask4(void *aa) +{ + register u_int32_t * a = wa; + *a++ = 0xffffffff; + *a++ = 0xffffffff; + *a++ = 0xffffffff; + *a = *((u_int32_t *)aa); +} + +void +fastcomp128(void * aa) +{ + register u_int32_t * a; + a = aa; + + *a++ ^= 0xffffffff; + *a++ ^= 0xffffffff; + *a++ ^= 0xffffffff; + *a++ ^= 0xffffffff; +} + +/* add two 128 bit numbers + return the carry + */ + +int +adder128(void * aa, void * bb, int carry) +{ + int i; + register u_int32_t a, b, r; + + for (i=3; i >= 0; i--) { + a = *((u_int32_t *)aa + i); + b = *((u_int32_t *)bb + i); + r = a + b; + a = 0; /* ripple carry forward */ + if ( r < a || r < b) /* if overflow */ + a = 1; + + b = r + carry; /* carry propagate in */ + if (b < r) /* ripple carry forward */ + carry = 1; /* if overflow */ + else + carry = a; + + *((u_int32_t *)a128.u + i) = b; + } + return carry; +} + +int +addercon(void * aa, int32_t con) +{ + register u_int32_t tmp = 0x80000000; + + if (con & tmp) + tmp = 0xffffffff; + else + tmp = 0; + + wb[0] = tmp; + wb[1] = tmp; + wb[2] = tmp; + wb[3] = (u_int32_t)con; + return adder128(aa,wb,0); +} + +int +have128(void * bp) +{ + register u_int32_t * p = bp; + + if (*p++ || *p++ || *p++ || *p++) + return 1; + return 0; +} + +int +_isipv4(void * bp) +{ + register u_int32_t * p = bp; + + if (*p++ || *p++ || *p++) + return 0; + return 1; +} + +/* network byte swap and copy */ +void +netswap_copy(void * dest, void * src, int len) +{ + register u_int32_t * d = dest, * s = src; + + for (/* -- */;len>0;len--) { +#ifdef host_is_LITTLE_ENDIAN + *d++ = (((*s & 0xff000000) >> 24) | ((*s & 0x00ff0000) >> 8) | \ + ((*s & 0x0000ff00) << 8) | ((*s & 0x000000ff) << 24)); +#else +# ifdef host_is_BIG_ENDIAN + *d++ = *s; +# else +# error ENDIANness not defined +# endif +#endif + s++; + } +} + +/* do ntohl / htonl changes as necessary for this OS + */ +void +netswap(void * ap, int len) +{ +#ifdef host_is_LITTLE_ENDIAN + register u_int32_t * a = ap; + for (/* -- */;len >0;len--) { + *a++ = (((*a & 0xff000000) >> 24) | ((*a & 0x00ff0000) >> 8) | \ + ((*a & 0x0000ff00) << 8) | ((*a & 0x000000ff) << 24)); + } +#endif +} + +/* shift right to purge '0's, + return mask bit count and remainder value, + left fill with ones + */ +unsigned char +_countbits(void *ap) +{ + register u_int32_t * p0 = (u_int32_t *)ap, * p1 = p0 +1, * p2 = p1 +1, * p3 = p2 +1; + unsigned char count = 128; + + fastcomp128(ap); + + do { + if (!(*p3 & 1)) + break; + count--; + *p3 >>= 1; + if (*p2 & 1) + *p3 |= 0x80000000; + *p2 >>= 1; + if (*p1 & 1) + *p2 |= 0x80000000; + *p1 >>= 1; + if (*p0 & 1) + *p1 |= 0x80000000; + *p0 >>= 1; + } while (count > 0); + return count; +} + +/* multiply 128 bit number x 2 + */ +void +_128x2(void * ap) +{ + register u_int32_t * p = (u_int32_t *)ap +3, tmpc, carry = 0; + + do { + tmpc = *p & 0x80000000; /* propagate hi bit to next word */ + *p <<= 1; + if (carry) + *p += 1; + carry = tmpc; + } while (p-- > (u_int32_t *)ap); +/* printf("2o %04X:%04X:%04X:%04X\n",*((u_int32_t *)ap),*((u_int32_t *)ap +1),*((u_int32_t *)ap +2),*((u_int32_t *)ap +3)); */ +} + +/* multiply 128 bit number X10 + */ +int +_128x10(void * ap, void * tp) +{ + _128x2(ap); /* multiply by two */ + *(u_int32_t *)tp = *(u_int32_t *)ap; /* temp save */ + *((u_int32_t *)tp +1) = *((u_int32_t *)ap +1); + *((u_int32_t *)tp +2) = *((u_int32_t *)ap +2); + *((u_int32_t *)tp +3) = *((u_int32_t *)ap +3); + _128x2(ap); + _128x2(ap); /* times 8 */ + (void) adder128(ap,tp,0); +/* printf("x %04X:%04X:%04X:%04X\n",*((u_int32_t *)ap),*((u_int32_t *)ap +1),*((u_int32_t *)ap +2),*((u_int32_t *)ap +3)); */ +} + +/* multiply 128 bit number by 10, add bcd digit to result + */ +void +_128x10plusbcd(void * ap, void * tp, char digit) +{ +/* printf("digit %X + %X = ",digit,*((u_int32_t *)ap +3)); */ + _128x10(ap,tp); + *(u_int32_t *)tp = 0; + *((u_int32_t *)tp + 1) = 0; + *((u_int32_t *)tp + 2) = 0; + *((u_int32_t *)tp + 3) = digit; + (void) adder128(ap,tp,0); +/* printf("%d %04X:%04X:%04X:%04X\n",digit,*((u_int32_t *)ap),*((u_int32_t *)ap +1),*((u_int32_t *)ap +2),*((u_int32_t *)ap +3)); */ +} + +char +_simple_pack(void * str,int len) +{ + int i = len -1, j=19, lo=1; + register unsigned char c, * bcdn = (unsigned char *)n.bcd, * sp = (unsigned char *) str; + + if (len > 40) + return '*'; /* error, input string too long */ + + memset (n.bcd, 0, 20); + + do { + c = *(sp + i) & 0x7f; + if (c < zero || c > (zero + 9)) + return c; /* error, out of range */ + + if (lo) { /* lo byte ? */ + *(bcdn + j) = c & 0xF; + lo = 0; + } + else { + c <<= 4; + *(bcdn + j) |= c; + lo = 1; /* lo byte next */ + j--; + } + } while (i-- > 0); + return 0; +} + +/* convert a packed bcd string to 128 bit binary string + */ +void +_bcdn2bin(void * bp, int len) +{ + int i = 0, hasdigits = 0, lo; + register unsigned char c, * cp = (unsigned char *)bp; + + memset(a128.c, 0, 16); + memset(c128.c, 0, 16); + + while (i < len ) { + 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 (c & 0xF) { + 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; + a128.u[3] = c >> 4; + } + } + } + i++; + if (i >= len) + break; + } + } +} + +/* convert a 128 bit number string to a bcd number string + returns the length of the bcd string === 20 + */ +int +_bin2bcd (unsigned char * binary) +{ + register u_int32_t tmp, add3, msk8, bcd8, carry; + u_int32_t word; + unsigned char binmsk = 0; + int c = 0,i, j, p; + + memset (n.bcd, 0, 20); + + for (p=0;p<128;p++) { /* bit pointer */ + if (! binmsk) { + word = *((unsigned char *)binary + c); + binmsk = 0x80; + c++; + } + carry = word & binmsk; /* bit to convert */ + binmsk >>= 1; + for (i=4;i>=0;i--) { + bcd8 = n.bcd[i]; + if (carry | bcd8) { /* if something to do */ + 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 */ + bcd8 <<= 1; /* x 2 */ + if (carry) + bcd8 += 1; + n.bcd[i] = bcd8; + carry = tmp; + } + } + } + netswap(n.bcd,5); + return 20; +} + +/* convert a bcd number string to a bcd text string + returns the number of digits + */ +int +_bcd2txt(unsigned char * bcd2p) +{ + register unsigned char bcd, dchar; + int i, j = 0; + + for (i=0;i<20;i++) { + dchar = *(bcd2p + i); + bcd = dchar >> 4; + if (j || bcd) { + n.txt[j] = bcd + zero; + j++; + } + bcd = dchar & 0xF; + if (j || bcd || i == 19) { /* must be at least one digit */ + n.txt[j] = bcd + zero; + j++; + } + } + n.txt[j] = 0; /* string terminator */ + return j; +} + +MODULE = NetAddr::IP::Util PACKAGE = NetAddr::IP::Util + +PROTOTYPES: ENABLE + +INCLUDE: xs_include/miniSocket.inc + +void +comp128(s,...) + SV * s +ALIAS: + NetAddr::IP::Util::ipv6to4 = 2 + NetAddr::IP::Util::shiftleft = 1 +PREINIT: + unsigned char * ap; + STRLEN len; + int i; +PPCODE: + ap = SvPV(s,len); + if (len != 16) { + if (ix == 2) + strcpy((char *)wa,"ipv6to4"); + else if (ix == 1) + strcpy((char *)wa,"shiftleft"); + else + strcpy((char *)wa,"comp128"); + croak("Bad arg length for %s%s, length is %d, should be %d", + "NetAddr::IP::Util::",(char *)wa,len *8,128); + } + if (ix == 2) { + XPUSHs(sv_2mortal(newSVpvn((unsigned char *)(ap +12),4))); + XSRETURN(1); + } + else if (ix == 1) { + if (items < 2) { + memcpy(wa,ap,16); + } + else if ((i = SvIV(ST(1))) == 0) { + memcpy(wa,ap,16); + } + else if (i < 0 || i > 128) { + croak("Bad arg value for %s, is %d, should be 0 thru 128", + "NetAddr::IP::Util::shiftleft",i); + } + else { + netswap_copy(wa,ap,4); + do { + _128x2(wa); + i--; + } while (i > 0); + netswap(wa,4); + } + } + else { + memcpy(wa,ap,16); + fastcomp128(wa); + } + XPUSHs(sv_2mortal(newSVpvn((unsigned char *)wa,16))); + XSRETURN(1); + +void +add128(as,bs) + SV * as + SV * bs +ALIAS: + NetAddr::IP::Util::sub128 = 1 +PREINIT: + unsigned char * ap, *bp; + STRLEN len; +PPCODE: + ap = SvPV(as,len); + if (len != 16) { + Bail: + if (ix == 1) + strcpy((char *)wa,"sub128"); + else + strcpy((char *)wa,"add128"); + croak("Bad arg length for %s%s, length is %d, should be %d", + "NetAddr::IP::Util::",(char *)wa,len *8,128); + } + + bp = SvPV(bs,len); + if (len != 16) { + goto Bail; + } + + netswap_copy(wa,ap,4); + netswap_copy(wb,bp,4); + if (ix == 1) { + fastcomp128(wb); + XPUSHs(sv_2mortal(newSViv((I32)adder128(wa,wb,1)))); + } + else { + XPUSHs(sv_2mortal(newSViv((I32)adder128(wa,wb,0)))); + } + if (GIMME_V == G_ARRAY) { + netswap(a128.u,4); + XPUSHs(sv_2mortal(newSVpvn(a128.c,16))); + XSRETURN(2); + } + XSRETURN(1); + +void +addconst(s,cnst) + SV * s + I32 cnst +PREINIT: + unsigned char * ap; + STRLEN len; +PPCODE: + ap = SvPV(s,len); + if (len != 16) { + 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(a128.c,16))); + XSRETURN(2); + } + XSRETURN(1); + +int +hasbits(s) + SV * s +ALIAS: + NetAddr::IP::Util::isIPv4 = 1 +PREINIT: + unsigned char * bp; + STRLEN len; +CODE: + bp = SvPV(s,len); + if (len != 16) { + if (ix == 1) + strcpy((char *)wa,"isIPv4"); + else + strcpy((char *)wa,"hasbits"); + croak("Bad arg length for %s%s, length is %d, should be %d", + "NetAddr::IP::Util::",(char *)wa,len *8,128); + } + if (ix == 1) { + RETVAL = _isipv4(bp); + } + else { + RETVAL = have128(bp); + } +OUTPUT: + RETVAL + +void +bin2bcd(s) + SV * s +ALIAS: + NetAddr::IP::Util::bcdn2txt = 2 + NetAddr::IP::Util::bin2bcdn = 1 +PREINIT: + unsigned char * cp; + STRLEN len; +PPCODE: + cp = SvPV(s,len); + if (ix == 0) { + if (len != 16) { + 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(n.txt,_bcd2txt((unsigned char *)n.bcd)))); + } + else if (ix == 1) { + if (len != 16) { + croak("Bad arg length for %s, length is %d, should be %d", + "NetAddr::IP::Util::bin2bcdn",len *8,128); + } + XPUSHs(sv_2mortal(newSVpvn((unsigned char *)n.bcd,_bin2bcd(cp)))); + } + else { + if (len > 20) { + 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(n.txt,_bcd2txt(cp)))); + } + XSRETURN(1); + +#* +#* the second argument 'len' is the number of bcd digits for +#* the bcdn2bin conversion. Pack looses track of the number +#* digits so this is needed to do the "right thing". +#* NOTE: that simple_pack always returns 40 digits +#* +void +bcd2bin(s,...) + SV * s +ALIAS: + NetAddr::IP::Util::bcdn2bin = 2 + NetAddr::IP::Util::simple_pack = 1 +PREINIT: + unsigned char * cp, badc; + STRLEN len; +PPCODE: + cp = SvPV(s,len); + if (len > 40) { + if (ix == 0) + strcpy((char *)wa,"bcd2bin"); + else if (ix ==1) + strcpy((char *)wa,"simple_pack"); + Badigits: + croak("Bad arg length for %s%s, length is %d, should be %d digits or less", + "NetAddr::IP::Util::",(char *)wa,len,40); + } + if (ix == 2) { + if (len > 20) { + len <<= 1; /* times 2 */ + strcpy((char *)wa,"bcdn2bin"); + goto Badigits; + } + if (items < 2) { + croak("Bad usage, should have %s('packedbcd,length)", + "NetAddr::IP::Util::bcdn2bin"); + } + len = SvIV(ST(1)); + _bcdn2bin(cp,(int)len); + netswap(a128.u,4); + XPUSHs(sv_2mortal(newSVpvn(a128.c,16))); + XSRETURN(1); + } + + badc = _simple_pack(cp,(int)len); + if (badc) { + if (ix == 1) + strcpy((char *)wa,"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); + } + if (ix == 0) { + _bcdn2bin(n.bcd,40); + netswap(a128.u,4); + XPUSHs(sv_2mortal(newSVpvn(a128.c,16))); + } + else { /* ix == 1 */ + XPUSHs(sv_2mortal(newSVpvn((unsigned char *)n.bcd,20))); + } + XSRETURN(1); + +void +notcontiguous(s) + SV * s +PREINIT: + unsigned char * ap, count; + STRLEN len; +PPCODE: + ap = SvPV(s,len); + if (len != 16) { + 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))); + XSRETURN(2); + } + XSRETURN(1); + +void +ipv4to6(s) + SV * s +ALIAS: + NetAddr::IP::Util::mask4to6 = 1 +PREINIT: + unsigned char * ip; + STRLEN len; +PPCODE: + ip = SvPV(s,len); + if (len != 4) { + if (ix == 1) + strcpy((char *)wa,"mask4to6"); + else + strcpy((char *)wa,"ipv4to6"); + croak("Bad arg length for %s%s, length is %d, should be 32", + "NetAddr::IP::Util::",(char *)wa,len *8); + } + if (ix == 0) + extendipv4(ip); + else + extendmask4(ip); + XPUSHs(sv_2mortal(newSVpvn((unsigned char *)wa,16))); + XSRETURN(1); + +void +ipanyto6(s) + SV * s +ALIAS: + NetAddr::IP::Util::maskanyto6 = 1 +PREINIT: + unsigned char * ip; + STRLEN len; +PPCODE: + ip = SvPV(s,len); + if (len == 16) /* if already 128 bits, return input */ + XPUSHs(sv_2mortal(newSVpvn(ip,16))); + else if (len == 4) { + if (ix == 0) + extendipv4(ip); + else + extendmask4(ip); + XPUSHs(sv_2mortal(newSVpvn((unsigned char *)wa,16))); + } + else { + if (ix == 1) + strcpy((char *)wa,"maskanyto6"); + else + strcpy((char *)wa,"ipanyto6"); + croak("Bad arg length for %s%s, length is %d, should be 32 or 128", + "NetAddr::IP::Util::",(char *)wa,len *8); + } + XSRETURN(1); diff --git a/Lite/Util/docs/rfc1884.txt b/Lite/Util/docs/rfc1884.txt new file mode 100644 index 0000000..76f8e88 --- /dev/null +++ b/Lite/Util/docs/rfc1884.txt @@ -0,0 +1,1023 @@ +Network Working Group R. Hinden, Ipsilon Networks +Request for Comments: 1884 S. Deering, Xerox PARC +Category: Standards Track Editors + December 1995 + + + IP Version 6 Addressing Architecture + + + + +Status of this Memo + + This document specifies an Internet standards track protocol for the + Internet community, and requests discussion and suggestions for + improvements. Please refer to the current edition of the "Internet + Official Protocol Standards" (STD 1) for the standardization state + and status of this protocol. Distribution of this memo is unlimited. + + +Abstract + + This specification defines the addressing architecture of the IP + Version 6 protocol [IPV6]. The document includes the IPv6 addressing + model, text representations of IPv6 addresses, definition of IPv6 + unicast addresses, anycast addresses, and multicast addresses, and an + IPv6 nodes required addresses. + + + + + + + + + + + + + + + + + + + + + + + + +Hinden & Deering Standards Track [Page 1] + + +RFC 1884 IPv6 Addressing Architecture December 1995 + + +Table of Contents + + 1. Introduction................................................3 + + 2. IPv6 Addressing.............................................3 + 2.1 Addressing Model........................................4 + 2.2 Text Representation of Addresses........................4 + 2.3 Address Type Representation.............................5 + 2.4 Unicast Addresses.......................................7 + 2.4.1 Unicast Address Example.............................8 + 2.4.2 The Unspecified Address.............................9 + 2.4.3 The Loopback Address................................9 + 2.4.4 IPv6 Addresses with Embedded IPv4 Addresses.........9 + 2.4.5 NSAP Addresses......................................10 + 2.4.6 IPX Addresses.......................................10 + 2.4.7 Provider-Based Global Unicast Addresses.............10 + 2.4.8 Local-use IPv6 Unicast Addresses....................11 + 2.5 Anycast Addresses.......................................12 + 2.5.1 Required Anycast Address............................13 + 2.6 Multicast Addresses.....................................14 + 2.6.1 Pre-Defined Multicast Addresses.....................15 + 2.7 A Node's Required Addresses.............................17 + + REFERENCES.....................................................18 + + SECURITY CONSIDERATIONS........................................18 + + DOCUMENT EDITOR'S ADDRESSES....................................18 + + + + + + + + + + + + + + + + + + + + + + + +Hinden & Deering Standards Track [Page 2] + + +RFC 1884 IPv6 Addressing Architecture December 1995 + + +1.0 INTRODUCTION + + + This specification defines the addressing architecture of the IP + Version 6 protocol. It includes a detailed description of the + currently defined address formats for IPv6 [IPV6]. + + The editors would like to acknowledge the contributions of Paul + Francis, Jim Bound, Brian Carpenter, Deborah Estrin, Peter Ford, Bob + Gilligan, Christian Huitema, Tony Li, Greg Minshall, Erik Nordmark, + Yakov Rekhter, Bill Simpson, and Sue Thomson. + +2.0 IPv6 ADDRESSING + + + IPv6 addresses are 128-bit identifiers for interfaces and sets of + interfaces. There are three types of addresses: + + + Unicast: An identifier for a single interface. A packet sent + to a unicast address is delivered to the interface + identified by that address. + + Anycast: An identifier for a set of interfaces (typically + belonging to different nodes). A packet sent to an + anycast address is delivered to one of the interfaces + identified by that address (the "nearest" one, + according to the routing protocols' measure of + distance). + + Multicast: An identifier for a set of interfaces (typically + belonging to different nodes). A packet sent to a + multicast address is delivered to all interfaces + identified by that address. + + There are no broadcast addresses in IPv6, their function being + superseded by multicast addresses. + + In this document, fields in addresses are given a specific name, for + example "subscriber". When this name is used with the term "ID" for + identifier after the name (e.g., "subscriber ID"), it refers to the + contents of the named field. When it is used with the term "prefix" + (e.g., "subscriber prefix") it refers to all of the address up to and + including this field. + + In IPv6, all zeros and all ones are legal values for any field, + unless specifically excluded. Specifically, prefixes may contain + zero-valued fields or end in zeros. + + + + + +Hinden & Deering Standards Track [Page 3] + + +RFC 1884 IPv6 Addressing Architecture December 1995 + + + 2.1 Addressing Model + + IPv6 Addresses of all types are assigned to interfaces, not nodes. + Since each interface belongs to a single node, any of that node's + interfaces' unicast addresses may be used as an identifier for the + node. + + An IPv6 unicast address refers to a single interface. A single + interface may be assigned multiple IPv6 addresses of any type + (unicast, anycast, and multicast). There are two exceptions to this + model. These are: + + 1) A single address may be assigned to multiple physical interfaces + if the implementation treats the multiple physical interfaces as + one interface when presenting it to the internet layer. This is + useful for load-sharing over multiple physical interfaces. + + 2) Routers may have unnumbered interfaces (i.e., no IPv6 address + assigned to the interface) on point-to-point links to eliminate + the necessity to manually configure and advertise the addresses. + Addresses are not needed for point-to-point interfaces on + routers if those interfaces are not to be used as the origins or + destinations of any IPv6 datagrams. + + IPv6 continues the IPv4 model that a subnet is associated with one + link. Multiple subnets may be assigned to the same link. + + + 2.2 Text Representation of Addresses + + There are three conventional forms for representing IPv6 addresses as + text strings: + + 1. The preferred form is x:x:x:x:x:x:x:x, where the 'x's are the + hexadecimal values of the eight 16-bit pieces of the address. + Examples: + + FEDC:BA98:7654:3210:FEDC:BA98:7654:3210 + + 1080:0:0:0:8:800:200C:417A + + Note that it is not necessary to write the leading zeros in an + individual field, but there must be at least one numeral in + every field (except for the case described in 2.). + + 2. Due to the method of allocating certain styles of IPv6 + addresses, it will be common for addresses to contain long + strings of zero bits. In order to make writing addresses + + + +Hinden & Deering Standards Track [Page 4] + + +RFC 1884 IPv6 Addressing Architecture December 1995 + + + containing zero bits easier a special syntax is available to + compress the zeros. The use of "::" indicates multiple groups + of 16-bits of zeros. The "::" can only appear once in an + address. The "::" can also be used to compress the leading + and/or trailing zeros in an address. + + For example the following addresses: + + 1080:0:0:0:8:800:200C:417A a unicast address + FF01:0:0:0:0:0:0:43 a multicast address + 0:0:0:0:0:0:0:1 the loopback address + 0:0:0:0:0:0:0:0 the unspecified addresses + + may be represented as: + + 1080::8:800:200C:417A a unicast address + FF01::43 a multicast address + ::1 the loopback address + :: the unspecified addresses + + 3. An alternative form that is sometimes more convenient when + dealing with a mixed environment of IPv4 and IPv6 nodes is + x:x:x:x:x:x:d.d.d.d, where the 'x's are the hexadecimal values + of the six high-order 16-bit pieces of the address, and the 'd's + are the decimal values of the four low-order 8-bit pieces of the + address (standard IPv4 representation). Examples: + + 0:0:0:0:0:0:13.1.68.3 + + 0:0:0:0:0:FFFF:129.144.52.38 + + or in compressed form: + + ::13.1.68.3 + + ::FFFF:129.144.52.38 + + + 2.3 Address Type Representation + + The specific type of an IPv6 address is indicated by the leading bits + in the address. The variable-length field comprising these leading + bits is called the Format Prefix (FP). The initial allocation of + these prefixes is as follows: + + + + + + + +Hinden & Deering Standards Track [Page 5] + + +RFC 1884 IPv6 Addressing Architecture December 1995 + + + Allocation Prefix Fraction of + (binary) Address Space + ------------------------------- -------- ------------- + Reserved 0000 0000 1/256 + Unassigned 0000 0001 1/256 + + Reserved for NSAP Allocation 0000 001 1/128 + Reserved for IPX Allocation 0000 010 1/128 + + Unassigned 0000 011 1/128 + Unassigned 0000 1 1/32 + Unassigned 0001 1/16 + Unassigned 001 1/8 + + Provider-Based Unicast Address 010 1/8 + + Unassigned 011 1/8 + + Reserved for Geographic- + Based Unicast Addresses 100 1/8 + + Unassigned 101 1/8 + Unassigned 110 1/8 + Unassigned 1110 1/16 + Unassigned 1111 0 1/32 + Unassigned 1111 10 1/64 + Unassigned 1111 110 1/128 + + Unassigned 1111 1110 0 1/512 + + Link Local Use Addresses 1111 1110 10 1/1024 + Site Local Use Addresses 1111 1110 11 1/1024 + + Multicast Addresses 1111 1111 1/256 + + Note: The "unspecified address" (see section 2.4.2), the + loopback address (see section 2.4.3), and the IPv6 Addresses + with Embedded IPv4 Addresses (see section 2.4.4), are assigned + out of the 0000 0000 format prefix space. + + + This allocation supports the direct allocation of provider addresses, + local use addresses, and multicast addresses. Space is reserved for + NSAP addresses, IPX addresses, and geographic addresses. The + remainder of the address space is unassigned for future use. This + can be used for expansion of existing use (e.g., additional provider + addresses, etc.) or new uses (e.g., separate locators and + identifiers). Fifteen percent of the address space is initially + + + +Hinden & Deering Standards Track [Page 6] + + +RFC 1884 IPv6 Addressing Architecture December 1995 + + + allocated. The remaining 85% is reserved for future use. + + Unicast addresses are distinguished from multicast addresses by the + value of the high-order octet of the addresses: a value of FF + (11111111) identifies an address as a multicast address; any other + value identifies an address as a unicast address. Anycast addresses + are taken from the unicast address space, and are not syntactically + distinguishable from unicast addresses. + + + 2.4 Unicast Addresses + + The IPv6 unicast address is contiguous bit-wise maskable, similar to + IPv4 addresses under Class-less Interdomain Routing [CIDR]. + + There are several forms of unicast address assignment in IPv6, + including the global provider based unicast address, the geographic + based unicast address, the NSAP address, the IPX hierarchical + address, the site-local-use address, the link-local-use address, and + the IPv4-capable host address. Additional address types can be + defined in the future. + + IPv6 nodes may have considerable or little knowledge of the internal + structure of the IPv6 address, depending on the role the node plays + (for instance, host versus router). At a minimum, a node may + consider that unicast addresses (including its own) have no internal + structure: + + | 128 bits | + +-----------------------------------------------------------------+ + | node address | + +-----------------------------------------------------------------+ + + + A slightly sophisticated host (but still rather simple) may + additionally be aware of subnet prefix(es) for the link(s) it is + attached to, where different addresses may have different values for + n: + + | n bits | 128-n bits | + +------------------------------------------------+----------------+ + | subnet prefix | interface ID | + +------------------------------------------------+----------------+ + + + Still more sophisticated hosts may be aware of other hierarchical + boundaries in the unicast address. Though a very simple router may + have no knowledge of the internal structure of IPv6 unicast + + + +Hinden & Deering Standards Track [Page 7] + + +RFC 1884 IPv6 Addressing Architecture December 1995 + + + addresses, routers will more generally have knowledge of one or more + of the hierarchical boundaries for the operation of routing + protocols. The known boundaries will differ from router to router, + depending on what positions the router holds in the routing + hierarchy. + + + 2.4.1 Unicast Address Examples + + An example of a Unicast address format which will likely be common on + LANs and other environments where IEEE 802 MAC addresses are + available is: + + + | n bits | 80-n bits | 48 bits | + +--------------------------------+-----------+--------------------+ + | subscriber prefix | subnet ID | interface ID | + +--------------------------------+-----------+--------------------+ + + Where the 48-bit Interface ID is an IEEE-802 MAC address. The use of + IEEE 802 MAC addresses as a interface ID is expected to be very + common in environments where nodes have an IEEE 802 MAC address. In + other environments, where IEEE 802 MAC addresses are not available, + other types of link layer addresses can be used, such as E.164 + addresses, for the interface ID. + + The inclusion of a unique global interface identifier, such as an + IEEE MAC address, makes possible a very simple form of auto- + configuration of addresses. A node may discover a subnet ID by + listening to Router Advertisement messages sent by a router on its + attached link(s), and then fabricating an IPv6 address for itself by + using its IEEE MAC address as the interface ID on that subnet. + + Another unicast address format example is where a site or + organization requires additional layers of internal hierarchy. In + this example the subnet ID is divided into an area ID and a subnet + ID. Its format is: + + | s bits | n bits | m bits | 128-s-n-m bits | + +----------------------+---------+--------------+-----------------+ + | subscriber prefix | area ID | subnet ID | interface ID | + +----------------------+---------+--------------+-----------------+ + + This technique can be continued to allow a site or organization to + add additional layers of internal hierarchy. It may be desirable to + use an interface ID smaller than a 48-bit IEEE 802 MAC address to + allow more space for the additional layers of internal hierarchy. + These could be interface IDs which are administratively created by + + + +Hinden & Deering Standards Track [Page 8] + + +RFC 1884 IPv6 Addressing Architecture December 1995 + + + the site or organization. + + + 2.4.2 The Unspecified Address + + The address 0:0:0:0:0:0:0:0 is called the unspecified address. It + must never be assigned to any node. It indicates the absence of an + address. One example of its use is in the Source Address field of + any IPv6 datagrams sent by an initializing host before it has learned + its own address. + + The unspecified address must not be used as the destination address + of IPv6 datagrams or in IPv6 Routing Headers. + + + 2.4.3 The Loopback Address + + The unicast address 0:0:0:0:0:0:0:1 is called the loopback address. + It may be used by a node to send an IPv6 datagram to itself. It may + never be assigned to any interface. + + The loopback address must not be used as the source address in IPv6 + datagrams that are sent outside of a single node. An IPv6 datagram + with a destination address of loopback must never be sent outside of + a single node. + + + 2.4.4 IPv6 Addresses with Embedded IPv4 Addresses + + The IPv6 transition mechanisms include a technique for hosts and + routers to dynamically tunnel IPv6 packets over IPv4 routing + infrastructure. IPv6 nodes that utilize this technique are assigned + special IPv6 unicast addresses that carry an IPv4 address in the + low-order 32-bits. This type of address is termed an "IPv4- + compatible IPv6 address" and has the format: + + + | 80 bits | 16 | 32 bits | + +--------------------------------------+--------------------------+ + |0000..............................0000|0000| IPv4 address | + +--------------------------------------+----+---------------------+ + + + A second type of IPv6 address which holds an embedded IPv4 address is + also defined. This address is used to represent the addresses of + IPv4-only nodes (those that *do not* support IPv6) as IPv6 addresses. + This type of address is termed an "IPv4-mapped IPv6 address" and has + the format: + + + +Hinden & Deering Standards Track [Page 9] + + +RFC 1884 IPv6 Addressing Architecture December 1995 + + + + | 80 bits | 16 | 32 bits | + +--------------------------------------+--------------------------+ + |0000..............................0000|FFFF| IPv4 address | + +--------------------------------------+----+---------------------+ + + + + 2.4.5 NSAP Addresses + + This mapping of NSAP address into IPv6 addresses is as follows: + + + | 7 | 121 bits | + +-------+---------------------------------------------------------+ + |0000001| to be defined | + +-------+---------------------------------------------------------+ + + The draft definition, motivation, and usage are under study [NSAP]. + + + 2.4.6 IPX Addresses + + This mapping of IPX address into IPv6 addresses is as follows: + + + | 7 | 121 bits | + +-------+---------------------------------------------------------+ + |0000010| to be defined | + +-------+---------------------------------------------------------+ + + The draft definition, motivation, and usage are under study. + + + 2.4.7 Provider-Based Global Unicast Addresses + + The global provider-based unicast address is assigned as described in + [ALLOC]. This initial assignment plan for these unicast addresses is + similar to assignment of IPv4 addresses under the CIDR scheme [CIDR]. + The IPv6 global provider-based unicast address format is as follows: + + + | 3 | n bits | m bits | o bits | 125-n-m-o bits | + +---+-----------+-----------+-------------+--------------------+ + |010|registry ID|provider ID|subscriber ID| intra-subscriber | + +---+-----------+-----------+-------------+--------------------+ + + + + + +Hinden & Deering Standards Track [Page 10] + + +RFC 1884 IPv6 Addressing Architecture December 1995 + + + The high-order part of the address is assigned to registries, who + then assign portions of the address space to providers, who then + assign portions of the address space to subscribers, etc. + + The registry ID identifies the registry which assigns the provider + portion of the address. The term "registry prefix" refers to the + high-order part of the address up to and including the registry ID. + + The provider ID identifies a specific provider which assigns the + subscriber portion of the address. The term "provider prefix" refers + to the high-order part of the address up to and including the + provider ID. + + The subscriber ID distinguishes among multiple subscribers attached + to the provider identified by the provider ID. The term "subscriber + prefix" refers to the high-order part of the address up to and + including the subscriber ID. + + The intra-subscriber portion of the address is defined by an + individual subscriber and is organized according to the subscribers + local internet topology. It is likely that many subscribers will + choose to divide the intra-subscriber portion of the address into a + subnet ID and an interface ID. In this case the subnet ID identifies + a specific physical link and the interface ID identifies a single + interface on that subnet. + + + 2.4.8 Local-use IPv6 Unicast Addresses + + There are two types of local-use unicast addresses defined. These + are Link-Local and Site-Local. The Link-Local is for use on a single + link and the Site-Local is for use in a single site. Link-Local + addresses have the following format: + + | 10 | + | bits | n bits | 118-n bits | + +----------+-------------------------+----------------------------+ + |1111111010| 0 | interface ID | + +----------+-------------------------+----------------------------+ + + Link-Local addresses are designed to be used for addressing on a + single link for purposes such as auto-address configuration, neighbor + discovery, or when no routers are present. + + Routers MUST not forward any packets with link-local source + addresses. + + + + + +Hinden & Deering Standards Track [Page 11] + + +RFC 1884 IPv6 Addressing Architecture December 1995 + + + Site-Local addresses have the following format: + + | 10 | + | bits | n bits | m bits | 118-n-m bits | + +----------+---------+---------------+----------------------------+ + |1111111011| 0 | subnet ID | interface ID | + +----------+---------+---------------+----------------------------+ + + + Site-Local addresses may be used for sites or organizations that are + not (yet) connected to the global Internet. They do not need to + request or "steal" an address prefix from the global Internet address + space. IPv6 site-local addresses can be used instead. When the + organization connects to the global Internet, it can then form global + addresses by replacing the site-local prefix with a subscriber + prefix. + + Routers MUST not forward any packets with site-local source addresses + outside of the site. + + 2.5 Anycast Addresses + + An IPv6 anycast address is an address that is assigned to more than + one interface (typically belonging to different nodes), with the + property that a packet sent to an anycast address is routed to the + "nearest" interface having that address, according to the routing + protocols' measure of distance. + + Anycast addresses are allocated from the unicast address space, using + any of the defined unicast address formats. Thus, anycast addresses + are syntactically indistinguishable from unicast addresses. When a + unicast address is assigned to more than one interface, thus turning + it into an anycast address, the nodes to which the address is + assigned must be explicitly configured to know that it is an anycast + address. + + For any assigned anycast address, there is a longest address prefix P + that identifies the topological region in which all interfaces + belonging to that anycast address reside. Within the region + identified by P, each member of the anycast set must be advertised as + a separate entry in the routing system (commonly referred to as a + "host route"); outside the region identified by P, the anycast + address may be aggregated into the routing advertisement for prefix + P. + + Note that in, the worst case, the prefix P of an anycast set may be + the null prefix, i.e., the members of the set may have no topological + locality. In that case, the anycast address must be advertised as a + + + +Hinden & Deering Standards Track [Page 12] + + +RFC 1884 IPv6 Addressing Architecture December 1995 + + + separate routing entry throughout the entire internet, which presents + a severe scaling limit on how many such "global" anycast sets may be + supported. Therefore, it is expected that support for global anycast + sets may be unavailable or very restricted. + + One expected use of anycast addresses is to identify the set of + routers belonging to an internet service provider. Such addresses + could be used as intermediate addresses in an IPv6 Routing header, to + cause a packet to be delivered via a particular provider or sequence + of providers. Some other possible uses are to identify the set of + routers attached to a particular subnet, or the set of routers + providing entry into a particular routing domain. + + There is little experience with widespread, arbitrary use of internet + anycast addresses, and some known complications and hazards when + using them in their full generality [ANYCST]. Until more experience + has been gained and solutions agreed upon for those problems, the + following restrictions are imposed on IPv6 anycast addresses: + + o An anycast address MUST NOT be used as the source address of an + IPv6 packet. + + o An anycast address MUST NOT be assigned to an IPv6 host, that + is, it may be assigned to an IPv6 router only. + + + 2.5.1 Required Anycast Address + + The Subnet-Router anycast address is predefined. It's format is as + follows: + + + | n bits | 128-n bits | + +------------------------------------------------+----------------+ + | subnet prefix | 00000000000000 | + +------------------------------------------------+----------------+ + + + The "subnet prefix" in an anycast address is the prefix which + identifies a specific link. This anycast address is syntactically + the same as a unicast address for an interface on the link with the + interface identifier set to zero. + + Packets sent to the Subnet-Router anycast address will be delivered + to one router on the subnet. All routers are required to support the + Subnet-Router anycast addresses for the subnets which they have + interfaces. + + + + +Hinden & Deering Standards Track [Page 13] + + +RFC 1884 IPv6 Addressing Architecture December 1995 + + + The subnet-router anycast address is intended to be used for + applications where a node needs to communicate with one of a set of + routers on a remote subnet. For example when a mobile host needs to + communicate with one of the mobile agents on it's "home" subnet. + + + 2.6 Multicast Addresses + + An IPv6 multicast address is an identifier for a group of nodes. A + node may belong to any number of multicast groups. Multicast + addresses have the following format: + + | 8 | 4 | 4 | 112 bits | + +------ -+----+----+---------------------------------------------+ + |11111111|flgs|scop| group ID | + +--------+----+----+---------------------------------------------+ + + 11111111 at the start of the address identifies the address as + being a multicast address. + + +-+-+-+-+ + flgs is a set of 4 flags: |0|0|0|T| + +-+-+-+-+ + + The high-order 3 flags are reserved, and must be + initialized to 0. + + T = 0 indicates a permanently-assigned ("well-known") + multicast address, assigned by the global internet + numbering authority. + + T = 1 indicates a non-permanently-assigned ("transient") + multicast address. + + scop is a 4-bit multicast scope value used to limit the scope of + the multicast group. The values are: + + 0 reserved + 1 node-local scope + 2 link-local scope + 3 (unassigned) + 4 (unassigned) + 5 site-local scope + 6 (unassigned) + 7 (unassigned) + 8 organization-local scope + 9 (unassigned) + A (unassigned) + + + +Hinden & Deering Standards Track [Page 14] + + +RFC 1884 IPv6 Addressing Architecture December 1995 + + + B (unassigned) + C (unassigned) + D (unassigned) + E global scope + F reserved + + group ID identifies the multicast group, either permanent or + transient, within the given scope. + + The "meaning" of a permanently-assigned multicast address is + independent of the scope value. For example, if the "NTP servers + group" is assigned a permanent multicast address with a group ID of + 43 (hex), then: + + FF01:0:0:0:0:0:0:43 means all NTP servers on the same node as + the sender. + + FF02:0:0:0:0:0:0:43 means all NTP servers on the same link as + the sender. + + FF05:0:0:0:0:0:0:43 means all NTP servers at the same site as + the sender. + + FF0E:0:0:0:0:0:0:43 means all NTP servers in the internet. + + Non-permanently-assigned multicast addresses are meaningful only + within a given scope. For example, a group identified by the non- + permanent, site-local multicast address FF15:0:0:0:0:0:0:43 at one + site bears no relationship to a group using the same address at a + different site, nor to a non-permanent group using the same group ID + with different scope, nor to a permanent group with the same group + ID. + + Multicast addresses must not be used as source addresses in IPv6 + datagrams or appear in any routing header. + + + 2.6.1 Pre-Defined Multicast Addresses + + The following well-known multicast addresses are pre-defined: + + Reserved Multicast Addresses: FF00:0:0:0:0:0:0:0 + FF01:0:0:0:0:0:0:0 + FF02:0:0:0:0:0:0:0 + FF03:0:0:0:0:0:0:0 + FF04:0:0:0:0:0:0:0 + FF05:0:0:0:0:0:0:0 + FF06:0:0:0:0:0:0:0 + + + +Hinden & Deering Standards Track [Page 15] + + +RFC 1884 IPv6 Addressing Architecture December 1995 + + + FF07:0:0:0:0:0:0:0 + FF08:0:0:0:0:0:0:0 + FF09:0:0:0:0:0:0:0 + FF0A:0:0:0:0:0:0:0 + FF0B:0:0:0:0:0:0:0 + FF0C:0:0:0:0:0:0:0 + FF0D:0:0:0:0:0:0:0 + FF0E:0:0:0:0:0:0:0 + FF0F:0:0:0:0:0:0:0 + + The above multicast addresses are reserved and shall never be + assigned to any multicast group. + + All Nodes Addresses: FF01:0:0:0:0:0:0:1 + FF02:0:0:0:0:0:0:1 + + The above multicast addresses identify the group of all IPv6 nodes, + within scope 1 (node-local) or 2 (link-local). + + All Routers Addresses: FF01:0:0:0:0:0:0:2 + FF02:0:0:0:0:0:0:2 + + The above multicast addresses identify the group of all IPv6 routers, + within scope 1 (node-local) or 2 (link-local). + + DHCP Server/Relay-Agent: FF02:0:0:0:0:0:0:C + + The above multicast addresses identify the group of all IPv6 DHCP + Servers and Relay Agents within scope 2 (link-local). + + Solicited-Node Address: FF02:0:0:0:0:1:XXXX:XXXX + + The above multicast address is computed as a function of a node's + unicast and anycast addresses. The solicited-node multicast address + is formed by taking the low-order 32 bits of the address (unicast or + anycast) and appending those bits to the 96-bit prefix FF02:0:0:0:0:1 + resulting in a multicast address in the range + + FF02:0:0:0:0:1:0000:0000 + + to + + FF02:0:0:0:0:1:FFFF:FFFF + + For example, the solicited node multicast address corresponding to + the IPv6 address 4037::01:800:200E:8C6C is FF02::1:200E:8C6C. IPv6 + addresses that differ only in the high-order bits, e.g., due to + multiple high-order prefixes associated with different providers, + + + +Hinden & Deering Standards Track [Page 16] + + +RFC 1884 IPv6 Addressing Architecture December 1995 + + + will map to the same solicited-node address thereby reducing the + number of multicast addresses a node must join. + + A node is required to compute and support a Solicited-Node multicast + addresses for every unicast and anycast address it is assigned. + + 2.7 A Node's Required Addresses + + A host is required to recognize the following addresses as + identifying itself: + + o Its Link-Local Address for each interface + o Assigned Unicast Addresses + o Loopback Address + o All-Nodes Multicast Address + o Solicited-Node Multicast Address for each of its assigned + unicast and anycast addresses + o Multicast Addresses of all other groups which the host belongs. + + A router is required to recognize the following addresses as + identifying itself: + + o Its Link-Local Address for each interface + o Assigned Unicast Addresses + o Loopback Address + o The Subnet-Router anycast addresses for the links it has + interfaces. + o All other Anycast addresses with which the router has been + configured. + o All-Nodes Multicast Address + o All-Router Multicast Address + o Solicited-Node Multicast Address for each of its assigned + unicast and anycast addresses + o Multicast Addresses of all other groups which the router + belongs. + + The only address prefixes which should be predefined in an + implementation are the: + + o Unspecified Address + o Loopback Address + o Multicast Prefix (FF) + o Local-Use Prefixes (Link-Local and Site-Local) + o Pre-Defined Multicast Addresses + o IPv4-Compatible Prefixes + + Implementations should assume all other addresses are unicast unless + specifically configured (e.g., anycast addresses). + + + +Hinden & Deering Standards Track [Page 17] + + +RFC 1884 IPv6 Addressing Architecture December 1995 + + +REFERENCES + + [ALLOC] Rekhter, Y., and T. Li, "An Architecture for IPv6 Unicast + Address Allocation", RFC 1887, cisco Systems, December + 1995. + + [ANYCST] Partridge, C., Mendez, T., and W. Milliken, "Host + Anycasting Service", RFC 1546, BBN, November 1993. + + [CIDR] Fuller, V., Li, T., Varadhan, K., and J. Yu, "Supernetting: + an Address Assignment and Aggregation Strategy", RFC 1338, + BARRNet, cisco, Merit, OARnet, June 1992. + + [IPV6] Deering, S., and R. Hinden, Editors, "Internet Protocol, + Version 6 (IPv6) Specification", RFC 1883, Xerox PARC, + Ipsilon Networks, December 1995. + + [MULT] Deering, S., "Host Extensions for IP multicasting", STD 5, + RFC 1112, Stanford University, August 1989. + + [NSAP] Carpenter, B., Editor, "Mechanisms for OSIN SAPs, CLNP and + TP over IPv6", Work in Progress. + + + +SECURITY CONSIDERATIONS + + Security issues are not discussed in this document. + + +DOCUMENT EDITOR'S ADDRESSES + + Robert M. Hinden Stephen E. Deering + Ipsilon Networks, Inc. Xerox Palo Alto Research Center + 2191 E. Bayshore Road, Suite 100 3333 Coyote Hill Road + Palo Alto, CA 94303 Palo Alto, CA 94304 + USA USA + + Phone: +1 415 846 4604 Phone: +1 415 812 4839 + Fax: +1 415 855 1414 Fax: +1 415 812 4471 + EMail: hinden@ipsilon.com EMail: deering@parc.xerox.com + + + + + + + + + + +Hinden & Deering Standards Track [Page 18] diff --git a/Lite/Util/lib/NetAddr/IP/UtilPP.pm b/Lite/Util/lib/NetAddr/IP/UtilPP.pm new file mode 100644 index 0000000..ea8628e --- /dev/null +++ b/Lite/Util/lib/NetAddr/IP/UtilPP.pm @@ -0,0 +1,694 @@ +#!/usr/bin/perl +package NetAddr::IP::UtilPP; + +use strict; +#use diagnostics; +#use lib qw(blib lib); + +use AutoLoader qw(AUTOLOAD); +use vars qw($VERSION @EXPORT_OK @ISA %EXPORT_TAGS); +require Exporter; + + +@ISA = qw(Exporter); + +$VERSION = do { my @r = (q$Revision: 0.07 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; + +@EXPORT_OK = qw( + hasbits + isIPv4 + shiftleft + addconst + add128 + sub128 + notcontiguous + ipv4to6 + mask4to6 + ipanyto6 + maskanyto6 + ipv6to4 + bin2bcd + bcd2bin + comp128 + bin2bcdn + bcdn2txt + bcdn2bin + simple_pack +); + +%EXPORT_TAGS = ( + all => [@EXPORT_OK], +); + +sub DESTROY {}; + +1; +__END__ + +=head1 NAME + +NetAddr::IP::UtilPP -- pure Perl functions for NetAddr::IP::Util + +=head1 SYNOPSIS + + use NetAddr::IP::UtilPP qw( + hasbits + isIPv4 + shiftleft + addconst + add128 + sub128 + notcontiguous + ipv4to6 + mask4to6 + ipanyto6 + maskanyto6 + ipv6to4 + bin2bcd + bcd2bin + ); + + use NetAddr::IP::UtilPP qw(:all) + + $rv = hasbits($bits128); + $rv = isIPv4($bits128); + $bitsX2 = shiftleft($bits128,$n); + $carry = addconst($ipv6naddr,$signed_32con); + ($carry,$ipv6naddr)=addconst($ipv6naddr,$signed_32con); + $carry = add128($ipv6naddr1,$ipv6naddr2); + ($carry,$ipv6naddr)=add128($ipv6naddr1,$ipv6naddr2); + $carry = sub128($ipv6naddr1,$ipv6naddr2); + ($spurious,$cidr) = notcontiguous($mask128); + ($carry,$ipv6naddr)=sub128($ipv6naddr1,$ipv6naddr2); + $ipv6naddr = ipv4to6($netaddr); + $ipv6naddr = mask4to6($netaddr); + $ipv6naddr = ipanyto6($netaddr); + $ipv6naddr = maskanyto6($netaddr); + $netaddr = ipv6to4($pv6naddr); + $bcdtext = bin2bcd($bits128); + $bits128 = bcd2bin($bcdtxt); + +=head1 DESCRIPTION + +B provides pure Perl functions for B + +=over 4 + +=item * $rv = hasbits($bits128); + +This function returns true if there are one's present in the 128 bit string +and false if all the bits are zero. + + i.e. if (hasbits($bits128)) { + &do_something; + } + + or if (hasbits($bits128 & $mask128) { + &do_something; + } + +This allows the implementation of logical functions of the form of: + + if ($bits128 & $mask128) { + ... + + input: 128 bit IPv6 string + returns: true if any bits are present + +=cut + +sub _deadlen { + my($len,$should) = @_; + $len *= 8; + $should = 128 unless $should; + my $sub = (caller(1))[3]; + die "Bad argument length for ".__PACKAGE__.":$sub, is $len, should be $should"; +} + +sub hasbits { + _deadlen(length($_[0])) + if length($_[0]) != 16; + return 1 if vec($_[0],3,32); + return (isIPv4($_[0])) ? 0 : 1; +} + +=item * $rv = isIPv4($bits128); + +This function returns true if there are no on bits present in the IPv6 +portion of the 128 bit string and false otherwise. + +=cut + +sub isIPv4 { + _deadlen(length($_[0])) + if length($_[0]) != 16; + return 0 if vec($_[0],0,32); + return 0 if vec($_[0],1,32); + return 0 if vec($_[0],2,32); + return 1; +} + +=item * $bitsXn = shiftleft($bits128,$n); + + input: 128 bit string variable, + number of shifts [optional] + returns: bits X n shifts + + NOTE: a single shift is performed + if $n is not specified + +=cut + +# multiply x 2 +# +sub _128x2 { + my $inp = shift; + $$inp[0] = ($$inp[0] << 1 & 0xffffffff) + (($$inp[1] & 0x80000000) ? 1:0); + $$inp[1] = ($$inp[1] << 1 & 0xffffffff) + (($$inp[2] & 0x80000000) ? 1:0); + $$inp[2] = ($$inp[2] << 1 & 0xffffffff) + (($$inp[3] & 0x80000000) ? 1:0); + $$inp[3] = $$inp[3] << 1 & 0xffffffff; +} + +# multiply x 10 +# +sub _128x10 { + my($a128p) = @_; + _128x2($a128p); # x2 + my @x2 = @$a128p; # save the x2 value + _128x2($a128p); + _128x2($a128p); # x8 + _sa128($a128p,\@x2,0); # add for x10 +} + +sub shiftleft { + _deadlen(length($_[0])) + if length($_[0]) != 16; + my($bits,$shifts) = @_; + return $bits unless $shifts; + die "Bad arg value for ".__PACKAGE__.":shiftleft, length should be 0 thru 128" + if $shifts < 0 || $shifts > 128; + my @uint32t = unpack('N4',$bits); + do { + $bits = _128x2(\@uint32t); + $shifts-- + } while $shifts > 0; + pack('N4',@uint32t); +} + +sub slowadd128 { + my @ua = unpack('N4',$_[0]); + my @ub = unpack('N4',$_[1]); + my $carry = _sa128(\@ua,\@ub,$_[2]); + return ($carry,pack('N4',@ua)) + if wantarray; + return $carry; +} + +sub _sa128 { + my($uap,$ubp,$carry) = @_; + if (($$uap[3] += $$ubp[3] + $carry) > 0xffffffff) { + $$uap[3] -= 4294967296; # 0x1_00000000 + $carry = 1; + } else { + $carry = 0; + } + + if (($$uap[2] += $$ubp[2] + $carry) > 0xffffffff) { + $$uap[2] -= 4294967296; + $carry = 1; + } else { + $carry = 0; + } + + if (($$uap[1] += $$ubp[1] + $carry) > 0xffffffff) { + $$uap[1] -= 4294967296; + $carry = 1; + } else { + $carry = 0; + } + + if (($$uap[0] += $$ubp[0] + $carry) > 0xffffffff) { + $$uap[0] -= 4294967296; + $carry = 1; + } else { + $carry = 0; + } + $carry; +} + +=item * addconst($ipv6naddr,$signed_32con); + +Add a signed constant to a 128 bit string variable. + + input: 128 bit IPv6 string, + signed 32 bit integer + returns: scalar carry + array (carry, result) + +=cut + +sub addconst { + my($a128,$const) = @_; + _deadlen(length($a128)) + if length($a128) != 16; + unless ($const) { + return (wantarray) ? ($const,$a128) : $const; + } + my $sign = ($const < 0) ? 0xffffffff : 0; + my $b128 = pack('N4',$sign,$sign,$sign,$const); + @_ = ($a128,$b128,0); + goto &slowadd128; +} + +=item * add128($ipv6naddr1,$ipv6naddr2); + +Add two 128 bit string variables. + + input: 128 bit string var1, + 128 bit string var2 + returns: scalar carry + array (carry, result) + +=cut + +sub add128 { + my($a128,$b128) = @_; + _deadlen(length($a128)) + if length($a128) != 16; + _deadlen(length($b128)) + if length($b128) != 16; + @_ = ($a128,$b128,0); + goto &slowadd128; +} + +=item * sub128($ipv6naddr1,$ipv6naddr2); + +Subtract two 128 bit string variables. + + input: 128 bit string var1, + 128 bit string var2 + returns: scalar carry + array (carry, result) + +Note: The carry from this operation is the result of adding the one's +complement of ARG2 +1 to the ARG1. It is logically +B. + + i.e. if ARG1 >= ARG2 then carry = 1 + or if ARG1 < ARG2 then carry = 0 + +=cut + +sub sub128 { + _deadlen(length($_[0])) + if length($_[0]) != 16; + _deadlen(length($_[1])) + if length($_[1]) != 16; + my $a128 = $_[0]; + my $b128 = ~$_[1]; + @_ = ($a128,$b128,1); + goto &slowadd128; +} + +=item * ($cidr,$spurious) = notcontiguous($mask128); + +This function counts the bit positions remaining in the mask when the +rightmost '0's are removed. + + input: 128 bit netmask + returns true if there are spurious + zero bits remaining in the + mask, false if the mask is + contiguous one's, + 128 bit cidr + +=cut + +sub notcontiguous { + _deadlen(length($_[0])) + if length($_[0]) != 16; + my @ua = unpack('N4', ~$_[0]); + my $count; + for ($count = 128;$count > 0; $count--) { + last unless $ua[3] & 1; + $ua[3] >>= 1; + $ua[3] |= 0x80000000 if $ua[2] & 1; + $ua[2] >>= 1; + $ua[2] |= 0x80000000 if $ua[1] & 1; + $ua[1] >>= 1; + $ua[1] |= 0x80000000 if $ua[0] & 1; + $ua[0] >>= 1; + } + + my $spurious = $ua[0] | $ua[1] | $ua[2] | $ua[3]; + return $spurious unless wantarray; + return ($spurious,$count); +} + +=item * $ipv6naddr = ipv4to6($netaddr); + +Convert an ipv4 network address into an ipv6 network address. + + input: 32 bit network address + returns: 128 bit network address + +=cut + +sub ipv4to6 { + _deadlen(length($_[0]),32) + if length($_[0]) != 4; +# return pack('L3H8',0,0,0,unpack('H8',$_[0])); + return pack('L3a4',0,0,0,$_[0]); +} + +=item * $ipv6naddr = mask4to6($netaddr); + +Convert an ipv4 netowrk address into an ipv6 network mask. + + input: 32 bit network/mask address + returns: 128 bit network/mask address + +NOTE: returns the high 96 bits as one's + +=cut + +sub mask4to6 { + _deadlen(length($_[0]),32) + if length($_[0]) != 4; +# return pack('L3H8',0xffffffff,0xffffffff,0xffffffff,unpack('H8',$_[0])); + return pack('L3a4',0xffffffff,0xffffffff,0xffffffff,$_[0]); +} + +=item * $ipv6naddr = ipanyto6($netaddr); + +Similar to ipv4to6 except that this function takes either an IPv4 or IPv6 +input and always returns a 128 bit IPv6 network address. + + input: 32 or 128 bit network address + returns: 128 bit network address + +=cut + +sub ipanyto6 { + my $naddr = shift; + my $len = length($naddr); + return $naddr if $len == 16; +# return pack('L3H8',0,0,0,unpack('H8',$naddr)) + return pack('L3a4',0,0,0,$naddr) + if $len == 4; + _deadlen($len,'32 or 128'); +} + +=item * $ipv6naddr = maskanyto6($netaddr); + +Similar to mask4to6 except that this function takes either an IPv4 or IPv6 +netmask and always returns a 128 bit IPv6 netmask. + + input: 32 or 128 bit network mask + returns: 128 bit network mask + +=cut + +sub maskanyto6 { + my $naddr = shift; + my $len = length($naddr); + return $naddr if $len == 16; +# return pack('L3H8',0xffffffff,0xffffffff,0xffffffff,unpack('H8',$naddr)) + return pack('L3a4',0xffffffff,0xffffffff,0xffffffff,$naddr) + if $len == 4; + _deadlen($len,'32 or 128'); +} + +=item * $netaddr = ipv6to4($pv6naddr); + +Truncate the upper 96 bits of a 128 bit address and return the lower +32 bits. Returns an IPv4 address as returned by inet_aton. + + input: 128 bit network address + returns: 32 bit inet_aton network address + +=cut + +sub ipv6to4 { + my $naddr = shift; +_deadlen(length($naddr)) + if length($naddr) != 16; + @_ = unpack('L3H8',$naddr); + return pack('H8',@{_}[3..10]); +} + +=item * $bcdtext = bin2bcd($bits128); + +Convert a 128 bit binary string into binary coded decimal text digits. + + input: 128 bit string variable + returns: string of bcd text digits + +=cut + +sub bin2bcd { + _deadlen(length($_[0])) + if length($_[0]) != 16; + unpack("H40",&_bin2bcdn) =~ /^0*(.+)/; + $1; +} + +=item * $bits128 = bcd2bin($bcdtxt); + +Convert a bcd text string to 128 bit string variable + + input: string of bcd text digits + returns: 128 bit string variable + +=cut + +sub bcd2bin { + &_bcdcheck; + goto &_bcd2bin; +} + +=back + +=cut + +#=item * $onescomp = comp128($ipv6addr); +# +#This function is for testing, it is more efficient to use perl " ~ " +#on the bit string directly. This interface to the B routine is published for +#module testing purposes because it is used internally in the B routine. The +#function is very fast, but calling if from perl directly is very slow. It is almost +#33% faster to use B than to do a 1's comp with perl and then call +#B. In the PurePerl version, it is a call to +# +# sub {return ~ $_[0]}; +# +#=cut + +sub comp128 { + _deadlen(length($_[0])) + if length($_[0]) != 16; + return ~ $_[0]; +} + +#=item * $bcdpacked = bin2bcdn($bits128); +# +#Convert a 128 bit binary string into binary coded decimal digits. +#This function is for testing only. +# +# input: 128 bit string variable +# returns: string of packed decimal digits +# +# i.e. text = unpack("H*", $bcd); +# +#=cut + +sub bin2bcdn { + _deadlen(length($_[0])) + if length($_[0]) != 16; + goto &_bin2bcdn; +} + +sub _bin2bcdn { + my($b128) = @_; + my @binary = unpack('N4',$b128); + my @nbcd = (0,0,0,0,0); # 5 - 32 bit registers + my ($add3, $msk8, $bcd8, $carry, $tmp); + my $j = 0; + my $k = -1; + my $binmsk = 0; + foreach(0..127) { + unless ($binmsk) { + $binmsk = 0x80000000; + $k++; + } + $carry = $binary[$k] & $binmsk; + $binmsk >>= 1; + next unless $carry || $j; # skip leading zeros + foreach(4,3,2,1,0) { + $bcd8 = $nbcd[$_]; + $add3 = 3; + $msk8 = 8; + + $j = 0; + while ($j < 8) { + $tmp = $bcd8 + $add3; + if ($tmp & $msk8) { + $bcd8 = $tmp; + } + $add3 <<= 4; + $msk8 <<= 4; + $j++; + } + $tmp = $bcd8 & 0x80000000; # propagate carry + $bcd8 <<= 1; # x2 + if ($carry) { + $bcd8 += 1; + } + $nbcd[$_] = $bcd8; + $carry = $tmp; + } + } + pack('N5',@nbcd); +} + +#=item * $bcdtext = bcdn2txt($bcdpacked); +# +#Convert a packed bcd string into text digits, suppress the leading zeros. +#This function is for testing only. +# +# input: string of packed decimal digits +# consisting of exactly 40 digits +# returns: hexdecimal digits +# +#Similar to unpack("H*", $bcd); +# +#=cut + +sub bcdn2txt { + die "Bad argument length for ".__PACKAGE__.":bcdn2txt, is ".(2 * length($_[0])).", should be exactly 40 digits" + if length($_[0]) != 20; + (unpack('H40',$_[0])) =~ /^0*(.+)/; + $1; +} + +#=item * $bits128 = bcdn2bin($bcdpacked,$ndigits); +# +# Convert a packed bcd string into a 128 bit string variable +# +# input: packed bcd string +# number of digits in string +# returns: 128 bit string variable +# + +sub bcdn2bin { + my($bcd,$dc) = @_; + $dc = 0 unless $dc; + die "Bad argument length for ".__PACKAGE__.":bcdn2txt, is ".(2 * length($bcd)).", should be 1 to 40 digits" + if length($bcd) > 20; + die "Bad digit count for ".__PACKAGE__.":bcdn2bin, is $dc, should be 1 to 40 digits" + if $dc < 1 || $dc > 40; + return _bcd2bin(unpack("H$dc",$bcd)); +} + +sub _bcd2bin { + my @bcd = split('',$_[0]); + my @hbits = (0,0,0,0); + my @digit = (0,0,0,0); + my $found = 0; + foreach(@bcd) { + my $bcd = $_ & 0xf; # just the nibble + unless ($found) { + next unless $bcd; # skip leading zeros + $found = 1; + $hbits[3] = $bcd; # set the first digit, no x10 necessary + next; + } + _128x10(\@hbits); + $digit[3] = $bcd; + _sa128(\@hbits,\@digit,0); + } + return pack('N4',@hbits); +} + +#=item * $bcdpacked = simple_pack($bcdtext); +# +#Convert a numeric string into a packed bcd string, left fill with zeros +#This function is for testing only. +# +# input: string of decimal digits +# returns: string of packed decimal digits +# +#Similar to pack("H*", $bcdtext); +# +sub _bcdcheck { + my($bcd) = @_;; + my $sub = (caller(1))[3]; + my $len = length($bcd); + die "Bad bcd number length $_ ".__PACKAGE__.":simple_pack, should be 1 to 40 digits" + if $len > 40 || $len < 1; + die "Bad character in decimal input string '$&' for ".__PACKAGE__.":simple_pack" + if $bcd =~ /\D/; +} + +sub simple_pack { + &_bcdcheck; + my($bcd) = @_; + while (length($bcd) < 40) { + $bcd = '0'. $bcd; + } + return pack('H40',$bcd); +} + + +=head1 EXPORT_OK + + hasbits + isIPv4 + shiftleft + addconst + add128 + sub128 + notcontiguous + ipv4to6 + mask4to6 + ipanyto6 + maskanyto6 + ipv6to4 + bin2bcd + bcd2bin + comp128 + bin2bcdn + bcdn2txt + bcdn2bin + simple_pack + +=head1 AUTHOR + +Michael Robinton + +=head1 COPYRIGHT + +Copyright 2006, 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 +otherwise in individuals sub modules) published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +=head1 AUTHOR + +Michael Robinton + +=cut + +1; diff --git a/Lite/Util/siteconf b/Lite/Util/siteconf new file mode 100755 index 0000000..3316dc8 --- /dev/null +++ b/Lite/Util/siteconf @@ -0,0 +1,1770 @@ +#! /bin/sh +# Guess values for system-dependent variables and create Makefiles. +# Generated by GNU Autoconf 2.53 and edited for this module 9-22-03 +# +# Copyright 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, 2002 +# Free Software Foundation, Inc. +# This configure script is free software; the Free Software Foundation +# gives unlimited permission to copy, distribute and modify it. +# +# +# Makefile.PL changes needed to use this script +# +# clean => 'whatever.... localStuff.h config.log' +# +# sub MY::top_targets { +# package MY; +# my $begin = q| +# config :: localStuff.h +# @$(NOOP) +# +# # siteconf CCname Cfile_ext OBJext EXEext "Cflags" "LDflags" +# # +# localStuff.h : +# ./siteconf "$(CC)" ".c" "$(OBJ_EXT)" "$(EXE_EXT)" "$(CCFLAGS)" "$(LDflags)" +# |; +# my $inherited = shift->SUPER::top_targets(@_); +# # whatever additional change, additions that may be needed +# $begin . $inherited; +# } +# +# + +# the command line must contain +# +# siteconf CCname Cfile_ext OBJext EXEext "Cflags" "LDflags" +if [ $# -ne 7 ]; then + echo this script is run by make, do not run it from the command line + exit -1 +fi + +CC=$1 +ac_ext=`echo $2 | sed 's/.//; q'` +ac_objext=`echo $3 | sed 's/.//; q'` +ac_cv_exeext=`echo $4 | sed 's/.//; q'` +CFLAGS=$5 +LDFLAGS=$6 +LIBS=$7 + +# want something like this... +#CC=gcc +#ac_ext=c +#ac_objext=o +#ac_cv_exeext= + +exec 5>config.log + +ac_exeext=$ac_cv_exeext +ac_compile='$CC -c $CFLAGS conftest.$ac_ext >&5' +ac_compile='$CC -c $CFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' + + +if expr a : '\(a\)' >/dev/null 2>&1; then + as_expr=expr +else + as_expr=false +fi + +exec 6>&1 + +rm -f localStuff.h + +cat >localStuff.h <<\_ASBOX +/* **************************************************** * + * ## localStuff.h ## * + * ## ----------- ## * + * * + * This file was generated automatically by 'siteconf'. * + * Don't edit this file, edit 'siteconf' instead. * + * * + * **************************************************** */ +#ifdef host_is_BIG_ENDIAN +#undef host_is_BIG_ENDIAN +#endif +#ifdef host_is_LITTLE_ENDIAN +#undef host_is_LITTLE_ENDIAN +#endif +_ASBOX + +## --------------------- ## +## M4sh Initialization. ## +## --------------------- ## + +# Be Bourne compatible +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then + emulate sh + NULLCMD=: +elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then + set -o posix +fi + +# Name of the executable. +as_me=`(basename "$0") 2>/dev/null || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)$' \| \ + . : '\(.\)' 2>/dev/null || +echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } + /^X\/\(\/\/\)$/{ s//\1/; q; } + /^X\/\(\/\).*/{ s//\1/; q; } + s/.*/./; q'` + +# PATH needs CR, and LINENO needs CR and PATH. +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + echo "#! /bin/sh" >conftest.sh + echo "exit 0" >>conftest.sh + chmod +x conftest.sh + if (PATH=".;."; conftest.sh) >/dev/null 2>&1; then + PATH_SEPARATOR=';' + else + PATH_SEPARATOR=: + fi + rm -f conftest.sh +fi + + + as_lineno_1=$LINENO + as_lineno_2=$LINENO + as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x$as_lineno_3" = "x$as_lineno_2" || { + # Find who we are. Look in the path if we contain no path at all + # relative or not. + case $0 in + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break +done + + ;; + esac + # We did not find ourselves, most probably we were run as `sh COMMAND' + # in which case we are not to be found in the path. + if test "x$as_myself" = x; then + as_myself=$0 + fi + if test ! -f "$as_myself"; then + { echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2 + { (exit 1); exit 1; }; } + fi + case $CONFIG_SHELL in + '') + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for as_base in sh bash ksh sh5; do + case $as_dir in + /*) + if ("$as_dir/$as_base" -c ' + as_lineno_1=$LINENO + as_lineno_2=$LINENO + as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then + CONFIG_SHELL=$as_dir/$as_base + export CONFIG_SHELL + exec "$CONFIG_SHELL" "$0" ${1+"$@"} + fi;; + esac + done +done +;; + esac + + # Create $as_me.lineno as a copy of $as_myself, but with $LINENO + # uniformly replaced by the line number. The first 'sed' inserts a + # line-number line before each line; the second 'sed' does the real + # work. The second script uses 'N' to pair each line-number line + # with the numbered line, and appends trailing '-' during + # substitution so that $LINENO is not a special case at line end. + # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the + # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) + sed '=' <$as_myself | + sed ' + N + s,$,-, + : loop + s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, + t loop + s,-$,, + s,^['$as_cr_digits']*\n,, + ' >$as_me.lineno && + chmod +x $as_me.lineno || + { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 + { (exit 1); exit 1; }; } + + # Don't try to exec as it changes $[0], causing all sort of problems + # (the dirname of $[0] is not the place where we might find the + # original and so on. Autoconf is especially sensible to this). + . ./$as_me.lineno + # Exit status is that of the last command. + exit +} + + +case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in + *c*,-n*) ECHO_N= ECHO_C=' +' ECHO_T=' ' ;; + *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; + *) ECHO_N= ECHO_C='\c' ECHO_T= ;; +esac + +if expr a : '\(a\)' >/dev/null 2>&1; then + as_expr=expr +else + as_expr=false +fi + +cat >&5 <<_ACEOF +This file contains any messages produced by compilers while +running siteconf, to aid debugging if siteconf makes a mistake. + +It was created by $as_me, which was +generated by GNU Autoconf 2.53. Invocation command line was + + $ $0 $@ + +_ACEOF + +# Factoring default headers for most tests. +ac_includes_default="\ +#include +#if HAVE_SYS_TYPES_H +# include +#endif +#if HAVE_SYS_STAT_H +# include +#endif +#if STDC_HEADERS +# include +# include +#else +# if HAVE_STDLIB_H +# include +# endif +#endif +#if HAVE_STRING_H +# if !STDC_HEADERS && HAVE_MEMORY_H +# include +# endif +# include +#endif +#if HAVE_STRINGS_H +# include +#endif +#if HAVE_INTTYPES_H +# include +#else +# if HAVE_STDINT_H +# include +# endif +#endif +#if HAVE_UNISTD_H +# include +#endif" + +############### begin tests ############################# + +# Checks for data types +echo "$as_me:$LINENO: checking for char" >&5 +echo $ECHO_N "checking for char... $ECHO_C" >&6 +if test "${ac_cv_type_char+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +#line $LINENO "siteconf" +#include "localStuff.h" +$ac_includes_default +#ifdef F77_DUMMY_MAIN +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } +#endif +int +main () +{ +if ((char *) 0) + return 0; +if (sizeof (char)) + return 0; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_type_char=yes +else + echo "$as_me: failed program was:" >&5 +cat conftest.$ac_ext >&5 +ac_cv_type_char=no +fi +rm -f conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_type_char" >&5 +echo "${ECHO_T}$ac_cv_type_char" >&6 + +echo "$as_me:$LINENO: checking size of char" >&5 +echo $ECHO_N "checking size of char... $ECHO_C" >&6 +if test "${ac_cv_sizeof_char+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test "$ac_cv_type_char" = yes; then + # The cast to unsigned long works around a bug in the HP C Compiler + # version HP92453-01 B.11.11.23709.GP, which incorrectly rejects + # declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. + # This bug is HP SR number 8606223364. + if test "$cross_compiling" = yes; then + # Depending upon the size, compute the lo and hi bounds. +cat >conftest.$ac_ext <<_ACEOF +#line $LINENO "siteconf" +#include "localStuff.h" +$ac_includes_default +#ifdef F77_DUMMY_MAIN +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } +#endif +int +main () +{ +static int test_array [1 - 2 * !(((long) (sizeof (char))) >= 0)]; +test_array [0] = 0 + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_lo=0 ac_mid=0 + while :; do + cat >conftest.$ac_ext <<_ACEOF +#line $LINENO "siteconf" +#include "localStuff.h" +$ac_includes_default +#ifdef F77_DUMMY_MAIN +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } +#endif +int +main () +{ +static int test_array [1 - 2 * !(((long) (sizeof (char))) <= $ac_mid)]; +test_array [0] = 0 + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_hi=$ac_mid; break +else + echo "$as_me: failed program was:" >&5 +cat conftest.$ac_ext >&5 +ac_lo=`expr $ac_mid + 1` + if test $ac_lo -le $ac_mid; then + ac_lo= ac_hi= + break + fi + ac_mid=`expr 2 '*' $ac_mid + 1` +fi +rm -f conftest.$ac_objext conftest.$ac_ext + done +else + echo "$as_me: failed program was:" >&5 +cat conftest.$ac_ext >&5 +cat >conftest.$ac_ext <<_ACEOF +#line $LINENO "siteconf" +#include "localStuff.h" +$ac_includes_default +#ifdef F77_DUMMY_MAIN +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } +#endif +int +main () +{ +static int test_array [1 - 2 * !(((long) (sizeof (char))) < 0)]; +test_array [0] = 0 + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_hi=-1 ac_mid=-1 + while :; do + cat >conftest.$ac_ext <<_ACEOF +#line $LINENO "siteconf" +#include "localStuff.h" +$ac_includes_default +#ifdef F77_DUMMY_MAIN +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } +#endif +int +main () +{ +static int test_array [1 - 2 * !(((long) (sizeof (char))) >= $ac_mid)]; +test_array [0] = 0 + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_lo=$ac_mid; break +else + echo "$as_me: failed program was:" >&5 +cat conftest.$ac_ext >&5 +ac_hi=`expr '(' $ac_mid ')' - 1` + if test $ac_mid -le $ac_hi; then + ac_lo= ac_hi= + break + fi + ac_mid=`expr 2 '*' $ac_mid` +fi +rm -f conftest.$ac_objext conftest.$ac_ext + done +else + echo "$as_me: failed program was:" >&5 +cat conftest.$ac_ext >&5 +ac_lo= ac_hi= +fi +rm -f conftest.$ac_objext conftest.$ac_ext +fi +rm -f conftest.$ac_objext conftest.$ac_ext +# Binary search between lo and hi bounds. +while test "x$ac_lo" != "x$ac_hi"; do + ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` + cat >conftest.$ac_ext <<_ACEOF +#line $LINENO "siteconf" +#include "localStuff.h" +$ac_includes_default +#ifdef F77_DUMMY_MAIN +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } +#endif +int +main () +{ +static int test_array [1 - 2 * !(((long) (sizeof (char))) <= $ac_mid)]; +test_array [0] = 0 + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_hi=$ac_mid +else + echo "$as_me: failed program was:" >&5 +cat conftest.$ac_ext >&5 +ac_lo=`expr '(' $ac_mid ')' + 1` +fi +rm -f conftest.$ac_objext conftest.$ac_ext +done +case $ac_lo in +?*) ac_cv_sizeof_char=$ac_lo;; +'') { { echo "$as_me:$LINENO: error: cannot compute sizeof (char), 77" >&5 +echo "$as_me: error: cannot compute sizeof (char), 77" >&2;} + { (exit 1); exit 1; }; } ;; +esac +else + if test "$cross_compiling" = yes; then + { { echo "$as_me:$LINENO: error: cannot run test program while cross compiling" >&5 +echo "$as_me: error: cannot run test program while cross compiling" >&2;} + { (exit 1); exit 1; }; } +else + cat >conftest.$ac_ext <<_ACEOF +#line $LINENO "siteconf" +#include "localStuff.h" +$ac_includes_default +long longval () { return (long) (sizeof (char)); } +unsigned long ulongval () { return (long) (sizeof (char)); } +#include +#include +#ifdef F77_DUMMY_MAIN +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } +#endif +int +main () +{ + + FILE *f = fopen ("conftest.val", "w"); + if (! f) + exit (1); + if (((long) (sizeof (char))) < 0) + { + long i = longval (); + if (i != ((long) (sizeof (char)))) + exit (1); + fprintf (f, "%ld\n", i); + } + else + { + unsigned long i = ulongval (); + if (i != ((long) (sizeof (char)))) + exit (1); + fprintf (f, "%lu\n", i); + } + exit (ferror (f) || fclose (f) != 0); + + ; + return 0; +} +_ACEOF +rm -f conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { ac_try='./conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_sizeof_char=`cat conftest.val` +else + echo "$as_me: program exited with status $ac_status" >&5 +echo "$as_me: failed program was:" >&5 +cat conftest.$ac_ext >&5 +( exit $ac_status ) +{ { echo "$as_me:$LINENO: error: cannot compute sizeof (char), 77" >&5 +echo "$as_me: error: cannot compute sizeof (char), 77" >&2;} + { (exit 1); exit 1; }; } +fi +rm -f core core.* *.core conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext +fi +fi +rm -f conftest.val +else + ac_cv_sizeof_char=0 +fi +fi +echo "$as_me:$LINENO: result: $ac_cv_sizeof_char" >&5 +echo "${ECHO_T}$ac_cv_sizeof_char" >&6 +cat >>localStuff.h <<_ACEOF +#define SIZEOF_CHAR $ac_cv_sizeof_char +_ACEOF + + +echo "$as_me:$LINENO: checking for short int" >&5 +echo $ECHO_N "checking for short int... $ECHO_C" >&6 +if test "${ac_cv_type_short_int+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +#line $LINENO "siteconf" +#include "localStuff.h" +$ac_includes_default +#ifdef F77_DUMMY_MAIN +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } +#endif +int +main () +{ +if ((short int *) 0) + return 0; +if (sizeof (short int)) + return 0; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_type_short_int=yes +else + echo "$as_me: failed program was:" >&5 +cat conftest.$ac_ext >&5 +ac_cv_type_short_int=no +fi +rm -f conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_type_short_int" >&5 +echo "${ECHO_T}$ac_cv_type_short_int" >&6 + +echo "$as_me:$LINENO: checking size of short int" >&5 +echo $ECHO_N "checking size of short int... $ECHO_C" >&6 +if test "${ac_cv_sizeof_short_int+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test "$ac_cv_type_short_int" = yes; then + # The cast to unsigned long works around a bug in the HP C Compiler + # version HP92453-01 B.11.11.23709.GP, which incorrectly rejects + # declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. + # This bug is HP SR number 8606223364. + if test "$cross_compiling" = yes; then + # Depending upon the size, compute the lo and hi bounds. +cat >conftest.$ac_ext <<_ACEOF +#line $LINENO "siteconf" +#include "localStuff.h" +$ac_includes_default +#ifdef F77_DUMMY_MAIN +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } +#endif +int +main () +{ +static int test_array [1 - 2 * !(((long) (sizeof (short int))) >= 0)]; +test_array [0] = 0 + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_lo=0 ac_mid=0 + while :; do + cat >conftest.$ac_ext <<_ACEOF +#line $LINENO "siteconf" +#include "localStuff.h" +$ac_includes_default +#ifdef F77_DUMMY_MAIN +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } +#endif +int +main () +{ +static int test_array [1 - 2 * !(((long) (sizeof (short int))) <= $ac_mid)]; +test_array [0] = 0 + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_hi=$ac_mid; break +else + echo "$as_me: failed program was:" >&5 +cat conftest.$ac_ext >&5 +ac_lo=`expr $ac_mid + 1` + if test $ac_lo -le $ac_mid; then + ac_lo= ac_hi= + break + fi + ac_mid=`expr 2 '*' $ac_mid + 1` +fi +rm -f conftest.$ac_objext conftest.$ac_ext + done +else + echo "$as_me: failed program was:" >&5 +cat conftest.$ac_ext >&5 +cat >conftest.$ac_ext <<_ACEOF +#line $LINENO "siteconf" +#include "localStuff.h" +$ac_includes_default +#ifdef F77_DUMMY_MAIN +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } +#endif +int +main () +{ +static int test_array [1 - 2 * !(((long) (sizeof (short int))) < 0)]; +test_array [0] = 0 + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_hi=-1 ac_mid=-1 + while :; do + cat >conftest.$ac_ext <<_ACEOF +#line $LINENO "siteconf" +#include "localStuff.h" +$ac_includes_default +#ifdef F77_DUMMY_MAIN +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } +#endif +int +main () +{ +static int test_array [1 - 2 * !(((long) (sizeof (short int))) >= $ac_mid)]; +test_array [0] = 0 + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_lo=$ac_mid; break +else + echo "$as_me: failed program was:" >&5 +cat conftest.$ac_ext >&5 +ac_hi=`expr '(' $ac_mid ')' - 1` + if test $ac_mid -le $ac_hi; then + ac_lo= ac_hi= + break + fi + ac_mid=`expr 2 '*' $ac_mid` +fi +rm -f conftest.$ac_objext conftest.$ac_ext + done +else + echo "$as_me: failed program was:" >&5 +cat conftest.$ac_ext >&5 +ac_lo= ac_hi= +fi +rm -f conftest.$ac_objext conftest.$ac_ext +fi +rm -f conftest.$ac_objext conftest.$ac_ext +# Binary search between lo and hi bounds. +while test "x$ac_lo" != "x$ac_hi"; do + ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` + cat >conftest.$ac_ext <<_ACEOF +#line $LINENO "siteconf" +#include "localStuff.h" +$ac_includes_default +#ifdef F77_DUMMY_MAIN +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } +#endif +int +main () +{ +static int test_array [1 - 2 * !(((long) (sizeof (short int))) <= $ac_mid)]; +test_array [0] = 0 + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_hi=$ac_mid +else + echo "$as_me: failed program was:" >&5 +cat conftest.$ac_ext >&5 +ac_lo=`expr '(' $ac_mid ')' + 1` +fi +rm -f conftest.$ac_objext conftest.$ac_ext +done +case $ac_lo in +?*) ac_cv_sizeof_short_int=$ac_lo;; +'') { { echo "$as_me:$LINENO: error: cannot compute sizeof (short int), 77" >&5 +echo "$as_me: error: cannot compute sizeof (short int), 77" >&2;} + { (exit 1); exit 1; }; } ;; +esac +else + if test "$cross_compiling" = yes; then + { { echo "$as_me:$LINENO: error: cannot run test program while cross compiling" >&5 +echo "$as_me: error: cannot run test program while cross compiling" >&2;} + { (exit 1); exit 1; }; } +else + cat >conftest.$ac_ext <<_ACEOF +#line $LINENO "siteconf" +#include "localStuff.h" +$ac_includes_default +long longval () { return (long) (sizeof (short int)); } +unsigned long ulongval () { return (long) (sizeof (short int)); } +#include +#include +#ifdef F77_DUMMY_MAIN +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } +#endif +int +main () +{ + + FILE *f = fopen ("conftest.val", "w"); + if (! f) + exit (1); + if (((long) (sizeof (short int))) < 0) + { + long i = longval (); + if (i != ((long) (sizeof (short int)))) + exit (1); + fprintf (f, "%ld\n", i); + } + else + { + unsigned long i = ulongval (); + if (i != ((long) (sizeof (short int)))) + exit (1); + fprintf (f, "%lu\n", i); + } + exit (ferror (f) || fclose (f) != 0); + + ; + return 0; +} +_ACEOF +rm -f conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { ac_try='./conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_sizeof_short_int=`cat conftest.val` +else + echo "$as_me: program exited with status $ac_status" >&5 +echo "$as_me: failed program was:" >&5 +cat conftest.$ac_ext >&5 +( exit $ac_status ) +{ { echo "$as_me:$LINENO: error: cannot compute sizeof (short int), 77" >&5 +echo "$as_me: error: cannot compute sizeof (short int), 77" >&2;} + { (exit 1); exit 1; }; } +fi +rm -f core core.* *.core conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext +fi +fi +rm -f conftest.val +else + ac_cv_sizeof_short_int=0 +fi +fi +echo "$as_me:$LINENO: result: $ac_cv_sizeof_short_int" >&5 +echo "${ECHO_T}$ac_cv_sizeof_short_int" >&6 +cat >>localStuff.h <<_ACEOF +#define SIZEOF_SHORT_INT $ac_cv_sizeof_short_int +_ACEOF + + +echo "$as_me:$LINENO: checking for int" >&5 +echo $ECHO_N "checking for int... $ECHO_C" >&6 +if test "${ac_cv_type_int+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +#line $LINENO "siteconf" +#include "localStuff.h" +$ac_includes_default +#ifdef F77_DUMMY_MAIN +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } +#endif +int +main () +{ +if ((int *) 0) + return 0; +if (sizeof (int)) + return 0; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_type_int=yes +else + echo "$as_me: failed program was:" >&5 +cat conftest.$ac_ext >&5 +ac_cv_type_int=no +fi +rm -f conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_type_int" >&5 +echo "${ECHO_T}$ac_cv_type_int" >&6 + +echo "$as_me:$LINENO: checking size of int" >&5 +echo $ECHO_N "checking size of int... $ECHO_C" >&6 +if test "${ac_cv_sizeof_int+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test "$ac_cv_type_int" = yes; then + # The cast to unsigned long works around a bug in the HP C Compiler + # version HP92453-01 B.11.11.23709.GP, which incorrectly rejects + # declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. + # This bug is HP SR number 8606223364. + if test "$cross_compiling" = yes; then + # Depending upon the size, compute the lo and hi bounds. +cat >conftest.$ac_ext <<_ACEOF +#line $LINENO "siteconf" +#include "localStuff.h" +$ac_includes_default +#ifdef F77_DUMMY_MAIN +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } +#endif +int +main () +{ +static int test_array [1 - 2 * !(((long) (sizeof (int))) >= 0)]; +test_array [0] = 0 + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_lo=0 ac_mid=0 + while :; do + cat >conftest.$ac_ext <<_ACEOF +#line $LINENO "siteconf" +#include "localStuff.h" +$ac_includes_default +#ifdef F77_DUMMY_MAIN +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } +#endif +int +main () +{ +static int test_array [1 - 2 * !(((long) (sizeof (int))) <= $ac_mid)]; +test_array [0] = 0 + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_hi=$ac_mid; break +else + echo "$as_me: failed program was:" >&5 +cat conftest.$ac_ext >&5 +ac_lo=`expr $ac_mid + 1` + if test $ac_lo -le $ac_mid; then + ac_lo= ac_hi= + break + fi + ac_mid=`expr 2 '*' $ac_mid + 1` +fi +rm -f conftest.$ac_objext conftest.$ac_ext + done +else + echo "$as_me: failed program was:" >&5 +cat conftest.$ac_ext >&5 +cat >conftest.$ac_ext <<_ACEOF +#line $LINENO "siteconf" +#include "localStuff.h" +$ac_includes_default +#ifdef F77_DUMMY_MAIN +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } +#endif +int +main () +{ +static int test_array [1 - 2 * !(((long) (sizeof (int))) < 0)]; +test_array [0] = 0 + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_hi=-1 ac_mid=-1 + while :; do + cat >conftest.$ac_ext <<_ACEOF +#line $LINENO "siteconf" +#include "localStuff.h" +$ac_includes_default +#ifdef F77_DUMMY_MAIN +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } +#endif +int +main () +{ +static int test_array [1 - 2 * !(((long) (sizeof (int))) >= $ac_mid)]; +test_array [0] = 0 + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_lo=$ac_mid; break +else + echo "$as_me: failed program was:" >&5 +cat conftest.$ac_ext >&5 +ac_hi=`expr '(' $ac_mid ')' - 1` + if test $ac_mid -le $ac_hi; then + ac_lo= ac_hi= + break + fi + ac_mid=`expr 2 '*' $ac_mid` +fi +rm -f conftest.$ac_objext conftest.$ac_ext + done +else + echo "$as_me: failed program was:" >&5 +cat conftest.$ac_ext >&5 +ac_lo= ac_hi= +fi +rm -f conftest.$ac_objext conftest.$ac_ext +fi +rm -f conftest.$ac_objext conftest.$ac_ext +# Binary search between lo and hi bounds. +while test "x$ac_lo" != "x$ac_hi"; do + ac_mid=`expr '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo` + cat >conftest.$ac_ext <<_ACEOF +#line $LINENO "siteconf" +#include "localStuff.h" +$ac_includes_default +#ifdef F77_DUMMY_MAIN +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } +#endif +int +main () +{ +static int test_array [1 - 2 * !(((long) (sizeof (int))) <= $ac_mid)]; +test_array [0] = 0 + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_hi=$ac_mid +else + echo "$as_me: failed program was:" >&5 +cat conftest.$ac_ext >&5 +ac_lo=`expr '(' $ac_mid ')' + 1` +fi +rm -f conftest.$ac_objext conftest.$ac_ext +done +case $ac_lo in +?*) ac_cv_sizeof_int=$ac_lo;; +'') { { echo "$as_me:$LINENO: error: cannot compute sizeof (int), 77" >&5 +echo "$as_me: error: cannot compute sizeof (int), 77" >&2;} + { (exit 1); exit 1; }; } ;; +esac +else + if test "$cross_compiling" = yes; then + { { echo "$as_me:$LINENO: error: cannot run test program while cross compiling" >&5 +echo "$as_me: error: cannot run test program while cross compiling" >&2;} + { (exit 1); exit 1; }; } +else + cat >conftest.$ac_ext <<_ACEOF +#line $LINENO "siteconf" +#include "localStuff.h" +$ac_includes_default +long longval () { return (long) (sizeof (int)); } +unsigned long ulongval () { return (long) (sizeof (int)); } +#include +#include +#ifdef F77_DUMMY_MAIN +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } +#endif +int +main () +{ + + FILE *f = fopen ("conftest.val", "w"); + if (! f) + exit (1); + if (((long) (sizeof (int))) < 0) + { + long i = longval (); + if (i != ((long) (sizeof (int)))) + exit (1); + fprintf (f, "%ld\n", i); + } + else + { + unsigned long i = ulongval (); + if (i != ((long) (sizeof (int)))) + exit (1); + fprintf (f, "%lu\n", i); + } + exit (ferror (f) || fclose (f) != 0); + + ; + return 0; +} +_ACEOF +rm -f conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { ac_try='./conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_sizeof_int=`cat conftest.val` +else + echo "$as_me: program exited with status $ac_status" >&5 +echo "$as_me: failed program was:" >&5 +cat conftest.$ac_ext >&5 +( exit $ac_status ) +{ { echo "$as_me:$LINENO: error: cannot compute sizeof (int), 77" >&5 +echo "$as_me: error: cannot compute sizeof (int), 77" >&2;} + { (exit 1); exit 1; }; } +fi +rm -f core core.* *.core conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext +fi +fi +rm -f conftest.val +else + ac_cv_sizeof_int=0 +fi +fi +echo "$as_me:$LINENO: result: $ac_cv_sizeof_int" >&5 +echo "${ECHO_T}$ac_cv_sizeof_int" >&6 +cat >>localStuff.h <<_ACEOF +#define SIZEOF_INT $ac_cv_sizeof_int +_ACEOF + + + +echo "$as_me:$LINENO: checking for u_intXX_t types" >&5 +echo $ECHO_N "checking for u_intXX_t types... $ECHO_C" >&6 +if test "${ac_cv_have_u_intxx_t+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + + cat >conftest.$ac_ext <<_ACEOF +#line $LINENO "siteconf" +#include "localStuff.h" + #include +#ifdef F77_DUMMY_MAIN +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } +#endif +int +main () +{ + u_int8_t a; u_int16_t b; u_int32_t c; a = b = c = 1; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_have_u_intxx_t="yes" +else + echo "$as_me: failed program was:" >&5 +cat conftest.$ac_ext >&5 + ac_cv_have_u_intxx_t="no" + +fi +rm -f conftest.$ac_objext conftest.$ac_ext + +fi +echo "$as_me:$LINENO: result: $ac_cv_have_u_intxx_t" >&5 +echo "${ECHO_T}$ac_cv_have_u_intxx_t" >&6 +if test "x$ac_cv_have_u_intxx_t" = "xyes" ; then + cat >>localStuff.h <<\_ACEOF +#define HAVE_U_INTXX_T 1 +_ACEOF + + have_u_intxx_t=1 +fi + +if test -z "$have_u_intxx_t" ; then + echo "$as_me:$LINENO: checking for u_intXX_t types in sys/socket.h" >&5 +echo $ECHO_N "checking for u_intXX_t types in sys/socket.h... $ECHO_C" >&6 + cat >conftest.$ac_ext <<_ACEOF +#line $LINENO "siteconf" +#include "localStuff.h" + #include +#ifdef F77_DUMMY_MAIN +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } +#endif +int +main () +{ + u_int8_t a; u_int16_t b; u_int32_t c; a = b = c = 1; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + + cat >>localStuff.h <<\_ACEOF +#define HAVE_U_INTXX_T 2 +_ACEOF + + echo "$as_me:$LINENO: result: yes" >&5 +echo "${ECHO_T}yes" >&6 + +else + echo "$as_me: failed program was:" >&5 +cat conftest.$ac_ext >&5 + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 + +fi +rm -f conftest.$ac_objext conftest.$ac_ext +fi + +if test -z "$have_u_intxx_t" ; then + echo "$as_me:$LINENO: checking for uintXX_t types" >&5 +echo $ECHO_N "checking for uintXX_t types... $ECHO_C" >&6 +if test "${ac_cv_have_uintxx_t+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + + cat >conftest.$ac_ext <<_ACEOF +#line $LINENO "siteconf" +#include "localStuff.h" + +#include + +#ifdef F77_DUMMY_MAIN +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } +#endif +int +main () +{ + uint8_t a; uint16_t b; uint32_t c; a = b = c = 1; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_have_uintxx_t="yes" +else + echo "$as_me: failed program was:" >&5 +cat conftest.$ac_ext >&5 + ac_cv_have_uintxx_t="no" + +fi +rm -f conftest.$ac_objext conftest.$ac_ext + +fi +echo "$as_me:$LINENO: result: $ac_cv_have_uintxx_t" >&5 +echo "${ECHO_T}$ac_cv_have_uintxx_t" >&6 + if test "x$ac_cv_have_uintxx_t" = "xyes" ; then + cat >>localStuff.h <<\_ACEOF +#define HAVE_UINTXX_T 1 +_ACEOF + + fi +fi + +if test -z "$have_uintxx_t" ; then + echo "$as_me:$LINENO: checking for uintXX_t types in stdint.h" >&5 +echo $ECHO_N "checking for uintXX_t types in stdint.h... $ECHO_C" >&6 + cat >conftest.$ac_ext <<_ACEOF +#line $LINENO "siteconf" +#include "localStuff.h" + #include +#ifdef F77_DUMMY_MAIN +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } +#endif +int +main () +{ + uint8_t a; uint16_t b; uint32_t c; a = b = c = 1; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + + cat >>localStuff.h <<\_ACEOF +#define HAVE_UINTXX_T 2 +_ACEOF + + echo "$as_me:$LINENO: result: yes" >&5 +echo "${ECHO_T}yes" >&6 + +else + echo "$as_me: failed program was:" >&5 +cat conftest.$ac_ext >&5 + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 + +fi +rm -f conftest.$ac_objext conftest.$ac_ext +fi + +# checking for inet_aton +if test -z "$have_uintxx_t" ; then + echo "$as_me:$LINENO: checking for inet_aton" >&5 +echo $ECHO_N "checking for inet_aton $ECHO_C" >&6 + cat >conftest.$ac_ext <<_ACEOF +#line $LINENO "siteconf" +#include +#include +#include +#include +#ifdef F77_DUMMY_MAIN +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } +#endif +int +main () +{ + struct in_addr in; + char * c = "127.0.0.1"; + + c = (char *)"127.0.0.1"; + inet_aton(c,&in); + ; + return 0; +} +_ACEOF + +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { ac_try='./conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + cat >>localStuff.h <<\_ACEOF +#define LOCAL_HAVE_inet_aton +_ACEOF + + echo "$as_me:$LINENO: result: yes" >&5 +echo "${ECHO_T}yes" >&6 + +else + echo "$as_me: failed program was:" >&5 +cat conftest.$ac_ext >&5 + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 + +fi +rm -f conftest.$ac_objext conftest$ac_exeext conftest.$ac_ext +fi + +# checking for inet_pton +if test -z "$have_uintxx_t" ; then + echo "$as_me:$LINENO: checking for inet_pton" >&5 +echo $ECHO_N "checking for inet_pton $ECHO_C" >&6 + cat >conftest.$ac_ext <<_ACEOF +#line $LINENO "siteconf" +#include +#include +#include +#include +#ifdef F77_DUMMY_MAIN +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } +#endif +int +main () +{ + char * c; + struct in_addr in; + + c = (char *)"127.0.0.1"; + inet_pton(AF_INET,c,&in); + ; + return 0; +} +_ACEOF + +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { ac_try='./conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + cat >>localStuff.h <<\_ACEOF +#define LOCAL_HAVE_inet_pton +_ACEOF + + echo "$as_me:$LINENO: result: yes" >&5 +echo "${ECHO_T}yes" >&6 + +else + echo "$as_me: failed program was:" >&5 +cat conftest.$ac_ext >&5 + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 + +fi +rm -f conftest.$ac_objext conftest$ac_exeext conftest.$ac_ext +fi + +# checking for ENDIANness + +if test -z "$have_uintxx_t" ; then + echo "$as_me:$LINENO: checking ENDIANness" >&5 +echo $ECHO_N "checking for ENDIANness $ECHO_C" >&6 + cat >conftest.$ac_ext <<_ACEOF +#line $LINENO "siteconf" +#ifdef F77_DUMMY_MAIN +# ifdef __cplusplus + extern "C" +# endif + int F77_DUMMY_MAIN() { return 1; } +#endif +#include +#include "localStuff.h" + +typedef union +{ + int16_t i; + char c[2]; +} endian; + +int +main() +{ + + endian e; + + e.i = 1; + return - (int)e.c[0]; +} +_ACEOF + +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { ac_try='./conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + };} && [ $ac_status -ne 1 ]; then + if [ $ac_status -eq 0 ]; then + cat >>localStuff.h <<\_ACEOF +#define host_is_BIG_ENDIAN +_ACEOF + echo "$as_me:$LINENO: result: BIG_ENDIAN" >&5 + echo "${ECHO_T}... BIG_ENDIAN" >&6 + else + cat >>localStuff.h <<\_ACEOF +#define host_is_LITTLE_ENDIAN +_ACEOF + echo "$as_me:$LINENO: result: LITTLE_ENDIAN" >&5 + echo "${ECHO_T}... LITTLE_ENDIAN" >&6 + fi +else +echo "$as_me:$LINENO: \$? = $ac_status" >&5 + echo "$as_me: failed program was:" >&5 + cat conftest.$ac_ext >&5 + { echo "$as_me:$LINENO: error: can't figure out ENDIANness" >&5 + echo "${ECHO_T}error: can't figure out ENDIANness" >&6 + { (exit 1); exit 1; }; }; +fi +rm -f conftest.$ac_objext conftest$ac_exeext conftest.$ac_ext +fi + diff --git a/Lite/Util/t/4to6.t b/Lite/Util/t/4to6.t new file mode 100644 index 0000000..307be86 --- /dev/null +++ b/Lite/Util/t/4to6.t @@ -0,0 +1,69 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### We start with some black magic to print on failure. +# Change 1..1 below to 1..last_test_to_print . +# (It may become useful if the test is moved to ./t subdirectory.) + +BEGIN { $| = 1; print "1..5\n"; } +END {print "not ok 1\n" unless $loaded;} + +use NetAddr::IP::Util qw( + inet_aton + ipv6_n2d + ipv6_aton + ipv4to6 + mask4to6 +); + +$loaded = 1; +print "ok 1\n"; +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + +$test = 2; + +sub ok { + print "ok $test\n"; + ++$test; +} + +my $nip = inet_aton('1.2.3.4'); +my $exp = '0:0:0:0:0:0:1.2.3.4'; + +## test 2 check 4->6 conversion +my $nipv6 = ipv4to6($nip); +my $ipv6 = ipv6_n2d($nipv6); +print "got: $ipv6\nexp: $exp\nnot " + unless $ipv6 eq $exp; +&ok; + + +## test 3 check mask4->6 extension +$exp = 'FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:1.2.3.4'; +$nipv6 = mask4to6($nip); +$ipv6 = ipv6_n2d($nipv6); +print "got: $ipv6\nexp: $exp\nnot " + unless $ipv6 eq $exp; +&ok; + +## test 4 check bad length +$nip = pack("H9",0x00,0x01,0x02,0x03,0x04,0x05,0x06,0x07,0x08,0x09); +eval { + ipv4to6($nip); +}; +print "ipv4to6 accepted bad argument length\nnot " + unless $@ && $@ =~ /Bad arg.+ipv4to6/; +&ok; + +## test 5 check bad length +eval { + mask4to6($nip); +}; +print "mask4to6 accepted bad argument length\nnot " + unless $@ && $@ =~ /Bad arg.+mask4to6/; +&ok; + diff --git a/Lite/Util/t/add128.t b/Lite/Util/t/add128.t new file mode 100644 index 0000000..1e8e7c0 --- /dev/null +++ b/Lite/Util/t/add128.t @@ -0,0 +1,92 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### We start with some black magic to print on failure. +# Change 1..1 below to 1..last_test_to_print . +# (It may become useful if the test is moved to ./t subdirectory.) + +BEGIN { $| = 1; print "1..57\n"; } +END {print "not ok 1\n" unless $loaded;} + +use NetAddr::IP::Util qw( + add128 + sub128 + ipv6_aton + ipv6_n2x + comp128 +); + +$loaded = 1; +print "ok 1\n"; +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + +$test = 2; + +sub ok { + print "ok $test\n"; + ++$test; +} + +my @num = # number plus carry exp +qw( + FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFE ::1 0 FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF + ::1 FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFE 0 FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF + ::2 FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFE 1 0:0:0:0:0:0:0:0 + FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFE ::2 1 0:0:0:0:0:0:0:0 + FFFF:FFFF:FFFF:FFFF:FFFF:8FFF:FFFF:FFFE ::7000:0:2 1 0:0:0:0:0:0:0:0 + FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFE ::3 1 0:0:0:0:0:0:0:1 + ::1 ::2 0 0:0:0:0:0:0:0:3 + ::FFFF ::FFFF 0 0:0:0:0:0:0:1:FFFE + ::FFFF:FFFF ::FFFF:FFFF 0 0:0:0:0:0:1:FFFF:FFFE + ::FFFF:FFFF:FFFF ::FFFF:FFFF:FFFF 0 0:0:0:0:1:FFFF:FFFF:FFFE + ::FFFF:FFFF:FFFF:FFFF ::FFFF:FFFF:FFFF:FFFF 0 0:0:0:1:FFFF:FFFF:FFFF:FFFE + ::FFFF:FFFF:FFFF:FFFF:FFFF ::FFFF:FFFF:FFFF:FFFF:FFFF 0 0:0:1:FFFF:FFFF:FFFF:FFFF:FFFE + ::FFFF:FFFF:FFFF:FFFF:FFFF:FFFF ::FFFF:FFFF:FFFF:FFFF:FFFF:FFFF 0 0:1:FFFF:FFFF:FFFF:FFFF:FFFF:FFFE + ::FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF ::FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF 0 1:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFE +); + +## test 2 - 15 check carry +for (my $i=0; $i<@num; $i+=4) { + my $num = ipv6_aton($num[$i]); + my $plus = ipv6_aton($num[$i +1]); + my $rv = add128($num,$plus); + print "got: $rv, exp: $num[$i +2]\nnot " + unless $rv == $num[$i +2]; + &ok; +} +## test 16 - 43 check carry + result +for (my $i=0; $i<@num; $i+=4) { + my $num = ipv6_aton($num[$i]); + my $plus = ipv6_aton($num[$i +1]); + my($rv,$result) = add128($num,$plus); + print "got: $rv, exp: $num[$i +2]\nnot " + unless $rv == $num[$i +2]; + &ok; + $result = ipv6_n2x($result); + print "got: $result\nexp: $num[$i +3]\nnot " + unless $result eq $num[$i +3]; + &ok; +} + +## test 44 - 57 the subtraction of the comp of the 'plus' category +## should invert the carry and add 1 to 'exp' +## start test at first 'number' that starts with '::FFFF' +for (my $i=0; $i<@num; $i+=4) { + next unless $num[$i] =~ /^::FFFF/; + my $num = ipv6_aton($num[$i]); + my $plus = ipv6_aton($num[$i +1]); + my $minus = comp128($plus); + my($rv,$result) = sub128($num,$minus); + print "got: $rv, exp: $num[$i +2]\nnot " + unless $rv == $num[$i +2]; + &ok; + $num[$i +3] =~ s/FFFE$/FFFF/; + $result = ipv6_n2x($result); + print "got: $result\nexp: $num[$i +3]\nnot " + unless $result eq $num[$i +3]; + &ok; +} diff --git a/Lite/Util/t/addconst.t b/Lite/Util/t/addconst.t new file mode 100644 index 0000000..dd28349 --- /dev/null +++ b/Lite/Util/t/addconst.t @@ -0,0 +1,77 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### We start with some black magic to print on failure. +# Change 1..1 below to 1..last_test_to_print . +# (It may become useful if the test is moved to ./t subdirectory.) + +BEGIN { $| = 1; print "1..20\n"; } +END {print "not ok 1\n" unless $loaded;} + +use NetAddr::IP::Util qw( + ipv6_aton + ipv6_n2x + inet_any2n + addconst +); + +$loaded = 1; +print "ok 1\n"; +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + +$test = 2; + +sub ok { + print "ok $test\n"; + ++$test; +} + +my @num = qw # input expected +( + :: 0:0:0:0:0:0:0:0 + :: 0:0:0:0:0:0:0:2 + ::FFFF 0:0:0:0:0:0:1:3 + ::FFFF:FFFF 0:0:0:0:0:1:0:5 + ::FFFF:FFFF:FFFF 0:0:0:0:1:0:0:7 + ::FFFF:FFFF:FFFF:ffff 0:0:0:1:0:0:0:9 + ::FFFF:FFFF:FFFF:ffff:ffff 0:0:1:0:0:0:0:B + ::FFFF:FFFF:FFFF:ffff:ffff:ffff 0:1:0:0:0:0:0:D + 0:FFFF:FFFF:FFFF:ffff:ffff:ffff:ffff 1:0:0:0:0:0:0:F + FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF 0:0:0:0:0:0:0:11 +); + +for (my $i=0; $i <@num; $i+=2) { + my $bnum = ipv6_aton($num[$i]); + my($carry,$rv) = addconst($bnum,$i); + $rv = ipv6_n2x($rv); + print "got: $rv\nexp: $num[$i +1]\nnot " + unless $rv eq $num[$i +1]; + &ok; +} + +@num = qw # input expected +( + FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF + :: FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFE + FFFF:: FFFE:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFC + FFFF:FFFF:: FFFF:FFFE:FFFF:FFFF:FFFF:FFFF:FFFF:FFFA + FFFF:FFFF:FFFF:: FFFF:FFFF:FFFE:FFFF:FFFF:FFFF:FFFF:FFF8 + ffff:ffff:ffff:ffff:: FFFF:FFFF:FFFF:FFFE:FFFF:FFFF:FFFF:FFF6 + ffff:ffff:ffff:ffff:ffff:: FFFF:FFFF:FFFF:FFFF:FFFE:FFFF:FFFF:FFF4 + ffff:ffff:ffff:ffff:ffff:ffff:: FFFF:FFFF:FFFF:FFFF:FFFF:FFFE:FFFF:FFF2 + FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:0 FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFE:FFF0 +); + +for (my $i=0; $i <@num; $i+=2) { + my $bnum = ipv6_aton($num[$i]); + my($carry,$rv) = addconst($bnum,-$i); + $rv = ipv6_n2x($rv); + print "got: $rv\nexp: $num[$i +1]\nnot " + unless $rv eq $num[$i +1]; + &ok; +} + diff --git a/Lite/Util/t/anyto6.t b/Lite/Util/t/anyto6.t new file mode 100644 index 0000000..a4149ea --- /dev/null +++ b/Lite/Util/t/anyto6.t @@ -0,0 +1,86 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### We start with some black magic to print on failure. +# Change 1..1 below to 1..last_test_to_print . +# (It may become useful if the test is moved to ./t subdirectory.) + +BEGIN { $| = 1; print "1..7\n"; } +END {print "not ok 1\n" unless $loaded;} + +use NetAddr::IP::Util qw( + inet_aton + ipv6_n2d + ipv6_aton + ipanyto6 + maskanyto6 +); + +$loaded = 1; +print "ok 1\n"; +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + +$test = 2; + +sub ok { + print "ok $test\n"; + ++$test; +} + +my $nip = inet_aton('1.2.3.4'); +my $exp = '0:0:0:0:0:0:1.2.3.4'; + +## test 2 check 4->6 conversion +my $nipv6 = ipanyto6($nip); +my $ipv6 = ipv6_n2d($nipv6); +print "got: $ipv6\nexp: $exp\nnot " + unless $ipv6 eq $exp; +&ok; + + +## test 3 check mask4->6 extension +$exp = 'FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:1.2.3.4'; +$nipv6 = maskanyto6($nip); +$ipv6 = ipv6_n2d($nipv6); +print "got: $ipv6\nexp: $exp\nnot " + unless $ipv6 eq $exp && +&ok; + +## test 4 check bad length +$nip = pack("H9",0x00,0x01,0x02,0x03,0x04,0x05,0x06,0x07,0x08,0x09); +eval { + ipanyto6($nip); +}; +print "ipanyto6 accepted bad argument length\nnot " + unless $@ && $@ =~ /Bad arg.+ipanyto6/; +&ok; + +## test 5 check bad length +eval { + maskanyto6($nip); +}; +print "maskanyto6 accepted bad argument length\nnot " + unless $@ && $@ =~ /Bad arg.+maskanyto6/; +&ok; + +## test 6 check pass of ipv6 addrs +$nip = ipv6_aton('::1:2.3.4.5'); +$exp = '0:0:0:0:0:1:2.3.4.5'; +$nipv6 = ipanyto6($nip); +$ipv6 = ipv6_n2d($nipv6); +print "got: $ipv6\nexp: $exp\nnot " + unless $ipv6 eq $exp; +&ok; + +## test 7 check pass of ipv6 addrs +$nip = ipv6_aton('FFF::1:2.3.4.5'); +$exp = 'FFF:0:0:0:0:1:2.3.4.5'; +$nipv6 = maskanyto6($nip); +$ipv6 = ipv6_n2d($nipv6); +print "got: $ipv6\nexp: $exp\nnot " + unless $ipv6 eq $exp; +&ok; diff --git a/Lite/Util/t/badd.t b/Lite/Util/t/badd.t new file mode 100644 index 0000000..9f2f291 --- /dev/null +++ b/Lite/Util/t/badd.t @@ -0,0 +1,69 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### We start with some black magic to print on failure. +# Change 1..1 below to 1..last_test_to_print . +# (It may become useful if the test is moved to ./t subdirectory.) +$| = 1; +END {print "1..1\nnot ok 1\n" unless $test;} + +use NetAddr::IP::Util qw( + ipv6_aton + ipv6_n2x +); + +$test = 1; + +sub ok { + print "ok $test\n"; + ++$test; +} + +my @addr = +qw( :: 0:0:0:0:0:0:0:0 + ::: undef + foo undef + ::foo undef + foo:: undef + abc::def::9 undef + abcd1:: undef + abcd:: abcd:0:0:0:0:0:0:0 + ::abcde undef + :a:b:c:d:1:2:3:4 undef + :a:b:c:d undef + a:b:c:d:1:2:3:4: undef + a:b:c:d:1:2:3:4:: undef + ::a:b:c:d:1:2:3:4 undef + ::a:b:c:d:1:2:3 0:a:b:c:d:1:2:3 + ::a:b:c:d:1:2:3: undef + :a:b:c:d:1:2:3:: undef + a:b:c:d:1:2:3:: a:b:c:d:1:2:3:0 +); + +my $x = @addr/2; + +# notify TEST about number of tests +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + +print '1..',$x,"\n"; + +for ($x = 0;$x <= $#addr; $x+=2) { + my $bstr = ipv6_aton($addr[$x]); + if ($addr[$x +1] =~ /undef/) { + print "unexpected return value for $addr[$x]: $_\nnot " + if ($_ = ipv6_aton && (ipv6_n2x($_) || 'not defined')); + } else { + my $rv = ipv6_aton($addr[$x]); + unless ($rv) { + print "got undefined value for $addr[$x]\nnot "; + } + else { + $rv = ipv6_n2x($rv) || 'not defined'; + print "got: $rv, exp: $addr[$x +1]\nnot " + unless $rv eq uc $addr[$x +1]; + } + } + &ok; +} diff --git a/Lite/Util/t/bcd2bin.t b/Lite/Util/t/bcd2bin.t new file mode 100644 index 0000000..f089736 --- /dev/null +++ b/Lite/Util/t/bcd2bin.t @@ -0,0 +1,68 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### We start with some black magic to print on failure. +# Change 1..1 below to 1..last_test_to_print . +# (It may become useful if the test is moved to ./t subdirectory.) + +BEGIN { $| = 1; print "1..25\n"; } +END {print "not ok 1\n" unless $loaded;} + +use NetAddr::IP::Util qw( + bcd2bin + ipv6_n2x +); + +$loaded = 1; +print "ok 1\n"; +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + +$test = 2; + +sub ok { + print "ok $test\n"; + ++$test; +} + +my @num = # input expected +qw( + 0 0:0:0:0:0:0:0:0 + 2147483648 0:0:0:0:0:0:8000:0 + 4294967296 0:0:0:0:0:1:0:0 + 8589934592 0:0:0:0:0:2:0:0 + 10000000000 0:0:0:0:0:2:540B:E400 + 17179869184 0:0:0:0:0:4:0:0 + 34359738368 0:0:0:0:0:8:0:0 + 68719476736 0:0:0:0:0:10:0:0 + 137438953472 0:0:0:0:0:20:0:0 + 274877906944 0:0:0:0:0:40:0:0 + 549755813888 0:0:0:0:0:80:0:0 + 1099511627776 0:0:0:0:0:100:0:0 + 2199023255552 0:0:0:0:0:200:0:0 + 4398046511104 0:0:0:0:0:400:0:0 + 8796093022208 0:0:0:0:0:800:0:0 + 17592186044416 0:0:0:0:0:1000:0:0 + 35184372088832 0:0:0:0:0:2000:0:0 + 70368744177664 0:0:0:0:0:4000:0:0 + 140737488355328 0:0:0:0:0:8000:0:0 + 9223372036854775808 0:0:0:0:8000:0:0:0 + 604462909807314587353088 0:0:0:8000:0:0:0:0 + 39614081257132168796771975168 0:0:8000:0:0:0:0:0 + 2596148429267413814265248164610048 0:8000:0:0:0:0:0:0 + 170141183460469231731687303715884105728 8000:0:0:0:0:0:0:0 +); + +## tests 2 - 9 check pack correct + +for (my $i=0;$i<@num;$i+=2) { +print $num[$i],"\n"; + my $bits = bcd2bin($num[$i]); + my $ip = ipv6_n2x($bits); + print "got: $ip\nexp: $num[$i +1]\nnot " + unless $ip eq $num[$i +1]; + &ok; +} diff --git a/Lite/Util/t/bcdn2bin.t b/Lite/Util/t/bcdn2bin.t new file mode 100644 index 0000000..baf1723 --- /dev/null +++ b/Lite/Util/t/bcdn2bin.t @@ -0,0 +1,73 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### We start with some black magic to print on failure. +# Change 1..1 below to 1..last_test_to_print . +# (It may become useful if the test is moved to ./t subdirectory.) + +BEGIN { $| = 1; print "1..25\n"; } +END {print "not ok 1\n" unless $loaded;} + +use NetAddr::IP::Util qw( + ipv6_n2x + bcdn2bin +); + +$loaded = 1; +print "ok 1\n"; +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + +$test = 2; + +sub ok { + print "ok $test\n"; + ++$test; +} + +my @num = # input expected +qw( + 0 0:0:0:0:0:0:0:0 + 2147483648 0:0:0:0:0:0:8000:0 + 4294967296 0:0:0:0:0:1:0:0 + 8589934592 0:0:0:0:0:2:0:0 + 10000000000 0:0:0:0:0:2:540B:E400 + 17179869184 0:0:0:0:0:4:0:0 + 34359738368 0:0:0:0:0:8:0:0 + 68719476736 0:0:0:0:0:10:0:0 + 137438953472 0:0:0:0:0:20:0:0 + 274877906944 0:0:0:0:0:40:0:0 + 549755813888 0:0:0:0:0:80:0:0 + 1099511627776 0:0:0:0:0:100:0:0 + 2199023255552 0:0:0:0:0:200:0:0 + 4398046511104 0:0:0:0:0:400:0:0 + 8796093022208 0:0:0:0:0:800:0:0 + 17592186044416 0:0:0:0:0:1000:0:0 + 35184372088832 0:0:0:0:0:2000:0:0 + 70368744177664 0:0:0:0:0:4000:0:0 + 140737488355328 0:0:0:0:0:8000:0:0 + 9223372036854775808 0:0:0:0:8000:0:0:0 + 604462909807314587353088 0:0:0:8000:0:0:0:0 + 39614081257132168796771975168 0:0:8000:0:0:0:0:0 + 2596148429267413814265248164610048 0:8000:0:0:0:0:0:0 + 170141183460469231731687303715884105728 8000:0:0:0:0:0:0:0 +); + +## tests 2 - 9 check pack correct + +#use Devel::Peek 'Dump'; + +for (my $i=0;$i<@num;$i+=2) { +print $num[$i],"\n"; + my $pkd = pack("H*",$num[$i]); + my $len = length($num[$i]); +#Dump($pkd); + my $bits = bcdn2bin($pkd,$len); + my $ip = ipv6_n2x($bits); + print "got: $ip\nexp: $num[$i +1]\nnot " + unless $ip eq $num[$i +1]; + &ok; +} diff --git a/Lite/Util/t/bin.t b/Lite/Util/t/bin.t new file mode 100644 index 0000000..b0cccb7 --- /dev/null +++ b/Lite/Util/t/bin.t @@ -0,0 +1,111 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### We start with some black magic to print on failure. +# Change 1..1 below to 1..last_test_to_print . +# (It may become useful if the test is moved to ./t subdirectory.) + +BEGIN { $| = 1; print "1..25\n"; } +END {print "not ok 1\n" unless $loaded;} + +use NetAddr::IP::Util qw( + ipv6_aton + bin2bcd + bin2bcdn + bcdn2txt +); + +$loaded = 1; +print "ok 1\n"; +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + +$test = 2; + +sub ok { + print "ok $test\n"; + ++$test; +} + +# input: array ref, value ref, number ref +# +sub val { + my $bcd = shift; + my $rv = unpack("H*",$bcd); + $rv =~ s/^0+(\d)/$1/g; + return $rv; +} + +sub numnum { + my($ar,$i) = @_; + return sprintf("%.0f",$ar->[$i +1]); +} + +sub numstr { + my($ar,$i) = @_; + return $ar->[$i+1]; +} + +sub dotest { + my($ar,$vr,$nr) = @_; + for(my $i=0;$i<@$ar;$i+=2) { + my $bstr = ipv6_aton($ar->[$i]); + my $bcd = bin2bcdn($bstr); + my $val = $vr->($bcd); + my $exp = $nr->($ar,$i); + print "\t\t$val\n"; + print "got: $val\nexp: $exp\nnot " + unless $val eq $exp; + &ok; + } +} + +# setup only, can't depend on float to do it right on all systems +#my @num1 = # input expected +#( +# '::' => 0, +# '::8000:0' => 2**(15+16), +# '::8000:0:0' => 2**(15+(16*2)), +# '::8000:0:0:0' => 2**(15+(16*3)), +# '::8000:0:0:0:0' => 2**(15+(16*4)), +# '::8000:0:0:0:0:0' => 2**(15+(16*5)), +# '::8000:0:0:0:0:0:0' => 2**(15+(16*6)), +# '8000:0:0:0:0:0:0:0' => 2**(15+(16*7)), +#); + +my @num2 = qw( + :: 0 + ::8000:0 2147483648 + ::8000:0:0 140737488355328 + ::8000:0:0:0 9223372036854775808 + ::8000:0:0:0:0 604462909807314587353088 + ::8000:0:0:0:0:0 39614081257132168796771975168 + ::8000:0:0:0:0:0:0 2596148429267413814265248164610048 + 8000:0:0:0:0:0:0:0 170141183460469231731687303715884105728 +); + +## tests 2 - 9 bin2bcdn numeric unpack +#dotest(\@num1,\&val,\&numnum); + +## tests 10 - 17 bin2bcdn string unpack TEST 2 - 9 +dotest(\@num2,\&val,\&numstr); + +## tests 18 - 25 bin2bcdn numeric bcdn2txt +#dotest(\@num1,\&bcdn2txt,\&numnum); + +## tests 26 - 33 bin2bcdn string bcdn2txt TEST 10 - 17 +dotest(\@num2,\&bcdn2txt,\&numstr); + +## tests 34 - 41 bin2bcd TEST 18 - 25 +for(my $i=0;$i<@num2;$i+=2) { + my $bstr = ipv6_aton($num2[$i]); + my $bcd = bin2bcd($bstr); + my $exp = $num2[$i +1]; + print "\t\t$bcd\n"; + print "got: $bcd\nexp: $exp\nnot " + unless $bcd eq $exp; + &ok; +} diff --git a/Lite/Util/t/comp128.t b/Lite/Util/t/comp128.t new file mode 100644 index 0000000..808af2b --- /dev/null +++ b/Lite/Util/t/comp128.t @@ -0,0 +1,48 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### We start with some black magic to print on failure. +# Change 1..1 below to 1..last_test_to_print . +# (It may become useful if the test is moved to ./t subdirectory.) + +BEGIN { $| = 1; print "1..4\n"; } +END {print "not ok 1\n" unless $loaded;} + +use NetAddr::IP::Util qw( + ipv6_aton + ipv6_n2x + comp128 +); + +$loaded = 1; +print "ok 1\n"; +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + +$test = 2; + +sub ok { + print "ok $test\n"; + ++$test; +} + +my @num = qw # input expected +( :: FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF + FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF 0:0:0:0:0:0:0:0 + A1B2:C3D4:E5D6:F7E8:08F9:190A:2A1B:3B4C 5E4D:3C2B:1A29:817:F706:E6F5:D5E4:C4B3 +); + +my $ff = ipv6_aton($num[1]); +for(my $i=0;$i<@num;$i+=2) { + my $num = $num[$i]; + my $bstr = ipv6_aton($num); + my $cnum = comp128($bstr); + my $rv = ipv6_n2x($cnum); + my $exp = $num[$i +1]; + print "got: $rv\nexp: $exp\nnot " + unless $rv eq $exp; + &ok; +} diff --git a/Lite/Util/t/croak.t b/Lite/Util/t/croak.t new file mode 100644 index 0000000..b939458 --- /dev/null +++ b/Lite/Util/t/croak.t @@ -0,0 +1,168 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### We start with some black magic to print on failure. +# Change 1..1 below to 1..last_test_to_print . +# (It may become useful if the test is moved to ./t subdirectory.) + +BEGIN { $| = 1; print "1..31\n"; } +END {print "not ok 1\n" unless $loaded;} + +use NetAddr::IP::Util qw( + bcd2bin + bin2bcd + hasbits + isIPv4 + add128 + sub128 + shiftleft + comp128 + bcdn2txt + bin2bcdn + bcdn2bin + simple_pack +); + +$loaded = 1; +print "ok 1\n"; +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + +$test = 2; + +sub ok { + print "ok $test\n"; + ++$test; +} + +## tests 2 - 9 simple_pack + +foreach( + '1234/', + '1234:', + 'a1234', + '&1234', +) { + my $rv; + eval { $rv = simple_pack($_) }; + if (defined $rv) { + $rv = unpack("H40",$rv); + print "got: $rv, exp: 'die'\nnot "; + } + &ok; + + print "expected a die from bad character input\nnot " + unless $@ && $@ =~ /Bad/; + &ok; +} + +## tests 10 - 17 bcd2bin + +foreach( + '1234/', + '1234:', + 'a1234', + '&1234', +) { + my $rv; + eval { $rv = bcd2bin($_) }; + if (defined $rv) { + $rv = unpack("H40",$rv); + print "got: $rv, exp: 'die'\nnot "; + } + &ok; + + print "expected a die from bad character input\nnot " + unless $@ && $@ =~ /Bad/; + &ok; +} + +## test 18 bcdn2bin +eval { bcdn2bin('123456789012345678901') }; +print "expected a die from bad vector string length\nnot " + unless $@ && $@ =~ /Bad/; +&ok; + +## test 19 bcdn2bin +eval { bcdn2bin('12345678901234567890') }; +print "expected a die from missing length specifier\nnot " + unless $@ && $@ =~ /Bad/; +&ok; + +## test 20 bin2bcd +eval { bin2bcd('123') }; +print "expected a die from bad vector string length\nnot " + unless $@ && $@ =~ /Bad/; +&ok; + +## test 21 bin2bcdn +eval { bin2bcdn('123') }; +print "expected a die from bad vector string length\nnot " + unless $@ && $@ =~ /Bad/; +&ok; + +## test 22 bcdn2txt +eval { bcdn2txt('123456789012345678901') }; +print "expected a die from bad vector string length\nnot " + unless $@ && $@ =~ /Bad/; +&ok; + +## test 23 bcdn2txt +my $rv; +my $exp = '3132333435363738393031323334353637383930'; +$rv = bcdn2txt('12345678901234567890'); +print "got: $rv\nexp: $exp\nnot " + unless $rv eq $exp; +&ok; + +## test 24 hasbits +eval { hasbits('123') }; +print "expected a die from bad vector string length\nnot " + unless $@ && $@ =~ /Bad/; +&ok; + +## test 25 isIPv4 +eval { isIPv4('12345678901234567') }; +print "expected a die from bad vector string length\nnot " + unless $@ && $@ =~ /Bad/; +&ok; + +## test 26 add128 +eval { add128('123','1234567890123456') }; +print "expected a die from bad vector string length\nnot " + unless $@ && $@ =~ /Bad/; +&ok; + +## test 27 sub128 +eval { sub128('1234567890123456','12345678901234567') }; +print "expected a die from bad vector string length\nnot " + unless $@ && $@ =~ /Bad/; +&ok; + +## test 28 comp128 +eval { comp128('123') }; +print "expected a die from bad vector string length\nnot " + unless $@ && $@ =~ /Bad/; +&ok; + +## test 29 shiftleft +eval { shiftleft ('12345678901234567') }; +print "expected a die from bad vector string length\nnot " + unless $@ && $@ =~ /Bad/; +&ok; + +## test 30 shiftleft +eval { shiftleft ('1234567890123456',-1) }; +print "expected a die from bad shift count specifier\nnot " + unless $@ && $@ =~ /Bad/; +&ok; + +## test 31 shiftleft +eval { shiftleft ('1234567890123456',129) }; +print "expected a die from bad shift count specifier\nnot " + unless $@ && $@ =~ /Bad/; +&ok; + diff --git a/Lite/Util/t/hasbits.t b/Lite/Util/t/hasbits.t new file mode 100644 index 0000000..780cc3a --- /dev/null +++ b/Lite/Util/t/hasbits.t @@ -0,0 +1,147 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### We start with some black magic to print on failure. +# Change 1..1 below to 1..last_test_to_print . +# (It may become useful if the test is moved to ./t subdirectory.) +$| = 1; +END {print "1..1\nnot ok 1\n" unless $test;} + +use NetAddr::IP::Util qw( + ipv6_aton + ipv6_n2x + hasbits +); + +$test = 1; + +sub ok { + print "ok $test\n"; + ++$test; +} + +my @num = qw # input +( + :: + 8000:: + 4000:: + 2000:: + 1000:: + 800:: + 400:: + 200:: + 100:: + 80:: + 40:: + 20:: + 10:: + 1:: + 0:8000:: + 0:4000:: + 0:2000:: + 0:1000:: + 0:800:: + 0:400:: + 0:200:: + 0:100:: + 0:80:: + 0:40:: + 0:20:: + 0:10:: + 0:1:: + 0:0:8000:: + 0:0:4000:: + 0:0:2000:: + 0:0:1000:: + 0:0:800:: + 0:0:400:: + 0:0:200:: + 0:0:100:: + 0:0:80:: + 0:0:40:: + 0:0:20:: + 0:0:10:: + 0:0:1:: + 0:0:0:8000:: + 0:0:0:4000:: + 0:0:0:2000:: + 0:0:0:1000:: + 0:0:0:800:: + 0:0:0:400:: + 0:0:0:200:: + 0:0:0:100:: + 0:0:0:80:: + 0:0:0:40:: + 0:0:0:20:: + 0:0:0:10:: + 0:0:0:1:: + ::8000:0:0:0 + ::4000:0:0:0 + ::2000:0:0:0 + ::1000:0:0:0 + ::800:0:0:0 + ::400:0:0:0 + ::200:0:0:0 + ::100:0:0:0 + ::80:0:0:0 + ::40:0:0:0 + ::20:0:0:0 + ::10:0:0:0 + ::1:0:0:0 + ::8000:0:0 + ::4000:0:0 + ::2000:0:0 + ::1000:0:0 + ::800:0:0 + ::400:0:0 + ::200:0:0 + ::100:0:0 + ::80:0:0 + ::40:0:0 + ::20:0:0 + ::10:0:0 + ::1:0:0 + ::8000:0 + ::4000:0 + ::2000:0 + ::1000:0 + ::800:0 + ::400:0 + ::200:0 + ::100:0 + ::80:0 + ::40:0 + ::20:0 + ::10:0 + ::1:0 + ::8000 + ::4000 + ::2000 + ::1000 + ::800 + ::400 + ::200 + ::100 + ::80 + ::40 + ::20 + ::10 + ::1 + ::8000:0:0:0:0 + ::8000:0:0:0:0:0 + ::8000:0:0:0:0:0:0 + 8000:0:0:0:0:0:0:0 +); +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): +print '1..',(scalar @num), "\n"; + +foreach (@num) { + my $bstr = ipv6_aton($_); + my $rv = hasbits($bstr); + my $exp = ($_ eq '::') ? 0:1; + print "got: $rv, exp: $exp for ", ipv6_n2x($bstr), "\nnot " + unless $rv eq $exp; + &ok; +} diff --git a/Lite/Util/t/inet_n2ad.t b/Lite/Util/t/inet_n2ad.t new file mode 100644 index 0000000..63846b4 --- /dev/null +++ b/Lite/Util/t/inet_n2ad.t @@ -0,0 +1,48 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### We start with some black magic to print on failure. +# Change 1..1 below to 1..last_test_to_print . +# (It may become useful if the test is moved to ./t subdirectory.) + +BEGIN { $| = 1; print "1..4\n"; } +END {print "not ok 1\n" unless $loaded;} + +use NetAddr::IP::Util qw( + ipv6_aton + ipv6_n2x + inet_any2n + inet_n2ad +); + +$loaded = 1; +print "ok 1\n"; +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + +$test = 2; + +sub ok { + print "ok $test\n"; + ++$test; +} + +my @num = qw # input expected +( a1b2:c3d4:e5d6:f7e8:08f9:190a:2a1b:3b4c A1B2:C3D4:E5D6:F7E8:8F9:190A:42.27.59.76 + 1.2.3.4 1.2.3.4 + 190A::102:304 190A:0:0:0:0:0:1.2.3.4 +); + +my $ff = ipv6_aton($num[1]); +for(my $i=0;$i<@num;$i+=2) { + my $num = $num[$i]; + my $bstr = inet_any2n($num); + my $rv = inet_n2ad($bstr); + my $exp = $num[$i +1]; + print "got: $rv\nexp: $exp\nnot " + unless $rv eq $exp; + &ok; +} diff --git a/Lite/Util/t/inet_n2dx.t b/Lite/Util/t/inet_n2dx.t new file mode 100644 index 0000000..ee60e4f --- /dev/null +++ b/Lite/Util/t/inet_n2dx.t @@ -0,0 +1,48 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### We start with some black magic to print on failure. +# Change 1..1 below to 1..last_test_to_print . +# (It may become useful if the test is moved to ./t subdirectory.) + +BEGIN { $| = 1; print "1..4\n"; } +END {print "not ok 1\n" unless $loaded;} + +use NetAddr::IP::Util qw( + ipv6_aton + ipv6_n2x + inet_any2n + inet_n2dx +); + +$loaded = 1; +print "ok 1\n"; +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + +$test = 2; + +sub ok { + print "ok $test\n"; + ++$test; +} + +my @num = qw # input expected +( a1b2:c3d4:e5d6:f7e8:08f9:190a:2a1b:3b4c A1B2:C3D4:E5D6:F7E8:8F9:190A:2A1B:3B4C + 1.2.3.4 1.2.3.4 + A1B2:C3D4:E5D6:F7E8:08F9:190A:1.2.3.4 A1B2:C3D4:E5D6:F7E8:8F9:190A:102:304 +); + +my $ff = ipv6_aton($num[1]); +for(my $i=0;$i<@num;$i+=2) { + my $num = $num[$i]; + my $bstr = inet_any2n($num); + my $rv = inet_n2dx($bstr); + my $exp = $num[$i +1]; + print "got: $rv\nexp: $exp\nnot " + unless $rv eq $exp; + &ok; +} diff --git a/Lite/Util/t/ipv4_inet.t b/Lite/Util/t/ipv4_inet.t new file mode 100644 index 0000000..6c44e68 --- /dev/null +++ b/Lite/Util/t/ipv4_inet.t @@ -0,0 +1,59 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### We start with some black magic to print on failure. +# Change 1..1 below to 1..last_test_to_print . +# (It may become useful if the test is moved to ./t subdirectory.) + +BEGIN { $| = 1; print "1..13\n"; } +END {print "not ok 1\n" unless $loaded;} + +#use diagnostics; +use NetAddr::IP::Util qw( + inet_ntoa + inet_aton +); + +$loaded = 1; +print "ok 1\n"; +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + +$test = 2; + +sub ok { + print "ok $test\n"; + ++$test; +} + +## test 2 add stuff to buffer +my @num = # addr +qw( + 0.0.0.0 + 255.255.255.255 + 1.2.3.4 + 10.253.230.9 +); + +foreach (@num) { + my @digs = split(/\./,$_); + my $pkd = pack('C4',@digs); + my $naddr = inet_aton($_); + my $addr = join('.',unpack('C4',$naddr)); + my $num = inet_ntoa($pkd); + + print "bits do not match\nnot " + unless $naddr eq $pkd; + &ok; + + print "inet_aton: $addr, exp: $_\nnot " + unless $addr eq $_; + &ok; + + print "inet_ntoa: $num, exp: $_\nnot " + unless $num eq $_; + &ok; +} diff --git a/Lite/Util/t/ipv6_any2n.t b/Lite/Util/t/ipv6_any2n.t new file mode 100644 index 0000000..3564508 --- /dev/null +++ b/Lite/Util/t/ipv6_any2n.t @@ -0,0 +1,47 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### We start with some black magic to print on failure. +# Change 1..1 below to 1..last_test_to_print . +# (It may become useful if the test is moved to ./t subdirectory.) + +BEGIN { $| = 1; print "1..4\n"; } +END {print "not ok 1\n" unless $loaded;} + +use NetAddr::IP::Util qw( + ipv6_aton + ipv6_n2x + inet_any2n +); + +$loaded = 1; +print "ok 1\n"; +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + +$test = 2; + +sub ok { + print "ok $test\n"; + ++$test; +} + +my @num = qw # input expected +( a1b2:c3d4:e5d6:f7e8:08f9:190a:2a1b:3b4c A1B2:C3D4:E5D6:F7E8:8F9:190A:2A1B:3B4C + 1.2.3.4 0:0:0:0:0:0:102:304 + A1B2:C3D4:E5D6:F7E8:08F9:190A:1.2.3.4 A1B2:C3D4:E5D6:F7E8:8F9:190A:102:304 +); + +my $ff = ipv6_aton($num[1]); +for(my $i=0;$i<@num;$i+=2) { + my $num = $num[$i]; + my $bstr = inet_any2n($num); + my $rv = ipv6_n2x($bstr); + my $exp = $num[$i +1]; + print "got: $rv\nexp: $exp\nnot " + unless $rv eq $exp; + &ok; +} diff --git a/Lite/Util/t/ipv6func.t b/Lite/Util/t/ipv6func.t new file mode 100644 index 0000000..ddfa9c0 --- /dev/null +++ b/Lite/Util/t/ipv6func.t @@ -0,0 +1,75 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### We start with some black magic to print on failure. +# Change 1..1 below to 1..last_test_to_print . +# (It may become useful if the test is moved to ./t subdirectory.) + +BEGIN { $| = 1; print "1..27\n"; } +END {print "not ok 1\n" unless $loaded;} + +use NetAddr::IP::Util qw( + ipv6_aton + ipv6_n2x + ipv6_n2d +); + +$loaded = 1; +print "ok 1\n"; +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + +$test = 2; + +sub ok { + print "ok $test\n"; + ++$test; +} + +my @num = # in exphex expd +qw( + :: 0:0:0:0:0:0:0:0 0:0:0:0:0:0:0.0.0.0 + 43:: 43:0:0:0:0:0:0:0 43:0:0:0:0:0:0.0.0.0 + ::21 0:0:0:0:0:0:0:21 0:0:0:0:0:0:0.0.0.33 + ::1:2:3:4:5:6:7 0:1:2:3:4:5:6:7 0:1:2:3:4:5:0.6.0.7 + 1:2:3:4:5:6:7:: 1:2:3:4:5:6:7:0 1:2:3:4:5:6:0.7.0.0 + 1::8 1:0:0:0:0:0:0:8 1:0:0:0:0:0:0.0.0.8 + FF00::FFFF FF00:0:0:0:0:0:0:FFFF FF00:0:0:0:0:0:0.0.255.255 + FFFF::FFFF:FFFF FFFF:0:0:0:0:0:FFFF:FFFF FFFF:0:0:0:0:0:255.255.255.255 +); + +for (my $i=0;$i<@num;$i+=3) { + my $bits = ipv6_aton($num[$i]); + my $len = length($bits); + print "bad len = $len, exp: 32\nnot " + unless $len == 16; # 16 bytes x 8 bits + &ok; + my $ipv6x = ipv6_n2x($bits); + print "got: $ipv6x\nexp: $num[$i +1]\nnot " + unless $ipv6x eq $num[$i +1]; + &ok; + my $ipv6d = ipv6_n2d($bits); + print "got: $ipv6d\nexp: $num[$i +2]\nnot " + unless $ipv6d eq $num[$i +2]; + &ok; +} + +## test 26 check bad length n2x +my $try = '1234'; +my $notempty = eval { + ipv6_n2x($try); +}; +print "failed bad argument length test for ipv6_n2x\nnot " + unless $@ && $@ =~ /Bad arg/; +&ok; + +## test 27 check bad length n2d +$notempty = eval { + ipv6_n2d($try); +}; +print "failed bad argument length test for ipv6_n2d\nnot " + unless $@ && $@ =~ /Bad arg/; +&ok; diff --git a/Lite/Util/t/ipv6to4.t b/Lite/Util/t/ipv6to4.t new file mode 100644 index 0000000..9500b07 --- /dev/null +++ b/Lite/Util/t/ipv6to4.t @@ -0,0 +1,55 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### We start with some black magic to print on failure. +# Change 1..1 below to 1..last_test_to_print . +# (It may become useful if the test is moved to ./t subdirectory.) + +BEGIN { $| = 1; print "1..4\n"; } +END {print "not ok 1\n" unless $loaded;} + +use NetAddr::IP::Util qw( + inet_ntoa + inet_any2n + ipv6_n2d + ipv6to4 +); + +$loaded = 1; +print "ok 1\n"; +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + +$test = 2; + +sub ok { + print "ok $test\n"; + ++$test; +} + +my $nip = inet_any2n('1.2.3.4'); +my $exp = '0:0:0:0:0:0:1.2.3.4'; + +## test 2 check that we have an ipv6 netaddr +my $ipv6 = ipv6_n2d($nip); +print "got: $ipv6\nexp: $exp\nnot " + unless $ipv6 eq $exp; +&ok; + +## test 3 check conversion back to ipv4 +$exp = '1.2.3.4'; +print "got: $_, exp: $exp\nnot " + unless inet_ntoa(ipv6to4($nip)) eq $exp; +&ok; + +## test 4 check bad length +$nip = pack("H9",0x00,0x01,0x02,0x03,0x04,0x05,0x06,0x07,0x08,0x09); +eval { + ipv6to4($nip); +}; +print "ipv6to4 accepted bad argument length\nnot " + unless $@ && $@ =~ /Bad arg.+ipv6to4/; +&ok; diff --git a/Lite/Util/t/isIPv4.t b/Lite/Util/t/isIPv4.t new file mode 100644 index 0000000..dce3a5d --- /dev/null +++ b/Lite/Util/t/isIPv4.t @@ -0,0 +1,148 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### We start with some black magic to print on failure. +# Change 1..1 below to 1..last_test_to_print . +# (It may become useful if the test is moved to ./t subdirectory.) + +BEGIN { $| = 1; print "1..106\n"; } +END {print "not ok 1\n" unless $loaded;} + +use NetAddr::IP::Util qw( + ipv6_aton + ipv6_n2x + isIPv4 +); + +$loaded = 1; +print "ok 1\n"; +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + +$test = 2; + +sub ok { + print "ok $test\n"; + ++$test; +} + +my @num = qw # input +( + :: + 8000:: + 4000:: + 2000:: + 1000:: + 800:: + 400:: + 200:: + 100:: + 80:: + 40:: + 20:: + 10:: + 1:: + 0:8000:: + 0:4000:: + 0:2000:: + 0:1000:: + 0:800:: + 0:400:: + 0:200:: + 0:100:: + 0:80:: + 0:40:: + 0:20:: + 0:10:: + 0:1:: + 0:0:8000:: + 0:0:4000:: + 0:0:2000:: + 0:0:1000:: + 0:0:800:: + 0:0:400:: + 0:0:200:: + 0:0:100:: + 0:0:80:: + 0:0:40:: + 0:0:20:: + 0:0:10:: + 0:0:1:: + 0:0:0:8000:: + 0:0:0:4000:: + 0:0:0:2000:: + 0:0:0:1000:: + 0:0:0:800:: + 0:0:0:400:: + 0:0:0:200:: + 0:0:0:100:: + 0:0:0:80:: + 0:0:0:40:: + 0:0:0:20:: + 0:0:0:10:: + 0:0:0:1:: + 0:0:0:0:8000:: + 0:0:0:0:4000:: + 0:0:0:0:2000:: + 0:0:0:0:1000:: + 0:0:0:0:800:: + 0:0:0:0:400:: + 0:0:0:0:200:: + 0:0:0:0:100:: + 0:0:0:0:80:: + 0:0:0:0:40:: + 0:0:0:0:20:: + 0:0:0:0:10:: + 0:0:0:0:1:: + 0:0:0:0:0:8000:: + 0:0:0:0:0:4000:: + 0:0:0:0:0:2000:: + 0:0:0:0:0:1000:: + 0:0:0:0:0:800:: + 0:0:0:0:0:400:: + 0:0:0:0:0:200:: + 0:0:0:0:0:100:: + 0:0:0:0:0:80:: + 0:0:0:0:0:40:: + 0:0:0:0:0:20:: + 0:0:0:0:0:10:: + 0:0:0:0:0:1:: + ::8000:0 + ::4000:0 + ::2000:0 + ::1000:0 + ::800:0 + ::400:0 + ::200:0 + ::100:0 + ::80:0 + ::40:0 + ::20:0 + ::10:0 + ::1:0 + ::8000 + ::4000 + ::2000 + ::1000 + ::800 + ::400 + ::200 + ::100 + ::80 + ::40 + ::20 + ::10 + ::1 +); + +foreach (@num) { + my $bstr = ipv6_aton($_); + my $rv = isIPv4($bstr); + my $exp = ($_ =~ /\d::$/) ? 0:1; + print "got: $rv, exp: $exp for ", ipv6_n2x($bstr), "\nnot " + unless $rv eq $exp; + &ok; +} diff --git a/Lite/Util/t/leftshift.t b/Lite/Util/t/leftshift.t new file mode 100644 index 0000000..abe622c --- /dev/null +++ b/Lite/Util/t/leftshift.t @@ -0,0 +1,58 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### We start with some black magic to print on failure. +# Change 1..1 below to 1..last_test_to_print . +# (It may become useful if the test is moved to ./t subdirectory.) + +BEGIN { $| = 1; print "1..9\n"; } +END {print "not ok 1\n" unless $loaded;} + +use NetAddr::IP::Util qw( + ipv6_aton + ipv6_n2x + shiftleft +); + +$loaded = 1; +print "ok 1\n"; +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + +$test = 2; + +sub ok { + print "ok $test\n"; + ++$test; +} + +my @num = # input shift expected +qw( + 1::1 none 1:0:0:0:0:0:0:1 + 1::1 0 1:0:0:0:0:0:0:1 + 1::1 1 2:0:0:0:0:0:0:2 + 1::1 2 4:0:0:0:0:0:0:4 + 1::1 3 8:0:0:0:0:0:0:8 + 1::1 15 8000:0:0:0:0:0:0:8000 + 1::1 16 0:0:0:0:0:0:1:0 + 1::1 128 0:0:0:0:0:0:0:0 +); + +for (my $i=0;$i < @num;$i+=3) { + my $bstr = ipv6_aton($num[$i]); + my $rv; + if ($num[$i +1] =~ /\D/) { + $rv = shiftleft($bstr); + } + else { + $rv = shiftleft($bstr,$num[$i +1]); + } + my $exp = $num[$i+2]; + my $got = ipv6_n2x($rv); + print "got: $got, exp: $exp\nnot " + unless $got eq $exp; + &ok; +} diff --git a/Lite/Util/t/mode.t b/Lite/Util/t/mode.t new file mode 100644 index 0000000..0069f5e --- /dev/null +++ b/Lite/Util/t/mode.t @@ -0,0 +1,22 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### We start with some black magic to print on failure. +# Change 1..1 below to 1..last_test_to_print . +# (It may become useful if the test is moved to ./t subdirectory.) + +BEGIN { $| = 1; print "1..2\n"; } +END {print "not ok 1\n" unless $loaded;} + +use NetAddr::IP::Util qw(mode); + +$loaded = 1; +print "ok 1\n"; +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + +print STDERR "\t\toperating mode ", mode, "\n"; +print "ok 2\n"; diff --git a/Lite/Util/t/notcontiguous.t b/Lite/Util/t/notcontiguous.t new file mode 100644 index 0000000..e8d8032 --- /dev/null +++ b/Lite/Util/t/notcontiguous.t @@ -0,0 +1,72 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### We start with some black magic to print on failure. +# Change 1..1 below to 1..last_test_to_print . +# (It may become useful if the test is moved to ./t subdirectory.) + +BEGIN { $| = 1; print "1..49\n"; } +END {print "not ok 1\n" unless $loaded;} + +use NetAddr::IP::Util qw( + inet_any2n + notcontiguous +); + +$loaded = 1; +print "ok 1\n"; +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + +$test = 2; + +sub ok { + print "ok $test\n"; + ++$test; +} + +my @num = # input expected spur +qw( + FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF 128 0 + FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFE 127 0 + FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFC 126 0 + FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFF8 125 0 + FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFF0 124 0 + FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFE0 123 0 + FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFC0 122 0 + FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FF80 121 0 + FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FF00 120 0 + FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:0 112 0 + FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFF0:0 108 0 + FFeF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF 128 1 + FFFF:FFeF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFE 127 1 + FFFF:FFFF:FeFF:FFFF:FFFF:FFFF:FFFF:FFFC 126 1 + FFFF:FFFF:FFFF:eFFF:FFFF:FFFF:FFFF:FFF8 125 1 + FFFF:FFFF:FFFF:FFFF:FFFe:FFFF:FFFF:FFF0 124 1 + FFFF:FFFF:FFF:FFFF:FFFF:FFFF:FFFF:FFE0 123 1 + FFFF:FFFF:FFFF:FFFF:FFFF:FFeF:FFFF:FFC0 122 1 + FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FeFF:FF80 121 1 + FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:eF00 120 1 + eFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:0 112 1 + FFFF:FeFF:FFFF:FFFF:FFFF:FFFF:FFF0:0 108 1 + F000:: 4 0 + A000:: 3 1 +); + +for (my $i=0;$i < @num;$i+=3) { + my $bstr = inet_any2n($num[$i]); + my $rv; + my $xcidr = $num[$i+1]; + my $xspur = $num[$i+2]; + my($spur,$cidr) = notcontiguous($bstr); + print "cidr: $cidr, exp: $xcidr\nnot " + unless $cidr == $xcidr; + &ok; + $spur = 1 if $spur; + print "spur: $spur, exp: $xspur\nnot " + unless $spur == $xspur; + &ok; +} diff --git a/Lite/Util/t/simple_pack.t b/Lite/Util/t/simple_pack.t new file mode 100644 index 0000000..901521c --- /dev/null +++ b/Lite/Util/t/simple_pack.t @@ -0,0 +1,51 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### We start with some black magic to print on failure. +# Change 1..1 below to 1..last_test_to_print . +# (It may become useful if the test is moved to ./t subdirectory.) + +BEGIN { $| = 1; print "1..9\n"; } +END {print "not ok 1\n" unless $loaded;} + +use NetAddr::IP::Util qw( + simple_pack +); + +$loaded = 1; +print "ok 1\n"; +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + +$test = 2; + +sub ok { + print "ok $test\n"; + ++$test; +} + +my @num2 = qw( + 0 + 2147483648 + 140737488355328 + 9223372036854775808 + 604462909807314587353088 + 39614081257132168796771975168 + 2596148429267413814265248164610048 + 170141183460469231731687303715884105728 +); + +## tests 2 - 9 check pack correct + +for (my $i=0;$i<@num2;$i++) { + my $len = length($num2[$i]); + my $pkd = simple_pack($num2[$i]); + my $rv = unpack("H40",$pkd); + $rv =~ s/^0+(\d)/$1/g; + print "got: $rv\nexp: $num2[$i]\nnot " + unless $rv eq $num2[$i]; + &ok; +} diff --git a/Lite/Util/t/sub128.t b/Lite/Util/t/sub128.t new file mode 100644 index 0000000..7ed31a3 --- /dev/null +++ b/Lite/Util/t/sub128.t @@ -0,0 +1,68 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### We start with some black magic to print on failure. +# Change 1..1 below to 1..last_test_to_print . +# (It may become useful if the test is moved to ./t subdirectory.) + +BEGIN { $| = 1; print "1..34\n"; } +END {print "not ok 1\n" unless $loaded;} + +use NetAddr::IP::Util qw( + sub128 + ipv6_aton + ipv6_n2x +); + +$loaded = 1; +print "ok 1\n"; +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + +$test = 2; + +sub ok { + print "ok $test\n"; + ++$test; +} +my @num = # number minus carry (not borrow) exp +qw( + ::f712:fff:fffe ::f712:fff:fffc 1 0:0:0:0:0:0:0:2 + ::712:fff:fffe ::712:fff:fffc 1 0:0:0:0:0:0:0:2 + ::712:ffff:fffe ::712:ffff:fffc 1 0:0:0:0:0:0:0:2 + ::f712:ffff:fffa ::f712:ffff:fffc 0 FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFE + ::f712:fff:fffa ::f712:fff:fffc 0 FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFE + ::712:fff:fffa ::712:fff:fffc 0 FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFE + ::712:ffff:fffa ::712:ffff:fffc 0 FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFE + ::2 ::1 1 0:0:0:0:0:0:0:1 + ::f712:ffff:fffe ::f712:ffff:fffc 1 0:0:0:0:0:0:0:2 + ::1 ::3 0 FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFE + ::1234 ::1234 1 0:0:0:0:0:0:0:0 +); +## test 2 check comp of zero + +for (my $i=0; $i<@num; $i+=4) { + my $num = ipv6_aton($num[$i]); + my $minus = ipv6_aton($num[$i +1]); + my $rv = sub128($num,$minus); + print "got: $rv, exp: $num[$i +2]\nnot " + unless $rv == $num[$i +2]; + &ok; +} + +for (my $i=0; $i<@num; $i+=4) { + my $num = ipv6_aton($num[$i]); + my $minus = ipv6_aton($num[$i +1]); + my($rv,$dif) = sub128($num,$minus); + print "got: $rv, exp: $num[$i +2]\nnot " + unless $rv == $num[$i +2]; + &ok; + $dif = ipv6_n2x($dif); + print "got: $dif\nexp: $num[$i +3]\nnot " + unless $dif eq $num[$i +3]; + &ok; +} + diff --git a/Lite/Util/typemap b/Lite/Util/typemap new file mode 100644 index 0000000..b85166a --- /dev/null +++ b/Lite/Util/typemap @@ -0,0 +1,28 @@ +# +# Map C types to Perl types +# + +struct in_addr * T_PTROBJ + +# +# Input conversions +# + +INPUT + +T_PTROBJ + if (sv_derived_from($arg, \"${ntype}\")) { + IV tmp = SvIV((SV*)SvRV($arg)); + $var = ($type) tmp; + } + else + croak(\"$var is not of type ${ntype}\") + +# +# Output conversions +# + +OUTPUT + +T_PTROBJ + sv_setref_pv($arg, \"${ntype}\", (void*)$var); diff --git a/Lite/Util/u_intxx.h b/Lite/Util/u_intxx.h new file mode 100644 index 0000000..6915673 --- /dev/null +++ b/Lite/Util/u_intxx.h @@ -0,0 +1,59 @@ +/* + * u_intxx.h + * + */ +#ifndef _SYS_TYPES_H +#include +#endif + +#include "localStuff.h" + +#ifndef _U_INTXX_DEFINES_H +#define _U_INTXX_DEFINES_H + +/* If sys/types.h does not supply u_intXX_t, supply them ourselves */ +#ifdef HAVE_U_INTXX_T +# if (HAVE_U_INTXX_T == 2) + #include +# endif +#else +# ifdef HAVE_UINTXX_T +# if (HAVE_UINTXX_T ==2) + #include +# endif +typedef uint8_t u_int8_t; +typedef uint16_t u_int16_t; +typedef uint32_t u_int32_t; +# define HAVE_U_INTXX_T 1 +# else +# if (SIZEOF_CHAR == 1) +typedef unsigned char u_int8_t; +# else +# error "8 bit int type not found." +# endif +# if (SIZEOF_SHORT_INT == 2) +typedef unsigned short int u_int16_t; +# else +# ifdef _UNICOS +# if (SIZEOF_SHORT_INT == 4) +typedef unsigned short u_int16_t; +# else +typedef unsigned long u_int16_t; +# endif +# else +# error "16 bit int type not found." +# endif +# endif +# if (SIZEOF_INT == 4) +typedef unsigned int u_int32_t; +# else +# ifdef _UNICOS +typedef unsigned long u_int32_t; +# else +# error "32 bit int type not found." +# endif +# endif +# endif +#endif + +#endif /* _U_INTXX_DEFINES_H */ diff --git a/Lite/Util/xs_include/inet_aton.c b/Lite/Util/xs_include/inet_aton.c new file mode 100644 index 0000000..02f9704 --- /dev/null +++ b/Lite/Util/xs_include/inet_aton.c @@ -0,0 +1,47 @@ +/* inet_aton.c + * + * Copyright 2006, Michael Robinton + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +*/ + +#ifndef LOCAL_HAVE_inet_aton +#include +#include +#include +#include + +int +my_inet_aton(const char *cp, struct in_addr *inp) +{ +# ifdef LOCAL_HAVE_inet_pton + return inet_pton(AF_INET,cp,inp); +# else +# ifdef LOCAL_HAVE_inet_addr + inp->s_addr = inet_addr(cp); + if (inp->s_addr == -1) { + if (strncmp("255.255.255.255",cp,15) == 0) + return 1; + else + return 0; + } + return 1; +# else +# error inet_aton, inet_pton, inet_addr not defined on this platform +# endif +# endif +} +#define inet_aton my_inet_aton +#endif diff --git a/Lite/Util/xs_include/miniSocket.inc b/Lite/Util/xs_include/miniSocket.inc new file mode 100644 index 0000000..eb9b26d --- /dev/null +++ b/Lite/Util/xs_include/miniSocket.inc @@ -0,0 +1,130 @@ + + # This file is excerpeted from perl-5.8.0/ext/Socket/Socket.xs and + # modified slightly so that it compiles on older versions of perl/gcc + # + # 3/28/06 verson 1.78 of Socket.xs, included in perl 5.9.3 + # is 100% compatible with this version + # + # Copyright 2003 - 2006, Michael Robinton + +void +inet_aton(host) + char * host + CODE: + { + struct in_addr ip_address; + struct hostent * phe; + int ok = + (host != NULL) && + (*host != '\0') && + inet_aton(host, &ip_address); + + if (!ok && (phe = gethostbyname(host))) { + Copy( phe->h_addr, &ip_address, phe->h_length, char ); + ok = 1; + } + + ST(0) = sv_newmortal(); + if (ok) + sv_setpvn( ST(0), (char *)&ip_address, sizeof ip_address ); + } + +void +inet_ntoa(ip_address_sv) + SV * ip_address_sv + CODE: + { + STRLEN addrlen; + struct in_addr addr; + char * addr_str; + char * ip_address; + # sigh.... these lines fail on older perl/gcc combinations + # if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1)) + # croak("Wide character in Socket::inet_ntoa"); + # ip_address = SvPVbyte(ip_address_sv, addrlen); + ip_address = SvPV(ip_address_sv,addrlen); + if (addrlen == sizeof(addr) || addrlen == 4) + addr.s_addr = + (ip_address[0] & 0xFF) << 24 | + (ip_address[1] & 0xFF) << 16 | + (ip_address[2] & 0xFF) << 8 | + (ip_address[3] & 0xFF); + else + croak("Bad arg length for %s, length is %d, should be %d", + "NetAddr::IP::Util::inet_ntoa", + addrlen, sizeof(addr)); + /* We could use inet_ntoa() but that is broken + * in HP-UX + GCC + 64bitint (returns "0.0.0.0"), + * so let's use this sprintf() workaround everywhere. + * This is also more threadsafe than using inet_ntoa(). */ + Newx(addr_str, 4 * 3 + 3 + 1, char); /* IPv6? */ + sprintf(addr_str, "%d.%d.%d.%d", + ((addr.s_addr >> 24) & 0xFF), + ((addr.s_addr >> 16) & 0xFF), + ((addr.s_addr >> 8) & 0xFF), + ( addr.s_addr & 0xFF)); + ST(0) = sv_2mortal(newSVpvn(addr_str, strlen(addr_str))); + Safefree(addr_str); + } diff --git a/Lite/t/addr.t b/Lite/t/addr.t new file mode 100644 index 0000000..2daeb95 --- /dev/null +++ b/Lite/t/addr.t @@ -0,0 +1,36 @@ + +#use diagnostics; +use NetAddr::IP::Lite; + +$| = 1; + +print "1..3\n"; + +my $test = 1; +sub ok() { + print 'ok ',$test++,"\n"; +} + +my $loip = new NetAddr::IP::Lite('::1.2.3.4/120'); # same as 1.2.3.4/24 +my $hiip = new NetAddr::IP::Lite('FF00::1:4/120'); + +## test '""' just for the heck of it +my $exp = 'FF00:0:0:0:0:0:1:4/120'; +my $txt = sprintf("%s",$hiip); +print 'got: ',$txt," exp: $exp\nnot " + unless $txt eq $exp; +&ok; + +## test addr lo +$exp = '0:0:0:0:0:0:102:304'; +my $addr = $loip->addr; +print "got: $addr, exp: $exp\nnot " + unless $addr eq $exp && ! ref $addr; +&ok; + +## test addr hi +$exp = 'FF00:0:0:0:0:0:1:4'; +$addr = $hiip->addr; +print "got: $addr, exp: $exp\nnot " + unless $addr eq $exp && ! ref $addr; +&ok; diff --git a/Lite/t/aton.t b/Lite/t/aton.t new file mode 100644 index 0000000..4be40f1 --- /dev/null +++ b/Lite/t/aton.t @@ -0,0 +1,33 @@ + +#use diagnostics; +use NetAddr::IP::Util qw( + inet_n2dx +); +use NetAddr::IP::Lite; + +$| = 1; + +print "1..2\n"; + +my $test = 1; +sub ok() { + print 'ok ',$test++,"\n"; +} + +my $loip = new NetAddr::IP::Lite('::1.2.3.4/120'); # same as 1.2.3.4/24 +my $hiip = new NetAddr::IP::Lite('FF00::4/120'); + +## test aton + +my $exp = 'FF00:0:0:0:0:0:0:4'; +my $txt = inet_n2dx($hiip->aton); +print "got: $txt, exp: $exp\nnot " + unless $txt eq $exp; +&ok; + +$exp = '1.2.3.4'; +$txt = inet_n2dx($loip->aton); +print "got: $txt, exp: $exp\nnot " + unless $txt eq $exp; +&ok; + diff --git a/Lite/t/bits.t b/Lite/t/bits.t new file mode 100644 index 0000000..476b9df --- /dev/null +++ b/Lite/t/bits.t @@ -0,0 +1,37 @@ + +#use diagnostics; +use NetAddr::IP::Lite; + +$| = 1; + +print "1..3\n"; + +my $test = 1; +sub ok() { + print 'ok ',$test++,"\n"; +} + +my $loip = new NetAddr::IP::Lite('::1.2.3.4/120'); # same as 1.2.3.4/24 +my $hiip = new NetAddr::IP::Lite('FF00::1:4/120'); +my $dqip = new NetAddr::IP::Lite('1.2.3.4/24'); + +## test bits lo +$exp = 128; +my $bits = $loip->bits; +print "got: $bits, exp: $exp\nnot " + unless $bits == $exp; +&ok; + +## test bits hi +$exp = 128; +$bits = $hiip->bits; +print "got: $bits, exp: $exp\nnot " + unless $bits == $exp; +&ok; + +## test dotquad bits +$exp = 32; +$bits = $dqip->bits; +print "got: $bits, exp: $exp\nnot " + unless $bits == $exp; +&ok; diff --git a/Lite/t/broadcast.t b/Lite/t/broadcast.t new file mode 100644 index 0000000..fea884f --- /dev/null +++ b/Lite/t/broadcast.t @@ -0,0 +1,37 @@ + +#use diagnostics; +use NetAddr::IP::Lite; + +$| = 1; + +print "1..3\n"; + +my $test = 1; +sub ok() { + print 'ok ',$test++,"\n"; +} + +my $loip = new NetAddr::IP::Lite('::1.2.3.4/120'); # same as 1.2.3.4/24 +my $hiip = new NetAddr::IP::Lite('FF00::4/120'); + +## test '""' just for the heck of it +my $exp = 'FF00:0:0:0:0:0:0:4/120'; +my $txt = sprintf("%s",$hiip); +print 'got: ',$txt," exp: $exp\nnot " + unless $txt eq $exp; +&ok; + +## test broadcast lo +$exp = '0:0:0:0:0:0:102:3FF/120'; +my $broad = $loip->broadcast; +print 'got: ',$broad, " exp: $exp\nnot " + unless $broad eq $exp; +&ok; + +## test broadcast hi +$exp = 'FF00:0:0:0:0:0:0:FF/120'; +$broad = $hiip->broadcast; +print 'got: ',$broad, " exp: $exp\nnot " + unless $broad eq $exp; +&ok; + diff --git a/Lite/t/cidr.t b/Lite/t/cidr.t new file mode 100644 index 0000000..292521a --- /dev/null +++ b/Lite/t/cidr.t @@ -0,0 +1,36 @@ + +#use diagnostics; +use NetAddr::IP::Lite; + +$| = 1; + +print "1..3\n"; + +my $test = 1; +sub ok() { + print 'ok ',$test++,"\n"; +} + +my $loip = new NetAddr::IP::Lite('::1.2.3.4/120'); # same as 1.2.3.4/24 +my $hiip = new NetAddr::IP::Lite('FF00::4/120'); +my $dqip = new NetAddr::IP::Lite('1.2.3.4/24'); + +## test cidr + +my $exp = 'FF00:0:0:0:0:0:0:4/120'; +my $txt = $hiip->cidr; +print "got: $txt, exp: $exp\nnot " + unless $txt eq $exp; +&ok; + +$exp = '0:0:0:0:0:0:102:304/120'; +$txt = $loip->cidr; +print "got: $txt, exp: $exp\nnot " + unless $txt eq $exp; +&ok; + +$exp = '1.2.3.4/24'; +$txt = $dqip->cidr; +print "got: $txt, exp: $exp\nnot " + unless $txt eq $exp; +&ok; diff --git a/Lite/t/contains.t b/Lite/t/contains.t new file mode 100644 index 0000000..8668244 --- /dev/null +++ b/Lite/t/contains.t @@ -0,0 +1,40 @@ + +#use diagnostics; +use NetAddr::IP::Lite; + +$| = 1; + +print "1..12\n"; + +my $test = 1; +sub ok() { + print 'ok ',$test++,"\n"; +} + +my $net4 = NetAddr::IP::Lite->new('1.2.3.5/30'); +my $net6 = NetAddr::IP::Lite->new('FF::85/126'); +my @try = qw( + 1.2.3.3 0 + 1.2.3.4 1 + 1.2.3.5 1 + 1.2.3.6 1 + 1.2.3.7 1 + 1.2.3.8 0 + FF::83 0 + FF::84 1 + FF::85 1 + FF::86 1 + FF::87 1 + FF::88 0 +); + +for (my $i=0;$i<@try;$i+=2) { + my $ip = NetAddr::IP::Lite->new($try[$i]); + my $rv = ($try[$i] =~ /:/) + ? $net6->contains($ip) + : $net4->contains($ip); + print "got: $rv, exp: $try[$i+1]\nnot " + unless $rv == $try[$i+1]; + &ok; +} + diff --git a/Lite/t/copy.t b/Lite/t/copy.t new file mode 100644 index 0000000..34ba8d5 --- /dev/null +++ b/Lite/t/copy.t @@ -0,0 +1,52 @@ + +#use diagnostics; +use NetAddr::IP::Lite 0.10; +*Ones = \&NetAddr::IP::Lite::Ones; +use NetAddr::IP::Util qw( + ipv6_aton + shiftleft +); +$| = 1; + +print "1..4\n"; + +my $test = 1; +sub ok() { + print 'ok ',$test++,"\n"; +} + +my $ip24 = '1.2.3.4/24'; +my $o = new NetAddr::IP::Lite($ip24); +my $c = $o->copy; + +## test 1 validate original +my $txto = sprintf("%s",$o); +my $txtc = sprintf("%s",$c); +print "orig... got: $txto, exp: $ip24\nnot " + unless $txto eq $ip24; +&ok; + +## test 2 +print "copy... got: $txtc, exp: $ip24\nnot " + unless $txtc eq $ip24; +&ok; + +my $ip28 = '1.2.3.4/28'; +my $mask = shiftleft(Ones(),32 - 28); + +$c->{mask} = $mask; +$txto = sprintf("%s",$o); +$txtc = sprintf("%s",$c); + +## test 3 validate original +$txto = sprintf("%s",$o); +$txtc = sprintf("%s",$c); +print "orig... got: $txto, exp: $ip24\nnot " + unless $txto eq $ip24; +&ok; + +## test 4 +print "copy... got: $txtc, exp: $ip28\nnot " + unless $txtc eq $ip28; +&ok; + diff --git a/Lite/t/firstlast.t b/Lite/t/firstlast.t new file mode 100644 index 0000000..5c4418a --- /dev/null +++ b/Lite/t/firstlast.t @@ -0,0 +1,39 @@ + +#use diagnostics; +use NetAddr::IP::Lite; + +$| = 1; + +print "1..4\n"; + +my $test = 1; +sub ok() { + print 'ok ',$test++,"\n"; +} + +my $ip4 = NetAddr::IP::Lite->new('1.2.3.11/29'); +my $ip6 = NetAddr::IP::Lite->new('FF::8B/125'); + +my $exp = '1.2.3.9'; +my $rv = $ip4->first->addr; +print "got: $rv, exp: $exp\nnot " + unless $rv eq $exp; +&ok; + +$exp = '1.2.3.14'; +$rv = $ip4->last->addr; +print "got: $rv, exp: $exp\nnot " + unless $rv eq $exp; +&ok; + +$exp = 'FF:0:0:0:0:0:0:89'; +$rv = $ip6->first->addr; +print "got: $rv, exp: $exp\nnot " + unless $rv eq $exp; +&ok; + +$exp = 'FF:0:0:0:0:0:0:8E'; +$rv = $ip6->last->addr; +print "got: $rv, exp: $exp\nnot " + unless $rv eq $exp; +&ok; diff --git a/Lite/t/lemasklen.t b/Lite/t/lemasklen.t new file mode 100644 index 0000000..fc7d2db --- /dev/null +++ b/Lite/t/lemasklen.t @@ -0,0 +1,19 @@ +use NetAddr::IP::Lite; + +my @masks = 0 .. 32; + +$| = 1; + +print '1..', scalar @masks, "\n"; + +my $count = 1; + +for my $m (@masks) { + my $ip = new NetAddr::IP::Lite '10.0.0.1', $m; + if ($ip->masklen == $m) { + print "ok ", $count ++, "\n"; + } + else { + print "not ok ", $count ++, "\n"; + } +} diff --git a/Lite/t/loops.t b/Lite/t/loops.t new file mode 100644 index 0000000..55696a5 --- /dev/null +++ b/Lite/t/loops.t @@ -0,0 +1,51 @@ +use NetAddr::IP::Lite; + +$| = 1; + +my @deltas = (0, 1, 2, 3, 255); + +print "1..", 15 + @deltas, "\n"; + +my $count = 1; + +for (my $ip = new NetAddr::IP::Lite '10.0.0.1/28'; + $ip < $ip->broadcast; + $ip ++) +{ + my $o = $ip->addr; + + $o =~ s/^.+\.(\d+)$/$1/; + + if ($o == $count) { + print "ok $count\n"; + } + else { + print "not ok $count\n"; + } + + ++ $count; +} + +my $ip = new NetAddr::IP::Lite '10.0.0.255/24'; +$ip ++; + +if ($ip eq '10.0.0.0/24') { + print "ok $count\n"; +} +else { + print "not ok $count\n"; +} + +++$count; + +$ip = new NetAddr::IP::Lite '10.0.0.0/24'; + +for my $v (@deltas) { + if ($ip + $v eq '10.0.0.' . $v . '/24') { + print "ok $count\n"; + } + else { + print "not ok $count\n"; + } + ++ $count; +} diff --git a/Lite/t/mask.t b/Lite/t/mask.t new file mode 100644 index 0000000..f99c811 --- /dev/null +++ b/Lite/t/mask.t @@ -0,0 +1,44 @@ + +#use diagnostics; +use NetAddr::IP::Lite; + +$| = 1; + +print "1..4\n"; + +my $test = 1; +sub ok() { + print 'ok ',$test++,"\n"; +} + +my $loip = new NetAddr::IP::Lite('::1.2.3.4/120'); # same as 1.2.3.4/24 +my $hiip = new NetAddr::IP::Lite('FF00::1:4/120'); +my $dqip = new NetAddr::IP::Lite('1.2.3.4/24'); + +## test '""' just for the heck of it +my $exp = 'FF00:0:0:0:0:0:1:4/120'; +my $txt = sprintf("%s",$hiip); +print 'got: ',$txt," exp: $exp\nnot " + unless $txt eq $exp; +&ok; + +## test lo ip +$exp = 'FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FF00'; +my $mask = $loip->mask; +print "got: $mask, exp: $exp\nnot " + unless $mask eq $exp && ! ref $mask; +&ok; + +## test mask hi +$exp = 'FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FF00'; +$mask = $hiip->mask; +print "got: $mask, exp: $exp\nnot " + unless $mask eq $exp && ! ref $mask; +&ok; + +## test mask dot quad +$exp = '255.255.255.0'; +$mask = $dqip->mask; +print "got: $mask, exp: $exp\nnot " + unless $mask eq $exp && ! ref $mask; +&ok; diff --git a/Lite/t/masklen.t b/Lite/t/masklen.t new file mode 100644 index 0000000..409b282 --- /dev/null +++ b/Lite/t/masklen.t @@ -0,0 +1,37 @@ + +#use diagnostics; +use NetAddr::IP::Lite; + +$| = 1; + +print "1..3\n"; + +my $test = 1; +sub ok() { + print 'ok ',$test++,"\n"; +} + +my $loip = new NetAddr::IP::Lite('::1.2.3.4/120'); # same as 1.2.3.4/24 +my $hiip = new NetAddr::IP::Lite('FF00::1:4/120'); +my $dqip = new NetAddr::IP::Lite('1.2.3.4/24'); + +## test masklen lo +$exp = 120; +my $masklen = $loip->masklen; +print "got: $masklen, exp: $exp\nnot " + unless $masklen == $exp; +&ok; + +## test masklen hi +$exp = 120; +$masklen = $hiip->masklen; +print "got: $masklen, exp: $exp\nnot " + unless $masklen == $exp; +&ok; + +## test masklen dq +$exp = 24; +$masklen = $dqip->masklen; +print "got: $masklen, exp: $exp\nnot " + unless $masklen == $exp; +&ok; diff --git a/Lite/t/netaddr.t b/Lite/t/netaddr.t new file mode 100644 index 0000000..4ee8c6b --- /dev/null +++ b/Lite/t/netaddr.t @@ -0,0 +1,208 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### We start with some black magic to print on failure. +# Change 1..1 below to 1..last_test_to_print . +# (It may become useful if the test is moved to ./t subdirectory.) + +BEGIN { $| = 1; print "1..35\n"; } +END {print "not ok 1\n" unless $loaded;} + +#use diagnostics; +use Data::Dumper; +use NetAddr::IP::Lite; + +$loaded = 1; +print "ok 1\n"; +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + +=pod + +$rv=list2NetAddr(\@inlist,\@NAobject); + +Build of NetAddr object structure from a list of IPv4 addresses or address +ranges. This object is passed to B to check if a given IP +address is contained in the list. + + input: array reference pointer + to a list of addresses + + i.e. 11.22.33.44 + 11.22.33.0/24 + 11.22.33.0/255.255.255.0 + 11.22.33.20-11.22.33.46 + 11.22.33.20 - 11.22.33.46 + + output: Number of objects created + or undef on error + +The NAobject array is filled with NetAddr::IP::Lite object references. + +=cut + +sub list2NetAddr { + my($inref,$outref) = @_; + return undef + unless ref $inref eq 'ARRAY' + && ref $outref eq 'ARRAY'; + unless ($SKIP_NetAddrIP) { + require NetAddr::IP::Lite; + $SKIP_NetAddrIP = 1; + } + @$outref = (); + my $IP; + no strict; + foreach $IP (@$inref) { + $IP =~ s/\s//g; + # 11.22.33.44 + if ($IP =~ /^\d+\.\d+\.\d+\.\d+$/o) { + push @$outref, NetAddr::IP::Lite->new($IP), 0; + } + # 11.22.33.44 - 11.22.33.49 + elsif ($IP =~ /^(\d+\.\d+\.\d+\.\d+)\s*\-\s*(\d+\.\d+\.\d+\.\d+)$/o) { + push @$outref, NetAddr::IP::Lite->new($1), NetAddr::IP::Lite->new($2); + } + # 11.22.33.44/63 + elsif ($IP =~ m|^\d+\.\d+\.\d+\.\d+/\d+$|) { + push @$outref, NetAddr::IP::Lite->new($IP), 0; + } + # 11.22.33.44/255.255.255.224 + elsif ($IP =~ m|^\d+\.\d+\.\d+\.\d+/\d+\.\d+\.\d+\.\d+$|o) { + push @$outref, NetAddr::IP::Lite->new($IP), 0; + } +# ignore un-matched IP patterns + } + return (scalar @$outref)/2; +} + +=pod + +$rv = matchNetAddr($ip,\@NAobject); + +Check if an IP address appears in a list of NetAddr objects. + + input: dot quad IP address, + reference to NetAddr objects + output: true if match else false + +=cut + +sub matchNetAddr { + my($ip,$naref) = @_; + return 0 unless $ip && $ip =~ /\d+\.\d+\.\d+\.\d+/; + $ip =~ s/\s//g; + $ip = new NetAddr::IP::Lite($ip); + my $i; + for($i=0; $i <= $#{$naref}; $i += 2) { + my $beg = $naref->[$i]; + my $end = $naref->[$i+1]; + if ($end) { + return 1 if $ip >= $beg && $ip <= $end; + } else { + return 1 if $ip->within($beg); + } + } + return 0; +} + + + +$test = 2; + +sub ok { + print "ok $test\n"; + ++$test; +} + +## test 2 instantiate netaddr array +# +# A multi-formated array of IP address that will never be tarpitted. +# +# WARNING: if you are using a private network, then you should include the +# address description for the net/subnets that you are using or you might +# find your DMZ or internal mail servers blocked since many DNSBLS list the +# private network addresses as BLACKLISTED +# +# 127./8, 10./8, 172.16/12, 192.168/16 +# +# class A xxx.0.0.0/8 +# class B xxx.xxx.0.0/16 +# class C xxx.xxx.xxx.0/24 0 +# 128 subnet xxx.xxx.xxx.xxx/25 128 +# 64 subnet xxx.xxx.xxx.xxx/26 192 +# 32 subnet xxx.xxx.xxx.xxx/27 224 +# 16 subnet xxx.xxx.xxx.xxx/28 240 +# 8 subnet xxx.xxx.xxx.xxx/29 248 +# 4 subnet xxx.xxx.xxx.xxx/30 252 +# 2 subnet xxx.xxx.xxx.xxx/31 254 +# single address xxx.xxx.xxx.xxx/32 255 +# +@tstrng = ( + # a single address + '11.22.33.44', + # a range of ip's, ONLY VALID WITHIN THE SAME CLASS 'C' + '22.33.44.55 - 22.33.44.65', + '45.67.89.10-45.67.89.32', + # a CIDR range + '5.6.7.16/28', + # a range specified with a netmask + '7.8.9.128/255.255.255.240', + # this should ALWAYS be here + '127.0.0.0/8', # ignore all test entries and localhost +); +my @NAobject; +my $rv = list2NetAddr(\@tstrng,\@NAobject); +print "wrong number of NA objects\ngot: $rv, exp: 6\nnot " + unless $rv == 6; +&ok; + +## test 3 check disallowed terms +print "accepted null parameter\nnot " + if matchNetAddr(); +&ok; + +## test 4 check disallowed parm +print "accepted non-numeric parameter\nnot " + if matchNetAddr('junk'); +&ok; + +##test 5 check non-ip short +print "accepted short ip segment\nnot " + if matchNetAddr('1.2.3'); +&ok; + +# yeah, it will accept a long one, but that's tough! + +## test 6-35 bracket NA objects +# +my @chkary = # 5 x 6 tests + # out left in left middle in right out right +qw( 11.22.33.43 11.22.33.44 11.22.33.44 11.22.33.44 11.22.33.45 + 22.33.44.54 22.33.44.55 22.33.44.60 22.33.44.65 22.33.44.66 + 45.67.89.9 45.67.89.10 45.67.89.20 45.67.89.32 45.67.89.33 + 5.6.7.15 5.6.7.16 5.6.7.20 5.6.7.31 5.6.7.32 + 7.8.9.127 7.8.9.128 7.8.9.138 7.8.9.143 7.8.9.144 + 126.255.255.255 127.0.0.0 127.128.128.128 127.255.255.255 128.0.0.0 +); + +for(my $i=0;$i <= $#chkary; $i+=5) { + print "accepted outside left bound $chkary[$i]\nnot " + if matchNetAddr($chkary[$i],\@NAobject); + &ok; + print "rejected inside left bound $chkary[$i+1]\nnot " + unless matchNetAddr($chkary[$i+1],\@NAobject); + &ok; + print "rejected inside middle bound $chkary[$i+2]\nnot " + unless matchNetAddr($chkary[$i+2],\@NAobject); + &ok; + print "rejected inside right bound $chkary[$i+3]\nnot " + unless matchNetAddr($chkary[$i+3],\@NAobject); + &ok; + print "accepted outside right bound $chkary[$i+4]\nnot " + if matchNetAddr($chkary[$i+4],\@NAobject); + &ok; +} diff --git a/Lite/t/network.t b/Lite/t/network.t new file mode 100644 index 0000000..c000940 --- /dev/null +++ b/Lite/t/network.t @@ -0,0 +1,44 @@ + +#use diagnostics; +use NetAddr::IP::Lite; + +$| = 1; + +print "1..4\n"; + +my $test = 1; +sub ok() { + print 'ok ',$test++,"\n"; +} + +my $loip = new NetAddr::IP::Lite('::1.2.3.4/120'); # same as 1.2.3.4/24 +my $hiip = new NetAddr::IP::Lite('FF00::1:4/120'); +my $dqip = new NetAddr::IP::Lite('1.2.3.4/24'); + +## test '""' just for the heck of it +my $exp = 'FF00:0:0:0:0:0:1:4/120'; +my $txt = sprintf("%s",$hiip); +print 'got: ',$txt," exp: $exp\nnot " + unless $txt eq $exp; +&ok; + +## test network dq +$exp = '1.2.3.0/24'; +my $net = $dqip->network; +print 'got: ',$net, " exp: $exp\nnot " + unless $net eq $exp; +&ok; + +## test network hi +$exp = 'FF00:0:0:0:0:0:1:0/120'; +$net = $hiip->network; +print 'got: ',$net, " exp: $exp\nnot " + unless $net eq $exp; +&ok; + +## test network lo +$exp = '0:0:0:0:0:0:102:300/120'; +$net = $loip->network; +print 'got: ',$net, " exp: $exp\nnot " + unless $net eq $exp; +&ok; diff --git a/Lite/t/new-nth.t b/Lite/t/new-nth.t new file mode 100644 index 0000000..04db308 --- /dev/null +++ b/Lite/t/new-nth.t @@ -0,0 +1,44 @@ + +#use diagnostics; +use NetAddr::IP::Lite; + +$| = 1; + +sub ok() { + print 'ok ',$test++,"\n"; +} + +my $ip4 = NetAddr::IP::Lite->new('1.2.3.11/29'); + +my @try = qw( + 0 1.2.3.9 + 1 1.2.3.10 + 2 1.2.3.11 + 3 1.2.3.12 + 4 1.2.3.13 + 5 1.2.3.14 + 6 undef +); + +print '1..', (@try/2) +2, "\n"; + +$test = 1; + +for (my $i=0;$i<@try;$i+=2) { + my $rv = $ip4->nth($try[$i]); + $rv = defined $rv + ? $rv->addr + : 'undef'; + print "got: $rv, exp: $try[$i+1]\nnot " + unless $rv eq $try[$i+1]; + &ok; +} + +print "got: $_, exp: 1\nnot " + unless ($_ = NetAddr::IP::Lite->new('1.2.3.4/32')->num()) && $_ == 1; +&ok; + +print "got: $_, exp: 0\nnot " + unless defined ($_ = NetAddr::IP::Lite->new('1.2.3.4/31')->num()) && $_ == 0; +&ok; + diff --git a/Lite/t/new-num.t b/Lite/t/new-num.t new file mode 100644 index 0000000..b8563f6 --- /dev/null +++ b/Lite/t/new-num.t @@ -0,0 +1,33 @@ + +#use diagnostics; +use NetAddr::IP::Lite; + +$| = 1; + +sub ok() { + print 'ok ',$test++,"\n"; +} + +my @try = qw( + 10/32 1 + 10/31 0 + 10/30 2 + ::1/128 1 + ::1/127 0 + ::1/126 2 + 1.2.3.11/29 6 + FF::8B/125 6 +); + +print '1..',(@try/2),"\n"; + +$test = 1; + +foreach(my $i = 0;$i <=$#try;$i+= 2) { + my $ip = NetAddr::IP::Lite->new($try[$i]); + my $exp = $try[$i +1]; + + print "got: $_, exp: $exp\nnot " + unless ($_ = $ip->num) == $exp; + &ok; +} diff --git a/Lite/t/numeric.t b/Lite/t/numeric.t new file mode 100644 index 0000000..6e7759d --- /dev/null +++ b/Lite/t/numeric.t @@ -0,0 +1,36 @@ + +#use diagnostics; +use NetAddr::IP::Lite; + +$| = 1; + +print "1..6\n"; + +my $test = 1; +sub ok() { + print 'ok ',$test++,"\n"; +} + +my @tval = qw # IP bcd mask bcd +( 8000:0:0:0:0:0:0:1/112 170141183460469231731687303715884105729 340282366920938463463374607431768145920 + 1.2.3.4/24 16909060 4294967040 +); + +for (my $i=0;$i < @tval;$i+=3) { + my $nip = NetAddr::IP::Lite->new($tval[$i]); +## test scalar return + my $sclr = $nip->numeric; + print "got: $sclr\nexp: $tval[$i+1]\nnot " + unless $sclr .'x' eq $tval[$i+1] .'x'; + &ok; + +## test array return + my($addr,$mask) = $nip->numeric; + print "got: $addr\nexp: $tval[$i+1]\nnot " + unless $addr .'x' eq $tval[$i+1] .'x'; + &ok; + + print "got: $mask\nexp: $tval[$i+2]\nnot " + unless $mask .'x' eq $tval[$i+2] .'x'; + &ok; +} diff --git a/Lite/t/old-nth.t b/Lite/t/old-nth.t new file mode 100644 index 0000000..ed20b14 --- /dev/null +++ b/Lite/t/old-nth.t @@ -0,0 +1,36 @@ + +#use diagnostics; +use NetAddr::IP::Lite qw(:old_nth); + +$| = 1; + +print "1..9\n"; + +my $test = 1; +sub ok() { + print 'ok ',$test++,"\n"; +} + +my $ip4 = NetAddr::IP::Lite->new('1.2.3.11/29'); + +my @try = qw( + 0 undef + 1 1.2.3.9 + 2 1.2.3.10 + 3 1.2.3.11 + 4 1.2.3.12 + 5 1.2.3.13 + 6 1.2.3.14 + 7 1.2.3.15 + 8 undef +); + +for (my $i=0;$i<@try;$i+=2) { + my $rv = $ip4->nth($try[$i]); + $rv = defined $rv + ? $rv->addr + : 'undef'; + print "got: $rv, exp: $try[$i+1]\nnot " + unless $rv eq $try[$i+1]; + &ok; +} diff --git a/Lite/t/old-num.t b/Lite/t/old-num.t new file mode 100644 index 0000000..f550054 --- /dev/null +++ b/Lite/t/old-num.t @@ -0,0 +1,33 @@ + +#use diagnostics; +use NetAddr::IP::Lite qw(:old_nth); + +$| = 1; + +sub ok() { + print 'ok ',$test++,"\n"; +} + +my @try = qw( + 10/32 0 + 10/31 1 + 10/30 3 + ::1/128 0 + ::1/127 1 + ::1/126 3 + 1.2.3.11/29 7 + FF::8B/125 7 +); + +print '1..',(@try/2),"\n"; + +$test = 1; + +foreach(my $i = 0;$i <=$#try;$i+= 2) { + my $ip = NetAddr::IP::Lite->new($try[$i]); + my $exp = $try[$i +1]; + + print "got: $_, exp: $exp\nnot " + unless ($_ = $ip->num) == $exp; + &ok; +} diff --git a/Lite/t/over-qq.t b/Lite/t/over-qq.t new file mode 100644 index 0000000..7571156 --- /dev/null +++ b/Lite/t/over-qq.t @@ -0,0 +1,53 @@ +use NetAddr::IP::Lite; + +my @addr = ('10.0.0.0/8', '192.168.0.0/16', '127.0.0.1/32'); + +$| = 1; + +print "1..", 5 * scalar @addr, "\n"; + +my $count = 1; + +for my $a (@addr) { + my $ip = new NetAddr::IP::Lite $a; + if ($a eq "$ip") { + print "ok $count\n"; + } + else { + print "not ok $count\n"; + } + ++ $count; + + if ($a eq $ip) { + print "ok $count\n"; + } + else { + print "not ok $count\n"; + } + ++ $count; + + if ($ip eq $a) { + print "ok $count\n"; + } + else { + print "not ok $count\n"; + } + ++ $count; + + if ($ip eq $ip) { + print "ok $count\n"; + } + else { + print "not ok $count\n"; + } + ++ $count; + + if ($ip == $ip) { + print "ok $count\n"; + } + else { + print "not ok $count\n"; + } + ++ $count; + +} diff --git a/Lite/t/over_comp.t b/Lite/t/over_comp.t new file mode 100644 index 0000000..16a0480 --- /dev/null +++ b/Lite/t/over_comp.t @@ -0,0 +1,66 @@ + +#use diagnostics; +use NetAddr::IP::Lite; + +$| = 1; + +print "1..21\n"; + +my $test = 1; +sub ok() { + print 'ok ',$test++,"\n"; +} + +my $four = new NetAddr::IP::Lite('::4'); +$four->{val} = 4; +my $five = new NetAddr::IP::Lite('::5'); +$five->{val} = 5; +my @t = ( +# arg1 arg2 < <= == >= > <=> cmp + $four, $four, 0, 1, 1, 1, 0, 0, 0, + $four, $five, 1, 1, 0, 0, 0, -1, -1, + $five, $four, 0, 0, 0, 1, 1, 1, 1, +); + +for (my $i = 0; $i< @t; $i+=9) { +## test '=' overloaded here + my $arg1 = $t[$i]; + my $arg2 = $t[$i+1]; + my ($lt,$le,$eq,$ge,$gt,$nc,$cmp) = @t[$i+2,$i+3,$i+4,$i+5,$i+6,$i+7,$i+8]; + +## test '<' + print "failed $arg1->{val} < $arg2->{val}, got: $_, exp: $lt\nnot " + unless ($_ = ($arg1 < $arg2)) == $lt; + &ok; + +## test '<=' + print "failed $arg1->{val} <= $arg2->{val}, got: $_, exp: $le\nnot " + unless ($_ = ($arg1 <= $arg2)) == $le; + &ok; + +## test '==' + print "failed $arg1->{val} == $arg2->{val}, got: $_, exp: $eq\nnot " + unless ($_ = ($arg1 == $arg2)) == $eq; + &ok; + +## test '>=' + print "failed $arg1->{val} >= $arg2->{val}, got: $_, exp: $ge\nnot " + unless ($_ = ($arg1 >= $arg2)) == $ge; + &ok; + +## test '>' + print "failed $arg1->{val} > $arg2->{val}, got: $_, exp: $gt\nnot " + unless ($_ = ($arg1 > $arg2)) == $gt; + &ok; + +## test '<=>' + print "failed $arg1->{val} <=> $arg2->{val}, got: $_, exp: $nc\nnot " + unless ($_ = ($arg1 <=> $arg2)) == $nc; + &ok; + +## test 'cmp' + print "failed $arg1->{val} cmp $arg2->{val}, got: $_, exp: $cmp\nnot " + unless ($_ = ($arg1 cmp $arg2)) == $cmp; + &ok; +} + diff --git a/Lite/t/over_copy.t b/Lite/t/over_copy.t new file mode 100644 index 0000000..1c4bc88 --- /dev/null +++ b/Lite/t/over_copy.t @@ -0,0 +1,85 @@ + +#use diagnostics; +use NetAddr::IP::Lite 0.10; +*Ones = \&NetAddr::IP::Lite::Ones; +use NetAddr::IP::Util qw( + ipv6_aton + shiftleft +); +$| = 1; + +print "1..8\n"; + +my $test = 1; +sub ok() { + print 'ok ',$test++,"\n"; +} + +my $ip24 = '1.2.3.4/24'; +my $o = new NetAddr::IP::Lite($ip24); +my $c = $o; + +## test 1 validate original +my $txto = sprintf("%s",$o); +my $txtc = sprintf("%s",$c); +print "orig... got: $txto, exp: $ip24\nnot " + unless $txto eq $ip24; +&ok; + +## test 2 +print "copy... got: $txtc, exp: $ip24\nnot " + unless $txtc eq $ip24; +&ok; + +my $ip28 = '1.2.3.4/28'; +my $mask = shiftleft(Ones(),32 - 28); + +$c->{mask} = $mask; +$txto = sprintf("%s",$o); +$txtc = sprintf("%s",$c); + +## overload does not unlink originals in this case +## test 3 validate original +$txto = sprintf("%s",$o); +$txtc = sprintf("%s",$c); +print "orig... got: $txto, exp: $ip28\nnot " + unless $txto eq $ip28; +&ok; + +## test 4 +print "copy... got: $txtc, exp: $ip28\nnot " + unless $txtc eq $ip28; +&ok; + +my $ip265 = '1.2.3.5/26'; +my $ip285 = '1.2.3.5/28'; +$mask = shiftleft(Ones(),32 - 26); + +## test 5 overload seperates variables +$c++; +## validate original +$txto = sprintf("%s",$o); +$txtc = sprintf("%s",$c); +print "orig... got: $txto, exp: $ip28\nnot " + unless $txto eq $ip28; +&ok; + +## test 6 check mutated copy +print "copy... got: $txtc, exp: $ip285\nnot " + unless $txtc eq $ip285; +&ok; + +## test 7 check seperation +$c->{mask} = $mask; +## validate original +$txto = sprintf("%s",$o); +$txtc = sprintf("%s",$c); +print "orig... got: $txto, exp: $ip28\nnot " + unless $txto eq $ip28; +&ok; + +## test 8 check mutated copy +print "copy... got: $txtc, exp: $ip265\nnot " + unless $txtc eq $ip265; +&ok; + diff --git a/Lite/t/over_equal.t b/Lite/t/over_equal.t new file mode 100644 index 0000000..626fa31 --- /dev/null +++ b/Lite/t/over_equal.t @@ -0,0 +1,63 @@ + +#use diagnostics; +use NetAddr::IP::Lite; + +$| = 1; + +print "1..8\n"; + +my $test = 1; +sub ok() { + print 'ok ',$test++,"\n"; +} + +my $four = new NetAddr::IP::Lite('0.0.0.4'); # same as 0.0.0.4/32 +my $four120 = new NetAddr::IP::Lite('::4/120'); # same as 0.0.0.4/24 + +my $t432 = '0.0.0.4/32'; +my $t4120 = '0:0:0:0:0:0:0:4/120'; + +## test '""' overload +my $txt = sprintf ("%s",$four120); + +print "got: $txt, exp: $t4120\nnot " + unless $txt eq $t4120; +&ok; + +## test '""' again +$txt = sprintf ("%s",$four); + +print "got: $txt, exp: $t432\nnot " + unless $txt eq $t432; +&ok; + +## test 'eq' to scalar +print 'failed ',$four," eq $t432\nnot " + unless $four eq $t432; +&ok; + +## test scalar 'eq' to +print "failed $t432 eq ",$four,"\nnot " + unless $t432 eq $four; +&ok; + +## test 'eq' to self +print 'failed ',$four,' eq ', $four,"\nnot " + unless $four eq $four; +&ok; + +## test 'eq' cidr != +print 'failed ',$four,' should not eq ',$four120,"\nnot " + if $four eq $four120; +&ok; + +## test '==' not for scalars +print "failed scalar $t432 should not == ",$four,"\nnot " + if $t432 == $four; +&ok; + +## test '== not for scalar, reversed args +print 'failed scalar ',$four," should not == $t432\nnot " + if $four == $t432; +&ok; + diff --git a/Lite/t/over_math.t b/Lite/t/over_math.t new file mode 100644 index 0000000..a912ef7 --- /dev/null +++ b/Lite/t/over_math.t @@ -0,0 +1,64 @@ + +#use diagnostics; +use NetAddr::IP::Lite; + +$| = 1; + +print "1..7\n"; + +my $test = 1; +sub ok() { + print 'ok ',$test++,"\n"; +} + +my $ip = new NetAddr::IP::Lite('0.0.0.4/24'); + +## test '+' +my $exp = '0.0.0.132/24'; +my $nip = $ip + 128; +print 'got: ',$nip," exp: $exp\nnot " + unless $nip eq $exp; +&ok; + +## test '+' wrap around +$nip = $ip + 257; +$exp = '0.0.0.5/24'; +print 'got: ',$nip," exp: $exp\nnot " + unless $nip eq $exp; +&ok; + +## test '-' and wrap +$nip = $ip - 10; +$exp = '0.0.0.250/24'; +print 'got: ',$nip," exp: $exp\nnot " + unless $nip eq $exp; +&ok; + +## test '++' post +$nip++; +$exp = '0.0.0.251/24'; +print 'got: ',$nip," exp: $exp\nnot " + unless $nip eq $exp; +&ok; + +## test '++' pre +++$nip; +$exp = '0.0.0.252/24'; +print 'got: ',$nip," exp: $exp\nnot " + unless $nip eq $exp; +&ok; + +## test '--' post +$ip--; +$exp = '0.0.0.3/24'; +print 'got: ',$ip," exp: $exp\nnot " + unless $ip eq $exp; +&ok; + +## test '--' pre +--$ip; +$exp = '0.0.0.2/24'; +print 'got: ',$ip," exp: $exp\nnot " + unless $ip eq $exp; +&ok; + diff --git a/Lite/t/pathological.t b/Lite/t/pathological.t new file mode 100644 index 0000000..deaafc6 --- /dev/null +++ b/Lite/t/pathological.t @@ -0,0 +1,27 @@ + +#use diagnostics; +use NetAddr::IP::Lite; + +END {print "1..1\nnot ok 1\n" unless $test}; + +$| = 1; + +$test = 1; +sub ok() { + print 'ok ',$test++,"\n"; +} + +my @addrs = # pathological cases should fail +qw( ::foo + ::f00/129 + ::f00/150 +); + +print '1..',(scalar @addrs),"\n"; + +my $ip; +foreach(@addrs) { + print "expected undef, got: $ip\nnot " + if ($ip = new NetAddr::IP::Lite($_)); + &ok; +} diff --git a/Lite/t/range.t b/Lite/t/range.t new file mode 100644 index 0000000..cd43053 --- /dev/null +++ b/Lite/t/range.t @@ -0,0 +1,34 @@ + +#use diagnostics; +use NetAddr::IP::Util qw( + inet_ntoa + ipv6_n2x +); +use NetAddr::IP::Lite; + +$| = 1; + +print "1..2\n"; + +my $test = 1; +sub ok() { + print 'ok ',$test++,"\n"; +} + +my $loip = new NetAddr::IP::Lite('1.2.3.4/24'); +my $hiip = new NetAddr::IP::Lite('FF00::4/120'); + +## test range + +my $exp = 'FF00:0:0:0:0:0:0:0 - FF00:0:0:0:0:0:0:FF'; +my $txt = $hiip->range; +print "got: $txt, exp: $exp\nnot " + unless $txt eq $exp; +&ok; + +$exp = '1.2.3.0 - 1.2.3.255'; +$txt = $loip->range; +print "got: $txt, exp: $exp\nnot " + unless $txt eq $exp; +&ok; + diff --git a/Lite/t/relops.t b/Lite/t/relops.t new file mode 100644 index 0000000..0c09a50 --- /dev/null +++ b/Lite/t/relops.t @@ -0,0 +1,59 @@ +use NetAddr::IP::Lite; + +BEGIN { +@gt = ( + [ '255.255.255.255/32', '0.0.0.0/0' ], + [ 'ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff', '::/0' ], + [ '10.0.1.0/16', '10.0.0.1/24' ], + [ '10.0.0.1/24', '10.0.0.0/24' ], + [ 'deaf:beef::1/64', 'dead:beef::/64' ], + ); + +@ngt = ( + [ '0.0.0.0/0', '255.255.255.255/32' ], + [ '::/0', 'ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff' ], + [ '10.0.0.0/24', '10.0.0.0/24' ], + [ 'dead:beef::/60', 'dead:beef::/60' ], + ); + +@cmp = ( + [ '0.0.0.0/0', '255.255.255.255/32', -1 ], + [ '::/0', 'ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff', -1 ], + [ '10.0.0.0/16', '10.0.0.0/8', 1 ], + [ 'dead:beef::/60', 'dead:beef::/40', 1 ], + [ '10.0.0.0/24', '10.0.0.0/8', 1 ], + [ '255.255.255.255/32', '0.0.0.0/0', 1 ], + [ 'ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff', '::/0', 1 ], + [ '142.52.5.87', '142.52.2.88', 1 ], + [ '10.0.0.0/24', '10.0.0.0/24', 0 ], + [ 'default', 'default', 0 ], + [ 'broadcast', 'broadcast', 0], + [ 'loopback', 'loopback', 0], + ); + +}; + +use Test::More tests => @gt + @ngt + (2 * @cmp); + +for my $a (@gt) { + $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::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::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]"); +} + diff --git a/Lite/t/v4-aton.t b/Lite/t/v4-aton.t new file mode 100644 index 0000000..10b0871 --- /dev/null +++ b/Lite/t/v4-aton.t @@ -0,0 +1,38 @@ +use Test::More tests => 18; +use Socket; + +my @addr = ( + [ 'localhost', '127.0.0.1' ], + [ 'broadcast', '255.255.255.255' ], + [ '254.254.0.1', '254.254.0.1' ], + [ 'default', '0.0.0.0' ], + [ '10.0.0.1', '10.0.0.1' ], + +); + +# Verify that Accept_Binary_IP works... + +SKIP: +{ + skip "Failed to load NetAddr::IP::Lite", 17 + unless use_ok('NetAddr::IP::Lite'); + + ok(! defined NetAddr::IP::Lite->new("\1\1\1\1"), + "binary unrecognized by default..."); + + # This mimicks the actual use with :aton + NetAddr::IP::Lite::import(':aton'); + + ok(defined NetAddr::IP::Lite->new("\1\1\1\1"), + "...but can be recognized"); + + is(NetAddr::IP::Lite->new($_->[0])->aton, inet_aton($_->[1]), "->aton($_->[0])") + for @addr; + + ok(defined NetAddr::IP::Lite->new(inet_aton($_->[1])), "->new aton($_->[1])") + for @addr; + + is(NetAddr::IP::Lite->new(inet_aton($_->[1]))->addr, $_->[1], + "->new aton($_->[1])") + for @addr; +} diff --git a/Lite/t/v4-badnm.t b/Lite/t/v4-badnm.t new file mode 100644 index 0000000..3a5dc55 --- /dev/null +++ b/Lite/t/v4-badnm.t @@ -0,0 +1,42 @@ +# I know this does not look like -*- perl -*-, but I swear it is... + +use strict; +use Test::More; + +$| = 1; + +my @badnets = ( + '10.10.10.10/255.255.0.255', + '10.10.10.10/255.0.255.255', + '10.10.10.10/0.255.255.255', + '10.10.10.10/128.255.0.255', + '10.10.10.10/255.128.0.255', + '10.10.10.10/255.255.255.129', + '10.10.10.10/255.255.129.0', + '10.10.10.10/255.255.255.130', + '10.10.10.10/255.255.130.0', + '10.10.10.10/255.0.0.1', + '10.10.10.10/255.129.0.1', + '10.10.10.10/0.255.0.255', + '58.26.0.0-58.27.127.255', # Taken from APNIC's WHOIS case +); + +my @goodnets = (); + +push @goodnets, "10.0.0.1/$_" for (0 .. 32); +push @goodnets, "10.0.0.1/255.255.255.255"; + +plan tests => 1 + @badnets + @goodnets; + +die "# Cannot continue without NetAddr::IP::Lite\n" + unless use_ok('NetAddr::IP::Lite'); + +my $count = 1; + +ok(! defined NetAddr::IP::Lite->new($_), "new $_ should fail") + for @badnets; + +ok(defined NetAddr::IP::Lite->new($_), "new $_ should work") + for @goodnets; + + diff --git a/Lite/t/v4-base.t b/Lite/t/v4-base.t new file mode 100644 index 0000000..b8e81bc --- /dev/null +++ b/Lite/t/v4-base.t @@ -0,0 +1,19 @@ +use NetAddr::IP::Lite; + +my @addr = (qw( 127.0.0.1 10.0.0.1 )); +my @mask = (qw( 255.0.0.0 255.255.0.0 255.255.255.0 255.255.255.255 )); + +$| = 1; +print "1..", (2 * scalar @addr * scalar @mask), "\n"; + +my $count = 1; + +for my $a (@addr) { + for my $m (@mask) { + my $ip = new NetAddr::IP::Lite $a, $m; + print (($ip->addr ne $a ? 'not ' : ''), "ok ", $count++, "\n"); + print (($ip->mask ne $m ? 'not ' : ''), "ok ", $count++, "\n"); + } +} + + diff --git a/Lite/t/v4-basem.t b/Lite/t/v4-basem.t new file mode 100644 index 0000000..516f50d --- /dev/null +++ b/Lite/t/v4-basem.t @@ -0,0 +1,24 @@ +use NetAddr::IP::Lite; + +my $nets = { + '10.0.0.16' => [ 24, '10.0.0.255', '10.0.0.0' ], + '127.0.0.1' => [ 8, '127.255.255.255', '127.0.0.0' ], + '192.168.0.10' => [ 17, '192.168.127.255', '192.168.0.0' ], +}; + +$| = 1; +print "1..", (2 * scalar keys %$nets), "\n"; + +my $count = 1; + +for my $a (keys %$nets) { + my $ip = new NetAddr::IP::Lite $a, $nets->{$a}->[0]; + print '', (($ip->broadcast->addr ne $nets->{$a}->[1] ? + 'not ' : ''), + "ok ", $count++, "\n"); + print '', (($ip->network->addr ne $nets->{$a}->[2] ? + 'not ' : ''), + "ok ", $count++, "\n"); +} + + diff --git a/Lite/t/v4-cidr.t b/Lite/t/v4-cidr.t new file mode 100644 index 0000000..b96f38f --- /dev/null +++ b/Lite/t/v4-cidr.t @@ -0,0 +1,28 @@ +use NetAddr::IP::Lite; + +$| = 1; + +my @addr = (qw( + 0.0.0.0/0 + 1.0.0.0/1 + 2.0.0.0/2 + 10.0.0.0/8 + 10.0.120.0/24 + 161.196.66.0/25 + 255.255.255.255/32 + )); + +print '1..', scalar @addr, "\n"; + +my $count = 1; + +for my $a (@addr) { + my $ip = new NetAddr::IP::Lite $a; + if ($ip->cidr eq $a) { + print "ok ", $count ++, "\n"; + } + else { + print "not ok ", $count ++, "\n"; + print "$a -> ", $ip->cidr, " [", $ip->mask, "]\n"; + } +} diff --git a/Lite/t/v4-cnew.t b/Lite/t/v4-cnew.t new file mode 100644 index 0000000..34258ff --- /dev/null +++ b/Lite/t/v4-cnew.t @@ -0,0 +1,26 @@ +use NetAddr::IP::Lite; + +my @subnets = ( + [ '127.1', '127.0.0.1/32' ], + [ '127.1/16', '127.1.0.0/16' ], + [ '10.10.10', '10.10.0.10/32' ], + [ '10.10.10/24', '10.10.10.0/24' ], + ); + +$| = 1; + +print '1..', (scalar @subnets) , "\n"; + +my $count = 1; + +for my $n (@subnets) { + my $ip = new NetAddr::IP::Lite $n->[0]; + if ($ip eq $n->[1]) { + print "ok $count\n"; + } + else { + print "not ok $count\n"; + } + + ++ $count; +} diff --git a/Lite/t/v4-contains.t b/Lite/t/v4-contains.t new file mode 100644 index 0000000..8c877ea --- /dev/null +++ b/Lite/t/v4-contains.t @@ -0,0 +1,60 @@ +use NetAddr::IP::Lite; + +my @yes_pairs = ( + [ [ '127.0.0.0', '255.0.0.0' ], + [ '127.0.0.1', '255.255.255.255'] ], + [ [ '10.0.0.0', '255.255.255.0' ], + [ '10.0.0.128', '255.255.255.128' ] ], + [ [ '10.0.0.0', '255.0.0.0' ], + [ '10.0.0.0', '255.0.0.0' ]], + [ [ '10.0.0.0', '255.0.0.0' ], + [ '10.0.0.1', '255.0.0.0' ]], + [ [ '10.0.0.0', '255.255.255.254' ], + [ '10.0.0.1', '255.255.255.254' ]], + [ [ '10.0.0.0', '255.255.255.254' ], + [ '10.0.0.1', '255.255.255.255' ]], + [ [ '10.0.0.1', '255.0.0.0' ], + [ '10.0.0.1', '255.255.255.255' ]], + [ [ 'default', 'default' ], + [ '10.0.0.1', '255.255.255.254' ]], + [ [ 'default', 'default' ], + [ 'broadcast', undef ]], + [ [ 'loopback', '255.0.0.0' ], + [ '127.0.0.0', '255.0.0.0' ] ], + ); + +my @no_pairs = ( + [ [ '127.0.0.1', '255.255.255.255' ], + [ '127.0.0.0', '255.0.0.0' ] ], + [ [ '10.0.0.0', '255.0.0.0' ], + [ '11.0.0.0', '255.0.0.0' ] ], + [ [ '10.0.1.0', '255.255.255.0' ], + [ '10.0.2.0', '255.255.255.0' ] ], + [ [ '10.0.0.1', '255.255.255.254' ], + [ 'default', '0' ] ], + ); + +$| = 1; +print "1..", 2 * (scalar @yes_pairs + scalar @no_pairs), "\n"; + +my $count = 1; + +for my $p (@yes_pairs) { + my $ip_a = new NetAddr::IP::Lite $p->[0]->[0], $p->[0]->[1]; + my $ip_b = new NetAddr::IP::Lite $p->[1]->[0], $p->[1]->[1]; + print (($ip_a->contains($ip_b) ? '' : 'not '), 'ok ', $count++, "\n"); + print (($ip_b->within($ip_a) ? '' : 'not '), 'ok ', $count++, "\n"); + +# print "a = ", $ip_a->addr, "/", $ip_a->mask, "\n"; +# print "b = ", $ip_b->addr, "/", $ip_b->mask, "\n"; + +} + +for my $p (@no_pairs) { + my $ip_a = new NetAddr::IP::Lite $p->[0]->[0], $p->[0]->[1]; + my $ip_b = new NetAddr::IP::Lite $p->[1]->[0], $p->[1]->[1]; + print (($ip_a->contains($ip_b) ? 'not ' : ''), 'ok ', $count++, "\n"); + print (($ip_b->within($ip_a) ? 'not ' : ''), 'ok ', $count++, "\n"); +} + + diff --git a/Lite/t/v4-last.t b/Lite/t/v4-last.t new file mode 100644 index 0000000..9e374f9 --- /dev/null +++ b/Lite/t/v4-last.t @@ -0,0 +1,32 @@ +use NetAddr::IP::Lite; + +my %w = ('default' => [ '255.255.255.254', '0.0.0.0' ], + 'loopback' => [ '127.255.255.254', '255.0.0.0' ], + '127.0.0.1/8' => [ '127.255.255.254', '255.0.0.0' ], + '10.' => [ '10.255.255.254', '255.0.0.0' ], + '10.10.10/24' => [ '10.10.10.254', '255.255.255.0' ], + ); + +$| = 1; + +print '1..', (2 * scalar keys %w), "\n"; + +my $count = 1; + +for my $a (keys %w) { + my $ip = NetAddr::IP::Lite->new($a)->last; + + if ($ip->addr eq $w{$a}->[0]) { + print "ok ", $count++, "\n"; + } + else { + print "not ok ", $count++, "\n"; + } + + if ($ip->mask eq $w{$a}->[1]) { + print "ok ", $count++, "\n"; + } + else { + print "not ok ", $count++, "\n"; + } +} diff --git a/Lite/t/v4-new-first.t b/Lite/t/v4-new-first.t new file mode 100644 index 0000000..fc0ecfd --- /dev/null +++ b/Lite/t/v4-new-first.t @@ -0,0 +1,30 @@ +use NetAddr::IP::Lite; + +my $nets = { + '10.0.0.16' => [ 24, '10.0.0.1', '10.0.0.254', '10.0.0.11'], + '10.0.0.5' => [ 30, '10.0.0.5', '10.0.0.6', 'undef' ], + '10.128.0.1' => [ 8, '10.0.0.1', '10.255.255.254', '10.0.0.11'], + '10.128.0.1' => [ 24, '10.128.0.1', '10.128.0.254', '10.128.0.11'], +}; + +$| = 1; +print "1..", (3 * scalar keys %$nets), "\n"; + +my $count = 1; + +for my $a (keys %$nets) { + my $ip = new NetAddr::IP::Lite $a, $nets->{$a}->[0]; + print '', (($ip->first->addr ne $nets->{$a}->[1] ? + 'not ' : ''), + "ok ", $count++, "\n"); + print '', (($ip->last->addr ne $nets->{$a}->[2] ? + 'not ' : ''), + "ok ", $count++, "\n"); + + my $new = $ip->nth(10); + print '', (((defined $new ? $new->addr : 'undef') ne $nets->{$a}->[3] ? + 'not ' : ''), + "ok ", $count++, "\n"); +} + + diff --git a/Lite/t/v4-new.t b/Lite/t/v4-new.t new file mode 100644 index 0000000..e629f89 --- /dev/null +++ b/Lite/t/v4-new.t @@ -0,0 +1,64 @@ +use NetAddr::IP::Lite; + +use Test::More; + +my $binword; +{ + local $SIG{__WARN__} = sub {}; + $binword = eval "0b11111111111111110000000000000000"; +} +if ($@) { + $binword = 0xffff0000; + print STDERR "\t\tskipped! 0b11111111111111110000000000000000\n\t\tbinary bit strings unsupported in Perl version $]\n"; +} + +@a = ( + [ 'localhost', '127.0.0.1' ], + [ 0x01010101, '1.1.1.1' ], + [ 1, '1.0.0.0' ], # Because it will have a mask. 0.0.0.1 ow + [ 'default', '0.0.0.0' ], + [ 'any', '0.0.0.0' ], + [-809041407, '207.199.2.1'], + [3485925889, '207.199.2.1'], +); + +@m = ( + [ 0, '0.0.0.0' ], + [ 1, '128.0.0.0' ], + [ 2, '192.0.0.0' ], + [ 4, '240.0.0.0' ], + [ 8, '255.0.0.0' ], + [ 16, '255.255.0.0' ], + [ 17, '255.255.128.0' ], + [ 24, '255.255.255.0' ], + [ 'default', '0.0.0.0' ], + [ 32, '255.255.255.255' ], + [ 'host', '255.255.255.255' ], + [ 0xffffff00, '255.255.255.0' ], + [ '255.255.255.240', '255.255.255.240' ], + [ '255.255.128.0', '255.255.128.0' ], + [ $binword, '255.255.0.0' ], +); + +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"); + +for my $a (@a) { + for my $m (@m) { + my $ip = new NetAddr::IP::Lite $a->[0], $m->[0]; + SKIP: + { + skip "Failed to make an object for $a->[0]/$m->[0]", 4 + unless defined $ip; + is($ip->addr, $a->[1], "$a->[0] / $m->[0] is $a->[1]"); + is($ip->mask, $m->[1], "$a->[0] / $m->[0] is $m->[1]"); + is($ip->bits, 32, "$a->[0] / $m->[0] is 32 bits wide"); + is($ip->version, 4, "$a->[0] / $m->[0] is version 4"); + }; + } +} + diff --git a/Lite/t/v4-num.t b/Lite/t/v4-num.t new file mode 100644 index 0000000..667e3c1 --- /dev/null +++ b/Lite/t/v4-num.t @@ -0,0 +1,35 @@ +use NetAddr::IP::Lite; + +my $nets = { + '10.1.2.3' => [ 32, 0 ], + '10.2.3.4' => [ 31, 1 ], + '10.0.0.16' => [ 24, 255 ], + '10.128.0.1' => [ 8, 2 ** 24 - 1 ], + '10.0.0.5' => [ 30, 3 ], +}; + +my $new = 1; # flag for old vs new numeric returns + +$| = 1; + +$test = keys %$nets; +$test *= 2; +print "1..", $test, "\n"; + +$test = 1; +sub tst { + for my $a (keys %$nets) { + my $nc = $nets->{$a}->[1] - $new; # net count + $nc = 1 if $nc < 0; + my $ip = new NetAddr::IP::Lite $a, $nets->{$a}->[0]; + print "got: $_, exp: $nc\nnot " + unless $ip->num == $nc; + print "ok ", $test++, "\n"; + } +} + +tst(); + +import NetAddr::IP::Lite qw(:old_nth); +$new = 0; +tst(); diff --git a/Lite/t/v4-numeric.t b/Lite/t/v4-numeric.t new file mode 100644 index 0000000..fb900f2 --- /dev/null +++ b/Lite/t/v4-numeric.t @@ -0,0 +1,36 @@ +use NetAddr::IP::Lite; + +my $nets = { + '10.0.0.0/20' => [ 167772160, 4294963200 ], + '10.0.15.0/24' => [ 167776000, 4294967040 ], + '192.168.0.0/24' => [ 3232235520, 4294967040], + 'broadcast' => [ 4294967295, 4294967295], + 'default' => [ 0, 0 ], +}; + +$| = 1; +print "1..", 4 * (scalar keys %$nets), "\n"; + +my $count = 1; + +for my $a (keys %$nets) { + my $ip = new NetAddr::IP::Lite $a; + my ($addr, $mask) = $ip->numeric; + + my $nip = new NetAddr::IP::Lite $addr, $mask; + + print '', ($nip ? '' : 'not '), 'ok ', $count++, "\n"; + + print '', ($nip and $nip->cidr eq $ip->cidr) ? '' : 'not ', + 'ok ', $count ++, "\n"; + + print '', (($addr != $nets->{$a}->[0] ? 'not ' : ''), + "ok ", $count++, "\n"); + + print '', (($mask != $nets->{$a}->[1] ? 'not ' : ''), + "ok ", $count++, "\n"); + + +} + + diff --git a/Lite/t/v4-old-first.t b/Lite/t/v4-old-first.t new file mode 100644 index 0000000..1ad05a2 --- /dev/null +++ b/Lite/t/v4-old-first.t @@ -0,0 +1,30 @@ +use NetAddr::IP::Lite qw(:old_nth); + +my $nets = { + '10.0.0.16' => [ 24, '10.0.0.1', '10.0.0.254', '10.0.0.10'], + '10.0.0.5' => [ 30, '10.0.0.5', '10.0.0.6', 'undef' ], + '10.128.0.1' => [ 8, '10.0.0.1', '10.255.255.254', '10.0.0.10'], + '10.128.0.1' => [ 24, '10.128.0.1', '10.128.0.254', '10.128.0.10'], +}; + +$| = 1; +print "1..", (3 * scalar keys %$nets), "\n"; + +my $count = 1; + +for my $a (keys %$nets) { + my $ip = new NetAddr::IP::Lite $a, $nets->{$a}->[0]; + print '', (($ip->first->addr ne $nets->{$a}->[1] ? + 'not ' : ''), + "ok ", $count++, "\n"); + print '', (($ip->last->addr ne $nets->{$a}->[2] ? + 'not ' : ''), + "ok ", $count++, "\n"); + + my $new = $ip->nth(10); + print '', (((defined $new ? $new->addr : 'undef') ne $nets->{$a}->[3] ? + 'not ' : ''), + "ok ", $count++, "\n"); +} + + diff --git a/Lite/t/v4-range.t b/Lite/t/v4-range.t new file mode 100644 index 0000000..2a96ef5 --- /dev/null +++ b/Lite/t/v4-range.t @@ -0,0 +1,48 @@ +use NetAddr::IP::Lite; + +use Test::More; + +my @ranges = ( + [ '10.0.0.0/8', '10.0.0.0', '10.255.255.255' ], + [ '192.168.0.0/16', '192.168.0.0', '192.168.255.255' ], + ); + +my @weird = ( + [ '128.111.12.0', '128.111.12.129' ], + ); + +plan tests => 6 * @ranges + 2 * @weird + 28; + +for my $r (@ranges) { + my $r1 = new NetAddr::IP::Lite $r->[1] . '-' . $r->[2]; + isa_ok($r1, 'NetAddr::IP::Lite'); + is($r1, $r->[0], "Correct interpretation (with space)"); + + $r1 = new NetAddr::IP::Lite $r->[1] . ' - ' . $r->[2]; + isa_ok($r1, 'NetAddr::IP::Lite'); + is($r1, $r->[0], "Correct interpretation (w/o space)"); + + $r1 = new NetAddr::IP::Lite $r->[0]; + isa_ok($r1, 'NetAddr::IP::Lite'); + is($r1->range, $r->[1] . ' - ' . $r->[2], "Correct reverse"); +} + +for my $r (@weird) +{ + my $r1 = new NetAddr::IP::Lite $r->[0] . '-' . $r->[1]; + ok(! defined $r1, "Weird range w/o space produces undef"); + $r1 = new NetAddr::IP::Lite $r->[0] . ' - ' . $r->[1]; + ok(! defined $r1, "Weird range with space produces undef"); +} + +for my $o (254, 252, 248, 240, 224, 192, 128) +{ + my $r1 = new NetAddr::IP::Lite '0.0.0.0 - ' . $o . '.0.0.0'; + ok(! defined $r1, "Weird $o range, first octet"); + $r1 = new NetAddr::IP::Lite '0.0.0.0 - 0.' . $o . '.0.0'; + ok(! defined $r1, "Weird $o range, second octet"); + $r1 = new NetAddr::IP::Lite '0.0.0.0 - 0.0.' . $o . '.0'; + ok(! defined $r1, "Weird $o range, third octet"); + $r1 = new NetAddr::IP::Lite '0.0.0.0 - 0.0.0.' . $o; + ok(! defined $r1, "Weird $o range, fourth octet"); +} diff --git a/Lite/t/v4-snew.t b/Lite/t/v4-snew.t new file mode 100644 index 0000000..596f95d --- /dev/null +++ b/Lite/t/v4-snew.t @@ -0,0 +1,29 @@ +use Test::More; +use NetAddr::IP::Lite; + +my %w = ('broadcast' => [ '255.255.255.255', '255.255.255.255' ], + 'default' => [ '0.0.0.0', '0.0.0.0' ], + 'loopback' => [ '127.0.0.1', '255.0.0.0' ], + '10.' => [ '10.0.0.0', '255.0.0.0' ], + '10/8' => [ '10.0.0.0', '255.0.0.0' ], + '127/8' => [ '127.0.0.0', '255.0.0.0' ], + '11.11.' => [ '11.11.0.0', '255.255.0.0' ], + '12.12.12.' => [ '12.12.12.0', '255.255.255.0' ], + '13.13.13.13' => [ '13.13.13.13', '255.255.255.255' ], + '0-127' => [ '0.0.0.0', '128.0.0.0' ], + '128-255' => [ '128.0.0.0', '128.0.0.0' ], + '0-63' => [ '0.0.0.0', '192.0.0.0' ], + '128-191' => [ '128.0.0.0', '192.0.0.0' ], + '10.128.0-127' => [ '10.128.0.0', '255.255.128.0' ], + '10.10.10/24' => [ '10.10.10.0', '255.255.255.0' ], + '10.10/16' => [ '10.10.0.0', '255.255.0.0' ], + '10.10.10' => [ '10.10.0.10', '255.255.255.255' ], + ); + +plan tests => 2 * scalar keys %w; + +for my $a (keys %w) { + my $ip = new NetAddr::IP::Lite $a; + is($ip->addr, $w{$a}->[0], "Matching ->addr()"); + is($ip->mask, $w{$a}->[1], "Matching ->mask()"); +} diff --git a/Lite/t/v4-wnew.t b/Lite/t/v4-wnew.t new file mode 100644 index 0000000..22facb9 --- /dev/null +++ b/Lite/t/v4-wnew.t @@ -0,0 +1,21 @@ +use Test::More tests => 12; +use NetAddr::IP::Lite; + +my @good = (qw(default any broadcast loopback)); +my @bad = map { ("$_.neveranydomainlikethis", + "nohostlikethis.$_") } @good; + +ok(defined NetAddr::IP::Lite->new($_), "defined ->new($_)") + for @good; + +my $bad = scalar @bad; + +diag <new($_), "not defined ->new($_)") + for @bad; + diff --git a/Lite/t/v6-contains.t b/Lite/t/v6-contains.t new file mode 100644 index 0000000..584a06e --- /dev/null +++ b/Lite/t/v6-contains.t @@ -0,0 +1,51 @@ +use NetAddr::IP::Lite; +use Test::More; + +my @yes_pairs = + ( + [ '::/0', '2001:620:0:4:a00:20ff:fe9c:7e4a' ], + [ '3ffe:2000:0:4::/64', '3ffe:2000:0:4:a00:20ff:fe9c:7e4a' ], + [ '3ffe:2000:0:4::/64', '3ffe:2000:0:4:a00:20ff:fe9c:7e4a/65' ], + [ '2001:620:0:4::/64', '2001:620:0:4:a00:20ff:fe9c:7e4a' ], + [ '2001:620:0:4::/64', '2001:620:0:4:a00:20ff:fe9c:7e4a/65' ], + [ '2001:620:0:4::/64', '2001:620:0:4::1' ], + [ '2001:620:0:4::/64', '2001:620:0:4:0:0:0:1' ], + [ 'deaf:beef::/32', 'deaf:beef::1' ], + [ 'deaf:beef::/32', 'deaf:beef::1:1' ], + [ 'deaf:beef::/32', 'deaf:beef::1:0:1' ], + [ 'deaf:beef::/32', 'deaf:beef::1:0:0:1' ], + [ 'deaf:beef::/32', 'deaf:beef::1:0:0:0:1' ], + ); + +my @no_pairs = + ( + [ '3ffe:2000:0:4::/64', '3ffe:2000:0:4:a00:20ff:fe9c:7e4a/63' ], + [ '2001:620:0:4::/64', '2001:620:0:4:a00:20ff:fe9c:7e4a/63' ], + [ 'deaf:beef::/32', 'dead:cafe::1' ], + [ 'deaf:beef::/32', 'dead:cafe::1:1' ], + [ 'deaf:beef::/32', 'dead:cafe::1:0:1' ], + [ 'deaf:beef::/32', 'dead:cafe::1:0:0:1' ], + [ 'deaf:beef::/32', 'dead:cafe::1:0:0:0:1' ], + ); + +my $tests = 6 * @yes_pairs + 1; +plan tests => $tests; + +ok(NetAddr::IP::Lite->new('::')->contains(NetAddr::IP::Lite->new('::')), + ":: contains itself"); + +for my $p (@yes_pairs) +{ + my $a = new NetAddr::IP::Lite $p->[0]; + my $b = new NetAddr::IP::Lite $p->[1]; + + isa_ok($a, 'NetAddr::IP::Lite', "$p->[0]"); + isa_ok($b, 'NetAddr::IP::Lite', "$p->[1]"); + + SKIP: { + ok($a->contains($b), "->contains $p->[0], $p->[1] is true"); + ok($b->within($a), "->within $p->[1], $p->[0] is true"); + ok(!$b->contains($a), "->contains $p->[1], $p->[0] is false"); + ok(!$a->within($b), "->within $p->[0], $p->[1] is false"); + } +} diff --git a/Lite/t/v6-inc.t b/Lite/t/v6-inc.t new file mode 100644 index 0000000..fa51fe8 --- /dev/null +++ b/Lite/t/v6-inc.t @@ -0,0 +1,38 @@ +use Test::More; +use NetAddr::IP::Lite; + +# Test ++ in IPv6 addresses (Bug rt.cpan.org #7070 by a guest) + +@ip = (NetAddr::IP::Lite->new('2001:468:ff:fffe::2/64'), + NetAddr::IP::Lite->new('2001:468:ff:fffe::2/64'), + NetAddr::IP::Lite->new('2001:468:ff:fffe::2/64')); + +$ip[1] ++; +$ip[2] ++; $ip[2] ++; + +plan tests => 11; + +# Test correct v6 creation +isa_ok($_, 'NetAddr::IP::Lite') for @ip; + +# Test that we did actually do something +diag "$ip[0] -- $ip[1]" + unless ok($ip[0] != $ip[1], "Auto incremented once differ"); +diag "$ip[0] -- $ip[2]" + unless ok($ip[0] != $ip[2], "Auto incremented twice differ"); +diag "$ip[1] -- $ip[2]" + unless ok($ip[1] != $ip[2], "Auto incremented two times differ"); + +# Test that what we did is correct +is($ip[1], $ip[0] + 1, "Test of first auto-increment"); +is($ip[2], $ip[0] + 2, "Test of second auto-increment"); + +# Now test auto-decrement + +$ip[1] --; +$ip[2] --; $ip[2] --; + +is($ip[0], $ip[1], "Decrement of decrement once is ok"); +is($ip[0], $ip[2], "Decrement of decrement twice is ok"); +is($ip[1], $ip[2], "Third case"); + diff --git a/Lite/t/v6-new-base.t b/Lite/t/v6-new-base.t new file mode 100644 index 0000000..9a26065 --- /dev/null +++ b/Lite/t/v6-new-base.t @@ -0,0 +1,70 @@ +# This -*- perl -*- code excercises the basic v6 functionality + +sub mypass() {1} +sub myfail() {0} + +@addr = + ( + ['::', 3, '0:0:0:0:0:0:0:0/128',myfail], + ['::1', 3, '0:0:0:0:0:0:0:1/128',myfail], + ['F34::123/40', 2, 'F34:0:0:0:0:0:0:3/40',mypass], + ['DEAD:BEEF::1/40', 2, 'DEAD:BEEF:0:0:0:0:0:3/40',mypass], + ['1000::2/40', 0, '1000:0:0:0:0:0:0:1/40',mypass], + ['1000::2000/40', 0, '1000:0:0:0:0:0:0:1/40',mypass], + ['DEAD::CAFE/40', 0, 'DEAD:0:0:0:0:0:0:1/40',mypass], + ['DEAD:BEEF::1/40', 3, 'DEAD:BEEF:0:0:0:0:0:4/40',mypass], + ['DEAD:BEEF::1/40', 4, 'DEAD:BEEF:0:0:0:0:0:5/40',mypass], + ['DEAD:BEEF::1/40', 5, 'DEAD:BEEF:0:0:0:0:0:6/40',mypass], + ['DEAD:BEEF::1/40', 6, 'DEAD:BEEF:0:0:0:0:0:7/40',mypass], + ['DEAD:BEEF::1/40', 7, 'DEAD:BEEF:0:0:0:0:0:8/40',mypass], + ['DEAD:BEEF::1/40', 8, 'DEAD:BEEF:0:0:0:0:0:9/40',mypass], + ['DEAD:BEEF::1/40', 254, 'DEAD:BEEF:0:0:0:0:0:FF/40',mypass], + ['DEAD:BEEF::1/40', 255, 'DEAD:BEEF:0:0:0:0:0:100/40',mypass], + ['DEAD:BEEF::1/40', 256, 'DEAD:BEEF:0:0:0:0:0:101/40',mypass], + ['DEAD:BEEF::1/40', 65535, 'DEAD:BEEF:0:0:0:0:1:0/40',mypass], + ['DEAD:BEEF::1/40', 65536, 'DEAD:BEEF:0:0:0:0:1:1/40',mypass], + ['2001:620:0:4::/64', 0, '2001:620:0:4:0:0:0:1/64',mypass], + ['3FFE:2000:0:4::/64', 0, '3FFE:2000:0:4:0:0:0:1/64',mypass], + ['2001:620:600::1', 0, '2001:620:600:0:0:0:0:1/128',mypass], + ['2001:620:600:0:1::1', 0,'2001:620:600:0:1:0:0:1/128',mypass], + ); + +use NetAddr::IP::Lite; +use Test::More; + +my($a, $ip, $test); + +$test = 4 * @addr + 4; +plan tests => $test; + +$test = 1; + +sub tst { + for $a (@addr) { + $ip = new NetAddr::IP::Lite $a->[0]; + $a->[0] =~ s,/\d+,,; + isa_ok($ip, 'NetAddr::IP::Lite', "$a->[0] "); +# requires full NetAddr::IP +# is(uc $ip->short, $a->[0], "short returns $a->[0]"); + is($ip->bits, 128, "bits == 128"); + is($ip->version, 6, "version == 6"); + my $index = $a->[1]; + if ($a->[3]) { + is(uc $ip->nth($index), $a->[2], "nth $a->[0], $index"); + } else { + ok(!$ip->nth($index),"nth $a->[0], undef"); + } + } +} + +tst(); + + +$test = new NetAddr::IP::Lite 'f34::1'; +isa_ok($test, 'NetAddr::IP::Lite'); +ok($test->network->contains($test), "->contains"); + +$test = new NetAddr::IP::Lite 'f35::1/40'; +isa_ok($test, 'NetAddr::IP::Lite'); +ok($test->network->contains($test), "->contains"); + diff --git a/Lite/t/v6-numeric.t b/Lite/t/v6-numeric.t new file mode 100644 index 0000000..c9eddfb --- /dev/null +++ b/Lite/t/v6-numeric.t @@ -0,0 +1,91 @@ +use NetAddr::IP::Lite; +use Test::More; + +my @pairs = + ( + [ '::/0', '0', '0' ], + [ '::/128', '0', '340282366920938463463374607431768211455' ], + [ 'cafe:cafe::/64', + '269827015721314068804783158349174669312', + '340282366920938463444927863358058659840' ], + [ 'cafe:cafe::1/64', + '269827015721314068804783158349174669313', + '340282366920938463444927863358058659840' ], + [ 'dead:beef::/100', + '295990755014133383690938178081940045824', + '340282366920938463463374607431499776000' ], + [ 'dead:beef::1/100', + '295990755014133383690938178081940045825', + '340282366920938463463374607431499776000' ], + ); + +my @scale = +qw( + 0000:0000:0000:0000:0000:0000:0000:0000 + 0000:0000:0000:0000:0000:0000:0000:0001 + 0000:0000:0000:0000:0000:0000:0000:0010 + 0000:0000:0000:0000:0000:0000:0000:0100 + 0000:0000:0000:0000:0000:0000:0000:1000 + 0000:0000:0000:0000:0000:0000:0001:0000 + 0000:0000:0000:0000:0000:0001:0000:0000 + 0000:0000:0000:0000:0000:0010:0000:0000 + 0000:0000:0000:0000:0000:0100:0000:0000 + 0000:0000:0000:0000:0000:1000:0000:0000 + 0000:0000:0000:0000:0001:0000:0000:0000 + 0000:0000:0000:0001:0000:0000:0000:0000 + 0000:0000:0000:0010:0000:0000:0000:0000 + 0000:0000:0000:0100:0000:0000:0000:0000 + 0000:0000:0000:1000:0000:0000:0000:0000 + 0000:0000:0001:0000:0000:0000:0000:0000 + 0000:0001:0000:0000:0000:0000:0000:0000 + 0000:0010:0000:0000:0000:0000:0000:0000 + 0000:0100:0000:0000:0000:0000:0000:0000 + 0000:1000:0000:0000:0000:0000:0000:0000 + 0001:0000:0000:0000:0000:0000:0000:0000 + 0010:0000:0000:0000:0000:0000:0000:0000 + 0100:0000:0000:0000:0000:0000:0000:0000 + 1000:0000:0000:0000:0000:0000:0000:0000 + ); + +my $tests = 4 * @pairs + @scale ** 2; +plan tests => $tests; + +for my $p (@pairs) +{ + my $a = new NetAddr::IP::Lite $p->[0]; + isa_ok($a, 'NetAddr::IP::Lite', "$p->[0]"); + is($a->numeric, $p->[1], "$p->[0] Scalar numeric ok"); + is(($a->numeric)[0], $p->[1], "$p->[0] Array numeric ok for network"); + is(($a->numeric)[1], $p->[2], "$p->[0] Array numeric ok for mask"); +} + +@ip_scale = map { new NetAddr::IP::Lite $_ } @scale; + +isa_ok($_, 'NetAddr::IP::Lite', $_->addr) for @ip_scale; + +for my $i (0 .. $#ip_scale) +{ + for my $l (0 .. $i - 1) + { + next if $l >= $i; + unless (ok($ip_scale[$i]->numeric > $ip_scale[$l]->numeric, + "[$i, $l] $scale[$i] > $scale[$l]")) + { + diag "assertion [$i]: " . $ip_scale[$i]->numeric . + " > " . $ip_scale[$l]->numeric; + } + } + + next if $i == $#ip_scale; + + for my $l ($i + 1 .. $#ip_scale) + { + next if $l <= $i; + unless (ok($ip_scale[$i]->numeric < $ip_scale[$l]->numeric, + "[$i, $l] $scale[$i] < $scale[$l]")) + { + diag "assertion [$i]: " . $ip_scale[$i]->numeric . + " < " . $ip_scale[$l]->numeric; + } + } +} diff --git a/Lite/t/v6-old-base.t b/Lite/t/v6-old-base.t new file mode 100644 index 0000000..0bbf088 --- /dev/null +++ b/Lite/t/v6-old-base.t @@ -0,0 +1,70 @@ +# This -*- perl -*- code excercises the basic v6 functionality + +sub mypass() {1} +sub myfail() {0} + +@addr = + ( + ['::', 3, '0:0:0:0:0:0:0:0/128',myfail], + ['::1', 3, '0:0:0:0:0:0:0:1/128',myfail], + ['F34::123/40', 3, 'F34:0:0:0:0:0:0:3/40',mypass], + ['DEAD:BEEF::1/40', 3, 'DEAD:BEEF:0:0:0:0:0:3/40',mypass], + ['1000::2/40', 1, '1000:0:0:0:0:0:0:1/40',mypass], + ['1000::2000/40', 1, '1000:0:0:0:0:0:0:1/40',mypass], + ['DEAD::CAFE/40', 1, 'DEAD:0:0:0:0:0:0:1/40',mypass], + ['DEAD:BEEF::1/40', 4, 'DEAD:BEEF:0:0:0:0:0:4/40',mypass], + ['DEAD:BEEF::1/40', 5, 'DEAD:BEEF:0:0:0:0:0:5/40',mypass], + ['DEAD:BEEF::1/40', 6, 'DEAD:BEEF:0:0:0:0:0:6/40',mypass], + ['DEAD:BEEF::1/40', 7, 'DEAD:BEEF:0:0:0:0:0:7/40',mypass], + ['DEAD:BEEF::1/40', 8, 'DEAD:BEEF:0:0:0:0:0:8/40',mypass], + ['DEAD:BEEF::1/40', 9, 'DEAD:BEEF:0:0:0:0:0:9/40',mypass], + ['DEAD:BEEF::1/40', 255, 'DEAD:BEEF:0:0:0:0:0:FF/40',mypass], + ['DEAD:BEEF::1/40', 256, 'DEAD:BEEF:0:0:0:0:0:100/40',mypass], + ['DEAD:BEEF::1/40', 257, 'DEAD:BEEF:0:0:0:0:0:101/40',mypass], + ['DEAD:BEEF::1/40', 65536, 'DEAD:BEEF:0:0:0:0:1:0/40',mypass], + ['DEAD:BEEF::1/40', 65537, 'DEAD:BEEF:0:0:0:0:1:1/40',mypass], + ['2001:620:0:4::/64', 1, '2001:620:0:4:0:0:0:1/64',mypass], + ['3FFE:2000:0:4::/64', 1, '3FFE:2000:0:4:0:0:0:1/64',mypass], + ['2001:620:600::1', 1, '2001:620:600:0:0:0:0:1/128',myfail], + ['2001:620:600:0:1::1', 1,'2001:620:600:0:1:0:0:1/128',myfail], + ); + +use NetAddr::IP::Lite qw(:old_nth); +use Test::More; + +my($a, $ip, $test); + +$test = 4 * @addr + 4; +plan tests => $test; + +$test = 1; + +sub tst { + for $a (@addr) { + $ip = new NetAddr::IP::Lite $a->[0]; + $a->[0] =~ s,/\d+,,; + isa_ok($ip, 'NetAddr::IP::Lite', "$a->[0] "); +# requires full NetAddr::IP +# is(uc $ip->short, $a->[0], "short returns $a->[0]"); + is($ip->bits, 128, "bits == 128"); + is($ip->version, 6, "version == 6"); + my $index = $a->[1]; + if ($a->[3]) { + is(uc $ip->nth($index), $a->[2], "nth $a->[0], $index"); + } else { + ok(!$ip->nth($index),"nth $a->[0], undef"); + } + } +} + +tst(); + + +$test = new NetAddr::IP::Lite 'f34::1'; +isa_ok($test, 'NetAddr::IP::Lite'); +ok($test->network->contains($test), "->contains"); + +$test = new NetAddr::IP::Lite 'f35::1/40'; +isa_ok($test, 'NetAddr::IP::Lite'); +ok($test->network->contains($test), "->contains"); + diff --git a/Lite/t/version.t b/Lite/t/version.t new file mode 100644 index 0000000..24f11fb --- /dev/null +++ b/Lite/t/version.t @@ -0,0 +1,29 @@ + +#use diagnostics; +use NetAddr::IP::Lite; + +$| = 1; + +print "1..2\n"; + +my $test = 1; +sub ok() { + print 'ok ',$test++,"\n"; +} + +my $loip = new NetAddr::IP::Lite('1.2.3.4/24'); +my $hiip = new NetAddr::IP::Lite('FF00::1:4/120'); + +## test version lo +$exp = 4; +my $version = $loip->version; +print "got: $version, exp: $exp\nnot " + unless $version == $exp; +&ok; + +## test version hi +$exp = 6; +$version = $hiip->version; +print "got: $version, exp: $exp\nnot " + unless $version == $exp; +&ok; diff --git a/Lite/t/within.t b/Lite/t/within.t new file mode 100644 index 0000000..3654871 --- /dev/null +++ b/Lite/t/within.t @@ -0,0 +1,40 @@ + +#use diagnostics; +use NetAddr::IP::Lite; + +$| = 1; + +print "1..12\n"; + +my $test = 1; +sub ok() { + print 'ok ',$test++,"\n"; +} + +my $net4 = NetAddr::IP::Lite->new('1.2.3.5/30'); +my $net6 = NetAddr::IP::Lite->new('FF::85/126'); +my @try = qw( + 1.2.3.3 0 + 1.2.3.4 1 + 1.2.3.5 1 + 1.2.3.6 1 + 1.2.3.7 1 + 1.2.3.8 0 + FF::83 0 + FF::84 1 + FF::85 1 + FF::86 1 + FF::87 1 + FF::88 0 +); + +for (my $i=0;$i<@try;$i+=2) { + my $ip = NetAddr::IP::Lite->new($try[$i]); + my $rv = ($try[$i] =~ /:/) + ? $ip->within($net6) + : $ip->within($net4); + print "got: $rv, exp: $try[$i+1]\nnot " + unless $rv == $try[$i+1]; + &ok; +} + diff --git a/MANIFEST b/MANIFEST index fc30795..f7239d4 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,13 +1,11 @@ +Changes IP.pm -lib/NetAddr/IP.pm -Makefile.PL -MANIFEST This list of files +MANIFEST MANIFEST.SKIP +META.yml +Makefile.PL README -SIGNATURE -t/00-load.t -t/00-Sign.t -t/bitops.t +TODO t/imhoff.t t/loops.t t/masklen.t @@ -27,11 +25,9 @@ t/v4-compact.t t/v4-compplus.t t/v4-contains.t -t/v4-first.t t/v4-hostenum.t t/v4-last.t t/v4-new.t -t/v4-num.t t/v4-numeric.t t/v4-range.t t/v4-re.t @@ -41,11 +37,105 @@ t/v4-sprefix.t t/v4-wnew.t t/v4-xprefix.t -t/v6-base.t t/v6-contains.t t/v6-inc.t t/v6-numeric.t +t/v6-re.t t/v6-split-bulk.t t/wildcard.t -TODO -META.yml Module meta-data (added by MakeMaker) +Lite/Changes +Lite/Lite.pm +Lite/MANIFEST +Lite/MANIFEST.SKIP +Lite/META.yml +Lite/Makefile.PL +Lite/README +Lite/t/addr.t +Lite/t/aton.t +Lite/t/bits.t +Lite/t/broadcast.t +Lite/t/cidr.t +Lite/t/contains.t +Lite/t/copy.t +Lite/t/firstlast.t +Lite/t/lemasklen.t +Lite/t/loops.t +Lite/t/mask.t +Lite/t/masklen.t +Lite/t/netaddr.t +Lite/t/network.t +Lite/t/numeric.t +Lite/t/over-qq.t +Lite/t/over_comp.t +Lite/t/over_copy.t +Lite/t/over_equal.t +Lite/t/over_math.t +Lite/t/pathological.t +Lite/t/range.t +Lite/t/relops.t +Lite/t/v4-aton.t +Lite/t/v4-badnm.t +Lite/t/v4-base.t +Lite/t/v4-basem.t +Lite/t/v4-cidr.t +Lite/t/v4-cnew.t +Lite/t/v4-contains.t +Lite/t/v4-last.t +Lite/t/v4-new.t +Lite/t/v4-num.t +Lite/t/v4-numeric.t +Lite/t/v4-range.t +Lite/t/v4-snew.t +Lite/t/v4-wnew.t +Lite/t/v6-contains.t +Lite/t/v6-inc.t +Lite/t/v6-numeric.t +Lite/t/version.t +Lite/t/within.t +Lite/t/new-nth.t +Lite/t/new-num.t +Lite/t/old-nth.t +Lite/t/old-num.t +Lite/t/v4-new-first.t +Lite/t/v4-old-first.t +Lite/t/v6-new-base.t +Lite/t/v6-old-base.t +Lite/Util/Changes +Lite/Util/GPL +Lite/Util/MANIFEST +Lite/Util/MANIFEST.SKIP +Lite/Util/Makefile.PL +Lite/Util/Makefile.old +Lite/Util/README +Lite/Util/Util.pm +Lite/Util/Util.xs +Lite/Util/docs/rfc1884.txt +Lite/Util/lib/NetAddr/IP/UtilPP.pm +Lite/Util/siteconf +Lite/Util/t/4to6.t +Lite/Util/t/add128.t +Lite/Util/t/addconst.t +Lite/Util/t/anyto6.t +Lite/Util/t/badd.t +Lite/Util/t/bcd2bin.t +Lite/Util/t/bcdn2bin.t +Lite/Util/t/bin.t +Lite/Util/t/comp128.t +Lite/Util/t/croak.t +Lite/Util/t/hasbits.t +Lite/Util/t/inet_n2ad.t +Lite/Util/t/inet_n2dx.t +Lite/Util/t/ipv4_inet.t +Lite/Util/t/ipv6_any2n.t +Lite/Util/t/ipv6func.t +Lite/Util/t/ipv6to4.t +Lite/Util/t/isIPv4.t +Lite/Util/t/leftshift.t +Lite/Util/t/mode.t +Lite/Util/t/notcontiguous.t +Lite/Util/t/simple_pack.t +Lite/Util/t/sub128.t +Lite/Util/typemap +Lite/Util/u_intxx.h +Lite/Util/xs_include/inet_aton.c +Lite/Util/xs_include/miniSocket.inc diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP index c5a17ca..1e28ae6 100644 --- a/MANIFEST.SKIP +++ b/MANIFEST.SKIP @@ -2,8 +2,8 @@ ^_build/ ^blib/ ^blibdirs -^Makefile$ -^Makefile\.[a-z]+$ +Makefile$ +Makefile\.[a-z]+$ ^pm_to_blib CVS/.* \.cvs @@ -20,3 +20,4 @@ \.tar\.gz$ \.zip$ _uu$ +Lite/Util/Util_IS.pm diff --git a/META.yml b/META.yml index e1f28aa..5011e11 100644 --- a/META.yml +++ b/META.yml @@ -1,11 +1,10 @@ # http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: NetAddr-IP -version: 3.33 +version: 4.001 version_from: IP.pm installdirs: site requires: - Math::BigInt: 0 Test::More: 0 distribution_type: module diff --git a/Makefile.PL b/Makefile.PL index f535d17..424780d 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -2,10 +2,17 @@ # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. -# $Id: Makefile.PL,v 1.11 2005/08/25 15:36:09 lem Exp $ - my $checker = 0; +print qq{ +This build requires a C compiler by default - A slower, pure Perl +version that does not require compilation of XS code can be used +instead, by invoking this as + + perl Makefile.PL -noxs + +} unless grep { m/-noxs/ } @ARGV; + eval q{ use Test::Pod; $checker = 1; }; @@ -15,7 +22,7 @@ Looks like this host does not have Test::Pod installed. Without this module, the Pod documentation cannot be tested. This is not a big deal really, but -you might want to install Test::Mod by issuing the following command: +you might want to install Test::Pod by issuing the following command: perl -MCPAN -e "install('Test::Pod')" @@ -68,20 +75,20 @@ use NetAddr::IP ':aton'; -We're still open for feedback on this one... - EOF ; -WriteMakefile( - (MM->can('signature_target') ? (SIGN => 1) : ()), +my %makeparms = ( +# (MM->can('signature_target') ? (SIGN => 1) : ()), 'NAME' => 'NetAddr::IP', 'VERSION_FROM' => 'IP.pm', # finds $VERSION 'PREREQ_PM' => { Test::More => 0, - Math::BigInt => 0, }, # e.g., Module::Name => 1.1 ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT_FROM => 'IP.pm', - AUTHOR => 'Luis E. Mu�oz ') : ()), - ); + AUTHOR => 'Luis E. Muñoz ') : ()), + clean => { FILES => "*~ tmp*"}, +); + +WriteMakefile(%makeparms); diff --git a/README b/README index b491adb..28c5791 100644 --- a/README +++ b/README @@ -3,13 +3,9 @@ +NetAddr::IP - Manage IP addresses and subnets - -NetAddr::IP - Manages IP addresses and subnets - - * * * * THIS MODULE REQUIRES PERL 5.6.0 OR NEWER. * * * * - -This module is designed as a help for managing (ranges of) IP +This distribution is designed as a help for managing (ranges of) IP addresses. It includes efficient implementations for most common tasks done to subnets or ranges of IP addresses, namely verifying if an address is within a subnet, comparing, looping, splitting subnets into @@ -25,7 +21,8 @@ that describes a subnet unambiguously, you should receive an object representing such subnet. Currently this includes various flavors of CIDR notation, traditional notation in one, two, three and four dotted -octets, hexadecimal, range and subnet notations. +octets, hexadecimal, range and subnet notations as well as other, less +used formats. IPv6 addresses are also supported. Overloading is also used to ease printing and doing simple aritmetic and comparisons on the IP addresses. For instance, you can do things @@ -52,32 +49,49 @@ ...which is quite useful for generating config files and the such. This works even for huge ranges of IP addresses. -As of version 3.14_1, it is able to handle some representations of v6 -subnets thanks to Kadlecsik Jozsi. Note that this support is still -preliminary and has not been widely tested. - -This module is entirely written in Perl, so you do not need access to -a compiler to use it. It has been extensively tested in a variety of -platforms. An extensive test suite is provided with the module to -verify correct results. +This module can be installed without compiling any XS code, although +some parts are available as XS for speed. It has been extensively +tested in a variety of platforms. An extensive test suite is provided +with the module to verify correct results. The lastest version of this module should be preferred. You can obtain -it on http://www.cpan.org/authors/id/L/LU/LUISMUNOZ/ or one of the -many CPAN mirrors. Please find a mirror near you to help spread the -load. +it on the nearest CPAN mirror. Please find a mirror near you to help +spread the load. -Note that version 3 and above is not completely backwards compatible -with version 2. Version 2 was a somewhat unstable work that grew too -fast. If you're upgrading from 2.xx, please review your code as some -methods no longer exist or have changed. +Version 4 works with earlier versions of perl at least back to 5.00503 +however overloaded iterative arrays and binary bit strings 0b101010101 +are not supported in versions of perl prior to 5.6.0. -********************************************************************** -* VERSIONS EARLIER THAN 3.00 WON'T BE SUPPORTED AT ALL. PLEASE DON'T * -* EVEN ASK. I have very limited time and this module has grown quite * -* popular. Please help me help you by staying up to date with it. If * -* you find a bug, upgrade to the latest version on CPAN prior to * -* contacting me. * -********************************************************************** +To use the old behavior for ->nth($index) and ->num(): + + use NetAddr::IP::Lite qw(:old_nth); + + old behavior: + NetAddr::IP->new('10/32')->nth(0) == undef + NetAddr::IP->new('10/32')->nth(1) == undef + NetAddr::IP->new('10/31')->nth(0) == undef + NetAddr::IP->new('10/31')->nth(1) == 10.0.0.1/31 + NetAddr::IP->new('10/30')->nth(0) == undef + NetAddr::IP->new('10/30')->nth(1) == 10.0.0.1/30 + NetAddr::IP->new('10/30')->nth(2) == 10.0.0.2/30 + NetAddr::IP->new('10/30')->nth(3) == 10.0.0.3/30 + +Note that in each case, the broadcast address is represented in the +output set and that the 'zero'th index is alway undef. + + new behavior: + NetAddr::IP->new('10/32')->nth(0) == 10.0.0.0/32 + NetAddr::IP->new('10.1/32'->nth(0) == 10.0.0.1/32 + NetAddr::IP->new('10/31')->nth(0) == undef + NetAddr::IP->new('10/31')->nth(1) == undef + NetAddr::IP->new('10/30')->nth(0) == 10.0.0.1/30 + NetAddr::IP->new('10/30')->nth(1) == 10.0.0.2/30 + NetAddr::IP->new('10/30')->nth(2) == undef + +Note that a /32 net always has 1 usable address while a /31 has none +since it has a network and broadcast address, but no host +addresses. The first index (0) returns the address immediately +following the network address. To install, follow the standard CPAN recipe of: @@ -89,10 +103,15 @@ $ make install -The test suite includes a lot of cases. Note that currently, some -tests require Test::More. Eventually all tests will require it, so you -should really consider installing it if your Perl did not include this -module. +NetAddr::IP depends on NetAddr::IP::Util which utilizes perl_xs. If +you do not have a C compiler on your system or you would prefer the +slower PURE PERL version for some obtuse reason then build as follows: + +$ perl Makefile.PL -noxs +$ make +$ make test + +$ make install Tests related to address compaction could be too resource-intensive in some environments. If this is your case, you can skip those tests by @@ -100,11 +119,15 @@ shell, you could use the following example: $ LIGHTERIPTESTS=yes; export LIGHTERIPTESTS +$ make test The module's documentation can be accessed through POD. After installing the module, you can do $ perldoc NetAddr::IP +$ perldoc NetAddr::IP::Lite +$ perldoc NetAddr::IP::Util +$ perldoc NetAddr::IP::UtilPP to access the documentation. There is also a tutorial in HTML at the following URIs @@ -113,7 +136,7 @@ http://mipagina.cantv.net/lem/perl/ipperf.htm If you want to thank me for this module, please go look at those -tutorials and if you see banners there, click on a few of them :) +tutorials and if you see banners there, click on a few :) Bug reports are welcome. Please do not forget to tell me what version/platform are you running this code on. Providing a small piece @@ -123,15 +146,16 @@ Also, this code is intended to be strict and -w safe, so please report cases where warnings are generated so that I can fix them. -Report your bugs to me (luismunoz@cpan.org). +Report your bugs to me (luismunoz@cpan.org) or through the CPAN RT +interface at http://rt.cpan.org/. DO YOU WANT TO THANK ME? If you consider this a valuable contribution, there is a web page where you can express your gratitude. Please see - http://mipagina.cantv.net/lem/thanks-en.html (English) - http://mipagina.cantv.net/lem/thanks-es.html (Spanish) + http://mipagina.cantv.net/lem/thanks-en.html (English) + http://mipagina.cantv.net/lem/thanks-es.html (Spanish) SECURITY CONSIDERATIONS @@ -161,17 +185,18 @@ LICENSE AND WARRANTY -This software is (c) Luis E. Muñoz. 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 and Michael A. Robinton. 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. No warranty of any kind is expressed or implied. This code might make your computer go up in a puff of black smoke. + -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.2.1 (Darwin) -iD8DBQFEVjDeQyDWGRI/hhARAk+FAJ9hlpLFuGsJiGLqPzEA/jO+lCkoSACgjsMV -arBrKLqsAmyuUGm+JXA1rn0= -=6Doe +iD8DBQFEzo9TQyDWGRI/hhARAiDiAJ9QW3va/3+Fjk3IbxXaISUFO9djtwCfamKl +oml7Sgrp5lEEQEdppKIyI2A= +=4GL1 -----END PGP SIGNATURE----- diff --git a/SIGNATURE b/SIGNATURE deleted file mode 100644 index b241a79..0000000 --- a/SIGNATURE +++ /dev/null @@ -1,72 +0,0 @@ -This file contains message digests of all files listed in MANIFEST, -signed via the Module::Signature module, version 0.44. - -To verify the content in this distribution, first make sure you have -Module::Signature installed, then type: - - % cpansign -v - -It will check each file's integrity, as well as the signature's -validity. If "==> Signature verified OK! <==" is not displayed, -the distribution may already have been compromised, and you should -not run its Makefile.PL or Build.PL. - ------BEGIN PGP SIGNED MESSAGE----- -Hash: SHA1 - -SHA1 1ba210ca17868942dccc0cfb9a1394cd571cf918 IP.pm -SHA1 d7797afc9c96440cc579c923ccac0f63ee46fbfa MANIFEST -SHA1 30074c1a88a1ac469ce2bab6104ee099d334d466 MANIFEST.SKIP -SHA1 7ff7c25206c71b0b8e16f782d33279a67ef0a6a3 Makefile.PL -SHA1 15f79045eb6bf6b0d4b35f4ca0468340f5e57a15 README -SHA1 834b38162820d64484b5c8f3e601962e60742ff6 TODO -SHA1 7e92f0ec190e0520245a5a04fce559009866da60 lib/NetAddr/IP.pm -SHA1 2bf2f62cb765b20126756819844b45cbe5f89979 t/00-Sign.t -SHA1 ea1ba2a8137b5912f060a053a981d73ea300f73f t/00-load.t -SHA1 647ad43b533838cfcacfd85af3c2176d9de9dc20 t/bitops.t -SHA1 408e29a1b1ded7a1f42501c3e0843a1b07ac01c1 t/imhoff.t -SHA1 ad8be2dc7d91acd0ab1e637f3032ff0175b879b1 t/loops.t -SHA1 458350bd045c9428456ff3d61b1a2facbad1225f t/masklen.t -SHA1 5516882545f1326eecca22a298c91775e8515897 t/new-store.t -SHA1 3833f81312dcd4ff7a8387a8ef937d6d9f906726 t/old-store.t -SHA1 1849b8a630d689a2c81a8eb33d1fb7697e8f0840 t/over-arr.t -SHA1 b577c363d7cad97f82750799ee2391bb2b625569 t/over-qq.t -SHA1 a7b84175a7c961dfcc786d423a104c8e3e4c447b t/relops.t -SHA1 1e520807bd379a9b1fa856f854cdfd1a41f81234 t/short.t -SHA1 2a052e687e3e08e79105214400f986227d3b36e4 t/v4-aton.t -SHA1 3234faaa5d93006fc00acf730cfcab20eeea9cfb t/v4-badnm.t -SHA1 44e867fa16b31c47303407d2cf36c9e5281be695 t/v4-base.t -SHA1 87c2bb554a3411ae076615b34ee89f8de1254621 t/v4-basem.t -SHA1 215bc6deba22404eee3aa398dc66e5ddc070747a t/v4-cidr.t -SHA1 2831dc3b7559505aa7b7fc464aa0f61dde07fb48 t/v4-cnew.t -SHA1 fd66ae275d094028efcfc9581d52e58a49591116 t/v4-coalesce.t -SHA1 ab3bbe6342d9f130c97025d2461592a5b6fdd74c t/v4-compact.t -SHA1 4560b06c36e56a5546d4033ba0bb0eb96b6f7389 t/v4-compplus.t -SHA1 7f4448ba664ed6c5eb1febe4178730421025fe9e t/v4-contains.t -SHA1 66de0299983348642bd517bd6a2503c90014ba50 t/v4-first.t -SHA1 a75533c20083e12ba26596c9b14a6e4dde0ff7c0 t/v4-hostenum.t -SHA1 c22f8aa965b42dbe318114bc1461c69446ab4d80 t/v4-last.t -SHA1 96656288c0cfa335327f827350538f33914ec2f0 t/v4-new.t -SHA1 f6791d9f35ea14ac2d09c81a78e9b2ca69fc6e6a t/v4-num.t -SHA1 0a75321f7fef3f5acd1e1555dd6924241ea824cc t/v4-numeric.t -SHA1 d8c49cfe039381704b5c457129aa188323762e4c t/v4-range.t -SHA1 11e6cb5998a67010a7f9cfad077634aa47314605 t/v4-re.t -SHA1 2e921e360c3e84be4a2d0963f367e35aeb1e2c8b t/v4-snew.t -SHA1 797a980512fd6a15accb51a0557a4bf5023e0503 t/v4-split-bulk.t -SHA1 df0c1e48533f361a447f2af6f6c8f891666bf851 t/v4-split-list.t -SHA1 56336d7cc3bfb20e221b12b51e5a3542493ab19e t/v4-sprefix.t -SHA1 52daa44312542825a5a5b4237008d8d043689012 t/v4-wnew.t -SHA1 1439861493b6c9c16b79ada07aeee752ce968ba6 t/v4-xprefix.t -SHA1 bc1583d9adeb4fc684a24c058635bd5b5c435e6d t/v6-base.t -SHA1 08bc66b8418c0166e2e5d0e80f738685a0217d97 t/v6-contains.t -SHA1 d44fbb3ba0df4cc93bbec19c3a22b0936a4f2073 t/v6-inc.t -SHA1 f2b96606d38e1ca44509271c5f13c4b071678d03 t/v6-numeric.t -SHA1 840842286ef5909296ae7a4dfcaff9ae5c25d460 t/v6-split-bulk.t -SHA1 083a3ddd6a2f9083acbf294f79be757f2db516d6 t/wildcard.t ------BEGIN PGP SIGNATURE----- -Version: GnuPG v1.2.1 (Darwin) - -iD8DBQFEY0F3QyDWGRI/hhARAo1sAJ4vveDPd2iBK7PY9QPy2j0HtftTCACffA0l -0jLvV13HdB03P6Qpi3oeWZA= -=z47z ------END PGP SIGNATURE----- diff --git a/TODO b/TODO index cf268bf..442e11c 100644 --- a/TODO +++ b/TODO @@ -1,22 +1,5 @@ -$Id: TODO,v 1.7 2006/05/01 16:55:18 lem Exp $ - o More tests for IPv6 functionality. This should be thoroughly tested. -o Extend the formats accepted for v6 addresses. - o Add support for other notations (when found). -o Add a way to force the recognition of a v6 IP address when the input - is presented numerically. (Suggested by Carlos Vicente) - -o As suggested by Geoff Seeley's application, it may be good to have a - method that will convert an arbitrary IP range into a list of - subnets (a list of NetAddr::IP objects) - -o Add simple is_broadcast and is_network utility functions - -o Have foreach iteration of NetAddr::IP return objects based in the - specified netmask instead of forcing /32s, as suggested by Steve - Thompson - diff --git a/lib/NetAddr/IP.pm b/lib/NetAddr/IP.pm deleted file mode 100644 index df09efc..0000000 --- a/lib/NetAddr/IP.pm +++ /dev/null @@ -1,2467 +0,0 @@ -#!/usr/bin/perl -w - -# $Id: IP.pm,v 3.32 2006/05/01 17:11:18 lem Exp $ - -package NetAddr::IP; - -=pod - -=head1 NAME - -NetAddr::IP - Manages IPv4 and IPv6 addresses and subnets - -=head1 SYNOPSIS - - use NetAddr::IP; - - my $ip = new NetAddr::IP 'loopback'; - - print "The address is ", $ip->addr, " with mask ", $ip->mask, "\n" ; - - if ($ip->within(new NetAddr::IP "127.0.0.0", "255.0.0.0")) { - print "Is a loopback address\n"; - } - - # This prints 127.0.0.1/32 - print "You can also say $ip...\n"; - -=head1 DESCRIPTION - -This module provides an object-oriented abstraction on top of IP -addresses or IP subnets, that allows for easy manipulations. Many -operations are supported, as described below: - -=head2 Overloaded Operators - -Many operators have been overloaded, as described below: - -=cut - -require 5.006_000; -use Carp; -use Socket; -use strict; -use warnings; -require Exporter; - -our @EXPORT_OK = qw(Compact Coalesce); - -our @ISA = qw(Exporter); - -our $VERSION = do { sprintf "%d.%02d", (q$Revision: 3.32 $ =~ /\d+/g) }; - -# Set to true, to enable recognizing of 4-octet binary notation IP -# addresses. Thanks to Steve Snodgrass for reporting. This can be done -# at the time of use-ing the module. See docs for details. - -our $Accept_Binary_IP = 0; - - ############################################# - # These are the overload methods, placed here - # for convenience. - ############################################# - -use overload - - '+' => \&plus, - - '-' => \&minus, - - '++' => \&plusplus, - - '--' => \&minusminus, - - "=" => sub { - return _fnew NetAddr::IP [ $_[0]->{addr}, $_[0]->{mask}, - $_[0]->{bits} ]; - }, - - '""' => sub { $_[0]->cidr(); }, - - 'eq' => sub { - my $a = ref $_[0] eq 'NetAddr::IP' ? $_[0]->cidr : $_[0]; - my $b = ref $_[1] eq 'NetAddr::IP' ? $_[1]->cidr : $_[1]; - $a eq $b; - }, - - '==' => sub { - return 0 unless ref $_[0] eq 'NetAddr::IP'; - return 0 unless ref $_[1] eq 'NetAddr::IP'; - $_[0]->cidr eq $_[1]->cidr; - }, - - '>' => sub { - return undef unless $_[0]->{bits} == $_[1]->{bits}; - return ($_[0]->numeric)[1] > ($_[1]->numeric)[1] - if scalar($_[0]->numeric()) == scalar($_[1]->numeric()); - return scalar($_[0]->numeric()) > scalar($_[1]->numeric()); - }, - - '<' => sub { - return undef unless $_[0]->{bits} == $_[1]->{bits}; - return ($_[0]->numeric)[1] < ($_[1]->numeric)[1] - if scalar($_[0]->numeric()) == scalar($_[1]->numeric()); - return scalar($_[0]->numeric()) < scalar($_[1]->numeric()); - }, - - '>=' => sub { - return undef unless $_[0]->{bits} == $_[1]->{bits}; - return scalar($_[0]->numeric()) >= scalar($_[1]->numeric()); - }, - - '<=' => sub { - return undef unless $_[0]->{bits} == $_[1]->{bits}; - return scalar($_[0]->numeric()) <= scalar($_[1]->numeric()); - }, - - '<=>' => sub { - - return undef unless $_[0]->{bits} == $_[1]->{bits}; - return ($_[0]->numeric)[1] <=> ($_[1]->numeric)[1] - if scalar($_[0]->numeric()) == scalar($_[1]->numeric()); - return scalar($_[0]->numeric()) <=> scalar($_[1]->numeric()); - }, - - 'cmp' => sub { - - return undef unless $_[0]->{bits} == $_[1]->{bits}; - return ($_[0]->numeric)[1] <=> ($_[1]->numeric)[1] - if scalar($_[0]->numeric()) == scalar($_[1]->numeric()); - return scalar($_[0]->numeric()) <=> scalar($_[1]->numeric()); - }, - - '@{}' => sub { - return [ $_[0]->hostenum ]; - }; - -=pod - -=over - -=item B)> - -Has been optimized to copy one NetAddr::IP object to another very quickly. - -=item B - -An object can be used just as a string. For instance, the following code - - my $ip = new NetAddr::IP 'loopback'; - print "$ip\n"; - -Will print the string 127.0.0.1/8. - -=item B - -You can test for equality with either C or C<==>. C allows the -comparison with arbitrary strings as well as NetAddr::IP objects. The -following example: - - if (NetAddr::IP->new('loopback') eq '127.0.0.1/8') - { print "Yes\n"; } - -Will print out "Yes". - -Comparison with C<==> requires both operands to be NetAddr::IP objects. - -In both cases, a true value is returned if the CIDR representation of -the operands is equal. - -=item B, E, E=, E=, E=E and C> - -Those are numeric comparisons. All will return undef if you attempt to -compare a V4 subnet with a V6 subnet, when V6 becomes supported some -day. - -In case the version matches, the numeric representation of the network -is compared through the corresponding operation. The netmask is -ignored for these comparisons, as there is no standard criteria to say -wether 10/8 is larger than 10/10 or not. - -=item B - -You can do something along the lines of - - my $net = new NetAddr::IP $cidr_spec; - for my $ip (@$net) { - print "Host $ip is in $net\n"; - } - -However, note that this might generate a very large amount of items in -the list. You must be careful when doing this kind of expansion, as it -is very easy to consume huge amounts of resources. See below for -smarter ways to do loops and other constructions that are much more -conservative. - -=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: - - print NetAddr::IP->new('loopback') + 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; - -outputs 10.0.0.0/24. - -=cut - -sub plus { - my $ip = shift; - my $const = shift; - - return $ip unless $const; - - my $b = $ip->{bits}; - my $a = $ip->{addr}; - my $m = $ip->{mask}; - - my $hp = "$a" & ~"$m"; - my $np = "$a" & "$m"; - - if ($b == 128) # v6? - { - use Math::BigInt; - - my $num = new Math::BigInt 0; - - for (0 .. 15) - { - $num <<= 8; - $num |= vec($hp, $_, 8); - } - - $num->badd($const); - - for (reverse 0 .. 15) - { - my $x = new Math::BigInt $num; - vec($hp, $_, 8) = $x & 0xFF; - $num >>= 8; - } - } - else # v4 - { - vec($hp, 0, $b) += $const; - } - - return _fnew NetAddr::IP [ "$np" | ("$hp" & ~"$m"), $m, $b]; -} - -=item B - -The complement of the addition of a constant. - -=cut - -sub minus { - my $ip = shift; - my $const = shift; - - return plus($ip, -$const, @_); -} - - # Auto-increment an object -=pod - -=item B - -Auto-incrementing a NetAddr::IP object causes the address part to be -adjusted to the next host address within the subnet. It will wrap at -the broadcast address and start again from the network address. - -=cut - -sub plusplus { - my $ip = shift; - - my $a = $ip->{addr}; - my $m = $ip->{mask}; - my $b = $ip->{bits}; - - if ($b == 128) - { - my $nip = NetAddr::IP->new($ip) + 1; - $ip->{$_} = $nip->{$_} for keys %$nip; - } - else - { - my $hp = "$a" & ~"$m"; - my $np = "$a" & "$m"; - - vec($hp, 0, 32) ++; - $ip->{addr} = "$np" | ("$hp" & ~"$m"); - } - - return $ip; -} - -=pod - -=item B - -Auto-decrementing a NetAddr::IP object performs exactly the opposite -of auto-incrementing it, as you would expect. - -=cut - -sub minusminus { - my $ip = shift; - - my $a = $ip->{addr}; - my $m = $ip->{mask}; - my $b = $ip->{bits}; - - if ($b == 128) - { - my $nip = NetAddr::IP->new($ip) - 1; - $ip->{$_} = $nip->{$_} for keys %$nip; - } - else - { - my $hp = "$a" & ~"$m"; - my $np = "$a" & "$m"; - - vec($hp, 0, 32) --; - - $ip->{addr} = "$np" | ("$hp" & ~"$m"); - } - return $ip; -} - - ############################################# - # End of the overload methods. - ############################################# - - -# Preloaded methods go here. - - # This is a variant to ->new() that - # creates and blesses a new object - # without the fancy parsing of - # IP formats and shorthands. - -sub _fnew ($$) { - my $type = shift; - my $class = ref($type) || $type || "NetAddr::IP"; - my $r_addr = shift; - - return - bless { addr => $r_addr->[0], - mask => $r_addr->[1], - bits => $r_addr->[2] }, - $class; -} - - # Returns 2 ** $bits -1 (ie, - # $bits one bits) -sub _ones ($) { - my $bits = shift; - return ~vec('', 0, $bits); -} - - # Validates that a mask is composed - # of a contiguous set of bits -sub _contiguous ($$) -{ - my $mask = shift; - my $octets = shift; - -# return 1 unless defined $mask and defined $octets; - - $octets /= 8; - - for my $o (0 .. $octets) - { - my $v = vec($mask, $o, 8); -# return unless grep { $v == $_ } -# (255, 254, 252, 248, 240, 224, 192, 128, 0); - return unless $v == 255 or $v == 254 or $v == 252 or - $v == 248 or $v == 240 or $v == 224 or $v == 192 or - $v == 128 or $v == 0; - } - - 1; -} - -sub _to_quad ($) { - my $vec = shift; - return vec($vec, 0, 8) . '.' . - vec($vec, 1, 8) . '.' . - vec($vec, 2, 8) . '.' . - vec($vec, 3, 8); -} - -sub _to_ipv6 ($) { - my $vec = shift; - my $r = ''; - - foreach (0..3) { - $r .= ':' . sprintf("%02x%02x:%02x%02x", - vec($vec, 4*$_, 8), vec($vec, 4*$_ + 1, 8), - vec($vec, 4*$_ + 2, 8), vec($vec, 4*$_ + 3, 8)); - } - $r =~ s/^://; - return $r; -} - -sub do_prefix ($$$) { - my $mask = shift; - my $faddr = shift; - my $laddr = shift; - - if ($mask > 24) { - return "$faddr->[0].$faddr->[1].$faddr->[2].$faddr->[3]-$laddr->[3]"; - } - elsif ($mask == 24) { - return "$faddr->[0].$faddr->[1].$faddr->[2]."; - } - elsif ($mask > 16) { - return "$faddr->[0].$faddr->[1].$faddr->[2]-$laddr->[2]."; - } - elsif ($mask == 16) { - return "$faddr->[0].$faddr->[1]."; - } - elsif ($mask > 8) { - return "$faddr->[0].$faddr->[1]-$laddr->[1]."; - } - elsif ($mask == 8) { - return "$faddr->[0]."; - } - else { - return "$faddr->[0]-$laddr->[0]"; - } -} - -sub _parse_mask ($$) { - my $mask = shift; - my $bits = shift; - - my $bmask = ''; - - if ($bits == 128) { - if (grep(lc $mask eq $_ , qw(unspecified loopback))) { - for (0..3) { - vec($bmask, $_, 32) = 0xFFFFFFFF; - } - } - elsif ($mask =~ /^(\d+)$/ && $1 <= 128) { - foreach (0..3) { - if ($mask >= 32*($_ + 1)) { - vec($bmask, $_, 32) = 0xFFFFFFFF; - } - elsif ($mask > 32*$_) { - vec($bmask, $_, 32) = 0xFFFFFFFF; - vec($bmask, $_, 32) <<= (32*($_ + 1) - $mask); - } - else { - vec($bmask, $_, 32) = 0x0; - } - } - } - else { - $bmask = undef; - } - } - elsif ($mask eq '32') - { - # *Very* common case - # $bmask = "\xff\xff\xff\xff"; - vec($bmask, 0, 32) = 0xffffffff; - } - elsif ($mask =~ m/^(\d+)$/ and $1 <= 32) { - # Another very common case - if ($1) { - vec($bmask, 0, $bits) = _ones $bits; - vec($bmask, 0, $bits) <<= ($bits - $1); - } else { - vec($bmask, 0, $bits) = 0x0; - } - } - elsif (lc $mask eq 'default' or lc $mask eq 'any') { - vec($bmask, 0, $bits) = 0x0; - } - elsif (lc $mask eq 'broadcast' or lc $mask eq 'host') { - vec($bmask, 0, $bits) = _ones $bits; - } - elsif (lc $mask eq 'loopback') { - vec($bmask, 0, 8) = 255; - vec($bmask, 1, 8) = 0; - vec($bmask, 2, 8) = 0; - vec($bmask, 3, 8) = 0; - } - elsif ($mask =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) { - - for my $i ($1, $2, $3, $4) { - return undef - unless grep { $i == $_ } - (255, 254, 252, 248, 240, 224, 192, 128, 0); - } - - return undef if ($1 < $2 or $2 < $3 or $3 < $4); - - return undef if $2 != 0 and $1 != 255; - return undef if $3 != 0 and $2 != 255; - return undef if $4 != 0 and $3 != 255; - - vec($bmask, 0, 8) = $1; - vec($bmask, 1, 8) = $2; - vec($bmask, 2, 8) = $3; - vec($bmask, 3, 8) = $4; - } - elsif ($mask =~ m/^(\d+)$/) { - vec($bmask, 0, $bits) = $1; - } - - $bmask; -} - -sub _obits ($$) { - my $lo = shift; - my $hi = shift; - - return 0xFF if $lo == $hi; - return (~ ($hi ^ $lo)) & 0xFF; -} - -sub _v4 ($$$) { - my $ip = shift; - my $mask = shift; - my $present = shift; - - my $addr = ''; - my $a; - - if ($ip =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/ - and $1 >= 0 and $1 <= 255 - and $2 >= 0 and $2 <= 255 - and $3 >= 0 and $3 <= 255 - and $4 >= 0 and $4 <= 255) - { - # The most frequent case - vec($addr, 0, 8) = $1; - vec($addr, 1, 8) = $2; - vec($addr, 2, 8) = $3; - vec($addr, 3, 8) = $4; - } - elsif ($ip =~ m/^(\d+)\.(\d+)$/ - and $1 >= 0 and $1 <= 255 - and $2 >= 0 and $2 <= 255) - { - vec($addr, 0, 8) = $1; - vec($addr, 1, 8) = ($present ? $2 : 0); - vec($addr, 2, 8) = 0; - vec($addr, 3, 8) = ($present ? 0 : $2); - } - elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)$/ - and $1 >= 0 and $1 <= 255 - and $2 >= 0 and $2 <= 255 - and $3 >= 0 and $3 <= 255) - { - vec($addr, 0, 8) = $1; - vec($addr, 1, 8) = $2; - vec($addr, 2, 8) = ($present ? $3 : 0); - vec($addr, 3, 8) = ($present ? 0 : $3); - } - elsif ($ip =~ m/^([xb\d]+)$/ and $1 >= 0 and $1 < 255 and $present) - { - vec($addr, 0, 8) = $1; - vec($addr, 1, 8) = 0; - vec($addr, 2, 8) = 0; - vec($addr, 3, 8) = 0; - } - elsif ($ip =~ m/^(-?[xb\d]+)$/) - { - my $num = $1; - $num += 2 ** 32 if $num < 0; - vec($addr, 0, 32) = $1; - } - - # The notations below, include an - # implicit mask specification. - - elsif ($ip =~ m/^(\d+)\.$/ and $1 >= 0 and $1 <= 255) { - #print "^(\\d+)\\.\$\n"; - vec($addr, 0, 8) = $1; - vec($addr, 1, 8) = 0; - vec($addr, 2, 8) = 0; - vec($addr, 3, 8) = 0; - vec($mask, 0, 32) = 0xFF000000; - } - elsif ($ip =~ m/^(\d+)\.(\d+)-(\d+)\.?$/ - and $1 >= 0 and $1 <= 255 - and $2 >= 0 and $2 <= 255 - and $3 >= 0 and $3 <= 255 - and $2 <= $3) { - #print "^(\\d+)\\.(\\d+)-(\\d+)\\.?\$\n"; - vec($addr, 0, 8) = $1; - vec($addr, 1, 8) = $2; - vec($addr, 2, 8) = 0; - vec($addr, 3, 8) = 0; - - vec($mask, 0, 32) = 0x0; - vec($mask, 0, 8) = 0xFF; - vec($mask, 1, 8) = _obits $2, $3; - } - elsif ($ip =~ m/^(\d+)-(\d+)\.?$/ - and $1 >= 0 and $1 <= 255 - and $2 >= 0 and $2 <= 255 - and $1 <= $2) { - #print "^(\\d+)-(\\d+)\\.?\$\n"; - vec($addr, 0, 8) = $1; - vec($addr, 1, 8) = 0; - vec($addr, 2, 8) = 0; - vec($addr, 3, 8) = 0; - - vec($mask, 0, 32) = 0x0; - vec($mask, 0, 8) = _obits $1, $2; - } - elsif ($ip =~ m/^(\d+)\.(\d+)\.$/ and $1 >= 0 - and $1 <= 255 and $2 >= 0 and $2 <= 255) - { - #print "^(\\d+)\\.(\\d+)\\.\$\n"; - vec($addr, 0, 8) = $1; - vec($addr, 1, 8) = $2; - vec($addr, 2, 8) = 0; - vec($addr, 3, 8) = 0; - vec($mask, 0, 32) = 0xFFFF0000; - } - elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)-(\d+)\.?$/ - and $1 >= 0 and $1 <= 255 - and $2 >= 0 and $2 <= 255 - and $3 >= 0 and $3 <= 255 - and $4 >= 0 and $4 <= 255 - and $3 <= $4) { - #print "^(\\d+)\\.(\\d+)\\.(\\d+)-(\\d+)\\.?\$\n"; - vec($addr, 0, 8) = $1; - vec($addr, 1, 8) = $2; - vec($addr, 2, 8) = $3; - vec($addr, 3, 8) = 0; - - vec($mask, 0, 32) = 0x0; - vec($mask, 0, 8) = 0xFF; - vec($mask, 1, 8) = 0xFF; - vec($mask, 2, 8) = _obits $3, $4; - } - elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)\.$/ and $1 >= 0 - and $1 <= 255 and $2 >= 0 and $2 <= 255 - and $3 >= 0 and $3 <= 255) - { - #print "^(\\d+)\\.(\\d+)\\.(\\d+)\\.\$\n"; - vec($addr, 0, 8) = $1; - vec($addr, 1, 8) = $2; - vec($addr, 2, 8) = $3; - vec($addr, 3, 8) = 0; - vec($mask, 0, 32) = 0xFFFFFF00; - } - elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+)-(\d+)$/ - and $1 >= 0 and $1 <= 255 - and $2 >= 0 and $2 <= 255 - and $3 >= 0 and $3 <= 255 - and $4 >= 0 and $4 <= 255 - and $5 >= 0 and $5 <= 255 - and $4 <= $5) { - #print "^(\\d+)\\.(\\d+)\\.(\\d+)\\.(\\d+)-(\\d+)\$\n"; - vec($addr, 0, 8) = $1; - vec($addr, 1, 8) = $2; - vec($addr, 2, 8) = $3; - vec($addr, 3, 8) = $4; - - vec($mask, 0, 8) = 0xFF; - vec($mask, 1, 8) = 0xFF; - vec($mask, 2, 8) = 0xFF; - vec($mask, 3, 8) = _obits $4, $5; - } - elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+) - \s*-\s*(\d+)\.(\d+)\.(\d+)\.(\d+)$/x - and $1 >= 0 and $1 <= 255 - and $2 >= 0 and $2 <= 255 - and $3 >= 0 and $3 <= 255 - and $4 >= 0 and $4 <= 255 - and $5 >= 0 and $5 <= 255 - and $6 >= 0 and $6 <= 255 - and $7 >= 0 and $7 <= 255 - and $8 >= 0 and $8 <= 255) - { - my $last = ''; - - vec($addr, 0, 8) = $1; - vec($addr, 1, 8) = $2; - vec($addr, 2, 8) = $3; - vec($addr, 3, 8) = $4; - - vec($last, 0, 8) = $5; - vec($last, 1, 8) = $6; - vec($last, 2, 8) = $7; - vec($last, 3, 8) = $8; - - vec($mask, 0, 8) = _obits $1, $5; - vec($mask, 1, 8) = _obits $2, $6; - vec($mask, 2, 8) = _obits $3, $7; - vec($mask, 3, 8) = _obits $4, $8; - - # Barf on invalid ranges. There can only be one - # octet in the netmask that is neither 0 nor 255. - - return - if grep ({ - vec($mask, $_, 8) != 0 - and vec($mask, $_, 8) != 255 - } (0 .. 3)) > 1; - - # Barf on invalid ranges. No octet on the right - # can be larger that any octet on the left - - for (0 .. 2) - { - return if vec($mask, $_, 8) < vec($mask, $_ + 1, 8); - } - } - elsif ($Accept_Binary_IP - and !$present and length($ip) == 4) { - my @o = unpack("C4", $ip); - - vec($addr, $_, 8) = $o[$_] for 0 .. 3; - vec($mask, 0, 32) = 0xFFFFFFFF; - } - elsif (lc $ip eq 'default' or lc $ip eq 'any') { - vec($addr, 0, 32) = 0x0; - } - elsif (lc $ip eq 'broadcast') { - vec($addr, 0, 32) = _ones 32; - } - elsif (lc $ip eq 'loopback') { - vec($addr, 0, 8) = 127; - vec($addr, 3, 8) = 1; - } - elsif (($a = gethostbyname($ip)) and defined($a) - and ($a ne pack("C4", 0, 0, 0, 0))) { - if ($a and inet_ntoa($a) =~ m!^(\d+)\.(\d+)\.(\d+)\.(\d+)$!) { - vec($addr, 0, 8) = $1; - vec($addr, 1, 8) = $2; - vec($addr, 2, 8) = $3; - vec($addr, 3, 8) = $4; - } - } - else { -# croak "Cannot obtain an IP address out of $ip"; - return; - } - - # Return the completed hash (no explicit return as this seems to be - # faster...) - { addr => $addr, mask => $mask, bits => 32 }; -} - -sub expand_v6 ($) { - my $pat = shift; - - if (length($pat) < 4) { - $pat = ('0' x (4 - length($pat))) . $pat; - } - return $pat; -} - -sub _v6_part ($$$) { - my $addr = shift; - my $four = shift; - my $n = shift; - - my($a, $b); - - return undef unless length($four) == 4; - $four =~ /^(.{2})(.{2})/; - ($a, $b) = ($1, $2); - - vec($addr, 2*$n, 8) = hex($a); - vec($addr, 2*$n + 1, 8) = hex($b); - - return $addr; -} - -sub _v6 ($$$) { - my $ip = lc shift; - my $mask = shift; - my $present = shift; - - my $addr = ''; - my $colons; - my $expanded; - my @ip; - - if ($ip eq 'unspecified') { - $ip = '::'; - } - elsif ($ip eq 'loopback') { - $ip = '::1'; - } - elsif ($ip =~ /:::/ || $ip =~ /::.*::/) { - return; - } - return unless $ip =~ /^[\da-f\:]+$/i; - - $colons = ($ip =~ tr/:/:/); - return unless $colons >= 2 && $colons <= 7; - $expanded = ':0' x (9 - $colons); - $expanded =~ s/0$// if ($ip =~ /[\da-f]+::[\da-f]+/); -# warn "# colons = $colons\n"; -# warn "# expanded = $expanded\n"; - $ip =~ s/::/$expanded/; - $ip = '0' . $ip if $ip =~ /^:/; -# warn "# ip = $ip\n"; - # .:.:.:.:.:.:.:. - @ip = split(/:/, $ip); - grep($_ = expand_v6($_), @ip);; - for (0..$#ip) { - $addr = _v6_part($addr, $ip[$_], $_); - return unless defined $addr; - } - - return { addr => $addr, mask => $mask, bits => 128 }; -} - -sub new4 ($$;$) { - new($_[0], $_[1], $_[2]); -} - -=pod - -=back - -=head2 Serializing and Deserializing - -This module defines hooks to collaborate with L for -serializing C objects, through compact and human readable -strings. You can revert to the old format by invoking this module as - - use NetAddr::IP ':old_storable'; - -You must do this if you have legacy data files containing NetAddr::IP -objects stored using the L module. - -=cut - -sub import -{ - unless (grep { $_ eq ':old_storable' } @_) - { - *{STORABLE_freeze} = sub - { - my $self = shift; - return $self->cidr(); # use stringification - }; - *{STORABLE_thaw} = sub - { - my $self = shift; - my $cloning = shift; # Not used - my $serial = shift; - - my $ip = new NetAddr::IP $serial; - $self->{addr} = $ip->{addr}; - $self->{mask} = $ip->{mask}; - $self->{bits} = $ip->{bits}; - return; - }; - } - - if (grep { $_ eq ':aton' } @_) - { - $Accept_Binary_IP = 1; - } - - @_ = grep { $_ ne ':old_storable' } @_; - @_ = grep { $_ ne ':aton' } @_; - NetAddr::IP->export_to_level(1, @_); -} - -=pod - -=head2 Methods - -=over - -=item C<-Enew([$addr, [ $mask|IPv6 ]])> - -This method creates a new IPv4 address with the supplied address in -C<$addr> and an optional netmask C<$mask>, which can be omitted to get -a /32 mask. - -C<$addr> can be almost anything that can be resolved to an IP address -in all the notations I have seen over time. It can optionally contain -the mask in CIDR notation. - -B notation is understood, with the limitation that the range -speficied by the prefix must match with a valid subnet. - -Addresses in the same format returned by C or -C can also be understood, although no mask can be -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 - - use NetAddr::IP ':aton' - -If called with no arguments, 'default' is assumed. - -IPv6 addresses according to RFC 1884 are also supported, except IPv4 -compatible IPv6 addresses. - -=cut - -sub new ($$;$) { - my $type = $_[0]; - my $class = ref($type) || $type || "NetAddr::IP"; - my $ip = $_[1]; - my $hasmask = 1; - my $bits; - my $mask; - - $ip = 'default' unless defined $ip; - $bits = index($ip, ':') >= 0 ? 128 : 32; - - if (@_ == 2) { - if ($ip =~ m!^(.+)/(.+)$!) { - $ip = $1; - $mask = $2; - } - elsif (grep { lc $ip eq $_ } (qw(default any broadcast loopback))) - { - $mask = $ip; - } - } - - if (defined $_[2]) { - if ($_[2] =~ /^ipv6$/i) { - if (grep { lc $ip eq $_ } (qw(unspecified loopback))) { - $bits = 128; - $mask = _parse_mask $ip, $bits; - } - else { - return undef; - } - } - else { - $mask = _parse_mask $_[2], $bits; - } - return undef unless defined $mask; - } - elsif (defined $mask) { - $mask = _parse_mask $mask, $bits; - return undef unless defined $mask; - } - else { - $hasmask = 0; - $mask = _parse_mask $bits, $bits; - return undef unless defined $mask; - } - - my $self = $bits == 32 ? _v4($ip, $mask, $hasmask) - : _v6($ip, $mask, $hasmask); - - return unless $self; - return unless _contiguous $self->{mask}, $self->{bits}; - - return bless $self, $class; -} - -=pod - -=item C<-Ebroadcast()> - -Returns a new object refering to the broadcast address of a given -subnet. The broadcast address has all ones in all the bit positions -where the netmask has zero bits. This is normally used to address all -the hosts in a given subnet. - -=cut - -sub broadcast ($) { - my $self = shift; - return $self->_fnew($self->_broadcast); -} - -sub _broadcast ($) { - my $self = shift; - my $a = $self->{addr}; - my $m = $self->{mask}; - my $c = ''; - - vec($c, 0, $self->{bits}) = _ones $self->{bits}; - vec($c, 0, $self->{bits}) ^= vec($m, 0, $self->{bits}); - - return [ "$a" | ~ "$m" | $c, $self->{mask}, $self->{bits} ]; -} - -=pod - -=item C<-Enetwork()> - -Returns a new object refering to the network address of a given -subnet. A network address has all zero bits where the bits of the -netmask are zero. Normally this is used to refer to a subnet. - -=cut - -sub network ($) { - my $self = shift; - return $self->_fnew($self->_network); -} - -sub _network ($) { - my $self = shift; - my $a = $self->{addr}; - my $m = $self->{mask}; - - return [ "$a" & "$m", $self->{mask}, $self->{bits} ]; -} - -=pod - -=item C<-Eaddr()> - -Returns a scalar with the address part of the object as a -dotted-quad. This is useful for printing or for passing the address -part of the NetAddr::IP object to other components that expect an IP -address. - -=cut - -sub addr ($) { - my $self = shift; - $self->{bits} == 32 ? _to_quad $self->{addr} - : _to_ipv6 $self->{addr}; -} - - -=pod - -=item C<-Emask()> - -Returns a scalar with the mask as a dotted-quad. - -=cut - -sub mask ($) { - my $self = shift; - $self->{bits} == 32 ? _to_quad $self->{mask} - : _to_ipv6 $self->{mask}; -} - -=pod - -=item C<-Emasklen()> - -Returns a scalar the number of one bits in the mask. - -=cut - -sub masklen ($) { - my $self = shift; - my $bits = 0; - - for (my $i = 0; - $i < $self->{bits}; - $i ++) - { - $bits += vec($self->{mask}, $i, 1); - } - - return $bits; -} - -=pod - -=item C<-Ebits()> - -Returns the wide of the address in bits. Normally 32 for v4 and 128 for v6. - -=cut - -sub bits { return $_[0]->{bits}; } - -=pod - -=item C<-Eversion()> - -Returns the version of the address or subnet. Currently this can be -either 4 or 6. - -=cut - -sub version { return $_[0]->{bits} == 32 ? 4 : 6; } - -=pod - -=item C<-Ecidr()> - -Returns a scalar with the address and mask in CIDR notation. A -NetAddr::IP object I to the result of this function. - -=cut - -sub cidr ($) { - my $self = shift; - return $self->addr . '/' . $self->masklen; -} - -=pod - -=item C<-Eaton()> - -Returns the address part of the NetAddr::IP object in the same format -as the C function. This should ease a bit the code -required to deal with "old-style" sockets. - -=cut - -sub aton { - my $self = shift; - return pack "C4", split /\./, $self->addr; -} - -=pod - -=item C<-Erange()> - -Returns a scalar with the base address and the broadcast address -separated by a dash and spaces. This is called range notation. - -=cut - -sub range ($) { - my $self = shift; - my $mask = $self->masklen; - - return undef if $self->{bits} > 32; - return $self->network->addr . ' - ' . $self->broadcast->addr; -} - -=pod - -=item C<-Eprefix()> - -Returns a scalar with the address and mask in prefix -representation. This is useful for some programs, which expect its -input to be in this format. This method will include the broadcast -address in the encoding. - -=cut - -sub prefix ($) { - my $self = shift; - my $mask = $self->masklen; - - return undef if $self->{bits} > 32; - return $self->addr if $mask == 32; - - my @faddr = split (/\./, $self->first->addr); - my @laddr = split (/\./, $self->broadcast->addr); - - return do_prefix $mask, \@faddr, \@laddr; -} - -=pod - -=item C<-Enprefix()> - -Just as C<-Eprefix()>, but does not include the broadcast address. - -=cut - -sub nprefix ($) { - my $self = shift; - my $mask = $self->masklen; - - return undef if $self->{bits} > 32; - return $self->addr if $mask == 32; - - my @faddr = split (/\./, $self->first->addr); - my @laddr = split (/\./, $self->last->addr); - - return do_prefix $mask, \@faddr, \@laddr; -} - -=pod - -=item C<-Enumeric()> - -When called in a scalar context, will return a numeric representation -of the address part of the IP address. When called in an array -contest, it returns a list of two elements. The first element is as -described, the second element is the numeric representation of the -netmask. - -This method is essential for serializing the representation of a -subnet. - -=cut - -sub numeric ($) { - my $self = shift; - if ($self->version == 4) - { - return - wantarray() ? ( vec($self->{addr}, 0, 32), - vec($self->{mask}, 0, 32) ) : - vec($self->{addr}, 0, 32); - } - else - { - my $n = new Math::BigInt 0; - my $m = new Math::BigInt 0 if wantarray; - for (0 .. 3) - { - $n <<= 32; - $n += vec($self->{addr}, $_, 32); - if (wantarray) - { - $m <<= 32; - $m += vec($self->{mask}, $_, 32); - } - } - return wantarray ? ($n, $m) : $n; - } -} - -=pod - -=item C<-Ewildcard()> - -When called in a scalar context, returns the wildcard bits -corresponding to the mask, in dotted-quad format. - -When called in an array context, returns a two-element array. The -first element, is the address part. The second element, is the -wildcard translation of the mask. - -=cut - -sub wildcard ($) { - my $self = shift; - return undef if $self->{bits} > 32; - return wantarray() ? ($self->addr, _to_quad ~$self->{mask}) : - _to_quad ~$self->{mask}; - -} - -=pod - -=item C<-Eshort()> - -Returns the address part in a short or compact notation. (ie, -127.0.0.1 becomes 127.1). Works with both, V4 and V6. Note that -C is now deprecated. - -=cut - -sub _compact_v6 ($) { - my $addr = shift; - - my @o = split /:/, $addr; - return $addr unless @o and grep { $_ =~ m/^0+$/ } @o; - - my @candidates = (); - my $start = undef; - - for my $i (0 .. $#o) - { - if (defined $start) - { - if ($o[$i] !~ m/^0+$/) - { - push @candidates, [ $start, $i - $start ]; - $start = undef; - } - } - else - { - $start = $i if $o[$i] =~ m/^0+$/; - } - } - - push @candidates, [$start, 8 - $start] if defined $start; - - my $l = (sort { $b->[1] <=> $a->[1] } @candidates)[0]; - - return $addr unless defined $l; - - $addr = $l->[0] == 0 ? '' : join ':', @o[0 .. $l->[0] - 1]; - $addr .= '::'; - $addr .= join ':', @o[$l->[0] + $l->[1] .. $#o]; - $addr =~ s/(^|:)0{1,3}/$1/g; - - return $addr; -} - -sub short ($) -{ - my $self = shift; - my $addr = $self->addr; - if ($self->{bits} == 32) - { - my @o = split(/\./, $addr, 4); - splice(@o, 1, 2) if $o[1] == 0 and $o[2] == 0; - return join '.', @o; - } - else - { - return _compact_v6 _to_ipv6 $self->{addr}; - } -} - -# *{compact_addr} = \&short; - -=pod - -=item C<$me-Econtains($other)> - -Returns true when C<$me> completely contains C<$other>. False is -returned otherwise and C is returned if C<$me> and C<$other> -are of different versions. - -Note that C<$me> and C<$other> must be C objects. - -=cut - -sub contains ($$) { - my $a = shift; - my $b = shift; - - my $bits = $a->{bits}; - - my $mask; - - # Both must be of the same length... - return undef - unless $bits == $b->{bits}; - - # $a must be less specific than $b... - my ($a_addr, $a_mask) = $a->numeric; - my ($b_addr, $b_mask) = $b->numeric; - - return 0 unless $a_mask <= $b_mask; - - # A default address always contains - return 1 if ($a_mask == 0x0); - - return ($a_addr & $a_mask) == ($b_addr & $a_mask); -} - -=pod - -=item C<$me-Ewithin($other)> - -The complement of C<-Econtains()>. Returns true when C<$me> is -completely con tained within C<$other>. - -Note that C<$me> and C<$other> must be C objects. - -=cut - -sub within ($$) { - return contains($_[1], $_[0]); -} - -=pod - -=item C<-Esplit($bits)> - -Returns a list of objects, representing subnets of C<$bits> mask -produced by splitting the original object, which is left -unchanged. Note that C<$bits> must be longer than the original -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. - -=cut - -sub split ($;$) { - return @{$_[0]->splitref($_[1])}; -} - -=pod - -=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. - -=cut - -sub splitref ($;$) { - my $self = shift; - my $mask = _parse_mask shift || $self->{bits}, $self->{bits}; - - my $bits = $self->{bits}; - - my @ret; - - if (vec($self->{mask}, 0, $bits) - <= vec($mask, 0, $bits)) - { - my $num = ''; - my $v = ''; - - my $net = $self->network->{addr}; - $net = "$net" & "$mask"; - - my $to = $self->broadcast->{addr}; - $to = "$to" & "$mask"; - - if ($bits == 128) - { - use Math::BigInt; - - my $n = new Math::BigInt 0; - my $t = new Math::BigInt 0; - my $u = new Math::BigInt 0; - my $x = ''; - - for (0 .. 15) - { - vec($num, $_, 8) = _ones 8; - vec($num, $_, 8) ^= vec($mask, $_, 8); - $n <<= 8; - $t <<= 8; - $u <<= 8; - $n |= vec($net, $_, 8); - $t |= vec($to, $_, 8); - $u |= vec($num, $_, 8); - } - -# warn "# splitref $self $mask\n"; -# warn "# net = ", $self->network, "\n"; -# warn "# bro = ", $self->broadcast, "\n"; - -# warn "# before, n = $n\n"; -# warn "# before, t = $t\n"; -# warn "# before, u = $u\n"; - - $u++; - my $i = $n->copy; - - do { - - my $j = $i->copy; - -# warn "# i = $i\n"; -# warn "# j = $j\n"; -# warn "# n = $n\n"; -# warn "# u = $u\n"; -# warn "# t = $t\n"; -# warn "###\n"; - - for (reverse 0 .. 15) - { - vec($v, $_, 8) = ($j & 0xFF); - $j >>= 8; - } - - push @ret, $self->_fnew([ $v, $mask, $bits ]); -# warn "# add ", $self->_fnew([$v, $mask, $bits]), "\n"; - $i += $u; - } while ($i <= $t); - } - else - { - vec($num, 0, $bits) = _ones $bits; - vec($num, 0, $bits) ^= vec($mask, 0, $bits); - vec($num, 0, $bits) ++; - - for (my $i = vec($net, 0, $bits); - $i <= vec($to, 0, $bits); - $i += vec($num, 0, $bits)) - { - vec($v, 0, $bits) = $i; - push @ret, $self->_fnew([ $v, $mask, $bits ]); - } - } - } - - return \@ret; -} - -=pod - -=item C<-Ehostenum()> - -Returns the list of hosts within a subnet. - -=cut - -sub hostenum ($) { - return @{$_[0]->hostenumref}; -} - -=pod - -=item C<-Ehostenumref()> - -Faster version of C<-Ehostenum()>, returning a reference to a list. - -=cut - -sub hostenumref ($) { - my $r = $_[0]->splitref(32); - if ($_[0]->mask ne '255.255.255.255') { - splice(@$r, 0, 1); - splice(@$r, scalar @$r - 1, 1); - } - return $r; -} - -=pod - -=item C<$me-Ecompact($addr1, $addr2, ...)> - -Given a list of objects (including C<$me>), this method will compact -all the addresses and subnets into the largest (ie, least specific) -subnets possible that contain exactly all of the given objects. - -Note that in versions prior to 3.02, if fed with the same IP subnets -multiple times, these subnets would be returned. From 3.02 on, a more -"correct" approach has been adopted and only one address would be -returned. - -Note that C<$me> and all C<$addr>-n must be C objects. - -=cut - -sub compact { - return @{compactref(\@_)}; -} - -*Compact = \&compact; - -=pod - -=item C<$me-Ecoalesce($masklen, $number, @list_of_subnets)> - -Will return a reference to list of C subnets of -C<$masklen> mask length, when C<$number> or more addresses from -C<@list_of_subnets> are found to be contained in said subnet. - -Subnets from C<@list_of_subnets> with a mask shorter than C<$masklen> -are passed "as is" to the return list. - -Subnets from C<@list_of_subnets> with a mask longer than C<$masklen> -will be counted (actually, the number of IP addresses is counted) -towards C<$number>. - -=cut - -sub coalesce -{ - my $masklen = shift; - my $number = shift; - - # Addresses are at @_ - my %ret = (); - - for my $ip (@_) - { - my $n = NetAddr::IP->new($ip->addr . '/' . $masklen)->network; - if ($ip->masklen > $masklen) - { - $ret{$n} += $ip->num + 1; - } - } - - my @ret = (); - - # Add to @ret any arguments with netmasks longer than our argument - for my $c (sort { $a->masklen <=> $b->masklen } - grep { $_->masklen <= $masklen } @_) - { - next if grep { $_->contains($c) } @ret; - push @ret, $c->network; - } - - # Now add to @ret all the subnets with more than $number hits - for my $c (map { new NetAddr::IP $_ } - grep { $ret{$_} >= $number } - keys %ret) - { - next if grep { $_->contains($c) } @ret; - push @ret, $c; - } - - return \@ret; -} - -*Coalesce = \&coalesce; - -=pod - -=item C<$me-Ecompactref(\@list)> - -As usual, a faster version of =item C<-Ecompact()> that returns a -reference to a list. Note that this method takes a reference to a list -instead. - -Note that C<$me> must be a C object. - -=cut - -sub compactref ($) { - my @addr = sort @{$_[0]} - or return []; - - my $bits = $addr[0]->{bits}; - my $changed; - - do { - $changed = 0; - for (my $i = 0; - $i <= $#addr - 1; - $i ++) - { - my $lip = $addr[$i]; - my $hip = $addr[$i + 1]; - - if ($lip->contains($hip)) { - splice(@addr, $i + 1, 1); - ++ $changed; - -- $i; - } - elsif (vec($lip->{mask}, 0, $bits) - == vec($hip->{mask}, 0, $bits)) - { - my $la = $lip->{addr}; - my $ha = $hip->{addr}; - my $nb = ''; - my $na = ''; - my $nm = ''; - - vec($nb, 0, $bits) = - vec($na, 0, $bits) = - vec($la, 0, $bits); - vec($nb, 0, $bits) ^= vec($ha, 0, $bits); - vec($na, 0, $bits) ^= vec($nb, 0, $bits); - vec($nm, 0, $bits) = vec($lip->{mask}, 0, $bits); - vec($nm, 0, $bits) <<= 1; - - if (("$la" & "$nm") eq ("$ha" & "$nm")) - { - if ("$la" eq "$ha") { - splice(@addr, $i + 1, 1); - } - else { - $addr[$i] = ($lip->_fnew([ "$na" & "$nm", - $nm, $bits ])); - splice(@addr, $i + 1, 1); - } - - -- $i; - ++ $changed; - } - } - } - } while ($changed); - - return \@addr; -} - -=pod - -=item C<-Efirst()> - -Returns a new object representing the first useable IP address within -the subnet (ie, the first host address). - -=cut - -sub first ($) { - my $self = shift; - - return $self->network + 1; -} - -=pod - -=item C<-Elast()> - -Returns a new object representing the last useable IP address within -the subnet (ie, one less than the broadcast address). - -=cut - -sub last ($) { - my $self = shift; - - return $self if $self->masklen == $self->{bits}; - - return $self->broadcast - 1; -} - -=pod - -=item C<-Enth($index)> - -Returns a new object representing the I-th useable IP address within -the subnet (ie, the I-th host address). If no address is available -(for example, when the network is too small for C<$index> hosts), -C is returned. - -=cut - -sub nth ($$) { - my $self = shift; - my $count = shift; - - return undef if ($count < 1 or $count > $self->num ()); - return $self->network + $count; -} - -=pod - -=item C<-Enum()> - -Returns the number of useable addresses IP addresses within the -subnet, not counting the broadcast address. - -=cut - -sub num ($) { - my $self = shift; - return ~vec($self->{mask}, 0, $self->{bits}) & 0xFFFFFFFF; -} - -=pod - -=item C<-Ere()> - -Returns a Perl regular expression that will match an IP address within -the given subnet. This is currently only implemented for IPv4 -addresses. - -=cut - -sub re ($) -{ - my $self = shift->network; # Insure a "zero" host part - return unless $self->bits == 32; - my ($addr, $mlen) = ($self->addr, $self->masklen); - my @o = split('\.', $addr, 4); - - my $octet= '(?:[0-9]|[1-9][0-9]|1[0-9][0-9]|2[0-4][0-9]|25[0-5])'; - my @r = @o; - my $d; - -# for my $i (0 .. $#o) -# { -# warn "# $self: $r[$i] == $o[$i]\n"; -# } - - if ($mlen != 32) - { - 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; - $r[2] = '(?:' . join('|', ($o[2]..$o[2] + $d)) . ')'; - } - 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; - $r[0] = '(?:' . join('|', ($o[0] .. $o[0] + $d)) . ')'; - } - else { $r[0] = $octet; } - } - } - } - } - - ### no digit before nor after (look-behind, look-ahead) - return "(?:(?first and -Elast methods. Version changed to 0.03. - -=back - - -=item 1.00 - -=over - - -=item * - -Implemented -Enew_subnet. Version changed to 1.00. - -=item * - -less croak()ing when improper input is fed to the module. A -more consistent 'undef' is returned now instead to allow the -user to better handle the error. - -=back - - -=item 1.10 - -=over - - -=item * - -As per Marnix A. Van Ammers [mav6@ns02.comp.pge.com] -suggestion, changed the syntax of the loop in host_enum to -be the same of the enum method. - -=item * - -Fixed the MS-DOS ^M at the end-of-line problem. This should -make the module easier to use for *nix users. - -=back - - -=item 1.20 - -=over - - -=item * - -Implemented -Ecompact and -Eexpand methods. - -=item * - -Applying for official name - -=back - - -=item 1.21 - -=over - - -=item * - -Added -Eaddr_number and -Emask_bits. Currently we return -normal numbers (not BigInts). Please test this in your -platform and report any problems! - -=back - - -=item 2.00 - -=over - - -=item * - -Released under the new *official* name of NetAddr::IP - -=back - - -=item 2.10 - -=over - - -=item * - -Added support for -Enew($min, $max, $bits) form - -=item * - -Added -Eto_numeric. This helps serializing objects - -=back - - -=item 2.20 - -=over - - -=item * - -Chris Dowling reported that the sort method introduced in -v1.20 for -Eexpand and -Ecompact doesn't always return a -number under perl versions < 5.6.0. His fix was applied and -redistributed. Thanks Chris! - -=item * - -This module is hopefully released with no CR-LF issues! - -=item * - -Fixed a warning about uninitialized values during make test - -=back - - -=item 2.21 - -=over - - -=item * - -Dennis Boylan pointed out a bug under Linux and perhaps -other platforms as well causing the error "Sort subroutine -didn't return single value at -/usr/lib/perl5/site_perl/5.6.0/NetAddr/IP.pm line 299, EE -line 2." or similar. This was fixed. - -=back - - -=item 2.22 - -=over - - -=item * - -Some changes suggested by Jeroen Ruigrok and Anton Berezin -were included. Thanks guys! - -=back - - -=item 2.23 - -=over - - -=item * - -Bug fix for /XXX.XXX.XXX.XXX netmasks under v5.6.1 suggested -by Tim Wuyts. Thanks! - -=item * - -Tested the module under MACHTYPE=hppa1.0-hp-hpux11.00. It is -now konwn to work under Linux (Intel/AMD), Digital Unix -(Alpha), Solaris (Sun), HP-UX11 (HP-PA-RISC), Windows -9x/NT/2K (using ActiveState on Intel). - -=back - - -=item 2.24 - -=over - - -=item * - -A spurious warning when expand()ing with -w under certain -circumstances was removed. This involved using /31s, /32s -and the same netmask as the input. Thanks to Elie Rosenblum -for pointing it out. - -=item * - -Slight change in license terms to ease redistribution as a -Debian package. - -=back - - -=item 3.00 - -This is a major rewrite, supposed to fix a number of issues pointed -out in earlier versions. - -The goals for this version include getting rid of BigInts, speeding up -and also cleaning up the code, which is written in a modular enough -way so as to allow IPv6 functionality in the future, taking benefit -from most of the methods. - -Note that no effort has been made to remain backwards compatible with -earlier versions. In particular, certain semantics of the earlier -versions have been removed in favor of faster performance. - -This version was tested under Win98/2K (ActiveState 5.6.0/5.6.1), -HP-UX11 on PA-RISC (5.6.0), RedHat Linux 6.2 (5.6.0), Digital Unix on -Alpha (5.6.0), Solaris on Sparc (5.6.0) and possibly others. - -=item 3.01 - -=over - -=item * - -Added C<-Enumeric()>. - -=item * - -C<-Enew()> called with no parameters creates a B -NetAddr::IP object. - -=back - -=item 3.02 - -=over - -=item * - -Fxed C<-Ecompact()> for cases of equal subnets or -mutually-contained IP addresses as pointed out by Peter Wirdemo. Note -that now only distinct IP addresses will be returned by this method. - -=item * - -Fixed the docs as suggested by Thomas Linden. - -=item * - -Introduced overloading to ease certain common operations. - -=item * - - Fixed compatibility issue with C<-Enum()> on 64-bit processors. - -=back - -=item 3.03 - -=over - -=item * - -Added more comparison operators. - -=item * - -As per Peter Wirdemo's suggestion, added C<-Ewildcard()> for -producing subnets in wildcard format. - -=item * - -Added C<++> and C<+> to provide for efficient iteration operations -over all the hosts of a subnet without C<-Eexpand()>ing it. - -=back - -=item 3.04 - -=over - -=item * - -Got rid of C when invalid input was fed to C<-Enew()>. - -=item * - -As suggested by Andrew Gaskill, added support for prefix -notation. Thanks for the code of the initial C<-Eprefix()> -function. - -=back - -=item 3.05 - -=over - -=item * - -Added support for range notation, where base and broadcast addresses -are given as arguments to C<-Enew()>. - -=back - -=item 3.06 - -=over - -=item * - -Andrew Ruthven pointed out a bug related to proper interpretation of -"compact" CIDR blocks. This was fixed. Thanks! - -=back - -=item 3.07 - -=over - -=item * - -Sami Pohto pointed out a bug with C<-Elast()>. This was fixed. - -=item * - -A small bug related to parsing of 'localhost' was fixed. - -=back - -=item 3.08 - -=over - -=item * - -By popular request, C<-Enew()> now checks the sanity of the netmasks -it receives. If the netmask is invalid, C will be returned. - -=back - -=item 3.09 - -=over - -=item * - -Fixed typo that invalidated otherwise correct masks. This bug appeared in 3.08. - -=back - -=item 3.10 - -=over - -=item * - -Fixed relops. Semantics where adjusted to remove the netmask from the -comparison. (ie, it does not make sense to say that 10.0.0.0/24 is > -10.0.0.0/16 or viceversa). - -=back - -=item 3.11 - -=over - -=item * - -Thanks to David D. Zuhn for contributing the C<-Enth()> method. - -=item * - -tutorial.htm now included in the distribution. I hope this helps some -people to better understand what kind of stuff can be done with this -module. - -=item * - -C<'any'> can be used as a synonim of C<'default'>. Also, C<'host'> is -now a valid (/32) netmask. - -=back - -=item 3.12 - -=over - -=item * - -Added CVS control files, though this is of no relevance to the community. - -=item * - -Thanks to Steve Snodgrass for pointing out a bug in the processing of -the special names such as default, any, etc. A fix was produced and -adequate tests were added to the code. - -=item * - -First steps towards "regexp free" parsing. - -=item * - -Documentation revisited and reorganized within the file, so that it -helps document the code. - -=item * - -Added C<-Eaton()> and support for this format in -C<-Enew()>. This makes the code helpful to interface with -old-style socket code. - -=back - -=item 3.13 - -=over - -=item * - -Fixes a warning related to 'wrapping', introduced in 3.12 in -C/C for the new support for C<-Eaton()>. - -=back - -=item 3.14 - -=over - -=item * - -C in Solaris seems to behave a bit different -from other OSes. Reversed change in 3.13 and added code around this -difference. - -=back - -=item 3.14_1 - -This is an interim release just to incorporate the v6 patches -contributed. No extensive testing has been done with this support -yet. More tests are needed. - -=over - -=item * - -Preliminary support for IPv6 contributed by Kadlecsik Jozsi -Ekadlec at sunserv.kfki.huE. Thanks a lot! - -=item * - -IP.pm and other files are enconded in ISO-8859-1 (Latin1) so that I -can spell my name properly. - -=item * - -Tested under Perl 5.8.0, no surprises found. - -=back - -=item 3.14_2 - -Minor development release. - -=over - -=item * - -Added C<-Eversion> and C<-Ebits>, including testing. - -=item * - -C can now be exported if the user so requests. - -=item * - -Fixed a bug when octets in a dotted quad were > 256 (ie, were not -octets). Thanks to Anton Berezin for pointing this out. - -=back - -=item 3.14_3 - -Fixed a bug pointed out by Brent Imhoff related to the implicit -comparison that happens within C. The netmask was being -ignored in the comparison (ie, 10/8 was considered the same as -10.0/16). Since some people have requested that 10.0/16 was considered -larger than 10/8, I added this change, which makes the bug go -away. This will be the last '_' release, pending new bugs. - -Regarding the comparison of subnets, I'm still open to debate so as to -wether 10.0/16 > 10/8. Certainly 255.255.0.0 > 255.0.0.0, but 2 ** 24 -are more hosts than 2 ** 16. I think we might use gt & friends for -this semantic and make everyone happy, but I won't do anything else -here without (significant) feedback. - -=item 3.14_4 - -As noted by Michael, 127/8 should be 127.0.0.0/8 and not -0.0.0.128/8. Also, improved docs on the usage of contains() and -friends. - -=item 3.15 - -Finally. Added POD tests (and fixed minor doc bug in IP.pm). As -reported by Anand Vijay, negative numbers are assumed to be signed -ints and converted accordingly to a v4 address. split() and nth() now -work with IPv6 addresses (Thanks to Venkata Pingali for -reporting). Tests were added for v6 base functionality and -splitting. Also tests for bitwise aritmethic with long integers has -been added. I'm afraid Math::BigInt is now required. - -Note that IPv6 might not be as solid as I would like. Be careful... - -=item 3.16 - -Fixed a couple of (minor) bugs in shipped tests in the last -version. Also, fixed a small pod typo that caused code to show up in -the documentation. - -=item 3.17 - -Fixed IP.pm so that all test could pass in Solaris machines. Thanks to -all who reported this. - -=item 3.18 - -Fixed some bugs pointed out by David Lloyd, having to do with the -module packaging and version requirements. Thanks David! - -=item 3.19 - -Fixed a bug pointed out by Andrew D. Clark, regarding proper parsing -of IP ranges with non-contiguous masks. Thanks Andrew! - -=item 3.20 - -Suggestion by Reuland Olivier gave birth to C, which provides -for a compact representation of the IP address. Rewrote C<_compact> to -find the longest sequence of zeros to compact. Reuland also pointed -out a flaw in contains() and within(), which was fixed. Thanks -Reuland! - -Fixed rt bug #5478 in t/00-load.t. - -=item 3.21 - -Fixed minor v-string problem pointed out by Steve Snodgrass (Thanks -Steve!). NetAddr::IP can now collaborate with Storable to serialize -itself. - -=item 3.22 - -Fixed bug rt.cpan.org #7070 reported by Grover Browning (auto-inc/dec -on v6 fails). Thanks Grover. Ruben van Staveren pointed out a bug in -v6 canonicalization, as well as providing a patch that was -applied. Thanks Ruben. - -=item 3.23 - -Included support for Module::Signature. Added -Ere() as -contributed by Laurent Facq (Thanks Laurent!). Added Coalesce() as -suggested by Perullo. - -=item 3.24 - -Version bump. Transfer of 3.23 to CPAN ended up in a truncated file -being uploaded. - -=item 3.25 - -Some IP specs resembling range notations but not depicting actual CIDR -ranges, were being erroneously recognized. Thanks to Steve Snodgrass -for reporting a bug with parsing IP addresses in 4-octet binary -format. Added optional Pod::Coverage tests. compact_addr has been -commented out, after a long time as deprecated. Improved speed of --Enew() for the case of a single host IPv4 address, which seems to -be the most common one. - -=back - -$Log: IP.pm,v $ -Revision 3.32 2006/05/01 17:11:18 lem -Force update as upload failed - -Revision 3.31 2006/05/01 16:47:15 lem -Fixed CPAN #16754, version contained a space - -Revision 3.30 2006/05/01 15:31:19 lem -Moved DNS resolution to the last spot in the chain, before special -keywords, as suggested by Kevin Brintnall - Thanks! - -Revision 3.29 2005/10/05 18:01:30 lem -Change version digits back to previous levels - -Revision 3.28 2005/09/28 23:56:52 lem -Each revision will now add the CVS log to the docs automatically. - - -=head1 AUTHOR - -Luis E. Muñoz - -=head1 WARRANTY - -This software comes with the same warranty as perl itself (ie, none), -so by using it you accept any and all the liability. - -=head1 LICENSE - -This software is (c) Luis E. Muñoz. It can be used under the terms of -the perl artistic license provided that proper credit for the work of -the author is preserved in the form of this copyright notice and -license for this module. - -=head1 SEE ALSO - -perl(1). - -=cut - diff --git a/t/00-Sign.t b/t/00-Sign.t deleted file mode 100644 index 09db4b4..0000000 --- a/t/00-Sign.t +++ /dev/null @@ -1,24 +0,0 @@ -#!/usr/bin/perl -use strict; -$|++; - -print "1..1\n"; - -if (!-s 'SIGNATURE') { - print "ok 1 # skip No signature file found\n"; - } -elsif (!eval { require Module::Signature; 1 }) { - print "ok 1 # skip ", - "Next time around, consider install Module::Signature, ", - "so you can verify the integrity of this distribution.\n"; -} -elsif (!eval { require Socket; Socket::inet_aton('pgp.mit.edu') }) { - print "ok 1 # skip Cannot connect to the keyserver\n"; - } -else { - (Module::Signature::verify() == Module::Signature::SIGNATURE_OK()) - or print "not "; - print "ok 1 # Valid signature\n"; - } - -__END__ diff --git a/t/00-load.t b/t/00-load.t deleted file mode 100644 index f11c7d2..0000000 --- a/t/00-load.t +++ /dev/null @@ -1,67 +0,0 @@ -# Generic load/POD test suite - -# $Id: 00-load.t,v 1.6 2006/05/01 15:24:50 lem Exp $ - -use Test::More; - -my @modules = qw/ - NetAddr::IP - /; - -my @paths = (); - -plan tests => 3 * scalar @modules; - -use_ok($_) for @modules; - -my $checker = 0; -my $coverage = 0; - -eval { require Test::Pod; - Test::Pod::import(); - $checker = 1; }; - -eval { require Pod::Coverage; - Pod::Coverage::import(); - $coverage = 1; }; - -for my $m (@modules) -{ - my $p = $m . ".pm"; - $p =~ s!::!/!g; - push @paths, $INC{$p}; -} - -SKIP: { - skip "Test::Pod is not available on this host", scalar @paths - unless $checker; - pod_file_ok($_) for @paths; -} - -SKIP: { skip "Pod::Coverage is not available on this host", scalar @paths - unless $coverage; - - for my $m (@modules) - { - my $pc = Pod::Coverage->new(package => $m, - also_private => [qr/^STORABLE_/, - qr/^new4$/, - qr/^expand_v6$/, - qr/^do_prefix$/, - ], - trustme => [ qr/^Coalesce$|^Compact$/, - qr/^(plus){1,2}$/, - qr/^(minus){1,2}$/ - ], - ); - unless (is($pc->coverage, 1, "Coverage for $m")) - { -# diag "Symbols covered:\n", -# join("\n", map { " " . $_ } $pc->covered); - diag "Symbols NOT covered:\n", - join("\n", map { " " . $_ } $pc->naked); - } - } - } - - diff --git a/t/bitops.t b/t/bitops.t deleted file mode 100644 index 4ef4ca8..0000000 --- a/t/bitops.t +++ /dev/null @@ -1,64 +0,0 @@ -# This code exercises some common functions that are used in parts -# of v6 management of IP.pm. It is intended as a reference in case -# of failure - -# $Id: bitops.t,v 1.1 2003/10/09 00:14:06 lem Exp $ - -use Test::More; -use NetAddr::IP; -use Math::BigInt; - -my @bases = (); # Base set of trivial numbers -my @convs = (); # Numbers after conversion / de-conversion -my @minus = (); # Bases minus one -my @plus = (); # Bases plus one - -for my $i (0 .. 127) -{ - my $I = new Math::BigInt 1; - $I <<= $i; - push @bases, $I; - $I = new Math::BigInt 3; - $I <<= $i; - push @bases, $I; -} - -pop @bases; - -plan tests => scalar @bases; - - # Test conversion back and forth - # to/from a suitable vec() - -for my $i (0 .. $#bases) # Build the actual conversion -{ - my $v = ''; - my $I = $bases[$i]->copy; - - for my $j (reverse 0 .. 15) - { - vec($v, $j, 8) = ($I & 0xFF); - $I >>= 8; - } - -# print "# "; -# printf "%02x", $_ for map { ord $_ } split //, $v; -# print "\n"; - - push @convs, $v; -} - -for my $i (0 .. $#bases) # Test reversibility -{ - my $I = new Math::BigInt 0; - for my $o (0 .. 15) - { - $I <<= 8; - $I |= vec($convs[$i], $o, 8); -# print "I = $I ($o)\n"; - } - - is($bases[$i], $I, "$bases[$i] == $I [$i]"); -} - - diff --git a/t/imhoff.t b/t/imhoff.t old mode 100755 new mode 100644 index b750eaf..7aafbdc --- a/t/imhoff.t +++ b/t/imhoff.t @@ -5,7 +5,7 @@ # without caring about the order of its arguments. -lem use strict; -use warnings; +#use warnings; use Test::More tests => 3; use NetAddr::IP qw(Compact); diff --git a/t/new-store.t b/t/new-store.t index 82d8b15..0875062 100644 --- a/t/new-store.t +++ b/t/new-store.t @@ -1,5 +1,4 @@ # t/new-store.t - test new Storable related - methods -# $Id: new-store.t,v 1.1 2004/10/11 15:40:29 lem Exp $ use Test::More; @@ -9,8 +8,8 @@ SKIP: { - skip "Failed to use Storable", $tests - unless use_ok("Storable", 'freeze', 'thaw'); + skip "Failed to use Storable, module not found", $tests + unless eval {require Storable && use_ok("Storable", 'freeze', 'thaw')}; skip "Failed to use NetAddr::IP", $tests unless use_ok("NetAddr::IP"); diff --git a/t/old-store.t b/t/old-store.t index a732fae..598c90c 100644 --- a/t/old-store.t +++ b/t/old-store.t @@ -1,5 +1,4 @@ # t/old-store.t - test backwards compatible Storable interaction -# $Id: old-store.t,v 1.1 2004/10/11 15:40:29 lem Exp $ use Test::More; @@ -9,8 +8,8 @@ SKIP: { - skip "Failed to use Storable", $tests - unless use_ok("Storable", 'freeze', 'thaw'); + skip "Failed to use Storable, module not found", $tests + unless eval { require Storable && use_ok("Storable", 'freeze', 'thaw')}; skip "Failed to use NetAddr::IP", $tests unless use_ok("NetAddr::IP", ':old_storable'); diff --git a/t/over-arr.t b/t/over-arr.t index 092442a..5dd962e 100644 --- a/t/over-arr.t +++ b/t/over-arr.t @@ -1,6 +1,5 @@ use NetAddr::IP; - -# $Id: over-arr.t,v 1.2 2002/10/31 04:30:35 lem Exp $ +use Test::More; my @addr = ( [ '10.0.0.0/24', '10.0.0.1/32' ], [ '192.168.0.0/24', '192.168.0.1/32' ], @@ -8,19 +7,14 @@ $| = 1; -print "1..", 1 * scalar @addr, "\n"; +$tests = @addr; -my $count = 1; +plan tests => $tests; -for my $a (@addr) { +SKIP: { + skip "overload dereferencing not supported in version $] of Perl", $tests, unless ($overload::ops{dereferencing} && $overload::ops{dereferencing} =~ /\@\{\}/); + for my $a (@addr) { my $ip = new NetAddr::IP $a->[0]; - - if (@$ip[0]->cidr eq $a->[1]) { - print "ok $count\n"; - } - else { - print "not ok $count\n"; - } - - ++$count; -} + ok(@$ip[0]->cidr eq $a->[1],$a->[0]); + } +}; diff --git a/t/short.t b/t/short.t index b6cc561..8b95561 100644 --- a/t/short.t +++ b/t/short.t @@ -7,7 +7,7 @@ '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', + 'DEAD:BEEF::1' => 'dead:beef::1', '::1' => '::1', '::' => '::', '2001:620:600::1' => '2001:620:600::1', diff --git a/t/v4-badnm.t b/t/v4-badnm.t index d5d4511..43520de 100644 --- a/t/v4-badnm.t +++ b/t/v4-badnm.t @@ -7,7 +7,7 @@ $| = 1; -our @badnets = ( +my @badnets = ( '10.10.10.10/255.255.0.255', '10.10.10.10/255.0.255.255', '10.10.10.10/0.255.255.255', @@ -23,7 +23,7 @@ '58.26.0.0-58.27.127.255', # Taken from APNIC's WHOIS case ); -our @goodnets = (); +my @goodnets = (); push @goodnets, "10.0.0.1/$_" for (0 .. 32); push @goodnets, "10.0.0.1/255.255.255.255"; diff --git a/t/v4-coalesce.t b/t/v4-coalesce.t index 7a3dd44..61d3d77 100644 --- a/t/v4-coalesce.t +++ b/t/v4-coalesce.t @@ -1,8 +1,11 @@ use Test::More; -# $Id: v4-coalesce.t,v 1.2 2005/03/24 20:47:40 lem Exp $ +if (defined($ENV{LIGHTERIPTESTS}) and $ENV{LIGHTERIPTESTS} =~ /yes/i) { + print "1..0 # Skipped: LIGHTERIPTESTS = yes\n"; + exit 0; +} -plan tests => 11; +plan tests => 21; die "# Cannot continue without NetAddr::IP\n" unless use_ok('NetAddr::IP', 'Coalesce'); @@ -18,26 +21,34 @@ push @ips, new NetAddr::IP "10.0.$o.100"; } +sub tst { # This should return the empty list... -my $r = Coalesce(24, 4, @ips); -diag "Coalesce returned $r" + my $r = Coalesce(24, 4, @ips); + diag "Coalesce returned $r" unless isa_ok($r, 'ARRAY', 'Return type from Coalesce'); -is(@$r, 0, "Empty array returned as expected"); + is(@$r, 0, "Empty array returned as expected"); # This should produce a list with all the /24s -$r = Coalesce(24, 2, @ips); -diag "Coalesce returned $r" + $r = Coalesce(24, 2, @ips); + diag "Coalesce returned $r" unless isa_ok($r, 'ARRAY', 'Return type from Coalesce'); -is(@$r, 256, "Whole result set as expected"); -my @c = NetAddr::IP::Compact(@$r); -is(@c, 1, "Results are compactable"); -ok($c[0] eq '10.0.0.0/16', "Correct results"); + is(@$r, 256, "Whole result set as expected"); + my @c = NetAddr::IP::Compact(@$r); + is(@c, 1, "Results are compactable"); + ok($c[0] eq '10.0.0.0/16', "Correct results"); # This should produce the same result as before, with an added /23 -$r = Coalesce(24, 2, @ips, NetAddr::IP->new('10.0.0.125/23')); -diag "Coalesce returned $r" + $r = Coalesce(24, 2, @ips, NetAddr::IP->new('10.0.0.125/23')); + diag "Coalesce returned $r" unless isa_ok($r, 'ARRAY', 'Return type from Coalesce'); -ok((grep { $_ eq '10.0.0.0/23' } @$r), "/23 went through"); -@c = NetAddr::IP::Compact(@$r); -is(@c, 1, "Results are compactable"); -ok($c[0] eq '10.0.0.0/16', "Correct results"); + ok((grep { $_ eq '10.0.0.0/23' } @$r), "/23 went through"); + @c = NetAddr::IP::Compact(@$r); + is(@c, 1, "Results are compactable"); + ok($c[0] eq '10.0.0.0/16', "Correct results"); +} + +tst(); + +import NetAddr::IP qw(:old_nth); + +tst(); diff --git a/t/v4-compact.t b/t/v4-compact.t index 991331b..7aac06d 100644 --- a/t/v4-compact.t +++ b/t/v4-compact.t @@ -14,7 +14,7 @@ $| = 1; if (defined($ENV{LIGHTERIPTESTS}) and $ENV{LIGHTERIPTESTS} =~ /yes/i) { - print "1..0\n"; + print "1..0 # Skipped: LIGHTERIPTESTS = yes\n"; exit 0; } diff --git a/t/v4-first.t b/t/v4-first.t deleted file mode 100644 index 270dce3..0000000 --- a/t/v4-first.t +++ /dev/null @@ -1,32 +0,0 @@ -use NetAddr::IP; - -# $Id: v4-first.t,v 1.2 2002/10/31 04:30:36 lem Exp $ - -my $nets = { - '10.0.0.16' => [ 24, '10.0.0.1', '10.0.0.254', '10.0.0.10'], - '10.0.0.5' => [ 30, '10.0.0.5', '10.0.0.6', 'undef' ], - '10.128.0.1' => [ 8, '10.0.0.1', '10.255.255.254', '10.0.0.10'], - '10.128.0.1' => [ 24, '10.128.0.1', '10.128.0.254', '10.128.0.10'], -}; - -$| = 1; -print "1..", (3 * scalar keys %$nets), "\n"; - -my $count = 1; - -for my $a (keys %$nets) { - my $ip = new NetAddr::IP $a, $nets->{$a}->[0]; - print '', (($ip->first->addr ne $nets->{$a}->[1] ? - 'not ' : ''), - "ok ", $count++, "\n"); - print '', (($ip->last->addr ne $nets->{$a}->[2] ? - 'not ' : ''), - "ok ", $count++, "\n"); - - my $new = $ip->nth(10); - print '', (((defined $new ? $new->addr : 'undef') ne $nets->{$a}->[3] ? - 'not ' : ''), - "ok ", $count++, "\n"); -} - - diff --git a/t/v4-new.t b/t/v4-new.t index 280f3b1..fb4cbc4 100644 --- a/t/v4-new.t +++ b/t/v4-new.t @@ -1,9 +1,18 @@ use NetAddr::IP; -# $Id: v4-new.t,v 1.8 2003/10/14 18:01:40 lem Exp $ +use Test::More; -BEGIN { -our @a = ( +my $binword; +{ + local $SIG{__WARN__} = sub {}; + $binword = eval "0b11111111111111110000000000000000"; +} +if ($@) { + $binword = 0xffff0000; + print STDERR "\t\tskipped! 0b11111111111111110000000000000000\n\t\tbinary bit strings unsupported in Perl version $]\n"; +} + +@a = ( [ 'localhost', '127.0.0.1' ], [ 0x01010101, '1.1.1.1' ], [ 1, '1.0.0.0' ], # Because it will have a mask. 0.0.0.1 ow @@ -11,9 +20,9 @@ [ 'any', '0.0.0.0' ], [-809041407, '207.199.2.1'], [3485925889, '207.199.2.1'], - ); +); -our @m = ( +@m = ( [ 0, '0.0.0.0' ], [ 1, '128.0.0.0' ], [ 2, '192.0.0.0' ], @@ -28,11 +37,10 @@ [ 0xffffff00, '255.255.255.0' ], [ '255.255.255.240', '255.255.255.240' ], [ '255.255.128.0', '255.255.128.0' ], - [ 0b11111111111111110000000000000000, '255.255.0.0' ], - ); -}; + [ $binword, '255.255.0.0' ], +); -use Test::More tests => (4 * scalar @a * scalar @m) + 4; +plan tests => (4 * scalar @a * scalar @m) + 4; ok(! defined NetAddr::IP->new('256.1.1.1'), "Invalid IP returns undef"); ok(! defined NetAddr::IP->new('256.256.1.1'), "Invalid IP returns undef"); diff --git a/t/v4-num.t b/t/v4-num.t deleted file mode 100644 index ee58d7d..0000000 --- a/t/v4-num.t +++ /dev/null @@ -1,24 +0,0 @@ -use NetAddr::IP; - -# $Id: v4-num.t,v 1.2 2002/10/31 04:30:36 lem Exp $ - -my $nets = { - '10.0.0.16' => [ 24, 255 ], - '10.128.0.1' => [ 8, 2 ** 24 - 1 ], - '10.0.0.5' => [ 30, 3 ], -}; - -$| = 1; -print "1..", (scalar keys %$nets), "\n"; - -my $count = 1; - -for my $a (keys %$nets) { - my $ip = new NetAddr::IP $a, $nets->{$a}->[0]; - - print '', (($ip->num != $nets->{$a}->[1] ? - 'not ' : ''), - "ok ", $count++, "\n"); -} - - diff --git a/t/v4-wnew.t b/t/v4-wnew.t index b366d82..710ca0a 100644 --- a/t/v4-wnew.t +++ b/t/v4-wnew.t @@ -1,8 +1,6 @@ use Test::More tests => 12; use NetAddr::IP; -# $Id: v4-wnew.t,v 1.1 2002/10/31 04:30:37 lem Exp $ - my @good = (qw(default any broadcast loopback)); my @bad = map { ("$_.neveranydomainlikethis", "nohostlikethis.$_") } @good; @@ -10,6 +8,14 @@ ok(defined NetAddr::IP->new($_), "defined ->new($_)") for @good; +my $bad = scalar @bad; + +diag <new($_), "not defined ->new($_)") for @bad; diff --git a/t/v6-base.t b/t/v6-base.t deleted file mode 100644 index 2a15687..0000000 --- a/t/v6-base.t +++ /dev/null @@ -1,55 +0,0 @@ -# This -*- perl -*- code excercises the basic v6 functionality - -# $Id: v6-base.t,v 1.13 2004/03/02 20:33:37 lem Exp $ - -our @addr = - ( - ['::', 3, '0000:0000:0000:0000:0000:0000:0000:0000/128'], - ['::1', 3, '0000:0000:0000:0000:0000:0000:0000:0001/128'], - ['f34::123/40', 3, '0f34:0000:0000:0000:0000:0000:0000:0003/40'], - ['dead:beef::1/40', 3, 'dead:beef:0000:0000:0000:0000:0000:0003/40'], - ['1000::2/40', 1, '1000:0000:0000:0000:0000:0000:0000:0001/40'], - ['1000::2000/40', 1, '1000:0000:0000:0000:0000:0000:0000:0001/40'], - ['dead::cafe/40', 1, 'dead:0000:0000:0000:0000:0000:0000:0001/40'], - ['dead:beef::1/40', 4, 'dead:beef:0000:0000:0000:0000:0000:0004/40'], - ['dead:beef::1/40', 5, 'dead:beef:0000:0000:0000:0000:0000:0005/40'], - ['dead:beef::1/40', 6, 'dead:beef:0000:0000:0000:0000:0000:0006/40'], - ['dead:beef::1/40', 7, 'dead:beef:0000:0000:0000:0000:0000:0007/40'], - ['dead:beef::1/40', 8, 'dead:beef:0000:0000:0000:0000:0000:0008/40'], - ['dead:beef::1/40', 9, 'dead:beef:0000:0000:0000:0000:0000:0009/40'], - ['dead:beef::1/40', 255, 'dead:beef:0000:0000:0000:0000:0000:00ff/40'], - ['dead:beef::1/40', 256, 'dead:beef:0000:0000:0000:0000:0000:0100/40'], - ['dead:beef::1/40', 257, 'dead:beef:0000:0000:0000:0000:0000:0101/40'], - ['dead:beef::1/40', 65536, 'dead:beef:0000:0000:0000:0000:0001:0000/40'], - ['dead:beef::1/40', 65537, 'dead:beef:0000:0000:0000:0000:0001:0001/40'], - ['2001:620:0:4::/64', 1, '2001:0620:0000:0004:0000:0000:0000:0001/64'], - ['3ffe:2000:0:4::/64', 1, '3ffe:2000:0000:0004:0000:0000:0000:0001/64'], - ['2001:620:600::1', 1, '2001:0620:0600:0000:0000:0000:0000:0001/128'], - ['2001:620:600:0:1::1', 1,'2001:0620:0600:0000:0001:0000:0000:0001/128'], - ); - -use NetAddr::IP; -use Test::More; - -my($a, $ip, $test); - -plan tests => 5 * @addr + 4; - -for $a (@addr) { - $ip = new NetAddr::IP $a->[0]; - $a->[0] =~ s,/\d+,,; - isa_ok($ip, 'NetAddr::IP', "$a->[0] "); - is($ip->short, $a->[0], "short returns $a->[0]"); - is($ip->bits, 128, "bits == 128"); - is($ip->version, 6, "version == 6"); - is($ip->nth($a->[1]), $a->[2], "nth $a->[0], $a->[1]"); -} - -$test = new NetAddr::IP 'f34::1'; -isa_ok($test, 'NetAddr::IP'); -ok($test->network->contains($test), "->contains"); - -$test = new NetAddr::IP 'f35::1/40'; -isa_ok($test, 'NetAddr::IP'); -ok($test->network->contains($test), "->contains"); - diff --git a/t/v6-re.t b/t/v6-re.t new file mode 100644 index 0000000..d175bf7 --- /dev/null +++ b/t/v6-re.t @@ -0,0 +1,69 @@ +#use diagnostics; +use Test::More; +use NetAddr::IP; +use NetAddr::IP::Util qw(addconst); + +my @ips = qw! + ::0:0f00 + ::FF:1e10 + ::ffFF:2d20 + ::eFF:3c30 + ::eeFF:4b40 + ::FF:5a50 + ::FF:6960 + ::FF:7870 + ::FF:8780 + ::FF:9690 + ::FF:a5a0 + ::FF:b4b0 + ::FF:c3c0 + ::FF:d2d0 + ::FF:e1e0 + ::FF:f0f0 +!; +my @mask = qw! 127 126 125 124 123 122 121 120 !; + +if (defined($ENV{LIGHTERIPTESTS}) and $ENV{LIGHTERIPTESTS} =~ /yes/i) { + pop @mask; pop @mask; +} + +my $tests = 0; +my @addrs; +foreach(@mask) { + foreach my $ip (@ips) { + push @addrs, new NetAddr::IP($ip,$_); + } + $tests += ((2**(128 - $_)) * @ips) +} + +$tests += (5 * @ips * @mask); + +plan tests => $tests; + +for my $a (@addrs) +{ + isa_ok($a, 'NetAddr::IP'); + my $re = $a->re6; + my $rx; + + eval { $rx = qr/$re/ }; + diag "Compilation of the resulting regular expression failed: $@" + unless ok(!$@, "Compilation of the resulting regular expression"); + + for (my $ip = $a->network; + $ip < $a->broadcast && $a->masklen != 128; + $ip ++) + { + ok($a->addr =~ m/$rx/, "Match of $ip in $a"); + } + + ok($a->broadcast->addr =~ m/$rx/, "Match of broadcast of $a"); + my $under = $a->network->copy; + $under->{addr} = (addconst($under->{addr},-1))[1]; + my $over = $a->broadcast->copy; + $over->{addr} = (addconst($over->{addr},1))[1]; + ok($under !~ m/$rx/, "$under does not match"); + ok($over !~ m/$rx/, "$over does not match"); + ok(NetAddr::IP->new('::') !~ m/$rx/, ":: does not match"); +} +