RE: [perl #20613] Perl_magic_setsig/clearsig problems (patch included)

From: "Anders Johnson" <ajohnson@wischip.com>
Message-ID: <000e01c2d151$2228ca90$9800a8c0@wis.com>

p4raw-id: //depot/perl@18803

diff --git a/mg.c b/mg.c
index 18c686d..433cc23 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -1043,6 +1043,14 @@ static int sig_defaulting[SIG_SIZE];
 #endif
 
 #ifndef PERL_MICRO
+#ifdef HAS_SIGPROCMASK
+static void
+restore_sigmask(pTHX_ SV *save_sv)
+{
+    sigset_t *ossetp = (sigset_t *) SvPV_nolen( save_sv );
+    (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0);
+}
+#endif
 int
 Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg)
 {
@@ -1076,19 +1084,67 @@ Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_clearsig(pTHX_ SV *sv, MAGIC *mg)
 {
-    I32 i;
+    /* XXX Some of this code was copied from Perl_magic_setsig. A little
+     * refactoring might be in order.
+     */
+    register char *s;
     STRLEN n_a;
-    /* Are we clearing a signal entry? */
-    i = whichsig(MgPV(mg,n_a));
-    if (i) {
-       if(PL_psig_ptr[i]) {
-           SvREFCNT_dec(PL_psig_ptr[i]);
-           PL_psig_ptr[i]=0;
-       }
-       if(PL_psig_name[i]) {
-           SvREFCNT_dec(PL_psig_name[i]);
-           PL_psig_name[i]=0;
-       }
+    SV* to_dec;
+    s = MgPV(mg,n_a);
+    if (*s == '_') {
+       SV** svp;
+       if (strEQ(s,"__DIE__"))
+           svp = &PL_diehook;
+       else if (strEQ(s,"__WARN__"))
+           svp = &PL_warnhook;
+       else
+           Perl_croak(aTHX_ "No such hook: %s", s);
+       if (*svp) {
+           to_dec = *svp;
+           *svp = 0;
+           SvREFCNT_dec(to_dec);
+       }
+    }
+    else {
+       I32 i;
+       /* Are we clearing a signal entry? */
+       i = whichsig(s);
+       if (i) {
+#ifdef HAS_SIGPROCMASK
+           sigset_t set, save;
+           SV* save_sv;
+           /* Avoid having the signal arrive at a bad time, if possible. */
+           sigemptyset(&set);
+           sigaddset(&set,i);
+           sigprocmask(SIG_BLOCK, &set, &save);
+           ENTER;
+           save_sv = newSVpv((char *)(&save), sizeof(sigset_t));
+           SAVEFREESV(save_sv);
+           SAVEDESTRUCTOR_X(restore_sigmask, save_sv);
+#endif
+           PERL_ASYNC_CHECK();
+#if defined(FAKE_PERSISTENT_SIGNAL_HANDLERS) || defined(FAKE_DEFAULT_SIGNAL_HANDLERS)
+           if (!sig_handlers_initted) Perl_csighandler_init();
+#endif
+#ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
+           sig_defaulting[i] = 1;
+           (void)rsignal(i, &Perl_csighandler);
+#else
+           (void)rsignal(i, SIG_DFL);
+#endif
+           if(PL_psig_name[i]) {
+               SvREFCNT_dec(PL_psig_name[i]);
+               PL_psig_name[i]=0;
+           }
+           if(PL_psig_ptr[i]) {
+               to_dec=PL_psig_ptr[i];
+               PL_psig_ptr[i]=0;
+               LEAVE;
+               SvREFCNT_dec(to_dec);
+           }
+           else
+               LEAVE;
+       }
     }
     return 0;
 }
@@ -1173,7 +1229,16 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
     register char *s;
     I32 i;
     SV** svp = 0;
+    /* Need to be careful with SvREFCNT_dec(), because that can have side
+     * effects (due to closures). We must make sure that the new disposition
+     * is in place before it is called.
+     */
+    SV* to_dec = 0;
     STRLEN len;
+#ifdef HAS_SIGPROCMASK
+    sigset_t set, save;
+    SV* save_sv;
+#endif
 
     s = MgPV(mg,len);
     if (*s == '_') {
@@ -1185,7 +1250,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
            Perl_croak(aTHX_ "No such hook: %s", s);
        i = 0;
        if (*svp) {
-           SvREFCNT_dec(*svp);
+           to_dec = *svp;
            *svp = 0;
        }
     }
@@ -1196,6 +1261,17 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
                Perl_warner(aTHX_ packWARN(WARN_SIGNAL), "No such signal: SIG%s", s);
            return 0;
        }
+#ifdef HAS_SIGPROCMASK
+       /* Avoid having the signal arrive at a bad time, if possible. */
+       sigemptyset(&set);
+       sigaddset(&set,i);
+       sigprocmask(SIG_BLOCK, &set, &save);
+       ENTER;
+       save_sv = newSVpv((char *)(&save), sizeof(sigset_t));
+       SAVEFREESV(save_sv);
+       SAVEDESTRUCTOR_X(restore_sigmask, save_sv);
+#endif
+       PERL_ASYNC_CHECK();
 #if defined(FAKE_PERSISTENT_SIGNAL_HANDLERS) || defined(FAKE_DEFAULT_SIGNAL_HANDLERS)
        if (!sig_handlers_initted) Perl_csighandler_init();
 #endif
@@ -1203,20 +1279,26 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
        sig_ignoring[i] = 0;
 #endif
 #ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
-         sig_defaulting[i] = 0;
+       sig_defaulting[i] = 0;
 #endif
        SvREFCNT_dec(PL_psig_name[i]);
-       SvREFCNT_dec(PL_psig_ptr[i]);
+       to_dec = PL_psig_ptr[i];
        PL_psig_ptr[i] = SvREFCNT_inc(sv);
        SvTEMP_off(sv); /* Make sure it doesn't go away on us */
        PL_psig_name[i] = newSVpvn(s, len);
        SvREADONLY_on(PL_psig_name[i]);
     }
     if (SvTYPE(sv) == SVt_PVGV || SvROK(sv)) {
-       if (i)
+       if (i) {
            (void)rsignal(i, &Perl_csighandler);
+#ifdef HAS_SIGPROCMASK
+           LEAVE;
+#endif
+       }
        else
            *svp = SvREFCNT_inc(sv);
+       if(to_dec)
+           SvREFCNT_dec(to_dec);
        return 0;
     }
     s = SvPV_force(sv,len);
