From 6b3e8b94301d1081e88d276eeb452668c8f13632 Mon Sep 17 00:00:00 2001
From: Andy Polyakov <appro@openssl.org>
Date: Sun, 8 Apr 2018 14:44:59 +0200
Subject: [PATCH] TLSProxy/Proxy.pm: handle -1 as return value from waitpid.

On rare occasion 's_server | perl -ne print' can complete before
corresponding waitpid, which on Windows can results in -1 return
value. This is not an error, don't treat it like one. Collect
even return value from s_server.

Reviewed-by: Bernd Edlinger <bernd.edlinger@hotmail.de>
Reviewed-by: Rich Salz <rsalz@openssl.org>
(Merged from https://github.com/openssl/openssl/pull/5907)
---
 util/perl/TLSProxy/Proxy.pm | 21 +++++++++++++++------
 1 file changed, 15 insertions(+), 6 deletions(-)

diff --git a/util/perl/TLSProxy/Proxy.pm b/util/perl/TLSProxy/Proxy.pm
index b3b2fec090..19b09a4744 100644
--- a/util/perl/TLSProxy/Proxy.pm
+++ b/util/perl/TLSProxy/Proxy.pm
@@ -243,7 +243,8 @@ sub start
     if ($self->{server_port} == 0) {
         # This actually means that s_server exited, because otherwise
         # we would still searching for ACCEPT...
-        die "no ACCEPT detected in '$execcmd' output\n";
+        waitpid($pid, 0);
+        die "no ACCEPT detected in '$execcmd' output: $?\n";
     }
 
     # Just make sure everything else is simply printed [as separate lines].
@@ -255,6 +256,7 @@ sub start
     if (eval { require Win32::Process; 1; }) {
         if (Win32::Process::Create(my $h, $^X, "perl -ne print", 0, 0, ".")) {
             $pid = $h->GetProcessID();
+            $self->{proc_handle} = $h;  # hold handle till next round [or exit]
         } else {
             $error = Win32::FormatMessage(Win32::GetLastError());
         }
@@ -412,11 +414,19 @@ sub clientstart
     my $pid;
     if (--$self->{serverconnects} == 0) {
         $pid = $self->{serverpid};
-        die "serverpid is zero\n" if $pid == 0;
-        print "Waiting for server process to close: $pid...\n";
-        # recall that we wait on process that buffers server's output
+        print "Waiting for 'perl -ne print' process to close: $pid...\n";
+        $pid = waitpid($pid, 0);
+        if ($pid > 0) {
+            die "exit code $? from 'perl -ne print' process\n" if $? != 0;
+        } elsif ($pid == 0) {
+            kill(3, $self->{real_serverpid});
+            die "lost control over $self->{serverpid}?";
+        }
+        $pid = $self->{real_serverpid};
+        print "Waiting for s_server process to close: $pid...\n";
+        # it's done already, just collect the exit code [and reap]...
         waitpid($pid, 0);
-        die "exit code $? from server process\n" if $? != 0;
+        die "exit code $? from s_server process\n" if $? != 0;
     } else {
         # It's a bit counter-intuitive spot to make next connection to
         # the s_server. Rationale is that established connection works
@@ -425,7 +435,6 @@ sub clientstart
         $self->connect_to_server();
     }
     $pid = $self->{clientpid};
-    die "clientpid is zero\n" if $pid == 0;
     print "Waiting for client process to close: $pid...\n";
     waitpid($pid, 0);
 
-- 
GitLab