This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Unblock signal-mask on error for unsafe signals
authorLeon Timmermans <fawaka@gmail.com>
Sat, 12 Feb 2011 21:19:57 +0000 (22:19 +0100)
committerFather Chrysostomos <sprout@cpan.org>
Thu, 17 Feb 2011 21:34:04 +0000 (13:34 -0800)
mg.c
t/op/sigdispatch.t

diff --git a/mg.c b/mg.c
index c58531e..5b6b339 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -3106,15 +3106,27 @@ Perl_sighandler(int sig)
 
     POPSTACK;
     if (SvTRUE(ERRSV)) {
-#if !defined(PERL_MICRO) && !defined(HAS_SIGPROCMASK)
+#ifndef PERL_MICRO
        /* Handler "died", for example to get out of a restart-able read().
         * Before we re-do that on its behalf re-enable the signal which was
         * blocked by the system when we entered.
         */
+#ifdef HAS_SIGPROCMASK
+#ifdef HAS_SIGACTION
+       if (sip)
+#endif
+       {
+           sigset_t set;
+           sigemptyset(&set);
+           sigaddset(&set,sig);
+           sigprocmask(SIG_UNBLOCK, &set, NULL);
+       }
+#else
        /* Not clear if this will work */
        (void)rsignal(sig, SIG_IGN);
        (void)rsignal(sig, PL_csighandlerp);
-#endif /* !PERL_MICRO && !HAS_SIGPROCMASK*/
+#endif
+#endif /* !PERL_MICRO */
        die_sv(ERRSV);
     }
 cleanup:
index e3c8fdb..5a5fc14 100644 (file)
@@ -9,7 +9,7 @@ BEGIN {
 use strict;
 use Config;
 
-plan tests => 12;
+plan tests => 13;
 
 watchdog(10);
 
@@ -70,4 +70,10 @@ SKIP: {
     POSIX::sigprocmask(&POSIX::SIG_UNBLOCK, $new, $old);
     ok $old->ismember(&POSIX::SIGUSR1), 'SIGUSR1 was still blocked';
     is $gotit, 2, 'Received fifth signal';
+
+    # test unsafe signal handlers in combination with exceptions
+    my $action = POSIX::SigAction->new(sub { $gotit--, die }, POSIX::SigSet->new, 0);
+    POSIX::sigaction(&POSIX::SIGUSR1, $action);
+    eval { kill SIGUSR1, $$ } for 1..2;
+    is $gotit, 0, 'Received both signals';
 }