WWWWWW

Current Directory: /home/.cpanm/work/1729881450.851206/Net-IP-1.26/t
Viewing File: /home/.cpanm/work/1729881450.851206/Net-IP-1.26/t/ipv6.t
use 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;
F1l3 Manager
