From: Chip Salzenberg Date: Wed, 9 Jul 2003 01:49:10 +0000 (-0400) Subject: Safe signals via POSIX::sigaction X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d36b65820b6b5e1d5ddb96186c8b7aa0b6e2ce9f;hp=463d09e6aae174eaf79dbe628f27cb752bc2f77b;p=p5sagit%2Fp5-mst-13.2.git Safe signals via POSIX::sigaction Message-ID: <20030709054910.GH2021@perlsupport.com> p4raw-id: //depot/perl@20081 --- diff --git a/embed.fnc b/embed.fnc index b8b3252..704f8d5 100644 --- a/embed.fnc +++ b/embed.fnc @@ -689,6 +689,7 @@ p |I32 |setenv_getix |char* nam p |void |setdefout |GV* gv p |HEK* |share_hek |const char* sv|I32 len|U32 hash np |Signal_t |sighandler |int sig +np |Signal_t |csighandler |int sig Ap |SV** |stack_grow |SV** sp|SV**p|int n Ap |I32 |start_subparse |I32 is_format|U32 flags p |void |sub_crush_depth|CV* cv diff --git a/embed.h b/embed.h index e872a31..951ff7b 100644 --- a/embed.h +++ b/embed.h @@ -958,6 +958,9 @@ #ifdef PERL_CORE #define sighandler Perl_sighandler #endif +#ifdef PERL_CORE +#define csighandler Perl_csighandler +#endif #define stack_grow Perl_stack_grow #define start_subparse Perl_start_subparse #ifdef PERL_CORE @@ -3445,6 +3448,9 @@ #ifdef PERL_CORE #define sighandler Perl_sighandler #endif +#ifdef PERL_CORE +#define csighandler Perl_csighandler +#endif #define stack_grow(a,b,c) Perl_stack_grow(aTHX_ a,b,c) #define start_subparse(a,b) Perl_start_subparse(aTHX_ a,b) #ifdef PERL_CORE diff --git a/ext/POSIX/POSIX.pm b/ext/POSIX/POSIX.pm index 74a014f..06e2252 100644 --- a/ext/POSIX/POSIX.pm +++ b/ext/POSIX/POSIX.pm @@ -54,7 +54,7 @@ sub AUTOLOAD { package POSIX::SigAction; use AutoLoader 'AUTOLOAD'; -sub new { bless {HANDLER => $_[1], MASK => $_[2], FLAGS => $_[3] || 0}, $_[0] } +sub new { bless {HANDLER => $_[1], MASK => $_[2], FLAGS => $_[3] || 0, SAFE => 0}, $_[0] } package POSIX; @@ -961,3 +961,4 @@ package POSIX::SigAction; sub handler { $_[0]->{HANDLER} = $_[1] if @_ > 1; $_[0]->{HANDLER} }; sub mask { $_[0]->{MASK} = $_[1] if @_ > 1; $_[0]->{MASK} }; sub flags { $_[0]->{FLAGS} = $_[1] if @_ > 1; $_[0]->{FLAGS} }; +sub safe { $_[0]->{SAFE} = $_[1] if @_ > 1; $_[0]->{SAFE} }; diff --git a/ext/POSIX/POSIX.pod b/ext/POSIX/POSIX.pod index 7517a85..598464d 100644 --- a/ext/POSIX/POSIX.pod +++ b/ext/POSIX/POSIX.pod @@ -1641,9 +1641,9 @@ object, it defaults to the empty set. The third parameter contains the C, it defaults to 0. $sigset = POSIX::SigSet->new(SIGINT, SIGQUIT); - $sigaction = POSIX::SigAction->new( 'main::handler', $sigset, &POSIX::SA_NOCLDSTOP ); + $sigaction = POSIX::SigAction->new( \&main::handler, $sigset, &POSIX::SA_NOCLDSTOP ); -This C object should be used with the C +This C object is intended for use with the C function. =back @@ -1661,6 +1661,23 @@ accessor functions to get/set the values of a SigAction object. $sigset = $sigaction->mask; $sigaction->flags(&POSIX::SA_RESTART); +=item safe + +accessor function for the "safe signals" flag of a SigAction object; see +L for general information on safe (a.k.a. "deferred") signals. If +you wish to handle a signal safely, use this accessor to set the "safe" flag +in the C object: + + $sigaction->safe(1); + +You may also examine the "safe" flag on the output action object which is +filled in when given as the third parameter to C: + + sigaction(SIGINT, $new_action, $old_action); + if ($old_action->safe) { + # previous SIGINT handler used safe signals + } + =back =head2 POSIX::SigSet diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index 11f74d4..3798152 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -1290,16 +1290,34 @@ sigaction(sig, optaction, oldaction = 0) /* Get back the flags. */ svp = hv_fetch(oldaction, "FLAGS", 5, TRUE); sv_setiv(*svp, oact.sa_flags); + + /* Get back whether the old handler used safe signals. */ + svp = hv_fetch(oldaction, "SAFE", 4, TRUE); + sv_setiv(*svp, oact.sa_handler == Perl_csighandler); } if (action) { - /* Vector new handler through %SIG. (We always use sighandler - for the C signal handler, which reads %SIG to dispatch.) */ + /* Safe signals use "csighandler", which vectors through the + PL_sighandlerp pointer when it's safe to do so. + (BTW, "csighandler" is very different from "sighandler".) */ + svp = hv_fetch(action, "SAFE", 4, FALSE); + act.sa_handler = (*svp && SvTRUE(*svp)) + ? Perl_csighandler : PL_sighandlerp; + + /* Vector new Perl handler through %SIG. + (The core signal handlers read %SIG to dispatch.) */ svp = hv_fetch(action, "HANDLER", 7, FALSE); if (!svp) croak("Can't supply an action without a HANDLER"); sv_setsv(*sigsvp, *svp); - mg_set(*sigsvp); /* handles DEFAULT and IGNORE */ + + /* This call actually calls sigaction() with almost the + right settings, including appropriate interpretation + of DEFAULT and IGNORE. However, why are we doing + this when we're about to do it again just below? XXX */ + mg_set(*sigsvp); + + /* And here again we duplicate -- DEFAULT/IGNORE checking. */ if(SvPOK(*svp)) { char *s=SvPVX(*svp); if(strEQ(s,"IGNORE")) { @@ -1308,12 +1326,6 @@ sigaction(sig, optaction, oldaction = 0) else if(strEQ(s,"DEFAULT")) { act.sa_handler = SIG_DFL; } - else { - act.sa_handler = PL_sighandlerp; - } - } - else { - act.sa_handler = PL_sighandlerp; } /* Set up any desired mask. */ diff --git a/ext/POSIX/t/sigaction.t b/ext/POSIX/t/sigaction.t index d2db20b..38cde16 100644 --- a/ext/POSIX/t/sigaction.t +++ b/ext/POSIX/t/sigaction.t @@ -21,7 +21,7 @@ use vars qw/$bad7 $ok10 $bad18 $ok/; $^W=1; -print "1..21\n"; +print "1..25\n"; sub IGNORE { $bad7=1; @@ -155,3 +155,29 @@ if ($^O eq 'VMS') { kill "HUP", $$; print $hup21 == 1 ? "ok 21\n" : "not ok 21\n"; } + +# "safe" attribute. +# for this one, use the accessor instead of the attribute + +# standard signal handling via %SIG is safe +$SIG{HUP} = \&foo; +$oldaction = POSIX::SigAction->new; +sigaction(SIGHUP, undef, $oldaction); +print $oldaction->safe ? "ok 22\n" : "not ok 22\n"; + +# SigAction handling is not safe ... +sigaction(SIGHUP, POSIX::SigAction->new(\&foo)); +sigaction(SIGHUP, undef, $oldaction); +print $oldaction->safe ? "not ok 23\n" : "ok 23\n"; + +# ... unless we say so! +$newaction = POSIX::SigAction->new(\&foo); +$newaction->safe(1); +sigaction(SIGHUP, $newaction); +sigaction(SIGHUP, undef, $oldaction); +print $oldaction->safe ? "ok 24\n" : "not ok 24\n"; + +# And safe signal delivery must work +$ok = 0; +kill 'HUP', $$; +print $ok ? "ok 25\n" : "not ok 25\n"; diff --git a/proto.h b/proto.h index 54882c1..bb91615 100644 --- a/proto.h +++ b/proto.h @@ -659,6 +659,7 @@ PERL_CALLCONV I32 Perl_setenv_getix(pTHX_ char* nam); PERL_CALLCONV void Perl_setdefout(pTHX_ GV* gv); PERL_CALLCONV HEK* Perl_share_hek(pTHX_ const char* sv, I32 len, U32 hash); PERL_CALLCONV Signal_t Perl_sighandler(int sig); +PERL_CALLCONV Signal_t Perl_csighandler(int sig); PERL_CALLCONV SV** Perl_stack_grow(pTHX_ SV** sp, SV**p, int n); PERL_CALLCONV I32 Perl_start_subparse(pTHX_ I32 is_format, U32 flags); PERL_CALLCONV void Perl_sub_crush_depth(pTHX_ CV* cv);