Net-IP-1.26/0000755000175000017500000000000012055427257012717 5ustar mvalentemvalenteNet-IP-1.26/Changes0000644000175000017500000000566512055425700014215 0ustar mvalentemvalenteRevision history for Perl extension Net::IP. 1.26 Wed Nov 28 12:00:00 2012 - This version is authored by Ulrich Wisser - 81138 ip types - 80164 hexip does not change when ip changes (fix: hexformat needs to be cleared by set) - 4898 double compression - 73232 invalid ipv6 1:2:3:4:5:6:7 - 73105 invalid ip 1:2 - 73104 expand 1::2::3 - 71042 ip_reverse 2001:4f8:3:36:0:0:0:235 - 45165 ip_range_to_prefix updated documentation - 32232 excepts 61-217-102-8.hinet-ip.hinet.net as range 1.25 Wed May 24 12:00:00 2006 - Math::BigInt is now mandatory - Several bugfixes done 1.24 Tue Oct 18 12:00:00 2005 - Thanks to Frederic Schutz - Bugfix in overlaps function - Updated Makefile - ran perltidy on the code 1.23 Mon Jun 06 12:00:00 2005 - Thanks to Achim Adam - Thanks to Malte S. Stretz - Thanks to Ville Skytta - Bugfixes in ip_reverse - Bugfix in ip_range_to_prefix for /31 subnets 1.22 Mon May 26 11:54:00 2005 - Big Thanks to Achim Adam - Removed 5.008 dependency - Added fix for trailing zeros on reverse IPv4 addresses - Updated 'special' ranges for Ipv4 and IPv6 1.19 Fri Feb 14 11:00:00 2003 - Documentation fix - Testsuite fix 1.18 Thu Feb 13 17:00:00 2003 - Big thanks to Kazuyuki Maejima - Changed definition of overlap constants - overlap constants always exported - set returns an IP object (instead of 1) - added function last_int() - added ++ operator overloading - added IP::Authority check (Nigel Wetters ) - Makefile.PL bugfix 1.16 Wed Dec 18 17:00:00 2002 - Small Bugfixes - Documentation Modifications (by fliptop AT peacecomputers.com) 1.15 Wed Oct 23 15:00:00 2002 - Bugfix release 1.14 Fri Oct 18 15:00:00 2002 - Bugfix release 1.13 Tue Oct 15 12:00:00 2002 - Bugfix in t/ipv4.t 1.12 Tue Oct 15 10:00:00 2002 - This revision is authored by Peter Hatch - Changed "IP -" to "Net::IP -" in NAME section of IP.pm so MakeMaker could grab the abstract - Updated Makefile.PL to include AUTHOR, ABSTRACT_FROM, PL_FILES tags - Added Linux RPM spec file (generated from Net-IP.spec.PL). If package is built by RPM, the script files are put into %{_prefix}/bin instead of into /usr/local/ncc/bin... - Changed the first line in the ipcount and iptab scripts so that MM_Unix::fixin can insert correct sharpbangs - Added function ip_compress_v4_prefix () 1.11 Tue May 28 15:00:00 2002 - added iptab script - added new constructor (IP + size) - added new options to ipcount 1.01 Thu Feb 01 10:46:09 2001 - added option to create multi-prefix ranges (/16,/17) - added a check on validity of prefixes - overlaps function rewritten - bugfix - added print() function 1.00 Thu Jan 18 15:00:00 2001 - First Release 0.01 Mon Nov 6 16:24:05 2000 - original version; created by h2xs 1.18 Net-IP-1.26/Net-IP.spec.PL0000644000175000017500000000137007552756526015154 0ustar mvalentemvalente#$Revision: 1.1 $ do 'IP.pm'; open (X, ">Net-IP.spec") || die "$!\n"; while () { s/\@VERSION\@/$Net::IP::VERSION/e; print X; } close(X); __END__ Summary: Net::IP Perl module Name: perl-Net-IP Version: @VERSION@ Release: 1 Source0: Net-IP-%{version}.tar.gz License: Perl Group: Development/Languages BuildRoot: %{_tmppath}/%{name}-root %description IP - Perl extension for manipulating IPv4/IPv6 addresses %prep %setup -q -n Net-IP-%{version} %{__perl} Makefile.PL INSTALLSCRIPT=%{_prefix}/bin %build %{__make} %install rm -rf $RPM_BUILD_ROOT %{__make} install PREFIX=$RPM_BUILD_ROOT%{_prefix} %clean rm -rf $RPM_BUILD_ROOT %files %defattr(-,root,root) %{_prefix}/lib/perl5/site_perl/*/Net %{_prefix}/lib/perl5/man/man3/* %{_prefix}/bin Net-IP-1.26/iptab0000755000175000017500000000157007552504331013742 0ustar mvalentemvalente#!perl use Net::IP; use strict; print "+----------------------------------------------+ | addrs bits pref class mask | +----------------------------------------------+ "; my ($ip,$size,$class,$bits,$len); my $ip = new Net::IP('0'); for my $len (reverse (0..32)) { $ip->set("0.0.0.0/$len"); $size = $ip->size(); if ($size >=1048576) # 1024*1024 { $size /= 1048576; $size .= 'M'; } elsif ($size >= 1024) { $size /= 1024; $size .= 'K'; }; $len = $ip->prefixlen(); $bits = 32 - $len; if ($bits >= 24) { $class = 2**($bits-24); $class.= 'A'; } elsif ($bits >= 16) { $class = 2**($bits-16); $class.= 'B'; } elsif ($bits >= 8) { $class = 2**($bits-8); $class.= 'C'; } printf ("| %5s %6s %6s %7s %-15s |\n", $size,$bits,'/'.$len,$class,$ip->mask()); }; print "+----------------------------------------------+\n"; Net-IP-1.26/t/0000755000175000017500000000000012055427257013162 5ustar mvalentemvalenteNet-IP-1.26/t/ipv6.t0000644000175000017500000001626112055427206014233 0ustar mvalentemvalenteuse lib "./t"; use ExtUtils::TBone; use Net::IP qw(:PROC); BEGIN { if (eval (require Math::BigInt)) { $math_bigint = 1; }; }; my $numtests = 28; # Create checker: my $T = typical ExtUtils::TBone; $numtests++ if $math_bigint; $numtests += 28 * 1000 + 8; # IPv6 network type tests $T->begin($numtests); #------------------------------------------------------------------------------ $ip = new Net::IP('dead:beef:0::/48',6); $T->ok (defined($ip),$Net::IP::ERROR); $T->ok_eq ($ip->binip(),'11011110101011011011111011101111000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000',$ip->error()); $T->ok_eq ($ip->ip(),'dead:beef:0000:0000:0000:0000:0000:0000',$ip->error()); $T->ok_eq ($ip->short(),'dead:beef::',$ip->error()); $T->ok_eq ($ip->hexip(),'0xdeadbeef000000000000000000000000',$ip->error()); $T->ok_eq ($ip->hexmask(),'0xffffffffffff00000000000000000000',$ip->error()); $T->ok_eqnum ($ip->prefixlen(),48,$ip->error()); $T->ok_eqnum ($ip->version(),6,$ip->error()); $T->ok_eq ($ip->mask(),'ffff:ffff:ffff:0000:0000:0000:0000:0000',$ip->error()); if ($math_bigint) { my $n = new Math::BigInt ('295990755014133383690938178081940045824'); $T->ok_eqnum ($ip->intip(),$n,$ip->error()); } $T->ok_eq ($ip->iptype(),'RESERVED',$ip->error()); $T->ok_eq ($ip->reverse_ip(),'0.0.0.0.f.e.e.b.d.a.e.d.ip6.arpa.',$ip->error()); $T->ok_eq ($ip->last_ip(),'dead:beef:0000:ffff:ffff:ffff:ffff:ffff',$ip->error()); $ip->set('202.31.4/24',4); $T->ok_eq ($ip->ip(),'202.31.4.0',$ip->error()); $ip->set(':1/128'); $T->ok_eq ($ip->error(),'Invalid address :1 (starts with :)',$ip->error()); $T->ok_eqnum ($ip->errno(),109,$ip->error()); $ip->set('ff00:0:f000::'); $ip2 = new Net::IP('0:0:1000::'); $T->ok_eq ($ip->binadd($ip2)->short(),'ff00:1::',$ip->error()); $ip->set('::e000:0/112'); $ip2->set('::e001:0/112'); $T->ok_eqnum ($ip->aggregate($ip2)->prefixlen(),111,$ip->error()); $ip2->set('::dfff:ffff'); $T->ok_eqnum ($ip->bincomp('gt',$ip2),1,$ip->error()); $ip->set('::e000:0 - ::e002:42'); $T->ok_eq (($ip->find_prefixes())[2],'0000:0000:0000:0000:0000:0000:e002:0040/127',$ip->error()); $ip->set('ffff::/16'); $ip2->set('8000::/16'); $T->ok_eqnum ($ip->overlaps($ip2),$IP_NO_OVERLAP,$ip->error()); # regression test bug 74898 RT $T->ok_eq( ip_compress_address ("2221:0:0:f800::1", 6), '2221:0:0:f800::1'); # regression test bug 73232 RT $T->ok( !ip_is_ipv6('1:2:3:4:5:6:7'), 'Invalid IPv6 1:2:3:4:5:6:7'); $T->ok( ip_is_ipv6('::1'), 'Valid ip ::1'); $T->ok( ip_is_ipv6('2001::'), 'Valid ip 2001::'); $T->ok( !ip_is_ipv6("1:2") , 'Invalid ip 1:2'); # bug 73105 RT # regression test bug 73104 RT $T->ok( !defined ip_expand_address("1::2::3",6), 'Expand invalid 1::2::3'); $T->ok_eq(Error(), 'Too many :: in ip'); $T->ok_eqnum(Errno(), 102); # regression test bug 71042 RT $T->ok_eq( ip_reverse("2001:4f8:3:36:0:0:0:235", 128, 6), '5.3.2.0.0.0.0.0.0.0.0.0.0.0.0.0.6.3.0.0.3.0.0.0.8.f.4.0.1.0.0.2.ip6.arpa.'); $T->ok_eq( ip_reverse("2001:4f8:3:36::235", 128, 6), '5.3.2.0.0.0.0.0.0.0.0.0.0.0.0.0.6.3.0.0.3.0.0.0.8.f.4.0.1.0.0.2.ip6.arpa.'); #------------------------------------------------------------------------------ # test for network types sub v6_expand { my ($ip) = @_; # Keep track of :: $ip =~ s/::/:!:/; # IP as an array my @ip = split /:/, $ip; # prepare result string $ip = ''; # go through all octets foreach (@ip) { # insert octet divider $ip .= ':' if length($ip); # replace ! with 0 octets if ($_ eq '!') { my $num_of_zero_octets = 9 - scalar(@ip); $ip .= ('0000:' x ($num_of_zero_octets - 1)) . '0000'; next; } # Add missing trailing 0s $ip .= ('0' x (4 - length($_))) . $_; } return lc($ip); } sub rbin { return int(2*rand); } sub ip2bin { my $ip = v6_expand(shift); $ip =~ s/://g; return unpack('B128', pack('H32', $ip)); } sub bin2ip { return join(':', unpack('H4H4H4H4H4H4H4H4', pack('B128', shift))); } sub v6_first { my $network = shift; while (length $network < 128) { $network .= '0'; } return bin2ip($network); } sub v6_last { my $network = shift; while (length $network < 128) { $network .= '1'; } return bin2ip($network); } sub v6_rand { my $network = shift; while (length $network < 128) { $network .= rbin(); } return bin2ip($network); } sub v6_okeq { my $ip = Net::IP->new(shift); $T->msg('IPv6: '.$ip->print ); $T->ok_eq ($ip->iptype(), shift, $ip->error()); return; } sub v6_nettest { my $ip = shift; my $prefix = shift; my $iptype = shift; my $numoftests = shift; my $network = substr( ip2bin($ip), 0, $prefix); die "ERROR! At least 3 tests must be run." if $numoftests < 3; v6_okeq( v6_first( $network ), $iptype ); v6_okeq( v6_last( $network ), $iptype ); $numoftests -= 2; while ($numoftests--) { v6_okeq( v6_rand( $network ), $iptype ); } # done return; } # this net is not complete of type RESERVED, test only parts #v6_nettest('::', 8, 'RESERVED', 1000); v6_nettest('::', 128, 'UNSPECIFIED', 3); v6_nettest('::1', 128, 'LOOPBACK', 3); v6_nettest('::FFFF:0:0', 96, 'IPV4MAP', 1000); v6_nettest('80::', 9, 'RESERVED', 1000); # this net is not complete of type RESERVED, test oly parts #v6_nettest('0100::', 8, 'RESERVED', 1000); v6_nettest('0100::', 64, 'DISCARD', 1000); v6_nettest('0180::', 9, 'RESERVED', 1000); v6_nettest('0200::', 7, 'RESERVED', 1000); v6_nettest('0400::', 6, 'RESERVED', 1000); v6_nettest('0800::', 5, 'RESERVED', 1000); v6_nettest('1000::', 4, 'RESERVED', 1000); # this net is not complete of type GLOBAL-UNICAST, test only parts #v6_nettest('2000::', 3, 'GLOBAL-UNICAST', 1000); v6_nettest('2001::', 32, 'TEREDO', 1000); v6_nettest('2001:2::', 48, 'BMWG', 1000); v6_nettest('2001:DB8::', 32, 'DOCUMENTATION', 1000); v6_nettest('2001:10::', 28, 'ORCHID', 1000); v6_nettest('2002::', 16, '6TO4', 1000); v6_nettest('3000::', 4, 'GLOBAL-UNICAST', 1000); v6_nettest('4000::', 3, 'RESERVED', 1000); v6_nettest('6000::', 3, 'RESERVED', 1000); v6_nettest('8000::', 3, 'RESERVED', 1000); v6_nettest('A000::', 3, 'RESERVED', 1000); v6_nettest('C000::', 3, 'RESERVED', 1000); v6_nettest('E000::', 4, 'RESERVED', 1000); v6_nettest('F000::', 5, 'RESERVED', 1000); v6_nettest('F800::', 6, 'RESERVED', 1000); v6_nettest('FA00::', 7, 'RESERVED', 1000); v6_nettest('FC00::', 8, 'UNIQUE-LOCAL-UNICAST', 1000); v6_nettest('FE00::', 9, 'RESERVED', 1000); v6_nettest('FE80::', 10, 'LINK-LOCAL-UNICAST', 1000); v6_nettest('FEC0::', 10, 'RESERVED', 1000); v6_nettest('FF00::', 8, 'MULTICAST', 1000); $T->end; 1; Net-IP-1.26/t/ipv4.t0000644000175000017500000002502712055422372014230 0ustar mvalentemvalenteuse lib "./t"; use ExtUtils::TBone; BEGIN { use lib '..'; use Net::IP qw(:PROC); if (eval (require Math::BigInt)) { $math_bigint = 1; }; }; my $numtests = 8031; # Create checker: my $T = typical ExtUtils::TBone; #my $T = new ExUtils::TBone "log.txt"; $numtests++ if $math_bigint; $T->begin($numtests); #------------------------------------------------------------------------------ $ip = new Net::IP('195.114.80/24',4); $T->ok (defined($ip),$Net::IP::Error); $T->ok_eq ($ip->binip(),'11000011011100100101000000000000',$ip->error()); $T->ok_eq ($ip->ip(),'195.114.80.0',$ip->error()); $T->ok_eq ($ip->print(),'195.114.80/24',$ip->error()); $T->ok_eq ($ip->hexip(),'0xc3725000',$ip->error()); $T->ok_eq ($ip->hexmask(),'0xffffff00',$ip->error()); $T->ok_eqnum ($ip->prefixlen(),24,$ip->error()); $T->ok_eqnum ($ip->version(),4,$ip->error()); $T->ok_eqnum ($ip->size(),256,$ip->error()); $T->ok_eq ($ip->binmask(),'11111111111111111111111100000000',$ip->error()); $T->ok_eq ($ip->mask(),'255.255.255.0',$ip->error()); $T->ok_eqnum ($ip->intip(),3279048704,$ip->error()) if $math_bigint; $T->ok_eq ($ip->iptype(),'PUBLIC',$ip->error()); $T->ok_eq ($ip->reverse_ip(),'80.114.195.in-addr.arpa.',$ip->error()); $T->ok_eq ($ip->last_bin(),'11000011011100100101000011111111',$ip->error()); $T->ok_eq ($ip->last_ip(),'195.114.80.255',$ip->error()); $ip->set('202.31.4/24'); $T->ok_eq ($ip->ip(),'202.31.4.0',$ip->error()); $ip->set('234.245.252.253/2'); $T->ok_eq ($ip->error(),'Invalid prefix 11101010111101011111110011111101/2',$ip->error()); $T->ok_eqnum ($ip->errno(),171,$ip->error()); $ip->set('62.33.41.9'); $ip2 = new Net::IP('0.1.0.5'); $T->ok_eq ($ip->binadd($ip2)->ip(),'62.34.41.14',$ip->error()); $ip->set('133.45.0/24'); $ip2 = new Net::IP('133.45.1/24'); $T->ok_eqnum ($ip->aggregate($ip2)->prefixlen(),23,$ip->error()); $ip2 = new Net::IP('133.44.255.255'); $T->ok_eqnum ($ip->bincomp('gt',$ip2),1,$ip->error()); $ip = new Net::IP('133.44.255.255-133.45.0.42'); $T->ok_eq (($ip->find_prefixes())[3],'133.45.0.40/31',$ip->error()); $ip = new Net::IP('192.168.2.254-192.168.2.255'); my @prefixes = $ip->find_prefixes(); $T->ok_eqnum (scalar(@prefixes), 1); $T->ok_eq ($prefixes[0],'192.168.2.254/31',$ip->error()); $ip->set('201.33.128.0/22'); $ip2->set('201.33.129.0/24'); $T->ok_eqnum ($ip->overlaps($ip2),$IP_B_IN_A_OVERLAP,$ip->error()); $ip->set('192.168.0.3/32'); $T->ok_eqnum ($ip->size,1,$ip->error()); # test if hexip changes when ip is set (bug 80164 RT) $ip = new Net::IP('195.114.80/24',4); $hex1 = $ip->hexip; $ip->set('192.168.0.3/32'); $hex2 = $ip->hexip; $T->ok($hex1 ne $hex2, "Hex IP should not match (hexip1:$hex1 hexip2:$hex2"); # regression test bug 32232 RT $ip->set('61-217-102-8.hinet-ip.hinet.net'); $T->ok_eq ($ip->error(),'Not a valid IPv4 address 217-102-8.hinet-ip.hinet.net',$ip->error()); $T->ok_eqnum ($ip->errno(),102,$ip->error()); #------------------------------------------------------------------------------ # test for network types sub rbin { return int(2*rand); } sub ip2bin { return unpack('B32', pack('C4C4C4C4', split(/\./, shift))); } sub bin2ip { return join('.', unpack('C4C4C4C4', pack('B32', shift))); } sub v4_first { my $network = shift; while (length $network < 32) { $network .= '0'; } return bin2ip($network); } sub v4_last { my $network = shift; while (length $network < 32) { $network .= '1'; } return bin2ip($network); } sub v4_rand { my $network = shift; while (length $network < 32) { $network .= rbin(); } return bin2ip($network); } sub v4_okeq { my $ip = Net::IP->new(shift); $T->msg('IPv4: '.$ip->print ); $T->ok_eq ($ip->iptype(), shift, $ip->error()); return; } sub v4_nettest { my $ip = shift; my $prefix = shift; my $iptype = shift; my $numoftests = shift; my $network = substr( ip2bin($ip), 0, $prefix); die "ERROR! At least 3 tests must be run." if $numoftests < 3; v4_okeq( v4_first( $network ), $iptype ); v4_okeq( v4_last( $network ), $iptype ); $numoftests -= 2; while ($numoftests--) { v4_okeq( v4_rand( $network ), $iptype ); } # done return; } # Address Block Present Use Reference # ------------------------------------------------------------------ # 0.0.0.0/8 "This" Network RFC 1122, Section 3.2.1.3 PRIVATE # 10.0.0.0/8 Private-Use Networks RFC 1918 PRIVATE # 100.64.0.0/10 CGN Shared Address Space RFC 6598 SHARED # 127.0.0.0/8 Loopback RFC 1122, Section 3.2.1.3 LOOPBACK # 169.254.0.0/16 Link Local RFC 3927 LINK-LOCAL # 172.16.0.0/12 Private-Use Networks RFC 1918 PRIVATE # 192.0.0.0/24 IETF Protocol Assignments RFC 5736 RESERVED # 192.0.2.0/24 TEST-NET-1 RFC 5737 TEST-NET # 192.88.99.0/24 6to4 Relay Anycast RFC 3068 6TO4-RELAY # 192.168.0.0/16 Private-Use Networks RFC 1918 PRIVATE # 198.18.0.0/15 Network Interconnect # Device Benchmark Testing RFC 2544 RESERVED # 198.51.100.0/24 TEST-NET-2 RFC 5737 TEST-NET # 203.0.113.0/24 TEST-NET-3 RFC 5737 TEST-NET # 224.0.0.0/4 Multicast RFC 3171 MULTICAST # 240.0.0.0/4 Reserved for Future Use RFC 1112, Section 4 RESERVED # 255.255.255.255/32 Limited Broadcast RFC 919, Section 7 BROADCAST # RFC 922, Section 7 v4_nettest( '0.0.0.0', 8, 'PRIVATE', 100); # 1 v4_nettest( '10.0.0.0', 8, 'PRIVATE', 100); # 2 v4_nettest( '100.64.0.0', 10, 'SHARED', 100); # 3 v4_nettest( '127.0.0.0', 8, 'LOOPBACK', 100); # 4 v4_nettest( '169.254.0.0', 16, 'LINK-LOCAL', 100); # 5 v4_nettest( '172.16.0.0', 12, 'PRIVATE', 100); # 6 v4_nettest( '192.0.0.0', 24, 'RESERVED', 100); # 7 v4_nettest( '192.0.2.0', 24, 'TEST-NET', 100); # 8 v4_nettest( '192.88.99.0', 24, '6TO4-RELAY', 100); # 9 v4_nettest( '192.168.0.0', 16, 'PRIVATE', 100); # 10 v4_nettest( '198.18.0.0', 15, 'RESERVED', 100); # 11 v4_nettest( '198.51.100.0', 24, 'TEST-NET', 100); # 12 v4_nettest( '203.0.113.0', 24, 'TEST-NET', 100); # 13 v4_nettest( '224.0.0.0', 4, 'MULTICAST', 100); # 14 # the 240/4 net can not be tested directly because the last ip in the block 255.255.255.255/32 has another type v4_nettest( '240.0.0.0', 5, 'RESERVED', 100); # 15 v4_nettest( '248.0.0.0', 6, 'RESERVED', 100); # 16 v4_nettest( '252.0.0.0', 7, 'RESERVED', 100); # 17 v4_nettest( '254.0.0.0', 8, 'RESERVED', 100); # 18 v4_nettest( '255.0.0.0', 9, 'RESERVED', 100); # 19 v4_nettest( '255.128.0.0', 10, 'RESERVED', 100); # 20 v4_nettest( '255.192.0.0', 11, 'RESERVED', 100); # 21 v4_nettest( '255.224.0.0', 12, 'RESERVED', 100); # 22 v4_nettest( '255.240.0.0', 13, 'RESERVED', 100); # 23 v4_nettest( '255.248.0.0', 14, 'RESERVED', 100); # 24 v4_nettest( '255.252.0.0', 15, 'RESERVED', 100); # 25 v4_nettest( '255.254.0.0', 16, 'RESERVED', 100); # 26 v4_nettest( '255.255.0.0', 17, 'RESERVED', 100); # 27 v4_nettest( '255.255.128.0', 18, 'RESERVED', 100); # 28 v4_nettest( '255.255.192.0', 19, 'RESERVED', 100); # 29 v4_nettest( '255.255.224.0', 20, 'RESERVED', 100); # 30 v4_nettest( '255.255.240.0', 21, 'RESERVED', 100); # 31 v4_nettest( '255.255.248.0', 22, 'RESERVED', 100); # 32 v4_nettest( '255.255.252.0', 23, 'RESERVED', 100); # 33 v4_nettest( '255.255.254.0', 24, 'RESERVED', 100); # 34 v4_nettest( '255.255.255.0', 25, 'RESERVED', 100); # 35 v4_nettest( '255.255.255.128', 26, 'RESERVED', 100); # 36 v4_nettest( '255.255.255.192', 27, 'RESERVED', 100); # 37 v4_nettest( '255.255.255.224', 28, 'RESERVED', 100); # 38 v4_nettest( '255.255.255.240', 29, 'RESERVED', 100); # 39 v4_nettest( '255.255.255.248', 30, 'RESERVED', 100); # 40 v4_nettest( '255.255.255.252', 31, 'RESERVED', 100); # 41 v4_okeq( '255.255.255.254', 'RESERVED'); v4_okeq( '255.255.255.255', 'BROADCAST'); # check boundary networks to be public v4_nettest( '1.0.0.0', 8, 'PUBLIC', 100); # 42 v4_nettest( '8.0.0.0', 8, 'PUBLIC', 100); # 43 v4_nettest( '9.0.0.0', 8, 'PUBLIC', 100); # 44 v4_nettest( '11.0.0.0', 8, 'PUBLIC', 100); # 45 v4_nettest( '100.63.0.0', 10, 'PUBLIC', 100); # 46 v4_nettest( '100.128.0.0', 10, 'PUBLIC', 100); # 47 v4_nettest( '100.192.0.0', 10, 'PUBLIC', 100); # 48 v4_nettest( '126.0.0.0', 8, 'PUBLIC', 100); # 49 v4_nettest( '128.0.0.0', 8, 'PUBLIC', 100); # 50 v4_nettest( '169.253.0.0', 16, 'PUBLIC', 100); # 51 v4_nettest( '169.255.0.0', 16, 'PUBLIC', 100); # 52 v4_nettest( '172.15.0.0', 12, 'PUBLIC', 100); # 53 v4_nettest( '172.32.0.0', 12, 'PUBLIC', 100); # 54 v4_nettest( '172.48.0.0', 12, 'PUBLIC', 100); # 55 v4_nettest( '191.255.255.0',24, 'PUBLIC', 100); # 56 v4_nettest( '192.0.1.0', 24, 'PUBLIC', 100); # 57 v4_nettest( '192.0.1.0', 24, 'PUBLIC', 100); # 58 v4_nettest( '192.0.3.0', 24, 'PUBLIC', 100); # 59 v4_nettest( '192.88.96.0', 24, 'PUBLIC', 100); # 60 v4_nettest( '192.88.97.0', 24, 'PUBLIC', 100); # 61 v4_nettest( '192.88.98.0', 24, 'PUBLIC', 100); # 62 v4_nettest( '192.88.100.0', 24, 'PUBLIC', 100); # 63 v4_nettest( '192.88.103.0', 24, 'PUBLIC', 100); # 64 v4_nettest( '192.160.0.0', 16, 'PUBLIC', 100); # 65 v4_nettest( '192.187.0.0', 16, 'PUBLIC', 100); # 66 v4_nettest( '192.175.0.0', 16, 'PUBLIC', 100); # 67 v4_nettest( '192.176.0.0', 16, 'PUBLIC', 100); # 68 v4_nettest( '198.16.0.0', 15, 'PUBLIC', 100); # 69 v4_nettest( '198.17.0.0', 15, 'PUBLIC', 100); # 70 v4_nettest( '198.20.0.0', 15, 'PUBLIC', 100); # 71 v4_nettest( '198.22.0.0', 15, 'PUBLIC', 100); # 72 v4_nettest( '198.48.100.0', 24, 'PUBLIC', 100); # 73 v4_nettest( '198.49.100.0', 24, 'PUBLIC', 100); # 74 v4_nettest( '198.50.100.0', 24, 'PUBLIC', 100); # 75 v4_nettest( '198.52.100.0', 24, 'PUBLIC', 100); # 76 v4_nettest( '198.55.100.0', 24, 'PUBLIC', 100); # 77 v4_nettest( '203.0.112.0', 24, 'PUBLIC', 100); # 78 v4_nettest( '203.0.114.0', 24, 'PUBLIC', 100); # 79 v4_nettest( '203.0.115.0', 24, 'PUBLIC', 100); # 80 #------------------------------------------------------------------------------ $T->end; 1; Net-IP-1.26/t/ExtUtils/0000755000175000017500000000000012055427257014743 5ustar mvalentemvalenteNet-IP-1.26/t/ExtUtils/TBone.pm0000644000175000017500000002511007204220746016301 0ustar mvalentemvalentepackage ExtUtils::TBone; =head1 NAME ExtUtils::TBone - a "skeleton" for writing "t/*.t" test files. =head1 SYNOPSIS Include a copy of this module in your t directory (as t/ExtUtils/TBone.pm), and then write your t/*.t files like this: use lib "./t"; # to pick up a ExtUtils::TBone use ExtUtils::TBone; # Make a tester... here are 3 different alternatives: my $T = typical ExtUtils::TBone; # standard log my $T = new ExtUtils::TBone; # no log my $T = new ExtUtils::TBone "testout/Foo.tlog"; # explicit log # Begin testing, and expect 3 tests in all: $T->begin(3); # expect 3 tests $T->msg("Something for the log file"); # message for the log # Run some tests: $T->ok($this); # test 1: no real info logged $T->ok($that, # test 2: logs a comment "Is that ok, or isn't it?"); $T->ok(($this eq $that), # test 3: logs comment + vars "Do they match?", This => $this, That => $that); # That last one could have also been written... $T->ok_eq($this, $that); # does 'eq' and logs operands $T->ok_eqnum($this, $that); # does '==' and logs operands # End testing: $T->end; =head1 DESCRIPTION This module is intended for folks who release CPAN modules with "t/*.t" tests. It makes it easy for you to output syntactically correct test-output while at the same time logging all test activity to a log file. Hopefully, bug reports which include the contents of this file will be easier for you to investigate. =head1 LOG FILE A typical log file output by this module looks like this: 1..3 ** A message logged with msg(). ** Another one. 1: My first test, using test(): how'd I do? 1: ok 1 ** Yet another message. 2: My second test, using test_eq()... 2: A: The first string 2: B: The second string 2: not ok 2 3: My third test. 3: ok 3 END Each test() is logged with the test name and results, and the test-number prefixes each line. This allows you to scan a large file easily with "grep" (or, ahem, "perl"). A blank line follows each test's record, for clarity. =head1 PUBLIC INTERFACE =cut # Globals: use strict; use vars qw($VERSION); use FileHandle; use File::Basename; # The package version, both in 1.23 style *and* usable by MakeMaker: $VERSION = substr q$Revision: 1.1.1.1 $, 10; #------------------------------ =head2 Construction =over 4 =cut #------------------------------ =item new [ARGS...] I Create a new tester. Any arguments are sent to log_open(). =cut sub new { my $self = bless { OUT =>\*STDOUT, Begin=>0, End =>0, Count=>0, }, shift; $self->log_open(@_) if @_; $self; } #------------------------------ =item typical I Create a typical tester. Use this instead of new() for most applicaitons. The directory "testout" is created for you automatically, to hold the output log file. =cut sub typical { my $class = shift; my ($tfile) = basename $0; unless (-d "testout") { mkdir "testout", 0755 or die "Couldn't create a 'testout' subdirectory: $!\n"; ### warn "$class: created 'testout' directory\n"; } $class->new($class->catfile('.', 'testout', "${tfile}log")); } #------------------------------ # DESTROY #------------------------------ # Class method, destructor. # Automatically closes the log. # sub DESTROY { $_[0]->log_close; } #------------------------------ =back =head2 Doing tests =over 4 =cut #------------------------------ =item begin NUMTESTS I Start testing. =cut sub begin { my ($self, $n) = @_; return if $self->{Begin}++; $self->l_print("1..$n\n\n"); print {$self->{OUT}} "1..$n\n"; } #------------------------------ =item end I End testing. =cut sub end { my ($self) = @_; return if $self->{End}++; $self->l_print("END\n"); print {$self->{OUT}} "END\n"; } #------------------------------ =item ok BOOL, [TESTNAME], [PARAMHASH...] I Do a test, and log some information connected with it. Use it like this: $T->ok(-e $dotforward); Or better yet, like this: $T->ok((-e $dotforward), "Does the user have a .forward file?"); Or even better, like this: $T->ok((-e $dotforward), "Does the user have a .forward file?", User => $ENV{USER}, Path => $dotforward, Fwd => $ENV{FWD}); That last one, if it were test #3, would be logged as: 3: Does the user have a .forward file? 3: User: "alice" 3: Path: "/home/alice/.forward" 3: Fwd: undef 3: ok You get the idea. Note that defined quantities are logged with delimiters and with all nongraphical characters suitably escaped, so you can see evidence of unexpected whitespace and other badnasties. Had "Fwd" been the string "this\nand\nthat", you'd have seen: 3: Fwd: "this\nand\nthat" And unblessed array refs like ["this", "and", "that"] are treated as multiple values: 3: Fwd: "this" 3: Fwd: "and" 3: Fwd: "that" =cut sub ok { my ($self, $ok, $test, @ps) = @_; ++($self->{Count}); # next test # Report to harness: my $status = ($ok ? "ok " : "not ok ") . $self->{Count}; print {$self->{OUT}} $status, "\n"; # Log: $self->ln_print($test, "\n") if $test; while (@ps) { my ($k, $v) = (shift @ps, shift @ps); my @vs = ((ref($v) and (ref($v) eq 'ARRAY'))? @$v : ($v)); foreach (@vs) { if (!defined($_)) { # value not defined: output keyword $self->ln_print(qq{ $k: undef\n}); } else { # value defined: output quoted, encoded form s{([\n\t\x00-\x1F\x7F-\xFF\\\"])} {'\\'.sprintf("%02X",ord($1)) }exg; s{\\0A}{\\n}g; $self->ln_print(qq{ $k: "$_"\n}); } } } $self->ln_print($status, "\n"); $self->l_print("\n"); 1; } #------------------------------ =item ok_eq ASTRING, BSTRING, [TESTNAME], [PARAMHASH...] I Convenience front end to ok(): test whether C, and logs the operands as 'A' and 'B'. =cut sub ok_eq { my ($self, $this, $that, $test, @ps) = @_; $self->ok(($this eq $that), ($test || "(Is 'A' string-equal to 'B'?)"), A => $this, B => $that, @ps); } #------------------------------ =item ok_eqnum ANUM, BNUM, [TESTNAME], [PARAMHASH...] I Convenience front end to ok(): test whether C, and logs the operands as 'A' and 'B'. =cut sub ok_eqnum { my ($self, $this, $that, $test, @ps) = @_; $self->ok(($this == $that), ($test || "(Is 'A' numerically-equal to 'B'?)"), A => $this, B => $that, @ps); } #------------------------------ =back =head2 Logging messages =over 4 =cut #------------------------------ =item log_open PATH I Open a log file for messages to be output to. This is invoked for you automatically by C and C. =cut sub log_open { my ($self, $path) = @_; $self->{LogPath} = $path; $self->{LOG} = FileHandle->new(">$path") || die "open $path: $!"; $self; } #------------------------------ =item log_close I Close the log file and stop logging. You shouldn't need to invoke this directly; the destructor does it. =cut sub log_close { my $self = shift; close(delete $self->{LOG}) if $self->{LOG}; } #------------------------------ =item log MESSAGE... I Log a message to the log file. No alterations are made on the text of the message. See msg() for an alternative. =cut sub log { my $self = shift; print {$self->{LOG}} @_ if $self->{LOG}; } #------------------------------ =item msg MESSAGE... I Log a message to the log file. Lines are prefixed with "** " for clarity, and a terminating newline is forced. =cut sub msg { my $self = shift; my $text = join '', @_; chomp $text; $text =~ s{^}{** }gm; $self->l_print($text, "\n"); } #------------------------------ # # l_print MESSAGE... # # Instance method, private. # Print to the log file if there is one. # sub l_print { my $self = shift; print { $self->{LOG} } @_ if $self->{LOG}; } #------------------------------ # # ln_print MESSAGE... # # Instance method, private. # Print to the log file, prefixed by message number. # sub ln_print { my $self = shift; foreach (split /\n/, join('', @_)) { $self->l_print("$self->{Count}: $_\n"); } } #------------------------------ =back =head2 Utilities =over 4 =cut #------------------------------ =item catdir DIR, ..., DIR I Concatenate several directories into a path ending in a directory. Lightweight version of the one in the (very new) File::Spec. Paths are assumed to be absolute. To signify a relative path, the first DIR must be ".", which is processed specially. On Mac, the path I end in a ':'. On Unix, the path I end in a '/'. =cut sub catdir { my $self = shift; my $relative = shift @_ if ($_[0] eq '.'); if ($^O eq 'Mac') { return ($relative ? ':' : '') . (join ':', @_) . ':'; } else { return ($relative ? './' : '/') . join '/', @_; } } #------------------------------ =item catfile DIR, ..., DIR, FILE I Like catdir(), but last element is assumed to be a file. Note that, at a minimum, you must supply at least a single DIR. =cut sub catfile { my $self = shift; my $file = pop; if ($^O eq 'Mac') { return $self->catdir(@_) . $file; } else { return $self->catdir(@_) . "/$file"; } } #------------------------------ =back =head1 CHANGE LOG B $Id: TBone.pm,v 1.1.1.1 2000/11/14 11:28:38 manuel Exp $ =over 4 =item Version 1.116 Cosmetic improvements only. =item Version 1.112 Added lightweight catdir() and catfile() (a la File::Spec) to enhance portability to Mac environment. =item Version 1.111 Now uses File::Basename to create "typical" logfile name, for portability. =item Version 1.110 Fixed bug in constructor that surfaced if no log was being used. =back Created: Friday-the-13th of February, 1998. =head1 AUTHOR Eryq (F). President, ZeeGee Software Inc. (F) =cut #------------------------------ 1; __END__ my $T = new ExtUtils::TBone "testout/foo.tlog"; $T->begin(3); $T->msg("before 1\nor 2"); $T->ok(1, "one"); $T->ok(2, "Two"); $T->ok(3, "Three", Roman=>'III', Arabic=>[3, '03'], Misc=>"3\nor 3"); $T->end; 1; Net-IP-1.26/COPYING0000644000175000017500000000347310325142270013744 0ustar mvalentemvalenteCopyright (c) 1999-2000 by RIPE-NCC. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. You should have received a copy of the Perl license along with Perl; see the file README in Perl distribution. 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. You should have received a copy of the Artistic License along with Perl; see the file Artistic. NO WARRANTY 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. 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 Net-IP-1.26/Makefile.PL0000644000175000017500000000203010325143351014650 0ustar mvalentemvalenteuse ExtUtils::MakeMaker; use Config; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. # RIPE NCC common configuration my %PARAM = (); if ($Config{vendorprefix} eq '/usr/local/ncc') { warn "\nConfiguring for RIPE NCC Perl installation...\n\n"; $PARAM{'INSTALLDIRS'} = 'vendor'; $PARAM{'INSTALLSCRIPT'} = '$(INSTALLVENDORBIN)'; # Hack for Perl prior 5.8.1 $PARAM{'macro'} = { 'INSTALLPREFIX' => '$(VENDORPREFIX)' }; } $PARAM{'dist'} = { 'COMPRESS' => 'gzip', 'SUFFIX' => '.gz', 'CI' => 'cvs ci', 'RCS_LABEL' => 'cvs tag -c -F $(NAME_SYM)-$(VERSION_SYM)', }; $PARAM{'ABSTRACT_FROM'} = 'IP.pm'; $PARAM{'AUTHOR'} = 'Manuel Valente '; $PARAM{'clean'} = {FILES => "Net-IP.spec"}; WriteMakefile( 'NAME' => 'Net::IP', 'VERSION_FROM' => 'IP.pm', 'PREREQ_PM' => {}, 'EXE_FILES' => [qw(ipcount iptab)], 'PL_FILES' => { 'Net-IP.spec.PL' => 'Net-IP.spec' }, %PARAM ); Net-IP-1.26/MANIFEST0000644000175000017500000000030510153403405014030 0ustar mvalentemvalenteChanges IP.pm MANIFEST Makefile.PL ipcount iptab t/ipv4.t t/ipv6.t t/ExtUtils/TBone.pm README COPYING Net-IP.spec.PL META.yml Module meta-data (added by MakeMaker) Net-IP-1.26/META.yml0000664000175000017500000000106112055427257014170 0ustar mvalentemvalente--- #YAML:1.0 name: Net-IP version: 1.26 abstract: Perl extension for manipulating IPv4/IPv6 addresses author: - Manuel Valente license: unknown distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: {} no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.57_05 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 Net-IP-1.26/README0000644000175000017500000000137312055425523013575 0ustar mvalentemvalenteThis is the Net::IP module, designed to allow easy manipulation of IPv4 and IPv6 addresses. You need to have Math::BigInt installed on your system. You install the library by running these commands: perl Makefile.PL make make test make install There is also a small application which uses the IP.pm module: ipcount.pl. Basically, it's an IP address mini-calculator, it can calculate the number of IP addresses in a prefix or all the prefixes contained in a given range. All bug reports and suggestions for improvemenets should be sent to Manuel Valente . Many thanks to Ulrich Wisser for the version 1.26. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Net-IP-1.26/IP.pm0000644000175000017500000022047112055426172013566 0ustar mvalentemvalente# Copyright (c) 1999 - 2002 RIPE NCC # # All Rights Reserved # # Permission to use, copy, modify, and distribute this software and its # documentation for any purpose and without fee is hereby granted, # provided that the above copyright notice appear in all copies and that # both that copyright notice and this permission notice appear in # supporting documentation, and that the name of the author not be # used in advertising or publicity pertaining to distribution of the # software without specific, written prior permission. # # THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING # ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS; IN NO EVENT SHALL # AUTHOR BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY # DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN # AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. #------------------------------------------------------------------------------ # Module Header # Filename : IP.pm # Purpose : Provide functions to manipulate IPv4/v6 addresses # Author : Manuel Valente # Date : 19991124 # Description : # Language Version : Perl 5 # OSs Tested : BSDI 3.1 - Linux # Command Line : ipcount # Input Files : # Output Files : # External Programs : Math::BigInt.pm # Problems : # To Do : # Comments : Based on ipv4pack.pm (Monica) and iplib.pm (Lee) # Math::BigInt is only loaded if int functions are used # $Id: IP.pm,v 1.23 2003/02/18 16:13:01 manuel Exp $ #------------------------------------------------------------------------------ package Net::IP; use strict; use Math::BigInt; # Global Variables definition use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $ERROR $ERRNO %IPv4ranges %IPv6ranges $useBigInt $IP_NO_OVERLAP $IP_PARTIAL_OVERLAP $IP_A_IN_B_OVERLAP $IP_B_IN_A_OVERLAP $IP_IDENTICAL); $VERSION = '1.26'; require Exporter; @ISA = qw(Exporter); # Functions and variables exported in all cases @EXPORT = qw(&Error &Errno $IP_NO_OVERLAP $IP_PARTIAL_OVERLAP $IP_A_IN_B_OVERLAP $IP_B_IN_A_OVERLAP $IP_IDENTICAL ); # Functions exported on demand (with :PROC) @EXPORT_OK = qw(&Error &Errno &ip_iptobin &ip_bintoip &ip_bintoint &ip_inttobin &ip_get_version &ip_is_ipv4 &ip_is_ipv6 &ip_expand_address &ip_get_mask &ip_last_address_bin &ip_splitprefix &ip_prefix_to_range &ip_is_valid_mask &ip_bincomp &ip_binadd &ip_get_prefix_length &ip_range_to_prefix &ip_compress_address &ip_is_overlap &ip_get_embedded_ipv4 &ip_aggregate &ip_iptype &ip_check_prefix &ip_reverse &ip_normalize &ip_normal_range &ip_iplengths $IP_NO_OVERLAP $IP_PARTIAL_OVERLAP $IP_A_IN_B_OVERLAP $IP_B_IN_A_OVERLAP $IP_IDENTICAL ); %EXPORT_TAGS = (PROC => [@EXPORT_OK],); # Definition of the Ranges for IPv4 IPs %IPv4ranges = ( '00000000' => 'PRIVATE', # 0/8 '00001010' => 'PRIVATE', # 10/8 '0110010001' => 'SHARED', # 100.64/10 '01111111' => 'LOOPBACK', # 127.0/8 '1010100111111110' => 'LINK-LOCAL', # 169.254/16 '101011000001' => 'PRIVATE', # 172.16/12 '110000000000000000000000' => 'RESERVED', # 192.0.0/24 '110000000000000000000010' => 'TEST-NET', # 192.0.2/24 '110000000101100001100011' => '6TO4-RELAY', # 192.88.99.0/24 '1100000010101000' => 'PRIVATE', # 192.168/16 '110001100001001' => 'RESERVED', # 198.18/15 '110001100011001101100100' => 'TEST-NET', # 198.51.100/24 '110010110000000001110001' => 'TEST-NET', # 203.0.113/24 '1110' => 'MULTICAST', # 224/4 '1111' => 'RESERVED', # 240/4 '11111111111111111111111111111111' => 'BROADCAST', # 255.255.255.255/32 ); # Definition of the Ranges for Ipv6 IPs %IPv6ranges = ( '00000000' => 'RESERVED', # ::/8 ('0' x 128) => 'UNSPECIFIED', # ::/128 ('0' x 127) . '1' => 'LOOPBACK', # ::1/128 ('0' x 80) . ('1' x 16) => 'IPV4MAP', # ::FFFF:0:0/96 '00000001' => 'RESERVED', # 0100::/8 '0000000100000000' . ('0' x 48) => 'DISCARD', # 0100::/64 '0000001' => 'RESERVED', # 0200::/7 '000001' => 'RESERVED', # 0400::/6 '00001' => 'RESERVED', # 0800::/5 '0001' => 'RESERVED', # 1000::/4 '001' => 'GLOBAL-UNICAST', # 2000::/3 '0010000000000001' . ('0' x 16) => 'TEREDO', # 2001::/32 '00100000000000010000000000000010' . ('0' x 16) => 'BMWG', # 2001:0002::/48 '00100000000000010000110110111000' => 'DOCUMENTATION', # 2001:DB8::/32 '0010000000000001000000000001' => 'ORCHID', # 2001:10::/28 '0010000000000010' => '6TO4', # 2002::/16 '010' => 'RESERVED', # 4000::/3 '011' => 'RESERVED', # 6000::/3 '100' => 'RESERVED', # 8000::/3 '101' => 'RESERVED', # A000::/3 '110' => 'RESERVED', # C000::/3 '1110' => 'RESERVED', # E000::/4 '11110' => 'RESERVED', # F000::/5 '111110' => 'RESERVED', # F800::/6 '1111110' => 'UNIQUE-LOCAL-UNICAST', # FC00::/7 '111111100' => 'RESERVED', # FE00::/9 '1111111010' => 'LINK-LOCAL-UNICAST', # FE80::/10 '1111111011' => 'RESERVED', # FEC0::/10 '11111111' => 'MULTICAST', # FF00::/8 ); # Overlap constants $IP_NO_OVERLAP = 0; $IP_PARTIAL_OVERLAP = 1; $IP_A_IN_B_OVERLAP = -1; $IP_B_IN_A_OVERLAP = -2; $IP_IDENTICAL = -3; # ---------------------------------------------------------- # OVERLOADING use overload ( '+' => 'ip_add_num', 'bool' => sub { @_ }, ); #------------------------------------------------------------------------------ # Subroutine ip_num_add # Purpose : Add an integer to an IP # Params : Number to add # Returns : New object or undef # Note : Used by overloading - returns undef when # the end of the range is reached sub ip_add_num { my $self = shift; my ($value) = @_; my $ip = $self->intip + $value; my $last = $self->last_int; # Reached the end of the range ? if ($ip > $self->last_int) { return; } my $newb = ip_inttobin($ip, $self->version); $newb = ip_bintoip($newb, $self->version); my $newe = ip_inttobin($last, $self->version); $newe = ip_bintoip($newe, $self->version); my $new = new Net::IP("$newb - $newe"); return ($new); } # ----------------------------------------------------------------------------- #------------------------------------------------------------------------------ # Subroutine new # Purpose : Create an instance of an IP object # Params : Class, IP prefix, IP version # Returns : Object reference or undef # Note : New just allocates a new object - set() does all the work sub new { my ($class, $data, $ipversion) = (@_); # Allocate new object my $self = {}; bless($self, $class); # Pass everything to set() unless ($self->set($data, $ipversion)) { return; } return $self; } #------------------------------------------------------------------------------ # Subroutine set # Purpose : Set the IP for an IP object # Params : Data, IP type # Returns : 1 (success) or undef (failure) sub set { my $self = shift; my ($data, $ipversion) = @_; # Normalize data as received - this should return 2 IPs my ($begin, $end) = ip_normalize($data, $ipversion) or do { $self->{error} = $ERROR; $self->{errno} = $ERRNO; return; }; # Those variables are set when the object methods are called # We need to reset everything for ( qw(ipversion errno prefixlen binmask reverse_ip last_ip iptype binip error ip intformat hexformat mask last_bin last_int prefix is_prefix) ) { delete($self->{$_}); } # Determine IP version for this object return unless ($self->{ipversion} = $ipversion || ip_get_version($begin)); # Set begin IP address $self->{ip} = $begin; # Set Binary IP address return unless ($self->{binip} = ip_iptobin($self->ip(), $self->version())); $self->{is_prefix} = 0; # Set end IP address # If single IP: begin and end IPs are identical $end ||= $begin; $self->{last_ip} = $end; # Try to determine the IP version my $ver = ip_get_version($end) || return; # Check if begin and end addresses have the same version if ($ver != $self->version()) { $ERRNO = 201; $ERROR = "Begin and End addresses have different IP versions - $begin - $end"; $self->{errno} = $ERRNO; $self->{error} = $ERROR; return; } # Get last binary address return unless ($self->{last_bin} = ip_iptobin($self->last_ip(), $self->version())); # Check that End IP >= Begin IP unless (ip_bincomp($self->binip(), 'le', $self->last_bin())) { $ERRNO = 202; $ERROR = "Begin address is greater than End address $begin - $end"; $self->{errno} = $ERRNO; $self->{error} = $ERROR; return; } # Find all prefixes (eg:/24) in the current range my @prefixes = $self->find_prefixes() or return; # If there is only one prefix: if (scalar(@prefixes) == 1) { # Get length of prefix return unless ((undef, $self->{prefixlen}) = ip_splitprefix($prefixes[0])); # Set prefix boolean var # This value is 1 if the IP range only contains a single /nn prefix $self->{is_prefix} = 1; } # If the range is a single prefix: if ($self->{is_prefix}) { # Set mask property $self->{binmask} = ip_get_mask($self->prefixlen(), $self->version()); # Check that the mask is valid unless ( ip_check_prefix( $self->binip(), $self->prefixlen(), $self->version() ) ) { $self->{error} = $ERROR; $self->{errno} = $ERRNO; return; } } return ($self); } sub print { my $self = shift; if ($self->{is_prefix}) { return ($self->short() . '/' . $self->prefixlen()); } else { return (sprintf("%s - %s", $self->ip(), $self->last_ip())); } } #------------------------------------------------------------------------------ # Subroutine error # Purpose : Return the current error message # Returns : Error string sub error { my $self = shift; return $self->{error}; } #------------------------------------------------------------------------------ # Subroutine errno # Purpose : Return the current error number # Returns : Error number sub errno { my $self = shift; return $self->{errno}; } #------------------------------------------------------------------------------ # Subroutine binip # Purpose : Return the IP as a binary string # Returns : binary string sub binip { my $self = shift; return $self->{binip}; } #------------------------------------------------------------------------------ # Subroutine prefixlen # Purpose : Get the IP prefix length # Returns : prefix length sub prefixlen { my $self = shift; return $self->{prefixlen}; } #------------------------------------------------------------------------------ # Subroutine version # Purpose : Return the IP version # Returns : IP version sub version { my $self = shift; return $self->{ipversion}; } #------------------------------------------------------------------------------ # Subroutine version # Purpose : Return the IP in quad format # Returns : IP string sub ip { my $self = shift; return $self->{ip}; } #------------------------------------------------------------------------------ # Subroutine is_prefix # Purpose : Check if range of IPs is a prefix # Returns : boolean sub is_prefix { my $self = shift; return $self->{is_prefix}; } #------------------------------------------------------------------------------ # Subroutine binmask # Purpose : Return the binary mask of an IP prefix # Returns : Binary mask (as string) sub binmask { my $self = shift; return $self->{binmask}; } #------------------------------------------------------------------------------ # Subroutine size # Purpose : Return the number of addresses contained in an IP object # Returns : Number of addresses sub size { my $self = shift; my $size = new Math::BigInt($self->last_int); $size->badd(1); $size->bsub($self->intip); } # All the following functions work the same way: the method is just a frontend # to the real function. When the real function is called, the output is cached # so that next time the same function is called,the frontend function directly # returns the result. #------------------------------------------------------------------------------ # Subroutine intip # Purpose : Return the IP in integer format # Returns : Integer sub intip { my $self = shift; return ($self->{intformat}) if defined($self->{intformat}); my $int = ip_bintoint($self->binip()); if (!$int) { $self->{error} = $ERROR; $self->{errno} = $ERRNO; return; } $self->{intformat} = $int; return ($int); } #------------------------------------------------------------------------------ # Subroutine hexip # Purpose : Return the IP in hex format # Returns : hex string sub hexip { my $self = shift; return $self->{'hexformat'} if(defined($self->{'hexformat'})); $self->{'hexformat'} = $self->intip->as_hex(); return $self->{'hexformat'}; } #------------------------------------------------------------------------------ # Subroutine hexmask # Purpose : Return the mask back in hex # Returns : hex string sub hexmask { my $self = shift; return $self->{hexmask} if(defined($self->{hexmask})); my $intmask = ip_bintoint($self->binmask); $self->{'hexmask'} = $intmask->as_hex(); return ($self->{'hexmask'}); } #------------------------------------------------------------------------------ # Subroutine prefix # Purpose : Return the Prefix (n.n.n.n/s) # Returns : IP Prefix sub prefix { my $self = shift; if (not $self->is_prefix()) { $self->{error} = "IP range $self->{ip} is not a Prefix."; $self->{errno} = 209; return; } return ($self->{prefix}) if defined($self->{prefix}); my $prefix = $self->ip() . '/' . $self->prefixlen(); if (!$prefix) { $self->{error} = $ERROR; $self->{errno} = $ERRNO; return; } $self->{prefix} = $prefix; return ($prefix); } #------------------------------------------------------------------------------ # Subroutine mask # Purpose : Return the IP mask in quad format # Returns : Mask (string) sub mask { my $self = shift; if (not $self->is_prefix()) { $self->{error} = "IP range $self->{ip} is not a Prefix."; $self->{errno} = 209; return; } return ($self->{mask}) if defined($self->{mask}); my $mask = ip_bintoip($self->binmask(), $self->version()); if (!$mask) { $self->{error} = $ERROR; $self->{errno} = $ERRNO; return; } $self->{mask} = $mask; return ($mask); } #------------------------------------------------------------------------------ # Subroutine short # Purpose : Get the short format of an IP address or a Prefix # Returns : short format IP or undef sub short { my $self = shift; my $r; if ($self->version == 6) { $r = ip_compress_address($self->ip(), $self->version()); } else { $r = ip_compress_v4_prefix($self->ip(), $self->prefixlen()); } if (!defined($r)) { $self->{error} = $ERROR; $self->{errno} = $ERRNO; return; } return ($r); } #------------------------------------------------------------------------------ # Subroutine iptype # Purpose : Return the type of an IP # Returns : Type or undef (failure) sub iptype { my ($self) = shift; return ($self->{iptype}) if defined($self->{iptype}); my $type = ip_iptype($self->binip(), $self->version()); if (!$type) { $self->{error} = $ERROR; $self->{errno} = $ERRNO; return; } $self->{iptype} = $type; return ($type); } #------------------------------------------------------------------------------ # Subroutine reverse_ip # Purpose : Return the Reverse IP # Returns : Reverse IP or undef(failure) sub reverse_ip { my ($self) = shift; if (not $self->is_prefix()) { $self->{error} = "IP range $self->{ip} is not a Prefix."; $self->{errno} = 209; return; } return ($self->{reverse_ip}) if defined($self->{reverse_ip}); my $rev = ip_reverse($self->ip(), $self->prefixlen(), $self->version()); if (!$rev) { $self->{error} = $ERROR; $self->{errno} = $ERRNO; return; } $self->{reverse_ip} = $rev; return ($rev); } #------------------------------------------------------------------------------ # Subroutine last_bin # Purpose : Get the last IP of a range in binary format # Returns : Last binary IP or undef (failure) sub last_bin { my ($self) = shift; return ($self->{last_bin}) if defined($self->{last_bin}); my $last; if ($self->is_prefix()) { $last = ip_last_address_bin($self->binip(), $self->prefixlen(), $self->version()); } else { $last = ip_iptobin($self->last_ip(), $self->version()); } if (!$last) { $self->{error} = $ERROR; $self->{errno} = $ERRNO; return; } $self->{last_bin} = $last; return ($last); } #------------------------------------------------------------------------------ # Subroutine last_int # Purpose : Get the last IP of a range in integer format # Returns : Last integer IP or undef (failure) sub last_int { my ($self) = shift; return ($self->{last_int}) if defined($self->{last_int}); my $last_bin = $self->last_bin() or return; my $last_int = ip_bintoint($last_bin, $self->version()) or return; $self->{last_int} = $last_int; return ($last_int); } #------------------------------------------------------------------------------ # Subroutine last_ip # Purpose : Get the last IP of a prefix in IP format # Returns : IP or undef (failure) sub last_ip { my ($self) = shift; return ($self->{last_ip}) if defined($self->{last_ip}); my $last = ip_bintoip($self->last_bin(), $self->version()); if (!$last) { $self->{error} = $ERROR; $self->{errno} = $ERRNO; return; } $self->{last_ip} = $last; return ($last); } #------------------------------------------------------------------------------ # Subroutine find_prefixes # Purpose : Get all prefixes in the range defined by two IPs # Params : IP # Returns : List of prefixes or undef (failure) sub find_prefixes { my ($self) = @_; my @list = ip_range_to_prefix($self->binip(), $self->last_bin(), $self->version()); if (!scalar(@list)) { $self->{error} = $ERROR; $self->{errno} = $ERRNO; return; } return (@list); } #------------------------------------------------------------------------------ # Subroutine bincomp # Purpose : Compare two IPs # Params : Operation, IP to compare # Returns : 1 (True), 0 (False) or undef (problem) # Comments : Operation can be lt, le, gt, ge sub bincomp { my ($self, $op, $other) = @_; my $a = ip_bincomp($self->binip(), $op, $other->binip()); unless (defined $a) { $self->{error} = $ERROR; $self->{errno} = $ERRNO; return; } return ($a); } #------------------------------------------------------------------------------ # Subroutine binadd # Purpose : Add two IPs # Params : IP to add # Returns : New IP object or undef (failure) sub binadd { my ($self, $other) = @_; my $ip = ip_binadd($self->binip(), $other->binip()); if (!$ip) { $self->{error} = $ERROR; $self->{errno} = $ERRNO; return; } my $new = new Net::IP(ip_bintoip($ip, $self->version())) or return; return ($new); } #------------------------------------------------------------------------------ # Subroutine aggregate # Purpose : Aggregate (append) two IPs # Params : IP to add # Returns : New IP object or undef (failure) sub aggregate { my ($self, $other) = @_; my $r = ip_aggregate( $self->binip(), $self->last_bin(), $other->binip(), $other->last_bin(), $self->version() ); if (!$r) { $self->{error} = $ERROR; $self->{errno} = $ERRNO; return; } return (new Net::IP($r)); } #------------------------------------------------------------------------------ # Subroutine overlaps # Purpose : Check if two prefixes overlap # Params : Prefix to compare # Returns : $NO_OVERLAP (no overlap) # $IP_PARTIAL_OVERLAP (overlap) # $IP_A_IN_B_OVERLAP (range1 is included in range2) # $IP_B_IN_A_OVERLAP (range2 is included in range1) # $IP_IDENTICAL (range1 == range2) # or undef (problem) sub overlaps { my ($self, $other) = @_; my $r = ip_is_overlap( $self->binip(), $self->last_bin(), $other->binip(), $other->last_bin() ); if (!defined($r)) { $self->{error} = $ERROR; $self->{errno} = $ERRNO; return; } return ($r); } #------------------------------------------------------------------------------ # Subroutine auth # Purpose : Return Authority information from IP::Authority # Params : IP object # Returns : Authority Source sub auth { my ($self) = shift; return ($self->{auth}) if defined($self->{auth}); my $auth = ip_auth($self->ip, $self->version); if (!$auth) { $self->{error} = $ERROR; $self->{errno} = $ERRNO; return; } $self->{auth} = $auth; return ($self->{auth}); } #------------------------------ PROCEDURAL INTERFACE -------------------------- #------------------------------------------------------------------------------ # Subroutine Error # Purpose : Return the ERROR string # Returns : string sub Error { return ($ERROR); } #------------------------------------------------------------------------------ # Subroutine Error # Purpose : Return the ERRNO value # Returns : number sub Errno { return ($ERRNO); } #------------------------------------------------------------------------------ # Subroutine ip_iplengths # Purpose : Get the length in bits of an IP from its version # Params : IP version # Returns : Number of bits sub ip_iplengths { my ($version) = @_; if ($version == 4) { return (32); } elsif ($version == 6) { return (128); } else { return; } } #------------------------------------------------------------------------------ # Subroutine ip_iptobin # Purpose : Transform an IP address into a bit string # Params : IP address, IP version # Returns : bit string on success, undef otherwise sub ip_iptobin { my ($ip, $ipversion) = @_; # v4 -> return 32-bit array if ($ipversion == 4) { return unpack('B32', pack('C4C4C4C4', split(/\./, $ip))); } # Strip ':' $ip =~ s/://g; # Check size unless (length($ip) == 32) { $ERROR = "Bad IP address $ip"; $ERRNO = 102; return; } # v6 -> return 128-bit array return unpack('B128', pack('H32', $ip)); } #------------------------------------------------------------------------------ # Subroutine ip_bintoip # Purpose : Transform a bit string into an IP address # Params : bit string, IP version # Returns : IP address on success, undef otherwise sub ip_bintoip { my ($binip, $ip_version) = @_; # Define normal size for address my $len = ip_iplengths($ip_version); if ($len < length($binip)) { $ERROR = "Invalid IP length for binary IP $binip\n"; $ERRNO = 189; return; } # Prepend 0s if address is less than normal size $binip = '0' x ($len - length($binip)) . $binip; # IPv4 if ($ip_version == 4) { return join '.', unpack('C4C4C4C4', pack('B32', $binip)); } # IPv6 return join(':', unpack('H4H4H4H4H4H4H4H4', pack('B128', $binip))); } #------------------------------------------------------------------------------ # Subroutine ip_bintoint # Purpose : Transform a bit string into an Integer # Params : bit string # Returns : BigInt sub ip_bintoint { my $binip = shift; # $n is the increment, $dec is the returned value my ($n, $dec) = (Math::BigInt->new(1), Math::BigInt->new(0)); # Reverse the bit string foreach (reverse(split '', $binip)) { # If the nth bit is 1, add 2**n to $dec $_ and $dec += $n; $n *= 2; } # Strip leading + sign $dec =~ s/^\+//; return $dec; } #------------------------------------------------------------------------------ # Subroutine ip_inttobin # Purpose : Transform a BigInt into a bit string # Comments : sets warnings (-w) off. # This is necessary because Math::BigInt is not compliant # Params : BigInt, IP version # Returns : bit string sub ip_inttobin { my $dec = Math::BigInt->new(shift); # Find IP version my $ip_version = shift; unless ($ip_version) { $ERROR = "Cannot determine IP version for $dec"; $ERRNO = 101; return; } my $binip = $dec->as_bin(); $binip =~ s/^0b//; # Define normal size for address my $len = ip_iplengths($ip_version); # Prepend 0s if result is less than normal size $binip = '0' x ($len - length($binip)) . $binip; return $binip; } #------------------------------------------------------------------------------ # Subroutine ip_get_version # Purpose : Get an IP version # Params : IP address # Returns : 4, 6, 0(don't know) sub ip_get_version { my $ip = shift; # If the address does not contain any ':', maybe it's IPv4 $ip !~ /:/ and ip_is_ipv4($ip) and return '4'; # Is it IPv6 ? ip_is_ipv6($ip) and return '6'; return; } #------------------------------------------------------------------------------ # Subroutine ip_is_ipv4 # Purpose : Check if an IP address is version 4 # Params : IP address # Returns : 1 (yes) or 0 (no) sub ip_is_ipv4 { my $ip = shift; # Check for invalid chars unless ($ip =~ m/^[\d\.]+$/) { $ERROR = "Invalid chars in IP $ip"; $ERRNO = 107; return 0; } if ($ip =~ m/^\./) { $ERROR = "Invalid IP $ip - starts with a dot"; $ERRNO = 103; return 0; } if ($ip =~ m/\.$/) { $ERROR = "Invalid IP $ip - ends with a dot"; $ERRNO = 104; return 0; } # Single Numbers are considered to be IPv4 if ($ip =~ m/^(\d+)$/ and $1 < 256) { return 1 } # Count quads my $n = ($ip =~ tr/\./\./); # IPv4 must have from 1 to 4 quads unless ($n >= 0 and $n < 4) { $ERROR = "Invalid IP address $ip"; $ERRNO = 105; return 0; } # Check for empty quads if ($ip =~ m/\.\./) { $ERROR = "Empty quad in IP address $ip"; $ERRNO = 106; return 0; } foreach (split /\./, $ip) { # Check for invalid quads unless ($_ >= 0 and $_ < 256) { $ERROR = "Invalid quad in IP address $ip - $_"; $ERRNO = 107; return 0; } } return 1; } #------------------------------------------------------------------------------ # Subroutine ip_is_ipv6 # Purpose : Check if an IP address is version 6 # Params : IP address # Returns : 1 (yes) or 0 (no) sub ip_is_ipv6 { my $ip = shift; # Count octets my $n = ($ip =~ tr/:/:/); return 0 unless ($n > 0 and $n < 8); # $k is a counter my $k; foreach (split /:/, $ip) { $k++; # Empty octet ? next if ($_ eq ''); # Normal v6 octet ? next if (/^[a-f\d]{1,4}$/i); # Last octet - is it IPv4 ? if ( ($k == $n + 1) && ip_is_ipv4($_) ) { $n++; # ipv4 is two octets next; } $ERROR = "Invalid IP address $ip"; $ERRNO = 108; return 0; } # Does the IP address start with : ? if ($ip =~ m/^:[^:]/) { $ERROR = "Invalid address $ip (starts with :)"; $ERRNO = 109; return 0; } # Does the IP address finish with : ? if ($ip =~ m/[^:]:$/) { $ERROR = "Invalid address $ip (ends with :)"; $ERRNO = 110; return 0; } # Does the IP address have more than one '::' pattern ? if ($ip =~ s/:(?=:)/:/g > 1) { $ERROR = "Invalid address $ip (More than one :: pattern)"; $ERRNO = 111; return 0; } # number of octets if ($n != 7 && $ip !~ /::/) { $ERROR = "Invalid number of octets $ip"; $ERRNO = 112; return 0; } # valid IPv6 address return 1; } #------------------------------------------------------------------------------ # Subroutine ip_expand_address # Purpose : Expand an address from compact notation # Params : IP address, IP version # Returns : expanded IP address or undef on failure sub ip_expand_address { my ($ip, $ip_version) = @_; unless ($ip_version) { $ERROR = "Cannot determine IP version for $ip"; $ERRNO = 101; return; } # v4 : add .0 for missing quads if ($ip_version == 4) { my @quads = split /\./, $ip; # check number of quads if (scalar(@quads) > 4) { $ERROR = "Not a valid IPv address $ip"; $ERRNO = 102; return; } my @clean_quads = (0, 0, 0, 0); foreach my $q (reverse @quads) { #check quad data if ($q !~ m/^\d{1,3}$/) { $ERROR = "Not a valid IPv4 address $ip"; $ERRNO = 102; return; } # build clean ipv4 unshift(@clean_quads, $q + 1 - 1); } return (join '.', @clean_quads[ 0 .. 3 ]); } # Keep track of :: my $num_of_double_colon = ($ip =~ s/::/:!:/g); if ($num_of_double_colon > 1) { $ERROR = "Too many :: in ip"; $ERRNO = 102; return; } # IP as an array my @ip = split /:/, $ip; # Number of octets my $num = scalar(@ip); foreach (0 .. (scalar(@ip) - 1)) { # Embedded IPv4 if ($ip[$_] =~ /\./) { # Expand Ipv4 address # Convert into binary # Convert into hex # Keep the last two octets $ip[$_] = substr( ip_bintoip( ip_iptobin( ip_expand_address($ip[$_], 4), 4), 6), -9); # Has an error occured here ? return unless (defined($ip[$_])); # $num++ because we now have one more octet: # IPv4 address becomes two octets $num++; next; } # Add missing trailing 0s $ip[$_] = ('0' x (4 - length($ip[$_]))) . $ip[$_]; } # Now deal with '::' ('000!') foreach (0 .. (scalar(@ip) - 1)) { # Find the pattern next unless ($ip[$_] eq '000!'); # @empty is the IP address 0 my @empty = map { $_ = '0' x 4 } (0 .. 7); # Replace :: with $num '0000' octets $ip[$_] = join ':', @empty[ 0 .. 8 - $num ]; last; } return (lc(join ':', @ip)); } #------------------------------------------------------------------------------ # Subroutine ip_get_mask # Purpose : Get IP mask from prefix length. # Params : Prefix length, IP version # Returns : Binary Mask sub ip_get_mask { my ($len, $ip_version) = @_; unless ($ip_version) { $ERROR = "Cannot determine IP version"; $ERRNO = 101; return; } my $size = ip_iplengths($ip_version); # mask is $len 1s plus the rest as 0s return (('1' x $len) . ('0' x ($size - $len))); } #------------------------------------------------------------------------------ # Subroutine ip_last_address_bin # Purpose : Return the last binary address of a range # Params : First binary IP, prefix length, IP version # Returns : Binary IP sub ip_last_address_bin { my ($binip, $len, $ip_version) = @_; unless ($ip_version) { $ERROR = "Cannot determine IP version"; $ERRNO = 101; return; } my $size = ip_iplengths($ip_version); # Find the part of the IP address which will not be modified $binip = substr($binip, 0, $len); # Fill with 1s the variable part return ($binip . ('1' x ($size - length($binip)))); } #------------------------------------------------------------------------------ # Subroutine ip_splitprefix # Purpose : Split a prefix into IP and prefix length # Comments : If it was passed a simple IP, it just returns it # Params : Prefix # Returns : IP, optionnaly length of prefix sub ip_splitprefix { my $prefix = shift; # Find the '/' return unless ($prefix =~ m!^([^/]+?)(/\d+)?$!); my ($ip, $len) = ($1, $2); defined($len) and $len =~ s!/!!; return ($ip, $len); } #------------------------------------------------------------------------------ # Subroutine ip_prefix_to_range # Purpose : Get a range from a prefix # Params : IP, Prefix length, IP version # Returns : First IP, last IP sub ip_prefix_to_range { my ($ip, $len, $ip_version) = @_; unless ($ip_version) { $ERROR = "Cannot determine IP version"; $ERRNO = 101; return; } # Expand the first IP address $ip = ip_expand_address($ip, $ip_version); # Turn into a binary # Get last address # Turn into an IP my $binip = ip_iptobin($ip, $ip_version) or return; return unless (ip_check_prefix($binip, $len, $ip_version)); my $lastip = ip_last_address_bin($binip, $len, $ip_version) or return; return unless ($lastip = ip_bintoip($lastip, $ip_version)); return ($ip, $lastip); } #------------------------------------------------------------------------------ # Subroutine ip_is_valid_mask # Purpose : Check the validity of an IP mask (11110000) # Params : Mask # Returns : 1 or undef (invalid) sub ip_is_valid_mask { my ($mask, $ip_version) = @_; unless ($ip_version) { $ERROR = "Cannot determine IP version for $mask"; $ERRNO = 101; return; } my $len = ip_iplengths($ip_version); if (length($mask) != $len) { $ERROR = "Invalid mask length for $mask"; $ERRNO = 150; return; } # The mask should be of the form 111110000000 unless ($mask =~ m/^1*0*$/) { $ERROR = "Invalid mask $mask"; $ERRNO = 151; return; } return 1; } #------------------------------------------------------------------------------ # Subroutine ip_bincomp # Purpose : Compare binary Ips with <, >, <=, >= # Comments : Operators are lt(<), le(<=), gt(>), and ge(>=) # Params : First binary IP, operator, Last binary Ip # Returns : 1 (yes), 0 (no), or undef (problem) sub ip_bincomp { my ($begin, $op, $end) = @_; my ($b, $e); if ($op =~ /^l[te]$/) # Operator is lt or le { ($b, $e) = ($end, $begin); } elsif ($op =~ /^g[te]$/) # Operator is gt or ge { ($b, $e) = ($begin, $end); } else { $ERROR = "Invalid Operator $op\n"; $ERRNO = 131; return; } # le or ge -> return 1 if IPs are identical return (1) if ($op =~ /e/ and ($begin eq $end)); # Check IP sizes unless (length($b) eq length($e)) { $ERROR = "IP addresses of different length\n"; $ERRNO = 130; return; } my $c; # Foreach bit for (0 .. length($b) - 1) { # substract the two bits $c = substr($b, $_, 1) - substr($e, $_, 1); # Check the result return (1) if ($c == 1); return (0) if ($c == -1); } # IPs are identical return 0; } #------------------------------------------------------------------------------ # Subroutine ip_binadd # Purpose : Add two binary IPs # Params : First binary IP, Last binary Ip # Returns : Binary sum or undef (problem) sub ip_binadd { my ($b, $e) = @_; # Check IP length unless (length($b) eq length($e)) { $ERROR = "IP addresses of different length\n"; $ERRNO = 130; return; } # Reverse the two IPs $b = scalar(reverse $b); $e = scalar(reverse $e); my ($carry, $result, $c) = (0); # Foreach bit (reversed) for (0 .. length($b) - 1) { # add the two bits plus the carry $c = substr($b, $_, 1) + substr($e, $_, 1) + $carry; $carry = 0; # sum = 0 => $c = 0, $carry = 0 # sum = 1 => $c = 1, $carry = 0 # sum = 2 => $c = 0, $carry = 1 # sum = 3 => $c = 1, $carry = 1 if ($c > 1) { $c -= 2; $carry = 1; } $result .= $c; } # Reverse result return scalar(reverse($result)); } #------------------------------------------------------------------------------ # Subroutine ip_get_prefix_length # Purpose : Get the prefix length for a given range of IPs # Params : First binary IP, Last binary IP # Returns : Length of prefix or undef (problem) sub ip_get_prefix_length { my ($bin1, $bin2) = @_; # Check length of IPs unless (length($bin1) eq length($bin2)) { $ERROR = "IP addresses of different length\n"; $ERRNO = 130; return; } # reverse IPs $bin1 = scalar(reverse $bin1); $bin2 = scalar(reverse $bin2); # foreach bit for (0 .. length($bin1) - 1) { # If bits are equal it means we have reached the longest prefix return ("$_") if (substr($bin1, $_, 1) eq substr($bin2, $_, 1)); } # Return 32 (IPv4) or 128 (IPv6) return length($bin1); } #------------------------------------------------------------------------------ # Subroutine ip_range_to_prefix # Purpose : Return all prefixes between two IPs # Params : First IP, Last IP, IP version # Returns : List of Prefixes or undef (problem) sub ip_range_to_prefix { my ($binip, $endbinip, $ip_version) = @_; unless ($ip_version) { $ERROR = "Cannot determine IP version"; $ERRNO = 101; return; } unless (length($binip) eq length($endbinip)) { $ERROR = "IP addresses of different length\n"; $ERRNO = 130; return; } my ($len, $nbits, $current, $add, @prefix); # 1 in binary my $one = ('0' x (ip_iplengths($ip_version) - 1)) . '1'; # While we have not reached the last IP while (ip_bincomp($binip, 'le', $endbinip) == 1) { # Find all 0s at the end if ($binip =~ m/(0+)$/) { # nbits = nb of 0 bits $nbits = length($1); } else { $nbits = 0; } do { $current = $binip; $add = '1' x $nbits; # Replace $nbits 0s with 1s $current =~ s/0{$nbits}$/$add/; $nbits--; # Decrease $nbits if $current >= $endbinip } while (ip_bincomp($current, 'le', $endbinip) != 1); # Find Prefix length $len = (ip_iplengths($ip_version)) - ip_get_prefix_length($binip, $current); # Push prefix in list push(@prefix, ip_bintoip($binip, $ip_version) . "/$len"); # Add 1 to current IP $binip = ip_binadd($current, $one); # Exit if IP is 32/128 1s last if ($current =~ m/^1+$/); } return (@prefix); } #------------------------------------------------------------------------------ # Subroutine ip_compress_v4_prefix # Purpose : Compress an IPv4 Prefix # Params : IP, Prefix length # Returns : Compressed IP - ie: 194.5 sub ip_compress_v4_prefix { my ($ip, $len) = @_; my @quads = split /\./, $ip; my $qlen = int(($len - 1) / 8); $qlen = 0 if ($qlen < 0); my $newip = join '.', @quads[ 0 .. $qlen ]; return ($newip); } #------------------------------------------------------------------------------ # Subroutine ip_compress_address # Purpose : Compress an IPv6 address # Params : IP, IP version # Returns : Compressed IP or undef (problem) sub ip_compress_address { my ($ip, $ip_version) = @_; unless ($ip_version) { $ERROR = "Cannot determine IP version for $ip"; $ERRNO = 101; return; } # Just return if IP is IPv4 return ($ip) if ($ip_version == 4); # already compressed addresses must be expanded first $ip = ip_expand_address( $ip, $ip_version); # Remove leading 0s: 0034 -> 34; 0000 -> 0 $ip =~ s/ (^|:) # Find beginning or ':' -> $1 0+ # 1 or several 0s (?= # Look-ahead [a-fA-F\d]+ # One or several Hexs (?::|$)) # ':' or end /$1/gx; my $reg = ''; # Find the longuest :0:0: sequence while ( $ip =~ m/ ((?:^|:) # Find beginning or ':' -> $1 0(?::0)+ # 0 followed by 1 or several ':0' (?::|$)) # ':' or end /gx ) { $reg = $1 if (length($reg) < length($1)); } # Replace sequence by '::' $ip =~ s/$reg/::/ if ($reg ne ''); return $ip; } #------------------------------------------------------------------------------ # Subroutine ip_is_overlap # Purpose : Check if two ranges overlap # Params : Four binary IPs (begin of range 1,end1,begin2,end2) # Returns : $NO_OVERLAP (no overlap) # $IP_PARTIAL_OVERLAP (overlap) # $IP_A_IN_B_OVERLAP (range1 is included in range2) # $IP_B_IN_A_OVERLAP (range2 is included in range1) # $IP_IDENTICAL (range1 == range2) # or undef (problem) sub ip_is_overlap { my ($b1, $e1, $b2, $e2) = (@_); my $swap; $swap = 0; unless ((length($b1) eq length($e1)) and (length($b2) eq length($e2)) and (length($b1) eq length($b2))) { $ERROR = "IP addresses of different length\n"; $ERRNO = 130; return; } # begin1 <= end1 ? unless (ip_bincomp($b1, 'le', $e1) == 1) { $ERROR = "Invalid range $b1 - $e1"; $ERRNO = 140; return; } # begin2 <= end2 ? unless (ip_bincomp($b2, 'le', $e2) == 1) { $ERROR = "Invalid range $b2 - $e2"; $ERRNO = 140; return; } # b1 == b2 ? if ($b1 eq $b2) { # e1 == e2 return ($IP_IDENTICAL) if ($e1 eq $e2); # e1 < e2 ? return ( ip_bincomp($e1, 'lt', $e2) ? $IP_A_IN_B_OVERLAP : $IP_B_IN_A_OVERLAP ); } # e1 == e2 ? if ($e1 eq $e2) { # b1 < b2 return ( ip_bincomp($b1, 'lt', $b2) ? $IP_B_IN_A_OVERLAP : $IP_A_IN_B_OVERLAP ); } # b1 < b2 if ((ip_bincomp($b1, 'lt', $b2) == 1)) { # e1 < b2 return ($IP_NO_OVERLAP) if (ip_bincomp($e1, 'lt', $b2) == 1); # e1 < e2 ? return ( ip_bincomp($e1, 'lt', $e2) ? $IP_PARTIAL_OVERLAP : $IP_B_IN_A_OVERLAP ); } else # b1 > b2 { # e2 < b1 return ($IP_NO_OVERLAP) if (ip_bincomp($e2, 'lt', $b1) == 1); # e2 < e1 ? return ( ip_bincomp($e2, 'lt', $e1) ? $IP_PARTIAL_OVERLAP : $IP_A_IN_B_OVERLAP ); } } #------------------------------------------------------------------------------ # Subroutine get_embedded_ipv4 # Purpose : Get an IPv4 embedded in an IPv6 address # Params : IPv6 # Returns : IPv4 or undef (not found) sub ip_get_embedded_ipv4 { my $ipv6 = shift; my @ip = split /:/, $ipv6; # Bugfix by Norbert Koch return unless (@ip); # last octet should be ipv4 return ($ip[-1]) if (ip_is_ipv4($ip[-1])); return; } #------------------------------------------------------------------------------ # Subroutine aggregate # Purpose : Aggregate 2 ranges # Params : 1st range (1st IP, Last IP), last range (1st IP, last IP), # IP version # Returns : prefix or undef (invalid) sub ip_aggregate { my ($binbip1, $bineip1, $binbip2, $bineip2, $ip_version) = @_; unless ($ip_version) { $ERROR = "Cannot determine IP version for $binbip1"; $ERRNO = 101; return; } # Bin 1 my $one = (('0' x (ip_iplengths($ip_version) - 1)) . '1'); # $eip1 + 1 = $bip2 ? unless (ip_binadd($bineip1, $one) eq $binbip2) { $ERROR = "Ranges not contiguous - $bineip1 - $binbip2"; $ERRNO = 160; return; } # Get ranges my @prefix = ip_range_to_prefix($binbip1, $bineip2, $ip_version); # There should be only one range return if scalar(@prefix) < 1; if (scalar(@prefix) > 1) { $ERROR = "$binbip1 - $bineip2 is not a single prefix"; $ERRNO = 161; return; } return ($prefix[0]); } #------------------------------------------------------------------------------ # Subroutine ip_iptype # Purpose : Return the type of an IP (Public, Private, Reserved) # Params : IP to test, IP version # Returns : type or undef (invalid) sub ip_iptype { my ($ip, $ip_version) = @_; # handle known ip versions return ip_iptypev4($ip) if $ip_version == 4; return ip_iptypev6($ip) if $ip_version == 6; # unsupported ip version $ERROR = "IP version $ip not supported"; $ERRNO = 180; return; } #------------------------------------------------------------------------------ # Subroutine ip_iptypev4 # Purpose : Return the type of an IP (Public, Private, Reserved) # Params : IP to test, IP version # Returns : type or undef (invalid) sub ip_iptypev4 { my ($ip) = @_; # check ip if ($ip !~ m/^[01]{1,32}$/) { $ERROR = "$ip is not a binary IPv4 address $ip"; $ERRNO = 180; return; } # see if IP is listed foreach (sort { length($b) <=> length($a) } keys %IPv4ranges) { return ($IPv4ranges{$_}) if ($ip =~ m/^$_/); } # not listed means IP is public return 'PUBLIC'; } #------------------------------------------------------------------------------ # Subroutine ip_iptypev6 # Purpose : Return the type of an IP (Public, Private, Reserved) # Params : IP to test, IP version # Returns : type or undef (invalid) sub ip_iptypev6 { my ($ip) = @_; # check ip if ($ip !~ m/^[01]{1,128}$/) { $ERROR = "$ip is not a binary IPv6 address"; $ERRNO = 180; return; } foreach (sort { length($b) <=> length($a) } keys %IPv6ranges) { return ($IPv6ranges{$_}) if ($ip =~ m/^$_/); } # How did we get here? All IPv6 addresses should match $ERROR = "Cannot determine type for $ip"; $ERRNO = 180; return; } #------------------------------------------------------------------------------ # Subroutine ip_check_prefix # Purpose : Check the validity of a prefix # Params : binary IP, length of prefix, IP version # Returns : 1 or undef (invalid) sub ip_check_prefix { my ($binip, $len, $ipversion) = (@_); # Check if len is longer than IP if ($len > length($binip)) { $ERROR = "Prefix length $len is longer than IP address (" . length($binip) . ")"; $ERRNO = 170; return; } my $rest = substr($binip, $len); # Check if last part of the IP (len part) has only 0s unless ($rest =~ /^0*$/) { $ERROR = "Invalid prefix $binip/$len"; $ERRNO = 171; return; } # Check if prefix length is correct unless (length($rest) + $len == ip_iplengths($ipversion)) { $ERROR = "Invalid prefix length /$len"; $ERRNO = 172; return; } return 1; } #------------------------------------------------------------------------------ # Subroutine ip_reverse # Purpose : Get a reverse name from a prefix # Comments : From Lee's iplib.pm # Params : IP, length of prefix, IP version # Returns : Reverse name or undef (error) sub ip_reverse { my ($ip, $len, $ip_version) = (@_); $ip_version ||= ip_get_version($ip); unless ($ip_version) { $ERROR = "Cannot determine IP version for $ip"; $ERRNO = 101; return; } if ($ip_version == 4) { my @quads = split /\./, $ip; my $no_quads = ($len / 8); my @reverse_quads = reverse @quads; while (@reverse_quads and $reverse_quads[0] == 0) { shift(@reverse_quads); } return join '.', @reverse_quads, 'in-addr', 'arpa.'; } elsif ($ip_version == 6) { my @rev_groups = reverse split /:/, ip_expand_address($ip, 6); my @result; foreach (@rev_groups) { my @revhex = reverse split //; push @result, @revhex; } # This takes the zone above if it's not exactly on a nibble my $first_nibble_index = $len ? 32 - (int($len / 4)) : 0; return join '.', @result[ $first_nibble_index .. $#result ], 'ip6', 'arpa.'; } } #------------------------------------------------------------------------------ # Subroutine ip_normalize # Purpose : Normalize data to a range of IP addresses # Params : IP or prefix or range # Returns : ip1, ip2 (if range) or undef (error) sub ip_normalize { my ($data) = shift; my $ipversion; my ($len, $ip, $ip2, $real_len, $first, $last, $curr_bin, $addcst, $clen); # Prefix if ($data =~ m!^(\S+?)(/\S+)$!) { ($ip, $len) = ($1, $2); return unless ($ipversion = ip_get_version($ip)); return unless ($ip = ip_expand_address($ip, $ipversion)); return unless ($curr_bin = ip_iptobin($ip, $ipversion)); my $one = '0' x (ip_iplengths($ipversion) - 1) . '1'; while ($len) { last unless ($len =~ s!^/(\d+)(\,|$)!!); $clen = $1; $addcst = length($2) > 0; return unless (ip_check_prefix($curr_bin, $clen, $ipversion)); return unless ($curr_bin = ip_last_address_bin($curr_bin, $clen, $ipversion)); if ($addcst) { return unless ($curr_bin = ip_binadd($curr_bin, $one)); } } return ($ip, ip_bintoip($curr_bin, $ipversion)); } # Range elsif ($data =~ /^(.+?)\s*\-\s*(.+)$/) { ($ip, $ip2) = ($1, $2); return unless ($ipversion = ip_get_version($ip)); return unless ($ip = ip_expand_address($ip, $ipversion)); return unless ($ip2 = ip_expand_address($ip2, $ipversion)); return ($ip, $ip2); } # IP + Number elsif ($data =~ /^(.+?)\s+\+\s+(.+)$/) { ($ip, $len) = ($1, $2); return unless ($ipversion = ip_get_version($ip)); return unless ($ip = ip_expand_address($ip, $ipversion)); my ($bin_ip); return unless ($bin_ip = ip_iptobin($ip, $ipversion)); return unless ($len = ip_inttobin($len, $ipversion)); return unless ($ip2 = ip_binadd($bin_ip, $len)); return unless ($ip2 = ip_bintoip($ip2, $ipversion)); return ($ip, $ip2); } # Single IP else { $ip = $data; return unless ($ipversion = ip_get_version($ip)); return unless ($ip = ip_expand_address($ip, $ipversion)); return $ip; } } #------------------------------------------------------------------------------ # Subroutine normal_range # Purpose : Return the normalized format of a range # Params : IP or prefix or range # Returns : "ip1 - ip2" or undef (error) sub ip_normal_range { my ($data) = shift; my ($ip1, $ip2) = ip_normalize($data); return unless ($ip1); $ip2 ||= $ip1; return ("$ip1 - $ip2"); } #------------------------------------------------------------------------------ # Subroutine ip_auth # Purpose : Get Authority information from IP::Authority Module # Comments : Requires IP::Authority # Params : IP, length of prefix # Returns : Reverse name or undef (error) sub ip_auth { my ($ip, $ip_version) = (@_); unless ($ip_version) { $ERROR = "Cannot determine IP version for $ip"; $ERRNO = 101; die; return; } if ($ip_version != 4) { $ERROR = "Cannot get auth information: Not an IPv4 address"; $ERRNO = 308; die; return; } require IP::Authority; my $reg = new IP::Authority; return ($reg->inet_atoauth($ip)); } 1; __END__ =encoding utf8 =head1 NAME Net::IP - Perl extension for manipulating IPv4/IPv6 addresses =head1 SYNOPSIS use Net::IP; my $ip = new Net::IP ('193.0.1/24') or die (Net::IP::Error()); print ("IP : ".$ip->ip()."\n"); print ("Sho : ".$ip->short()."\n"); print ("Bin : ".$ip->binip()."\n"); print ("Int : ".$ip->intip()."\n"); print ("Mask: ".$ip->mask()."\n"); print ("Last: ".$ip->last_ip()."\n"); print ("Len : ".$ip->prefixlen()."\n"); print ("Size: ".$ip->size()."\n"); print ("Type: ".$ip->iptype()."\n"); print ("Rev: ".$ip->reverse_ip()."\n"); =head1 DESCRIPTION This module provides functions to deal with B addresses. The module can be used as a class, allowing the user to instantiate IP objects, which can be single IP addresses, prefixes, or ranges of addresses. There is also a procedural way of accessing most of the functions. Most subroutines can take either B or B addresses transparently. =head1 OBJECT-ORIENTED INTERFACE =head2 Object Creation A Net::IP object can be created from a single IP address: $ip = new Net::IP ('193.0.1.46') || die ... Or from a Classless Prefix (a /24 prefix is equivalent to a C class): $ip = new Net::IP ('195.114.80/24') || die ... Or from a range of addresses: $ip = new Net::IP ('20.34.101.207 - 201.3.9.99') || die ... Or from a address plus a number: $ip = new Net::IP ('20.34.10.0 + 255') || die ... The new() function accepts IPv4 and IPv6 addresses: $ip = new Net::IP ('dead:beef::/32') || die ... Optionnaly, the function can be passed the version of the IP. Otherwise, it tries to guess what the version is (see B<_is_ipv4()> and B<_is_ipv6()>). $ip = new Net::IP ('195/8',4); # Class A =head1 OBJECT METHODS Most of these methods are front-ends for the real functions, which use a procedural interface. Most functions return undef on failure, and a true value on success. A detailed description of the procedural interface is provided below. =head2 set Set an IP address in an existing IP object. This method has the same functionality as the new() method, except that it reuses an existing object to store the new IP. C<$ip-Eset('130.23.1/24',4);> Like new(), set() takes two arguments - a string used to build an IP address, prefix, or range, and optionally, the IP version of the considered address. It returns an IP object on success, and undef on failure. =head2 error Return the current object error string. The error string is set whenever one of the methods produces an error. Also, a global, class-wide B function is avaliable. Cerror());> =head2 errno Return the current object error number. The error number is set whenever one of the methods produces an error. Also, a global B<$ERRNO> variable is set when an error is produced. Cerrno());> =head2 ip Return the IP address (or first IP of the prefix or range) in quad format, as a string. Cip());> =head2 binip Return the IP address as a binary string of 0s and 1s. Cbinip());> =head2 prefixlen Return the length in bits of the current prefix. Cprefixlen());> =head2 version Return the version of the current IP object (4 or 6). Cversion());> =head2 size Return the number of IP addresses in the current prefix or range. Use of this function requires Math::BigInt. Csize());> =head2 binmask Return the binary mask of the current prefix, if applicable. Cbinmask());> =head2 mask Return the mask in quad format of the current prefix. Cmask());> =head2 prefix Return the full prefix (ip+prefix length) in quad (standard) format. Cprefix());> =head2 print Print the IP object (IP/Prefix or First - Last) Cprint());> =head2 intip Convert the IP in integer format and return it as a Math::BigInt object. Cintip());> =head2 hexip Return the IP in hex format Chexip());> =head2 hexmask Return the mask in hex format Chexmask());> =head2 short Return the IP in short format: IPv4 addresses: 194.5/16 IPv6 addresses: ab32:f000:: Cshort());> =head2 iptype Return the IP Type - this describes the type of an IP (Public, Private, Reserved, etc.) See procedural interface ip_iptype for more details. Ciptype());> =head2 reverse_ip Return the reverse IP for a given IP address (in.addr. format). Creserve_ip());> =head2 last_ip Return the last IP of a prefix/range in quad format. Clast_ip());> =head2 last_bin Return the last IP of a prefix/range in binary format. Clast_bin());> =head2 last_int Return the last IP of a prefix/range in integer format. Clast_int());> =head2 find_prefixes This function finds all the prefixes that can be found between the two addresses of a range. The function returns a list of prefixes. C<@list = $ip-Efind_prefixes($other_ip));> =head2 bincomp Binary comparaison of two IP objects. The function takes an operation and an IP object as arguments. It returns a boolean value. The operation can be one of: lt: less than (smaller than) le: smaller or equal to gt: greater than ge: greater or equal to Cbincomp('lt',$ip2) {...}> =head2 binadd Binary addition of two IP objects. The value returned is an IP object. Cbinadd($ip2);> =head2 aggregate Aggregate 2 IPs - Append one range/prefix of IPs to another. The last address of the first range must be the one immediately preceding the first address of the second range. A new IP object is returned. Caggregate($ip2);> =head2 overlaps Check if two IP ranges/prefixes overlap each other. The value returned by the function should be one of: $IP_PARTIAL_OVERLAP (ranges overlap) $IP_NO_OVERLAP (no overlap) $IP_A_IN_B_OVERLAP (range2 contains range1) $IP_B_IN_A_OVERLAP (range1 contains range2) $IP_IDENTICAL (ranges are identical) undef (problem) Coverlaps($ip2)==$IP_A_IN_B_OVERLAP) {...};> =head2 looping The C<+> operator is overloaded in order to allow looping though a whole range of IP addresses: my $ip = new Net::IP ('195.45.6.7 - 195.45.6.19') || die; # Loop do { print $ip->ip(), "\n"; } while (++$ip); The ++ operator returns undef when the last address of the range is reached. =head2 auth Return IP authority information from the IP::Authority module C<$auth = ip->auth ();> Note: IPv4 only =head1 PROCEDURAL INTERFACE These functions do the real work in the module. Like the OO methods, most of these return undef on failure. In order to access error codes and strings, instead of using $ip-Eerror() and $ip-Eerrno(), use the global functions C and C. The functions of the procedural interface are not exported by default. In order to import these functions, you need to modify the use statement for the module: C =head2 Error Returns the error string corresponding to the last error generated in the module. This is also useful for the OO interface, as if the new() function fails, we cannot call $ip-Eerror() and so we have to use Error(). warn Error(); =head2 Errno Returns a numeric error code corresponding to the error string returned by Error. =head2 ip_iptobin Transform an IP address into a bit string. Params : IP address, IP version Returns : binary IP string on success, undef otherwise C<$binip = ip_iptobin ($ip,6);> =head2 ip_bintoip Transform a bit string into an IP address Params : binary IP, IP version Returns : IP address on success, undef otherwise C<$ip = ip_bintoip ($binip,6);> =head2 ip_bintoint Transform a bit string into a BigInt. Params : binary IP Returns : BigInt C<$bigint = new Math::BigInt (ip_bintoint($binip));> =head2 ip_inttobin Transform a BigInt into a bit string. I: sets warnings (C<-w>) off. This is necessary because Math::BigInt is not compliant. Params : BigInt, IP version Returns : binary IP C<$binip = ip_inttobin ($bigint);> =head2 ip_get_version Try to guess the IP version of an IP address. Params : IP address Returns : 4, 6, undef(unable to determine) C<$version = ip_get_version ($ip)> =head2 ip_is_ipv4 Check if an IP address is of type 4. Params : IP address Returns : 1 (yes) or 0 (no) C =head2 ip_is_ipv6 Check if an IP address is of type 6. Params : IP address Returns : 1 (yes) or 0 (no) C =head2 ip_expand_address Expand an IP address from compact notation. Params : IP address, IP version Returns : expanded IP address or undef on failure C<$ip = ip_expand_address ($ip,4);> =head2 ip_get_mask Get IP mask from prefix length. Params : Prefix length, IP version Returns : Binary Mask C<$mask = ip_get_mask ($len,6);> =head2 ip_last_address_bin Return the last binary address of a prefix. Params : First binary IP, prefix length, IP version Returns : Binary IP C<$lastbin = ip_last_address_bin ($ip,$len,6);> =head2 ip_splitprefix Split a prefix into IP and prefix length. If it was passed a simple IP, it just returns it. Params : Prefix Returns : IP, optionnaly length of prefix C<($ip,$len) = ip_splitprefix ($prefix)> =head2 ip_prefix_to_range Get a range of IPs from a prefix. Params : Prefix, IP version Returns : First IP, last IP C<($ip1,$ip2) = ip_prefix_to_range ($prefix,6);> =head2 ip_bincomp Compare binary Ips with <, >, <=, >=. Operators are lt(<), le(<=), gt(>), and ge(>=) Params : First binary IP, operator, Last binary IP Returns : 1 (yes), 0 (no), or undef (problem) C =head2 ip_binadd Add two binary IPs. Params : First binary IP, Last binary IP Returns : Binary sum or undef (problem) C<$binip = ip_binadd ($bin1,$bin2);> =head2 ip_get_prefix_length Get the prefix length for a given range of 2 IPs. Params : First binary IP, Last binary IP Returns : Length of prefix or undef (problem) C<$len = ip_get_prefix_length ($ip1,$ip2);> =head2 ip_range_to_prefix Return all prefixes between two IPs. Params : First IP (binary format), Last IP (binary format), IP version Returns : List of Prefixes or undef (problem) The prefixes returned have the form q.q.q.q/nn. C<@prefix = ip_range_to_prefix ($ip1,$ip2,6);> =head2 ip_compress_v4_prefix Compress an IPv4 Prefix. Params : IP, Prefix length Returns : Compressed Prefix C<$ip = ip_compress_v4_prefix ($ip, $len);> =head2 ip_compress_address Compress an IPv6 address. Just returns the IP if it is an IPv4. Params : IP, IP version Returns : Compressed IP or undef (problem) C<$ip = ip_compress_adress ($ip, $version);> =head2 ip_is_overlap Check if two ranges of IPs overlap. Params : Four binary IPs (begin of range 1,end1,begin2,end2), IP version $IP_PARTIAL_OVERLAP (ranges overlap) $IP_NO_OVERLAP (no overlap) $IP_A_IN_B_OVERLAP (range2 contains range1) $IP_B_IN_A_OVERLAP (range1 contains range2) $IP_IDENTICAL (ranges are identical) undef (problem) C<(ip_is_overlap($rb1,$re1,$rb2,$re2,4) eq $IP_A_IN_B_OVERLAP) and do {};> =head2 ip_get_embedded_ipv4 Get an IPv4 embedded in an IPv6 address Params : IPv6 Returns : IPv4 string or undef (not found) C<$ip4 = ip_get_embedded($ip6);> =head2 ip_check_mask Check the validity of a binary IP mask Params : Mask Returns : 1 or undef (invalid) C Checks if mask has only 1s followed by 0s. =head2 ip_aggregate Aggregate 2 ranges of binary IPs Params : 1st range (1st IP, Last IP), last range (1st IP, last IP), IP version Returns : prefix or undef (invalid) C<$prefix = ip_aggregate ($bip1,$eip1,$bip2,$eip2) || die ...> =head2 ip_iptypev4 Return the type of an IPv4 address. Params: binary IP Returns: type as of the following table or undef (invalid ip) See RFC 5735 and RFC 6598 S
S<-------------------------------------------------------------------> S<0.0.0.0/8 "This" Network RFC 1122 PRIVATE> S<10.0.0.0/8 Private-Use Networks RFC 1918 PRIVATE> S<100.64.0.0/10 CGN Shared Address Space RFC 6598 SHARED> S<127.0.0.0/8 Loopback RFC 1122 LOOPBACK> S<169.254.0.0/16 Link Local RFC 3927 LINK-LOCAL> S<172.16.0.0/12 Private-Use Networks RFC 1918 PRIVATE> S<192.0.0.0/24 IETF Protocol Assignments RFC 5736 RESERVED> S<192.0.2.0/24 TEST-NET-1 RFC 5737 TEST-NET> S<192.88.99.0/24 6to4 Relay Anycast RFC 3068 6TO4-RELAY> S<192.168.0.0/16 Private-Use Networks RFC 1918 PRIVATE> S<198.18.0.0/15 Network Interconnect> S< Device Benchmark Testing RFC 2544 RESERVED> S<198.51.100.0/24 TEST-NET-2 RFC 5737 TEST-NET> S<203.0.113.0/24 TEST-NET-3 RFC 5737 TEST-NET> S<224.0.0.0/4 Multicast RFC 3171 MULTICAST> S<240.0.0.0/4 Reserved for Future Use RFC 1112 RESERVED> S<255.255.255.255/32 Limited Broadcast RFC 919 BROADCAST> S< RFC 922> =head2 ip_iptypev6 Return the type of an IPv6 address. Params: binary ip Returns: type as of the following table or undef (invalid) See L and L S S<-------------------------------------------------------------> S<0000::/8 Reserved by IETF [RFC4291] RESERVED> S<0100::/8 Reserved by IETF [RFC4291] RESERVED> S<0200::/7 Reserved by IETF [RFC4048] RESERVED> S<0400::/6 Reserved by IETF [RFC4291] RESERVED> S<0800::/5 Reserved by IETF [RFC4291] RESERVED> S<1000::/4 Reserved by IETF [RFC4291] RESERVED> S<2000::/3 Global Unicast [RFC4291] GLOBAL-UNICAST> S<4000::/3 Reserved by IETF [RFC4291] RESERVED> S<6000::/3 Reserved by IETF [RFC4291] RESERVED> S<8000::/3 Reserved by IETF [RFC4291] RESERVED> S S S S S S S S S S S S<---------------------------------------------------------------------> S<::1/128 Loopback Address [RFC4291] UNSPECIFIED> S<::/128 Unspecified Address [RFC4291] LOOPBACK> S<::FFFF:0:0/96 IPv4-mapped Address [RFC4291] IPV4MAP> S<0100::/64 Discard-Only Prefix [RFC6666] DISCARD> S<2001:0000::/32 TEREDO [RFC4380] TEREDO> S<2001:0002::/48 BMWG [RFC5180] BMWG> S<2001:db8::/32 Documentation Prefix [RFC3849] DOCUMENTATION> S<2001:10::/28 ORCHID [RFC4843] ORCHID> S<2002::/16 6to4 [RFC3056] 6TO4> S S S =head2 ip_iptype Return the type of an IP (Public, Private, Reserved) Params : Binary IP to test, IP version (defaults to 6) Returns : type (see ip_iptypev4 and ip_iptypev6 for details) or undef (invalid) C<$type = ip_iptype ($ip);> =head2 ip_check_prefix Check the validity of a prefix Params : binary IP, length of prefix, IP version Returns : 1 or undef (invalid) Checks if the variant part of a prefix only has 0s, and the length is correct. C =head2 ip_reverse Get a reverse name from a prefix Params : IP, length of prefix, IP version Returns : Reverse name or undef (error) C<$reverse = ip_reverse ($ip);> =head2 ip_normalize Normalize data to a range/prefix of IP addresses Params : Data String (Single IP, Range, Prefix) Returns : ip1, ip2 (if range/prefix) or undef (error) C<($ip1,$ip2) = ip_normalize ($data);> =head2 ip_auth Return IP authority information from the IP::Authority module Params : IP, version Returns : Auth info (RI for RIPE, AR for ARIN, etc) C<$auth = ip_auth ($ip,4);> Note: IPv4 only =head1 BUGS The Math::BigInt library is needed for functions that use integers. These are ip_inttobin, ip_bintoint, and the size method. In a next version, Math::BigInt will become optionnal. =head1 AUTHORS Manuel Valente . Original IPv4 code by Monica Cortes Sack . Original IPv6 code by Lee Wilmot . =head1 BASED ON ipv4pack.pm, iplib.pm, iplibncc.pm. =head1 SEE ALSO perl(1), IP::Authority =cut Net-IP-1.26/ipcount0000755000175000017500000000705410325143630014320 0ustar mvalentemvalente#!perl -w # Copyright (c) 2000 RIPE NCC # # All Rights Reserved # # Permission to use, copy, modify, and distribute this software and its # documentation for any purpose and without fee is hereby granted, # provided that the above copyright notice appear in all copies and that # both that copyright notice and this permission notice appear in # supporting documentation, and that the name of the author not be # used in advertising or publicity pertaining to distribution of the # software without specific, written prior permission. # # THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING # ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS; IN NO EVENT SHALL # AUTHOR BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY # DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN # AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. #------------------------------------------------------------------------------ # Module Header # Filename : ipcount.pl # Purpose : IP addresses calculator # Author : Manuel Valente # Date : 20000329 # Description : # Language Version : Perl 5 # OSs Tested : BSDI 3.1 # Command Line : # Input Files : # Output Files : # External Programs : Net::IP.pm # Problems : # To Do : # Comments : # $Id: ipcount,v 1.3 2002/10/15 09:18:14 manuel Exp $ #------------------------------------------------------------------------------ use strict; use Math::BigInt; use Net::IP qw(:PROC); use Getopt::Std; my %opts; getopts ('rd:',\%opts); scalar (@ARGV) < 1 and usage(); my $arg = join '',@ARGV; $arg =~ s/\s+//g; my $ip = new Net::IP($arg) or die ("Cannot create IP object $arg: ".Error()); my @list = $ip->find_prefixes() or die ($ip->error()); # Cut down the supplied range in smaller prefixes if ($opts{d}) { if (scalar(@list) > 1) { $ip->set ($list[0]) or die (Error()); warn ("\nWarning: The supplied Range does not fit in one single prefix.\n"); warn ("I will use the first prefix only (".$ip->print.")\n\n"); } my $size = new Math::BigInt (2); $size = $size->bpow (ip_iplengths($ip->version) - $opts{d}) - 1; my $current = new Net::IP($ip->ip); my $last = new Net::IP($ip->last_ip); my $new_ip = new Net::IP(0); my $count; while ($current->bincomp ('lt', $last)) { $new_ip->set($current->last_ip.'+'.$size) or die (Error()); print $new_ip->print,"\n"; if ($opts{r}) { print $new_ip->reverse_ip,"\n"; } $current->set($new_ip->last_ip .'+ 1') or die (Error()); $count++; } printf ("\nFound %s /%ss in %s\n\n",$count, $opts{d}, $ip->print); exit; } my ($addr,@pr,$tot); foreach (@list) { $addr = new Net::IP ($_) or die ("Cannot create IP object $_: ".Error()); printf ("%18s %15s - %-15s [%s]\n",$addr->print(),$addr->ip(),$addr->last_ip(), $addr->size()); if ($opts{r}) { print $addr->reverse_ip,"\n"; } $tot += $addr->size(); push (@pr,'/'.$addr->prefixlen()); }; if (scalar(@list) > 1) { print "\n"; printf ("%18s %15s - %-15s [%s]\n",$ip->ip().(join ',',@pr),$ip->ip(),$ip->last_ip(),$tot); }; # Print usage and die sub usage { print " Usage: ipcount [-r] [-d ] address -r: Print Reverse Ranges -d : Cut down the original prefix in several prefixes The address range can be one of: ipcount IP + size ipcount IP1 - IP2 ipcount IP/len "; exit (1); };