#!/usr/bin/perl
# This program is free software, released under the Artistic license.
# Scott Cruzen

# Requires (probably works with older versions of most of these):
# Expect-1.10
# IO-Tty-0.04
# IO-Stty-.02
# TermReadKey-2.14
# Parse-RecDescent-1.94

use strict;
use Expect;
use Getopt::Long;
use Term::ReadKey;
use POSIX qw(strftime);
use Parse::RecDescent;

use Data::Dumper;

eval { require "names.pl"; };

warn $@ if $@;

my $usage = << "END";
mass.pl version 1.07
$0 --script script --machines machine1,...,machineN
--name namedlist --send file --retrieve file --ssh [1 or 2]
--noroot --sshpass --sshphrase --su --sudo --user username --bd --noping
--ssh [1 or 2] --pingonly

general opts:
--script script\t\tspecify the name of the script to run on the targets
--machines machines\toperate on this comma separated list of machines
--name namedlist\tuse the named list of machines from names.pl
--send files\t\tsend this comma separated list of files
--retrieve files\tscp these files back after executing the script

auth opts:
--noroot\t\tdon't try to use su to become root
--sshpass\t\task for password to authenticate to ssh with
--sshphrase\t\task for passphrase to authenticate to ssh with
--su\t\t\tbecome root via su instead of sudo
--sudo\t\t\tbecome root via sudo instead of su
--user username\t\tspecify the user we should scp and ssh as
--bd\t\t\tbackdoor, equal to --noroot --user root --sshpass

misc opts:
--ssh option\t\tspecify ssh options (version etc)
--retonly\t\tonly retrieve files, no script
--pingonly\t\tonly ping hosts
--nocleanup\t\tdon't delete sent files
END

my (@send, @retrieve, @machines, @noclean);
my (@failed, @passed, @fatal);
my ($name, $user, $script, $passwd, $noping, $noroot, $nocleanup, $retonly, $sshopts, $usesu);
my ($sshpass, $bd, $sshphrase, $pingonly, $shbang, $prog);
my $usesudo = 1;
my $retryct = 3;

#######################################################################
# process command line options

my @args = @ARGV;

GetOptions( "script=s" => \$script, "machines=s" => \@machines,
"noroot" => \$noroot, "sudo" => \$usesudo, "su" => \$usesu,
"name=s" => \$name, "sshpass" => \$sshpass, "user=s" => \$user,
"send:s" => \@send, "retrieve:s" => \@retrieve, "bd" => \$bd,
"ssh:s" => \$sshopts, "noping" => \$noping, "sshphrase" => \$sshphrase,
"retonly" => \$retonly, "pingonly" => \$pingonly, "nocleanup" => \$nocleanup );

my $grammar = <<'EOF';
{ no strict "refs"; 
  my @stack;
  sub process {
    my ($A, $B, $op) = @_;
    my $return;
    my (%count, %seen);
    my (@isect, @diff, @union, @aonly);

    foreach my $e (@$A) { $count{$e}++ }
    foreach my $e (@$B) { $count{$e}++; $seen{$e}++ }

    if ($op eq '+') {
      foreach my $e (keys %count) {
        push(@union, $e);
      }
      $return = \@union;
    }
    if ($op eq '-') {
      foreach my $e (@$A) {
        push(@aonly, $e) unless exists $seen{$e};
      }
      $return = \@aonly;
    }
    if ($op eq '%') {
      foreach my $e (keys %count) {
        push @{ $count{$e} == 2 ? \@isect : \@diff }, $e;
      }
      $return = \@diff;
    }
    if ($op eq '*') {
      foreach my $e (keys %count) {
        push @{ $count{$e} == 2 ? \@isect : \@diff }, $e;
      }
      $return = \@isect;
    }
    return $return;
  }
}
startrule: expression /^\Z/ { $return = $item{expression}; }
expression:
  '(' expression ')' exptail {
    $return = $item{expression};
    my $elem;
    while ($elem = pop @stack) {
      $return = process($return,$elem->{a},$elem->{op});
    }
    1;
  } |
  identifier exptail {
    $return = $item{identifier};
    my $elem;
    while ($elem = pop @stack) {
      $return = process($return,$elem->{a},$elem->{op});
    }
    1;
  }
