From: Jarkko Hietaniemi Date: Wed, 20 Jul 2005 14:40:54 +0000 (+0300) Subject: support POSIX SA_SIGINFO X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8aad04aa6a2ab20a526b53089f8919d46434ca7e;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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 --- 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 --- a/ext/POSIX/POSIX.pod +++ b/ext/POSIX/POSIX.pod @@ -1130,6 +1130,31 @@ Returns C on failure. The C 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 and possibly also C documentation. + =item siglongjmp siglongjmp() is C-specific: use L instead. diff --git a/ext/POSIX/t/sigaction.t b/ext/POSIX/t/sigaction.t index bc40b78..6de6cfb 100644 --- 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 --- 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 --- 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 --- a/mg.c +++ b/mg.c @@ -52,7 +52,11 @@ tie. # include #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 --- 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 --- 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 --- 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 --- 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 --- 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);