diff options
| -rw-r--r-- | doio.c | 6 | ||||
| -rw-r--r-- | ext/Test-Harness/t/sample-tests/taint | 2 | ||||
| -rw-r--r-- | ext/Test-Harness/t/sample-tests/taint_warn | 2 | ||||
| -rw-r--r-- | pod/perl5110delta.pod | 7 | ||||
| -rw-r--r-- | pod/perldiag.pod | 6 | ||||
| -rw-r--r-- | pod/perlfunc.pod | 12 | ||||
| -rw-r--r-- | t/op/kill0.t | 16 |
7 files changed, 43 insertions, 8 deletions
@@ -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 b67d719fc7..c36698e042 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 768f527326..398d6181ee 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 e9e9efa160..c49c0e7b4c 100644 --- 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 dc0c5ea3ee..9d58104ab8 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 2035795bb6..23e5535e4f 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<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 063c38897b..eadf15dc36 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"); +} + |