From: Eric Brine <ikegami@adaelis.com>
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<open(FOO, "-|")> 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<waitpid $pid, 0> when you're done with the process.
Failing to do this can result in an accumulation of defunct or "zombie"
processes. See L<perlfunc/waitpid> 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";
}
}