exptail:
  operator '(' expression ')' exptail {
    my $A = $item{expression};
    my $op = $item{operator};

    push @stack, {op => $op, a => $A };
  } |
  operator identifier exptail {
    my $A = $item{identifier};
    my $op = $item{operator};

    push @stack, {op => $op, a => $A };
  } |
  {1}
identifier: idre { 
  my $id = $item{idre};
  $id =~ s/\\-/-/g;
  $id =~ s/'//g;
  my $tmp = '::'.$id;
  if (defined @$tmp) {
    $return = [@$tmp];
  } else {
    $return = [$id];
  }
}
idre: /('[a-z][\w-]*')|([a-z](\w|\\-)*)/i
operator: /[%*+-]/
EOF

if ($name) {
  $::RD_HINT = 1;
  my $p = new Parse::RecDescent($grammar) or die "Compile error\n";
  my $ret = $p->startrule(\$name);
  die "Syntax error in name expression\n" unless defined $ret;
  @machines = sort(@$ret,@machines);
}

die $usage unless (($pingonly || $script || ($retonly && @retrieve)) &&
    @machines);

unless ($user) { $user = $ENV{LOGNAME}; }

push @send, $script;

# check that $script starts with #!
unless ($pingonly or $retonly) {
    open FILE, $script;
    $shbang = <FILE>;
    die "$script doesn't look like a shell script" if ($shbang !~ /^#!/);
    if ($shbang =~ /^#!\s*(\/.*)$/) {
      $prog = $1;
    } else {
      die "failed to extract program name from $shbang\n";
    }

    # scan the script for any '# send:' or '# retrieve:" lines
    while (<FILE>) {
        /^\# send: (.*)/ && do { push @send, $1; };
        /^\# noclean: (.*)/ && do { push @noclean, $1; };
        /^\# retrieve: (.*)/ && do { push @retrieve, $1; };
    }
    close FILE;
}

if ($bd) {
  $noroot = $sshpass = $bd;
  $user = "root";
}

if ($usesu) {
    $usesudo = 0;
}

@send = split(/,/,join(',',@send));
@noclean = split(/,/,join(',',@noclean));
@retrieve = split(/,/,join(',',@retrieve));
@machines = split(/,/,join(',',@machines));

for (@send, @noclean) {
  die "Couldn't find $_\n" unless -f;
}

#######################################################################
# get the root/sudo password
unless ($pingonly) {
  $passwd = getpass($usesudo ? "sudo password: " : "su password: ") unless $noroot;
  $sshpass = getpass("ssh password: ") if $sshpass;
  $sshphrase = getpass("ssh passphrase: ") if $sshphrase;
} else {
  $script = "pingonly";
}

#######################################################################
# iterate over the specified machines

while (@machines && $retryct) {
  @failed = ();

  print "trying to run $script on ",scalar @machines, " machines\n";
  printnice(@machines);
  print "\n";

  for my $host (@machines) {
    print "$host\n\n";

    eval { dostuff($host, $script, $user, \@send, \@noclean, \@retrieve); };

    for ($@) {
      /^warning/i && do {
        print STDERR "\n\n$@\n";
        push @failed, $host;
        last;
      };

      /^fatal/i && do {
        print STDERR "\n\n$@\n";
        push @fatal, $host;
        last;
      };

      push @passed, $host;
    }
  }

  @machines = @failed;

  print scalar @passed, " passed: ";
  printnice(@passed);

  print scalar @failed, " failed: ";
  printnice(@failed);

  if (--$retryct && @failed) {
    print "sleeping for 5 seconds\n";
    sleep(5);
  }
}

# zero the root password in memory (pointless)
$passwd =~ s/./z/g;
$sshpass =~ s/./z/g;
$sshphrase =~ s/./z/g;

print scalar @fatal, " fatal errors: ";
printnice(@fatal);

# Save the report to a file
mkdir("reports", 0755) unless -d "reports";
open FILE, ">>reports/$script";

my $ofh = select(FILE);

print scalar localtime(),"\n";
print "args: ", join(' ', @args), "\n";

print scalar @passed, " passed: ";
printnice(@passed);

print scalar @failed, " failed: ";
printnice(@failed);

print scalar @fatal, " fatal errors: ";
printnice(@fatal);
print "\n";

select($ofh);

#######################################################################
# subroutines

# dostuff:
# ping a machine, if there's a response, scp the script specified on
# the command line to the machine (and any --send files), then ssh in,
# su to root, execute the script, close the ssh connection, then scp any
# files specified in --retrieve back and store them in retrieve/$name
#
# returns undef on success or an error string
sub dostuff {
  my ($name, $script, $user, $send, $noclean, $retrieve) = @_;  
  my $file;

  # ping is suid (usually), so by using system we avoid having
  # to run mass.pl as root
  if (!$noping && system("ping -n -c 1 $name")) {
    die "Warning: $name doesn't respond to ping\n";
  }
    if ($pingonly) {
        return;
    }

    if ($retonly) {
        goto retrieveonly;
    }
#$Expect::Exp_Internal = 1;

  my @t;
  push @t, "scp";
  push @t, "-o $sshopts" if $sshopts;
  push @t, @$noclean, @$send, "$user\@$name:";

  my $scp = Expect->spawn(@t) ||
    die "Warning: scp failed on $name\n";

  $scp->expect(undef,
    [ 'Are you sure you want to continue ',
      sub {
        print $scp "yes\r"; exp_continue;
      },
    ],
    [ 'Enter passphrase ',
      sub {
        $scp->log_group(undef);
        $scp->log_stdout(undef);
        print $scp "$sshphrase\r";
        $scp->expect(0, '');
        $scp->clear_accum();
        $scp->log_stdout(1);
        $scp->log_group(1);
        exp_continue;
      }
    ],
    [ qr/password/i,
      sub {
        $scp->log_group(undef);
        $scp->log_stdout(undef);
        print $scp "$sshpass\r";
        $scp->expect(0, '');
        $scp->clear_accum();
        $scp->log_stdout(1);
        $scp->log_group(1);

        exp_continue;
      }
    ],
    [ 'Permission denied, please try again.',
      sub {
        die "Warning: scp failed on $name\n";
      }
    ],
    [ 'Connection closed by remote host',
      sub {
        die "Warning: scp failed on $name\n";
      }
    ],
    [ 'lost connection',
      sub {
        die "Warning: scp failed on $name\n";
      }
    ]
  );

  $scp->hard_close();

  @t = qw(ssh -x);
  push @t, "-o $sshopts" if $sshopts;
  push @t, "-t", "-l", $user, $name, "sh";
#'PS1=$\ ',

  my $ssh = Expect->spawn(@t) ||
    die "Warning: ssh failed on $name\n";

#$Expect::Exp_Internal = 1;

  $ssh->expect(120,
    [ 'Connection closed by remote host',
      sub {
        die "Warning: ssh failed on $name\n";
      }
    ],
    [ 'lost connection',
      sub {
        die "Warning: ssh failed on $name\n";
      }
    ],
    [ 'Error reading response length from authentication socket.',
      sub {
        die "Warning: ssh failed on $name\n";
      }
    ],
    [ 'Enter passphrase ',
      sub {
        $ssh->log_group(undef);
        $ssh->log_stdout(undef);
        print $ssh "$sshphrase\r";
        $ssh->expect(0, '');
        $ssh->clear_accum();
        $ssh->log_stdout(1);
        $ssh->log_group(1);
        exp_continue;
      }
    ],
    [ qr/password/i,
      sub {
        $ssh->log_group(undef);
        $ssh->log_stdout(undef);
        print $ssh "$sshpass\r";
        $ssh->expect(0, '');
        $ssh->clear_accum();
        $ssh->log_stdout(1);
        $ssh->log_group(1);
        exp_continue;
      }
    ],
    [ '[#$] $',
# at this point we're logged in
      sub {
        print $ssh "PS1='\$ '; PATH=/usr/local/bin:".
          "/bin:/usr/bin:/usr/sbin:/usr/local/sbin:".
          "/sbin ;export PS1;export PATH\r";
        beroot($ssh, $name) unless $noroot;

#"chmod a+x $script ;".
        my $args = join ' ', @ARGV;
        print $ssh "$prog $script $args && ".
          "echo script\\ done || ".
          "echo script\\ failed\r";

        $ssh->clear_accum();
      }
    ],
    [ 'timeout',
      sub {
        $ssh->hard_close();
        die "Warning: No shell prompt on $name\n";
      }
    ]
  );

    my $err;

  $ssh->expect(undef,
    [ 'script done' ],
    [ 'script failed',
      sub {
                print "failed!\n";
                $err = "Fatal: Script $script failed on $name\n";
      }
    ]
  );

# cleanup
    unless ($nocleanup) {
        my @rm = @$send;
        s/.*\/// for @rm;
        print $ssh "/bin/rm -f @rm && echo removed\\ @rm\r";

        $ssh->expect(undef,
            [ "removed @rm" ]
        );
    }

  $ssh->hard_close();

    die $err if $err;

  print "\n\n";

retrieveonly:  
  if (@$retrieve) {
    mkdir("retrieve", 0755) unless -d "retrieve";
    mkdir("retrieve/$name", 0755) unless -d "retrieve/$name";

        my @t;
        push @t, "scp";
        push @t, "-o $sshopts" if $sshopts;
        push @t, "$user\@$name:@$retrieve";
        push @t, "retrieve/$name";

#print Dumper @t;

        my $scp = Expect->spawn(@t) ||
            die "Warning: scp failed on $name\n";

        $scp->expect(undef,
            [ 'Are you sure you want to continue ',
                sub {
                    print $scp "yes\r"; exp_continue;
                },
            ],
            [ 'Enter passphrase ',
                sub {
                    $scp->log_group(undef);
                    $scp->log_stdout(undef);
                    print $scp "$sshphrase\r";
                    $scp->expect(0, '');
                    $scp->clear_accum();
                    $scp->log_stdout(1);
                    $scp->log_group(1);
                    exp_continue;
                }
            ],
            [ qr/password/i,
                sub {
                    $scp->log_group(undef);
                    $scp->log_stdout(undef);
                    print $scp "$sshpass\r";
                    $scp->expect(0, '');
                    $scp->clear_accum();
                    $scp->log_stdout(1);
                    $scp->log_group(1);

                    exp_continue;
                }
            ],
            [ 'Permission denied, please try again.',
              sub {
                die "Warning: scp failed on $name\n";
              }
            ],
            [ 'Connection closed by remote host',
                sub {
                    die "Warning: scp failed on $name\n";
                }
            ],
            [ 'lost connection',
                sub {
                    die "Warning: scp failed on $name\n";
                }
            ]
        );

        $scp->hard_close();
  }
}

sub beroot {
  my ($ssh, $name) = @_;

#$Expect::Exp_Internal = 1;

  $ssh->clear_accum();

  if ($usesudo) {
    print $ssh "sudo -K ; sudo sh\r";
  } else {
    print $ssh "su root -c sh\r";
  }

  # 250 ms sleep
  select(undef,undef,undef,0.25);

  $ssh->expect(undef,
    [ 'assword',
      sub {
        print "sending sudo password\n";
        print $ssh "$passwd\r";
      }
    ],
    [ '[$#] $',
      sub {
        print $ssh "\r";
      }
    ]
  );

  $ssh->expect(undef,
    [ 'not found',
      sub {
        $ssh->hard_close();
        die("Fatal: ".($usesudo ? "sudo" : "su").
          " not found on $name\n");
      }
    ],
    [ 'timeout',
      sub {
        $ssh->hard_close();
        die "Fatal: No root prompt on $name\n";
      }
    ],
    [ 'Sorry|incorrect password|Password:',
      sub {
        $ssh->hard_close();
        die "Fatal: No root prompt on $name (bad password)\n";
      }
    ],
    [ '[$#] $',
      sub {
        print $ssh "PATH=/usr/local/bin:/bin".
        ":/usr/bin:/usr/sbin:/sbin:/usr/local/sbin ; ".
        "export PATH\r".
        "if [ `id|cut -d ' ' -f 1` = 'uid=0(root)' ];".
        " then PS1='# '; fi\r";
      }
    ]
  );
#$Expect::Exp_Internal = 0;
}

# use format to wrap text
# takes an array as input and prints it comma separated
# for example: n123, n456, n789
sub printnice {
  my $list;

format Something =
^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
$list
.

  # format line break characters
  local $: = ',';
  # input record separator
  local $/ = '';
  # format name
  local $~ = 'Something';

  $list = join(',',sort(@_));
  if ($list) {
    write;
  } else {
    print "\n";
  }
}

sub getpass {
  my ($prompt) = @_;

  print STDERR $prompt;

  ReadMode 2; # Turn off echo

  my $pass = <STDIN>;
  chomp $pass;

  ReadMode 0; # Reset tty mode before exiting

  print STDERR "\n";

  return $pass;
}

# $Id: mass.pl,v 3.21 2006/08/16 05:39:03 sic Exp $
# vim:sw=2:ts=2:softtabstop=2:expandtab