support POSIX SA_SIGINFO

Message-ID: <42DE3846.6050606@gmail.com>

p4raw-id: //depot/perl@25200

diff --git a/embed.fnc b/embed.fnc
index 7363a46..bbafdbe 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -706,8 +706,13 @@ p  |I32    |setenv_getix   |const char* nam
 #endif
 p      |void   |setdefout      |NULLOK GV* gv
 Ap     |HEK*   |share_hek      |NN const char* str|I32 len|U32 hash
+#if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
+np     |Signal_t |sighandler   |int sig|...
+Anp    |Signal_t |csighandler  |int sig|...
+#else
 np     |Signal_t |sighandler   |int sig
 Anp    |Signal_t |csighandler  |int sig
+#endif
 Ap     |SV**   |stack_grow     |NN SV** sp|NN SV**p|int n
 ApR    |I32    |start_subparse |I32 is_format|U32 flags
 p      |void   |sub_crush_depth|NN CV* cv

diff --git a/embed.h b/embed.h
index 023d8f3..9ab983a 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -750,10 +750,17 @@
 #define setdefout              Perl_setdefout
 #endif
 #define share_hek              Perl_share_hek
+#if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
 #ifdef PERL_CORE
 #define sighandler             Perl_sighandler
 #endif
 #define csighandler            Perl_csighandler
+#else
+#ifdef PERL_CORE
+#define sighandler             Perl_sighandler
+#endif
+#define csighandler            Perl_csighandler
+#endif
 #define stack_grow             Perl_stack_grow
 #define start_subparse         Perl_start_subparse
 #ifdef PERL_CORE
@@ -2740,10 +2747,15 @@
 #define setdefout(a)           Perl_setdefout(aTHX_ a)
 #endif
 #define share_hek(a,b,c)       Perl_share_hek(aTHX_ a,b,c)
+#if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
+#ifdef PERL_CORE
+#endif
+#else
 #ifdef PERL_CORE
 #define sighandler             Perl_sighandler
 #endif
 #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.pod b/ext/POSIX/POSIX.pod
index 147f2db..e7166a6 100644 (file)
--- a/ext/POSIX/POSIX.pod
+++ b/ext/POSIX/POSIX.pod
@@ -1130,6 +1130,31 @@ Returns C<undef> on failure.  The C<signal> must be a number (like
 SIGHUP), not a string (like "SIGHUP"), though Perl does try hard
 to understand you.
 
+If you use the SA_SIGINFO flag, the signal handler will in addition to
+the first argument, the signal name, also receive a second argument, a
+hash reference, inside which are the following keys with the following
+semantics, as defined by POSIX/SUSv3:
+
+    signo       the signal number
+    errno       the error number
+    code        if this is zero or less, the signal was sent by
+                a user process and the uid and pid make sense,
+                otherwise the signal was sent by the kernel
+    pid         the process id generating the signal
+    uid         the uid of the process id generating the signal
+    status      exit value or signal for SIGCHLD
+    band        band event for SIGPOLL
+
+A third argument is also passed to the handler, which contains a copy
+of the raw binary contents of the siginfo structure: if a system has
+some non-POSIX fields, this third argument is where to unpack() them
+from.
+
+Note that not all siginfo values make sense simultaneously (some are
+valid only for certain signals, for example), and not all values make
+sense from Perl perspective, you should to consult your system's
+C<sigaction> and possibly also C<siginfo> documentation.
+
 =item siglongjmp
 
 siglongjmp() is C-specific: use L<perlfunc/die> instead.

diff --git a/ext/POSIX/t/sigaction.t b/ext/POSIX/t/sigaction.t
index bc40b78..6de6cfb 100644 (file)
--- a/ext/POSIX/t/sigaction.t
+++ b/ext/POSIX/t/sigaction.t
@@ -16,7 +16,7 @@ BEGIN{
        }
 }
 
-use Test::More tests => 29;
+use Test::More tests => 30;
 
 use strict;
 use vars qw/$bad $bad7 $ok10 $bad18 $ok/;
@@ -190,3 +190,15 @@ SKIP: {
     kill 'SIGRTMIN', $$;
     is($sigrtmin, 1, "SIGRTMIN handler works");
 }
+
+SKIP: {
+    eval 'use POSIX qw(SA_SIGINFO); SA_SIGINFO';
+    skip("no SA_SIGINFO", 1) if $@;
+    sub hiphup {
+       is($_[1]->{pid}, $$, "SA_SIGINFO got right pid");
+    }
+    my $act = POSIX::SigAction->new('hiphup', 0, SA_SIGINFO);
+    sigaction(SIGHUP, $act);
+    kill 'HUP', $$;
+}
+

