sockaddr.t revision 1.1.1.2
1#!./perl 2 3use strict; 4use warnings; 5 6use Socket qw( 7 AF_INET 8 inet_ntoa inet_aton inet_ntop inet_pton 9 pack_sockaddr_in unpack_sockaddr_in sockaddr_in 10 sockaddr_family 11 sockaddr_un 12); 13use Test::More tests => 33; 14 15# inet_aton, inet_ntoa 16{ 17 is(join(".", unpack("C*",inet_aton("10.20.30.40"))), "10.20.30.40", 'inet_aton returns packed bytes'); 18 19 is(inet_ntoa(v10.20.30.40), "10.20.30.40", 'inet_ntoa from v-string'); 20 21 is(inet_ntoa(inet_aton("10.20.30.40")), "10.20.30.40", 'inet_aton->inet_ntoa roundtrip'); 22 23 local $@; 24 eval { inet_ntoa(v10.20.30.400) }; 25 like($@, qr/^Wide character in Socket::inet_ntoa at/, 'inet_ntoa warns about wide characters'); 26} 27 28# inet_ntop, inet_pton 29SKIP: { 30 skip "No inet_ntop", 5 unless defined eval { inet_pton(AF_INET, "10.20.30.40") }; 31 32 is(join(".", unpack("C*",inet_pton(AF_INET, "10.20.30.40"))), "10.20.30.40", 'inet_pton AF_INET returns packed bytes'); 33 34 is(inet_ntop(AF_INET, v10.20.30.40), "10.20.30.40", 'inet_ntop AF_INET from v-string'); 35 36 is(inet_ntop(AF_INET, inet_pton(AF_INET, "10.20.30.40")), "10.20.30.40", 'inet_pton->inet_ntop AF_INET roundtrip'); 37 is(inet_ntop(AF_INET, inet_aton("10.20.30.40")), "10.20.30.40", 'inet_aton->inet_ntop AF_INET roundtrip'); 38 39 local $@; 40 eval { inet_ntop(AF_INET, v10.20.30.400) }; 41 like($@, qr/^Wide character in Socket::inet_ntop at/, 'inet_ntop warns about wide characters'); 42} 43 44SKIP: { 45 skip "No AF_INET6", 3 unless my $AF_INET6 = eval { Socket::AF_INET6() }; 46 skip "No inet_ntop", 3 unless defined eval { inet_pton($AF_INET6, "2460::1") }; 47 48 is(uc unpack("H*",inet_pton($AF_INET6, "2001:503:BA3E::2:30")), "20010503BA3E00000000000000020030", 49 'inet_pton AF_INET6 returns packed bytes'); 50 51 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", 52 'inet_ntop AF_INET6 from octet string'); 53 54 is(lc inet_ntop($AF_INET6, inet_pton($AF_INET6, "2001:503:BA3E::2:30")), "2001:503:ba3e::2:30", 55 'inet_pton->inet_ntop AF_INET6 roundtrip'); 56} 57 58# sockaddr_family 59{ 60 local $@; 61 eval { sockaddr_family("") }; 62 like($@, qr/^Bad arg length for Socket::sockaddr_family, length is 0, should be at least \d+/, 'sockaddr_family warns about argument length'); 63} 64 65# pack_sockaddr_in, unpack_sockaddr_in 66# sockaddr_in 67{ 68 my $sin = pack_sockaddr_in 100, inet_aton("10.20.30.40"); 69 ok(defined $sin, 'pack_sockaddr_in defined'); 70 71 is(sockaddr_family($sin), AF_INET, 'sockaddr_family of pack_sockaddr_in' ); 72 73 is( (unpack_sockaddr_in($sin))[0] , 100, 'pack_sockaddr_in->unpack_sockaddr_in port'); 74 is(inet_ntoa((unpack_sockaddr_in($sin))[1]), "10.20.30.40", 'pack_sockaddr_in->unpack_sockaddr_in addr'); 75 76 is(inet_ntoa(scalar unpack_sockaddr_in($sin)), "10.20.30.40", 'unpack_sockaddr_in in scalar context yields addr'); 77 78 is_deeply( [ sockaddr_in($sin) ], [ unpack_sockaddr_in($sin) ], 79 'sockaddr_in in list context unpacks' ); 80 81 is(sockaddr_family(scalar sockaddr_in(200,v10.30.50.70)), AF_INET, 82 'sockaddr_in in scalar context packs'); 83} 84 85# pack_sockaddr_in6, unpack_sockaddr_in6 86# sockaddr_in6 87SKIP: { 88 skip "No AF_INET6", 9 unless my $AF_INET6 = eval { Socket::AF_INET6() }; 89 skip "Cannot pack_sockaddr_in6()", 9 unless my $sin6 = eval { Socket::pack_sockaddr_in6(0x1234, "0123456789abcdef", 0, 89) }; 90 91 ok(defined $sin6, 'pack_sockaddr_in6 defined'); 92 93 is(sockaddr_family($sin6), $AF_INET6, 'sockaddr_family of pack_sockaddr_in6'); 94 95 is((Socket::unpack_sockaddr_in6($sin6))[0], 0x1234, 'pack_sockaddr_in6->unpack_sockaddr_in6 port'); 96 is((Socket::unpack_sockaddr_in6($sin6))[1], "0123456789abcdef", 'pack_sockaddr_in6->unpack_sockaddr_in6 addr'); 97 is((Socket::unpack_sockaddr_in6($sin6))[2], 0, 'pack_sockaddr_in6->unpack_sockaddr_in6 scope_id'); 98 is((Socket::unpack_sockaddr_in6($sin6))[3], 89, 'pack_sockaddr_in6->unpack_sockaddr_in6 flowinfo'); 99 100 is(scalar Socket::unpack_sockaddr_in6($sin6), "0123456789abcdef", 'unpack_sockaddr_in6 in scalar context yields addr'); 101 102 is_deeply( [ Socket::sockaddr_in6($sin6) ], [ Socket::unpack_sockaddr_in6($sin6) ], 103 'sockaddr_in6 in list context unpacks' ); 104 105 is(sockaddr_family(scalar Socket::sockaddr_in6(0x1357, "02468ace13579bdf")), $AF_INET6, 106 'sockaddr_in6 in scalar context packs' ); 107} 108 109# sockaddr_un 110SKIP: { 111 # see if we can handle abstract sockets 112 skip "Abstract AF_UNIX paths unsupported", 2 unless $^O eq "linux"; 113 114 my $test_abstract_socket = chr(0) . '/org/perl/hello'. chr(0) . 'world'; 115 my $addr = sockaddr_un ($test_abstract_socket); 116 my ($path) = sockaddr_un ($addr); 117 is($path, $test_abstract_socket, 'sockaddr_un can handle abstract AF_UNIX paths'); 118 119 # see if we calculate the address structure length correctly 120 is(length ($test_abstract_socket) + 2, length $addr, 'sockaddr_un abstract address length'); 121} 122 123# warnings 124{ 125 my $w = 0; 126 local $SIG{__WARN__} = sub { 127 ++ $w if $_[0] =~ /^6-ARG sockaddr_in call is deprecated/ ; 128 }; 129 130 no warnings 'Socket'; 131 sockaddr_in(1,2,3,4,5,6) ; 132 is($w, 0, "sockaddr_in deprecated form doesn't warn without lexical warnings"); 133 134 use warnings 'Socket'; 135 sockaddr_in(1,2,3,4,5,6) ; 136 is($w, 1, "sockaddr_in deprecated form warns with lexical warnings"); 137} 138