Perl_magic_setsig/clearsig problems (patch included)

[p5pRT]

Migrated from rt.perl.org#20613 (status was 'resolved')

Searchable as RT20613$

[p5pRT]

From ajohnson@wischip.com

I discovered a few problems with setting and clearing %SIG entries in the Perl 5.8.0 production release (currently the same as the development release). To wit​:

+ Deleting a %SIG entry does not restore the default signal/hook disposition. + The previous disposition SV refcount is decremented (possibly resulting in its deallocation) *before* the new disposition is in place\, and while the handler is in an inconsistent state. If it's a coderef with closures\, then just about anything can happen at that point\, which is bad because DESTROY might need the new handler to be in place. + A signal can arrive while it's being dispositioned\, which could\, for example\, cause the program to terminate immediately while we're switching from one handler to another. + There are a couple of apparently redundant "*svp=0" statements. (I commented them\, but I was too chicken to remove them.)

The patch includes a test case for the first 2 items. Here are a couple of items that I might have screwed up and should be reviewed by a more experienced Perl hacker​:

+ The test case uses "$? & 0xFF" to see if the closed pipe exited from a signal. Is this portable? + Is there any way (e.g. exception?) that Perl_magic_setsig() might escape without restoring the sigprocmask? (If so\, we could maybe use the trick from POSIX​::sigaction to get around that.) This could also result in a memory leak (because "to_dec" would get ignored).

Here is the patch​:

Inline Patch

