From: Eric Brine Date: Mon, 18 Jan 2010 18:21:20 +0000 (-0800) Subject: open3 errors in child croak parent RT#72016 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8960aa876f446ad29b892204eeb41fc724123dcb;p=p5sagit%2Fp5-mst-13.2.git open3 errors in child croak parent RT#72016 Errors in open3 no longer appear to originate from the executed command on forking systems. --- diff --git a/ext/IPC-Open3/lib/IPC/Open3.pm b/ext/IPC-Open3/lib/IPC/Open3.pm index 82c20ae..c367758 100644 --- a/ext/IPC-Open3/lib/IPC/Open3.pm +++ b/ext/IPC-Open3/lib/IPC/Open3.pm @@ -48,7 +48,7 @@ instead of a pipe(2) made. If either reader or writer is the null string, this will be replaced by an autogenerated filehandle. If so, you must pass a valid lvalue -in the parameter slot so it can be overwritten in the caller, or +in the parameter slot so it can be overwritten in the caller, or an exception will be raised. The filehandles may also be integers, in which case they are understood @@ -68,9 +68,9 @@ C the child process will just be the forked Perl process rather than an external command. This feature isn't yet supported on Win32 platforms. -open3() does not wait for and reap the child process after it exits. +open3() does not wait for and reap the child process after it exits. Except for short programs where it's acceptable to let the operating system -take care of this, you need to do this yourself. This is normally as +take care of this, you need to do this yourself. This is normally as simple as calling C when you're done with the process. Failing to do this can result in an accumulation of defunct or "zombie" processes. See L for more information. @@ -161,6 +161,18 @@ sub xpipe { pipe $_[0], $_[1] or croak "$Me: pipe($_[0], $_[1]) failed: $!"; } +sub xpipe_anon { + pipe $_[0], $_[1] or croak "$Me: pipe failed: $!"; +} + +sub xclose_on_exec { + require Fcntl; + my $flags = fcntl($_[0], &Fcntl::F_GETFD, 0) + or croak "$Me: fcntl failed: $!"; + fcntl($_[0], &Fcntl::F_SETFD, $flags|&Fcntl::FD_CLOEXEC) + or croak "$Me: fcntl failed: $!"; +} + # I tried using a * prototype character for the filehandle but it still # disallows a bearword while compiling under strict subs. @@ -199,12 +211,12 @@ sub _open3 { unless (eval { $dad_wtr = $_[1] = gensym unless defined $dad_wtr && length $dad_wtr; $dad_rdr = $_[2] = gensym unless defined $dad_rdr && length $dad_rdr; - 1; }) + 1; }) { # must strip crud for croak to add back, or looks ugly $@ =~ s/(?<=value attempted) at .*//s; croak "$Me: $@"; - } + } $dad_err ||= $dad_rdr; @@ -225,54 +237,89 @@ sub _open3 { xpipe $dad_rdr, $kid_wtr if !$dup_rdr; xpipe $dad_err, $kid_err if !$dup_err && $dad_err ne $dad_rdr; - $kidpid = DO_SPAWN ? -1 : xfork; - if ($kidpid == 0) { # Kid - # A tie in the parent should not be allowed to cause problems. - untie *STDIN; - untie *STDOUT; - # If she wants to dup the kid's stderr onto her stdout I need to - # save a copy of her stdout before I put something else there. - if ($dad_rdr ne $dad_err && $dup_err - && xfileno($dad_err) == fileno(STDOUT)) { - my $tmp = gensym; - xopen($tmp, ">&$dad_err"); - $dad_err = $tmp; - } + if (!DO_SPAWN) { + # Used to communicate exec failures. + xpipe my $stat_r, my $stat_w; + + $kidpid = xfork; + if ($kidpid == 0) { # Kid + eval { + # A tie in the parent should not be allowed to cause problems. + untie *STDIN; + untie *STDOUT; + + close $stat_r; + xclose_on_exec $stat_w; + + # If she wants to dup the kid's stderr onto her stdout I need to + # save a copy of her stdout before I put something else there. + if ($dad_rdr ne $dad_err && $dup_err + && xfileno($dad_err) == fileno(STDOUT)) { + my $tmp = gensym; + xopen($tmp, ">&$dad_err"); + $dad_err = $tmp; + } + + if ($dup_wtr) { + xopen \*STDIN, "<&$dad_wtr" if fileno(STDIN) != xfileno($dad_wtr); + } else { + xclose $dad_wtr; + xopen \*STDIN, "<&=" . fileno $kid_rdr; + } + if ($dup_rdr) { + xopen \*STDOUT, ">&$dad_rdr" if fileno(STDOUT) != xfileno($dad_rdr); + } else { + xclose $dad_rdr; + xopen \*STDOUT, ">&=" . fileno $kid_wtr; + } + if ($dad_rdr ne $dad_err) { + if ($dup_err) { + # I have to use a fileno here because in this one case + # I'm doing a dup but the filehandle might be a reference + # (from the special case above). + xopen \*STDERR, ">&" . xfileno($dad_err) + if fileno(STDERR) != xfileno($dad_err); + } else { + xclose $dad_err; + xopen \*STDERR, ">&=" . fileno $kid_err; + } + } else { + xopen \*STDERR, ">&STDOUT" if fileno(STDERR) != fileno(STDOUT); + } + return 0 if ($cmd[0] eq '-'); + exec @cmd or do { + local($")=(" "); + croak "$Me: exec of @cmd failed"; + }; + }; + + my $bang = 0+$!; + my $err = $@; + utf8::encode $err if $] >= 5.008; + print $stat_w pack('IIa*', $bang, length($err), $err); + close $stat_w; - if ($dup_wtr) { - xopen \*STDIN, "<&$dad_wtr" if fileno(STDIN) != xfileno($dad_wtr); - } else { - xclose $dad_wtr; - xopen \*STDIN, "<&=" . fileno $kid_rdr; - } - if ($dup_rdr) { - xopen \*STDOUT, ">&$dad_rdr" if fileno(STDOUT) != xfileno($dad_rdr); - } else { - xclose $dad_rdr; - xopen \*STDOUT, ">&=" . fileno $kid_wtr; + eval { require POSIX; POSIX::_exit(255); }; + exit 255; } - if ($dad_rdr ne $dad_err) { - if ($dup_err) { - # I have to use a fileno here because in this one case - # I'm doing a dup but the filehandle might be a reference - # (from the special case above). - xopen \*STDERR, ">&" . xfileno($dad_err) - if fileno(STDERR) != xfileno($dad_err); - } else { - xclose $dad_err; - xopen \*STDERR, ">&=" . fileno $kid_err; + else { # Parent + close $stat_w; + my $to_read = length(pack('I', 0)) * 2; + my $bytes_read = read($stat_r, my $buf = '', $to_read); + if ($bytes_read) { + (my $bang, $to_read) = unpack('II', $buf); + read($stat_r, my $err = '', $to_read); + if ($err) { + utf8::decode $err if $] >= 5.008; + } else { + $err = "$Me: " . ($! = $bang); + } + $! = $bang; + die($err); } - } else { - xopen \*STDERR, ">&STDOUT" if fileno(STDERR) != fileno(STDOUT); } - return 0 if ($cmd[0] eq '-'); - local($")=(" "); - exec @cmd or do { - carp "$Me: exec of @cmd failed"; - eval { require POSIX; POSIX::_exit(255); }; - exit 255; - }; - } elsif (DO_SPAWN) { + } + else { # DO_SPAWN # All the bookkeeping of coincidence between handles is # handled in spawn_with_handles. diff --git a/ext/IPC-Open3/t/IPC-Open3.t b/ext/IPC-Open3/t/IPC-Open3.t index 849b0ba..23ca8e5 100644 --- a/ext/IPC-Open3/t/IPC-Open3.t +++ b/ext/IPC-Open3/t/IPC-Open3.t @@ -157,14 +157,9 @@ if (IPC::Open3::DO_SPAWN) { } } else { if ($@) { - # exec failure should throw exception in parent. - print "ok 23 # TODO RT 72016\n"; + print "ok 23\n"; } else { - if (waitpid($pid, 0) > 0) { - # exec failure currently appears as child error. - print "not ok 23 # TODO RT 72016\n"; - } else { - print "not ok 23\n"; - } + waitpid($pid, 0); + print "not ok 23\n"; } }