refcnt: fd -1 < 0 with MIME::Lite #13929
Comments
From efimov@reg.ruthe following codeuse strict; } $SIG{ALRM}=sub{die};
|
From victor@vsespb.ruAnother way to reproduce (without blessing a filehandle) use strict; __END__ Died at 57.pl line 4. (strange that does not work without 'use Carp' or 'use something_not_not_anything_else') On Mon Jun 16 05:29:13 2014, efimov@reg.ru wrote:
|
|
The RT System itself - Status changed from 'new' to 'open' |
From @tonycozOn Mon Jun 16 06:14:37 2014, vsespb wrote:
This croaked for me without the use Carp: tony@mars:.../git/perl2$ ./perl -Ilib fdlesszero.pl What appears to be happening is, the explicit close executes, and ends up calling into my_pclose(). This function basically does two things, a) calls PerlIO_close(), which closes the fd and sets the handle's fd to -1 b) loops on wait4pid(), waiting for the child process to complete wait4pid() uses waitpid() or wait4() to wait for the child, if it's interruptted as in this case, it calls PERL_ASYNC_CHECK() which delivers any pending signals. That dies, which tries to destroy FH again, and since fd is now -1, we get the croak above. I can prevent the croak() by adding: if (fd < 0) { to the top of Perl_my_pclose(). It doesn't matter in this particular case, since the parent process immediately exits, but in a more complex case where the perl process keeps running this will result in zombie processes. Tony |
From victor@vsespb.ruI think it should behave like this (when there is wait() called from destructor). $ perl 1.pl $ cat 1.pl So instead if (fd < 0) { Perl_my_pclose should continue and run wait4pid loop, but PerlIO_close should be skipped. Also, "if (fd < 0) {" can be improved like On Mon Jul 07 00:22:57 2014, tonyc wrote:
|
From @tonycozOn Mon Jul 07 12:48:51 2014, vsespb wrote:
Without the original fd we can't look up the pid to wait on. We can't re-order the close/wait to wait/close, since if we're writing to the child, it may be waiting for EOF (eg. a filter) before exiting. Tony |
From victor@vsespb.ruOn Mon Jul 07 16:35:06 2014, tonyc wrote:
We need make function re-entrant. Can save PID for later user in global varibale.
yes, right. Here is prototype. All tests pass and original problem fixed. ==== svp = av_fetch(PL_fdpid,fd,TRUE); + if (fd < 0 && inside_my_pclose) { #ifdef OS2
|
From @tonycozOn Tue Jul 08 03:02:17 2014, vsespb wrote:
...
Another problem I can see with the current my_pclose() code - the second time we enter my_pclose() for our sample code, the PerlIO object has already been freed by PerlIO_close(), so we're accessing a freed object. Because of the way PerlIO allocates memory, this isn't picked up by valgrind. I can think of a few different possibilities to fix the problem: a) implement a half-close operation for PerlIO that closes the handle but doesn't release the PerlIO object. my_pclose() would half-close the object, perform the wait, then do the full close which releases the PerlIO object. I'm not sure how much work this is. b) keep a linked list (or other structure, but hopefully we don't have a lot of them) of closing-in-progress pipe PerlIO handles, my_pclose() checks if the handle is on the list. If it is, it bypasses the PerlIO_close(), if not, call PerlIO_close() and add an entry to the list with the PerlIO object pointer[1] and pid. After the wait() loop is complete remove the entry from the list. I think this might be the correct solution. Locking may need to be an issue as the linked list needs to be visible cross-thread as some handles are visible cross-thread. This is the multi-handle version of your solution. c) implement something close to the vms/vms.c implementation of my_popen()/my_pclose() which keeps a fairly complex data structure for each pipe. Overkill here I think. Tony [1] this is undefined behaviour, but less so than following the pointer, I expect |
From e.lepikhin@corp.mail.ruCreated by johnlepikhin@gmail.comThis is a bug report for perl from johnlepikhin@gmail.com, ----------------------------------------------------------------- $ perl -e 'alarm(1); $SIG{ALRM} = sub { die "" }; open($fh, "-|", Perl Info |
From @tonycozOn Wed, 11 Apr 2018 05:53:26 -0700, e.lepikhin@corp.mail.ru wrote:
This looks like a duplicate for 122112. Tony |
|
The RT System itself - Status changed from 'new' to 'open' |
From @tonycozOn Mon, 07 Jul 2014 12:48:51 -0700, vsespb wrote:
The attached fixes this specific problem. It does leave the PerlIO handle in the IO SV IFP slot, so if someone attempts to use the handle after an interruptted pipe close they might still have problems. Tony |
From @tonycoz0001-perl-122112-test-for-signal-handler-death-in-pclose.patchFrom 8d15119dfcdaaf499a5e551b78da9212e639df9e Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 30 May 2018 14:03:04 +1000
Subject: (perl #122112) test for signal handler death in pclose
---
t/io/pipe.t | 25 ++++++++++++++++++++++++-
1 file changed, 24 insertions(+), 1 deletion(-)
diff --git a/t/io/pipe.t b/t/io/pipe.t
index f9ee65afe8..8196f05393 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,26 @@ SKIP: {
is($child, -1, 'child reaped if piped program cannot be executed');
}
+
+SKIP: {
+ # this is probably more restrictive than necessary
+ skip "Might not be using perl's pclose", 2
+ unless $^O =~ /^(linux|.*bsd|darwin)$/ia;
+ # [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
+ 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.11.0
|
From @tonycoz0002-perl-122112-prevent-access-to-closed-pip-FH-on-a-sig.patchFrom 4a0e84cfb4e3e88db08219eb4fc033b8ddbc29d5 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 13 Sep 2017 08:53:38 +1000
Subject: (perl #122112) prevent access to closed pip FH on a signal that dies
Don't access a closed PerlIO handle if a signal handler dies
when closing a pipe.
---
doio.c | 106 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
sv.h | 1 +
t/io/pipe.t | 2 --
util.c | 4 +--
4 files changed, 108 insertions(+), 5 deletions(-)
diff --git a/doio.c b/doio.c
index 4b8923f77c..03c75219df 100644
--- a/doio.c
+++ b/doio.c
@@ -1726,6 +1726,110 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit)
return retval;
}
+#if (!defined(DOSISH) || defined(HAS_FORK)) && !defined(VMS) && !defined(__LIBCATAMOUNT__) && !defined(__amigaos4__)
+
+static int
+S_pclose_free(pTHX_ SV *io, MAGIC *mg) {
+ if (mg->mg_obj && SvIVX(mg->mg_obj) > 0) {
+ /* We should only get here for an implicit close.
+
+ We do the close here rather than in S_do_pclose() because
+ during destruction magic is freed before io_close() is
+ called, so we no longer have access to the original PerlIO
+ object, which has been closed if we get here.
+ */
+ int fd = (int)SvIVX(mg->mg_obj);
+ SV **svp = av_fetch(PL_fdpid,fd,TRUE);
+ Pid_t pid = (SvTYPE(*svp) == SVt_IV) ? SvIVX(*svp) : -1;
+
+ if (pid > 0) {
+ Pid_t pid2;
+ int status;
+ do {
+ /* a die within a signal handler in here may ... */
+ pid2 = wait4pid(pid, &status, 0);
+ /* ... prevent anything following here running */
+ } while (pid2 == -1 && errno == EINTR);
+ }
+ /* ensure sv_clear() doesn't try to close it again */
+ IoIFP(io) = NULL;
+ SvREFCNT_dec(*svp);
+ *svp = NULL;
+ }
+ return 0;
+}
+
+static const MGVTBL pclose_vtbl =
+ {
+ NULL, /* svt_get */
+ NULL, /* svt_set */
+ NULL, /* svt_len */
+ NULL, /* svt_clear */
+ S_pclose_free, /* svt_free */
+ NULL, /* svt_copy */
+ NULL, /* svt_dup */
+ NULL /* svt_local */
+ };
+
+static int
+S_do_pclose(pTHX_ IO *io) {
+ MAGIC *mg = mg_findext((SV*)io, PERL_MAGIC_uvar, &pclose_vtbl);
+ int status;
+ if (!mg) {
+ mg = sv_magicext((SV*)io, sv_2mortal(newSViv(-1)), PERL_MAGIC_uvar, &pclose_vtbl, NULL, 0);
+ }
+ if (SvIVX(mg->mg_obj) == -1) {
+ int fd = PerlIO_fileno(IoIFP(io));
+ sv_setiv(mg->mg_obj, fd);
+
+ /* it's possible for a signal handler to be called when pclose() waits
+ on the child process, and for that signal handler to die, which leaves
+ the underlying PerlIO object freed, but the child process still
+ un-wait()ed upon.
+ */
+ status = PerlProc_pclose(IoIFP(io));
+ }
+ else {
+
+ /* if we get here, close() has been explicitly called on a
+ pipe handle we've already tried to close.
+
+ The magic free code will handle the implicit close in this
+ case.
+ */
+
+ int fd = (int)SvIVX(mg->mg_obj);
+ SV **svp = av_fetch(PL_fdpid,fd,TRUE);
+ Pid_t pid = (SvTYPE(*svp) == SVt_IV) ? SvIVX(*svp) : -1;
+
+ if (pid > 0) {
+ Pid_t pid2;
+ do {
+ /* a die within a signal handler in here may ... */
+ pid2 = wait4pid(pid, &status, 0);
+ /* ... prevent anything following here running */
+ } while (pid2 == -1 && errno == EINTR);
+ status = pid2 < 0 ? pid2 : status == 0 ? 0 : (errno = 0, status);
+ }
+ else {
+ status = 0;
+ }
+ SvREFCNT_dec(*svp);
+ *svp = NULL;
+ }
+ sv_setiv(mg->mg_obj, -1);
+
+ return status;
+}
+
+#define do_pclose(io) S_do_pclose(aTHX_ (io));
+
+#else
+
+#define do_pclose(io) PerlProc_pclose(IoIFP(io))
+
+#endif
+
bool
Perl_io_close(pTHX_ IO *io, GV *gv, bool not_implicit, bool warn_on_fail)
{
@@ -1735,7 +1839,7 @@ 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));
+ const int status = do_pclose(io);
if (not_implicit) {
STATUS_NATIVE_CHILD_SET(status);
retval = (STATUS_UNIX == 0);
diff --git a/sv.h b/sv.h
index 1c7224277f..503fd14eb7 100644
--- a/sv.h
+++ b/sv.h
@@ -1422,6 +1422,7 @@ object type. Exposed to perl code via Internals::SvREADONLY().
#define IoFMT_GV(sv) ((XPVIO*) SvANY(sv))->xio_fmt_gv
#define IoBOTTOM_NAME(sv)((XPVIO*) SvANY(sv))->xio_bottom_name
#define IoBOTTOM_GV(sv) ((XPVIO*) SvANY(sv))->xio_bottom_gv
+#define IoPIPE_PID(sv) ((XPVIO*) SvANY(sv))->xio_pipe_pid
#define IoTYPE(sv) ((XPVIO*) SvANY(sv))->xio_type
#define IoFLAGS(sv) ((XPVIO*) SvANY(sv))->xio_flags
diff --git a/t/io/pipe.t b/t/io/pipe.t
index 8196f05393..c95da9c796 100644
--- a/t/io/pipe.t
+++ b/t/io/pipe.t
@@ -257,9 +257,7 @@ my \$pid = open my \$fh, "|\$cmd" or die "\$!\n";
close \$fh;
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");
diff --git a/util.c b/util.c
index 647f53307d..58fdc4e6e3 100644
--- a/util.c
+++ b/util.c
@@ -2795,8 +2795,6 @@ Perl_my_pclose(pTHX_ PerlIO *ptr)
svp = av_fetch(PL_fdpid,fd,TRUE);
pid = (SvTYPE(*svp) == SVt_IV) ? SvIVX(*svp) : -1;
- SvREFCNT_dec(*svp);
- *svp = NULL;
#if defined(USE_PERLIO)
/* Find out whether the refcount is low enough for us to wait for the
@@ -2816,6 +2814,8 @@ Perl_my_pclose(pTHX_ PerlIO *ptr)
if (should_wait) do {
pid2 = wait4pid(pid, &status, 0);
} while (pid2 == -1 && errno == EINTR);
+ SvREFCNT_dec(*svp);
+ *svp = NULL;
if (close_failed) {
RESTORE_ERRNO;
return -1;
--
2.11.0
|
From @tonycozOn Tue, 29 May 2018 22:54:52 -0700, tonyc wrote:
I think the attached is a better solution, as detailed in the commit message. Tony |
From @tonycoz0002-perl-122112-a-simpler-fix-for-pclose-aborted-by-a-si.patchFrom cfc3d5eb217d47974692a6f052c10c1f47bc2dcf Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Thu, 9 May 2019 09:52:30 +1000
Subject: (perl #122112) a simpler fix for pclose() aborted by a signal
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.
---
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.11.0
|
From @tonycozOn Wed, 08 May 2019 18:41:08 -0700, tonyc wrote:
Test case applied as fb5e771 and the simple fix as 35608a1. Tony |
|
@tonycoz - Status changed from 'open' to 'pending release' |
|
@tonycoz - Status changed from 'pending release' to 'open' |
From rich@hyphen-dash-hyphen.infoOn Fri, May 31, 2019 at 8:45 PM Richard Leach
Sorry, io/pipe.t has started failing but it's io/eintr that seems to |
From rich@hyphen-dash-hyphen.infoOn Thu, May 30, 2019 at 1:36 AM Tony Cook via RT Hi Tony, io/pipe.t has just started hanging on my Android builds, seemingly I'll have time over the weekend to look in more detail, is there any $ ./perl harness -v io/pipe.t Test Summary Report io/pipe.t (Wstat: 0 Tests: 26 Failed: 0) via perlbug: queue: perl5 status: open |
From @tonycozOn Fri, 31 May 2019 21:41:46 -0700, rich@hyphen-dash-hyphen.info wrote:
Was this consistent? ie. was pipe.t consistently passing before the change and is now consistently failing? and similarly for eintr.t? Can you see where eintr.t is blocking? Something like: cd t ; ./perl io/eintr.t will run the test manually. I don't see how the change I ended up making would cause the signal not to be delivered in either case.[1] Tony [1] one of the changes I considered could have caused blocking |
From rich@hyphen-dash-hyphen.infoOn Mon, Jun 3, 2019 at 2:58 AM Tony Cook via RT
eintr.t turned out to be a local problem that went away after a reboot. pipe.t is more persistent. It was consistently passing in the run up Trying to identify the breaking commit (and learn how to use bisect.pl Regards, |
From rich@hyphen-dash-hyphen.infoOn Mon, Jun 3, 2019 at 8:00 AM Richard Leach
Hi Tony, It was definitely fb5e771 wot broke it. Thanks, |
From rich@hyphen-dash-hyphen.infoOn Mon, Jun 3, 2019 at 6:43 PM Richard Leach
That commit broke the test from a smoker's perspective, but it was https://help-bash.gnu.narkive.com/la0zjaBe/when-pipes-fail-and-when-not The Termux SSH shell indeed cannot catch SIGPIPE: $ trap '' pipe; bash -c 'trap - pipe; for i in {0..9}; do I'm not sufficiently familiar with the process model to know how I've run out of time this evening, but options otherwise seem to be: Thanks, |
From @tonycozOn Mon, Jun 03, 2019 at 10:36:56PM +0100, Richard Leach wrote:
The io/pipe.t test that's failing is setting up a signal handler for I'm setting up an Android VM, maybe that will let me track it down. Tony |
From @jmdhOn Mon, 03 Jun 2019 18:17:20 -0700, tonyc wrote:
io/pipe.t reproducibly fails on Debian (both 9 and unstable): make test_harness is happy, but make test is definitely not: t/io/pipe ...................................................... FAILED--unexpected output at test 25 This just seems to be left-over print debugging? line 256: print $prog; |
From @LeontOn Thu, Jun 6, 2019 at 7:10 PM Dominic Hargreaves via RT
Apparently, TEST allows for extra output in cpan|dist|ext|lib, but not (puts Test::Harness hat on) I would not recommend extra output Leon |
From @tonycozOn Thu, Jun 06, 2019 at 10:10:35AM -0700, Dominic Hargreaves via RT wrote:
Thanks, fixed in 2fe0d7f. Tony |
From @tonycozOn Fri, 31 May 2019 21:41:49 -0700, rich@hyphen-dash-hyphen.info wrote:
There were two problems, one that 2fe0d7f fixed, the extraneous output from the test. The other problem was that the PIPE signal wasn't being delivered when the test wasn't being run through make, ie. any of the following failed to output "ok 9": cd t ; ./perl -I../lib io/pipe.t but: make test TEST_FILES=io/pipe.t worked. It turned out to be that the problem was that SIGPIPE was blocked, presumably something in make was unblocking it. The attached adjusts the signal mask so that SIGPIPE isn't blocked, assuming the right POSIX APIs are available, the eval should ensure nothing happens if the APIs aren't available. Tony |
From @tonycoz0001-perl-122112-make-sure-SIGPIPE-is-delivered-if-we-tes.patchFrom f9c44acd1d6465f687b5aeb2d845879ef0db6f84 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 25 Jun 2019 15:47:57 +1000
Subject: (perl #122112) make sure SIGPIPE is delivered if we test it
---
t/io/pipe.t | 12 ++++++++++++
1 file changed, 12 insertions(+)
diff --git a/t/io/pipe.t b/t/io/pipe.t
index 9f5bb3bcf8..bdf743c26c 100644
--- a/t/io/pipe.t
+++ b/t/io/pipe.t
@@ -125,6 +125,18 @@ wait; # Collect from $pid
pipe(READER,WRITER) || die "Can't open pipe";
close READER;
+eval {
+ # one platform at least appears to block SIGPIPE by default (see #122112)
+ # so make sure it's unblocked.
+ # The eval wrapper should ensure this does nothing if these aren't
+ # implemented.
+ require POSIX;
+ my $mask = POSIX::SigSet->new(POSIX::SIGPIPE());
+ my $old = POSIX::SigSet->new();
+ POSIX::sigprocmask(POSIX::SIG_UNBLOCK(), $mask, $old);
+ note "Yes, SIGPIPE was blocked" if $old->ismember(POSIX::SIGPIPE());
+};
+
$SIG{'PIPE'} = 'broken_pipe';
sub broken_pipe {
--
2.11.0
|
From rich@hyphen-dash-hyphen.infoOn Tue, Jun 25, 2019 at 7:16 AM Tony Cook via RT
Many thanks for digging into that case! via perlbug: queue: perl5 status: open |
From @tonycozOn Tue, 25 Jun 2019 00:21:09 -0700, rich@hyphen-dash-hyphen.info wrote:
Applied as 293a533. Tony |
|
@tonycoz - Status changed from 'open' to 'pending release' |
Migrated from rt.perl.org#122112 (status was 'pending release')
Searchable as RT122112$
The text was updated successfully, but these errors were encountered: