From: Ilya Zakharevich Date: Fri, 9 Jul 1999 05:21:13 +0000 (-0400) Subject: make system() return -1 and set $! if exec of child failed X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d5a9bfb0fc8643b1208bad4f15e3c88ef46b4160;p=p5sagit%2Fp5-mst-13.2.git make system() return -1 and set $! if exec of child failed Message-ID: <19990709052113.A6201@monk.mps.ohio-state.edu> Subject: [PATCH 5.005_57] system()==-1 and $! from failing fork/exec p4raw-id: //depot/perl@3679 --- diff --git a/doio.c b/doio.c index 674bd7b..b0c7a9e 100644 --- a/doio.c +++ b/doio.c @@ -1049,6 +1049,12 @@ Perl_my_lstat(pTHX) bool Perl_do_aexec(pTHX_ SV *really, register SV **mark, register SV **sp) { + return do_aexec5(really, mark, sp, 0, 0); +} + +bool +do_aexec5(SV *really, register SV **mark, register SV **sp, int fd, int do_report) +{ register char **a; char *tmps; STRLEN n_a; @@ -1073,6 +1079,12 @@ Perl_do_aexec(pTHX_ SV *really, register SV **mark, register SV **sp) if (ckWARN(WARN_EXEC)) Perl_warner(aTHX_ WARN_EXEC, "Can't exec \"%s\": %s", PL_Argv[0], Strerror(errno)); + if (do_report) { + int e = errno; + + PerlLIO_write(fd, (void*)&e, sizeof(int)); + PerlLIO_close(fd); + } } do_execfree(); return FALSE; diff --git a/embed.h b/embed.h index dfd37d0..7789679 100644 --- a/embed.h +++ b/embed.h @@ -102,6 +102,7 @@ #define die_where Perl_die_where #define dounwind Perl_dounwind #define do_aexec Perl_do_aexec +#define do_aexec5 Perl_do_aexec5 #define do_binmode Perl_do_binmode #define do_chop Perl_do_chop #define do_close Perl_do_close @@ -1422,6 +1423,7 @@ #define die_where(a,b) Perl_die_where(aTHX_ a,b) #define dounwind(a) Perl_dounwind(aTHX_ a) #define do_aexec(a,b,c) Perl_do_aexec(aTHX_ a,b,c) +#define do_aexec5(a,b,c,d,e) Perl_do_aexec5(aTHX_ a,b,c,d,e) #define do_binmode(a,b,c) Perl_do_binmode(aTHX_ a,b,c) #define do_chop(a,b) Perl_do_chop(aTHX_ a,b) #define do_close(a,b) Perl_do_close(aTHX_ a,b) @@ -2829,6 +2831,8 @@ #define dounwind Perl_dounwind #define Perl_do_aexec CPerlObj::Perl_do_aexec #define do_aexec Perl_do_aexec +#define Perl_do_aexec5 CPerlObj::Perl_do_aexec5 +#define do_aexec5 Perl_do_aexec5 #define Perl_do_binmode CPerlObj::Perl_do_binmode #define do_binmode Perl_do_binmode #define Perl_do_chop CPerlObj::Perl_do_chop diff --git a/embed.pl b/embed.pl index 927fb02..1af25ad 100755 --- a/embed.pl +++ b/embed.pl @@ -1081,6 +1081,7 @@ p |OP* |vdie |const char* pat|va_list* args p |OP* |die_where |char* message|STRLEN msglen p |void |dounwind |I32 cxix p |bool |do_aexec |SV* really|SV** mark|SV** sp +p |bool |do_aexec5 |SV* really|SV** mark|SV** sp|int fd|int flag p |int |do_binmode |PerlIO *fp|int iotype|int flag p |void |do_chop |SV* asv|SV* sv p |bool |do_close |GV* gv|bool not_implicit diff --git a/global.sym b/global.sym index 06c71da..8a3e725 100644 --- a/global.sym +++ b/global.sym @@ -86,6 +86,7 @@ Perl_vdie Perl_die_where Perl_dounwind Perl_do_aexec +Perl_do_aexec5 Perl_do_binmode Perl_do_chop Perl_do_close diff --git a/objXSUB.h b/objXSUB.h index 43e29f4..9728482 100644 --- a/objXSUB.h +++ b/objXSUB.h @@ -1147,6 +1147,10 @@ #define Perl_do_aexec pPerl->Perl_do_aexec #undef do_aexec #define do_aexec Perl_do_aexec +#undef Perl_do_aexec5 +#define Perl_do_aexec5 pPerl->Perl_do_aexec5 +#undef do_aexec5 +#define do_aexec5 Perl_do_aexec5 #undef Perl_do_binmode #define Perl_do_binmode pPerl->Perl_do_binmode #undef do_binmode diff --git a/perlapi.c b/perlapi.c index d3ebc9b..037ad3d 100755 --- a/perlapi.c +++ b/perlapi.c @@ -682,6 +682,13 @@ Perl_do_aexec(pTHXo_ SV* really, SV** mark, SV** sp) return ((CPerlObj*)pPerl)->Perl_do_aexec(really, mark, sp); } +#undef Perl_do_aexec5 +bool +Perl_do_aexec5(pTHXo_ SV* really, SV** mark, SV** sp, int fd, int flag) +{ + return ((CPerlObj*)pPerl)->Perl_do_aexec5(really, mark, sp, fd, flag); +} + #undef Perl_do_binmode int Perl_do_binmode(pTHXo_ PerlIO *fp, int iotype, int flag) diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index e7fdc78..921b66f 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -4377,7 +4377,8 @@ The return value is the exit status of the program as returned by the C call. To get the actual exit value divide by 256. See also L. This is I what you want to use to capture the output from a command, for that you should use merely backticks or -C, as described in L. +C, as described in L. Return value of -1 +indicates a failure to start the program (inspect $! for the reason). Like C, C allows you to lie to a program about its name if you use the C syntax. Again, see L. diff --git a/pp_sys.c b/pp_sys.c index b216b62..cbd5764 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -3577,6 +3577,8 @@ PP(pp_system) int status; Sigsave_t ihand,qhand; /* place to save signals during system() */ STRLEN n_a; + I32 did_pipes = 0; + int pp[2]; if (SP - MARK == 1) { if (PL_tainting) { @@ -3587,16 +3589,24 @@ PP(pp_system) } PERL_FLUSHALL_FOR_CHILD; #if (defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(OS2) + if (PerlProc_pipe(pp) >= 0) + did_pipes = 1; while ((childpid = vfork()) == -1) { if (errno != EAGAIN) { value = -1; SP = ORIGMARK; PUSHi(value); + if (did_pipes) { + PerlLIO_close(pp[0]); + PerlLIO_close(pp[1]); + } RETURN; } sleep(5); } if (childpid > 0) { + if (did_pipes) + PerlLIO_close(pp[1]); rsignal_save(SIGINT, SIG_IGN, &ihand); rsignal_save(SIGQUIT, SIG_IGN, &qhand); do { @@ -3607,17 +3617,43 @@ PP(pp_system) STATUS_NATIVE_SET(result == -1 ? -1 : status); do_execfree(); /* free any memory child malloced on vfork */ SP = ORIGMARK; + if (did_pipes) { + int errkid; + int n = 0, n1; + + while (n < sizeof(int)) { + n1 = PerlLIO_read(pp[0], + (void*)(((char*)&errkid)+n), + (sizeof(int)) - n); + if (n1 <= 0) + break; + n += n1; + } + PerlLIO_close(pp[0]); + if (n) { /* Error */ + if (n != sizeof(int)) + Perl_croak(aTHX_ "panic: kid popen errno read"); + errno = errkid; /* Propagate errno from kid */ + STATUS_CURRENT = -1; + } + } PUSHi(STATUS_CURRENT); RETURN; } + if (did_pipes) { + PerlLIO_close(pp[0]); +#if defined(HAS_FCNTL) && defined(F_SETFD) + fcntl(pp[1], F_SETFD, FD_CLOEXEC); +#endif + } if (PL_op->op_flags & OPf_STACKED) { SV *really = *++MARK; - value = (I32)do_aexec(really, MARK, SP); + value = (I32)do_aexec5(really, MARK, SP, pp[1], did_pipes); } else if (SP - MARK != 1) - value = (I32)do_aexec(Nullsv, MARK, SP); + value = (I32)do_aexec5(Nullsv, MARK, SP, pp[1], did_pipes); else { - value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), n_a)); + value = (I32)do_exec3(SvPVx(sv_mortalcopy(*SP), n_a), pp[1], did_pipes); } PerlProc__exit(-1); #else /* ! FORK or VMS or OS/2 */ diff --git a/proto.h b/proto.h index fe399f0..e4a9db8 100644 --- a/proto.h +++ b/proto.h @@ -95,6 +95,7 @@ VIRTUAL OP* Perl_vdie(pTHX_ const char* pat, va_list* args); VIRTUAL OP* Perl_die_where(pTHX_ char* message, STRLEN msglen); VIRTUAL void Perl_dounwind(pTHX_ I32 cxix); VIRTUAL bool Perl_do_aexec(pTHX_ SV* really, SV** mark, SV** sp); +VIRTUAL bool Perl_do_aexec5(pTHX_ SV* really, SV** mark, SV** sp, int fd, int flag); VIRTUAL int Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int flag); VIRTUAL void Perl_do_chop(pTHX_ SV* asv, SV* sv); VIRTUAL bool Perl_do_close(pTHX_ GV* gv, bool not_implicit); diff --git a/t/op/exec.t b/t/op/exec.t index 5cf7386..99af53b 100755 --- a/t/op/exec.t +++ b/t/op/exec.t @@ -25,7 +25,9 @@ if (system "true") {print "not ok 4\n";} else {print "ok 4\n";} if ((system "/bin/sh -c 'exit 1'") != 256) { print "not "; } print "ok 5\n"; -if ((system "lskdfj") == 255 << 8) {print "ok 6\n";} else {print "not ok 6\n";} +$rc = system "lskdfj"; +if ($rc == 255 << 8 or $rc == -1 and ($! == 2 or $! =~ /\bno\b.*\bfile/i)) + {print "ok 6\n";} else {print "not ok 6\n";} unless (exec "lskdjfalksdjfdjfkls") {print "ok 7\n";} else {print "not ok 7\n";}