diff options
author | Daniel Dragan <bulk88@hotmail.com> | 2015-07-07 12:59:01 -0400 |
---|---|---|
committer | Tony Cook <tony@develop-help.com> | 2015-07-08 11:35:57 +1000 |
commit | c85f23b236fa90fedd9cceed2da12481184d5bbf (patch) | |
tree | aff58bca43713ec58444143c0d000adef9c371d9 /ext | |
parent | 7ed1d857c7b7016b9bde564c6802a4721d903d95 (diff) | |
download | perl-c85f23b236fa90fedd9cceed2da12481184d5bbf.tar.gz |
dont report a $@ exception with uninitialized $!'s message in IPC::Open3
Commit a24d8dfd08 "Make IPC::Open3 work without fork()" from 5.003 created
an eval block, and if that eval block threw an exception, instead of
propagating $@, the code propagated $!, even though no system call was done
and $! is effectivly unintialized data. In one case for me, a taint
exception inside system was turned into open3() throwing an exception
about "Inappropriate I/O control operation" or "Bad file descriptor", which
had nothing to do with the real fault which was a Perl C level croak with
the message "Insecure $ENV{PATH} while running with -T switch at ..."
which was called as Perl_pp_system->Perl_taint_env->Perl_taint_proper->
Perl_croak->Perl_vcroak. This patch does not try to fix the ambiguity of
the error messages between the !DO_SPAWN and IO::Pipe
branches/implementations of _open3.
Diffstat (limited to 'ext')
-rw-r--r-- | ext/IPC-Open3/lib/IPC/Open3.pm | 8 | ||||
-rw-r--r-- | ext/IPC-Open3/t/IPC-Open3.t | 42 |
2 files changed, 47 insertions, 3 deletions
diff --git a/ext/IPC-Open3/lib/IPC/Open3.pm b/ext/IPC-Open3/lib/IPC/Open3.pm index 7c7e9b532a..273f205480 100644 --- a/ext/IPC-Open3/lib/IPC/Open3.pm +++ b/ext/IPC-Open3/lib/IPC/Open3.pm @@ -9,7 +9,7 @@ require Exporter; use Carp; use Symbol qw(gensym qualify); -$VERSION = '1.18'; +$VERSION = '1.19'; @ISA = qw(Exporter); @EXPORT = qw(open3); @@ -412,7 +412,11 @@ sub spawn_with_handles { } else { $pid = eval { system 1, @_ }; # 1 == P_NOWAIT } - push @errs, "IO::Pipe: Can't spawn-NOWAIT: $!" if !$pid || $pid < 0; + if($@) { + push @errs, "IO::Pipe: Can't spawn-NOWAIT: $@"; + } elsif(!$pid || $pid < 0) { + push @errs, "IO::Pipe: Can't spawn-NOWAIT: $!"; + } } # Do this in reverse, so that STDERR is restored first: diff --git a/ext/IPC-Open3/t/IPC-Open3.t b/ext/IPC-Open3/t/IPC-Open3.t index fcaecef61c..25cfdfb6ae 100644 --- a/ext/IPC-Open3/t/IPC-Open3.t +++ b/ext/IPC-Open3/t/IPC-Open3.t @@ -14,7 +14,7 @@ BEGIN { } use strict; -use Test::More tests => 44; +use Test::More tests => 45; use IO::Handle; use IPC::Open3; @@ -165,6 +165,46 @@ $pid = eval { open3 'WRITE', '', 'ERROR', '/non/existent/program'; }; like($@, qr/^open3: Modification of a read-only value attempted at /, 'open3 faults read-only parameters correctly') or do {waitpid $pid, 0}; +package NoFetch; + +my $fetchcount = 1; + +sub TIESCALAR { + my $class = shift; + my $instance = shift || undef; + return bless \$instance => $class; +} + +sub FETCH { + my $cmd; #dont let "@args = @DB::args;" in Carp::caller_info fire this die + #fetchcount may need to be increased to 2 if this code is being stepped with + #a perl debugger + if($fetchcount == 1 && (caller(1))[3] ne 'Carp::caller_info') { + #Carp croak reports the errors as being in IPC-Open3.t, so it is + #unacceptable for testing where the FETCH failure occured, we dont want + #it failing in a $foo = $_[0]; #later# system($foo), where the failure + #is supposed to be triggered in the inner most syscall, aka system() + my ($package, $filename, $line, $subroutine) = caller(2); + + die("FETCH not allowed in ".((caller(1))[3])." in ".((caller(2))[3])."\n"); + } else { + $fetchcount++; + return tie($cmd, 'NoFetch'); + } +} + +package main; + +{ + my $cmd; + tie($cmd, 'NoFetch'); + + $pid = eval { open3 'WRITE', 'READ', 'ERROR', $cmd; }; + like($@, qr/^(?:open3: IO::Pipe: Can't spawn-NOWAIT: FETCH not allowed in \(eval\) (?x: + )in IPC::Open3::spawn_with_handles|FETCH not allowed in \(eval\) in IPC::Open3::_open3)/, + 'dieing inside Tied arg propagates correctly') or do {waitpid $pid, 0}; +} + foreach my $handle (qw (DUMMY STDIN STDOUT STDERR)) { local $::{$handle}; my $out = IO::Handle->new(); |