#!/usr/bin/perl

# DO NOT EDIT THIS FILE.  IT IS GENERATED AUTOMATICALLY FROM prsh.PL
$VERSION = '0.4';

=head1 NAME

prsh - An asynchronous, parallel rsh

=head1 SYNOPSIS

B<prsh> [--debug][--rsh-cmd word] [--ssh] [--prepend] [--timeout sec]
[--nokill] [--status] [--login-shell] [--help] [hostname ... ] -- command [args]

=head1 DESCRIPTION

B<Prsh> is a parallel asynchronous interface to rsh(1).
It runs a I<command> on a set of remote I<hostnames> listed 
on the command line.
All remote commands execute concurrently, and their standard
output and standard error are delivered to B<prsh>'s stdout
and stderr, respectively.   
The stdin of all remote commands is closed, c.f.
the B<-n> argument to rsh(1).

B<Prsh> is particularly useful in a system area
network, e.g., a Beowulf,  where users and system administrators 
frequently need to execute commands
remotely on large numbers of processors.

=head1 OPTIONS

Options control timeouts, status reports,
output flushing, etc.  
Options may be entered with one -hyphen or two --hyphens and they
may be abbreviated as long as they are unambiguous.

=over 5

=item B<--debug> 

Print some information which might be helpful for debugging.  You'll
see exactly what is being executed on the remote node.

=item B<--rsh-cmd> word

Use I<word> to launch a remote shell, in lieu of rsh.  Word may contain
embedded spaces.  For example,
the C<--ssh> argument below is equivalent to C<--rsh-cmd 'ssh -n -a -x'>.

=item B<--ssh>

Equivalent to C<--rsh-cmd 'ssh -n -a -x'>.

=item B<--prepend>

Prepend an identifier (i.e., the hostname) to every line of output
(both standard output and standard error) from each remote node.
B<Prsh> will guess that the execution shell on the remote node
is the same as the local environment variable C<SHELL>.  If this is
not the case, the C<--shell-type> flag is mandatory.

=item B<--nodeid>

Equivalent to --prepend, for backwards compatibility.  Deprecated.

=item B<--shell-type> [bash|csh]

Currently, this is only necessary when the C<--prepend> option is used.

Tells B<prsh> the type of default shell used for remote execution
on the remote hosts.  
In order to generate correct syntax for the remote command, B<prsh> 
must know whether the remote shell will be bash-like or not.
Bash-like shells should accept the C<E<gt>(proc)> syntax.
B<Prsh> will guess based on the value of the local C<SHELL>
environment variable, so this option is also only necessary if the
remote hosts have a different default login shell.

This command does not B<force> the remote shell to be one thing or
another.  If you want to use a particular shell just name it on the
command line, e.g.,:

C<prsh --prepend --shell-type csh remote -- /bin/bash -c 'foo=bar; echo $foo'>

ought to work even if your local C<SHELL> is bash, and your login shell on
remote host is csh.

=item B<--timeout> seconds

Terminate all remote processes after the specified number of I<seconds>.
The default is to wait 15 seconds.  An argument of zero means to wait
indefinitely.

=item B<--status>

Print a line indicating the completion status of each command.  
This relies on C<rsh> (or the command named in the B<--rsh-arg> option)
returning reliable exit status information.  Unfortunately, rsh(1) is
unreliable in this regard.  Ssh(1) is better.

=item B<--nokill>

Normally, when B<prsh> reaches its timeout (see C<--timeout>) it 
issues a kill command for each of the remote processes it spawned
before it exits.  This option allows orphaned processes to continue
running.

=item [hostname ...] 

The 
command will be run on each of the given I<hostnames>.  If no I<hostnames>
are provided, then the environment variable C<PRSH_HOSTS> will be
used instead.  

=item B<--> command [args]

The I<command> and I<args> are passed through rsh for execution on the
remote hosts.  The -- argument may not be abbreviated as a single hyphen.

=back

=head1 EXAMPLES

=over 5

=item *

Set the default list of remote processors to the contents of a file

export PRSH_HOSTS=`cat /var/run/bnodes-up`

=item *

Ensure that we have a directory on every node's /scratch:

prsh -- mkdir --parent /scratch/johns/tmp

=item *

Kill a program (perhaps an MPI or PVM process) that is running
of control.

prsh -- killall amok

=item *

Ask every remote processor to touch a unique file in your home directory.
This is a fairly severe test that network services, including NFS and rsh
are intact between the remote nodes and the host node.  Nodes that
respond with OK are probably completely operational.

