Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

IPC::Open2, IPC::Open3 feature request: report exec failures separately #10072

Closed
p5pRT opened this issue Jan 11, 2010 · 26 comments
Closed

IPC::Open2, IPC::Open3 feature request: report exec failures separately #10072

p5pRT opened this issue Jan 11, 2010 · 26 comments

Comments

@p5pRT
Copy link

p5pRT commented Jan 11, 2010

Migrated from rt.perl.org#72016 (status was 'resolved')

Searchable as RT72016$

@p5pRT
Copy link
Author

p5pRT commented Jan 11, 2010

From @epa

Created by @epa

When using IPC​::Open2 or IPC​::Open3 to run an external program,
if the exec() itself fails, then a process id is still returned
and the child process exits with status 255. This is problematic,
because it provides no way to distinguish between a child process
that ran and gave 255 as its status, and one that didn't run at all.
Perl's builtin system(), on the other hand, does allow you to
distinguish these two cases, by setting $? to -1.

  use 5.010;
  use IPC​::Open3;
  system 'nonexistent';
  say $?;
  my $pid = open3(\*CHLD_IN, \*CHLD_OUT, \*CHLD_ERR, 'nonexistent');
  waitpid $pid, 0;
  say $?;

It would be good for open2() and open3() to use the same convention as
system(), and set $? to -1 if exec() or wait() or waitpid() fail, with
more details in $!. In such cases the returned pid would be zero.

I know that often it is difficult for user code to follow the familiar
convention of putting an error code in $!, so if that is not possible,
some other way of reporting the exec failure could be used, such as
throwing an exception.

Perl Info

Flags:
    category=library
    severity=wishlist

This perlbug was built using Perl 5.10.0 in the Fedora build system.
It is being executed now by Perl 5.10.0 - Thu Sep  3 12:24:00 EDT 2009.

Site configuration information for perl 5.10.0:

Configured by Red Hat, Inc. at Thu Sep  3 12:24:00 EDT 2009.

