Add error checks after execing PL_cshname or PL_sh_path
Jan Dubois [Wed, 7 Jun 2006 15:53:02 +0000 (08:53 -0700)]
From: "Jan Dubois" <jand@activestate.com>
Message-ID: <002301c68a85$21aa7320$d045a8c0@candy>

p4raw-id: //depot/perl@28376

doio.c
embed.fnc
embed.h
proto.h

diff --git a/doio.c b/doio.c
index f5f59a3..41f026f 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1396,6 +1396,19 @@ Perl_my_lstat(pTHX)
     return PL_laststatval;
 }
 
+static void
+S_exec_failed(pTHX_ const char *cmd, int fd, int do_report)
+{
+    const int e = errno;
+    if (ckWARN(WARN_EXEC))
+       Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
+                   cmd, Strerror(e));
+    if (do_report) {
+       PerlLIO_write(fd, (void*)&e, sizeof(int));
+       PerlLIO_close(fd);
+    }
+}
+
 bool
 Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp,
               int fd, int do_report)
@@ -1428,15 +1441,7 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp,
        else
            PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv));
        PERL_FPU_POST_EXEC
-       if (ckWARN(WARN_EXEC))
-           Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
-               (really ? tmps : PL_Argv[0]), Strerror(errno));
-       if (do_report) {
-           const int e = errno;
-
-           PerlLIO_write(fd, (void*)&e, sizeof(int));
-           PerlLIO_close(fd);
-       }
+       S_exec_failed(aTHX_ (really ? tmps : PL_Argv[0]), fd, do_report);
     }
     do_execfree();
 #endif
@@ -1508,6 +1513,7 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
                  PerlProc_execl(PL_cshname, "csh", flags, ncmd, NULL);
                  PERL_FPU_POST_EXEC
                  *s = '\'';
+                 S_exec_failed(aTHX_ PL_cshname, fd, do_report);
                  Safefree(cmd);
                  return FALSE;
              }
@@ -1555,6 +1561,7 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
            PERL_FPU_PRE_EXEC
            PerlProc_execl(PL_sh_path, "sh", "-c", cmd, NULL);
            PERL_FPU_POST_EXEC
+           S_exec_failed(aTHX_ PL_sh_path, fd, do_report);
            Safefree(cmd);
            return FALSE;
        }
@@ -1582,14 +1589,7 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
            do_execfree();
            goto doshell;
        }
-       if (ckWARN(WARN_EXEC))
-           Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
-               PL_Argv[0], Strerror(errno));
-       if (do_report) {
-           const int e = errno;
-           PerlLIO_write(fd, (const void*)&e, sizeof(int));
-           PerlLIO_close(fd);
-       }
+       S_exec_failed(aTHX_ PL_Argv[0], fd, do_report);
     }
     do_execfree();
     Safefree(cmd);
index 1c4fff1..3212583 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -206,6 +206,9 @@ Ap  |int    |do_spawn_nowait|NN char* cmd
 p      |bool   |do_exec3       |NN const char* cmd|int fd|int do_report
 #endif
 p      |void   |do_execfree
+#ifdef PERL_IN_DOIO_C
+s      |void   |exec_failed    |const char *cmd|int fd|int do_report
+#endif
 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
 p      |I32    |do_ipcctl      |I32 optype|NN SV** mark|NN SV** sp
 p      |I32    |do_ipcget      |I32 optype|NN SV** mark|NN SV** sp
diff --git a/embed.h b/embed.h
index 778baac..2885e22 100644 (file)
--- a/embed.h
+++ b/embed.h
 #ifdef PERL_CORE
 #define do_execfree            Perl_do_execfree
 #endif
+#ifdef PERL_IN_DOIO_C
+#ifdef PERL_CORE
+#define exec_failed            S_exec_failed
+#endif
+#endif
 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
 #ifdef PERL_CORE
 #define do_ipcctl              Perl_do_ipcctl
 #ifdef PERL_CORE
 #define do_execfree()          Perl_do_execfree(aTHX)
 #endif
+#ifdef PERL_IN_DOIO_C
+#ifdef PERL_CORE
+#define exec_failed(a,b,c)     S_exec_failed(aTHX_ a,b,c)
+#endif
+#endif
 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
 #ifdef PERL_CORE
 #define do_ipcctl(a,b,c)       Perl_do_ipcctl(aTHX_ a,b,c)
diff --git a/proto.h b/proto.h
index da4a153..aad0de6 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -441,6 +441,9 @@ PERL_CALLCONV bool  Perl_do_exec3(pTHX_ const char* cmd, int fd, int do_report)
 
 #endif
 PERL_CALLCONV void     Perl_do_execfree(pTHX);
+#ifdef PERL_IN_DOIO_C
+STATIC void    S_exec_failed(pTHX_ const char *cmd, int fd, int do_report);
+#endif
 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
 PERL_CALLCONV I32      Perl_do_ipcctl(pTHX_ I32 optype, SV** mark, SV** sp)
                        __attribute__nonnull__(pTHX_2)