Perl Unsafe Signals

Matts on 2008-11-03T20:39:10

This is just to document (and place in google) how to do unsafe signals in recent perls without loading a non-core library to do it:

    use POSIX qw(SIGALRM);
    my $timeout = 30;
    my $sigset = POSIX::SigSet->new(SIGALRM);
    my $action = POSIX::SigAction->new(
        sub {
            # re-install alarm in case we were in an internal eval{} block
            alarm($timeout);
            die "timeout working on: " . (caller(1))[1] . "\n";
        },
        $sigset,
        &POSIX::SA_NODEFER, # turns off safe signals
    );
    POSIX::sigaction(SIGALRM, $action);
    my $prev_alarm = alarm($timeout);
    
    eval {
        # long running code here
    };
    my $err = $@;
    alarm($prev_alarm);
    if ($err) {
        if ($err !~ /timeout working on:/) {
            die $err; # propogate this error
        }
        # process the timeout
    }

This is written for alarms, which TBH is probably where you really need it, since the regexp engine can get its knickers in a twist and not fire your alarm until the heat death of the universe, but the code will work for other types of signals too.

And yes, I know there are modules on CPAN for this, such as the excellent and very simple Perl::Unsafe::Signals, but sometimes another module isn't an option. I also know the code is a bit flawed in that the second installation of the alarm doesn't do the right thing (it should install at as $timeout - (time - $start_time)), so feel free to fix it yourself.