Multithreading 在Perl线程中调用system（）时生成僵尸进程

在我的测试环境中有两个Linux节点（hostA和hosb），我需要触发一个脚本（worker.sh）在所有节点上并发运行，worker.sh已经放置在所有节点中，因此我在Perl脚本（master.pl）中使用了线程模块，下面是代码片段：

use threads(stringify);

sub runByThreads{
   my($count,$funcion,$host_ref,$cmd) = @_;
   @hostlist = @{$host_ref};

   my $thread;
   my @failNodes;

   for (my $i=0;$i<$count;$i++) {
      my $host =@hostlist[$i];
      $thread = threads->create($funcion,$host,$cmd);
      $parserState{$thread} = $host;
      $thread_num ++;
   }

   while ($thread_num != 0) {      # stuck in this while loop
      foreach my $subthread(threads->list(threads::joinable)) {
         my $ret = $subthread->join();
         if ($ret != 0) {
            ....
         }
         $thread_num --;
     }
     sleep 2;
   }
}

sub runCmd {
    my ($host,$cmd) = @_;

    chomp($localhost = `hostname -f`);
    if ($localhost eq $host) {
        $ret = system("source /etc/profile; $cmd");
    } else {
        $ret = system("ssh -o StrictHostKeyChecking=no ".$host." \"source /etc/profile; ". $cmd."\"");
    }
    return $ret;
}


main {
    my @servers = qw/hostA hostB/
    my $nodecount = scalar(@servers);
    my $arg = "--node";

    $cmd = "$HOME/worker.sh "."$arg";
    my @ret = &runByThreads($nodecount,\&runCmd,\@servers,$cmd);
    if ( scalar(@ret) != 0) {
        $failNum += 1;
    }
}

&main;

但有时，ps显示存在一个不存在的进程，该不存在的进程将导致master.pl卡在while循环中

0 S optitest  6503  6502  1  80   0 - 50628 pipe_w 05:51 ?        00:00:00 /usr/bin/perl master.pl
0 Z optitest  7496  6503  0  80   0 -     0 exit   05:51 ?        00:00:00 [hostname] <defunct>
0 S optitest  7497  6503  0  80   0 - 26536 wait   05:51 ?        00:00:00 sh -c source /etc/profile; cd /home/jack/linux/worker.sh --node

0 S optitest 6503 6502 1 80 0-50628管道w 05:51？00:00:00/usr/bin/perl master.pl
0Z光学测试749665030800-0出口05:51？00:00:00[主机名]
0秒测试749765030800-26536等待05:51？00:00:00 sh-c源/etc/profile；cd/home/jack/linux/worker.sh--节点

我知道僵尸进程是一个已完成执行（通过退出系统调用）但在进程表中仍有一个条目的进程，这发生在子进程中，其中仍然需要该条目以允许父进程读取其子进程的退出状态：一旦通过等待系统调用读取退出状态，僵尸的条目将从进程表中删除，并被称为“收获”

在我的测试中，我对失效进程是如何生成的感到困惑，失效进程应该是通过ssh在hostB上运行work.pl的进程，但我发现，当通过Perl系统调用创建该进程时，该进程似乎立即成为失效进程，因为我没有看到其运行的任何输出，甚至第一行worker.sh中的“echo”也没有执行

还有一件事也很奇怪，在worker.sh中，一些脚本被调用在后台运行，如果我清空hostB上的worker.sh，也可能会发生失效问题，但是如果我清空hostA和hostB上的worker.sh，我就再也看不到失效问题了

---

对于这篇冗长的文章，我很抱歉，我正在尽我最大的努力让我的问题更清楚，你能帮我检查一下出了什么问题吗，我在使用threads模块时是否遗漏了什么，或者threads模块有一些问题，因为我注意到官方不鼓励在perl中使用基于解释器的线程

线程在perldoc中列为“不推荐”。就我个人而言，我发现它们工作得很好，只是有点违反直觉——它们不是可能假设的轻量级结构（基于其他线程模型）

