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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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<sa_flags>, 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<POSIX::SigAction> object should be used with the C<POSIX::sigaction()>
+This C<POSIX::SigAction> object is intended for use with the C<POSIX::sigaction()>
 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<perlipc> 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<POSIX::SigAction> 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<POSIX::sigaction()>:
+
+       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 (file)
--- 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 (file)
--- 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 (file)
--- 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);