Restore SIGFPE on exec()

Message-ID: <20030710171319.GA21588@perlsupport.com>

p4raw-id: //depot/perl@20117

diff --git a/doio.c b/doio.c
index fd5b809..18d5254 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1429,10 +1429,12 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp,
        if ((!really && *PL_Argv[0] != '/') ||
            (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));
+       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));
@@ -1502,7 +1504,9 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report)
                  *--s = '\0';
              if (s[-1] == '\'') {
                  *--s = '\0';
+                 PERL_FPU_PRE_EXEC
                  PerlProc_execl(PL_cshname,"csh", flags, ncmd, (char*)0);
+                 PERL_FPU_POST_EXEC
                  *s = '\'';
                  return FALSE;
              }
@@ -1545,7 +1549,9 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report)
                }
            }
          doshell:
+           PERL_FPU_PRE_EXEC
            PerlProc_execl(PL_sh_path, "sh", "-c", cmd, (char*)0);
+           PERL_FPU_POST_EXEC
            return FALSE;
        }
     }
@@ -1563,7 +1569,9 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report)
     }
     *a = Nullch;
     if (PL_Argv[0]) {
+       PERL_FPU_PRE_EXEC
        PerlProc_execvp(PL_Argv[0],PL_Argv);
+       PERL_FPU_POST_EXEC
        if (errno == ENOEXEC) {         /* for system V NIH syndrome */
            do_execfree();
            goto doshell;

diff --git a/perl.c b/perl.c
index d41e8db..73f10df 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -2982,10 +2982,12 @@ S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv, int *fdscript)
                 PL_statbuf.st_mode & (S_ISUID|S_ISGID))
             {
                 /* try again */
+                PERL_FPU_PRE_EXEC
                 PerlProc_execv(Perl_form(aTHX_ "%s/sperl"PERL_FS_VER_FMT,
                                          BIN_EXP, (int)PERL_REVISION,
                                          (int)PERL_VERSION,
                                          (int)PERL_SUBVERSION), PL_origargv);
+                PERL_FPU_POST_EXEC
                 Perl_croak(aTHX_ "Can't do setuid\n");
             }
 #       endif
@@ -3242,9 +3244,11 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
            (void)PerlIO_close(PL_rsfp);
 #ifndef IAMSUID
            /* try again */
+           PERL_FPU_PRE_EXEC
            PerlProc_execv(Perl_form(aTHX_ "%s/sperl"PERL_FS_VER_FMT, BIN_EXP,
                                     (int)PERL_REVISION, (int)PERL_VERSION,
                                     (int)PERL_SUBVERSION), PL_origargv);
+           PERL_FPU_POST_EXEC
 #endif
            Perl_croak(aTHX_ "Can't do setuid\n");
        }
@@ -3326,9 +3330,11 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 #if defined(HAS_FCNTL) && defined(F_SETFD)
     fcntl(PerlIO_fileno(PL_rsfp),F_SETFD,0);   /* ensure no close-on-exec */
 #endif
+    PERL_FPU_PRE_EXEC
     PerlProc_execv(Perl_form(aTHX_ "%s/perl"PERL_FS_VER_FMT, BIN_EXP,
                             (int)PERL_REVISION, (int)PERL_VERSION,
                             (int)PERL_SUBVERSION), PL_origargv);/* try again */
+    PERL_FPU_POST_EXEC
     Perl_croak(aTHX_ "Can't do setuid\n");
 #endif /* IAMSUID */
 #else /* !DOSUID */

diff --git a/perl.h b/perl.h
index a361e0f..cb43a3d 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -1935,12 +1935,18 @@ typedef struct clone_params CLONE_PARAMS;
 #    define PERL_FPU_INIT fpsetmask(0);
 #  else
 #    if defined(SIGFPE) && defined(SIG_IGN)
-#      define PERL_FPU_INIT signal(SIGFPE, SIG_IGN);
+#      define PERL_FPU_INIT       PL_sigfpe_saved = signal(SIGFPE, SIG_IGN)
+#      define PERL_FPU_PRE_EXEC   { Sigsave_t xfpe; rsignal_save(SIGFPE, PL_sigfpe_saved, &xfpe);
+#      define PERL_FPU_POST_EXEC    rsignal_restore(SIGFPE, &xfpe); }
 #    else
 #      define PERL_FPU_INIT
 #    endif
 #  endif
 #endif
+#ifndef PERL_FPU_PRE_EXEC
+#  define PERL_FPU_PRE_EXEC   {
+#  define PERL_FPU_POST_EXEC  }
+#endif
 
 #ifndef PERL_SYS_INIT3
 #  define PERL_SYS_INIT3(argvp,argcp,envp) PERL_SYS_INIT(argvp,argcp)

diff --git a/perlapi.h b/perlapi.h
index 0f56a0a..123a7d5 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -944,6 +944,8 @@ END_EXTERN_C
 #define PL_patleave            (*Perl_Gpatleave_ptr(NULL))
 #undef  PL_sh_path
 #define PL_sh_path             (*Perl_Gsh_path_ptr(NULL))
+#undef  PL_sigfpe_saved
+#define PL_sigfpe_saved                (*Perl_Gsigfpe_saved_ptr(NULL))
 #undef  PL_thr_key
 #define PL_thr_key             (*Perl_Gthr_key_ptr(NULL))
 

diff --git a/perlvars.h b/perlvars.h
index abd2f3e..0811399 100644 (file)
--- a/perlvars.h
+++ b/perlvars.h
@@ -55,3 +55,7 @@ PERLVAR(Gdollarzero_mutex, perl_mutex)        /* Modifying $0 */
 /* This is constant on most architectures, a global on OS/2 */
 PERLVARI(Gsh_path,     char *, SH_PATH)/* full path of shell */
 
+/* If Perl has to ignore SIGPFE, this is its saved state.
+ * See perl.h macros PERL_FPU_INIT and PERL_FPU_{PRE,POST}_EXEC. */
+PERLVAR(Gsigfpe_saved, Sighandler_t)
+

diff --git a/toke.c b/toke.c
index d9ba6cb..2527e95 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -2704,7 +2704,9 @@ Perl_yylex(pTHX)
                    else
                        newargv = PL_origargv;
                    newargv[0] = ipath;
+                   PERL_FPU_PRE_EXEC
                    PerlProc_execv(ipath, EXEC_ARGV_CAST(newargv));
+                   PERL_FPU_POST_EXEC
                    Perl_croak(aTHX_ "Can't exec %s", ipath);
                }
 #endif