Summary of my perl5 (revision 5 version 10 subversion 0) configuration:
  Platform:
    osname=linux, osvers=2.6.18-128.4.1.el5xen, archname=x86_64-linux-thread-multi
    uname='linux xenbuilder4.fedora.phx.redhat.com 2.6.18-128.4.1.el5xen #1 smp thu jul 23 20:15:43 edt 2009 x86_64 x86_64 x86_64 gnulinux '
    config_args='-des -Doptimize=-O2 -g -pipe -Wall -Wp,-D_FORTIFY_SOURCE=2 -fexceptions -fstack-protector --param=ssp-buffer-size=4 -m64 -mtune=generic -Accflags=-DPERL_USE_SAFE_PUTENV -Dversion=5.10.0 -Dmyhostname=localhost -Dperladmin=root@localhost -Dcc=gcc -Dcf_by=Red Hat, Inc. -Dprefix=/usr -Dvendorprefix=/usr -Dsiteprefix=/usr/local -Dprivlib=/usr/lib/perl5/5.10.0 -Dsitelib=/usr/local/lib/perl5/site_perl/5.10.0 -Dvendorlib=/usr/lib/perl5/vendor_perl/5.10.0 -Darchlib=/usr/lib64/perl5/5.10.0/x86_64-linux-thread-multi -Dsitearch=/usr/local/lib64/perl5/site_perl/5.10.0/x86_64-linux-thread-multi -Dvendorarch=/usr/lib64/perl5/vendor_perl/5.10.0/x86_64-linux-thread-multi -Dinc_version_list=none -Darchname=x86_64-linux-thread-multi -Dlibpth=/usr/local/lib64 /lib64 /usr/lib64 -Duseshrplib -Dusethreads -Duseithreads -Duselargefiles -Dd_dosuid -Dd_semctl_semun -Di_db -Ui_ndbm -Di_gdbm -Di_shadow -Di_syslog -Dman3ext=3pm -Duseperlio -Dinstallusrbinperl=n -Ubincompat5005 -Uversiononly -Dpager=/usr/bin/less -isr -Dd_gethostent_r_proto -Ud_endhostent_r_proto -Ud_sethostent_r_proto -Ud_endprotoent_r_proto -Ud_setprotoent_r_proto -Ud_endservent_r_proto -Ud_setservent_r_proto -Dscriptdir=/usr/bin -Dotherlibdirs=/usr/lib/perl5/site_perl'
    hint=recommended, useposix=true, d_sigaction=define
    useithreads=define, usemultiplicity=define
    useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
    use64bitint=define, use64bitall=define, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='gcc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DPERL_USE_SAFE_PUTENV -DDEBUGGING -fno-strict-aliasing -pipe -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -I/usr/include/gdbm',
    optimize='-O2 -g -pipe -Wall -Wp,-D_FORTIFY_SOURCE=2 -fexceptions -fstack-protector --param=ssp-buffer-size=4 -m64 -mtune=generic',
    cppflags='-D_REENTRANT -D_GNU_SOURCE -DPERL_USE_SAFE_PUTENV -DDEBUGGING -fno-strict-aliasing -pipe -I/usr/local/include -I/usr/include/gdbm'
    ccversion='', gccversion='4.4.1 20090902 (Red Hat 4.4.1-8)', gccosandvers=''
    intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
    ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=8, prototype=define
  Linker and Libraries:
    ld='gcc', ldflags =''
    libpth=/usr/local/lib64 /lib64 /usr/lib64
    libs=-lresolv -lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lpthread -lc
    perllibs=-lresolv -lnsl -ldl -lm -lcrypt -lutil -lpthread -lc
    libc=, so=so, useshrplib=true, libperl=libperl.so
    gnulibc_version='2.10.90'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E -Wl,-rpath,/usr/lib64/perl5/5.10.0/x86_64-linux-thread-multi/CORE'
    cccdlflags='-fPIC', lddlflags='-shared -O2 -g -pipe -Wall -Wp,-D_FORTIFY_SOURCE=2 -fexceptions -fstack-protector --param=ssp-buffer-size=4 -m64 -mtune=generic'

Locally applied patches:
    


@INC for perl 5.10.0:
    /home/eda/lib/perl5/5.10.0
    /home/eda/lib/perl5/site_perl/5.10.0
    /usr/local/lib64/perl5/site_perl/5.10.0/x86_64-linux-thread-multi
    /usr/local/lib/perl5/site_perl/5.10.0
    /usr/lib64/perl5/vendor_perl/5.10.0/x86_64-linux-thread-multi
    /usr/lib/perl5/vendor_perl/5.10.0
    /usr/lib/perl5/vendor_perl
    /usr/lib64/perl5/5.10.0/x86_64-linux-thread-multi
    /usr/lib/perl5/5.10.0
    /usr/lib/perl5/site_perl/5.10.0
    /usr/lib/perl5/site_perl
    .


Environment for perl 5.10.0:
    HOME=/home/eda
    LANG=en_GB.UTF-8
    LANGUAGE (unset)
    LC_COLLATE=C
    LC_CTYPE=en_GB.UTF-8
    LC_MESSAGES=en_GB.UTF-8
    LC_MONETARY=en_GB.UTF-8
    LC_NUMERIC=en_GB.UTF-8
    LC_TIME=en_GB.UTF-8
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/home/eda/bin:/home/eda/bin:/home/eda/bin:/usr/lib64/qt-3.3/bin:/usr/kerberos/sbin:/usr/kerberos/bin:/usr/lib64/ccache:/usr/local/bin:/bin:/usr/bin:/sbin:/usr/sbin:/sbin:/usr/sbin:/sbin:/usr/sbin
    PERL5LIB=/home/eda/lib/perl5/5.10.0:/home/eda/lib/perl5/site_perl/5.10.0
    PERL_BADLANG (unset)
    SHELL=/bin/bash

