comment on

have you got any ideas?

The problem is that the signal handler is not being reset when the eval is terminated by the die in the signal handler, so the solution is to reset the signal handler in the signal handler.

I modified your script to do this and it survived the signal storm 10 times out of 10 on my system.

#!/usr/bin/perl
use warnings FATAL => qw( all );
use strict;

use Test::More tests => 1;
use POSIX qw( _exit );

sub wrap_sigs {
        my $signals = shift;
        my $coderef = shift;

        my $died;
        my %old_sighandlers;
        eval {
                for my $sig (keys %$signals) {
                        $old_sighandlers{$sig} = ($SIG{$sig} || 'DEFAU
+LT');
                        $SIG{$sig} =  sub {
                            for my $sig (keys %old_sighandlers) {
                                $SIG{$sig} = $old_sighandlers{$sig};
                            }
                            die ('SIG' . $sig . "\n");
                        };
                }

                $died = 1 unless eval { $coderef->(); 1 };

                for my $sig (keys %old_sighandlers) {
                        $SIG{$sig} = $old_sighandlers{$sig};
                }
        };

        return $died;
}

my $pid = fork;
if ($pid) {
        $SIG{ALRM} = sub { };
        my $timeout = time + 5;
        diag('parent entering wrap_sigs loop');
        while (time < $timeout) {
                wrap_sigs(
                        { ALRM => 1 },
                        sub { }
                );
        }
        diag('parent survived, killing child');
        kill TERM => $pid;
} else {
        sleep 1;
        diag('child starting signal storm');
        1 while kill ALRM => getppid;
        _exit(0);
}
ok(1, 'survived signal storm');
[download]

I also added a few print statements to see how often and when various bits executed. I was surprised how few times a signal was caught: quite reliably between 10 and 15 times, despite how quickly the two loops execute. I guess this has to do with how often the process scheduler switches running processes on my single CPU system.

#!/usr/bin/perl
use warnings FATAL => qw( all );
use strict;

use Test::More tests => 1;
use POSIX qw( _exit );

$|=1;

sub wrap_sigs {
        my $signals = shift;
        my $coderef = shift;

        my $died;
        my %old_sighandlers;
        eval {
                print "entering eval\n";
                for my $sig (keys %$signals) {
                        $old_sighandlers{$sig} = ($SIG{$sig} || 'DEFAU
+LT');
                        $SIG{$sig} =  sub {
                            print "caught signal with inner handler\n"
+;
                            for my $sig (keys %old_sighandlers) {
                                $SIG{$sig} = $old_sighandlers{$sig};
                            }
                            die ('SIG' . $sig . "\n");
                        };
                }

                $died = 1 unless eval {
                    print "entering inner eval\n";
                    $coderef->();
                    print "leaving inner eval\n";
                    1
                };

                for my $sig (keys %old_sighandlers) {
                        $SIG{$sig} = $old_sighandlers{$sig};
                }
                print "leaving eval\n";
        };

        return $died;
}

my $pid = fork;
if ($pid) {
        $SIG{ALRM} = sub { print "caught signal with outer handler\n";
+ };
        my $timeout = time + 5;
        diag('parent entering wrap_sigs loop');
        while (time < $timeout) {
                wrap_sigs(
                        { ALRM => 1 },
                        sub { }
                );
        }
        diag('parent survived, killing child');
        kill TERM => $pid;
} else {
        sleep 1;
        $|=1;
        diag('child starting signal storm');
        print "killing...\n" while kill ALRM => getppid;
        _exit(0);
}
ok(1, 'survived signal storm');
[download]

In reply to Re^3: Setting signal handlers considered unsafe? by ig
in thread Setting signal handlers considered unsafe? by gnosek

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		`&`
	<		`<`
	>		`>`
	[		`[`
	]		`]`

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.