This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Unit tests for Socket::getaddrinfo() and Socket::getnameinfo()
[perl5.git] / ext / Socket / t / getaddrinfo.t
1 use strict;
2 use warnings;
3 use Test::More tests => 29;
4
5 use Socket qw(
6    AI_NUMERICHOST AF_INET SOCK_STREAM IPPROTO_TCP
7    unpack_sockaddr_in inet_aton getaddrinfo
8 );
9
10 my ( $err, @res );
11
12 ( $err, @res ) = getaddrinfo( "127.0.0.1", "80", { socktype => SOCK_STREAM } );
13 cmp_ok( $err, "==", 0, '$err == 0 for host=127.0.0.1/service=80/socktype=STREAM' );
14 cmp_ok( $err, "eq", "", '$err eq "" for host=127.0.0.1/service=80/socktype=STREAM' );
15 is( scalar @res, 1,
16    '@res has 1 result' );
17
18 is( $res[0]->{family}, AF_INET,
19    '$res[0] family is AF_INET' );
20 is( $res[0]->{socktype}, SOCK_STREAM,
21    '$res[0] socktype is SOCK_STREAM' );
22 ok( $res[0]->{protocol} == 0 || $res[0]->{protocol} == IPPROTO_TCP,
23    '$res[0] protocol is 0 or IPPROTO_TCP' );
24 is_deeply( [ unpack_sockaddr_in $res[0]->{addr} ],
25            [ 80, inet_aton( "127.0.0.1" ) ],
26            '$res[0] addr is {"127.0.0.1", 80}' );
27
28 # Check actual IV integers work just as well as PV strings
29 ( $err, @res ) = getaddrinfo( "127.0.0.1", 80, { socktype => SOCK_STREAM } );
30 cmp_ok( $err, "==", 0, '$err == 0 for host=127.0.0.1/service=80/socktype=STREAM' );
31 is_deeply( [ unpack_sockaddr_in $res[0]->{addr} ],
32            [ 80, inet_aton( "127.0.0.1" ) ],
33            '$res[0] addr is {"127.0.0.1", 80}' );
34
35 ( $err, @res ) = getaddrinfo( "127.0.0.1", "" );
36 cmp_ok( $err, "==", 0, '$err == 0 for host=127.0.0.1' );
37 # Might get more than one; e.g. different socktypes
38 ok( scalar @res > 0, '@res has results' );
39
40 ( $err, @res ) = getaddrinfo( "127.0.0.1", undef );
41 cmp_ok( $err, "==", 0, '$err == 0 for host=127.0.0.1/service=undef' );
42
43 # Test GETMAGIC
44 {
45    "127.0.0.1" =~ /(.+)/;
46    ( $err, @res ) = getaddrinfo($1, undef);
47    cmp_ok( $err, "==", 0, '$err == 0 for host=$1' );
48    ok( scalar @res > 0, '@res has results' );
49    is( (unpack_sockaddr_in $res[0]->{addr})[1],
50        inet_aton( "127.0.0.1" ),
51        '$res[0] addr is {"127.0.0.1", ??}' );
52 }
53
54 ( $err, @res ) = getaddrinfo( "", "80", { family => AF_INET, socktype => SOCK_STREAM } );
55 cmp_ok( $err, "==", 0, '$err == 0 for service=80/family=AF_INET/socktype=STREAM' );
56 is( scalar @res, 1, '@res has 1 result' );
57
58 # Just pick the first one
59 is( $res[0]->{family}, AF_INET,
60    '$res[0] family is AF_INET' );
61 is( $res[0]->{socktype}, SOCK_STREAM,
62    '$res[0] socktype is SOCK_STREAM' );
63 ok( $res[0]->{protocol} == 0 || $res[0]->{protocol} == IPPROTO_TCP,
64    '$res[0] protocol is 0 or IPPROTO_TCP' );
65
66 # Now some tests of a few well-known internet hosts
67 my $goodhost = "cpan.perl.org";
68
69 SKIP: {
70    skip "Resolver has no answer for $goodhost", 2 unless gethostbyname( $goodhost );
71
72    ( $err, @res ) = getaddrinfo( "cpan.perl.org", "ftp", { socktype => SOCK_STREAM } );
73    cmp_ok( $err, "==", 0, '$err == 0 for host=cpan.perl.org/service=ftp/socktype=STREAM' );
74    # Might get more than one; e.g. different families
75    ok( scalar @res > 0, '@res has results' );
76 }
77
78 # Now something I hope doesn't exist - we put it in a known-missing TLD
79 my $missinghost = "TbK4jM2M0OS.lm57DWIyu4i";
80
81 # Some CPAN testing machines seem to have wildcard DNS servers that reply to
82 # any request. We'd better check for them
83
84 SKIP: {
85    skip "Resolver has an answer for $missinghost", 1 if gethostbyname( $missinghost );
86
87    # Some OSes return $err == 0 but no results
88    ( $err, @res ) = getaddrinfo( $missinghost, "ftp", { socktype => SOCK_STREAM } );
89    ok( $err != 0 || ( $err == 0 && @res == 0 ),
90       '$err != 0 or @res == 0 for host=TbK4jM2M0OS.lm57DWIyu4i/service=ftp/socktype=SOCK_STREAM' );
91    if( @res ) {
92       # Diagnostic that might help
93       while( my $r = shift @res ) {
94          diag( "family=$r->{family} socktype=$r->{socktype} protocol=$r->{protocol} addr=[" . length( $r->{addr} ) . " bytes]" );
95          diag( "  addr=" . join( ", ", map { sprintf '0x%02x', ord $_ } split m//, $r->{addr} ) );
96       }
97    }
98 }
99
100 # Now check that names with AI_NUMERICHOST fail
101
102 ( $err, @res ) = getaddrinfo( "localhost", "ftp", { flags => AI_NUMERICHOST, socktype => SOCK_STREAM } );
103 ok( $err != 0, '$err != 0 for host=localhost/service=ftp/flags=AI_NUMERICHOST/socktype=SOCK_STREAM' );
104
105 # Some sanity checking on the hints hash
106 ok( defined eval { getaddrinfo( "127.0.0.1", "80", undef ); 1 },
107          'getaddrinfo() with undef hints works' );
108 ok( !defined eval { getaddrinfo( "127.0.0.1", "80", "hints" ); 1 },
109          'getaddrinfo() with string hints dies' );
110 ok( !defined eval { getaddrinfo( "127.0.0.1", "80", [] ); 1 },
111          'getaddrinfo() with ARRAY hints dies' );
112
113 # Ensure it doesn't segfault if args are missing
114
115 ( $err, @res ) = getaddrinfo();
116 ok( defined $err, '$err defined for getaddrinfo()' );
117
118 ( $err, @res ) = getaddrinfo( "127.0.0.1" );
119 ok( defined $err, '$err defined for getaddrinfo("127.0.0.1")' );