From: Chip Salzenberg <chip@pobox.com>
Date: Thu, 10 Jul 2003 13:13:20 +0000 (-0400)
Subject: Restore SIGFPE on exec()
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b35112e751727d4207068fd54bf0c9d77ad0ba97;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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