From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Wed, 18 Jun 2003 09:08:47 +0000 (+0000)
Subject: If the first argument of sigaction() was a string, not a number
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1d81eac947dedbd62bc60aa6d92509cbe424fa3d;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
--- 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";
+}