Threads getting stuck in ssh connection (perl) - multithreading

Question

I'm working on a scrip which idea is to create threads and simultaneously go throughout a list of machines and check for things. It appears that when a thread goes into it's separate terminal using "ssh ......" it gets stuck and I can't kill it. They also have a timer which doesn't seem to be working.
Here is the code:
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);
}
I get the output message which the ssh returns, but I never get to the next print.
This is the code for creating the threads.
foreach(#machines){
my $_ = threads->create(thread_creation,$_);
$SIG{ALRM} = sub { $_->kill('ALRM') };
push(#threads,$_);
}
sub thread_creation(){
my $host = $_;
eval{
$SIG{ALRM} = sub { die; };
alarm(5);
ssh_con($host,"pblue");
alarm(0);
}
}
Output :
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

Answer 1

Aside from your code being a little odd, I have encountered your issue - specifically in Perl 5.8.8 on RHEL 5.
It seems there's a race condition, where if you spawn two ssh processes within a thread simultaneously, they deadlock. The only solution I have found is a workaround whereby you declare:
my $ssh_lock : shared;
And then 'open' your ssh as a filehandle:
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
}
However this may well be a moot point on newer versions of perl/newer operating systems. I certainly couldn't reproduce it particularly reliably though, and it went away entirely when I started using fork() instead.
That said - your code is doing some rather strange things. Not least that the command you are running is:
ssh $host -l pblue
Which is a valid command, but it'll start ssh interactively - but because you're multithreading, that'll do very strange things with standard in and stdout.
You should also be very careful with signals with multithreading - it doesn't work too well, because of the nature of the inter-process communication. Setting an ALARM signal
For a similar sort of thing - e.g. running commands via ssh - I've had a degree of success with an approach like this:
#!/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();
}