```diff diff -Naur perl-5.8.0/mg.c perl-5.8.0-sig2/mg.c --- perl-5.8.0/mg.c Sat Jun 15 13:16:44 2002 +++ perl-5.8.0-sig2/mg.c Wed Jan 29 13:27:34 2003 @@ -1061,19 +1061,48 @@ 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 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; + SvREFCNT_dec(to_dec); + } + }   }   return 0; } @​@​ -1156\,7 +1185\,15 @​@​   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; +#endif

  s = MgPV(mg\,len);   if (*s == '_') { @​@​ -1168\,7 +1205\,7 @​@​   Perl_croak(aTHX_ "No such hook​: %s"\, s);   i = 0;   if (*svp) { - SvREFCNT_dec(*svp); + to_dec = *svp;   *svp = 0;   }   } @​@​ -1179\,6 +1216\,12 @​@​   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); +#endif #if defined(FAKE_PERSISTENT_SIGNAL_HANDLERS) || defined(FAKE_DEFAULT_SIGNAL_HANDLERS)   if (!sig_handlers_initted) Perl_csighandler_init(); #endif @​@​ -1189\,17 +1232\,23 @​@​   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 + sigprocmask(SIG_SETMASK\, &save\, NULL); +#endif + }   else   *svp = SvREFCNT_inc(sv); + if(to_dec) + SvREFCNT_dec(to_dec);   return 0;   }   s = SvPV_force(sv\,len); @​@​ -1212\,7 +1261\,7 @​@​   (void)rsignal(i\, SIG_IGN); #endif   } else - *svp = 0; + *svp = 0; /* XXX​: Redundant? */   }   else if (strEQ(s\,"DEFAULT") || !*s) {   if (i) @​@​ -1225\,7 +1274\,7 @​@​   (void)rsignal(i\, SIG_DFL); #endif   else - *svp = 0; + *svp = 0; /* XXX​: Redundant? */   }   else {   /* @​@​ -1240\,6 +1289\,12 @​@​   else   *svp = SvREFCNT_inc(sv);   } +#ifdef HAS_SIGPROCMASK + if(i) + sigprocmask(SIG_SETMASK\, &save\, NULL); +#endif + if(to_dec) + SvREFCNT_dec(to_dec);   return 0; } #endif /* !PERL_MICRO */

Inline Patch

```diff diff -Naur perl-5.8.0/t/op/magic.t perl-5.8.0-sig2/t/op/magic.t --- perl-5.8.0/t/op/magic.t Wed Jul 10 17:18:07 2002 +++ perl-5.8.0-sig2/t/op/magic.t Wed Jan 29 13:00:40 2003 @@ -36,7 +36,7 @@ return 1; } -print "1..46\n"; +print "1..48\n"; $Is_MSWin32 = $^O eq 'MSWin32'; $Is_NetWare = $^O eq 'NetWare'; @@ -67,7 +67,7 @@ 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 @@ 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? ```

Here is the output from "perlbug -d":

---

Flags​:   category=   severity=

---

Site configuration information for perl v5.8.0​:

Configured by anders at Fri Nov 15 12​:33​:55 PST 2002.

Summary of my perl5 (revision 5.0 version 8 subversion 0) configuration​:   Platform​:   osname=linux\, osvers=2.4.18\, archname=i686-linux   uname='linux wolf12 2.4.18 #1 mon jul 8 14​:56​:03 pdt 2002 i686 unknown '   config_args='-de'   hint=recommended\, useposix=true\, d_sigaction=define   usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef   useperlio=define d_sfio=undef uselargefiles=define usesocks=undef   use64bitint=undef use64bitall=undef uselongdouble=undef   usemymalloc=n\, bincompat5005=undef   Compiler​:   cc='cc'\, ccflags ='-fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -I/usr/include/gdbm'\,   optimize='-O2'\,   cppflags='-fno-strict-aliasing -I/usr/local/include -I/usr/include/gdbm'   ccversion=''\, gccversion='2.96 20000731 (Red Hat Linux 7.1 2.96-98)'\, gccosandvers=''   intsize=4\, longsize=4\, ptrsize=4\, doublesize=8\, byteorder=1234   d_longlong=define\, longlongsize=8\, d_longdbl=define\, longdblsize=12   ivtype='long'\, ivsize=4\, nvtype='double'\, nvsize=8\, Off_t='off_t'\, lseeksize=8   alignbytes=4\, prototype=define   Linker and Libraries​:   ld='cc'\, ldflags =' -L/usr/local/lib'   libpth=/usr/local/lib /lib /usr/lib   libs=-lnsl -lndbm -lgdbm -ldl -lm -lc -lcrypt -lutil   perllibs=-lnsl -ldl -lm -lc -lcrypt -lutil   libc=/lib/libc-2.2.4.so\, so=so\, useshrplib=false\, libperl=libperl.a   gnulibc_version='2.2.4'   Dynamic Linking​:   dlsrc=dl_dlopen.xs\, dlext=so\, d_dlsymun=undef\, ccdlflags='-rdynamic'   cccdlflags='-fpic'\, lddlflags='-shared -L/usr/local/lib'

Locally applied patches​:  

---

@​INC for perl v5.8.0​:   /tools/By-Install/perl/5.8.0/i686-linux2.4/1/lib/5.8.0/i686-linux   /tools/By-Install/perl/5.8.0/i686-linux2.4/1/lib/5.8.0   /tools/By-Install/cpan/living/i686-linux2.4/1/lib/cpan/i686-linux   /tools/By-Install/cpan/living/i686-linux2.4/1/lib/cpan   /tools/By-Install/cpan/living/i686-linux2.4/1/lib/cpan   .

---

Environment for perl v5.8.0​:   HOME=/home1/anders   LANG=en_US   LANGUAGE (unset)

LD_LIBRARY_PATH=/opt/cadence/linux/ldv-3.4/tools/lib​:/opt/cadence/linux/ ldv-3.4/tools/inca/lib​:/usr/local/lib   LOGDIR (unset)

PATH=/home1/anders/bin​:/tools/bin​:/opt/cadence/linux/ldv-3.4/tools/bin​:/ opt/cadence/linux/ldv-3.4/tools/inca/bin​:/opt/synopsys/linux/vcs/bin​:/op t/synopsys/linux/vcs/virsimdir/bin​:/usr/local/vnc​:/opt/synopsys/linux/sc l/linux/bin​:/usr/local/bin​:/bin​:/usr/bin​:/usr/X11R6/bin​:.   PERLDOC_PAGER=less -Cr   PERL_BADLANG (unset)   SHELL=/bin/csh

[p5pRT]

From goldbb2@earthlink.net

"Anders Johnson (via RT)" wrote​: [snip]

+ if(PL_psig_ptr[i]) { + to_dec=PL_psig_ptr[i]; + PL_psig_ptr[i]=0; + SvREFCNT_dec(to_dec); + }

How often is stuff like this used/needed\, throughout perl's source? It's not exactly something one can grep for\, after all...

I suspect (fear) that many places where this should be done\, but isn't.

Eg\, av_clear stores sv_undef in the array slot before decrementing the refcount of that sv\, but neither av_undef nor av_fill do.

In gv_fetchmeth\, I see​:   SvREFCNT_dec(cv);   GvCV(topgv) = cv = Nullcv; Should this do something similar (replace\, then dec?)? I suppose that it's rare that coderefs get blessed at all\, let alone into classes with destructors\, so it would be hard to provoke this accidentally\, but it's concievable. There're other places throughout perl which likewise derecemnt before replacing.

  perl -e '@​x = (bless[]); sub DESTROY{pop @​x}; undef @​x'   perl -e '@​x = (bless[]); sub DESTROY{pop @​x}; $#x=-1'   perl -e '%x = (1\,bless[]); sub DESTROY{ delete $x{1}; }; %x=()'

Knowing that the problem exists\, I'm sure that someone could come up with perl code which provokes the others.

-- $..='(?​:(?{local$^C=$^C|'.(1\<\<$_).'})|)'for+a..4; $..='(?{print+substr"\n !\,$^C\,1 if $^C\<26})(?!)'; $.=~s'!'haktrsreltanPJ\,r coeueh"';BEGIN{${"\cH"} |=(1\<\<21)}""=~$.;qw(Just another Perl hacker\,\n);

[p5pRT]

From ajohnson@wischip.com

Just so you know\, I have some revisions on this patch to deal with some other potential problems that I just discovered by digging though mg.c.

Rather than confuse the issue right now\, I'll wait for confirmation that I'm on the right track before submitting the revised patch.

Thanks\, &ers

[p5pRT]

From ajohnson@wischip.com

I think I see your point. Still\, my vote would be to fix these issues to the extent that we know about them. At worst\, there are 442 instances of SvREFCNT_dec to look at in the entire source tree.

OTOH\, you can certainly make the argument that most of these bugs require truly contrived cases to provoke\, and therefore it isn't worth the effort. However\, the particular bug fixed by the patch was provoked by an attempt to accumulate received signals in a critical section block\, and then deliver those signals to the process when the critical section exits\, which I think you'll agree is legitimate (but see below).

Incidentally\, there are some related issues that I've recently discovered​:

+ If a signal is received just as you're changing its disposition from a handler to DEFAULT\, then the signal could get deferred until after the disposition changes\, which generally results in badness. (I already have a patch for this one.)

+ It's still not safe for a signal handler to die() (which is otherwise very useful)\, because it can prevent a DESTROY method from doing its job. (This is analogous to the "destructors must never\, ever throw" rule in C++. See http​://www.gotw.ca/gotw/047.htm .)

I think that fixing the second issue requires adding some critical-section support to Perl itself. (Perhaps a $^E variable that inhibits signal sampling and is automatically set locally for any DESTROY and STORE methods that get called on behalf of a block exiting.) If such a thing were to exist\, then you could certainly call my test case contrived\, since you could then use "local $^E=1;" to accomplish basically the same thing.

Of course\, I'm all ears if you have any better ideas. I'm particularly fond of any solution that doesn't require modifying the Perl core\, so long as it's clean and robust.

Thanks\, &ers

[p5pRT]

From nick@ing-simmons.net

Benjamin Goldberg \goldbb2@&#8203;earthlink\.net writes​:

"Anders Johnson (via RT)" wrote​: [snip]

+ if(PL_psig_ptr[i]) { + to_dec=PL_psig_ptr[i]; + PL_psig_ptr[i]=0; + SvREFCNT_dec(to_dec); + }

How often is stuff like this used/needed\, throughout perl's source? It's not exactly something one can grep for\, after all...

I suspect (fear) that many places where this should be done\, but isn't.

I don't fully grasp what the problem is yet. The "safe signals" code in 5.8 should make the above _less_ necessary. Signals should only be asynchronously messing with a always allocated array of counts. All access to perl SVs etc. should be synchronous - so what is getting in during the decrement? And which bit of code let it?

Eg\, av_clear stores sv_undef in the array slot before decrementing the refcount of that sv\, but neither av_undef nor av_fill do.

In gv_fetchmeth\, I see​: SvREFCNT_dec(cv); GvCV(topgv) = cv = Nullcv; Should this do something similar (replace\, then dec?)? I suppose that it's rare that coderefs get blessed at all\, let alone into classes with destructors\, so it would be hard to provoke this accidentally\, but it's concievable. There're other places throughout perl which likewise derecemnt before replacing.

perl -e '@​x = (bless[]); sub DESTROY{pop @​x}; undef @​x' perl -e '@​x = (bless[]); sub DESTROY{pop @​x}; $#x=-1' perl -e '%x = (1\,bless[]); sub DESTROY{ delete $x{1}; }; %x=()'

Knowing that the problem exists\, I'm sure that someone could come up with perl code which provokes the others. -- Nick Ing-Simmons http​://www.ni-s.u-net.com/

[p5pRT]

From nick@ing-simmons.net

Anders Johnson \ajohnson@&#8203;wischip\.com writes​:

Incidentally\, there are some related issues that I've recently discovered​:

+ If a signal is received just as you're changing its disposition from a handler to DEFAULT\, then the signal could get deferred until after the disposition changes\, which generally results in badness. (I already have a patch for this one.)

If the signal had arrived slightly later (machine busier) it would have gone to DEFAULT handler - so changing handlers when signals maybe in the pipe is source of the "badness".

+ It's still not safe for a signal handler to die() (which is otherwise very useful)\, because it can prevent a DESTROY method from doing its job. (This is analogous to the "destructors must never\, ever throw" rule in C++. See http​://www.gotw.ca/gotw/047.htm .)

Can you explain some more?

I think that fixing the second issue requires adding some critical-section support to Perl itself. (Perhaps a $^E variable that inhibits signal sampling and is automatically set locally for any DESTROY and STORE methods that get called on behalf of a block exiting.) If such a thing were to exist\, then you could certainly call my test case contrived\, since you could then use "local $^E=1;" to accomplish basically the same thing.

Of course\, I'm all ears if you have any better ideas. I'm particularly fond of any solution that doesn't require modifying the Perl core\, so long as it's clean and robust.

Thanks\, &ers -- Nick Ing-Simmons http​://www.ni-s.u-net.com/

[p5pRT]

From ajohnson@wischip.com

[I tried to send this yesterday\, but our email server was hosed. Sorry if this is a duplicate.]

Nick Ing-Simmons​:

I don't fully grasp what the problem is yet. The "safe signals" code in 5.8 should make the above _less_ necessary. Signals should only be asynchronously messing with a always allocated array of counts. All access to perl SVs etc. should be synchronous - so what is getting in during the decrement? And which bit of code let it?

This particular problems arises from the DESTROY method(s) associated with the scalar being freed through SvREFCNT_dec. Signals get sampled inside DESTROY methods\, so calls to SvREFCNT_dec can result in PERL_ASYNC_CHECK() being called. The test case included in the patch illustrates the problem.

The sigprocmask() stuff in the original patch is actually bogus because of the new "safe signals" code. Sorry about that. However\, something similar is needed to fix one of the related problems (see below).

Nick Ing-Simmons​:

If the signal had arrived slightly later (machine busier) it would have gone to DEFAULT handler - so changing handlers when signals maybe in the pipe is source of the "badness".

Let me try to predict what will happen (and since this is difficult to reproduce reliably\, I'll let you correct me if I'm wrong)​:

1. We enter Perl_magic_setsig() with a new disposition of "DEFAULT". 2. The signal arrives\, setting PL_sig_pending and PL_psig_pend[sig]. 3. PL_psig_ptr[sig] and PL_psig_name[sig] are set to "DEFAULT". 4. The signal is redispositioned to SIG_DFL. 5. We return from Perl_magic_setsig()\, and back into the Perl code. 6. At some point soon thereafter\, Perl_despatch_signal() is called\, which   calls Perl_sighandler() on behalf of the signal. 7. "SIGxxx handler \"DEFAULT\" not defined." (I call this badness.)

It seems to me that fundamentally you need to prevent #2 from happening\, or you'll be in trouble. You could require the Perl code to call POSIX​::sigprocmask() before assigning to %SIG\, but that's pretty ugly. My vote would be to have Perl_magic_setsig() and Perl_magic_clearsig() take care of this for you. (I have a patch for this\, but I'd prefer to resolve the issues before we start shooting various patches back and forth.)

Nick Ing-Simmons​:

Can you explain some more?

That bit about destructors not throwing is a subtle point that C++'ers have debated at some length\, but ultimately the only clean solution is that it should never\, ever happen. Ever. Here's an example​:

Consider an object that represents a temporary file. When the object goes out of scope\, you require the temporary file to be removed *without exception*. Now suppose that you just reached the end of the block containing the object\, and you're in the middle of the object's DESTROY method\, after you've done some stuff but before the file has been removed. Then a signal arrives and its handler die()s. Now you're in a world of hurt\, because either A) you've already decremented the object's reference count\, and the file isn't going to be removed at all\, or B) the die() causes the reference count to go to zero\, in which case you'll restart the DESTROY method from the beginning\, which is bad because the object is probably in an inconsistent state.

There are lots of other ways for this to cause problems\, including leaking gobs of memory and so forth. But if you can take care of this example\, then you're probably on the right track.

I can think of two distinct ways to attack the problem\, the first of which is that "$^E" stuff I mentioned earlier. The second would be to guarantee that DESTROY and STORE methods (STORE can get called when a tie'd local goes out of scope) always get restarted\, and then to require those methods to put a "local $SIG{...}" or "eval" around critical code. (This second approach leads us back to handlers that can accumulate signals\, which is what exposes that first problem.)

Thanks\, &ers

[p5pRT]

From ajohnson@wischip.com

This thread seems to have died out unexpectedly. I've included my latest patch (relative to 5.8.0)\, which is alleged to do the following​:

+ Signal handler isn't freed until after the new disposition is installed. + Signal can't get deferred and then polled after the handler is removed. + delete $SIG{...} is roughly equivalent to $SIG{...}="DEFAULT". + A couple of redundant statements were removed.

There is still the issue of a signal handler calling die() while the main thread is inside a destructor. I'd like to discuss what can be done about this\, but it shouldn't necessarily preclude applying the patch as-is.

Robust\, clean signal handling is apparently a goal of Perl 5.7.3 and later. I think it's important to make that a reality\, and not just a promise. I'm here to help if I can.

Thanks\, &ers

----- Begin Patch -----

Inline Patch

```diff diff -Naur perl-5.8.0/mg.c perl-5.8.0-sig3/mg.c --- perl-5.8.0/mg.c Sat Jun 15 13:16:44 2002 +++ perl-5.8.0-sig3/mg.c Wed Jan 29 17:17:46 2003 @@ -1028,6 +1028,14 @@ #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) { @@ -1061,19 +1069,67 @@ 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; } @​@​ -1156\,7 +1212\,16 @​@​   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 == '_') { @​@​ -1168\,7 +1233\,7 @​@​   Perl_croak(aTHX_ "No such hook​: %s"\, s);   i = 0;   if (*svp) { - SvREFCNT_dec(*svp); + to_dec = *svp;   *svp = 0;   }   } @​@​ -1179\,6 +1244\,17 @​@​   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 @​@​ -1186\,20 +1262\,26 @​@​   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); @​@​ -1211\,8 +1293\,7 @​@​ #else   (void)rsignal(i\, SIG_IGN); #endif - } else - *svp = 0; + }   }   else if (strEQ(s\,"DEFAULT") || !*s) {   if (i) @​@​ -1224\,8 +1305\,6 @​@​ #else   (void)rsignal(i\, SIG_DFL); #endif - else - *svp = 0;   }   else {   /* @​@​ -1240\,6 +1319\,12 @​@​   else   *svp = SvREFCNT_inc(sv);   } +#ifdef HAS_SIGPROCMASK + if(i) + LEAVE; +#endif + if(to_dec) + SvREFCNT_dec(to_dec);   return 0; } #endif /* !PERL_MICRO */

