4

I am running a perl script on a Linux host. I'm trying to write a script that forks, where the child starts a program that takes forever and the parent times out after 5 seconds, killing the child. Here is what I have:

my $start = time();
my $timeOut = 5;

my $childPid = fork();
if ($childPid) {
    # I am the parent, and $childPid is my child
    while (kill(0, $childPid)) {
        if (time() > $start + $timeOut) {
            $numKilled = kill(SIGTERM, $childPid);
            printf("numKilled: %s\n", $numKilled);
        }
        sleep 1;
    }
}
else {
    # I am the child - do something that blocks forever
    `adb -s 410bf6c1 logcat`;
    exit;
}

Output:

aschirma@graphics9-lnx:~$ perl perl-fork-test.pl 
numKilled: 1
numKilled: 1
numKilled: 1
numKilled: 1
numKilled: 1
...

The behavior I expect is that I see "numKilled: 1" exactly once, and the child process (and any of its children) is killed after roughly 5 seconds. But I see from experiment that neither the child nor its children are getting killed. The kill(SIGTERM, $childPid) appears to do nothing.

How can I actually kill the child?

4

6 回答 6

6

Should be something like this. This isn't following best practices, but it should help you with your problem...

#!/usr/bin/perl

use warnings;
use strict;
use POSIX qw(:sys_wait_h);

my $timeOut = 5;
$SIG{ALRM} = \&timeout;
$SIG{CHLD} = 'IGNORE',
alarm($timeOut);

my $childPid = fork();
if ($childPid) {
    while(1) {
        print "[$$]: parent...\n"; 
        sleep(2); 
    }
}else {
    # I am the child - do something that blocks forever
    while(1){
        print "[$$]: child...\n";
        sleep(2);
    }
    exit;
}

sub timeout {
    print "killing $childPid\n";
    print "###\n" . `ps -ef | grep -v grep | grep perl` . "###\n";
    if ( ! (waitpid($childPid, WNOHANG)) ) {
        print "killing $childPid...\n";
        kill 9, $childPid;
        die "[$$]: exiting\n";
    }
}

OUTPUT:

$ forktest.pl
[24118]: parent...
[24119]: child...
[24118]: parent...
[24119]: child...
[24118]: parent...
[24119]: child...
killing 24119
###
cblack   24118 12548  0 14:12 pts/8    00:00:00 /usr/bin/perl ./forktest.pl
cblack   24119 24118  0 14:12 pts/8    00:00:00 /usr/bin/perl ./forktest.pl
###
killing 24119...
[24118]: exiting
于 2013-02-21T22:13:43.027 回答
4

From perldoc fork:

If you fork without ever waiting on your children, you will accumulate zombies. On some systems, you can avoid this by setting $SIG{CHLD} to "IGNORE" .

I was able to get the desired behavior when adding $SIG{CHLD} = 'IGNORE'; to the top of your code.

[ben@imac ~]$ perl test.pl
numKilled: 1
[ben@imac ~]$

Alternatively, adding waitpid($childPid, 0); after kill did the trick as well.

于 2013-02-21T21:58:07.377 回答
1

Chances are that you are useing neither strict nor POSIX in your script, so SIGTERM is being interpreted as the bareword "SIGTERM", which isn't behaving in a useful way.

use strict to make this accidental bareword into an error, then use POSIX to pull in the SIGTERM constant.

于 2013-02-21T21:28:39.837 回答
1

I am also seeing this behaviour, that kill 0 returns true even after the process was gone; I suspected you might be missing a call to waitpid (often done in a SIGCHLD handler) which would result in this, but even after adding it, the kill 0 continues to return true.

I suggest you use non-blocking waitpid instead of kill (and verify that the process actually does die on a SIGTERM signal - some may not, at least immediately). You may also want to try SIGINT after a while if SIGTERM didn't work, and in the last resort SIGKILL.

于 2013-02-21T21:46:23.487 回答
1

Try killing the process group (use -$pid):

kill TERM => -$pid;

See perlipc.

于 2013-02-22T01:05:07.527 回答
0

I think the problem is with the '0' you are passing as first argument of 'kill'. When I read the docs, they say that '0' will just check to see whether you can send a signal to the process, without sending it. In your case, you want to send the 'KILL' signal to the child process, so do this:

kill( 'KILL', $childPid );
于 2017-01-27T07:37:39.570 回答