______________________________________________________________________
This email has been scanned by the MessageLabs Email Security System.
For more information please visit http://www.messagelabs.com/email 
______________________________________________________________________

@p5pRT
Copy link
Author

p5pRT commented Jan 11, 2010

From @epa

I should add, I am not sure whether it is possible to implement what I ask for.
Presumably IPC​::Open2 first fork()s a child process, which then asynchronously
does the exec(), so even when running a nonexistent binary you'd still have to
return a pid to the caller and then report the 'no such file or directory'
at some later point, perhaps after the caller has wait()ed for the child to exit.

Getting -1 into the $? variable might be difficult, even though the builtin
system() does it.

But I feel there should be some way to report exec() failures correctly with
the right information, rather than squashing them all into exit status 255.
The wise heads on this list might have some idea how to do it.

--
Ed Avis <eda@​waniasset.com>

______________________________________________________________________
This email has been scanned by the MessageLabs Email Security System.
For more information please visit http​://www.messagelabs.com/email
______________________________________________________________________

@p5pRT
Copy link
Author

p5pRT commented Jan 11, 2010

From @ikegami

On Mon, Jan 11, 2010 at 8​:28 AM, Ed Avis <eda@​waniasset.com> wrote​:

Getting -1 into the $? variable might be difficult, even though the builtin
system() does it.

perl -le"$? = -1; print $?"
-1

Guess not.

@p5pRT
Copy link
Author

p5pRT commented Jan 11, 2010

The RT System itself - Status changed from 'new' to 'open'

@p5pRT
Copy link
Author

p5pRT commented Jan 11, 2010

From @ikegami

On Mon, Jan 11, 2010 at 12​:05 PM, Eric Brine <ikegami@​adaelis.com> wrote​:

On Mon, Jan 11, 2010 at 8​:28 AM, Ed Avis <eda@​waniasset.com> wrote​:

Getting -1 into the $? variable might be difficult, even though the
builtin
system() does it.

perl -le"$? = -1; print $?"
-1

Guess not.

Oh, you meant for the child to place -1 in the parent's $?, and the error
code in the parent's $!.

@p5pRT
Copy link
Author

p5pRT commented Jan 11, 2010

From @epa

Eric Brine <ikegami@​adaelis.com> wrote​:

Oh, you meant for the child to place -1 in the parent's $?,
and the error code in the parent's $!.

Well, partly that, which is a question of interprocess communication,
and partly the Perl-specific question of whether user code can
assign to magic variables like $? and $!. I know that getting an
error code into $! (so that a tied filehandle can return reasonable
error messages, for example) is difficult. It seems that assigning to
$? works, but it's not documented exactly what the semantics of doing
so are (except when setting it in an END block); over the years I've
been conditioned to avoid doing anything clever to builtin variables
other than $_, because they often do unexpected things. But you may
be right that a simple assigment to $? is a safe way to pass this
information back up to the caller.

--
Ed Avis <eda@​waniasset.com>

______________________________________________________________________
This email has been scanned by the MessageLabs Email Security System.
For more information please visit http​://www.messagelabs.com/email
______________________________________________________________________

@p5pRT
Copy link
Author

p5pRT commented Jan 11, 2010

From @ikegami

On Mon, Jan 11, 2010 at 12​:15 PM, Ed Avis <eda@​waniasset.com> wrote​:

I know that getting an
error code into $! (so that a tied filehandle can return reasonable
error messages, for example) is difficult.

Maybe if you're trying to set custom messages. If you're trying to set it to
some valid error number, all you need to do is assign the error number. (You
can get them from module Errno). It's even documented.

$ perl -le'for (1..10) { $!=$_; print $!; }'
Operation not permitted
No such file or directory
No such process
Interrupted system call
Input/output error
No such device or address
Argument list too long
Exec format error
Bad file descriptor
No child processes

