From: Ilya Zakharevich Date: Thu, 6 May 1999 18:17:28 +0000 (-0400) Subject: Re: [PATCH 5.005_56] Make open(F,"command |") return correct err(no) X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e446cec8f170ecc3eabea80092ef64589855e167;p=p5sagit%2Fp5-mst-13.2.git Re: [PATCH 5.005_56] Make open(F,"command |") return correct err(no) Message-ID: <19990506181728.A12433@monk.mps.ohio-state.edu> p4raw-id: //depot/perl@3373 --- diff --git a/doio.c b/doio.c index 664bd15..064b0ca 100644 --- a/doio.c +++ b/doio.c @@ -1061,6 +1061,12 @@ do_execfree(void) bool do_exec(char *cmd) { + return do_exec3(cmd,0,0); +} + +bool +do_exec3(char *cmd, int fd, int do_report) +{ register char **a; register char *s; char flags[10]; @@ -1141,9 +1147,15 @@ do_exec(char *cmd) } { dTHR; + int e = errno; + if (ckWARN(WARN_EXEC)) warner(WARN_EXEC, "Can't exec \"%s\": %s", PL_Argv[0], Strerror(errno)); + if (do_report) { + PerlLIO_write(fd, (void*)&e, sizeof(int)); + PerlLIO_close(fd); + } } } do_execfree(); diff --git a/embed.h b/embed.h index dad61c7..011cc68 100644 --- a/embed.h +++ b/embed.h @@ -107,6 +107,7 @@ #define do_close Perl_do_close #define do_eof Perl_do_eof #define do_exec Perl_do_exec +#define do_exec3 Perl_do_exec3 #define do_execfree Perl_do_execfree #define do_gv_dump Perl_do_gv_dump #define do_gvgv_dump Perl_do_gvgv_dump @@ -1092,6 +1093,7 @@ #define do_close CPerlObj::Perl_do_close #define do_eof CPerlObj::Perl_do_eof #define do_exec CPerlObj::Perl_do_exec +#define do_exec3 CPerlObj::Perl_do_exec3 #define do_execfree CPerlObj::Perl_do_execfree #define do_gv_dump CPerlObj::Perl_do_gv_dump #define do_gvgv_dump CPerlObj::Perl_do_gvgv_dump diff --git a/global.sym b/global.sym index e7d1e36..09520a9 100644 --- a/global.sym +++ b/global.sym @@ -98,6 +98,7 @@ do_chop do_close do_eof do_exec +do_exec3 do_execfree do_hv_dump do_gv_dump diff --git a/objXSUB.h b/objXSUB.h index aa75722..6297e9f 100644 --- a/objXSUB.h +++ b/objXSUB.h @@ -1047,6 +1047,8 @@ #define do_eof pPerl->Perl_do_eof #undef do_exec #define do_exec pPerl->Perl_do_exec +#undef do_exec3 +#define do_exec3 pPerl->Perl_do_exec3 #undef do_execfree #define do_execfree pPerl->Perl_do_execfree #undef do_gv_dump diff --git a/pod/perldiag.pod b/pod/perldiag.pod index cc9160e..4b18882 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -2021,6 +2021,10 @@ and then discovered it wasn't a context we know how to do a goto in. (P) The lexer got into a bad state parsing a string with brackets. +=item panic: kid popen errno read + +(F) forked child returned an incomprehensible message about its errno. + =item panic: last (P) We popped the context stack to a block context, and then discovered diff --git a/proto.h b/proto.h index 61e5fa0..ff71c5a 100644 --- a/proto.h +++ b/proto.h @@ -99,6 +99,7 @@ VIRTUAL void do_chop _((SV* asv, SV* sv)); VIRTUAL bool do_close _((GV* gv, bool not_implicit)); VIRTUAL bool do_eof _((GV* gv)); VIRTUAL bool do_exec _((char* cmd)); +VIRTUAL bool do_exec3 _((char* cmd, int fd, int flag)); VIRTUAL void do_execfree _((void)); #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) I32 do_ipcctl _((I32 optype, SV** mark, SV** sp)); diff --git a/util.c b/util.c index 688314c..b357aa8 100644 --- a/util.c +++ b/util.c @@ -1910,6 +1910,8 @@ my_popen(char *cmd, char *mode) register I32 pid; SV *sv; I32 doexec = strNE(cmd,"-"); + I32 did_pipes = 0; + int pp[2]; PERL_FLUSHALL_FOR_CHILD; #ifdef OS2 @@ -1925,9 +1927,15 @@ my_popen(char *cmd, char *mode) } if (PerlProc_pipe(p) < 0) return Nullfp; + if (doexec && PerlProc_pipe(pp) >= 0) + did_pipes = 1; while ((pid = (doexec?vfork():fork())) < 0) { if (errno != EAGAIN) { PerlLIO_close(p[This]); + if (did_pipes) { + PerlLIO_close(pp[0]); + PerlLIO_close(pp[1]); + } if (!doexec) croak("Can't fork"); return Nullfp; @@ -1942,6 +1950,12 @@ my_popen(char *cmd, char *mode) #define THIS that #define THAT This PerlLIO_close(p[THAT]); + if (did_pipes) { + PerlLIO_close(pp[0]); +#if defined(HAS_FCNTL) && defined(F_SETFD) + fcntl(pp[1], F_SETFD, FD_CLOEXEC); +#endif + } if (p[THIS] != (*mode == 'r')) { PerlLIO_dup2(p[THIS], *mode == 'r'); PerlLIO_close(p[THIS]); @@ -1954,9 +1968,10 @@ my_popen(char *cmd, char *mode) #define NOFILE 20 #endif for (fd = PL_maxsysfd + 1; fd < NOFILE; fd++) - PerlLIO_close(fd); + if (fd != pp[1]) + PerlLIO_close(fd); #endif - do_exec(cmd); /* may or may not use the shell */ + do_exec3(cmd,pp[1],did_pipes); /* may or may not use the shell */ PerlProc__exit(1); } /*SUPPRESS 560*/ @@ -1970,6 +1985,8 @@ my_popen(char *cmd, char *mode) } do_execfree(); /* free any memory malloced by child on vfork */ PerlLIO_close(p[that]); + if (did_pipes) + PerlLIO_close(pp[1]); if (p[that] < p[This]) { PerlLIO_dup2(p[This], p[that]); PerlLIO_close(p[This]); @@ -1979,6 +1996,28 @@ my_popen(char *cmd, char *mode) (void)SvUPGRADE(sv,SVt_IV); SvIVX(sv) = pid; PL_forkprocess = pid; + if (did_pipes && pid > 0) { + 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; + } + if (n) { /* Error */ + if (n != sizeof(int)) + croak("panic: kid popen errno read"); + PerlLIO_close(pp[0]); + errno = errkid; /* Propagate errno from kid */ + return Nullfp; + } + } + if (did_pipes) + PerlLIO_close(pp[0]); return PerlIO_fdopen(p[This], mode); } #else