From 28170417347a7e6a222dba26eef74ce8a906e978 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= Date: Tue, 25 Jun 2019 15:37:50 +0200 Subject: [PATCH] Fix a crash in SIGALARM handler when waiting on a child process to be closed --- ...mpler-fix-for-pclose-aborted-by-a-si.patch | 70 +++++++++++++++++++ ...remove-some-interfering-debug-output.patch | 28 ++++++++ ...t-for-signal-handler-death-in-pclose.patch | 54 ++++++++++++++ perl.spec | 14 ++++ 4 files changed, 166 insertions(+) create mode 100644 perl-5.31.0-perl-122112-a-simpler-fix-for-pclose-aborted-by-a-si.patch create mode 100644 perl-5.31.0-perl-122112-remove-some-interfering-debug-output.patch create mode 100644 perl-5.31.0-perl-122112-test-for-signal-handler-death-in-pclose.patch diff --git a/perl-5.31.0-perl-122112-a-simpler-fix-for-pclose-aborted-by-a-si.patch b/perl-5.31.0-perl-122112-a-simpler-fix-for-pclose-aborted-by-a-si.patch new file mode 100644 index 0000000..e7e2b38 --- /dev/null +++ b/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 +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ř +--- + 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 + diff --git a/perl-5.31.0-perl-122112-remove-some-interfering-debug-output.patch b/perl-5.31.0-perl-122112-remove-some-interfering-debug-output.patch new file mode 100644 index 0000000..2733044 --- /dev/null +++ b/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 +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ř +--- + 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 + diff --git a/perl-5.31.0-perl-122112-test-for-signal-handler-death-in-pclose.patch b/perl-5.31.0-perl-122112-test-for-signal-handler-death-in-pclose.patch new file mode 100644 index 0000000..035f202 --- /dev/null +++ b/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 +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ř +--- + 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 = < - 4:5.30.0-439 - Define %%perl_vendor*, %%perl_archlib, %%perl_privlib, because in rpm