Unit tests for Socket::getaddrinfo() and Socket::getnameinfo()
authorPaul "LeoNerd" Evans <leonerd@leonerd.org.uk>
Mon, 13 Dec 2010 17:50:56 +0000 (17:50 +0000)
committerJesse Vincent <jesse@bestpractical.com>
Mon, 3 Jan 2011 04:21:35 +0000 (12:21 +0800)
ext/Socket/t/getaddrinfo.t [new file with mode: 0644]
ext/Socket/t/getnameinfo.t [new file with mode: 0644]

diff --git a/ext/Socket/t/getaddrinfo.t b/ext/Socket/t/getaddrinfo.t
new file mode 100644 (file)
index 0000000..5c8d153
--- /dev/null
@@ -0,0 +1,119 @@
+use strict;
+use warnings;
+use Test::More tests => 29;
+
+use Socket qw(
+   AI_NUMERICHOST AF_INET SOCK_STREAM IPPROTO_TCP
+   unpack_sockaddr_in inet_aton getaddrinfo
+);
+
+my ( $err, @res );
+
+( $err, @res ) = getaddrinfo( "127.0.0.1", "80", { socktype => SOCK_STREAM } );
+cmp_ok( $err, "==", 0, '$err == 0 for host=127.0.0.1/service=80/socktype=STREAM' );
+cmp_ok( $err, "eq", "", '$err eq "" for host=127.0.0.1/service=80/socktype=STREAM' );
+is( scalar @res, 1,
+   '@res has 1 result' );
+
+is( $res[0]->{family}, AF_INET,
+   '$res[0] family is AF_INET' );
+is( $res[0]->{socktype}, SOCK_STREAM,
+   '$res[0] socktype is SOCK_STREAM' );
+ok( $res[0]->{protocol} == 0 || $res[0]->{protocol} == IPPROTO_TCP,
+   '$res[0] protocol is 0 or IPPROTO_TCP' );
+is_deeply( [ unpack_sockaddr_in $res[0]->{addr} ],
+           [ 80, inet_aton( "127.0.0.1" ) ],
+           '$res[0] addr is {"127.0.0.1", 80}' );
+
+# Check actual IV integers work just as well as PV strings
+( $err, @res ) = getaddrinfo( "127.0.0.1", 80, { socktype => SOCK_STREAM } );
+cmp_ok( $err, "==", 0, '$err == 0 for host=127.0.0.1/service=80/socktype=STREAM' );
+is_deeply( [ unpack_sockaddr_in $res[0]->{addr} ],
+           [ 80, inet_aton( "127.0.0.1" ) ],
+           '$res[0] addr is {"127.0.0.1", 80}' );
+
+( $err, @res ) = getaddrinfo( "127.0.0.1", "" );
+cmp_ok( $err, "==", 0, '$err == 0 for host=127.0.0.1' );
+# Might get more than one; e.g. different socktypes
+ok( scalar @res > 0, '@res has results' );
+
+( $err, @res ) = getaddrinfo( "127.0.0.1", undef );
+cmp_ok( $err, "==", 0, '$err == 0 for host=127.0.0.1/service=undef' );
+
+# Test GETMAGIC
+{
+   "127.0.0.1" =~ /(.+)/;
+   ( $err, @res ) = getaddrinfo($1, undef);
+   cmp_ok( $err, "==", 0, '$err == 0 for host=$1' );
+   ok( scalar @res > 0, '@res has results' );
+   is( (unpack_sockaddr_in $res[0]->{addr})[1],
+       inet_aton( "127.0.0.1" ),
+       '$res[0] addr is {"127.0.0.1", ??}' );
+}
+
+( $err, @res ) = getaddrinfo( "", "80", { family => AF_INET, socktype => SOCK_STREAM } );
+cmp_ok( $err, "==", 0, '$err == 0 for service=80/family=AF_INET/socktype=STREAM' );
+is( scalar @res, 1, '@res has 1 result' );
+
+# Just pick the first one
+is( $res[0]->{family}, AF_INET,
+   '$res[0] family is AF_INET' );
+is( $res[0]->{socktype}, SOCK_STREAM,
+   '$res[0] socktype is SOCK_STREAM' );
+ok( $res[0]->{protocol} == 0 || $res[0]->{protocol} == IPPROTO_TCP,
+   '$res[0] protocol is 0 or IPPROTO_TCP' );
+
+# Now some tests of a few well-known internet hosts
+my $goodhost = "cpan.perl.org";
+
+SKIP: {
+   skip "Resolver has no answer for $goodhost", 2 unless gethostbyname( $goodhost );
+
+   ( $err, @res ) = getaddrinfo( "cpan.perl.org", "ftp", { socktype => SOCK_STREAM } );
+   cmp_ok( $err, "==", 0, '$err == 0 for host=cpan.perl.org/service=ftp/socktype=STREAM' );
+   # Might get more than one; e.g. different families
+   ok( scalar @res > 0, '@res has results' );
+}
+
+# Now something I hope doesn't exist - we put it in a known-missing TLD
+my $missinghost = "TbK4jM2M0OS.lm57DWIyu4i";
+
+# Some CPAN testing machines seem to have wildcard DNS servers that reply to
+# any request. We'd better check for them
+
+SKIP: {
+   skip "Resolver has an answer for $missinghost", 1 if gethostbyname( $missinghost );
+
+   # Some OSes return $err == 0 but no results
+   ( $err, @res ) = getaddrinfo( $missinghost, "ftp", { socktype => SOCK_STREAM } );
+   ok( $err != 0 || ( $err == 0 && @res == 0 ),
+      '$err != 0 or @res == 0 for host=TbK4jM2M0OS.lm57DWIyu4i/service=ftp/socktype=SOCK_STREAM' );
+   if( @res ) {
+      # Diagnostic that might help
+      while( my $r = shift @res ) {
+         diag( "family=$r->{family} socktype=$r->{socktype} protocol=$r->{protocol} addr=[" . length( $r->{addr} ) . " bytes]" );
+         diag( "  addr=" . join( ", ", map { sprintf '0x%02x', ord $_ } split m//, $r->{addr} ) );
+      }
+   }
+}
+
+# Now check that names with AI_NUMERICHOST fail
+
+( $err, @res ) = getaddrinfo( "localhost", "ftp", { flags => AI_NUMERICHOST, socktype => SOCK_STREAM } );
+ok( $err != 0, '$err != 0 for host=localhost/service=ftp/flags=AI_NUMERICHOST/socktype=SOCK_STREAM' );
+
+# Some sanity checking on the hints hash
+ok( defined eval { getaddrinfo( "127.0.0.1", "80", undef ); 1 },
+         'getaddrinfo() with undef hints works' );
+ok( !defined eval { getaddrinfo( "127.0.0.1", "80", "hints" ); 1 },
+         'getaddrinfo() with string hints dies' );
+ok( !defined eval { getaddrinfo( "127.0.0.1", "80", [] ); 1 },
+         'getaddrinfo() with ARRAY hints dies' );
+
+# Ensure it doesn't segfault if args are missing
+
+( $err, @res ) = getaddrinfo();
+ok( defined $err, '$err defined for getaddrinfo()' );
+
+( $err, @res ) = getaddrinfo( "127.0.0.1" );
+ok( defined $err, '$err defined for getaddrinfo("127.0.0.1")' );
diff --git a/ext/Socket/t/getnameinfo.t b/ext/Socket/t/getnameinfo.t
new file mode 100644 (file)
index 0000000..803e8c0
--- /dev/null
@@ -0,0 +1,37 @@
+use strict;
+use warnings;
+use Test::More tests => 10;
+
+use Socket qw(
+   AF_INET NI_NUMERICHOST NI_NUMERICSERV
+   getnameinfo pack_sockaddr_in inet_aton
+);
+
+my ( $err, $host, $service );
+
+( $err, $host, $service ) = getnameinfo( pack_sockaddr_in( 80, inet_aton( "127.0.0.1" ) ), NI_NUMERICHOST|NI_NUMERICSERV );
+cmp_ok( $err, "==", 0, '$err == 0 for {family=AF_INET,port=80,sinaddr=127.0.0.1}/NI_NUMERICHOST|NI_NUMERICSERV' );
+cmp_ok( $err, "eq", "", '$err eq "" for {family=AF_INET,port=80,sinaddr=127.0.0.1}/NI_NUMERICHOST|NI_NUMERICSERV' );
+
+is( $host, "127.0.0.1", '$host is 127.0.0.1 for NH/NS' );
+is( $service, "80", '$service is 80 for NH/NS' );
+
+# Probably "localhost" but we'd better ask the system to be sure
+my $expect_host = gethostbyaddr( inet_aton( "127.0.0.1" ), AF_INET );
+defined $expect_host or $expect_host = "127.0.0.1";
+
+( $err, $host, $service ) = getnameinfo( pack_sockaddr_in( 80, inet_aton( "127.0.0.1" ) ), NI_NUMERICSERV );
+cmp_ok( $err, "==", 0, '$err == 0 for {family=AF_INET,port=80,sinaddr=127.0.0.1}/NI_NUMERICSERV' );
+
+is( $host, $expect_host, "\$host is $expect_host for NS" );
+is( $service, "80", '$service is 80 for NS' );
+
+# Probably "www" but we'd better ask the system to be sure
+my $expect_service = getservbyport( 80, "tcp" );
+defined $expect_service or $expect_service = "80";
+
+( $err, $host, $service ) = getnameinfo( pack_sockaddr_in( 80, inet_aton( "127.0.0.1" ) ), NI_NUMERICHOST );
+cmp_ok( $err, "==", 0, '$err == 0 for {family=AF_INET,port=80,sinaddr=127.0.0.1}/NI_NUMERICHOST' );
+
+is( $host, "127.0.0.1", '$host is 127.0.0.1 for NH' );
+is( $service, $expect_service, "\$service is $expect_service for NH" );