#!/usr/bin/perl -w
# See copyright, etc in below POD section.
######################################################################

require 5.005;
use IO::File;
use IO::Pipe;
use Pod::Usage;
use Getopt::Long;
use POSIX ":sys_wait_h";
use Term::ReadLine;

use Schedule::Load::Hosts;
use strict;
use vars qw ($Debug %Pids $Child $Opt_Parallel $Opt_Prefix %Host_Lists);

######################################################################

$SIG{INT}  = \&sig_quit;
$SIG{HUP}  = \&sig_term;
$SIG{ABRT} = \&sig_term;
$SIG{TERM} = \&sig_term;

autoflush STDOUT 1;
autoflush STDERR 1;

######################################################################

my @params = ();
my @hosts = ();
$Opt_Prefix = 1;
my $Opt_Summary;

Getopt::Long::config ("pass_through", "no_auto_abbrev");
if (!GetOptions (
		 "help"		=> \&usage,
		 "parallel!"	=> \$Opt_Parallel,
		 "prefix!"	=> \$Opt_Prefix,
		 "summary!"	=> \$Opt_Summary,
		 "hosts=s"	=> sub {shift; push @hosts, shift;},
		 "debug!"	=> \$Debug,
		 "<>"		=> \&parameter,
		 )) {
    die "%Error: Bad usage, try 'slrsh --help'\n";
}

push @params, @ARGV;

# Choose hosts to execute on
gather_host_lists();  # -> %Host_Lists
if ($#hosts<0) {
    @hosts = set_hosts('ALL') if $#hosts<0;
} else {
    @hosts = set_hosts(@hosts);
}

my $param = join(' ',@params);
if ($param) {
    print "Hosts: @hosts\n";
    cmd($param, @hosts);
} else {
    cmdloop(@hosts);
}

######################################################################

sub parameter {
    my $param = shift;
    push @params, $param;
}

sub usage {
    print "Version: $Schedule::Load::VERSION\n";
    pod2usage(-verbose=>2, -exitval => 2);
    exit(1);
}

######################################################################

sub gather_host_lists {
    my @params = @_;
    # Form %Host_List with each class specified.
    my $hosts = Schedule::Load::Hosts->fetch(@params);

    my @classes = (sort ($hosts->classes()));
    foreach my $host ($hosts->hosts_sorted) {
	push @{$Host_Lists{ALL}}, $host->hostname;
	push @{$Host_Lists{uc $host->archname}}, $host->hostname;
	push @{$Host_Lists{uc $host->osvers}}, $host->hostname;
	foreach my $class (@classes) {
	    if ($host->exists($class) && $host->get($class)) {
		push @{$Host_Lists{uc $class}}, $host->hostname;
	    }
	}
    }
}

sub set_hosts {
    my @in = shift;
    # Set the list of hosts to specified list, expanding any lists
    my @out;
    foreach my $instr (@in) {
	foreach my $inhost (split /[ \t:,]+/, "$instr:") {
	    my $negate = 1 if $inhost =~ s/^-//;
	    if ($inhost =~ /^[ \t:,]*$/) {
	    } else {
		my @requested;
		if (defined $Host_Lists{$inhost}) {
		    push @requested, @{$Host_Lists{$inhost}};
		} else {
		    push @requested, $inhost;
		}
		if ($negate) {
		    @out = stripList(\@out, \@requested);
		} else {
		    push @out, @requested;
		}
	    }
	}
    }
    return @out;
}

sub stripList {
    my $inref = shift;
    my $deleteref = shift;
    my @out = @{$inref};
    foreach my $del (@{$deleteref}) {
	my @rm;
	foreach my $par (@out) {
	    push @rm, $par unless $par eq $del;
	}
	@out = @rm;
    }
    return @out;
}


######################################################################