@p5pRT
Copy link
Author

p5pRT commented Jan 11, 2010

From @ikegami

On Mon, Jan 11, 2010 at 12​:15 PM, Ed Avis <eda@​waniasset.com> wrote​:

Eric Brine <ikegami@​adaelis.com> wrote​:

Oh, you meant for the child to place -1 in the parent's $?,
and the error code in the parent's $!.

Well, partly that, which is a question of interprocess communication,

I was wondering how system() managed this.

$ strace perl -e'system "nonexistant"'
...
getpid() = 24003
close(3) = 0
pipe([3, 4]) = 0
clone(child_stack=0, flags=CLONE_CHILD_CLEARTID|CLONE_CHILD_SETTID|SIGCHLD,
child_tidptr=0xb7d0eb18) = 24004
--- SIGCHLD (Child exited) @​ 0 (0) ---
close(4) = 0
rt_sigaction(SIGINT, {SIG_IGN}, {SIG_DFL}, 8) = 0
rt_sigaction(SIGQUIT, {SIG_IGN}, {SIG_DFL}, 8) = 0
waitpid(24004, [{WIFEXITED(s) && WEXITSTATUS(s) == 255}], 0) = 24004
rt_sigaction(SIGINT, {SIG_DFL}, NULL, 8) = 0
rt_sigaction(SIGQUIT, {SIG_DFL}, NULL, 8) = 0
read(3, "\2\0\0\0"..., 4) = 4
close(3) = 0
...

system creates a pipe, over which the value to store in $! is returned. (2,
in this case.)

I can write the patch if you want (tomorrow or soon after).

- Eric

@p5pRT
Copy link
Author

p5pRT commented Jan 12, 2010

From @epa

Eric Brine <ikegami@​adaelis.com> wrote​:

system creates a pipe, over which the value to store in $! is returned.

I don't completely understand how this works - surely after the child process
has performed an exec(), it can no longer write anything to the pipe, because
it's now running code from some other binary. If the exec() fails then of course
it can write to the pipe, but if it succeeds?

Yet all sorts of things (including the shell) are able to detect failed exec()
in a child process, so there must be some obvious point I'm missing.
 

I can write the patch if you want (tomorrow or soon after).

That would be great, I'm very curious to see how it can be done.

--
Ed Avis <eda@​waniasset.com>

______________________________________________________________________
This email has been scanned by the MessageLabs Email Security System.
For more information please visit http​://www.messagelabs.com/email
______________________________________________________________________

@p5pRT
Copy link
Author

p5pRT commented Jan 12, 2010

From ben@morrow.me.uk

Quoth eda@​waniasset.com (Ed Avis)​:

Eric Brine <ikegami@​adaelis.com> wrote​:

system creates a pipe, over which the value to store in $! is returned.

I don't completely understand how this works - surely after the child process
has performed an exec(), it can no longer write anything to the pipe, because
it's now running code from some other binary. If the exec() fails then
of course
it can write to the pipe, but if it succeeds?

The child's end of the pipe is set close-on-exec, so if the pipe is
closed with nothing written to it that means the exec succeeded.

Yet all sorts of things (including the shell) are able to detect failed exec()
in a child process, so there must be some obvious point I'm missing.

I don't know how the various shell implementations do it, but I suspect
it's not like this.

Ben

@p5pRT
Copy link
Author

p5pRT commented Jan 12, 2010

From @ikegami

On Mon, Jan 11, 2010 at 2​:53 PM, Eric Brine <ikegami@​adaelis.com> wrote​:

I can write the patch if you want (tomorrow or soon after).

On Tue, Jan 12, 2010 at 10​:01 AM, Ben Morrow <ben@​morrow.me.uk> wrote​:

The child's end of the pipe is set close-on-exec, so if the pipe is
closed with nothing written to it that means the exec succeeded.

Do you know if core provides a means of doing that?

@p5pRT
Copy link
Author

