This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
add a new function, Perl_perly_sighandler()
authorDavid Mitchell <davem@iabyn.com>
Mon, 11 Nov 2019 11:26:45 +0000 (11:26 +0000)
committerDavid Mitchell <davem@iabyn.com>
Mon, 18 Nov 2019 09:34:40 +0000 (09:34 +0000)
This function implements the body of what used to be Perl_sighandler(),
the latter becoming a thin wrapper round Perl_perly_sighandler().

The main reason for this change is that it allows us to add an extra
arg, 'safe' to the function without breaking backcompat. This arg
indicates whether the function is being called directly from the OS
signal handler (safe==0), or deferred via Perl_despatch_signals()
(safe==1).

This allows an infelicity in the code to be fixed - it was formerly
trying to determine the route it had been called by (and hence whether a
'safe' route) by seeing if either of the sig/uap parameters was
non-null. It turns out that this was highly dogdy, and only worked by
luck. The safe caller did indeed pass NULL args, but due to a bug
(shortly to be fixed), sometimes the kernel thinks its calling a 1-arg
sig handler when its actually calling a 3-arg one. This means that the
sig/uap args are random garbage, and happen to be non-zero only by happy
coincidence on the OS/platforms so far.

Also, it turns out that the call via Perl_csighandler() was getting it
wrong: its explicit (NULL,NULL) args made it look like a safe signal
call. This will be corrected in the next commit, but for this commit the
old wrong behaviour is preserved.

See RT #82040 for details of when/why the original dodgy 'safe' check
was
added.

embed.fnc
embed.h
mg.c
proto.h

index 016d5bb..1f3913e 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1691,6 +1691,7 @@ ATp       |Signal_t |csighandler  |int sig|NULLOK Siginfo_t *info|NULLOK void *uap
 Tp     |Signal_t |sighandler   |int sig
 ATp    |Signal_t |csighandler  |int sig
 #endif
+ATp    |Signal_t |perly_sighandler     |int sig|NULLOK Siginfo_t *info|NULLOK void *uap|bool safe
 Ap     |SV**   |stack_grow     |NN SV** sp|NN SV** p|SSize_t n
 Ap     |I32    |start_subparse |I32 is_format|U32 flags
 Xp     |void   |init_named_cv  |NN CV *cv|NN OP *nameop
diff --git a/embed.h b/embed.h
index 0bfaaa8..8138141 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define parse_stmtseq(a)       Perl_parse_stmtseq(aTHX_ a)
 #define parse_subsignature(a)  Perl_parse_subsignature(aTHX_ a)
 #define parse_termexpr(a)      Perl_parse_termexpr(aTHX_ a)
+#define perly_sighandler       Perl_perly_sighandler
 #define pmop_dump(a)           Perl_pmop_dump(aTHX_ a)
 #define pop_scope()            Perl_pop_scope(aTHX)
 #define pregcomp(a,b)          Perl_pregcomp(aTHX_ a,b)
diff --git a/mg.c b/mg.c
index 998b4d8..a934ea7 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -1533,11 +1533,20 @@ Perl_csighandler(int sig)
           (PL_signals & PERL_SIGNALS_UNSAFE_FLAG))
        /* Call the perl level handler now--
         * with risk we may be in malloc() or being destructed etc. */