diff --git a/global.sym b/global.sym
index 5fccbc5..f17db24 100644 (file)
--- a/global.sym
+++ b/global.sym
@@ -430,6 +430,7 @@ Perl_scan_oct
 Perl_screaminstr
 Perl_share_hek
 Perl_csighandler
+Perl_csighandler
 Perl_stack_grow
 Perl_start_subparse
 Perl_sv_2bool

diff --git a/iperlsys.h b/iperlsys.h
index f84852d..8380c5b 100644 (file)
--- a/iperlsys.h
+++ b/iperlsys.h
@@ -51,7 +51,11 @@
 #include "perlio.h"
 
 #ifndef Sighandler_t
+#  if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
+typedef Signal_t (*Sighandler_t) (int, ...);
+#  else
 typedef Signal_t (*Sighandler_t) (int);
+#  endif
 #endif
 
 #if defined(PERL_IMPLICIT_SYS)

diff --git a/mg.c b/mg.c
index 78ccb9a..f4f8f60 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -52,7 +52,11 @@ tie.
 #  include <sys/pstat.h>
 #endif
 
+#if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
+Signal_t Perl_csighandler(int sig, ...);
+#else
 Signal_t Perl_csighandler(int sig);
+#endif
 
 #ifdef __Lynx__
 /* Missing protos on LynxOS */
@@ -1184,7 +1188,7 @@ Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg)
            if (PL_sig_handlers_initted && PL_sig_defaulting[i]) sigstate = SIG_DFL;
 #endif
            /* cache state so we don't fetch it again */
-           if(sigstate == SIG_IGN)
+           if(sigstate == (Sighandler_t) SIG_IGN)
                sv_setpv(sv,"IGNORE");
            else
                sv_setsv(sv,&PL_sv_undef);
@@ -1241,7 +1245,7 @@ Perl_magic_clearsig(pTHX_ SV *sv, MAGIC *mg)
            PL_sig_defaulting[i] = 1;
            (void)rsignal(i, PL_csighandlerp);
 #else
-           (void)rsignal(i, SIG_DFL);
+           (void)rsignal(i, (Sighandler_t) SIG_DFL);
 #endif
            if(PL_psig_name[i]) {
                SvREFCNT_dec(PL_psig_name[i]);
@@ -1270,7 +1274,11 @@ S_raise_signal(pTHX_ int sig)
 }
 
 Signal_t
+#if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
+Perl_csighandler(int sig, ...)
+#else
 Perl_csighandler(int sig)
+#endif
 {
 #ifdef PERL_GET_SIG_CONTEXT
     dTHXa(PERL_GET_SIG_CONTEXT);
@@ -1419,7 +1427,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
            PL_sig_ignoring[i] = 1;
            (void)rsignal(i, PL_csighandlerp);
 #else
-           (void)rsignal(i, SIG_IGN);
+           (void)rsignal(i, (Sighandler_t) SIG_IGN);
 #endif
        }
     }
@@ -1431,7 +1439,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
            (void)rsignal(i, PL_csighandlerp);
          }
 #else
-           (void)rsignal(i, SIG_DFL);
+           (void)rsignal(i, (Sighandler_t) SIG_DFL);
 #endif
     }
     else {
@@ -2613,7 +2621,7 @@ Perl_whichsig(pTHX_ const char *sig)
 }
 
 Signal_t
-Perl_sighandler(int sig)
+Perl_sighandler(int sig, ...)
 {
 #ifdef PERL_GET_SIG_CONTEXT
     dTHXa(PERL_GET_SIG_CONTEXT);
@@ -2683,6 +2691,36 @@ Perl_sighandler(int sig)
     PUSHSTACKi(PERLSI_SIGNAL);
     PUSHMARK(SP);
     PUSHs(sv);
+#if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
+    {
+        struct sigaction oact;
+
+        if (sigaction(sig, 0, &oact) == 0 && oact.sa_flags & SA_SIGINFO) {
+             siginfo_t *sip;
+             va_list args;
+
+             va_start(args, sig);
+             sip = (siginfo_t*)va_arg(args, siginfo_t*);
+             if (sip) {
+                  HV *sih = newHV();
+                  SV *rv  = newRV_noinc((SV*)sih);
+                  /* The siginfo fields signo, code, errno, pid, uid,
+                   * addr, status, and band are defined by POSIX/SUSv3. */
+                  hv_store(sih, "signo",   5, newSViv(sip->si_signo),  0);
+                  hv_store(sih, "code",    4, newSViv(sip->si_code),   0);
+                  hv_store(sih, "errno",   5, newSViv(sip->si_errno),  0);
+                  hv_store(sih, "uid",     3, newSViv(sip->si_uid),    0);
+                  hv_store(sih, "pid",     3, newSViv(sip->si_pid),    0);
+                  hv_store(sih, "addr",    4, newSVuv(PTR2UV(sip->si_addr)),   0);
+                  hv_store(sih, "status",  6, newSViv(sip->si_status), 0);
+                  hv_store(sih, "band",    4, newSViv(sip->si_band),   0);
+                  EXTEND(SP, 2);
+                  PUSHs((SV*)rv);
+                  PUSHs(newSVpv((void*)sip, sizeof(*sip)));
+             }
+        }
+    }
+#endif
     PUTBACK;
 
     call_sv((SV*)cv, G_DISCARD|G_EVAL);

diff --git a/perl.c b/perl.c
index 4884865..3ff4a80 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -258,7 +258,7 @@ perl_construct(pTHXx)
            SvREFCNT(&PL_sv_placeholder) = (~(U32)0)/2;
        }
 
