关于perl fork

picbhan

最近测试perl fork函数能产生子进程的最大数目和子进程自动收割，结果发现貌似如果是fork失败了的话，就没法继续fork了，无论你是否在第一个失败的fork后把所有子进程都收割。也就是说，无论你还有没有子进程在运行，只要fork失败了，就无法恢复fork了，不知道有没有人想到办法解决这个问题？
代码贴出来，高手看看吧！求解

1. #!/usr/bin/env perl
   
2. use strict;
   
3. use warnings;
   
4. 
   
5. use POSIX ":sys_wait_h"; # for nonblocking read
   
6. my %children;
   
7. my $count = 0;
   
8. 
   
9. my $num = 0;
   
10. while ($num++ < 100) { # win7最多fork 64个
    
11.     my $pid = fork();
    
12.     until (defined $pid) {
    
13.         die "Can't fork. count is $count.\n" if $count == 0;
    
14.         for (keys %children) {
    
15.             print "Reaping $_ now, count is $count\n";
    
16.             waitpid(0, $_);
    
17.             delete $children{$_};
    
18.             $count--;
    
19.         }
    
20.         print "All reaped.\n";
    
21.         $pid = fork();
    
22.     }
    
23.     $children{$pid} = 1;
    
24.    
    
25.     if ($pid == 0) {
    
26.         sleep 1;
    
27.         exit 0;
    
28.     }
    
29.     $children{$pid}=1;
    
30.     $count++;
    
31.     print("pid is $pid, num is $num\n");
    
32. }

复制代码

zhlong8

waitpid 用错了

picbhan

回复 2# zhlong8


    其实我最开始用的是my $pid = waitpid(-1, WNOHANG);但是好像也不对。能否解释清楚一点呢？

zhlong8

回复 3# picbhan


    你这里应该用 waitpid($_, 0) PID 是第一个参数

picbhan

回复 4# zhlong8


    waitpid(0, $_)对于64以下的数据能够正常运行，waitpid($_， 0)能够在64以后继续fork，貌似perldoc官网上对waitpid解释太少了。
另外，如果我想用waitpid(-1， WHOHANG)这种形式该怎么改呢？因为我不确定waitpid(0, $_)是否会等待当前$_进程执行完才能收割下一个，waitpid(-1， WHOHANG)貌似不阻断。

zhlong8

回复 5# picbhan


    直接搜 waitpid 就行。另外 64 个的限制是存在的要改估计要重新编译才行，你先把它当定死的吧。

picbhan

回复 6# zhlong8


    我又搜了一遍perldoc.org，关于waitpid的介绍确实不够详细，不过看了unix的waitpid倒是挺好理解的，虽然参数有差别。刚刚测试发现my $pid = waitpid($_, 0)是阻塞的，但是我想要非阻塞的收割方式，因为我只需限制子进程的最大数目不超过一个定值，当超过后就收割任何僵死进程，因此这种阻塞的方式不太合适。而我下面的代码对于fork失败后貌似就无法收割已产生的子进程，但是对于未失败的fork能正常运行。我觉得原因还是在于fork失败后waitpid(-1, WNOHANG)不能正常运行，这种情况下有解决办法没？

1. #!/usr/bin/env perl
   
2. use strict;
   
3. use warnings;
   
4. 
   
5. use POSIX ":sys_wait_h"; # for nonblocking read
   
6. my %children;
   
7. my $count = 0;
   
8. 
   
9. my $num = 0;
   
10. while ($num++ < 70) {
    
11.     my $pid = fork();
    
12.     until (defined $pid) {
    
13.         die "Can't fork. count is $count\n" if $count == 0;
    
14.         unless (_reap_subprocess(\%children, \$count)) {
    
15.             die "Can't fork subprocess even when no " .
    
16.                 "subprocess is running.\n";
    
17.         }
    
18.         $pid = fork();
    
19.     }
    
20.     $children{$pid} = 1;
    
21.    
    
22.     if ($pid == 0) {
    
23.         sleep 5;
    
24.         exit 0;
    
25.     }
    
26.     $count++;
    
27.     print("pid is $pid, num is $num\n");
    
28.     _reap_subprocess(\%children, \$count) if $count > 63; # 62 works here
    
29. }
    
30. 
    
31. _reap_subprocess(\%children, \$count) while ($count);
    
32. 
    
33. sub _reap_subprocess {
    
34.     my ($child_ref, $count_ref) = @_;
    
35.     return 0 unless $count_ref;
    
36.     my %child = %$child_ref;
    
37.    
    
38.     my $reaped;
    
39.     while (1) {
    
40.         # last if reaped one valid subprocess
    
41.         my $pid = waitpid(-1, WNOHANG);
    
42.         if ($pid == -1 or $pid == 0) {
    
43.             last if $reaped;
    
44.             print "No HANG, wait 5, count is $count_ref.\n";
    
45.             sleep 5;
    
46.         }
    
47.         elsif (defined $child{$pid}) {
    
48.             print "pid is $pid, count is $count_ref\n";
    
49.             delete $child_ref->{$pid};
    
50.             $count_ref--;
    
51.             $reaped = 1;
    
52.         }
    
53.     }
    
54.    
    
55.     return 1;
    
56. }

