system() returns -1 when $SIG{CHLD} in effect #11789
Comments
From @rcaputoCreated by @rcaputoUsing $SIG{CHLD} to reap signals causes system() to return -1 on print system('echo "without reaper: "'), "\n"; Output shows that it's wise to fear the REAPER(). % ./perl ../../support/sigchld-system.pl There seems to be a workaround. I've tried to implement it, but I PP_system() uses Perl_wait4pid() to wait for a particular PID. It could be possible to block SIGCHLD in PP_system() before PERL_USES_PL_PIDSTATUS must be in effect. Perl_wait4pid() must enter PP_system() can unblock SIGCHLD and dispatch pending PL_pidstatus A minimal patch might get away with enabling PERL_USES_PL_PIDSTATUS on Perl Info |
From @rcaputoI'm attaching a Test::More test case that illustrates the problem. It includes a PROVE_CONCEPT |
From @rcaputoThere's precedent for blocking SIGCHLD during system(). http://pubs.opengroup.org/onlinepubs/009695399/functions/system.html "The system() function shall ignore the SIGINT and SIGQUIT signals, and shall block the SIGCHLD |
From @rcaputoThe blead implementation uses rsignal_save() to ignore SIGINT and SIGQUIT, but it doesn't seem |
From @rcaputoI was pointed to two similar bugs while researching this issue. Resolving this may help to https://rt-archive.perl.org/perl5//Public/Bug/Display.html?id=36976 http://rt.perl.org/rt3/Public/Bug/Display.html?id=18849 |
From @LeontOn Thu Dec 08 09:26:48 2011, rcaputo2 wrote:
Patch attached :-) Leon |
From @Leont0001-Block-SIGCHLD-during-system-call-per-POSIX.patchFrom c11ee830e255ff3173440dde1fcad0137dfc231e Mon Sep 17 00:00:00 2001
From: Leon Timmermans <fawaka@gmail.com>
Date: Fri, 9 Dec 2011 00:32:10 +0100
Subject: [PATCH] Block SIGCHLD during system() call (per POSIX)
---
pp_sys.c | 15 +++++++++++++++
1 files changed, 15 insertions(+), 0 deletions(-)
diff --git a/pp_sys.c b/pp_sys.c
index 78a51ae..5d40e9e 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -4106,9 +4106,15 @@ PP(pp_system)
Pid_t childpid;
int pp[2];
I32 did_pipes = 0;
+ sigset_t newset, oldset;
if (PerlProc_pipe(pp) >= 0)
did_pipes = 1;
+#if (defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO))
+ sigemptyset(&newset);
+ sigaddset(&newset, SIGCHLD);
+ sigprocmask(SIG_BLOCK, &newset, &oldset);
+#endif
while ((childpid = PerlProc_fork()) == -1) {
if (errno != EAGAIN) {
value = -1;
@@ -4118,6 +4124,9 @@ PP(pp_system)
PerlLIO_close(pp[0]);
PerlLIO_close(pp[1]);
}
+#if (defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO))
+ sigprocmask(SIG_SETMASK, &oldset, NULL);
+#endif
RETURN;
}
sleep(5);
@@ -4136,6 +4145,9 @@ PP(pp_system)
result = wait4pid(childpid, &status, 0);
} while (result == -1 && errno == EINTR);
#ifndef PERL_MICRO
+#ifdef HAS_SIGPROCMASK
+ sigprocmask(SIG_SETMASK, &oldset, NULL);
+#endif
(void)rsignal_restore(SIGINT, &ihand);
(void)rsignal_restore(SIGQUIT, &qhand);
#endif
@@ -4166,6 +4178,9 @@ PP(pp_system)
XPUSHi(STATUS_CURRENT);
RETURN;
}
+#if (defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO))
+ sigprocmask(SIG_SETMASK, &oldset, NULL);
+#endif
if (did_pipes) {
PerlLIO_close(pp[0]);
#if defined(HAS_FCNTL) && defined(F_SETFD)
--
1.7.5.4
|
|
The RT System itself - Status changed from 'new' to 'open' |
From @LeontOn Thu Dec 08 16:41:00 2011, LeonT wrote:
New patch, now avoiding declaring sigset_t's on platforms without Leon |
From @Leont0001-Block-SIGCHLD-during-system-call-per-POSIX.patchFrom 5c5e26ae6b56d73f4c2f912623d5fc04cccfdc24 Mon Sep 17 00:00:00 2001
From: Leon Timmermans <fawaka@gmail.com>
Date: Fri, 9 Dec 2011 00:32:10 +0100
Subject: [PATCH] Block SIGCHLD during system() call (per POSIX)
---
pp_sys.c | 17 +++++++++++++++++
1 files changed, 17 insertions(+), 0 deletions(-)
diff --git a/pp_sys.c b/pp_sys.c
index 78a51ae..1bf561d 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -4106,9 +4106,17 @@ PP(pp_system)
Pid_t childpid;
int pp[2];
I32 did_pipes = 0;
+#if (defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO))
+ sigset_t newset, oldset;
+#endif
if (PerlProc_pipe(pp) >= 0)
did_pipes = 1;
+#if (defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO))
+ sigemptyset(&newset);
+ sigaddset(&newset, SIGCHLD);
+ sigprocmask(SIG_BLOCK, &newset, &oldset);
+#endif
while ((childpid = PerlProc_fork()) == -1) {
if (errno != EAGAIN) {
value = -1;
@@ -4118,6 +4126,9 @@ PP(pp_system)
PerlLIO_close(pp[0]);
PerlLIO_close(pp[1]);
}
+#if (defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO))
+ sigprocmask(SIG_SETMASK, &oldset, NULL);
+#endif
RETURN;
}
sleep(5);
@@ -4136,6 +4147,9 @@ PP(pp_system)
result = wait4pid(childpid, &status, 0);
} while (result == -1 && errno == EINTR);
#ifndef PERL_MICRO
+#ifdef HAS_SIGPROCMASK
+ sigprocmask(SIG_SETMASK, &oldset, NULL);
+#endif
(void)rsignal_restore(SIGINT, &ihand);
(void)rsignal_restore(SIGQUIT, &qhand);
#endif
@@ -4166,6 +4180,9 @@ PP(pp_system)
XPUSHi(STATUS_CURRENT);
RETURN;
}
+#if (defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO))
+ sigprocmask(SIG_SETMASK, &oldset, NULL);
+#endif
if (did_pipes) {
PerlLIO_close(pp[0]);
#if defined(HAS_FCNTL) && defined(F_SETFD)
--
1.7.5.4
|
From @cpansproutOn Thu Dec 08 17:15:21 2011, LeonT wrote:
Since you actually understand what’s going on (unlike me), could you -- Father Chrysostomos |
From @LeontOn Fri, Dec 9, 2011 at 10:38 PM, Father Chrysostomos via RT
POSIX says «The system() function shall ignore the SIGINT and SIGQUIT
I'm lacking a system where the test failed (e.g. FreeBSD or OS X), so Leon |
From @rcaputoI am attaching a new test case that I hope addresses all issues raised |
From @rcaputo#!/usr/bin/env perl use warnings; use Test::More; use constant TRUE => 'perl -e "exit 0"'; # Skip platforms that don't support SIGCHLD. unless (exists $SIG{CHLD}) { plan tests => 3; # Make sure processes forked outside system() are still reaped. my $pid = fork(); # Test system() without REAPER in place. test_system('without reaper'); # Put REAPER() in place. REAPER() is adapted from perlipc.pod. my @pids; sub REAPER { # Reset SIGCHLD in case of SysV semantics. $SIG{CHLD} = \&REAPER; # Test system() with REAPER() in place. test_system('with reaper'); # Give PIDs a chance. note "Waiting briefly for SIGCHLD..."; # Make sure the non-system() PID was reaped. is_deeply( # End of main tests. Begin helper functions. sub test_system { my $expected_zeroes = 10; # This test is looking for a race between system()'s waitpid() and a for (1..$expected_zeroes) { is( |
From @LeontOn Fri, Dec 9, 2011 at 11:38 PM, Father Chrysostomos via RT
I adapted Rocco's tests for core, see attachment Leon |
From @Leont0002-Added-tests-for-SIGCHLD-blocking-during-system.patchFrom 44f842713e2ec6de544abbff3aaf9a88f857c1bc Mon Sep 17 00:00:00 2001
From: Leon Timmermans <fawaka@gmail.com>
Date: Wed, 28 Dec 2011 23:46:54 +0200
Subject: [PATCH 2/2] Added tests for SIGCHLD blocking during system()
---
t/op/sigdispatch.t | 56 ++++++++++++++++++++++++++++++++++++++++++++++++++-
1 files changed, 54 insertions(+), 2 deletions(-)
diff --git a/t/op/sigdispatch.t b/t/op/sigdispatch.t
index 3b8d6ec..6b0ba59 100644
--- a/t/op/sigdispatch.t
+++ b/t/op/sigdispatch.t
@@ -9,9 +9,9 @@ BEGIN {
use strict;
use Config;
-plan tests => 26;
+plan tests => 29;
-watchdog(15);
+watchdog(25);
$SIG{ALRM} = sub {
die "Alarm!\n";
@@ -137,3 +137,55 @@ like $@, qr/No such hook: __DIE__\\0whoops at/;
$SIG{"KILL\0"} = sub { 1 };
like $w, qr/No such signal: SIGKILL\\0 at/, 'Arbitrary signal lookup through %SIG is clean';
}
+
+use constant TRUE => ('perl', '-e', 'exit 0');
+
+SKIP: {
+ skip '', 3 if is_miniperl() or not exists $SIG{CHLD};
+ require POSIX;
+ require Time::HiRes;
+
+ my $pid = fork // die "Can't fork: $!";
+ unless ($pid) {
+ note("Child PID: $$");
+ Time::HiRes::sleep(0.250);
+ exit;
+ }
+
+ test_system('without reaper');
+
+ my @pids;
+ $SIG{CHLD} = sub {
+ while (waitpid(-1, POSIX::WNOHANG()) > 0) {
+ note "Reaped: $pid";
+ push @pids, $pid;
+ }
+ };
+
+ test_system('with reaper');
+
+ note("Waiting briefly for SIGCHLD...");
+ Time::HiRes::sleep(0.500);
+
+ ok(@pids == 1 && $pids[0] == $pid, "Reaped all (and only) the processes forked.");
+}
+
+sub test_system {
+ my $subtest = shift;
+
+ my $expected_zeroes = 10;
+ my $got_zeroes = 0;
+
+ # This test is looking for a race between system()'s waitpid() and a
+ # signal handler. Looping a few times increases the chances of
+ # catching the error.
+
+ for (1..$expected_zeroes) {
+ $got_zeroes++ unless system(TRUE);
+ }
+
+ is(
+ $got_zeroes, $expected_zeroes,
+ "system() $subtest succeeded $got_zeroes times out of $expected_zeroes"
+ );
+}
--
1.7.5.4
|
From @LeontOn Thu, Dec 29, 2011 at 12:06 AM, Leon Timmermans <fawaka@gmail.com> wrote:
Fixed the patch to use the new perl instead of the system perl to Leon |
From @Leont0002-Added-tests-for-SIGCHLD-blocking-during-system.patchFrom 44f842713e2ec6de544abbff3aaf9a88f857c1bc Mon Sep 17 00:00:00 2001
From: Leon Timmermans <fawaka@gmail.com>
Date: Wed, 28 Dec 2011 23:46:54 +0200
Subject: [PATCH 2/2] Added tests for SIGCHLD blocking during system()
---
t/op/sigdispatch.t | 56 ++++++++++++++++++++++++++++++++++++++++++++++++++-
1 files changed, 54 insertions(+), 2 deletions(-)
diff --git a/t/op/sigdispatch.t b/t/op/sigdispatch.t
index 3b8d6ec..6b0ba59 100644
--- a/t/op/sigdispatch.t
+++ b/t/op/sigdispatch.t
@@ -9,9 +9,9 @@ BEGIN {
use strict;
use Config;
-plan tests => 26;
+plan tests => 29;
-watchdog(15);
+watchdog(25);
$SIG{ALRM} = sub {
die "Alarm!\n";
@@ -137,3 +137,55 @@ like $@, qr/No such hook: __DIE__\\0whoops at/;
$SIG{"KILL\0"} = sub { 1 };
like $w, qr/No such signal: SIGKILL\\0 at/, 'Arbitrary signal lookup through %SIG is clean';
}
+
+use constant TRUE => ('perl', '-e', 'exit 0');
+
+SKIP: {
+ skip '', 3 if is_miniperl() or not exists $SIG{CHLD};
+ require POSIX;
+ require Time::HiRes;
+
+ my $pid = fork // die "Can't fork: $!";
+ unless ($pid) {
+ note("Child PID: $$");
+ Time::HiRes::sleep(0.250);
+ exit;
+ }
+
+ test_system('without reaper');
+
+ my @pids;
+ $SIG{CHLD} = sub {
+ while (waitpid(-1, POSIX::WNOHANG()) > 0) {
+ note "Reaped: $pid";
+ push @pids, $pid;
+ }
+ };
+
+ test_system('with reaper');
+
+ note("Waiting briefly for SIGCHLD...");
+ Time::HiRes::sleep(0.500);
+
+ ok(@pids == 1 && $pids[0] == $pid, "Reaped all (and only) the processes forked.");
+}
+
+sub test_system {
+ my $subtest = shift;
+
+ my $expected_zeroes = 10;
+ my $got_zeroes = 0;
+
+ # This test is looking for a race between system()'s waitpid() and a
+ # signal handler. Looping a few times increases the chances of
+ # catching the error.
+
+ for (1..$expected_zeroes) {
+ $got_zeroes++ unless system(TRUE);
+ }
+
+ is(
+ $got_zeroes, $expected_zeroes,
+ "system() $subtest succeeded $got_zeroes times out of $expected_zeroes"
+ );
+}
--
1.7.5.4
|
From @LeontOn Thu, Dec 29, 2011 at 12:41 PM, Leon Timmermans <fawaka@gmail.com> wrote:
And now for real… Leon |
From @Leont0002-Added-tests-for-SIGCHLD-blocking-during-system.patchFrom 3856004c9dd9bc49a14ab65b7526fc97e1208828 Mon Sep 17 00:00:00 2001
From: Leon Timmermans <fawaka@gmail.com>
Date: Wed, 28 Dec 2011 23:46:54 +0200
Subject: [PATCH 2/2] Added tests for SIGCHLD blocking during system()
---
t/op/sigdispatch.t | 56 ++++++++++++++++++++++++++++++++++++++++++++++++++-
1 files changed, 54 insertions(+), 2 deletions(-)
diff --git a/t/op/sigdispatch.t b/t/op/sigdispatch.t
index 3b8d6ec..e4e6207 100644
--- a/t/op/sigdispatch.t
+++ b/t/op/sigdispatch.t
@@ -9,9 +9,9 @@ BEGIN {
use strict;
use Config;
-plan tests => 26;
+plan tests => 29;
-watchdog(15);
+watchdog(25);
$SIG{ALRM} = sub {
die "Alarm!\n";
@@ -137,3 +137,55 @@ like $@, qr/No such hook: __DIE__\\0whoops at/;
$SIG{"KILL\0"} = sub { 1 };
like $w, qr/No such signal: SIGKILL\\0 at/, 'Arbitrary signal lookup through %SIG is clean';
}
+
+use constant TRUE => ($^X, '-e', 'exit 0');
+
+SKIP: {
+ skip '', 3 if is_miniperl() or not exists $SIG{CHLD};
+ require POSIX;
+ require Time::HiRes;
+
+ my $pid = fork // die "Can't fork: $!";
+ unless ($pid) {
+ note("Child PID: $$");
+ Time::HiRes::sleep(0.250);
+ exit;
+ }
+
+ test_system('without reaper');
+
+ my @pids;
+ $SIG{CHLD} = sub {
+ while (waitpid(-1, POSIX::WNOHANG()) > 0) {
+ note "Reaped: $pid";
+ push @pids, $pid;
+ }
+ };
+
+ test_system('with reaper');
+
+ note("Waiting briefly for SIGCHLD...");
+ Time::HiRes::sleep(0.500);
+
+ ok(@pids == 1 && $pids[0] == $pid, "Reaped all (and only) the processes forked.");
+}
+
+sub test_system {
+ my $subtest = shift;
+
+ my $expected_zeroes = 10;
+ my $got_zeroes = 0;
+
+ # This test is looking for a race between system()'s waitpid() and a
+ # signal handler. Looping a few times increases the chances of
+ # catching the error.
+
+ for (1..$expected_zeroes) {
+ $got_zeroes++ unless system(TRUE);
+ }
+
+ is(
+ $got_zeroes, $expected_zeroes,
+ "system() $subtest succeeded $got_zeroes times out of $expected_zeroes"
+ );
+}
--
1.7.5.4
|
From @cpansproutOn Thu Dec 29 02:42:48 2011, LeonT wrote:
I think you resubmitted the same patch. Anyway, I’m getting test failures after applying this and your patch to ... Before applying the fix, I got two ‘not oks’: ok 25 I’m not even going to pretend I understand any of this. -- Father Chrysostomos |
From @cpansproutOn Thu Dec 29 06:15:52 2011, sprout wrote:
And now when I run it the tests pass. The weather hasn’t changed the -- Father Chrysostomos |
From tchrist@perl.comFather Chrysostomos wrote:
Funny you should mention that. http://news.slashdot.org/story/11/12/29/1425232/sun-storms-may-affect-radios-cell-phones-today --tom |
From @LeontOn Thu, Dec 29, 2011 at 4:15 PM, Father Chrysostomos via RT
I did, see my email a few hours later that did contain a different patch
My patch is fucked. I wasn't paying enough attention, it's not testing
Then I'll pretend I do ;-) Leon |
From @LeontOn Thu, Dec 29, 2011 at 11:34 PM, Leon Timmermans <fawaka@gmail.com> wrote:
I think this one is better. Leon |
From @Leont0002-Added-tests-for-SIGCHLD-blocking-during-system.patchFrom 6082975c0b6fd141f919ee2276a6afbdb951c2a4 Mon Sep 17 00:00:00 2001
From: Leon Timmermans <fawaka@gmail.com>
Date: Fri, 30 Dec 2011 20:02:07 +0200
Subject: [PATCH 2/2] Added tests for SIGCHLD blocking during system()
---
MANIFEST | 1 +
t/op/sigsystem.t | 63 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 64 insertions(+), 0 deletions(-)
create mode 100644 t/op/sigsystem.t
diff --git a/MANIFEST b/MANIFEST
index 53acd0c..d4a9c63 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -5265,6 +5265,7 @@ t/op/runlevel.t See if die() works from perl_call_*()
t/op/select.t See if 0- and 1-argument select works
t/op/setpgrpstack.t See if setpgrp works
t/op/sigdispatch.t See if signals are always dispatched
+t/op/sigsystem.t See if system and SIGCHLD handlers play together nicely
t/op/sleep.t See if sleep works
t/op/smartkve.t See if smart deref for keys/values/each works
t/op/smartmatch.t See if the ~~ operator works
diff --git a/t/op/sigsystem.t b/t/op/sigsystem.t
new file mode 100644
index 0000000..0197ad9
--- /dev/null
+++ b/t/op/sigsystem.t
@@ -0,0 +1,63 @@
+#!perl -w
+
+BEGIN {
+ require './test.pl';
+}
+
+use strict;
+use constant TRUE => ($^X, '-e', 'exit 0');
+use Data::Dumper;
+
+plan tests => 4;
+
+SKIP: {
+ skip 'Platform doesn\'t support SIGCHLD', 3 if is_miniperl() or not exists $SIG{CHLD};
+ require POSIX;
+ require Time::HiRes;
+
+ my $pid = fork // die "Can't fork: $!";
+ unless ($pid) {
+ note("Child PID: $$");
+ Time::HiRes::sleep(0.250);
+ POSIX::_exit(0);
+ }
+
+ test_system('without reaper');
+
+ my @pids;
+ $SIG{CHLD} = sub {
+ while ((my $child = waitpid(-1, POSIX::WNOHANG())) > 0) {
+ note "Reaped: $child";
+ push @pids, $child;
+ }
+ };
+
+ test_system('with reaper');
+
+ note("Waiting briefly for SIGCHLD...");
+ Time::HiRes::sleep(0.500);
+
+ ok(@pids == 1, 'Reaped only one process');
+ ok($pids[0] == $pid, "Reaped the right process.") or diag(Dumper(\@pids));
+}
+
+sub test_system {
+ my $subtest = shift;
+
+ my $expected_zeroes = 10;
+ my $got_zeroes = 0;
+
+ # This test is looking for a race between system()'s waitpid() and a
+ # signal handler. Looping a few times increases the chances of
+ # catching the error.
+
+ for (1..$expected_zeroes) {
+ $got_zeroes++ unless system(TRUE);
+ }
+
+ is(
+ $got_zeroes, $expected_zeroes,
+ "system() $subtest succeeded $got_zeroes times out of $expected_zeroes"
+ );
+}
+
--
1.7.5.4
|
From @cpansproutOn Fri Dec 30 10:22:50 2011, LeonT wrote:
Thank you. Applied as c56bc16 and the fix as b1cf9e9. -- Father Chrysostomos |
|
@cpansprout - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#105700 (status was 'resolved')
Searchable as RT105700$
The text was updated successfully, but these errors were encountered: