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