From: Anders Johnson Date: Mon, 10 Feb 2003 14:09:46 +0000 (-0800) Subject: RE: [perl #20613] Perl_magic_setsig/clearsig problems (patch included) X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2d4fcd5e8be8d83efa948a259c49b56fc6c27ee5;p=p5sagit%2Fp5-mst-13.2.git RE: [perl #20613] Perl_magic_setsig/clearsig problems (patch included) From: "Anders Johnson" Message-ID: <000e01c2d151$2228ca90$9800a8c0@wis.com> p4raw-id: //depot/perl@18803 --- diff --git a/mg.c b/mg.c index 18c686d..433cc23 100644 --- 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 --- 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?