Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How, in Perl 5, can I get the pid of the process who sent me a signal?

Tags:

signals

perl

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?

like image 992
Chas. Owens Avatar asked Jun 09 '11 16:06

Chas. Owens


1 Answers

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.

like image 51
ikegami Avatar answered Oct 12 '22 21:10

ikegami