amigaos4: save and restore stdio handles around exec

[perl5.git] / doio.c

diff --git a/doio.c b/doio.c
index 39e5ce7..d8ea076 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -741,9 +741,10 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname,
                 int ofd = PerlIO_fileno(fp);
                 int dupfd = ofd >= 0 ? PerlLIO_dup(ofd) : -1;
 #if defined(HAS_FCNTL) && defined(F_SETFD)
-               /* Assume if we have F_SETFD we have F_GETFD */
-                int coe = ofd >= 0 ? fcntl(ofd, F_GETFD) : -1;
-                if (coe < 0) {
+               /* Assume if we have F_SETFD we have F_GETFD. */
+                /* Get a copy of all the fd flags. */
+                int fd_flags = ofd >= 0 ? fcntl(ofd, F_GETFD) : -1;
+                if (fd_flags < 0) {
                     if (dupfd >= 0)
                         PerlLIO_close(dupfd);
                     goto say_false;
@@ -757,8 +758,9 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname,
                 PerlIO_close(fp);
                 PerlLIO_dup2(dupfd, ofd);
 #if defined(HAS_FCNTL) && defined(F_SETFD)
-               /* The dup trick has lost close-on-exec on ofd */
-               fcntl(ofd,F_SETFD, coe);
+               /* The dup trick has lost close-on-exec on ofd,
+                 * and possibly any other flags, so restore them. */
+               fcntl(ofd,F_SETFD, fd_flags);
 #endif
                 PerlLIO_close(dupfd);
            }
@@ -769,12 +771,10 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname,
        PerlIO_clearerr(fp);
        fd = PerlIO_fileno(fp);
     }
-#if defined(HAS_FCNTL) && defined(F_SETFD)
-    if (fd >= 0) {
-        if (fcntl(fd, F_SETFD, fd > PL_maxsysfd) < 0) {
-            PerlLIO_close(fd);
-            goto say_false;
-        }
+#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
+    if (fd > PL_maxsysfd && fcntl(fd, F_SETFD, FD_CLOEXEC) < 0) {
+        PerlLIO_close(fd);
+        goto say_false;
     }
 #endif
     IoIFP(io) = fp;
@@ -1528,9 +1528,14 @@ S_exec_failed(pTHX_ const char *cmd, int fd, int do_report)
 {
     const int e = errno;
     PERL_ARGS_ASSERT_EXEC_FAILED;
-    if (ckWARN(WARN_EXEC))
-       Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
-                   cmd, Strerror(e));
+#ifdef __amigaos4__
+    if (e)
+#endif
+    {
+       if (ckWARN(WARN_EXEC))
+           Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
+                       cmd, Strerror(e));
+    }
     if (do_report) {
         /* XXX silently ignore failures */
         PERL_UNUSED_RESULT(PerlLIO_write(fd, (void*)&e, sizeof(int)));
@@ -1538,12 +1543,14 @@ S_exec_failed(pTHX_ const char *cmd, int fd, int do_report)
     }
 }
 
-bool
+DO_EXEC_TYPE
 Perl_do_aexec5(pTHX_ SV *really, SV **mark, SV **sp,
               int fd, int do_report)
 {
     dVAR;
+    DO_EXEC_TYPE result = DO_EXEC_FAILURE;
     PERL_ARGS_ASSERT_DO_AEXEC5;
+    PERL_UNUSED_VAR(result); /* if DO_EXEC_TYPE is bool */
 #if defined(__SYMBIAN32__) || defined(__LIBCATAMOUNT__)
     Perl_croak(aTHX_ "exec? I'm not *that* kind of operating system");
 #else
@@ -1566,16 +1573,21 @@ Perl_do_aexec5(pTHX_ SV *really, SV **mark, SV **sp,
            (really && *tmps != '/'))           /* will execvp use PATH? */
            TAINT_ENV();                /* testing IFS here is overkill, probably */
        PERL_FPU_PRE_EXEC
-       if (really && *tmps)
-           PerlProc_execvp(tmps,EXEC_ARGV_CAST(PL_Argv));
-       else
-           PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv));
+       if (really && *tmps) {
+            result =
+              (DO_EXEC_TYPE)
+              PerlProc_execvp(tmps,EXEC_ARGV_CAST(PL_Argv));
+       } else {
+           result =
+              (DO_EXEC_TYPE)
+              PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv));
+       }
        PERL_FPU_POST_EXEC
        S_exec_failed(aTHX_ (really ? tmps : PL_Argv[0]), fd, do_report);
     }
     do_execfree();
 #endif
-    return FALSE;
+    return DO_EXEC_RETVAL(result);
 }
 
 void
@@ -1589,7 +1601,7 @@ Perl_do_execfree(pTHX)
 
 #ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION
 
-bool
+DO_EXEC_TYPE
 Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
 {
     dVAR;
@@ -1599,6 +1611,8 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
     char *cmd;
     /* Make a copy so we can change it */
     const Size_t cmdlen = strlen(incmd) + 1;
+    DO_EXEC_TYPE result = DO_EXEC_FAILURE;
+    PERL_UNUSED_VAR(result); /* if DO_EXEC_TYPE is bool */
 
     PERL_ARGS_ASSERT_DO_EXEC3;
 
@@ -1634,12 +1648,14 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
              if (s[-1] == '\'') {
                  *--s = '\0';
                  PERL_FPU_PRE_EXEC
-                 PerlProc_execl(PL_cshname, "csh", flags, ncmd, (char*)NULL);
+                 result =
+                    (DO_EXEC_TYPE)
+                    PerlProc_execl(PL_cshname, "csh", flags, ncmd, (char*)NULL);
                  PERL_FPU_POST_EXEC
                  *s = '\'';
                  S_exec_failed(aTHX_ PL_cshname, fd, do_report);
                  Safefree(buf);
-                 return FALSE;
+                 return DO_EXEC_RETVAL(result);
              }
          }
        }
@@ -1683,11 +1699,16 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
            }
          doshell:
            PERL_FPU_PRE_EXEC
-           PerlProc_execl(PL_sh_path, "sh", "-c", cmd, (char *)NULL);
+           result =
+              (DO_EXEC_TYPE)
+              PerlProc_execl(PL_sh_path, "sh", "-c", cmd, (char *)NULL);
            PERL_FPU_POST_EXEC
            S_exec_failed(aTHX_ PL_sh_path, fd, do_report);
+#if defined (__amigaos4__)
+            amigaos_post_exec(fd, do_report);
+#endif
            Safefree(buf);
-           return FALSE;
+           return DO_EXEC_RETVAL(result);
        }
     }
 
@@ -1707,7 +1728,9 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
     *a = NULL;
     if (PL_Argv[0]) {
        PERL_FPU_PRE_EXEC
-       PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv));
+       result =
+          (DO_EXEC_TYPE)
+          PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv));
        PERL_FPU_POST_EXEC
        if (errno == ENOEXEC) {         /* for system V NIH syndrome */
            do_execfree();
@@ -1717,7 +1740,7 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
     }
     do_execfree();
     Safefree(buf);
-    return FALSE;
+    return DO_EXEC_RETVAL(result);
 }
 
 #endif /* OS2 || WIN32 */