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