Make kill() fatal for non-numeric pids

As the debate over the best way to deal with floating point
pids stalled, this is just for non-numeric, which at least
squashes the bug even if it's not the Platonic ideal for
everyone.

It also doesn't address overloaded objects that might not have
IV, NV or PV appropriately set, but the approach mirrors what is
done elsewhere in doio.c so I recommend applying this patch now and
fixing the problem of overloaded objects at some other time when
it can be done more globally, either through an improvement or
replacement of looks_like_number

Also updated POD for kill when process is 0 or negative and
fixed Test-Harness tests that used kill with a string pid.
(Test-Harness test fix also submitted upstream)

diff --git a/doio.c b/doio.c
index 7be7af1..1e9d7d9 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1726,6 +1726,8 @@ nothing in the core.
             * CRTL's emulation of Unix-style signals and kill()
             */
            while (++mark <= sp) {
+               if (!(SvIOK(*mark) || SvNOK(*mark) || looks_like_number(*mark)))
+                   Perl_croak(aTHX_ "Can't kill a non-numeric process ID");
                I32 proc = SvIV(*mark);
                register unsigned long int __vmssts;
                APPLY_TAINT_PROPER();
@@ -1750,6 +1752,8 @@ nothing in the core.
        if (val < 0) {
            val = -val;
            while (++mark <= sp) {
+               if (!(SvIOK(*mark) || SvNOK(*mark) || looks_like_number(*mark)))
+                   Perl_croak(aTHX_ "Can't kill a non-numeric process ID");
                const I32 proc = SvIV(*mark);
                APPLY_TAINT_PROPER();
 #ifdef HAS_KILLPG
@@ -1762,6 +1766,8 @@ nothing in the core.
        }
        else {
            while (++mark <= sp) {
+               if (!(SvIOK(*mark) || SvNOK(*mark) || looks_like_number(*mark)))
+                   Perl_croak(aTHX_ "Can't kill a non-numeric process ID");
                const I32 proc = SvIV(*mark);
                APPLY_TAINT_PROPER();
                if (PerlProc_kill(proc, val))

diff --git a/ext/Test-Harness/t/sample-tests/taint b/ext/Test-Harness/t/sample-tests/taint
index b67d719..c36698e 100644 (file)
--- a/ext/Test-Harness/t/sample-tests/taint
+++ b/ext/Test-Harness/t/sample-tests/taint
@@ -3,5 +3,5 @@
 use lib qw(t/lib);
 use Test::More tests => 1;
 
-eval { kill 0, $^X };
+eval { `$^X -e1` };
 like( $@, '/^Insecure dependency/', '-T honored' );

diff --git a/ext/Test-Harness/t/sample-tests/taint_warn b/ext/Test-Harness/t/sample-tests/taint_warn
index 768f527..398d618 100644 (file)
--- a/ext/Test-Harness/t/sample-tests/taint_warn
+++ b/ext/Test-Harness/t/sample-tests/taint_warn
@@ -6,6 +6,6 @@ use Test::More tests => 1;
 my $warnings = '';
 {
     local $SIG{__WARN__} = sub { $warnings .= join '', @_ };
-    kill 0, $^X;
+    `$^X -e1`;
 }
 like( $warnings, '/^Insecure dependency/', '-t honored' );

diff --git a/pod/perl5110delta.pod b/pod/perl5110delta.pod
index e9e9efa..c49c0e7 100644 (file)
--- a/pod/perl5110delta.pod
+++ b/pod/perl5110delta.pod
@@ -185,6 +185,13 @@ See L</"The C<overloading> pragma"> above.
 as documented, and as does C<-I> when specified on the command-line.
 (Renée Bäcker)
 
+=item C<kill> is now fatal when called on non-numeric process identifiers
+
+Previously, an 'undef' process identifier would be interpreted as a request to
+kill process "0", which would terminate the current process group on POSIX
+systems.  Since process identifiers are always integers, killing a non-numeric
+process is now fatal.
+
 =back
 
 =head1 New or Changed Diagnostics

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index dc0c5ea..9d58104 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -830,6 +830,12 @@ processes, Perl has reset the signal to its default value.  This
 situation typically indicates that the parent program under which Perl
 may be running (e.g. cron) is being very careless.
 
+=item Can't kill a non-numeric process ID
+
+(F) Process identifiers must be (signed) integers.  It is a fatal error to
+attempt to kill() an undefined, empty-string or otherwise non-numeric
+process identifier.
+
 =item Can't "last" outside a loop block
 
 (F) A "last" statement was executed to break out of the current block,

diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index 2035795..23e5535 100644 (file)
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -2631,11 +2631,13 @@ the super-user).  This is a useful way to check that a child process is
 alive (even if only as a zombie) and hasn't changed its UID.  See
 L<perlport> for notes on the portability of this construct.
 
-Unlike in the shell, if SIGNAL is negative, it kills
-process groups instead of processes.  (On System V, a negative I<PROCESS>
-number will also kill process groups, but that's not portable.)  That
-means you usually want to use positive not negative signals.  You may also
-use a signal name in quotes.
+Unlike in the shell, if SIGNAL is negative, it kills process groups instead
+of processes. That means you usually want to use positive not negative signals.
+You may also use a signal name in quotes.
+
+The behavior of kill when a I<PROCESS> number is zero or negative depends on
+the operating system.  For example, on POSIX-conforming systems, zero will
+signal the current process group and -1 will signal all processes.
 
 See L<perlipc/"Signals"> for more details.
 

diff --git a/t/op/kill0.t b/t/op/kill0.t
index 063c388..eadf15d 100644 (file)
--- a/t/op/kill0.t
+++ b/t/op/kill0.t
@@ -14,7 +14,7 @@ BEGIN {
 
 use strict;
 
-plan tests => 2;
+plan tests => 5;
 
 ok( kill(0, $$), 'kill(0, $pid) returns true if $pid exists' );
 
@@ -29,3 +29,17 @@ for my $pid (1 .. $total) {
 # It is highly unlikely that all of the above PIDs are genuinely in use,
 # so $count should be less than $total.
 ok( $count < $total, 'kill(0, $pid) returns false if $pid does not exist' );
+
+# Verify that trying to kill a non-numeric PID is fatal
+my @bad_pids = (
+    [ undef , 'undef'         ],
+    [ ''    , 'empty string'  ],
+    [ 'abcd', 'alphabetic'    ],
+);
+
+for my $case ( @bad_pids ) {
+  my ($pid, $name) = @$case;
+  eval { kill 0, $pid };
+  like( $@, qr/^Can't kill a non-numeric process ID/, "dies killing $name pid");
+}
+