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