#/usr/local/bin/perl
#Path: tut.cis.ohio-state.edu!pacific.mps.ohio-state.edu!zaphod.mps.ohio-state.edu!mips!apple!oliveb!orc!mipos3!iwarp.intel.com!news
#From: merlyn@iwarp.intel.com (Randal Schwartz)
#Newsgroups: comp.lang.perl,alt.sources
#Subject: multiple host command launcher (gsh) in Perl
#Message-ID: <1990Mar7.190633.3801@iwarp.intel.com>
#Date: 7 Mar 90 19:06:33 GMT
#Sender: news@iwarp.intel.com
#Reply-To: merlyn@iwarp.intel.com (Randal Schwartz)
#Organization: Stonehenge; netaccess via Intel, Beaverton, Oregon, USA
#Lines: 279
#Xref: tut.cis.ohio-state.edu comp.lang.perl:607 alt.sources:1534
#
#Here's the 'gsh' I've been using for a while (industrial strength by
#now).  The coding style is not pretty, but it has been roadtested.
#
#Yes, this stuff was inspired by the 'gsh' in the Perl distribution,
#although I've taken it about three steps further.  Mine has parallel
#launching and waiting, a built-in (but overridable/extensible)
#hostlist, and a timeout for those rsh's that launch but "never" come
#back.  You'll want to edit the builtin hostlist, unless you just
#*happen* to have a bunch of systems named 'iwarpa', 'iwarpb', etc.
#etc. :-)
#
#Enjoy.
#
#================================================== snip here
## Copyright (C) 1989, 1990, by Randal L. Schwartz.  All Rights Reserved.
## usage: gsh [options] hostspec [command [arg]...]
## Runs command and args on hosts according to hostspec.  Results are
## sent to STDOUT, with hostname prefix.  A missing command means to just
## echo the computed hostnames on STDOUT. 'hostspec' is one of:
##   hostname, hostattribute, hostspec+hostspec, hostspec-hostspec
## Default hostlist is defined in @HOSTLIST later on.
##
## options:
## -d: don't run any commands on other hosts... but fork anyway.
## -h hostlist: extend the hostlist with the contents of the named file.
## -H hostlist: replace the hostlist with the contents of the named file.
## -i: give STDIN to the processes as STDIN
## -o place: send the outputs to "place$host" instead of STDOUT
## -n procs: run this many processes at a time (default 5).
##           (remember that each rsh is two processes on this host!)
## -v: be noisy about starting and finishing processes.
## -z sec: zap processes after sec seconds (default 300).

## requires 3.0 beta or better
@HOSTLIST = split(/\n/, <<'ENDHOSTLIST');  # comments allowed in here...
decster=decster.uta.edu
ENDHOSTLIST

$| = 1; # don't buffer STDOUT

$the_task_filename = "/tmp/$$.thetask";

$tasks = 0;
$taskmax = 5;
$zapsecs = 300;

sub start {
	local($host) = @_;

	print "starting '$host'...\n" if $verbose;
	
	while ($tasks > 0 && $tasks >= $taskmax) {
		&finish();
	};
	unless ($pid = fork) {	# child
		open(STDIN, "<$the_task_filename") ||
			die "Cannot open $the_task_filename as STDIN ($!)";
		open(STDOUT, ">$place$host") ||
			die "Cannot open $place$host ($!)";
		open(STDERR, ">&STDOUT");
		exec 'cat' if $debug;
		$parent = $$;
		if (fork) { # still the child
			exec 'rsh', $host, '/bin/sh';
			die "Cannot exec rsh ($!)";
		}
		# child child
		$zaptime = time + $zapsecs;
		while (time < $zaptime) {
			sleep 5;
			exit 0 if getppid == 1;
		}
		kill 9, $parent;
		print "\nTIMED OUT AFTER $zapsecs SECONDS\n";
		exit 0;
	}
	$tasklist{$pid} = $host;
	$tasks++;
}

