| Subject: | Catching a signal during select() can lock up IPC::Run |
Observed on Linux (ubuntu with perl 5.10.0 and centos with 5.8.8), if a
process catches a signal while in IPC::Run's select() call, select()
returns -1 and sets errno to EINTR. IPC::Run ignores this and proceeds
as if select() had returned normally:
lib/IPC/Run.pm line 3061:
croak "$! in select" if $nfound < 0 and $! != POSIX::EINTR;
The problem is that because select() was interrupted it returns without
modifying the bit vectors, so they still hold the set of FDs of interest
rather than the set of ready FDs. In other words, catching a signal in
select() fools IPC::Run into thinking that every FD that it asked about
is now ready. It can then block as it tries to read from a non-ready FD.
Test and fix in the attached patch.
| Subject: | ipc-run-eintr.patch |
diff --git a/lib/IPC/Run.pm b/lib/IPC/Run.pm
index 5ebdc70..3acc4a6 100644
--- a/lib/IPC/Run.pm
+++ b/lib/IPC/Run.pm
@@ -3058,7 +3058,17 @@ SELECT:
}
last if ! $nfound && $self->{non_blocking};
- croak "$! in select" if $nfound < 0 and $! != POSIX::EINTR;
+ if ($nfound < 0) {
+ if ($! == POSIX::EINTR) {
+ # Caught a signal before any FD went ready. Ensure that
+ # the bit fields reflect "no FDs ready".
+ $self->{ROUT} = $self->{WOUT} = $self->{EOUT} = '';
+ $nfound = 0;
+ }
+ else {
+ croak "$! in select";
+ }
+ }
## TODO: Analyze the EINTR failure mode and see if this patch
## is adequate and optimal.
## TODO: Add an EINTR test to the test suite.
diff --git a/t/eintr.t b/t/eintr.t
new file mode 100644
index 0000000..c04f16f
--- /dev/null
+++ b/t/eintr.t
@@ -0,0 +1,60 @@
+#!/usr/bin/perl
+
+=pod
+
+=head1 NAME
+
+eintr.t - Test select() failing with EINTR
+
+=cut
+
+use strict;
+BEGIN {
+ $| = 1;
+ $^W = 1;
+ if( $ENV{PERL_CORE} ) {
+ chdir '../lib/IPC/Run' if -d '../lib/IPC/Run';
+ unshift @INC, 'lib', '../..';
+ $^X = '../../../t/' . $^X;
+ }
+}
+
+use Test::More;
+use IPC::Run qw( start run );
+
+
+my $got_usr1 = 0;
+$SIG{USR1} = sub { $got_usr1++ };
+
+# Need the child to send a signal to this process in order to trigger
+# EINTR on select(), skip the test on platforms where we can't do that.
+my ($in, $out, $err) = ('', '', '');
+run [$^X, '-e', "kill 'USR1', $$"], \$in, \$out, \$err;
+if ($got_usr1 != 1) {
+ plan skip_all => "can't deliver a signal on this platform";
+}
+
+plan tests => 3;
+
+# A kid that will send SIGUSR1 to this process and then produce some output.
+my $kid_perl = qq[sleep 1; kill 'USR1', $$; sleep 1; print "foo\n"; sleep 10];
+my @kid = ( $^X, '-e', "\$| = 1; $kid_perl" );
+
+# If EINTR on select() is not handled properly then IPC::Run can think
+# that one or more kid output handles are ready for reads when they are
+# not, causing it to block until the kid exits.
+
+($in, $out, $err) = ('', '', '');
+my $harness = start \@kid, \$in, \$out, \$err;
+
+my $pump_started = time;
+$harness->pump;
+
+is $out, "foo\n", "got stdout on the first pump";
+
+ok time - $pump_started < 5, "first pump didn't wait for kid exit";
+
+is $got_usr1, 2, 'got USR1 from the kid';
+
+$harness->kill_kill;
+$harness->finish;