Multithreading 线程在ssh连接（perl）中卡住

我正在制作一张纸条，这个纸条的想法是创建线程，同时浏览机器列表并检查东西。看起来，当一个线程使用“ssh……”进入它的独立终端时，它会被卡住，我无法杀死它。他们也有一个计时器，似乎不工作

代码如下：

sub call_cmd{
    my $host = shift;
    my $cmd = shift;
    my $command = $cmd;
    my $message;

    open( DIR, "$cmd|" ) || die "No cmd: $cmd $!";
    while(<DIR>){
        $message.=$_;
        print "\n $host $message \n";
    }
    close DIR;

    print "I'm here";
}

sub ssh_con($$){

my $host = $_[0]; 
my $cmd = "ssh $host -l $_[1]";
call_cmd($host,$cmd);

}

输出：

 home/pblue> perl tsh.pl

 ssh XXXXX -l pblue

 ssh XXXXX -l pblue

  XXXXX Last login: Mon Sep 30 10:39:01 2013 from ldm052.wdf.sap.corp


  XXXXX Last login: Mon Sep 30 10:39:01 2013 from ldm052.wdf.sap.corp

---

除了您的代码有点奇怪之外，我还遇到了您的问题——特别是在RHEL 5上的Perl 5.8.8中

似乎存在一种竞争条件，如果您在一个线程中同时生成两个ssh进程，它们就会死锁。我找到的唯一解决方案是一种变通方法，您可以在其中声明：

my $ssh_lock : shared;

然后将ssh作为文件句柄“打开”：

my $ssh_data:
{
    lock ( $ssh_lock );
    open ( my $ssh_data, "|-", "ssh -n $hostname $command" ); 
}
#lock out of scope, so released
while ( <$ssh_data> ) {
    #do something
}

这是一个有效的命令，但它将以交互方式启动ssh—但由于您是多线程的，这将在标准in和标准stdout中执行非常奇怪的操作

对于使用多线程的

signal

s，您也应该非常小心-由于进程间通信的性质，它工作得不太好。设置报警信号

对于类似的事情（例如，通过ssh运行命令），我已经通过以下方法获得了一定程度的成功：

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

use threads;
use threads::shared;
use Thread::Queue;

my @servers_to_check = qw ( hostname1 hostname2 hostname3 hostname4 );

my $num_threads = 10;

my $task_q = Thread::Queue->new;
my $ssh_lock : shared;

sub worker_thread {
    my ($command_to_run) = @_;
    while ( my $server = $task_q->dequeue ) {
        my $ssh_results;
        {
            lock($ssh_lock);
            my $pid = open( $ssh_results, "-|",
                "ssh -n $server $command_to_run" );
        }
        while (<$ssh_results>) {
            print;
        }
        close($ssh_results);
    }
}

for ( 1 .. $num_threads ) {
    threads->create( \&worker_thread, "df -k" );
}

$task_q->enqueue(@servers_to_check);
$task_q->end;

foreach my $thr ( threads->list ) {
    $thr->join();
}

#/usr/bin/perl
严格使用；
使用警告；
使用线程；
使用线程：：共享；
使用线程：：队列；
my@servers\u to\u check=qw（主机名1主机名2主机名3主机名4）；
我的$num_线程=10；
我的$task\u q=线程：：队列->新建；
我的$ssh_锁：共享；
副工作线程{
我的（$command_to_run）=@；
while（my$server=$task\u q->出列）{
我的$ssh_结果；
{
锁（$ssh_-lock）；
my$pid=open（$ssh_结果“-|”，
“ssh-n$server$command_to_run”）；
}
而（）{
印刷品；
}
关闭（$ssh_结果）；
}
}
用于（1..$num_线程）{
线程->创建（\&worker\u线程，“df-k”）；
}
$task\u q->排队（@servers\u to\u check）；
$task_q->end；
foreach my$thr（线程->列表）{
$thr->join（）；
}

此代码具有高度的WTF。您正在命名进程

DIR

上的句柄，并在读取第1行后关闭if。您没有显示调用

call\u cmd

的位置。覆盖所有

ALRM

处理程序<代码>报警在每个进程级别上工作，但您使用线程——这是海森堡和混乱的一种交互方式。您是否使用了严格的

；使用警告

？你能告诉我你得到的确切结果吗？我不知道你的代码是什么。我在阅读了第一行之后试图关闭它，以查看线程是否会退出ssh连接，但它似乎不起作用。我已经添加了CALLYMCMD，虽然它基本上只是形成要执行的命令。考虑使用。YEA作为一个工作来工作，所有的东西都是以Simular的方式设置的。我无法使用较新版本的perl，因为这些机器是构建服务器。其想法是在interactive中启动，并根据评估的输出继续使用命令，不管它当前如何执行命令，然后评估并触发新的ssh。无论如何，谢谢：）如果你想这么做，你需要

IPC:：Open2

来连接

STDIN

和

STDOUT

。

ssh $host -l pblue

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

use threads;
use threads::shared;
use Thread::Queue;

my @servers_to_check = qw ( hostname1 hostname2 hostname3 hostname4 );

my $num_threads = 10;

my $task_q = Thread::Queue->new;
my $ssh_lock : shared;

sub worker_thread {
    my ($command_to_run) = @_;
    while ( my $server = $task_q->dequeue ) {
        my $ssh_results;
        {
            lock($ssh_lock);
            my $pid = open( $ssh_results, "-|",
                "ssh -n $server $command_to_run" );
        }
        while (<$ssh_results>) {
            print;
        }
        close($ssh_results);
    }
}

for ( 1 .. $num_threads ) {
    threads->create( \&worker_thread, "df -k" );
}

$task_q->enqueue(@servers_to_check);
$task_q->end;

foreach my $thr ( threads->list ) {
    $thr->join();
}