sub cmdloop {
    # Poll for commands and execute
    my @hosts = @_;
    my $Term = new Term::ReadLine 'slrsh';
    print "Hosts: @hosts\n";

    print "Use 'hosts' to change host list, 'x' to exit.\n";
    while (1) {
	my $line = $Term->readline("slrsh> ");
	last if !defined $line;
	if ($line =~ /^\s*$/) {
	} elsif ($line =~ /^\s*hosts\s+(\S.*)$/) {
	    $Host_Lists{HOSTS} = \@hosts;
	    $line = $1;
	    $line =~ s/^\s+//;
	    $line =~ s/\s+$//;
	    if ($line ne "") { # !NOP
		@hosts = set_hosts($line);
	    }
	    print "Current Hosts: @hosts\n";
	} elsif ($line =~ /^\s*hosts\s*$/) {
	    $Host_Lists{HOSTS} = \@hosts;
	    for my $lname (sort (keys %Host_Lists)) {
		my @lhosts = @{$Host_Lists{$lname}};
		print "  Use '$lname' => @lhosts\n";
	    }
	    print "Current Hosts: @hosts\n";
	    my $line = $Term->readline("what_hosts? ");
	    $line =~ s/^\s+//;
	    $line =~ s/\s+$//;
	    if ($line ne "") { # !NOP
		@hosts = set_hosts($line);
	    }
	    print "Current Hosts: @hosts\n";
	} elsif ($line =~ /^\s*(quit|exit|q|x)\s*$/) {
	    last;
	} else {
	    cmd($line, @hosts);
	}
    }

    print "\n";
}

sub form_cmds {
    my $usrcmd = shift;
    my @hosts = @_;
    # Pass command and list of hosts, return list of all commands to execute
    my @cmds = ();
    # Execute command on each host in list.
    foreach my $host (@hosts) {
	my @eachhosts = ($host);
	@eachhosts = @hosts if $usrcmd =~ /\@HOSTS(?![a-z0-9A-Z_])/;
	foreach my $subhost (@eachhosts) {
	    my $hcmd = $usrcmd;
	    $hcmd =~ s/\@HOSTS?(?![a-z0-9A-Z_])/$subhost/mg;
	    push @cmds, {host=>$host, cmd=>$hcmd};
	}
    }
    return @cmds;
}

sub cmd {
    my $usrcmd = shift;
    my @hosts = @_;
    # Execute command on each host in list.
    if ($Opt_Parallel) {
	backgnd_cmd ($usrcmd, @hosts);
	return;
    }

    my @cmds = form_cmds($usrcmd,@hosts);
    foreach my $cmdref (@cmds) {
	print "\n",$cmdref->{host},": ",$cmdref->{cmd},"\n";
	system ("ssh",$cmdref->{host},$cmdref->{cmd});
    }
}

######################################################################

sub sig_quit {
    # Ctrl-C, kill all processes we spawned
    exit(1) if $Child;
    warn "Ctrl-C: Slrsh ignoring Ctrl-C, use 'x' to exit.\n";
}

sub sig_term {
    exit(1) if $Child;
    die "Quitting...\n";
}

sub backgnd_cmd {
    my $usrcmd = shift;
    my @hosts = @_;

    # Prevent DISPLAY use via ssh
    delete $ENV{DISPLAY};

    # Execute command on each host in list.
    my @cmds = form_cmds($usrcmd,@hosts);
    foreach my $cmdref (@cmds) {
	my $fh = new IO::Handle;
	my $pid = open(*{$fh}, "-|");
	die "Can't fork: $!" unless defined $pid;
	$cmdref->{pid} = $pid;
	$cmdref->{pipe} = $fh;
	print "FORK $pid ",$cmdref->{pipe}," at ",$cmdref->{host},"\n" if $Debug;
	if ($pid) { # Parent
	}
	else { # Child
	    $Child = 1;
	    exec 'ssh', $cmdref->{host}, $cmdref->{cmd};
	    die "Can't exec ssh";
	}
    }

    # Grab output from each host
    my %hostOutput;
    while ($#cmds >= 0) {
	my $cnum = 0;
	foreach my $cmdref (@cmds) {
	    my $pipe = $cmdref->{pipe};
	    my $host = $cmdref->{host};
	    $hostOutput{$host} ||= [];
	    while (defined(my $line = $pipe->getline())) {
		print "$cmdref->{host}: " if ($Opt_Prefix);
		print "$line";
		push @{$hostOutput{$host}}, $line;
	    }
	    if ($pipe->eof) {
		splice @cmds, $cnum, 1;
	    }
	    $cnum++;
	}
    }

    if ($Opt_Summary) {
	# Invert output
	my %outputByHost;
	foreach my $host (keys %hostOutput) {
	    $outputByHost{join('',@{$hostOutput{$host}})}{$host} = 1;
	}
	print "\n=== Output summary:\n";
	foreach my $output (sort (keys %outputByHost)) {
	    foreach my $host (sort (keys %{$outputByHost{$output}})) {
		print " $host";
	    }
	    print ":\n";
	    print $output;
	}
    }
}

