1898184e3Ssthen#!./perl 2898184e3Ssthen 3*256a93a4Safresh1use v5.6.1; 4898184e3Ssthenuse strict; 5898184e3Ssthenuse warnings; 6898184e3Ssthen 7898184e3Ssthenuse Socket qw( 8898184e3Ssthen AF_INET 9898184e3Ssthen inet_ntoa inet_aton inet_ntop inet_pton 10898184e3Ssthen pack_sockaddr_in unpack_sockaddr_in sockaddr_in 115759b3d2Safresh1 pack_sockaddr_un unpack_sockaddr_un 12898184e3Ssthen sockaddr_family 13898184e3Ssthen sockaddr_un 14898184e3Ssthen); 15*256a93a4Safresh1use Test::More tests => 50; 16898184e3Ssthen 17898184e3Ssthen# inet_aton, inet_ntoa 18898184e3Ssthen{ 19898184e3Ssthen is(join(".", unpack("C*",inet_aton("10.20.30.40"))), "10.20.30.40", 'inet_aton returns packed bytes'); 20898184e3Ssthen 21898184e3Ssthen is(inet_ntoa(v10.20.30.40), "10.20.30.40", 'inet_ntoa from v-string'); 22898184e3Ssthen 23898184e3Ssthen is(inet_ntoa(inet_aton("10.20.30.40")), "10.20.30.40", 'inet_aton->inet_ntoa roundtrip'); 24898184e3Ssthen 25898184e3Ssthen local $@; 26898184e3Ssthen eval { inet_ntoa(v10.20.30.400) }; 27898184e3Ssthen like($@, qr/^Wide character in Socket::inet_ntoa at/, 'inet_ntoa warns about wide characters'); 28898184e3Ssthen} 29898184e3Ssthen 30898184e3Ssthen# inet_ntop, inet_pton 31898184e3SsthenSKIP: { 32898184e3Ssthen skip "No inet_ntop", 5 unless defined eval { inet_pton(AF_INET, "10.20.30.40") }; 33898184e3Ssthen 34898184e3Ssthen is(join(".", unpack("C*",inet_pton(AF_INET, "10.20.30.40"))), "10.20.30.40", 'inet_pton AF_INET returns packed bytes'); 35898184e3Ssthen 36898184e3Ssthen is(inet_ntop(AF_INET, v10.20.30.40), "10.20.30.40", 'inet_ntop AF_INET from v-string'); 37898184e3Ssthen 38898184e3Ssthen is(inet_ntop(AF_INET, inet_pton(AF_INET, "10.20.30.40")), "10.20.30.40", 'inet_pton->inet_ntop AF_INET roundtrip'); 39898184e3Ssthen is(inet_ntop(AF_INET, inet_aton("10.20.30.40")), "10.20.30.40", 'inet_aton->inet_ntop AF_INET roundtrip'); 40898184e3Ssthen 41898184e3Ssthen local $@; 42898184e3Ssthen eval { inet_ntop(AF_INET, v10.20.30.400) }; 43898184e3Ssthen like($@, qr/^Wide character in Socket::inet_ntop at/, 'inet_ntop warns about wide characters'); 44898184e3Ssthen} 45898184e3Ssthen 46898184e3SsthenSKIP: { 47898184e3Ssthen skip "No AF_INET6", 3 unless my $AF_INET6 = eval { Socket::AF_INET6() }; 48898184e3Ssthen skip "No inet_ntop", 3 unless defined eval { inet_pton($AF_INET6, "2460::1") }; 49898184e3Ssthen 50898184e3Ssthen is(uc unpack("H*",inet_pton($AF_INET6, "2001:503:BA3E::2:30")), "20010503BA3E00000000000000020030", 51898184e3Ssthen 'inet_pton AF_INET6 returns packed bytes'); 52898184e3Ssthen 53898184e3Ssthen is(uc inet_ntop($AF_INET6, "\x20\x01\x05\x03\xBA\x3E\x00\x00\x00\x00\x00\x00\x00\x02\x00\x30"), "2001:503:BA3E::2:30", 54898184e3Ssthen 'inet_ntop AF_INET6 from octet string'); 55898184e3Ssthen 56898184e3Ssthen is(lc inet_ntop($AF_INET6, inet_pton($AF_INET6, "2001:503:BA3E::2:30")), "2001:503:ba3e::2:30", 57898184e3Ssthen 'inet_pton->inet_ntop AF_INET6 roundtrip'); 58898184e3Ssthen} 59898184e3Ssthen 60898184e3Ssthen# sockaddr_family 61898184e3Ssthen{ 62898184e3Ssthen local $@; 63898184e3Ssthen eval { sockaddr_family("") }; 64898184e3Ssthen like($@, qr/^Bad arg length for Socket::sockaddr_family, length is 0, should be at least \d+/, 'sockaddr_family warns about argument length'); 65898184e3Ssthen} 66898184e3Ssthen 67898184e3Ssthen# pack_sockaddr_in, unpack_sockaddr_in 68898184e3Ssthen# sockaddr_in 69898184e3Ssthen{ 70898184e3Ssthen my $sin = pack_sockaddr_in 100, inet_aton("10.20.30.40"); 71898184e3Ssthen ok(defined $sin, 'pack_sockaddr_in defined'); 72898184e3Ssthen 73898184e3Ssthen is(sockaddr_family($sin), AF_INET, 'sockaddr_family of pack_sockaddr_in' ); 74898184e3Ssthen 75898184e3Ssthen is( (unpack_sockaddr_in($sin))[0] , 100, 'pack_sockaddr_in->unpack_sockaddr_in port'); 76898184e3Ssthen is(inet_ntoa((unpack_sockaddr_in($sin))[1]), "10.20.30.40", 'pack_sockaddr_in->unpack_sockaddr_in addr'); 77898184e3Ssthen 7891f110e0Safresh1 is(inet_ntoa(scalar unpack_sockaddr_in($sin)), "10.20.30.40", 'unpack_sockaddr_in in scalar context yields addr'); 7991f110e0Safresh1 80898184e3Ssthen is_deeply( [ sockaddr_in($sin) ], [ unpack_sockaddr_in($sin) ], 81898184e3Ssthen 'sockaddr_in in list context unpacks' ); 82898184e3Ssthen 83898184e3Ssthen is(sockaddr_family(scalar sockaddr_in(200,v10.30.50.70)), AF_INET, 84898184e3Ssthen 'sockaddr_in in scalar context packs'); 855759b3d2Safresh1 86*256a93a4Safresh1 my $warnings = ""; 87*256a93a4Safresh1 local $SIG{__WARN__} = sub { $warnings .= $_[0]; }; 885759b3d2Safresh1 ok( !eval { pack_sockaddr_in 0, undef; 1 }, 895759b3d2Safresh1 'pack_sockaddr_in undef addr is fatal' ); 905759b3d2Safresh1 ok( !eval { unpack_sockaddr_in undef; 1 }, 915759b3d2Safresh1 'unpack_sockaddr_in undef is fatal' ); 925759b3d2Safresh1 935759b3d2Safresh1 ok( eval { pack_sockaddr_in undef, "\0\0\0\0"; 1 }, 945759b3d2Safresh1 'pack_sockaddr_in undef port is allowed' ); 955759b3d2Safresh1 96*256a93a4Safresh1 is( $warnings, "", 'undefined values produced no warnings' ); 97*256a93a4Safresh1 98*256a93a4Safresh1 ok( eval { pack_sockaddr_in 98765, "\0\0\0\0"; 1 }, 99*256a93a4Safresh1 'pack_sockaddr_in oversized port is allowed' ); 100*256a93a4Safresh1 like( $warnings, qr/^Port number above 0xFFFF, will be truncated to 33229 for Socket::pack_sockaddr_in at /, 101*256a93a4Safresh1 'pack_sockaddr_in oversized port warning' ); 102898184e3Ssthen} 103898184e3Ssthen 104898184e3Ssthen# pack_sockaddr_in6, unpack_sockaddr_in6 105898184e3Ssthen# sockaddr_in6 106898184e3SsthenSKIP: { 107*256a93a4Safresh1 skip "No AF_INET6", 15 unless my $AF_INET6 = eval { Socket::AF_INET6() }; 108*256a93a4Safresh1 skip "Cannot pack_sockaddr_in6()", 15 unless my $sin6 = eval { Socket::pack_sockaddr_in6(0x1234, "0123456789abcdef", 0, 89) }; 109898184e3Ssthen 110898184e3Ssthen ok(defined $sin6, 'pack_sockaddr_in6 defined'); 111898184e3Ssthen 112898184e3Ssthen is(sockaddr_family($sin6), $AF_INET6, 'sockaddr_family of pack_sockaddr_in6'); 113898184e3Ssthen 114898184e3Ssthen is((Socket::unpack_sockaddr_in6($sin6))[0], 0x1234, 'pack_sockaddr_in6->unpack_sockaddr_in6 port'); 115898184e3Ssthen is((Socket::unpack_sockaddr_in6($sin6))[1], "0123456789abcdef", 'pack_sockaddr_in6->unpack_sockaddr_in6 addr'); 116898184e3Ssthen is((Socket::unpack_sockaddr_in6($sin6))[2], 0, 'pack_sockaddr_in6->unpack_sockaddr_in6 scope_id'); 117898184e3Ssthen is((Socket::unpack_sockaddr_in6($sin6))[3], 89, 'pack_sockaddr_in6->unpack_sockaddr_in6 flowinfo'); 118898184e3Ssthen 11991f110e0Safresh1 is(scalar Socket::unpack_sockaddr_in6($sin6), "0123456789abcdef", 'unpack_sockaddr_in6 in scalar context yields addr'); 12091f110e0Safresh1 121898184e3Ssthen is_deeply( [ Socket::sockaddr_in6($sin6) ], [ Socket::unpack_sockaddr_in6($sin6) ], 122898184e3Ssthen 'sockaddr_in6 in list context unpacks' ); 123898184e3Ssthen 124898184e3Ssthen is(sockaddr_family(scalar Socket::sockaddr_in6(0x1357, "02468ace13579bdf")), $AF_INET6, 125898184e3Ssthen 'sockaddr_in6 in scalar context packs' ); 1265759b3d2Safresh1 127*256a93a4Safresh1 my $warnings = ""; 128*256a93a4Safresh1 local $SIG{__WARN__} = sub { $warnings .= $_[0]; }; 1295759b3d2Safresh1 ok( !eval { Socket::pack_sockaddr_in6( 0, undef ); 1 }, 1305759b3d2Safresh1 'pack_sockaddr_in6 undef addr is fatal' ); 1315759b3d2Safresh1 ok( !eval { Socket::unpack_sockaddr_in6( undef ); 1 }, 1325759b3d2Safresh1 'unpack_sockaddr_in6 undef is fatal' ); 1335759b3d2Safresh1 1345759b3d2Safresh1 ok( eval { Socket::pack_sockaddr_in6( undef, "\0"x16 ); 1 }, 1355759b3d2Safresh1 'pack_sockaddr_in6 undef port is allowed' ); 1365759b3d2Safresh1 137*256a93a4Safresh1 is( $warnings, "", 'undefined values produced no warnings' ); 138*256a93a4Safresh1 139*256a93a4Safresh1 ok( eval { Socket::pack_sockaddr_in6( 98765, "\0"x16 ); 1 }, 140*256a93a4Safresh1 'pack_sockaddr_in6 oversized port is allowed' ); 141*256a93a4Safresh1 like( $warnings, qr/^Port number above 0xFFFF, will be truncated to 33229 for Socket::pack_sockaddr_in6 at /, 142*256a93a4Safresh1 'pack_sockaddr_in6 oversized port warning' ); 143898184e3Ssthen} 144898184e3Ssthen 1455759b3d2Safresh1# sockaddr_un on abstract paths 146898184e3SsthenSKIP: { 147898184e3Ssthen # see if we can handle abstract sockets 1485759b3d2Safresh1 skip "Abstract AF_UNIX paths unsupported", 7 unless $^O eq "linux"; 149898184e3Ssthen 150898184e3Ssthen my $test_abstract_socket = chr(0) . '/org/perl/hello'. chr(0) . 'world'; 151898184e3Ssthen my $addr = sockaddr_un ($test_abstract_socket); 152898184e3Ssthen my ($path) = sockaddr_un ($addr); 153898184e3Ssthen is($path, $test_abstract_socket, 'sockaddr_un can handle abstract AF_UNIX paths'); 154898184e3Ssthen 155898184e3Ssthen # see if we calculate the address structure length correctly 156898184e3Ssthen is(length ($test_abstract_socket) + 2, length $addr, 'sockaddr_un abstract address length'); 1575759b3d2Safresh1 1585759b3d2Safresh1 my $warnings = 0; 1595759b3d2Safresh1 local $SIG{__WARN__} = sub { $warnings++ }; 1605759b3d2Safresh1 ok( !eval { pack_sockaddr_un( undef ); 1 }, 1615759b3d2Safresh1 'pack_sockaddr_un undef path is fatal' ); 1625759b3d2Safresh1 ok( !eval { unpack_sockaddr_un( undef ); 1 }, 1635759b3d2Safresh1 'unpack_sockaddr_un undef is fatal' ); 1645759b3d2Safresh1 1655759b3d2Safresh1 is( $warnings, 0, 'undefined values produced no warnings' ); 1665759b3d2Safresh1 1675759b3d2Safresh1 ok( eval { pack_sockaddr_un( "x" x 0x10000 ); 1 }, 1685759b3d2Safresh1 'pack_sockaddr_un(very long path) succeeds' ) or diag( "Died: $@" ); 1695759b3d2Safresh1 is( $warnings, 1, 'pack_sockaddr_in(very long path) warns' ); 170898184e3Ssthen} 171898184e3Ssthen 172898184e3Ssthen# warnings 173898184e3Ssthen{ 174898184e3Ssthen my $w = 0; 175898184e3Ssthen local $SIG{__WARN__} = sub { 176898184e3Ssthen ++ $w if $_[0] =~ /^6-ARG sockaddr_in call is deprecated/ ; 177898184e3Ssthen }; 178898184e3Ssthen 179898184e3Ssthen no warnings 'Socket'; 180898184e3Ssthen sockaddr_in(1,2,3,4,5,6) ; 181898184e3Ssthen is($w, 0, "sockaddr_in deprecated form doesn't warn without lexical warnings"); 182898184e3Ssthen 183898184e3Ssthen use warnings 'Socket'; 184898184e3Ssthen sockaddr_in(1,2,3,4,5,6) ; 185898184e3Ssthen is($w, 1, "sockaddr_in deprecated form warns with lexical warnings"); 186898184e3Ssthen} 187