Fix a crash in SIGALARM handler when waiting on a child process to be closed

perl-5.31.0-perl-122112-a-simpler-fix-for-pclose-aborted-by-a-si.patch

@@ -0,0 +1,70 @@
+From 35608a1658fe75c79ca53d96aea6cf7cb2a98615 Mon Sep 17 00:00:00 2001
+From: Tony Cook <tony@develop-help.com>
+Date: Thu, 9 May 2019 09:52:30 +1000
+Subject: [PATCH] (perl #122112) a simpler fix for pclose() aborted by a signal
+MIME-Version: 1.0
+Content-Type: text/plain; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+
+This change results in a zombie child process for the lifetime of
+the process, but I think that's the responsibility of the signal
+handler that aborted pclose().
+
+We could add some magic to retry (and retry and retry) waiting on
+child process as we rewind (since there's no other way to remove
+the zombie), but the program has chosen implicitly to abort the
+wait() done by pclose() and it's best to honor that.
+
+If we do choose to retry the wait() we might be blocking an attempt
+by the process to terminate, whether by exit() or die().
+
+If a program does need more flexible handling there's always
+pipe()/fork()/exec() and/or the various event-driven frameworks on
+CPAN.
+
+Signed-off-by: Petr Písař <ppisar@redhat.com>
+---
+ doio.c      | 12 +++++++++++-
+ t/io/pipe.t |  2 --
+ 2 files changed, 11 insertions(+), 3 deletions(-)
+
+diff --git a/doio.c b/doio.c
+index 0cc4e55404..05a06968dc 100644
+--- a/doio.c
++++ b/doio.c
+@@ -1779,7 +1779,17 @@ Perl_io_close(pTHX_ IO *io, GV *gv, bool not_implicit, bool warn_on_fail)
+ 
+     if (IoIFP(io)) {
+ 	if (IoTYPE(io) == IoTYPE_PIPE) {
+-	    const int status = PerlProc_pclose(IoIFP(io));
++            PerlIO *fh = IoIFP(io);
++            int status;
++
++            /* my_pclose() can propagate signals which might bypass any code
++               after the call here if the signal handler throws an exception.
++               This would leave the handle in the IO object and try to close it again
++               when the SV is destroyed on unwind or global destruction.
++               So NULL it early.
++            */
++            IoOFP(io) = IoIFP(io) = NULL;
++	    status = PerlProc_pclose(fh);
+ 	    if (not_implicit) {
+ 		STATUS_NATIVE_CHILD_SET(status);
+ 		retval = (STATUS_UNIX == 0);
+diff --git a/t/io/pipe.t b/t/io/pipe.t
+index 1d01db6af6..fc3071300d 100644
+--- a/t/io/pipe.t
++++ b/t/io/pipe.t
+@@ -255,9 +255,7 @@ close \$fh;
+ PROG
+     print $prog;
+     my $out = fresh_perl($prog, {});
+-    $::TODO = "not fixed yet";
+     cmp_ok($out, '!~', qr/refcnt/, "no exception from PerlIO");
+-    undef $::TODO;
+     # checks that that program did something rather than failing to
+     # compile
+     cmp_ok($out, '=~', qr/Died at/, "but we did get the exception from die");
+-- 
+2.20.1
+

perl-5.31.0-perl-122112-remove-some-interfering-debug-output.patch

@@ -0,0 +1,28 @@
+From 2fe0d7f40a94163d6c242c3e695fdcd19e387422 Mon Sep 17 00:00:00 2001
+From: Tony Cook <tony@develop-help.com>
+Date: Tue, 11 Jun 2019 14:59:23 +1000
+Subject: [PATCH] (perl #122112) remove some interfering debug output
+MIME-Version: 1.0
+Content-Type: text/plain; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+
+Signed-off-by: Petr Písař <ppisar@redhat.com>
+---
+ t/io/pipe.t | 1 -
+ 1 file changed, 1 deletion(-)
+
+diff --git a/t/io/pipe.t b/t/io/pipe.t
+index fc3071300d..9f5bb3bcf8 100644
+--- a/t/io/pipe.t
++++ b/t/io/pipe.t
+@@ -253,7 +253,6 @@ my \$cmd = qq(\$Perl -e "sleep 3");
+ my \$pid = open my \$fh, "|\$cmd" or die "\$!\n";
+ close \$fh;
+ PROG
+-    print $prog;
+     my $out = fresh_perl($prog, {});
+     cmp_ok($out, '!~', qr/refcnt/, "no exception from PerlIO");
+     # checks that that program did something rather than failing to
+-- 
+2.20.1
+

perl-5.31.0-perl-122112-test-for-signal-handler-death-in-pclose.patch

@@ -0,0 +1,54 @@
+From fb5e77103dd443cc2112ba14dc665aa5ec072ce6 Mon Sep 17 00:00:00 2001
+From: Tony Cook <tony@develop-help.com>
+Date: Wed, 30 May 2018 14:03:04 +1000
+Subject: [PATCH] (perl #122112) test for signal handler death in pclose
+MIME-Version: 1.0
+Content-Type: text/plain; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+
+Signed-off-by: Petr Písař <ppisar@redhat.com>
+---
+ t/io/pipe.t | 23 ++++++++++++++++++++++-
+ 1 file changed, 22 insertions(+), 1 deletion(-)
+
+diff --git a/t/io/pipe.t b/t/io/pipe.t
+index f9ee65afe8..1d01db6af6 100644
+--- a/t/io/pipe.t
++++ b/t/io/pipe.t
+@@ -10,7 +10,7 @@ if (!$Config{'d_fork'}) {
+     skip_all("fork required to pipe");
+ }
+ else {
+-    plan(tests => 25);
++    plan(tests => 27);
+ }
+ 
+ my $Perl = which_perl();
+@@ -241,3 +241,24 @@ SKIP: {
+ 
+   is($child, -1, 'child reaped if piped program cannot be executed');
+ }
++
++{
++    # [perl #122112] refcnt: fd -1 < 0 when a signal handler dies
++    # while a pipe close is waiting on a child process
++    my $prog = <<PROG;
++\$SIG{ALRM}=sub{die};
++alarm 1;
++\$Perl = "$Perl";
++my \$cmd = qq(\$Perl -e "sleep 3");
++my \$pid = open my \$fh, "|\$cmd" or die "\$!\n";
++close \$fh;
++PROG
++    print $prog;
++    my $out = fresh_perl($prog, {});
++    $::TODO = "not fixed yet";
++    cmp_ok($out, '!~', qr/refcnt/, "no exception from PerlIO");
++    undef $::TODO;
++    # checks that that program did something rather than failing to
++    # compile
++    cmp_ok($out, '=~', qr/Died at/, "but we did get the exception from die");
++}
+-- 
+2.20.1
+

perl.spec

@@ -165,6 +165,12 @@ Patch19:        perl-5.30.0-Remove-undefined-behavior-from-IV-shifting.patch
 # Fix stacking file test operators, CPAN RT#127073, fixed after 5.31.0
 Patch20:        perl-5.31.0-Don-t-use-PL_check-op_type-to-check-for-filetets-ops.patch
 
+# Fix a crash in SIGALARM handler when waiting on a child process to be closed,
+# RT#122112, fixed after 5.31.0
+Patch21:        perl-5.31.0-perl-122112-test-for-signal-handler-death-in-pclose.patch
+Patch22:        perl-5.31.0-perl-122112-a-simpler-fix-for-pclose-aborted-by-a-si.patch
+Patch23:        perl-5.31.0-perl-122112-remove-some-interfering-debug-output.patch
+
 # Link XS modules to libperl.so with EU::CBuilder on Linux, bug #960048
 Patch200:       perl-5.16.3-Link-XS-modules-to-libperl.so-with-EU-CBuilder-on-Li.patch
 
@@ -2703,6 +2709,9 @@ Perl extension for Version Objects
 %patch18 -p1
 %patch19 -p1
 %patch20 -p1
+%patch21 -p1
+%patch22 -p1
+%patch23 -p1
 %patch200 -p1
 %patch201 -p1
 
@@ -2730,6 +2739,9 @@ perl -x patchlevel.h \
     'Fedora Patch18: Fix an undefined behavior in shifting IV variables' \
     'Fedora Patch19: Fix an undefined behavior in shifting IV variables' \
     'Fedora Patch20: Fix stacking file test operators (CPAN RT#127073)' \
+    'Fedora Patch21: Fix a crash in SIGALARM handler when waiting on a child process to be closed (RT#122112)' \
+    'Fedora Patch22: Fix a crash in SIGALARM handler when waiting on a child process to be closed (RT#122112)' \
+    'Fedora Patch23: Fix a crash in SIGALARM handler when waiting on a child process to be closed (RT#122112)' \
     'Fedora Patch200: Link XS modules to libperl.so with EU::CBuilder on Linux' \
     'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \
     %{nil}
@@ -4981,6 +4993,8 @@ popd
 - Fix memory handling when parsing string literals
 - Fix an undefined behavior in shifting IV variables
 - Fix stacking file test operators (CPAN RT#127073)
+- Fix a crash in SIGALARM handler when waiting on a child process to be closed
+  (RT#122112)
 
 * Tue Jun 11 2019 Jitka Plesnikova <jplesnik@redhat.com> - 4:5.30.0-439
 - Define %%perl_vendor*, %%perl_archlib, %%perl_privlib, because in rpm