p5pRT commented Jan 12, 2010

From ben@morrow.me.uk

Quoth ikegami@​adaelis.com (Eric Brine)​:

On Mon, Jan 11, 2010 at 2​:53 PM, Eric Brine <ikegami@​adaelis.com> wrote​:

I can write the patch if you want (tomorrow or soon after).

On Tue, Jan 12, 2010 at 10​:01 AM, Ben Morrow <ben@​morrow.me.uk> wrote​:

The child's end of the pipe is set close-on-exec, so if the pipe is
closed with nothing written to it that means the exec succeeded.

Do you know if core provides a means of doing that?

Either use $^F (which is crude) or set the flag directly with

  use Fcntl;

  fcntl $FH, F_SETFD, FD_CLOEXEC;

Note that this probably won't work on non-Unix systems.

(Are there any systems which define any *other* F_{G,S}ETFD flags, which
would require getting the flags, oring in FD_CLOEXEC, and setting them
again?)

Ben

@p5pRT
Copy link
Author

p5pRT commented Jan 12, 2010

From @ikegami

On Tue, Jan 12, 2010 at 10​:01 AM, Ben Morrow <ben@​morrow.me.uk> wrote​:

The child's end of the pipe is set close-on-exec, so if the pipe is

closed with nothing written to it that means the exec succeeded.

I had looked for fcntl() in Fcntl, but I hadn't thought to look in perlfunc!

Looks like the handle is already close-on-exec in linux, but there's no
reason to assume that's always the case.

I can handle Windows, but I know nothing of VMS. Can it fork(), can it
close-on-exec using fcntl()?

Below is what I got t so far. test() returns the same as open3()​: An
exception or the pid of the child.

-------------------- BEGIN CODE --------------------
#!/usr/bin/perl

use strict;
use warnings;

use Errno qw( EAGAIN );
use Fcntl qw( F_GETFD F_SETFD FD_CLOEXEC );
use IO​::Handle qw( );
use POSIX qw( _exit );

# Override exec() to simulate failures
use subs qw( exec );
use vars qw( $EXEC_FAIL_CODE );
sub exec {
  if (!defined($EXEC_FAIL_CODE)) {
  return CORE​::exec(@​_);
  } else {
  $! = $EXEC_FAIL_CODE;
  return 0;
  }
}

sub test {
  my ($child_launched, $code) = @​_;

  pipe(my ($r, $w))
  or die "pipe​: $!\n";

  defined( my $pid = fork() )
  or die "fork​: $!\n";

  if (!$pid) {
  local $EXEC_FAIL_CODE = $child_launched ? undef : $code;

  my $flags = fcntl($w, F_GETFD, 0)
  or goto ERROR;

  fcntl($w, F_SETFD, $flags|FD_CLOEXEC)
  or goto ERROR;

  if (!exec(perl => ( -e => 'exit $ARGV[0]', $code ))) {
  ERROR​:
  print($w pack('I', $!));
  close($w);
  _exit(255);
  }
  }

  close($w);

  my $to_read = length(pack('I', 0));
  my $bytes_read = read($r, my $buf = '', $to_read);
  if ($bytes_read) {
  $! = unpack('I', $buf);
  die("exec​: $!\n");
  }

  return $pid;
}

my @​tests = (
  [ 'exec succeeding and child exiting with code 0', 1, 0 ],
  [ 'exec failing with $! == 2', 0, 2 ],
  [ 'exec failing with $! == 13', 0, 13 ],
  [ 'exec succeeding and child exiting with code 1', 1, 1 ],
  [ 'exec succeeding and child exiting with code 255', 1, 255 ],
);

for (@​tests) {
  my ($name, $child_launched, $code) = @​$_;
  print("\n") if $_ != $tests[0];
  print("Test $name\n");
  if (my $pid = eval { test($child_launched, $code) }) {
  if (!waitpid($pid, 0)) {
  warn("waitpid​: $!\n");
  next;
  }
  printf("Child exited with \$? = %04X\n", $?);
  } else {
  print("[Exception] $@​");
  }
}
-------------------- END CODE --------------------