Inline Patch

```diff diff -Naur perl-5.8.0/t/op/magic.t perl-5.8.0-sig3/t/op/magic.t --- perl-5.8.0/t/op/magic.t Wed Jul 10 17:18:07 2002 +++ perl-5.8.0-sig3/t/op/magic.t Wed Jan 29 13:00:40 2003 @@ -36,7 +36,7 @@ return 1; } -print "1..46\n"; +print "1..48\n"; $Is_MSWin32 = $^O eq 'MSWin32'; $Is_NetWare = $^O eq 'NetWare'; @@ -67,7 +67,7 @@ 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 @@ 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? ```

[p5pRT]

From @hvds

"Anders Johnson" \ajohnson@&#8203;wischip\.com wrote​: :This thread seems to have died out unexpectedly. I've included my latest :patch (relative to 5.8.0)\, which is alleged to do the following​: : :+ Signal handler isn't freed until after the new disposition is :installed. :+ Signal can't get deferred and then polled after the handler is :removed. :+ delete $SIG{...} is roughly equivalent to $SIG{...}="DEFAULT". :+ A couple of redundant statements were removed. : :There is still the issue of a signal handler calling die() while the :main thread is inside a destructor. I'd like to discuss what can be done :about this\, but it shouldn't necessarily preclude applying the patch :as-is.

Thanks\, applied to the development sources as change #18803.

Please note that your mailer appears to be wrapping lines in patches; if you don't have a way to stop it doing that\, I'd suggest sending any future patches as attachments instead.

Hugo

[p5pRT]

@rspier - Status changed from 'new' to 'resolved'