Generic Broadcast SSH Launcher

[QM]

I'm currently using the following to run commands on remote systems through ssh. I'd appreciate any comments or improvements.

One specific question is how to capture STDERR and assign it to the remote host it came from. (I haven't spent much time investigating this issue, so there's probably some easy fix I've overlooked.)

Here's the script:

#!/usr/bin/env perl

use strict;
use warnings;

use Parallel::ForkManager;

### hash keys ###
my $HOST = q/host/;
my $START = q/start/;

### cmd line options
my $CMD_OPT  = q/-c/;
my $USER_OPT = q/-u/;
my $SSH_OPT  = q/-s/;
my $EVAL_OPT = q/-e/;
my $HELP_OPT = q/-h/;
my $TIMEOUT_OPT = q/-t/;

### defaults
my $ssh  = my $ssh_default  = q/ssh/;
my $cmd  = my $cmd_default  = q/uptime/;
my $user = my $user_default = q/murphy/;
my $timeout = 90;

### process cmd line
my @temp_args;

while (@ARGV)
{
    if ($ARGV[0] =~ /^$CMD_OPT$/)
    {
        shift;
        if (exists $ARGV[0])
        {
            $cmd = shift;
            next;
        }
        else
        {
            warn "Error: option $CMD_OPT requires an argument\n";
            usage();
        }
    }

    if ($ARGV[0] =~ /^$USER_OPT$/)
    {
        shift;
        if (exists $ARGV[0])
        {
            $user = shift;
            next;
        }
        else
        {
            warn "Error: option $USER_OPT requires an argument\n";
            usage();
        }
    }

    if ($ARGV[0] =~ /^$SSH_OPT$/)
    {
        shift;
        if (exists $ARGV[0])
        {
            $ssh = shift;
            next;
        }
        else
        {
            warn "Error: option $SSH_OPT requires an argument\n";
            usage();
        }
    }

    if ($ARGV[0] =~ /^$TIMEOUT_OPT$/)
    {
        shift;
        if (exists $ARGV[0])
        {
            $timeout = shift;
            next;
        }
        else
        {
            warn "Error: option $TIMEOUT_OPT requires an argument\n";
            usage();
        }
    }

    if ($ARGV[0] =~ /^$EVAL_OPT$/)
    {
        shift;
        if (exists $ARGV[0])
        {
            my $eval_string = shift;
            my @result;
            {
#                no strict 'subs';
                @result = eval "$eval_string";
                print "<", join(', ', @result), ">\n";
                die ($@) if $@;
#                print "\n";
            }
            push @ARGV, @result if @result;
            next;
        }
        else
        {
            warn "Error: option $EVAL_OPT requires an argument\n";
            usage();
        }
    }

    if ($ARGV[0] =~ /^$HELP_OPT/)
    {
        usage();
    }

    push @temp_args, shift;
}

@ARGV = @temp_args;

### setup default host list
my $host_base = q/camhyd/;
my $blade_base = q/mur/;
my $blade_sign = q/b/;
my @hosts = map { $host_base . $_ } qw(tc01);

for my $rack ('001'..'003')
{
    for my $blade (0..7)
    {
        push @hosts, "${host_base}${blade_base}${rack}${blade_sign}${b
+lade}";
    }
}

### override from cmd line
if (@ARGV)
{
    @hosts = @ARGV;
}

# save child pids here
my %children;

# create new manager, limit number of parallel processes
my $pm = new Parallel::ForkManager(10); # limit to 10 parallel process
+es

for my $host (sort @hosts)
{
    if (my $pid = $pm->start) {
      $children{$pid}{$HOST} = $host;
      $children{$pid}{$START} = time();
      next;
    }
    ### child section ###
    alarm($timeout); # die after elapsed time in child

    my @result = qx/$ssh ${user}\@$host '$cmd'/;

    my $prefix = sprintf " %20s)  ", $host;
    my $message;
    $message = sprintf "%s\n", '*' x 20 if (@result != 1);
    for my $r (@result) {
        $message .= "$prefix$r";
    }
    print "$message\n";
    $pm->finish; # do the exit in the child process
}
$pm->wait_all_children;

exit;

sub usage
{
    warn "Usage: $0 [-s ssh_cmd] [-u user] [-c cmd] [hosts...]\n\n";
    warn "    where:\n\n";
    warn "    $SSH_OPT ssh_cmd    ssh-type cmd to use (default: $ssh_d
+efault)\n";
    warn "    $USER_OPT user       username for the ssh_cmd (default: 
+$user_default)\n";
    warn "    $CMD_OPT cmd        remote shell command to use on the h
+osts (default: $cmd_default)\n";
    warn "    $EVAL_OPT cmd        eval arguments, such as ranges (ex:
+ $EVAL_OPT 'glob(\"camhydmur00{1,2,3}b{0,1,2,3,4,5,6,7}\")')\n";
    warn "    $TIMEOUT_OPT cmd        timeout in seconds before parent
+ reaps children\n";
    warn "    hosts...      hostnames for the remote shell command\n";
    warn "    $HELP_OPT            usage (this output)\n";
    warn "\n";
    warn "It is assumed that ssh key exchange has already been setup.\
+n";
    die "\n";
}

Typical run looks like this:

my_machine> net.pl -c 'date' camhydmur001b{1,2,3}
       camhydmur001b3)  Fri May 10 12:15:58 GMT 2013

       camhydmur001b1)  Fri May 10 12:15:58 GMT 2013

       camhydmur001b2)  Fri May 10 12:15:58 GMT 2013

However, when there are errors, I haven't figured out how to assign them to the corresponding host:

my_machine> net.pl -c 'ls /junk' camhydmur001b{1,2,3}
ls: cannot access /junk: No such file or directory
********************

ls: cannot access /junk: No such file or directory
********************

ls: cannot access /junk: No such file or directory
********************

Update: I revisited this recently, and realized I just needed redirection. A quick hack like this does it:

$cmd .= ' 2>&1';

...though I'll put something in more generic, like have a default redirect, then a command line option to change it when needed.

[mcrose]

It looks like you're reinventing a wheel. https://metacpan.org/module/SALVA/Net-OpenSSH-0.60/lib/Net/OpenSSH.pm

open my $stderr_fh, '>>', '/tmp/$host.err' or die ...;
open my $stdout_fh, '>>', '/tmp/$host.log' or die ...;
 
my $ssh = Net::OpenSSH->new($host, default_stderr_fh => $stderr_fh,
                                   default_stdout_fh => $stdout_fh);
$ssh->error and die "SSH connection failed: " . $ssh->error;
 
$ssh->scp_put("/foo/bar*", "/tmp")
  or die "scp failed: " . $ssh->error;

[QM]

OK, I see that. So it seems I can use $ssh->capture2(...).

Are there any issues between Net::OpenSSH and Parallel::ForkManager? Or is there a better way to do this without P::FM?

[salva]

There shouldn't be any issues combining both modules.

Check also Net::OpenSSH::Parallel.