Block signals during fork (fixes RT#82580)

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 99b7641..026afbc 100644 (file)
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -638,6 +638,12 @@ C<CORE::GLOBAL> override had op checking performed twice.  The checking
 is always idempotent for pure Perl code, but the double checking can
 matter when custom call checkers are involved.
 
+=item *
+
+A race condition used to exist around fork that could cause a signal sent to
+the parent to be handled by both parent and child. Signals are now blocked
+briefly around fork to prevent this from happening [perl #82580].
+
 =back
 
 =head1 Known Problems

diff --git a/pp_sys.c b/pp_sys.c
index 02b50ea..65d527a 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -4021,10 +4021,31 @@ PP(pp_fork)
 #ifdef HAS_FORK
     dVAR; dSP; dTARGET;
     Pid_t childpid;
+#if defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO)
+    sigset_t oldmask, newmask;
+#endif
 
     EXTEND(SP, 1);
     PERL_FLUSHALL_FOR_CHILD;
+#if defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO)
+    sigfillset(&newmask);
+    sigprocmask(SIG_SETMASK, &newmask, &oldmask);
+#endif
     childpid = PerlProc_fork();
+    if (childpid == 0) {
+       int sig;
+       PL_sig_pending = 0;
+       if (PL_psig_pend)
+           for (sig = 1; sig < SIG_SIZE; sig++)
+               PL_psig_pend[sig] = 0;
+    }
+#if defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO)
+    {
+       dSAVE_ERRNO;
+       sigprocmask(SIG_SETMASK, &oldmask, NULL);
+       RESTORE_ERRNO;
+    }
+#endif
     if (childpid < 0)
        RETSETUNDEF;
     if (!childpid) {