复制代码

picbhan

我把这个程序放在linux系统上运行的时候是正常的，因为linux能fork更多子进程，所以修改了下一些数值和输出，代码如下：

1. #!/usr/bin/env perl
   
2. use strict;
   
3. use warnings;
   
4. 
   
5. use POSIX ":sys_wait_h"; # for nonblocking read
   
6. my %children;
   
7. my $count = 0;
   
8. my $max = shift @ARGV || 100000;
   
9. my $num = 0;
   
10. while ($num++ < $max) {
    
11.     my $pid = fork();
    
12.     until (defined $pid) {
    
13.         print "Failed to fork new subprocess, num is $num， try to reap zombies now.\n";
    
14.         die "Can't fork. count is $count\n" if $count == 0;
    
15.         unless (_reap_subprocess(\%children, \$count)) {
    
16.             die "Can't fork subprocess even when no " .
    
17.                 "subprocess is running.\n";
    
18.         }
    
19.         print "Zombies reaped, try to fork again.\n";
    
20.         $pid = fork();
    
21.     }
    
22.     $children{$pid} = 1;
    
23.    
    
24.     if ($pid == 0) {
    
25.         sleep 5;
    
26.         exit 0;
    
27.     }
    
28.     $count++;
    
29.     #print("pid is $pid, num is $num\n");
    
30.     #_reap_subprocess(\%children, \$count) if $count > 63; # 62 works here
    
31. }
    
32. 
    
33. _reap_subprocess(\%children, \$count) while ($count);
    
34. 
    
35. sub _reap_subprocess {
    
36.     my ($child_ref, $count_ref) = @_;
    
37.     return 0 unless $count_ref;
    
38.     my %child = %$child_ref;
    
39.    
    
40.     my $reaped;
    
41.     while (1) {
    
42.         # last if reaped one valid subprocess
    
43.         my $pid = waitpid(-1, WNOHANG);
    
44.         if ($pid == -1 or $pid == 0) {
    
45.             last if $reaped;
    
46.             print "No HANG, wait 5, count is $count_ref, pid is $pid.\n";
    
47.             sleep 5;
    
48.         }
    
49.         elsif (defined $child{$pid}) {
    
50.             # print "pid is $pid, count is $count_ref\n";
    
51.             delete $child_ref->{$pid};
    
52.             $count_ref--;
    
53.             $reaped = 1;
    
54.         }
    
55.     }
    
56.    
    
57.     return 1;
    
58. }

复制代码

代码输出如下：
Failed to fork new subprocess, num is 31822, try to reap zombies.
Zombies reaped, try to fork again.
Failed to fork new subprocess, num is 54765, try to reap zombies.
Zombies reaped, try to fork again.
Failed to fork new subprocess, num is 54765, try to reap zombies.
No HANG, wait 5, count is 12656, pid is 0.
Zombies reaped, try to fork again.
Failed to fork new subprocess, num is 67421, try to reap zombies.
Zombies reaped, try to fork again.
Failed to fork new subprocess, num is 67421, try to reap zombies.
No HANG, wait 5, count is 12656, pid is 0.
Zombies reaped, try to fork again.
Failed to fork new subprocess, num is 80081, try to reap zombies.
Zombies reaped, try to fork again.
Failed to fork new subprocess, num is 80081, try to reap zombies.
No HANG, wait 5, count is 12656, pid is 0.
Zombies reaped, try to fork again.
Failed to fork new subprocess, num is 92737, try to reap zombies.
Zombies reaped, try to fork again.
Failed to fork new subprocess, num is 92737, try to reap zombies.
No HANG, wait 5, count is 12656, pid is 0.
Zombies reaped, try to fork again.
No HANG, wait 5, count is 7264, pid is 0.
No HANG, wait 5, count is 788, pid is 0.
整个代码正常结束。
因此，我觉得可能是win7系统中perl自己仿真的fork和waitpid与linux系统调用的有所差别，才导致在fork失败后waitpid(-1, WNOHANG)不能正常收割子进程。

zhlong8

回复 8# picbhan


    估计不支持第一个参数为 -1 吧，对某一个 fork 出来的“进程”是支持非阻塞模式的。

picbhan

回复 9# zhlong8


    我觉得应该不是不支持第一个参数为-1，要不然当fork没失败之前也不会运行成功了，比如说

1. _reap_subprocess(\%children, \$count) if $count > 62; # 62 works here

复制代码

在fork失败之前就收割完僵死进程在win7上也能够正常运行。而收割方法是一样的$pid = waitpid(-1, WNOHANG);