In C, I can say
#include <stdio.h> #include <unistd.h> #include <signal.h> int continue_running = 1; void handler(int signal, siginfo_t* info, void* data) { printf("got signal %d from process %d running as user %d\n", signal, info->si_pid, info->si_uid); continue_running = 0; } int main(int argc, char** argv) { struct sigaction sa; sigset_t mask; sigemptyset(&mask); sa.sa_sigaction = &handler; sa.sa_mask = mask; sa.sa_flags = SA_SIGINFO; sigaction(SIGTERM, &sa, NULL); printf("pid is %d\n", getpid()); while (continue_running) { sleep(1); }; return 0; }
This prints out something like
pid is 31980 got signal 15 from process 31985 running as user 1000
when sent a SIGTERM
from process 31985.
I can write similar Perl 5 code using POSIX::sigaction
:
#!/usr/bin/perl use strict; use warnings; use POSIX; use Data::Dumper; my $sigset = POSIX::SigSet->new; $sigset->emptyset; my $sa = POSIX::SigAction->new( sub { print "caught signal\n" . Dumper \@_; $a = 0 }, $sigset, ); $sa->flags(POSIX::SA_SIGINFO); $sa->safe(1); #defer the signal until we are in a safe place in the intrepeter POSIX::sigaction(POSIX::SIGTERM, $sa); print "$$\n"; $a = 1; sleep 1 while $a;
But the handler still only receives one argument (the signal). How can I get at siginfo_t
structure? Do have to write my own XS code that sets up its own handler and then passes the information on to a Perl callback? Will writing my own handler in XS screw up the interpreter in some way?
sighandler
(found in mg.c
) is the wrapper around the Perl signal handler sub. As you can see, it is capabable of sending the information you want to the Perl signal handler sub.
#if defined(HAS_SIGACTION) && defined(SA_SIGINFO) { struct sigaction oact; if (sigaction(sig, 0, &oact) == 0 && oact.sa_flags & SA_SIGINFO) { if (sip) { HV *sih = newHV(); SV *rv = newRV_noinc(MUTABLE_SV(sih)); /* The siginfo fields signo, code, errno, pid, uid, * addr, status, and band are defined by POSIX/SUSv3. */ (void)hv_stores(sih, "signo", newSViv(sip->si_signo)); (void)hv_stores(sih, "code", newSViv(sip->si_code)); #if 0 /* XXX TODO: Configure scan for the existence of these, but even that does not help if the SA_SIGINFO is not implemented according to the spec. */ hv_stores(sih, "errno", newSViv(sip->si_errno)); hv_stores(sih, "status", newSViv(sip->si_status)); hv_stores(sih, "uid", newSViv(sip->si_uid)); hv_stores(sih, "pid", newSViv(sip->si_pid)); hv_stores(sih, "addr", newSVuv(PTR2UV(sip->si_addr))); hv_stores(sih, "band", newSViv(sip->si_band)); #endif EXTEND(SP, 2); PUSHs(rv); mPUSHp((char *)sip, sizeof(*sip)); } } } }
The information you want would be in the last parameter, although you'd have to unpack *sip
yourself Perl-side. The catch is that the above code isn't getting excercised. Specifically, sip
is always NULL
.
Under unsafe signals, sighandler
is called from csighandler
, Perl's C-level signal handler. It currently doesn't pass on the pertinent information to signalhandler
, but that's easily fixed.
-Perl_csighandler(int sig, siginfo_t *sip PERL_UNUSED_DECL, void *uap PERL_UNUSED_DECL) +Perl_csighandler(int sig, siginfo_t *sip, void *uap PERL_UNUSED_DECL) - (*PL_sighandlerp)(sig, NULL, NULL); + (*PL_sighandlerp)(sig, sip, NULL);
Sample run:
$ PERL_SIGNALS=unsafe ./perl -Ilib a.pl 31213 caught signal $VAR1 = [ 'TERM', { 'code' => 0, 'signo' => 15 }, '...*sip as "packed/binary" string...' ];
Under safe signals, sighandler
is called from despatch_signals
(sic) via PERL_ASYNC_CHECK
. Unfortunately, the *sip
previously received by csighandler
is no longer available. To fix this, csighandler
would have to queue a copy of *sip
for despatch_signals
to fetch.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With