@@ -1228,8 +1310,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
 #else
            (void)rsignal(i, SIG_IGN);
 #endif
-       } else
-           *svp = 0;
+       }
     }
     else if (strEQ(s,"DEFAULT") || !*s) {
        if (i)
@@ -1241,8 +1322,6 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
 #else
            (void)rsignal(i, SIG_DFL);
 #endif
-       else
-           *svp = 0;
     }
     else {
        /*
@@ -1257,6 +1336,12 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
        else
            *svp = SvREFCNT_inc(sv);
     }
+#ifdef HAS_SIGPROCMASK
+    if(i)
+       LEAVE;
+#endif
+    if(to_dec)
+       SvREFCNT_dec(to_dec);
     return 0;
 }
 #endif /* !PERL_MICRO */

diff --git a/t/op/magic.t b/t/op/magic.t
index 0619c0d..8f598a1 100755 (executable)
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -36,7 +36,7 @@ sub skip {
     return 1;
 }
 
-print "1..50\n";
+print "1..52\n";
 
 $Is_MSWin32 = $^O eq 'MSWin32';
 $Is_NetWare = $^O eq 'NetWare';
@@ -67,7 +67,7 @@ ok $!, $!;
 close FOO; # just mention it, squelch used-only-once
 
 if ($Is_MSWin32 || $Is_NetWare || $Is_Dos || $Is_MPE || $Is_MacOS) {
-    skip('SIGINT not safe on this platform') for 1..2;
+    skip('SIGINT not safe on this platform') for 1..4;
 }
 else {
   # the next tests are done in a subprocess because sh spits out a
@@ -98,7 +98,35 @@ END
 
     close CMDPIPE;
 
-    $test += 2;
+    open( CMDPIPE, "| $PERL");
+    print CMDPIPE <<'END';
+
+    { package X;
+       sub DESTROY {
+           kill "INT",$$;
+       }
+    }
+    sub x {
+       my $x=bless [], 'X';
+       return sub { $x };
+    }
+    $| = 1;            # command buffering
+    $SIG{"INT"} = "ok5";
+    {
+       local $SIG{"INT"}=x();
+       print ""; # Needed to expose failure in 5.8.0 (why?)
+    }
+    sleep 1;
+    delete $SIG{"INT"};
+    kill "INT",$$; sleep 1;
+    sub ok5 {
+       print "ok 5\n";
+    }
+END
+    close CMDPIPE;
+    print $? & 0xFF ? "ok 6\n" : "not ok 6\n";
+
+    $test += 4;
 }
 
 # can we slice ENV?