This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Socket 2.015
authorJarkko Hietaniemi <jhi@iki.fi>
Sat, 16 Aug 2014 01:54:48 +0000 (21:54 -0400)
committerJarkko Hietaniemi <jhi@iki.fi>
Sat, 16 Aug 2014 01:57:24 +0000 (21:57 -0400)
cpan/Socket/Socket.pm
cpan/Socket/t/getaddrinfo.t
cpan/Socket/t/getnameinfo.t
cpan/Socket/t/socketpair.t

index b1c78cc..a63e16d 100644 (file)
@@ -3,7 +3,7 @@ package Socket;
 use strict;
 { use 5.006001; }
 
-our $VERSION = '2.014';
+our $VERSION = '2.015';
 
 =head1 NAME
 
@@ -935,7 +935,7 @@ if( defined &getaddrinfo ) {
 # family
 
 # Borrowed from Regexp::Common::net
-my $REGEXP_IPv4_DECIMAL = qr/25[0-5]|2[0-4][0-9]|1?[0-9]{1,2}/;
+my $REGEXP_IPv4_DECIMAL = qr/25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2}/;
 my $REGEXP_IPv4_DOTTEDQUAD = qr/$REGEXP_IPv4_DECIMAL\.$REGEXP_IPv4_DECIMAL\.$REGEXP_IPv4_DECIMAL\.$REGEXP_IPv4_DECIMAL/;
 
 sub fake_makeerr
index 24f154c..6f8a324 100644 (file)
@@ -101,10 +101,24 @@ SKIP: {
 }
 
 # Numeric addresses with AI_NUMERICHOST should pass (RT95758)
-{
-    ( $err, @res ) = getaddrinfo( "127.0.0.1", 80, { flags => AI_NUMERICHOST } );
-    ok( $err == 0, "\$err == 0 for 127.0.0.1/80/flags=AI_NUMERICHOST" ) or
-       diag( "\$err is $err" );
+AI_NUMERICHOST: {
+    # Here we need a port that is open to the world. Not all places have all
+    # the ports. For example Solaris by default doesn't have http/80 in
+    # /etc/services, and that would fail. Let's try a couple of commonly open
+    # ports, and hope one of them will succeed. Conversely this means that
+    # sometimes this will fail.
+    #
+    # An alternative method would be to manually parse /etc/services and look
+    # for enabled services but that's kind of yuck, too.
+    my @port = (80, 7, 22, 25, 88, 123, 110, 389, 443, 445, 873, 2049, 3306);
+    foreach my $port ( @port ) {
+       ( $err, @res ) = getaddrinfo( "127.0.0.1", $port, { flags => AI_NUMERICHOST, socktype => SOCK_STREAM } );
+       if( $err == 0 ) {
+           ok( $err == 0, "\$err == 0 for 127.0.0.1/$port/flags=AI_NUMERICHOST" );
+           last AI_NUMERICHOST;
+       }
+    }
+    fail( "$err for 127.0.0.1/$port[-1]/flags=AI_NUMERICHOST (failed for ports @port)" );
 }
 
 # Now check that names with AI_NUMERICHOST fail
index 035b345..5ee5575 100644 (file)
@@ -1,6 +1,6 @@
 use strict;
 use warnings;
-use Test::More tests => 14;
+use Test::More tests => 12;
 
 use Socket qw(:addrinfo AF_INET pack_sockaddr_in inet_aton);
 
@@ -21,26 +21,14 @@ is( $service, "80", '$service is 80 for NS, NIx_NOHOST' );
 is( $host, "127.0.0.1", '$host is undef for NIx_NOSERV' );
 is( $service, undef, '$service is 80 for NS, NIx_NOSERV' );
 
-# 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 $flags = NI_NUMERICHOST;
-my $expect_service = getservbyport( 80, "tcp" );
-unless( defined $expect_service ) {
-    $expect_service = "80";
-    $flags |= NI_NUMERICSERV; # don't seem to have a service name
-}
+# We can't meaningfully compare '$host' with anything specific, all we can be
+# sure is it's not empty
+ok( length $host, '$host is nonzero length for NS' );
 
-( $err, $host, $service ) = getnameinfo( pack_sockaddr_in( 80, inet_aton( "127.0.0.1" ) ), $flags );
-cmp_ok( $err, "==", 0, '$err == 0 for {family=AF_INET,port=80,sinaddr=127.0.0.1}/NI_NUMERICHOST[|NI_NUMERICSERV]' );
+( $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" );
+ok( length $service, '$service is nonzero length for NH' );
index 817707a..823306e 100644 (file)
@@ -35,6 +35,11 @@ BEGIN {
            }
            warn "Something unexpectedly hung during testing";
            kill "INT", $parent or die "Kill failed: $!";
+           if( $^O eq "cygwin" ) {
+               # sometimes the above isn't enough on cygwin
+               sleep 1; # wait a little, it might have worked after all
+               system( "/bin/kill -f $parent; echo die $parent" );
+           }
            exit 1;
        }
     }