-------------------- BEGIN OUTPUT --------------------
Test exec succeeding and child exiting with code 0
Child exited with $? = 0000

Test exec failing with $! == 2
[Exception] exec​: No such file or directory

Test exec failing with $! == 13
[Exception] exec​: Permission denied

Test exec succeeding and child exiting with code 1
Child exited with $? = 0100

Test exec succeeding and child exiting with code 255
Child exited with $? = FF00
-------------------- END OUTPUT --------------------

@p5pRT
Copy link
Author

p5pRT commented Jan 13, 2010

From @arc

Ben Morrow <ben@​morrow.me.uk> wrote​:

Are there any systems which define any *other* F_{G,S}ETFD flags, which
would require getting the flags, oring in FD_CLOEXEC, and setting them
again?

I've investigated that question in the past, and while I can't say
definitively that there aren't, I haven't found any.

--
Aaron Crane ** http​://aaroncrane.co.uk/

@p5pRT
Copy link
Author

p5pRT commented Jan 18, 2010

From @ikegami

Patch attached.

The first adds TODO tests.
The second fixes the bug and makes the tests "live".

@p5pRT
Copy link
Author

p5pRT commented Jan 18, 2010

From @ikegami

0001-Add-TODO-test-for-RT-72016.patch
From 47f948ab7d9571bcf1ad69f23287485ccbaa9674 Mon Sep 17 00:00:00 2001
From: Eric Brine <ikegami@adaelis.com>
Date: Sun, 17 Jan 2010 20:44:14 -0800
Subject: [PATCH 1/2] Add TODO test for RT#72016

---
 ext/IPC-Open3/t/IPC-Open3.t |   24 +++++++++++++++++++++++-
 1 files changed, 23 insertions(+), 1 deletions(-)

diff --git a/ext/IPC-Open3/t/IPC-Open3.t b/ext/IPC-Open3/t/IPC-Open3.t
index 79d5ced..849b0ba 100644
--- a/ext/IPC-Open3/t/IPC-Open3.t
+++ b/ext/IPC-Open3/t/IPC-Open3.t
@@ -47,7 +47,7 @@ my ($pid, $reaped_pid);
 STDOUT->autoflush;
 STDERR->autoflush;
 
-print "1..22\n";
+print "1..23\n";
 
 # basic
 ok 1, $pid = open3 'WRITE', 'READ', 'ERROR', $perl, '-e', cmd_line(<<'EOF');
@@ -146,3 +146,25 @@ else {
 	print WRITE "ok 22\n";
 	waitpid $pid, 0;
 }
+
+# RT 72016
+eval{$pid = open3 'WRITE', 'READ', 'ERROR', '/non/existant/program'; };
+if (IPC::Open3::DO_SPAWN) {
+    if ($@ || waitpid($pid, 0) > 0) {
+	print "ok 23\n";
+    } else {
+	print "not ok 23\n";
+    }
+} else {
+    if ($@) {
+	# exec failure should throw exception in parent.
+	print "ok 23 # TODO RT 72016\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";
+	}
+    }
+}
-- 
1.6.5.2

@p5pRT
Copy link
Author

p5pRT commented Jan 18, 2010

From @ikegami

0002-open3-errors-in-child-croak-parent-RT-72016.patch
From 03ee1d038782bcdc74ec0ef9d02d895fdc3d34e0 Mon Sep 17 00:00:00 2001
From: Eric Brine <ikegami@adaelis.com>
Date: Mon, 18 Jan 2010 10:21:20 -0800
Subject: [PATCH 2/2] open3 errors in child croak parent RT#72016

