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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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