+    {
+        if (PL_sighandlerp == Perl_sighandler)
+            /* default handler, so can call perly_sighandler() directly
+             * rather than via Perl_sighandler, passing the extra
+             * 'safe = false' arg
+             */
+            Perl_perly_sighandler(sig, NULL, NULL, 1 /* XXX tmp safe */);
+        else
 #ifdef PERL_USE_3ARG_SIGHANDLER
-       (*PL_sighandlerp)(sig, NULL, NULL);
+            (*PL_sighandlerp)(sig, NULL, NULL);
 #else
-       (*PL_sighandlerp)(sig);
+            (*PL_sighandlerp)(sig);
 #endif
+    }
     else {
        if (!PL_psig_pend) return;
        /* Set a flag to say this signal is pending, that is awaiting delivery after
@@ -1615,11 +1624,19 @@ Perl_despatch_signals(pTHX)
            }
 #endif
            PL_psig_pend[sig] = 0;
+            if (PL_sighandlerp == Perl_sighandler)
+                /* default handler, so can call perly_sighandler() directly
+                 * rather than via Perl_sighandler, passing the extra
+                 * 'safe = true' arg
+                 */
+                Perl_perly_sighandler(sig, NULL, NULL, 1 /* safe */);
+            else
 #ifdef PERL_USE_3ARG_SIGHANDLER
-           (*PL_sighandlerp)(sig, NULL, NULL);
+                (*PL_sighandlerp)(sig, NULL, NULL);
 #else
-           (*PL_sighandlerp)(sig);
+                (*PL_sighandlerp)(sig);
 #endif
+
 #ifdef HAS_SIGPROCMASK
            if (!was_blocked)
                LEAVE;
@@ -3319,12 +3336,35 @@ Perl_whichsig_pvn(pTHX_ const char *sig, STRLEN len)
     return -1;
 }
 
-Signal_t
 #ifdef PERL_USE_3ARG_SIGHANDLER
+
+Signal_t
 Perl_sighandler(int sig, Siginfo_t *sip, void *uap)
+{
+    Perl_perly_sighandler(sig, sip, uap, 0);
+}
+
 #else
+
+Signal_t
 Perl_sighandler(int sig)
+{
+    Perl_perly_sighandler(sig, NULL, NULL, 0);
+}
+
 #endif
+
+/* Invoke the perl-level signal handler. This function is called either
+ * directly from one of the C-level signals handlers (Perl_sighandler or
+ * Perl_csighandler), or for safe signals, later from
+ * Perl_despatch_signals() at a suitable safe point during execution.
+ *
+ * 'safe' is a boolean indicating the latter call path.
+ */
+
+Signal_t
+Perl_perly_sighandler(int sig, Siginfo_t *sip PERL_UNUSED_DECL,
+                    void *uap PERL_UNUSED_DECL, bool safe)
 {
 #ifdef PERL_GET_SIG_CONTEXT
     dTHXa(PERL_GET_SIG_CONTEXT);
@@ -3456,10 +3496,13 @@ Perl_sighandler(int sig)
         * blocked by the system when we entered.
         */
 #ifdef HAS_SIGPROCMASK
-#if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
-           if (sip || uap)
-#endif
-           {
+           if (!safe) {
+                /* safe signals called via dispatch_signals() set up a
+                 * savestack destructor, unblock_sigmask(), to
+                 * automatically unblock the handler at the end. If
+                 * instead we get here directly, we have to do it
+                 * ourselves
+                 */
                sigset_t set;
                sigemptyset(&set);
                sigaddset(&set,sig);
@@ -3467,6 +3510,9 @@ Perl_sighandler(int sig)
            }
 #else
            /* Not clear if this will work */
+            /* XXX not clear if this should be protected by 'if (safe)'
+             * too */
+
            (void)rsignal(sig, SIG_IGN);
            (void)rsignal(sig, PL_csighandlerp);
 #endif
diff --git a/proto.h b/proto.h
index 8c3018f..7adae3c 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -2647,6 +2647,8 @@ PERL_CALLCONV int perl_parse(PerlInterpreter *my_perl, XSINIT_t xsinit, int argc
 PERL_CALLCONV int      perl_run(PerlInterpreter *my_perl);
 #define PERL_ARGS_ASSERT_PERL_RUN      \
        assert(my_perl)
+PERL_CALLCONV Signal_t Perl_perly_sighandler(int sig, Siginfo_t *info, void *uap, bool safe);
+#define PERL_ARGS_ASSERT_PERLY_SIGHANDLER
 PERL_CALLCONV void     Perl_pmop_dump(pTHX_ PMOP* pm);
 #define PERL_ARGS_ASSERT_PMOP_DUMP
 PERL_CALLCONV OP*      Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, UV flags, I32 floor);