Errors in open3 no longer appear to originate from the executed command on forking systems.
---
 ext/IPC-Open3/lib/IPC/Open3.pm |  145 ++++++++++++++++++++++++++--------------
 ext/IPC-Open3/t/IPC-Open3.t    |   11 +--
 2 files changed, 99 insertions(+), 57 deletions(-)

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";
     }
 }
-- 
1.6.5.2

@p5pRT
Copy link
Author

p5pRT commented Mar 16, 2010

From @iabyn

Eric notes that he has pending work on this ticket

@p5pRT
Copy link
Author

p5pRT commented Apr 5, 2010

From @ikegami

On Tue Mar 16 03​:07​:52 2010, davem wrote​:

Eric notes that he has pending work on this ticket

More precisely, the patches are written, attached to the ticket and
waiting to be applied.

@p5pRT
Copy link
Author

p5pRT commented Apr 15, 2010

From @rgarcia

On 18 January 2010 20​:38, Eric Brine <ikegami@​adaelis.com> wrote​:

Patch attached.

The first adds TODO tests.
The second fixes the bug and makes the tests "live".

Thanks, applied to blaedperl. I also bumped the version of IPC​::Open3 to 1.06.

@p5pRT
Copy link
Author

p5pRT commented Apr 15, 2010

@rgs - Status changed from 'open' to 'resolved'

@p5pRT p5pRT closed this as completed Apr 15, 2010
@p5pRT
Copy link
Author

p5pRT commented Feb 15, 2011

From @epa

Thanks, applied to blaedperl. I also bumped the version of IPC​::Open3
to 1.06.

This doesn't seem to have made it into perl-5.12.3, which still includes
IPC​::Open3 version 1.05 (which doesn't include the patch).

Could I ask you to look at why this didn't make it into perl proper?

@p5pRT
Copy link
Author

p5pRT commented Feb 16, 2011

From @ikegami

On Tue, Feb 15, 2011 at 11​:43 AM, Ed Avis via RT
<perlbug-followup@​perl.org>wrote​:

Thanks, applied to blaedperl. I also bumped the version of IPC​::Open3
to 1.06.

This doesn't seem to have made it into perl-5.12.3, which still includes
IPC​::Open3 version 1.05 (which doesn't include the patch).

Could I ask you to look at why this didn't make it into perl proper?

There has only been maintenance releases since this was changed. Only
selected changes go into maintenance releases, and they have to be bug
fixes. You'll have to ask p5p about the specific process.

@p5pRT
Copy link
Author

p5pRT commented Feb 16, 2011

From @epa

There has only been maintenance releases since this was changed.

Ah, I see. The patch went in shortly after 5.12 had been released, so
it is waiting for 5.14.

Is it straightforward to release the new version on CPAN in the
meantime? (I don't fully understand the complexities of 'dual-life'
modules - so if it's a PITA, it would be best to wait.)

@p5pRT
Copy link
Author

p5pRT commented Feb 16, 2011

From @ikegami

On Wed, Feb 16, 2011 at 11​:06 AM, Ed Avis via RT
<perlbug-followup@​perl.org>wrote​:

There has only been maintenance releases since this was changed.

Ah, I see. The patch went in shortly after 5.12 had been released, so
it is waiting for 5.14.

Correct.

Is it straightforward to release the new version on CPAN in the
meantime? (I don't fully understand the complexities of 'dual-life'
modules - so if it's a PITA, it would be best to wait.)

It's not a dual-life module, i.e. it's only distributed as part of Perl
itself. Someone would have to make it dual-life first.

If you want it now, just grab the .pm from git and save it into your lib
directory.
http​://perl5.git.perl.org/perl.git/blob_plain/HEAD​:/ext/IPC-Open3/lib/IPC/Open3.pm

- Eric

@p5pRT
Copy link
Author

p5pRT commented Sep 20, 2019

From @epa

Thanks to all who worked on this. What happens now is that open3() throws an exception.

  open3​: exec of nonexistent failed​: No such file or directory

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Development

No branches or pull requests

1 participant