-       PL_sighandlerp = Perl_sighandler;
+       PL_sighandlerp = (Sighandler_t) Perl_sighandler;
        PL_pidstatus = newHV();
     }
 
@@ -2001,7 +2001,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #  define SIGCHLD SIGCLD
 #endif
        Sighandler_t sigstate = rsignal_state(SIGCHLD);
-       if (sigstate == SIG_IGN) {
+       if (sigstate == (Sighandler_t) SIG_IGN) {
            if (ckWARN(WARN_SIGNAL))
                Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
                            "Can't ignore signal CHLD, forcing to default");

diff --git a/perl.h b/perl.h
index 9560689..63eba70 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -2404,7 +2404,7 @@ typedef struct clone_params CLONE_PARAMS;
 #    define PERL_FPU_INIT fpsetmask(0);
 #  else
 #    if defined(SIGFPE) && defined(SIG_IGN) && !defined(PERL_MICRO)
-#      define PERL_FPU_INIT       PL_sigfpe_saved = signal(SIGFPE, SIG_IGN);
+#      define PERL_FPU_INIT       PL_sigfpe_saved = (Sighandler_t) signal(SIGFPE, SIG_IGN);
 #      define PERL_FPU_PRE_EXEC   { Sigsave_t xfpe; rsignal_save(SIGFPE, PL_sigfpe_saved, &xfpe);
 #      define PERL_FPU_POST_EXEC    rsignal_restore(SIGFPE, &xfpe); }
 #    else

diff --git a/pp_sys.c b/pp_sys.c
index 0ce6f43..77613cb 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -4240,8 +4240,8 @@ PP(pp_system)
            if (did_pipes)
                PerlLIO_close(pp[1]);
 #ifndef PERL_MICRO
-           rsignal_save(SIGINT, SIG_IGN, &ihand);
-           rsignal_save(SIGQUIT, SIG_IGN, &qhand);
+           rsignal_save(SIGINT,  (Sighandler_t) SIG_IGN, &ihand);
+           rsignal_save(SIGQUIT, (Sighandler_t) SIG_IGN, &qhand);
 #endif
            do {
                result = wait4pid(childpid, &status, 0);

diff --git a/proto.h b/proto.h
index 888c991..522ee03 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1655,8 +1655,13 @@ PERL_CALLCONV void       Perl_setdefout(pTHX_ GV* gv);
 PERL_CALLCONV HEK*     Perl_share_hek(pTHX_ const char* str, I32 len, U32 hash)
                        __attribute__nonnull__(pTHX_1);
 
+#if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
+PERL_CALLCONV Signal_t Perl_sighandler(int sig, ...);
+PERL_CALLCONV Signal_t Perl_csighandler(int sig, ...);
+#else
 PERL_CALLCONV Signal_t Perl_sighandler(int sig);
 PERL_CALLCONV Signal_t Perl_csighandler(int sig);
+#endif
 PERL_CALLCONV SV**     Perl_stack_grow(pTHX_ SV** sp, SV**p, int n)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2);

diff --git a/util.c b/util.c
index 4f1a8e8..3635d35 100644 (file)
--- a/util.c
+++ b/util.c
@@ -2413,10 +2413,10 @@ Perl_rsignal(pTHX_ int signo, Sighandler_t handler)
 #ifdef USE_ITHREADS
     /* only "parent" interpreter can diddle signals */
     if (PL_curinterp != aTHX)
-       return SIG_ERR;
+       return (Sighandler_t) SIG_ERR;
 #endif
 
-    act.sa_handler = handler;
+    act.sa_handler = (void(*)(int))handler;
     sigemptyset(&act.sa_mask);
     act.sa_flags = 0;
 #ifdef SA_RESTART
@@ -2424,13 +2424,13 @@ Perl_rsignal(pTHX_ int signo, Sighandler_t handler)
         act.sa_flags |= SA_RESTART;    /* SVR4, 4.3+BSD */
 #endif
 #if defined(SA_NOCLDWAIT) && !defined(BSDish) /* See [perl #18849] */
-    if (signo == SIGCHLD && handler == (Sighandler_t)SIG_IGN)
+    if (signo == SIGCHLD && handler == (Sighandler_t) SIG_IGN)
        act.sa_flags |= SA_NOCLDWAIT;
 #endif
     if (sigaction(signo, &act, &oact) == -1)
-       return SIG_ERR;
+       return (Sighandler_t) SIG_ERR;
     else
-       return oact.sa_handler;
+       return (Sighandler_t) oact.sa_handler;
 }
 
 Sighandler_t
