Подтвердить что ты не робот

Как в Perl 5 я могу получить pid процесса, который послал мне сигнал?

В C я могу сказать

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

Это выдает что-то вроде

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

при отправке a SIGTERM из процесса 31985.

Я могу написать аналогичный код Perl 5, используя 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;

Но обработчик все еще получает только один аргумент (сигнал). Как я могу попасть в структуру siginfo_t? Нужно ли писать собственный XS-код, который настраивает собственный обработчик, а затем передает информацию на обратный вызов Perl? Будет ли писать мой собственный обработчик в XS каким-то образом заманить переводчика?

4b9b3361

Ответ 1

sighandler (найденный в mg.c) является оберткой вокруг подпрограммы обработчика Perl. Как вы можете видеть, возможно передать информацию, которую вы хотите передать в обработчик обработчика Perl.

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

Информация, которую вы хотите, будет в последнем параметре, хотя вам придется распаковать *sip самостоятельно Perl-side. Уловка заключается в том, что вышеприведенный код не работает. В частности, sip всегда NULL.


В небезопасных сигналах sighandler вызывается из csighandler, обработчика сигнала уровня на уровне Perl. В настоящее время он не передает соответствующую информацию в signalhandler, но это легко фиксируется.

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

Пример прогона:

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

Под безопасными сигналами sighandler вызывается из despatch_signals (sic) через PERL_ASYNC_CHECK. К сожалению, *sip, ранее полученный csighandler, больше не доступен. Чтобы исправить это, csighandler пришлось бы выставить копию *sip для despatch_signals для извлечения.