sub finish {
	return unless $tasks > 0;
	print "waiting on '", join(" ", sort values(tasklist)), "'...\n"
		if $verbose;
	do {
		die "Nothing to wait for??? ($!)" unless ($pid = wait) > 0;
	} until $tasklist{$pid};
	print "finished task on '", delete $tasklist{$pid}, "'.\n"
		if $verbose;
	$tasks--;
}

sub finishall {
	while ($tasks > 0) {
		&finish();
	}
}

sub gethostlist {
	local($f,$replace) = @_;
	open(GETHOSTLIST, "<$f") || die "Cannot open '$f' ($!)";
	@HOSTLIST = () if $replace;
	unshift(@HOSTLIST, <GETHOSTLIST>); # put it at the beginning
	close(GETHOSTLIST);
}

# end initialization... begin code...

while ($ARGV[0] =~ /^-/) {
	$_ = shift;
	$debug++, $verbose++, next if /^-d/;
	$verbose++, next if /^-v/;
	$taskmax = $1, next if /^-n(.+)/;
	$taskmax = shift, next if /^-n/;
	&gethostlist($1, 1), next if /^-H(.+)/;
	&gethostlist(shift, 1), next if /^-H/;
	&gethostlist($1), next if /^-h(.+)/;
	&gethostlist(shift), next if /^-h/;
	$do_stdin++, next if /^-i/;
	$place = $1, next if /^-o(.+)/;
	$place = shift, next if /^-o/;
	$zapsecs = $1, next if /^-z(.+)/;
	$zapsecs = shift, next if /^-z/;
	die "unknown flag $_";
}

$place = "/tmp/$$.", $do_stdout++ unless $place;

unshift(@HOSTLIST,"TARGET=" . shift);

$the_task .= join(" ", @ARGV);
if ($do_stdin) {
	$_ = join("",<STDIN>);
	chop if /\n$/;
	$the_task = "($the_task ;) <<'FoObAr'\n$_\nFoObAr\n";
	# if I got tricky, I could skip the extra shell, but, hey... it works
}

@TARGETS = ();

$attr{'TARGET'} = 1;	# this is what I want.

for $_ (@HOSTLIST) {
	s/\s*\n?$//;	# toss trailing white
	s/^\s*//;	# toss leading white
	next if /^(#.*)?$/; # skip comment lines and blank lines
	if (/^([^-+=]+)=(.*)/) {
		($name,$repl) = ($1,"+$2");
		next unless $yes = $attr{$name}; # +1 if wanted, -1 if not
		while ($repl =~ s/^([+-])([^-+]+)//) {
			next if $attr{$2};
			$attr{$2} = ($1 eq '-') ? - $yes : $yes;
			print "assigning $attr{$2} to $2\n" if $debug;
		}
	} else {	# must be a terminal node:
		@attr = split;
		$host = $attr[0];
		$wanted = 0;
		for $attr (@attr) {
			$wanted++, next if $attr{$attr} > 0;
			$wanted=-1, last if $attr{$attr} < 0;
		}
		push(TARGETS, $host) if $wanted > 0;
	}
}

if ($the_task =~ /^\s*$/) { # no command?  just list the hosts
	print join("\n", @TARGETS), "\n";
	exit 0;
}

open(THE_TASK, ">$the_task_filename") || die "Cannot open THE_TASK ($!)";
print THE_TASK $the_task;
close(THE_TASK);

for $host (@TARGETS) {	# launch'em all, $taskmax at a time
	&start($host);
}

&finishall();		# and hang out while the last $taskmax finish

unlink $the_task_filename; # no need for this anymore

exit 0 unless $do_stdout;

for $host (@TARGETS) {	# show what they said
	open(F,"<$place$host") || die "missing output for $host ($!)";
	if ($_ = join("$host:\t", <F>)) {
		print "$host:\t$_";
		print "\n" unless /\n$/;
	}
	close(F);
	unlink "$place$host";
}
exit 0;