alarm does not seem to fire if I set $SIG{ALRM}

I'm trying to implement an alarm in my Perl backend process so that it will terminate if it gets stuck for too long. I tried to implement the code given on the alarm documentation page on Perldoc (this is verbatim from the documentation other than the line that calls my program's key subroutine instead of the sample line in the documentation):

eval {
    local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
    alarm $timeout;
    &FaithTree::Backend::commandLine({ 'skipWidgets' => $skipWidgets, 'commandLineId' => $commandLineId, 'force' => $force });
    alarm 0;
};
if ($@) {
    die unless $@ eq "alarm\n";   # propagate unexpected errors
    # timed out
}
else {
    # didn't
}

Given this code, nothing happens when the alarm should have timed out. On the other hand, if I remove the custom definition for $SIG{ALRM} (which, again, came straight from the Perl documentation) the alarm does fire, just without the custom handler.

I'm wondering if the fact that I'm using Thread::Queue is playing a role in the alarm failing, but that doesn't explain why it works so long as I skip redefining $SIG{ALRM}.

Here's a minimal, runnable version with subroutine that is intentionally an infinite loop for testing:

eval {
    $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
    alarm 1;
    &FaithTree::Test::Backend::commandLine({ 'skipWidgets' => $skipWidgets, 'commandLineId' => $commandLineId, 'force' => $force });
    alarm 0;
};


if ($@) {
    die unless $@ eq "alarm\n";   # propagate unexpected errors
    # timed out
}
else {
   exit;
}


package FaithTree::Test::Backend;

use File::Tail;
use threads;
use threads::shared;
use Thread::Queue;

sub commandLine {

    our $N //= 4;
    my $Q = new Thread::Queue;
    my @kids = map threads->create( \&FaithTree::Test::Backend::fetchChild, $Q ), 1 .. $N;  

    my @feeds = ( "1","2","3","4" );

    foreach my $feed (@feeds) {
        $Q->enqueue( $feed );
    }

    $Q->enqueue( ( undef ) x $N );
    $_->join for @kids; 

}

sub fetchChild {

    print "Test";
    # Access queue.
    my $Q = shift;

    #What is my thread id?
    my $tid = threads->tid();

    my ($num, $num2);

    for ( ; ; ){ 
        if ($num2 == 10000) {
            say STDERR $tid . ': ' . $num;
            $num2 = 0;
        }
    
        $num++; 
        $num2++;
    }

    return 1;

}

If you comment out the $SIG{ALRM} line, it will terminate when the alarm is set to time out. If you leave it in place, it will never terminate.

Solution

Signals and threads don't mix well. You might want to rethink your use of signals. For example, you could move all the thread stuff to a child process.

Signal handlers are only called between Perl ops. The main thread is in a call to XS sub thread->join, and the signal handler will be called once join returns.

Most blocking system calls can be interrupted (returning error EINTR), so it might be possible to write a signal-aware version of join. Except I seem to remember pthread functions not being interruptible, so maybe not.

In this particular case, you could have the threads signal the main thread when they are over using a system that allows the main thread to block until the a signal occurs or a timeout has occured. cond_signal/cond_timedwait is such a system.

use Sub::ScopeFinalizer qw( scope_finalizer );
use Time::HiRes         qw( time );

my $lock :shared;
my $threads_remaining = $N;
my $Q = new Thread::Queue;

my @threads;
{
   lock $lock;
   for (1..$N) {
      ++$threads_remaining;

      push @threads, async {
         my $guard = scope_finalizer {
            lock $lock;
            --$threads_remaining;
            cond_signal($lock);
         };

         worker($Q);
      }
   }
}

my $max_end_time = time + 1;

# ...

{
   lock $lock;
   while ($threads_remaining) {
      if (!cond_timedwait($lock, $max_end_time)) {
         # ... Handle timeout ...
      }
   }
}

$_->join for @threads;