How to prevent Perl from exit when SIGUSR1 recieved?

cmyker has asked for the wisdom of the Perl Monks concerning the following question:

I'm trying to use SIGUSR1 to force daemon writed in Perl to execute common tasks. But when Perl receives SIGUSR1 it handles this signal, everything seems to be ok but when it receives more than 1 signal in a few seconds (sometimes even 1 signal) it exits...

#!/usr/bin/perl

use strict;
use POSIX;

my $sigset = POSIX::SigSet->new(&POSIX::SIGUSR1);
my $action = POSIX::SigAction->new(\&trap, $sigset, &POSIX::SA_SIGINFO
+);
POSIX::sigaction(&POSIX::SIGUSR1, $action);

#$SIG{USR1} = \&trap; #or install handler like this or "use sigtrap" w
+hatever

sub trap {
    print "got signal.\n";
}

print "My pid is: $$\n";

while(sleep(1)) {

}
[download]

$ perl test.pl 
My pid is: 3188
$ kill -SIGUSR1 3188 
got signal.
$ kill -SIGUSR1 3188
got signal.
---> script is terminated
[download]

C version works without any problems:

#include <stdio.h>
#include <stdlib.h>
#include <unistd.h>
#include <signal.h>

void usr1handler(int signal);

int main(void) {
    signal(SIGUSR1, usr1handler);

    printf("My pid is: %d\n", getpid());

    for(;;) {
        sleep(1);
    }
    return 0;
}

void usr1handler(int signal) {
    printf("Got a signal: %d\n", signal);
}
[download]

$ ./test 
My pid is: 3188
$ kill -SIGUSR1 3318
Got a signal called: 10
$ kill -SIGUSR1 3318
Got a signal called: 10
$ kill -SIGUSR1 3318
Got a signal called: 10
$ kill -SIGUSR1 3318
Got a signal called: 10
... it never exits
[download]

I'm using perl version v5.12.1 under Linux 2.6.34-12. Any suggestions is much appreciated.

Comment on How to prevent Perl from exit when SIGUSR1 recieved? Select or Download Code

Replies are listed 'Best First'.
Re: How to prevent Perl from exit when SIGUSR1 recieved? by repellent (Priest) on Aug 21, 2010 at 01:12 UTC
`SIGUSR1` causes the process to break out of a sleep. Note that the C code: `for(;;) { sleep(1); }` [download] is not semantically equivalent to the Perl code: `while(sleep(1)) { }` [download] Instead, in Perl, try either of the following for the same effect: `for (;;) { sleep(1) }` `while (1) { sleep(1) }` `sleep(1) while 1;`	[reply] [d/l] [select]
Re: How to prevent Perl from exit when SIGUSR1 recieved? by jethro (Monsignor) on Aug 20, 2010 at 23:44 UTC
I tried your script and used every combination I found mentioned in perlipc (i.e. without posix) and couldn't get it to work either. It seems definitely broken. A trace shows this difference between a successful handling and an unsuccessful: #ok: write(1, "got signal.\n", 12got signal. ) = 12 wait4(-1, 0x7fff97d3635c, WNOHANG, NULL) = -1 ECHILD (No child process +es) rt_sigprocmask(SIG_BLOCK, [USR1], [USR1], 8) = 0 rt_sigaction(SIGUSR1, {0x4ba320, [], SA_RESTORER, 0x7ff73ec382e0}, {0x +4ba320, [], SA_RESTORER, 0x7ff73ec382e0}, 8) = 0 rt_sigprocmask(SIG_SETMASK, [USR1], NULL, 8) = 0 rt_sigprocmask(SIG_UNBLOCK, [USR1], NULL, 8) = 0 rt_sigprocmask(SIG_BLOCK, [CHLD], [], 8) = 0 #not ok: write(1, "got signal.\n", 12got signal. ) = 12 wait4(-1, 0x7fff97d3635c, WNOHANG, NULL) = -1 ECHILD (No child process +es) rt_sigprocmask(SIG_BLOCK, [USR1], [USR1], 8) = 0 rt_sigaction(SIGUSR1, {0x4ba320, [], SA_RESTORER, 0x7ff73ec382e0}, {0x +4ba320, [], SA_RESTORER, 0x7ff73ec382e0}, 8) = 0 rt_sigprocmask(SIG_SETMASK, [USR1], NULL, 8) = 0 rt_sigprocmask(SIG_UNBLOCK, [USR1], NULL, 8) = 0 rt_sigaction(SIG_0, NULL, {0x8ab3b8, [], SA_NOCLDSTOP}, 8) = -1 EINVAL + (Invalid argument) [download] The difference is the call to rt_sigaction instead of a third rt_sigprocmask, seemingly unprovoked by any return values from the operating system. So my guess is the problem is in the perl code. It seems a case for a debugger now	[reply] [d/l]
Re: How to prevent Perl from exit when SIGUSR1 recieved? by okram (Monk) on Aug 23, 2010 at 12:09 UTC
Changing the while() to: `while (1) { sleep 1; }` [download] Seems to do what you expect: multiple -USR1 are trapped and handled.	[reply] [d/l]