Comment, dans Perl 5, puis-je connaître le pid du processus qui m'a envoyé un signal?

Question

En C, je peux dire

#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;
}

Ce imprime quelque chose comme

pid is 31980
got signal 15 from process 31985 running as user 1000

lors de l'envoi d'un SIGTERM de processus 31985.

Je peux écrire similaire Perl 5 code à l'aide d' 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;

Mais le maître toujours reçoit un seul argument (le signal). Comment puis-je obtenir à l' siginfo_t de la structure? Dois écrire mon propre code XS qui met en place son propre gestionnaire, puis transmet les informations à un Perl de rappel? Sera écrit mon propre gestionnaire de XS à vis jusqu'à l'interprète d'une certaine façon?

Answer 1

sighandler (qui se trouve dans mg.c) est le wrapper autour de la Perl gestionnaire de signal de sous. Comme vous pouvez le voir, il est capabable de vous envoyer les informations que vous souhaitez le Perl gestionnaire de signal de sous.

#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));
            }
        }
    }
}

Les informations que vous souhaitez serait dans le dernier paramètre, bien que vous auriez à décompresser *sip vous-même Perl-côté. Le hic, c'est que le code ci-dessus n'est pas d'obtenir excercised. Plus précisément, sip toujours NULL.

---

En vertu de l'dangereux signaux, sighandler est appelée à partir d' csighandler, Perl, C-niveau de gestionnaire de signal. Actuellement, il ne passe pas sur l'information pertinente pour signalhandler, mais c'est facilement résolu.

-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);

Exemple d'exécution:

$ PERL_SIGNALS=unsafe ./perl -Ilib a.pl
31213
caught signal
$VAR1 = [
          'TERM',
          {
            'code' => 0,
            'signo' => 15
          },
          '...*sip as "packed/binary" string...'
        ];

---

En vertu de sécurité des signaux, sighandler est appelée à partir d' despatch_signals (sic) par PERL_ASYNC_CHECK. Malheureusement, l' *sip été reçu par l' csighandler n'est plus disponible. Pour résoudre ce problème, csighandler aurait à la file d'attente d'une copie de l' *sip pour despatch_signals à extraire.