This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
harden IO's cachepropagate-tcp
authorTony Cook <tony@develop-help.com>
Thu, 12 Dec 2019 00:30:59 +0000 (11:30 +1100)
committerTony Cook <tony@develop-help.com>
Mon, 16 Dec 2019 00:48:47 +0000 (11:48 +1100)
This failed on Win32 like in the #17351 CI checks with:

../dist/if/t/if.t .................................................. ok
Can't call method "sockdomain" on an undefined value at t/cachepropagate-tcp.t line 46.
# Looks like your test exited with 9 just after 5.
../dist/IO/t/cachepropagate-tcp.t ..................................
Dubious, test returned 9 (wstat 2304, 0x900)
Failed 3/8 subtests

I suspect what happened is there was a race between the parent
accepting the connection and the child exiting and closing the
connection.

The Microsoft documentation for accept() indicates one possible
reason for failure is:

WSAECONNRESET
An incoming connection was indicated, but was subsequently
        terminated by the remote peer prior to accepting the call.

which I suspect happened here.

So I've:

- added a basic error check for the result of accept()
- made the child to wait for the parent to close the socket
- the parent explicitly closes the socket

dist/IO/t/cachepropagate-tcp.t

index b9104bb..59a7adc 100644 (file)
@@ -9,7 +9,7 @@ use Socket;
 use Test::More;
 use Config;
 
 use Test::More;
 use Config;
 
-plan tests => 8;
+plan tests => 9;
 
 my $listener = IO::Socket::INET->new(Listen => 1,
                                      LocalAddr => '127.0.0.1',
 
 my $listener = IO::Socket::INET->new(Listen => 1,
                                      LocalAddr => '127.0.0.1',
@@ -36,6 +36,14 @@ SKIP: {
        my $connector = IO::Socket::INET->new(PeerAddr => '127.0.0.1',
                                              PeerPort => $port,
                                              Proto => 'tcp');
        my $connector = IO::Socket::INET->new(PeerAddr => '127.0.0.1',
                                              PeerPort => $port,
                                              Proto => 'tcp');
+        if ($connector) {
+            my $buf;
+            # wait for parent to close its end
+            $connector->read($buf, 1);
+        }
+        else {
+            diag "child failed to connect to parent: $@";
+        }
        exit(0);
     } else {;
            ok(defined($cpid), 'spawned a child');
        exit(0);
     } else {;
            ok(defined($cpid), 'spawned a child');
@@ -43,6 +51,9 @@ SKIP: {
 
     my $new = $listener->accept();
 
 
     my $new = $listener->accept();
 
+    ok($new, "got a socket from accept")
+      or diag "accept failed: $@";
+
     is($new->sockdomain(), $d, 'domain match');
   SKIP: {
       skip "no Socket::SO_PROTOCOL", 1 if !defined(eval { Socket::SO_PROTOCOL });
     is($new->sockdomain(), $d, 'domain match');
   SKIP: {
       skip "no Socket::SO_PROTOCOL", 1 if !defined(eval { Socket::SO_PROTOCOL });
@@ -52,6 +63,7 @@ SKIP: {
       skip "no Socket::SO_TYPE", 1 if !defined(eval { Socket::SO_TYPE });
       is($new->socktype(), $s, 'type match');
     }
       skip "no Socket::SO_TYPE", 1 if !defined(eval { Socket::SO_TYPE });
       is($new->socktype(), $s, 'type match');
     }
+    $new->close;
 
     wait();
 }
 
     wait();
 }