######################################################################
######################################################################
__END__

=pod

=head1 NAME

slrsh - Perform rsh command on all clump systems

=head1 SYNOPSIS

B<slrsh>  I<command>

B<slrsh>
    I<command>
    I<command>
    ...
    quit

=head1 DESCRIPTION

slrsh executes the arguments as a shell command like rsh does.  However the
command is executed on every host registered with rschedule.  This is
useful for system management functions.

Without a argument, slrsh will prompt for commands and execute them.

In any commands, @HOST is replaced with the name of the local host
(ala `hostname`), and @HOSTS causes the command to be replicated for
each host.  Thus this command on a 2 machine clump:

    slrsh mount /net/@HOSTS

will execute 4 commands:
    ssh host1 mount /net/host1
    ssh host1 mount /net/host2
    ssh host2 mount /net/host1
    ssh host2 mount /net/host2

=head1 ARGUMENTS

=over 4

=item --help

Displays this message and program version and exits.

=item --hosts

Add a host to the list of hosts to be executed on, or add a list of colon
separated hostnames or class aliases.  If not specified, the default is all
hosts.

=item --noprefix

Disable the default printing of the hostname in front of all --parallel
output.

=item --parallel

Run each command on all machines in parallel.  The command cannot
require any input.  The name of the machine will be prefixed to all
output unless --noprefix is used.

=item --summary

With --parallel, summarize the output, showing hosts with identical outputs
together.  This is useful for then creating a new list of hosts from those
hosts which had a specific output.

=back

=head1 COMMANDS

=over 4

=item exit (or x)

Exit slrsh.  Control-C will not exit this program, as hitting Ctrl-C is
more commonly used to interrupt commands on the remote machines.

=item hosts

Specify the list of hosts to run the following commands on.  If nothing is
specified on the command line, print a list of all class aliases, and
prompt for the list of hosts.  Hosts may be separated by spaces, commas, or
colons.  Hosts may also be a scheduler class, which adds all hosts in that
class.  Hosts may also include a leading - (minus) to remove the specified
host.  Thus "hosts CLASS_COUNTRIES -turkey washington" would return all
hosts that are of scheduler class "COUNTRIES", excluding the host "turkey,"
and adding the host "washington".

=item quit (or q)

Same as exit.

=back

=head1 SETUP

Here's an example of setting up ssh keys so root can get between systems.
This example will differ for your site.

  ssh-keygen -t dsa
  mv .ssh/authorization_keys2 .ssh/authorized_keys2

  slrsh su root
  ssh -l root jamaica
  rm -rf /root/.ssh
  ln -s \$(DIRPROJECT_PREFIX)/root/.ssh /root/.ssh

=head1 DISTRIBUTION

The latest version is available from CPAN and from L<http://www.veripool.org/>.

Copyright 1998-2009 by Wilson Snyder.  This package is free software; you
can redistribute it and/or modify it under the terms of either the GNU
Lesser General Public License Version 3 or the Perl Artistic License Version 2.0.

=head1 SEE ALSO

L<Schedule::Load>, L<rhosts>

=head1 AUTHORS

Wilson Snyder <wsnyder@wsnyder.org>

=cut
######################################################################