From e2c0f81f627951896aca833460887e6e8f20aba6 Mon Sep 17 00:00:00 2001 From: David Golden Date: Wed, 8 Jul 2009 13:28:54 -0400 Subject: [PATCH] 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) --- doio.c | 6 ++++++ ext/Test-Harness/t/sample-tests/taint | 2 +- ext/Test-Harness/t/sample-tests/taint_warn | 2 +- pod/perl5110delta.pod | 7 +++++++ pod/perldiag.pod | 6 ++++++ pod/perlfunc.pod | 12 +++++++----- t/op/kill0.t | 16 +++++++++++++++- 7 files changed, 43 insertions(+), 8 deletions(-) diff --git a/doio.c b/doio.c index 7be7af1..1e9d7d9 100644 --- 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 --- 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 --- 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 --- a/pod/perl5110delta.pod +++ b/pod/perl5110delta.pod @@ -185,6 +185,13 @@ See L pragma"> above. as documented, and as does C<-I> when specified on the command-line. (Renée Bäcker) +=item C 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 --- 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 --- 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 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 -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 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 for more details. diff --git a/t/op/kill0.t b/t/op/kill0.t index 063c388..eadf15d 100644 --- 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"); +} + -- 2.7.4