Skip to content

Commit

Permalink
Retry _read() on EINTR, instead of losing pipe contents.
Browse files Browse the repository at this point in the history
By not retrying, EINTR behaved like EOF.  In other words, EINTR had
consequences like the write side (kid side) closing the pipe early.
Symptoms depended on the _read() caller.  When $pipe_reader conflated
EINTR with pipe closure, symptoms were application-specific.  When
_spawn reading the internal "sync pipe" conflated EINTR with pipe
closure, the parent would fail to report exec failure.  Add a test for
the loss of exec failure report.  The $pipe_reader problem is much
tougher to test, because $pipe_reader only tries read() if select()
found data available.  Hence, the signal needs to arrive in the narrow
window after read() enters the kernel, before read() returns
already-available data.  The issue report reproduced that on macOS only.

Fixes cpan-authors#176
  • Loading branch information
nmisch committed Oct 12, 2024
1 parent 85ed0b9 commit baf0824
Show file tree
Hide file tree
Showing 2 changed files with 34 additions and 4 deletions.
14 changes: 12 additions & 2 deletions lib/IPC/Run.pm
Original file line number Diff line number Diff line change
Expand Up @@ -1545,8 +1545,11 @@ sub _pty {
sub _read {
confess 'undef' unless defined $_[0];
my $s = '';
my $r = POSIX::read( $_[0], $s, 10_000 );
croak "$!: read( $_[0] )" if not($r) and !$!{EINTR};
my $r;
do {
$r = POSIX::read( $_[0], $s, 10_000 );
} while ( !defined($r) && $!{EINTR} );
croak "$!: read( $_[0] )" unless defined($r);
$r ||= 0;
_debug "read( $_[0] ) = $r chars '$s'" if _debugging_data;
return $s;
Expand All @@ -1567,6 +1570,13 @@ sub _spawn {
croak "$! during fork" unless defined $kid->{PID};

unless ( $kid->{PID} ) {
if ( $self->{_sigusr1_after_fork} ) {

# sleep 10ms to improve chance of parent starting read() before it
# handles the signal we're about to send.
select undef, undef, undef, 0.01;
kill 'USR1', getppid;
}
## _do_kid_and_exit closes sync_reader_fd since it closes all unwanted and
## unloved fds.
$self->_do_kid_and_exit($kid);
Expand Down
24 changes: 22 additions & 2 deletions t/eintr.t
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@
=head1 NAME
eintr.t - Test select() failing with EINTR
eintr.t - Test select() and read() failing with EINTR
=cut

Expand Down Expand Up @@ -35,7 +35,7 @@ if ( $got_usr1 != 1 ) {
plan skip_all => "can't deliver a signal on this platform";
}

plan tests => 3;
plan tests => 5;

# 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 180];
Expand All @@ -59,3 +59,23 @@ is $got_usr1, 2, 'got USR1 from the kid';

$harness->kill_kill;
$harness->finish;

# Have kid send SIGUSR1 while we're in read of sync pipe. That pipe conveys any
# exec failure to us.
SKIP: {
if ( IPC::Run::Win32_MODE() ) {
skip "Can't really exec() $^O", 1;
}

my $expected = 'exec failed';
my $h = eval {
start(
[ $^X, "-e", 1 ],
_sigusr1_after_fork => 1,
_simulate_exec_failure => 1
);
};
my $got = $@ =~ $expected ? $expected : $@ || "";
is $got_usr1, 3, 'got USR1 from the _simulate_exec_failure kid';
is( $got, $expected, "reported exec failure despite USR1" );
}

0 comments on commit baf0824

Please sign in to comment.