1use strict; 2use warnings; 3use Test::More tests => 30; 4 5use Socket qw(:addrinfo AF_INET SOCK_STREAM IPPROTO_TCP unpack_sockaddr_in inet_aton); 6 7my ( $err, @res ); 8 9( $err, @res ) = getaddrinfo( "127.0.0.1", "80", { socktype => SOCK_STREAM } ); 10cmp_ok( $err, "==", 0, '$err == 0 for host=127.0.0.1/service=80/socktype=STREAM' ); 11cmp_ok( $err, "eq", "", '$err eq "" for host=127.0.0.1/service=80/socktype=STREAM' ); 12is( scalar @res, 1, 13 '@res has 1 result' ); 14 15is( $res[0]->{family}, AF_INET, 16 '$res[0] family is AF_INET' ); 17is( $res[0]->{socktype}, SOCK_STREAM, 18 '$res[0] socktype is SOCK_STREAM' ); 19ok( $res[0]->{protocol} == 0 || $res[0]->{protocol} == IPPROTO_TCP, 20 '$res[0] protocol is 0 or IPPROTO_TCP' ); 21ok( defined $res[0]->{addr}, 22 '$res[0] addr is defined' ); 23if (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 } ); 33cmp_ok( $err, "==", 0, '$err == 0 for host=127.0.0.1/service=80/socktype=STREAM' ); 34is_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", "" ); 39cmp_ok( $err, "==", 0, '$err == 0 for host=127.0.0.1' ); 40# Might get more than one; e.g. different socktypes 41ok( scalar @res > 0, '@res has results' ); 42 43( $err, @res ) = getaddrinfo( "127.0.0.1", undef ); 44cmp_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, protocol => IPPROTO_TCP } ); 58cmp_ok( $err, "==", 0, '$err == 0 for service=80/family=AF_INET/socktype=STREAM/protocol=IPPROTO_TCP' ); 59is( scalar @res, 1, '@res has 1 result' ); 60 61# Just pick the first one 62is( $res[0]->{family}, AF_INET, 63 '$res[0] family is AF_INET' ); 64is( $res[0]->{socktype}, SOCK_STREAM, 65 '$res[0] socktype is SOCK_STREAM' ); 66ok( $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 70my $goodhost = "cpan.perl.org"; 71 72SKIP: { 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 82my $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 87SKIP: { 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 105SKIP: { 106 skip "Resolver has no answer for $goodhost", 1 unless gethostbyname( $goodhost ); 107 108 ( $err, @res ) = getaddrinfo( $goodhost, "ftp", { flags => AI_NUMERICHOST, socktype => SOCK_STREAM } ); 109 ok( $err != 0, "\$err != 0 for host=$goodhost/service=ftp/flags=AI_NUMERICHOST/socktype=SOCK_STREAM" ); 110} 111 112# Some sanity checking on the hints hash 113ok( defined eval { getaddrinfo( "127.0.0.1", "80", undef ); 1 }, 114 'getaddrinfo() with undef hints works' ); 115ok( !defined eval { getaddrinfo( "127.0.0.1", "80", "hints" ); 1 }, 116 'getaddrinfo() with string hints dies' ); 117ok( !defined eval { getaddrinfo( "127.0.0.1", "80", [] ); 1 }, 118 'getaddrinfo() with ARRAY hints dies' ); 119 120# Ensure it doesn't segfault if args are missing 121 122( $err, @res ) = getaddrinfo(); 123ok( defined $err, '$err defined for getaddrinfo()' ); 124 125( $err, @res ) = getaddrinfo( "127.0.0.1" ); 126ok( defined $err, '$err defined for getaddrinfo("127.0.0.1")' ); 127