1*eac174f2Safresh1use v5.6.1; 2898184e3Ssthenuse strict; 3898184e3Ssthenuse warnings; 4b8851fccSafresh1use Test::More tests => 31; 5898184e3Ssthen 6898184e3Ssthenuse Socket qw(:addrinfo AF_INET SOCK_STREAM IPPROTO_TCP unpack_sockaddr_in inet_aton); 7898184e3Ssthen 8898184e3Ssthenmy ( $err, @res ); 9898184e3Ssthen 10898184e3Ssthen( $err, @res ) = getaddrinfo( "127.0.0.1", "80", { socktype => SOCK_STREAM } ); 11898184e3Ssthencmp_ok( $err, "==", 0, '$err == 0 for host=127.0.0.1/service=80/socktype=STREAM' ); 12898184e3Ssthencmp_ok( $err, "eq", "", '$err eq "" for host=127.0.0.1/service=80/socktype=STREAM' ); 13898184e3Ssthenis( scalar @res, 1, 14898184e3Ssthen '@res has 1 result' ); 15898184e3Ssthen 16898184e3Ssthenis( $res[0]->{family}, AF_INET, 17898184e3Ssthen '$res[0] family is AF_INET' ); 18898184e3Ssthenis( $res[0]->{socktype}, SOCK_STREAM, 19898184e3Ssthen '$res[0] socktype is SOCK_STREAM' ); 20898184e3Ssthenok( $res[0]->{protocol} == 0 || $res[0]->{protocol} == IPPROTO_TCP, 21898184e3Ssthen '$res[0] protocol is 0 or IPPROTO_TCP' ); 22898184e3Ssthenok( defined $res[0]->{addr}, 23898184e3Ssthen '$res[0] addr is defined' ); 24898184e3Ssthenif (length $res[0]->{addr}) { 25898184e3Ssthen is_deeply( [ unpack_sockaddr_in $res[0]->{addr} ], 26898184e3Ssthen [ 80, inet_aton( "127.0.0.1" ) ], 27898184e3Ssthen '$res[0] addr is {"127.0.0.1", 80}' ); 28898184e3Ssthen} else { 29898184e3Ssthen fail( '$res[0] addr is empty: check $socksizetype' ); 30898184e3Ssthen} 31898184e3Ssthen 32898184e3Ssthen# Check actual IV integers work just as well as PV strings 33898184e3Ssthen( $err, @res ) = getaddrinfo( "127.0.0.1", 80, { socktype => SOCK_STREAM } ); 34898184e3Ssthencmp_ok( $err, "==", 0, '$err == 0 for host=127.0.0.1/service=80/socktype=STREAM' ); 35898184e3Ssthenis_deeply( [ unpack_sockaddr_in $res[0]->{addr} ], 36898184e3Ssthen [ 80, inet_aton( "127.0.0.1" ) ], 37898184e3Ssthen '$res[0] addr is {"127.0.0.1", 80}' ); 38898184e3Ssthen 39898184e3Ssthen( $err, @res ) = getaddrinfo( "127.0.0.1", "" ); 40898184e3Ssthencmp_ok( $err, "==", 0, '$err == 0 for host=127.0.0.1' ); 41898184e3Ssthen# Might get more than one; e.g. different socktypes 42898184e3Ssthenok( scalar @res > 0, '@res has results' ); 43898184e3Ssthen 44898184e3Ssthen( $err, @res ) = getaddrinfo( "127.0.0.1", undef ); 45898184e3Ssthencmp_ok( $err, "==", 0, '$err == 0 for host=127.0.0.1/service=undef' ); 46898184e3Ssthen 47898184e3Ssthen# Test GETMAGIC 48898184e3Ssthen{ 49898184e3Ssthen "127.0.0.1" =~ /(.+)/; 50898184e3Ssthen ( $err, @res ) = getaddrinfo($1, undef); 51898184e3Ssthen cmp_ok( $err, "==", 0, '$err == 0 for host=$1' ); 52898184e3Ssthen ok( scalar @res > 0, '@res has results' ); 53898184e3Ssthen is( (unpack_sockaddr_in $res[0]->{addr})[1], 54898184e3Ssthen inet_aton( "127.0.0.1" ), 55898184e3Ssthen '$res[0] addr is {"127.0.0.1", ??}' ); 56898184e3Ssthen} 57898184e3Ssthen 586fb12b70Safresh1( $err, @res ) = getaddrinfo( "", "80", { family => AF_INET, socktype => SOCK_STREAM, protocol => IPPROTO_TCP } ); 596fb12b70Safresh1cmp_ok( $err, "==", 0, '$err == 0 for service=80/family=AF_INET/socktype=STREAM/protocol=IPPROTO_TCP' ); 60898184e3Ssthenis( scalar @res, 1, '@res has 1 result' ); 61898184e3Ssthen 62898184e3Ssthen# Just pick the first one 63898184e3Ssthenis( $res[0]->{family}, AF_INET, 64898184e3Ssthen '$res[0] family is AF_INET' ); 65898184e3Ssthenis( $res[0]->{socktype}, SOCK_STREAM, 66898184e3Ssthen '$res[0] socktype is SOCK_STREAM' ); 67898184e3Ssthenok( $res[0]->{protocol} == 0 || $res[0]->{protocol} == IPPROTO_TCP, 68898184e3Ssthen '$res[0] protocol is 0 or IPPROTO_TCP' ); 69898184e3Ssthen 70898184e3Ssthen# Now some tests of a few well-known internet hosts 71898184e3Ssthenmy $goodhost = "cpan.perl.org"; 72898184e3Ssthen 73898184e3SsthenSKIP: { 74898184e3Ssthen skip "Resolver has no answer for $goodhost", 2 unless gethostbyname( $goodhost ); 75898184e3Ssthen 76898184e3Ssthen ( $err, @res ) = getaddrinfo( "cpan.perl.org", "ftp", { socktype => SOCK_STREAM } ); 77898184e3Ssthen cmp_ok( $err, "==", 0, '$err == 0 for host=cpan.perl.org/service=ftp/socktype=STREAM' ); 78898184e3Ssthen # Might get more than one; e.g. different families 79898184e3Ssthen ok( scalar @res > 0, '@res has results' ); 80898184e3Ssthen} 81898184e3Ssthen 82898184e3Ssthen# Now something I hope doesn't exist - we put it in a known-missing TLD 83898184e3Ssthenmy $missinghost = "TbK4jM2M0OS.lm57DWIyu4i"; 84898184e3Ssthen 85898184e3Ssthen# Some CPAN testing machines seem to have wildcard DNS servers that reply to 86898184e3Ssthen# any request. We'd better check for them 87898184e3Ssthen 88898184e3SsthenSKIP: { 89898184e3Ssthen skip "Resolver has an answer for $missinghost", 1 if gethostbyname( $missinghost ); 90898184e3Ssthen 91898184e3Ssthen # Some OSes return $err == 0 but no results 92898184e3Ssthen ( $err, @res ) = getaddrinfo( $missinghost, "ftp", { socktype => SOCK_STREAM } ); 93898184e3Ssthen ok( $err != 0 || ( $err == 0 && @res == 0 ), 94898184e3Ssthen '$err != 0 or @res == 0 for host=TbK4jM2M0OS.lm57DWIyu4i/service=ftp/socktype=SOCK_STREAM' ); 95898184e3Ssthen if( @res ) { 96898184e3Ssthen # Diagnostic that might help 97898184e3Ssthen while( my $r = shift @res ) { 98898184e3Ssthen diag( "family=$r->{family} socktype=$r->{socktype} protocol=$r->{protocol} addr=[" . length( $r->{addr} ) . " bytes]" ); 99898184e3Ssthen diag( " addr=" . join( ", ", map { sprintf '0x%02x', ord $_ } split m//, $r->{addr} ) ); 100898184e3Ssthen } 101898184e3Ssthen } 102898184e3Ssthen} 103898184e3Ssthen 104b8851fccSafresh1# Numeric addresses with AI_NUMERICHOST should pass (RT95758) 105b8851fccSafresh1AI_NUMERICHOST: { 106b8851fccSafresh1 # Here we need a port that is open to the world. Not all places have all 107b8851fccSafresh1 # the ports. For example Solaris by default doesn't have http/80 in 108b8851fccSafresh1 # /etc/services, and that would fail. Let's try a couple of commonly open 109b8851fccSafresh1 # ports, and hope one of them will succeed. Conversely this means that 110b8851fccSafresh1 # sometimes this will fail. 111b8851fccSafresh1 # 112b8851fccSafresh1 # An alternative method would be to manually parse /etc/services and look 113b8851fccSafresh1 # for enabled services but that's kind of yuck, too. 114b8851fccSafresh1 my @port = (80, 7, 22, 25, 88, 123, 110, 389, 443, 445, 873, 2049, 3306); 115b8851fccSafresh1 foreach my $port ( @port ) { 116b8851fccSafresh1 ( $err, @res ) = getaddrinfo( "127.0.0.1", $port, { flags => AI_NUMERICHOST, socktype => SOCK_STREAM } ); 117b8851fccSafresh1 if( $err == 0 ) { 118b8851fccSafresh1 ok( $err == 0, "\$err == 0 for 127.0.0.1/$port/flags=AI_NUMERICHOST" ); 119b8851fccSafresh1 last AI_NUMERICHOST; 120b8851fccSafresh1 } 121b8851fccSafresh1 } 122b8851fccSafresh1 fail( "$err for 127.0.0.1/$port[-1]/flags=AI_NUMERICHOST (failed for ports @port)" ); 123b8851fccSafresh1} 124b8851fccSafresh1 125898184e3Ssthen# Now check that names with AI_NUMERICHOST fail 126898184e3Ssthen 1276fb12b70Safresh1SKIP: { 1286fb12b70Safresh1 skip "Resolver has no answer for $goodhost", 1 unless gethostbyname( $goodhost ); 1296fb12b70Safresh1 1306fb12b70Safresh1 ( $err, @res ) = getaddrinfo( $goodhost, "ftp", { flags => AI_NUMERICHOST, socktype => SOCK_STREAM } ); 1316fb12b70Safresh1 ok( $err != 0, "\$err != 0 for host=$goodhost/service=ftp/flags=AI_NUMERICHOST/socktype=SOCK_STREAM" ); 1326fb12b70Safresh1} 133898184e3Ssthen 134898184e3Ssthen# Some sanity checking on the hints hash 135898184e3Ssthenok( defined eval { getaddrinfo( "127.0.0.1", "80", undef ); 1 }, 136898184e3Ssthen 'getaddrinfo() with undef hints works' ); 137898184e3Ssthenok( !defined eval { getaddrinfo( "127.0.0.1", "80", "hints" ); 1 }, 138898184e3Ssthen 'getaddrinfo() with string hints dies' ); 139898184e3Ssthenok( !defined eval { getaddrinfo( "127.0.0.1", "80", [] ); 1 }, 140898184e3Ssthen 'getaddrinfo() with ARRAY hints dies' ); 141898184e3Ssthen 142898184e3Ssthen# Ensure it doesn't segfault if args are missing 143898184e3Ssthen 144898184e3Ssthen( $err, @res ) = getaddrinfo(); 145898184e3Ssthenok( defined $err, '$err defined for getaddrinfo()' ); 146898184e3Ssthen 147898184e3Ssthen( $err, @res ) = getaddrinfo( "127.0.0.1" ); 148898184e3Ssthenok( defined $err, '$err defined for getaddrinfo("127.0.0.1")' ); 149