我会注意到-对于自动获取僵尸的一般解决方案是设置

$SIG{'CHLD'}

，例如：但是如果捕获返回代码，这可能不是一个好主意。不过，您可能可以改为执行

open

和

waitpid

所以我通常不会建议使用它们，除非您有需要进行大量线程间通信的场景<代码>并行：：ForkManager通常效率更高

如果您必须使用它们，我不会像您这样做，并为每个“作业”生成一个线程，而是使用带有

thread:：Queue

的工作线程模型

我不能肯定，但我怀疑你的问题之一是这一行：

$cmd = "$HOME/worker.sh "."$arg";

因为perl将插入

$HOME

——并且您没有定义它，因此它是空的

你真的应该打开

strict

和

warnings

并清除由此产生的任何错误-你的代码有很多错误

但也就是说，除非我遗漏了一些东西，否则您的代码要比需要的复杂得多，看起来您在这里所做的一切都是运行并行ssh命令

所以我建议你最好是这样：

#!/usr/bin/env perl
use strict;
use warnings;

use threads;
use Thread::Queue;

my @servers = qw/hostA hostB/;

my $cmd         = '$HOME/worker.sh --node';
my $threadcount = 2;

my $hostq  = Thread::Queue->new();
my $errorq = Thread::Queue->new();

sub worker {
    while ( my $hostname = $hostq->dequeue ) {
        my $output =
            qx( ssh -o StrictHostKeyChecking=no $hostname \"source /etc/profile; $cmd\" );
        if ($?) {
            $errorq->enqueue("$hostname: $output");
        }
    }
}


$hostq->enqueue(@servers);
for ( 1 .. $threadcount ) {
    my $thr = threads->create( \&worker );
}
$hostq->end();

foreach my $thr ( threads->list ) {
    $thr->join;
}
$errorq->end();
while ( my $error = $errorq->dequeue ) {
    print "ERROR: $error\n";
}

或者，使用

Parallel:：ForkManager

：

#!/usr/bin/env perl
use strict;
use warnings;

my @servers = qw/hostA hostB/;

my $cmd     = '$HOME/worker.sh --node';
my $manager = Parallel::ForkManager->new(5);    #fork limit.

foreach my $hostname (@servers) {
    $manager->start and next;
    my $output =
        qx( ssh -o StrictHostKeyChecking=no $hostname \"source /etc/profile; $cmd\" );
    if ($?) {
        print "ERROR: $hostname $output\n";
    }
    $manager->finish;
}

$manager->wait_all_children();

---

关于“官方不鼓励线程”，不，它们不是。threads.pm上的警告用词不当。实际上是指上一段。如果你不想处理线程太重的事实，那么就不鼓励线程。好吧，我不知道你能得到比perldoc说的“官方不鼓励在perl中使用基于解释器的线程”更多的“官方不鼓励”。我同意-如果你把它们设置正确的话，它们很好用。我刚才说那个句子用词不对。官方并不反对线程。官方上，如果你不想处理线程太重的事实，那么就不鼓励线程。我将修改答案。@ikegami，这可能更适合聊天，但我可以问一下，为什么你说这种不鼓励是非官方的吗？来自5.20的threads.pm的警告在perldelta-5.20中明显出现，并保留到5.22的更新threads.pm中。此外，所有这些警告都与perlpolicy对官方劝阻含义的令人沮丧的解释有关。这对我来说似乎相当正式。试试看！

#!/usr/bin/env perl
use strict;
use warnings;

my @servers = qw/hostA hostB/;

my $cmd     = '$HOME/worker.sh --node';
my $manager = Parallel::ForkManager->new(5);    #fork limit.

foreach my $hostname (@servers) {
    $manager->start and next;
    my $output =
        qx( ssh -o StrictHostKeyChecking=no $hostname \"source /etc/profile; $cmd\" );
    if ($?) {
        print "ERROR: $hostname $output\n";
    }
    $manager->finish;
}

$manager->wait_all_children();