prsh --prepend -ssh --status -- touch $HOME/.checknodes/\`uname --nodename\`

=back

=head1 ENVIRONMENT

Any switches in the C<PRSH_OPTIONS> environment variable will 
be used before the command line arguments.  The environment
variable C<PRSH_HOSTS> is used as a list of hostnames only if
no hostnames are explicitly provided on the command line.

=head1 SEE ALSO

rsh(1), ssh(1)

=head1 TODO

C<-sequential> argument that says to wait for each command to
complete before moving on to the next one.  Some fancy interrupt
handling is probably appropriate - i.e., SIGINT should probably
prompt for whether you want to continue with other nodes or not.

=head1 KNOWN BUGS

Quotes do not protect whitespace in C<PRSH_OPTIONS>.
Thus, C<PRSH_OPTIONS='--debug --rsh "ssh -n -a -x"'> does not work
the way you might hope.

It is difficult to guarantee that spaces, quotes, shell 
metacharacters, etc. traverse the gauntlet of interpreters between 
the caller's shell and remote execution completely unmolested.
Simple cases seem to work correctly, however.

Signal propagation is uncertain at best.

rsh(1) does not reliably propagate the return status of remote commands
back to the invoking shell, 
so the --status option is not as useful as it might be.  Use ssh(1) if
you're interested in remote exit status.

prsh(1) can overwhelm ssh(1)'s ability to forward X11 and authentication 
packets.  That's why the -ssh argument automatically
invokes ssh(1) with C<-a -x> flags.  Be very cautious about
re-enabling X11 and/or authentication forwarding.

=head1 AUTHOR

John Salmon <johns@cacr.caltech.edu>

=cut

use Getopt::Long;

sub help{
    $_ = <<'EOF';
Usage: prsh [options] [processors] -- [remote-commands]
"Parallel" rsh - run a command on a list of remote processors with optional
timeouts, output flushing, status reports, etc.  The environment variable
PRSH_OPTIONS is implicitly passed as an argument list.  Later arguments
override earlier ones.  Quotes inside PRSH_OPTIONS do not work correctly.
 Options:
 --debug
 --rsh-cmd word     e.g., "rsh -n", "ssh -c none -n -a -x", ...
 --ssh           i.e., short for --rsh-cmd 'ssh -n -a -x'
 --prepend        prepend a hostname to every line of output
 --timeout integer (0 means none) 
 --nokill           i.e., don't kill the ones left behind that didn't finish.
 --status        i.e. report on the completion status of commands.
 --shell-type [bash|csh] tell prsh the type of shell on the remote end
 --help          print this message
 [hostnames]        e.g., n001 n002, `cat /var/run/nodes`
                    If none are specified, the environment PRSH_HOSTS is used
 -- remote-commands  e.g., ls -l /scratch/johns/core, hostname, free
EOF
    print $_;
}

sub debug{
    print STDOUT @_ if $debug;
}

# Look for an environment variable PRSH_HOSTS, and initialize the
# list of processors.  So if you're going to be using the same batch
# of nodes for a while, export PRSH_HOSTS=`cat mynodes` might be a
# good idea.  (See man perlfunc for the subtle distinction between 
# split ' ' and split / /).
@list_of_processors = split ' ',$ENV{'PRSH_HOSTS'};

sub more_processors{
    @list_of_processors = () if !$explicit_processor_args;
    $explicit_processor_args = 1;
    push @list_of_processors, @_;
}

# A convenience command...  It's easier to type -ssh than -rsh 'ssh -n -a -x'
# -ssh overrides -rsh, no matter what order they are presented.
sub do_ssh{
    $rsh_cmd = 'ssh -n -a -x';
}

# The only important distinction at the moment is between
# bash-like and csh-like.  So we look for bash in the argument.
# Since ksh has (I think) the same >( ) syntax, we map it to bash as well.
sub do_shell_type{
    (undef,my $arg)=@_;
    debug "arg=$arg\n";
    $shell_type = ($arg =~ /(bash)|(ksh)/) ? 'bash' : 'csh';
    debug "shell_type = $shell_type\n";
}

$ntry = 0;
$debug = 0;
$rsh_cmd = 'rsh -n';
&do_shell_type (undef, $ENV{SHELL});
$do_ssh = 0;
$timeout = 15;
$do_kill = 1;
$do_status = 0;
$add_prepend = 0;

# Stick PRSH_OPTIONS at the front of ARGV.  This doesn't propagate quoted
# strings correctly, i.e., export PRSH_ARGS="-rsh 'ssh -n -a -x'" doesn't
# do what you might hope.  To fix it probably requires recursive invocation
# to give the shell another shot at the arguments.
# Possible uses:  PRSH_ARGS="timeout 0" or "-ssh" or "-debug -ssh", etc.
unshift @ARGV, split ' ',$ENV{'PRSH_OPTIONS'};

&GetOptions("debug" => \$debug, 
	    "rsh-cmd=s" => \$rsh_cmd, 
	    "ssh" => \&do_ssh,
	    "prepend" => \$add_prepend,
	    "nodeid" => \$add_prepend,
	    "timeout=i" => \$timeout,
	    "kill!" => \$do_kill,
	    "status!" => \$do_status,
	    "help" => \&help,
	    "shell-type=s" => \&do_shell_type,
	    "<>" => \&more_processors
	    );
# Set $remote_command to anything following a -- option
$remote_command = join(' ', @ARGV);
debug $remote_command;

# We have to split up rsh_cmd into separate words.  It might be
# easier to just pull off the first word...
@rsh_args = split ' ',$rsh_cmd;
$rsh_prog = shift @rsh_args;

debug "timeout: $timeout\n",
    "rsh_prog: $rsh_prog\n",
    "rsh_args: ", join(' ', @rsh_args), "\n",
    "nodes: ", join(':', @list_of_processors), "\n";

# This allows the -prepend hack to tag both stderr and stdout.
# Alternatively, we could try to use a bash construct like: 2> >( cmd )
# to try to apply a distinct filter to stderr.
$remote_bash = ( $ENV{'SHELL'} =~ /bash/ );

# We're done with argument processing.  Loop over the remote nodes,
# issuing an rsh (via fork/exec) to each one.  Add some output 
# filters to the remote commands if requested.
$prefix="";
$suffix="";
foreach $rhost (@list_of_processors){
    $body = $remote_command;
    if( $add_prepend ){
	# Run two seds on the remote end to filter stdout and stderr.
	if( $shell_type =~ /bash/ ){
	    # The parentheses start another subshell that
	    # protect redirections contained in $remote_command
	    $prefix='(';
	    $suffix=") 2> >(sed s/^/$rhost:\\ / 1>&2) | sed s/^/$rhost:\\ /";
	}else{
	    # If the remote user's login shell is not bash we have
	    # to run two additional shells  on the remote node:
	    # The outer bash allows us to do fancy
	    # filtering of stderr.  The inner $SHELL is the user's
	    # login shell.
	    $prefix=q!/bin/bash -c '$SHELL -c "!;
            # Escape all dollar-signs in the body of the remote command.
            # THIS MAY BE WRONG, but it seems to work.
            $body =~ s/\$/\\\$/;
            $suffix=qq!" 2> >(sed s/^/$rhost\\ / 1>&2) | sed s/^/$rhost\\ /'!;
	}
    }
    $pid=&fork_exec ($rsh_prog, @rsh_args, $rhost, "$prefix $body $suffix");
    $rhosts{$pid} = $rhost;
}

# Now give everything $timeout to complete.  If the $sleep_pid finishes,
# we kill all the remaining processes.  Should we start the clock before
# or after we loop over all the processors?
if( $timeout > 0 ){
    $add_prepend = 0;		# should we save the value??
    $sleep_pid = &fork_exec('sleep', $timeout);
    $min_npids = 1;
}else{
    $min_npids = 0;
}

# Now wait for everything to complete.  If the sleep completes,
# then we kill all the rest.
while( scalar keys(%cmds) > $min_npids ){
    debug 'still waiting for ', join(' ', keys(%cmds)), "\n";
    $pid = wait;
    if( $pid == -1 ){
	print "There are still active pids: ", join(' ', keys(%cmds)), "\n";
	die "wait unexpectedly returned -1\n";
    }
    if( defined $cmds{$pid} ){
	if( $pid != $sleep_pid ){
	    if( $do_status ){
		print "$rhosts{$pid} : $cmds{$pid}", ($? >> 8) ? " FAILED" : " OK", "\n";
	    }else{
		# report failed commands even if status was not requested
		print "$rhosts{$pid} : $cmds{$pid}", " FAILED\n" if ($? >> 8);
	    }
	}
    }else{
	print "wait returned $pid - unexpected!\n";
    }
    delete $cmds{$pid};
    if( $pid == $sleep_pid && $do_kill ){
	print "Time up, terminate with extreme prejudice:\n";
	print 'kill -9 ' , join(' ',  keys(%cmds)), "\n";
	kill 9, keys(%cmds);
	while( ($pid,$cmd) = each %cmds ){
	    # report timeout even if status was not requested.
	    print "$rhosts{$pid} : $cmd", " TIMED OUT\n";
	}
	last;
    }
}
 
# Don't leave the sleep running!  Would it be better to use a non-blocking
# waitpid here?  Don't check for $do_kill - it's bad form to leave
# stray processes lying around, even if the user doesn't
# want his own processes annihilated.
if( $sleep_pid && $cmds{$sleep_pid} ){
    debug "kill -9 $sleep_pid\n";
    delete $cmds{$sleep_pid};
    kill 9, $sleep_pid;
}

sub fork_exec{
    my @cmd = @_;
    # code from 'Programming Perl' p167
  FORK: {
      if( $pid = fork ){
	  # parent code
	  # child pid is in $pid
	  $cmds{ $pid } = "'" . (join "' '", @cmd) . "'";
	  debug "$pid => $cmds{$pid}\n";
	  return $pid;
      }elsif (defined $pid) { # $pid is zero here if defined
	  # child code
	  # parent process pid is available with getppid
	  # is it better to close stdout and stdin or to redirect them
	  # to /dev/null?
	  close(STDIN);
	  open(STDIN, "</dev/null");
	  exec @cmd;  # where should stdout/stderr go?
	  die "Couldn't exec ", join(':', @cmd), "\n";
      }elsif ($! =~ /Try again/ && $ntry < 5) {
	  # EAGAIN, supposedly recoverable fork error
	  # Is this really a good idea?
	  print "fork: ", join(' ', @_), ": EAGAIN... retrying\n";
	  sleep 5;
	  $ntry++;
	  redo FORK;
      }else{
	  # wierd fork error
	  die "Can't fork: $!\n";
      }
  }
}
