2

我绝不是 perl 或多线程方面的专家，但我确信我“做错了”，需要一些关于如何改变它的指导，这样我就不会收到线程退出警告。

如您所见，该程序读取参数 0，查找与主机名关联的每个 IP 地址，然后测试每个 IP 以查看 ssh 是否正在运行。

此脚本的目的是为每个主机生成一个 tcp 测试并返回第一个成功的 tcp 连接。

任何人都可以提出一种更可靠且不需要睡眠的方法吗？

use strict;
use warnings;
BEGIN {
    use Config;
    $Config{useithreads} or die('Recompile Perl with threads to run this program.');
}
use threads;
use IO::Socket::INET;
$| = 1;

unless($ARGV[0]){ die("error please use argument")}

my $timeoutval=3;
my $testHost=$ARGV[0];
my $dlquery=`dig $testHost | grep 'IN A'`;
my $SUCCESS=0;

sub testSSHhost {
    my $fqdn = shift;
    my $socket = new IO::Socket::INET (
            PeerHost => $fqdn,
            PeerPort => '22',
            Proto => 'tcp',
            Timeout => $timeoutval,
    ) or return "ERROR in Socket Creation : $!\n";

    my $tcpData = <$socket>;
    $socket->close();
    if ($tcpData && $tcpData=~/SSH/){
            print "$fqdn\n";
            $SUCCESS=1;
            exit(0);
    }
    return $fqdn;
}

my @threads;
for my $line (split(/\n/,$dlquery)){
    my @linesplit=split(/ /,$line);
     $linesplit[0]=~s/\.$//;
     $linesplit[0]=~s/ *//g;
     my $t = threads->new(\&testSSHhost, $linesplit[0]);
     push(@threads,$t);
}

while (!$SUCCESS){sleep 0.3}

我真正想要避免的是“一个线程在 2 个线程运行时退出。” 错误消息或“分段错误”消息

4

2 回答 2

2

像这样的东西（未经测试！）：

use Modern::Perl;
use threads;
use Thread::Queue;
use IO::Socket::INET;
$| = 1;

my $testHost = $ARGV[0];
my $dlquery  = `dig $testHost | grep 'IN A'`;
my $config   = { NUMBER_OF_THREADS => 5 };      #how many threads you gonna use?

my $queue           = Thread::Queue->new;
my $queue_processed = Thread::Queue->new;

for my $line ( split( /\n/, $dlquery ) ) {
    my ($ip) = split( / /, $line );
    $ip =~ s/\.$//;
    $ip =~ s/ *//g;

    $queue->enqueue($ip);
}

foreach my $thread_id ( 1 .. $config->{NUMBER_OF_THREADS} ) {

    $queue->enqueue(undef);
    my $thread = threads->create( \&testSSHhost() )->detach();
}

while ( $queue->pending() ) {

    my $result = $queue_processed->dequeue();

    if ( $result->{status} ) {

        say $result->{ip};
    }
}

sub testSSHhost {

    while ( my $fqdn = $queue->dequeue() ) {

        my $status = 0;

        my $socket = new IO::Socket::INET(
            PeerHost => $fqdn,
            PeerPort => 22,
            Proto    => 'tcp',
            Timeout  => 3,
        ) or return "ERROR in Socket Creation : $!\n";

        my $tcpData = <$socket>;
        $socket->close();
        if ( $tcpData && $tcpData =~ /SSH/ ) {

            $status = 1;
        }

        $queue_processed->enqueue( { ip => $fqdn, status => $status, } );
    }

    return 0;
}
于 2012-06-22T15:28:31.463 回答
0

您可以使用 Qeus 来实现它： http ://search.cpan.org/dist/Thread-Queue/lib/Thread/Queue.pm

在产生线程之前，您创建一个队列，然后让线程将成功的 IP 地址推入其中。然后父进程将阻止出队，直到弹出一些东西。

于 2012-06-22T14:16:36.717 回答