If the first argument of sigaction() was a string, not a number

(or a SIGXXX 'constant') one got first (if using -w) 'Argument "FOO"
isn't numeric in subroutine entry ...' but after that one got
(depending on the OS) either a coredump (because of trying to
assign to *0 in mg_get) or a hang (because of the sigprocmask()
blocking signals inside POSIX::sigaction, a nasty hang since
one obviously cannot interrupt it...only SIGKILL works).
In older Perls (tried with 5.6.1) one got 'No such signal: SIGZERO ...'
because of the string becoming zero due to the XS typemap magic.
Resolved by making the POSIX::sigaction to try harder to figure
out a valid signal number (one still gets the warning, though),
and returning undef if no sense can be made.

p4raw-id: //depot/perl@19809

diff --git a/ext/POSIX/POSIX.pod b/ext/POSIX/POSIX.pod
index e031582..7517a85 100644 (file)
--- a/ext/POSIX/POSIX.pod
+++ b/ext/POSIX/POSIX.pod
@@ -1123,9 +1123,11 @@ manpage for details.
 
 Synopsis:
 
-       sigaction(sig, action, oldaction = 0)
+       sigaction(signal, action, oldaction = 0)
 
-Returns C<undef> on failure.
+Returns C<undef> on failure.  The C<signal> must be a number (like
+SIGHUP), not a string (like "SIGHUP"), though Perl does try hard
+to understand you.
 
 =item siglongjmp
 

diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs
index 3cf6ab5..7fc9883 100644 (file)
--- a/ext/POSIX/POSIX.xs
+++ b/ext/POSIX/POSIX.xs
@@ -1212,10 +1212,26 @@ sigaction(sig, optaction, oldaction = 0)
            sigset_t osset;
            POSIX__SigSet sigset;
            SV** svp;
-           SV** sigsvp = hv_fetch(GvHVn(siggv),
-                                PL_sig_name[sig],
-                                strlen(PL_sig_name[sig]),
-                                TRUE);
+           SV** sigsvp;
+           if (sig == 0 && SvPOK(ST(0))) {
+               char *s = SvPVX(ST(0));
+               int i = whichsig(s);
+
+               if (i < 0 && memEQ(s, "SIG", 3))
+                   i = whichsig(s + 3);
+               if (i < 0) {
+                   if (ckWARN(WARN_SIGNAL))
+                       Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
+                                    "No such signal: SIG%s", s);
+                   XSRETURN_UNDEF;
+               }
+               else
+                   sig = i;
+            }
+           sigsvp = hv_fetch(GvHVn(siggv),
+                             PL_sig_name[sig],
+                             strlen(PL_sig_name[sig]),
+                             TRUE);
 
            /* Check optaction and set action */
            if(SvTRUE(optaction)) {
@@ -1234,9 +1250,11 @@ sigaction(sig, optaction, oldaction = 0)
             * in between. We use sigprocmask() to make it so.
             */
            sigfillset(&sset);
+#if 0
            RETVAL=sigprocmask(SIG_BLOCK, &sset, &osset);
            if(RETVAL == -1)
                XSRETURN_UNDEF;
+#endif
            ENTER;
            /* Restore signal mask no matter how we exit this block. */
            osset_sv = newSVpv((char *)(&osset), sizeof(sigset_t));

diff --git a/ext/POSIX/t/sigaction.t b/ext/POSIX/t/sigaction.t
index 63ff17d..d2db20b 100644 (file)
--- a/ext/POSIX/t/sigaction.t
+++ b/ext/POSIX/t/sigaction.t
@@ -21,7 +21,7 @@ use vars qw/$bad7 $ok10 $bad18 $ok/;
 
 $^W=1;
 
-print "1..18\n";
+print "1..21\n";
 
 sub IGNORE {
        $bad7=1;
@@ -133,3 +133,25 @@ if ($^O eq 'VMS') {
     print $bad18 ? "not ok 18\n" : "ok 18\n";
 }
 
+{
+    local $SIG{__WARN__} = sub { }; # Just suffer silently.
+
+    my $hup20;
+    my $hup21;
+
+    sub hup20 { $hup20++ }
+    sub hup21 { $hup21++ }
+
+    sigaction("FOOBAR", $newaction);
+    print "ok 19\n"; # no coredump, still alive
+
+    $newaction = POSIX::SigAction->new("hup20");
+    sigaction("SIGHUP", $newaction);
+    kill "HUP", $$;
+    print $hup20 == 1 ? "ok 20\n" : "not ok 20\n";
+
+    $newaction = POSIX::SigAction->new("hup21");
+    sigaction("HUP", $newaction);
+    kill "HUP", $$;
+    print $hup21 == 1 ? "ok 21\n" : "not ok 21\n";
+}