Trong perl, giết chết trẻ em và con của nó khi con được tạo bằng mở

Question

Dưới đây là mã của tôi, với xử lý lỗi và các công cụ khác lấy ra cho rõ ràng:

sub launch_and_monitor { 

    my ($script, $timeout) = @_; 

    sub REAPER { 
     while ((my $child = waitpid(-1, &WNOHANG)) > 0) {} 
     $SIG{CHLD} = \&REAPER; 
    } 
    $SIG{CHLD} = \&REAPER; 

    my $pid = fork; 
    if (defined $pid) { 
     if ($pid == 0) { 
      # in child 
      monitor($timeout); 
     } 
     else { 
      launch($script); 
     } 
    } 
} 

Việc tung ra phụ thực hiện một kịch bản shell mà lần lượt ra mắt khác quy trình, như vậy:

sub launch($) { 

    my ($script) = @_; 

    my $pid = open(PIPE, "$script|"); 

    # write pid to pidfile 

    if ($pid != 0) { 
     while(<PIPE>) { 
      # do stuff with output 
     } 
     close(PIPE) or die $!; 
    } 
} 

Phụ giám sát cơ bản chỉ chờ một khoảng thời gian nhất định và sau đó tìm cách giết tập lệnh trình bao.

sub monitor($) { 

    my ($timeout) = @_; 

    sleep $timeout; 

    # check if script is still running and if so get pid from pidfile 
    if (...) { 
     my $pid = getpid(...);   
     kill 9, $pid; 
    } 
} 

Điều này giết chết tập lệnh, tuy nhiên, nó không giết bất kỳ quy trình phụ nào của nó. Làm thế nào để khắc phục?

Answer 1

Bạn có thể thực hiện việc này với các nhóm xử lý, nếu hệ điều hành của bạn hỗ trợ chúng. Bạn cần phải làm cho quá trình kịch bản trở thành một nhà lãnh đạo nhóm quá trình. Quá trình con mà nó chạy sẽ kế thừa nhóm quá trình từ cha mẹ của chúng. Sau đó, bạn có thể sử dụng lệnh giết để gửi tín hiệu đến từng quá trình trong nhóm cùng một lúc.

Trong launch(), bạn sẽ cần phải thay thế dòng open bằng một nhánh đó. Sau đó, trong đứa trẻ, bạn sẽ gọi setpgrp() trước khi thực hiện lệnh. Một cái gì đó như sau nên làm việc:

my $pid = open(PIPE, "-|"); 
if (0 == $pid) { 
    setpgrp(0, 0); 
    exec $script; 
    die "exec failed: $!\n"; 
} 
else { 
    while(<PIPE>) { 
     # do stuff with output 
    } 
    close(PIPE) or die $!; 
} 

Sau đó, để giết chết quá trình kịch bản và con của nó, phủ nhận quá trình ID mà bạn đã thể hiện:

kill 9, -$pid; 

Answer 2

Nói chung, tôi không nghĩ rằng bạn có thể mong đợi các tín hiệu được truyền vào tất cả các quy trình con; điều này không cụ thể đối với perl.

Điều đó nói rằng, bạn có thể sử dụng quá trình nhóm tính năng tín hiệu được xây dựng vào perl kill():

... nếu SIGNAL là tiêu cực, nó giết chết các nhóm quá trình thay vì quá trình ...

bạn có thể cần phải sử dụng setpgrp() trên (trực tiếp) quá trình con quý vị, sau đó thay đổi cuộc gọi giết bạn để một cái gì đó như:

kill -9, $pgrp; 

Answer 3

Hãy thử thêm:

use POSIX qw(setsid); 
setsid; 

ở phía trên cùng của chức năng launch_and_monitor của bạn. Điều này sẽ đặt các quy trình của bạn trong một phiên riêng biệt và khiến mọi thứ thoát ra khi người đứng đầu phiên (nghĩa là tổng thể) thoát.

Answer 4

Giết chết một công trình processgroup, nhưng don' t quên cha mẹ có thể bị giết một mình quá. Giả sử các tiến trình con có một vòng lặp sự kiện, chúng có thể kiểm tra socket cha đã được tạo ra trong một socketpair trước khi thực hiện fork() cho tính hợp lệ. Trong thực tế, chọn() sạch sẽ thoát khi socket mẹ đã biến mất, tất cả những gì cần làm là kiểm tra socket.

Ví dụ::

use strict; use warnings; 
use Socket; 

$SIG{CHLD} = sub {}; 

socketpair(my $p, my $c, AF_UNIX, SOCK_STREAM, PF_UNSPEC) or die $!; 

print "parent $$, fork 2 kids\n"; 
for (0..1){ 
    my $kid = fork(); 
    unless($kid){ 
     child_loop($p, $c); 
     exit; 
    } 
    print "parent $$, forked kid $kid\n"; 
} 

print "parent $$, waiting 5s\n"; 
sleep 5; 
print "parent $$ exit, closing sockets\n"; 

sub child_loop { 
    my ($p_s, $c_s) = @_; 
    print "kid: $$\n"; 
    close($c_s); 
    my $rin = ''; 
    vec($rin, fileno($p_s), 1) = 1; 
    while(1){ 
     select my $rout = $rin, undef, undef, undef; 
     if(vec($rout, fileno($p_s), 1)){ 
      print "kid: $$, parent gone, exiting\n"; 
      last; 
     } 
    } 
} 

Chạy như thế này:

tim@mint:~$ perl ~/abc.pl 
parent 5638, fork 2 kids 
parent 5638, forked kid 5639 
kid: 5639 
parent 5638, forked kid 5640 
parent 5638, waiting 5s 
kid: 5640 
parent 5638 exit, closing sockets 
kid: 5640, parent gone, exiting 
kid: 5639, parent gone, exiting 
tim@mint:~$