in reply to Signal Handler

The theory is described here, but in my experience this doesn't work as advertised...

For example, this is what I get on the Linux box (SuSE 10.2) I'm sending this from: 

#!/usr/local/perl/5.10.0/bin/perl

use strict;
use warnings;

use POSIX;
use Data::Dumper;
$Data::Dumper::Useqq = 1;

my $inf;
my $sender_pid;

POSIX::sigaction(
           SIGINT,
           POSIX::SigAction->new(
               sub {
                   $inf = Dumper \@_;
                   $sender_pid = unpack "x16S", $_[2];     # <--
               },
               0,
               POSIX::SA_SIGINFO
           ),
       );

kill 'INT', $$;

print $inf;
print "Sender PID: $sender_pid\n";
print "Own PID:    $$\n";

__END__
$VAR1 = [
          "INT",
          {
            "code" => 0,
            "signo" => 2
          },
          "\2\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0RQ\0\0005\4\0\0\270\273}\0\
+0\0\0\0`\257i\0\0\0\0\0\3342E\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0
+\0\370\25e\0\0\0\0\0\30 e\0\0\0\0\0\1\0\0\0\0\0\0\0\r\0\0\0\0\0\0\0\3
+60b8\213\377\177\0\0\370b8\213\377\177\0\0\1\0\0\0\0\0\0\0\3IM\0\0\0\
+0\0"
        ];
Sender PID: 20818   (as we're sending the signal ourself, the sender i
+s $$)
Own PID:    20818

[download]

Ideally - as I'm reading the docs - there should also be hash fields for 'pid' (the process id generating the signal), 'uid', etc. — not available in this case, though.

With a bit of luck (and reading through your system's siginfo.h — (e.g. /usr/include/asm-generic/siginfo.h on my system)), you might be able to extract the relevant info from the raw siginfo struct dump...

Update:  unpack "x16S", ... looks promising — at least in my case, it extracts the appropriate PID  (see $sender_pid in the above updated snippet).  But be sure to test its portability, before you make this a vital part of your application...! :)

Replies are listed 'Best First'.
Re^2: Signal Handler
by lakshmananindia (Chaplain) on Dec 06, 2008 at 03:53 UTC
    Thanks for our reply. I executed the code that you posted.
    But I got only the signal name.
    $VAR1 = [
          "INT"
        ];
Sender PID:
Own PID:    2784

    [download]

    I am using debian, and my system supports sigaction(2). Now I need to know what will be the problem. Please help.

[reply]
[d/l]

      Sorry, forgot to mention explicitly that this only works starting with Perl 5.10.0 — AFAIK, older versions only ever provide the signal name (I get the same output as you with 5.8.8).

      Update: FWIW, this is the respective code snippet from mg.c (line 2854) in the Perl 5.10.0 sources: 

      #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((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((SV*)rv);
           PUSHs(newSVpvn((char *)sip, sizeof(*sip)));
          }

     }
    }
#endif

      [download]

      I can't find any entry in the Changes file when this has been added, but it's definitely not there in 5.8.8.   (Note the "#if 0 /* XXX TODO:...", btw, which wraps the "pid" code.)

[reply]
[d/l]
[select]
        Hi almut,

        Thanks, now I got it. You also gave me an insight on XS. Thanks.

[reply]

In Section Seekers of Perl Wisdom