@@ -2439,9 +2439,9 @@ Perl_rsignal_state(pTHX_ int signo)
     struct sigaction oact;
 
     if (sigaction(signo, (struct sigaction *)NULL, &oact) == -1)
-       return SIG_ERR;
+       return (Sighandler_t) SIG_ERR;
     else
-       return oact.sa_handler;
+       return (Sighandler_t) oact.sa_handler;
 }
 
 int
@@ -2456,7 +2456,7 @@ Perl_rsignal_save(pTHX_ int signo, Sighandler_t handler, Sigsave_t *save)
        return -1;
 #endif
 
-    act.sa_handler = handler;
+    act.sa_handler = (void(*)(int))handler;
     sigemptyset(&act.sa_mask);
     act.sa_flags = 0;
 #ifdef SA_RESTART
@@ -2464,7 +2464,7 @@ Perl_rsignal_save(pTHX_ int signo, Sighandler_t handler, Sigsave_t *save)
         act.sa_flags |= SA_RESTART;    /* SVR4, 4.3+BSD */
 #endif
 #if defined(SA_NOCLDWAIT) && !defined(BSDish) /* See [perl #18849] */
-    if (signo == SIGCHLD && handler == (Sighandler_t)SIG_IGN)
+    if (signo == SIGCHLD && handler == (Sighandler_t) SIG_IGN)
        act.sa_flags |= SA_NOCLDWAIT;
 #endif
     return sigaction(signo, &act, save);
@@ -2491,7 +2491,7 @@ Perl_rsignal(pTHX_ int signo, Sighandler_t handler)
 #if defined(USE_ITHREADS) && !defined(WIN32)
     /* only "parent" interpreter can diddle signals */
     if (PL_curinterp != aTHX)
-       return SIG_ERR;
+       return (Sighandler_t) SIG_ERR;
 #endif
 
     return PerlProc_signal(signo, handler);
@@ -2514,7 +2514,7 @@ Perl_rsignal_state(pTHX_ int signo)
 #if defined(USE_ITHREADS) && !defined(WIN32)
     /* only "parent" interpreter can diddle signals */
     if (PL_curinterp != aTHX)
-       return SIG_ERR;
+       return (Sighandler_t) SIG_ERR;
 #endif
 
     PL_sig_trapped = 0;
@@ -2534,7 +2534,7 @@ Perl_rsignal_save(pTHX_ int signo, Sighandler_t handler, Sigsave_t *save)
        return -1;
 #endif
     *save = PerlProc_signal(signo, handler);
-    return (*save == SIG_ERR) ? -1 : 0;
+    return (*save == (Sighandler_t) SIG_ERR) ? -1 : 0;
 }
 
 int
@@ -2545,7 +2545,7 @@ Perl_rsignal_restore(pTHX_ int signo, Sigsave_t *save)
     if (PL_curinterp != aTHX)
        return -1;
 #endif
-    return (PerlProc_signal(signo, *save) == SIG_ERR) ? -1 : 0;
+    return (PerlProc_signal(signo, *save) == (Sighandler_t) SIG_ERR) ? -1 : 0;
 }
 
 #endif /* !HAS_SIGACTION */
@@ -2588,9 +2588,9 @@ Perl_my_pclose(pTHX_ PerlIO *ptr)
     if(PerlProc_kill(pid, 0) < 0) { return(pid); }   /* HOM 12/23/91 */
 #endif
 #ifndef PERL_MICRO
-    rsignal_save(SIGHUP, SIG_IGN, &hstat);
-    rsignal_save(SIGINT, SIG_IGN, &istat);
-    rsignal_save(SIGQUIT, SIG_IGN, &qstat);
+    rsignal_save(SIGHUP,  (Sighandler_t) SIG_IGN, &hstat);
+    rsignal_save(SIGINT,  (Sighandler_t) SIG_IGN, &istat);
+    rsignal_save(SIGQUIT, (Sighandler_t) SIG_IGN, &qstat);
 #endif
     do {
        pid2 = wait4pid(pid, &status, 0);