mass.pl

#!/usr/bin/perl
# This program is free software, released under the Artistic license.
# Scott Cruzen <sic@lerp.com>

# 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 Text::ParseWords qw(shellwords);

use Data::Dumper;

$| = 1;

push @INC, ".";
push @INC, "/usr/local/etc";

eval { require "names.pl"; };

warn $@ if $@;

my $usage = << "END";
mass.pl version 1.14
$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
--numchild n\t\tnumber of processes to fork, default min of 10 or number of targets
--verbose\t\tshow slightly more output
--debug\t\t\tshow more debugging output

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
--dry\t\t\tlike --pingonly --noping
--groups\t\tonly display host groups
--export\t\tlike dry but output export statement for bash, to be used via eval
--help\t\t\tthis.
END

my (@send, @retrieve, @machines, @noclean);
my (@failed, @passed, @fatal);
my ($name, $user, $script, $passwd, $noping, $noroot, $nocleanup, $retonly);
my ($sshopts, $usesu, $dry, $groups, $export, $domain);
my ($sshpass, $bd, $sshphrase, $pingonly, $shbang, $prog);
my ($retrievedir, $reportsdir, $do, $verbose, $debug, $help);
my $usesudo = 1;
my $retryct = 3;
my $numchild = 10;

#######################################################################
# 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,
"dry" => \$dry, "groups" => \$groups, "export" => \$export,
"domain=s" => \$domain, "numchild:s" => \$numchild, "do" => \$do,
"verbose+" => \$verbose, "debug" => \$debug, "help" => \$help,
"retryct=s" => \$retryct );

my @scriptargs = @ARGV;

if ($ENV{MASS_HOME} && -d $ENV{MASS_HOME}) {
  $reportsdir = "$ENV{MASS_HOME}/reports";
  $retrievedir = "$ENV{MASS_HOME}/retrieve";
} else {
  $reportsdir = "reports";
  $retrievedir = "retrieve";
}


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 '+' || $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;
  if ($id =~ s/^@//) {
    $return = [$id];
  } else {
    my $tmp = $Names::names{$id};
    if (@$tmp) {
    $return = [@$tmp];
  } else {
    $return = [$id];
  }
}
}
idre: /('\@?[a-z][\w-\.]*')|(\@?[a-z](\.|\w|-)*)/i
operator: /[,%*+\/]/
EOF

if ($dry or $export) {
  $pingonly = 1;
  $noping = 1;
}

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

sub parsefile {
    my ($script) = @_;
    local *FILE;
    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>) {
        /^\# name:\s+(.*)/ && do { die "multiple name expressions!" if $name; $name = $1; };
        /^\# send:\s+(.*)/ && do { push @send, shellwords($1); };
        /^\# noclean:\s+(.*)/ && do { push @noclean, shellwords($1); };
        /^\# retrieve:\s+(.*)/ && do { push @retrieve, shellwords($1); };
        /^\# include:\s+(.*)/ && do {
          my ($include) = shellwords($1);
          push @send, $include;
          parsefile($include);
        };
    }
}

# check that $script starts with #!
unless ($pingonly or $retonly or $do) {
  parsefile($script);
}

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);
}

if ($groups) {
  for (sort(keys %Names::names)) {
    chomp();
    print "$_, " if $_ and scalar($Names::names{$_}) > 0;
  }
  print "\n";
  exit();
}

die $usage unless @machines;

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

push @send, $script unless $do;

#$script =~ s/.*\///;

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

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

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

@machines = map { "$_.$domain" } @machines if $domain;

sub unesc {
  return [shellwords($_)]->[0];
}

my %fixmodes = ();

for (@send, @noclean) {
  my $fn = unesc($_);
  die "Couldn't find $fn\n" unless -f $fn;
  my (undef,undef,$mode) = stat $fn;
  chmod 0644, $fn;
  #print "chmod 0644, $fn\n";
  $fixmodes{$fn} = $mode & 07777;
}

#######################################################################
# 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;
} elsif ($dry) {
  $script = "dry";
} else {
  $script = "pingonly";
}

if ($export) {
  print "declare -a masstargets; masstargets=(".(join ' ',@machines).")\n";
  exit 0;
}

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

if (scalar @machines < $numchild) {
  $numchild = scalar @machines;
}

####
# Setup auto-reaping of dead children

my $waitedpid;

sub REAPER {
  $waitedpid = wait;
#  print STDERR "reaped $waitedpid\n";
}

####
# Make child processes

my %pipes;

use POSIX;

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

if ($dry) {
    exit 0;
}

for (my $childid = 0; $childid < $numchild; $childid++) {
#  print STDERR "forking: $childid $numchild\n";
  my ($outrd, $outwr, $inrd, $inwr, $ctlrd, $ctlwr);

  # out is for child stdout and stderr, it's unfiltered lines of text from the child script
  pipe $outrd, $outwr;

  # in is for parent -> child control, to send each host to the child process
  pipe $inrd, $inwr;

  # ctl is for child -> parent status reporting
  pipe $ctlrd, $ctlwr;

  my $pid = fork;

  if (!defined $pid) {
    die "can't fork: $!\n";
  } elsif ($pid) {
    # parent
    close $inrd;
    close $outwr;
    close $ctlwr;

    $pipes{$pid} = { outrd => $outrd, inwr => $inwr, ctlrd => $ctlrd };
  } else {
    for (keys(%pipes)) {
      close $pipes{$_}{outrd};
      close $pipes{$_}{inwr};
      close $pipes{$_}{ctlrd};
    }

    close $outrd;
    close $inwr;
    close $ctlrd;

    dup2(fileno $outwr, 1); # stdout
    dup2(fileno $outwr, 2); # stderr

    my ($buf, $len);

    while (($len = sysread($inrd, $buf, 4096)) > 0) {
      for my $line (split /\n/, $buf) {
        my $host;
        for ($line) {
          /host: (.*)$/ &&  do {
            $host = $1;
            syswrite $ctlwr, process($host);
          };
        }
      }
    }
    sleep 1;
    exit;
  }
}

$SIG{CHLD} = \&REAPER;

my %inprogress = map { +"$_" => { attempts => 0 } } @machines;

sub done {
  my ($targets) = @_;
  my @machines = keys %$targets;
  grep { ! ($targets->{$_}{done} || $targets->{$_}{fatal} || ($targets->{$_}{attempts} >= $retryct)) } @machines;
}

sub nexttarget {
  my ($targets, $pid) = @_;
  for (keys(%$targets)) {
    my $p = $targets->{$_};
    if (!$p->{pid} && !$p->{fatal} && !$p->{done} && $p->{attempts} < $retryct) {
      $p->{pid} = $pid;
      $p->{attempts}++;
      print STDERR "next host: $_\n" if ($verbose > 1);
      return $_;
    }
  }
  return undef;
}

sub updateresult {
  my ($targets, $pid, $result) = @_;
  for my $host (keys(%$targets)) {
    my $p = $targets->{$host};
    if ($p->{pid} == $pid) {
      delete $p->{pid};
      for ($result) {
        /^warning:/i && do {
          $p->{warning} = $result;
          return $host;
        };
        /^fatal:/i && do {
          $p->{fatal} = $result;
          return $host;
        };
        $p->{done} = $result;
        return $host;
      }
    }
  }
  undef;
}

sub cleanout {
  my ($host, $buf) = @_;
  my $capture;
  for (split /\n/, $buf) {
    /^script done/ && do { $capture = 0; };
    print "$host: $_\n" if $capture or ($verbose > 2);
    /echo script\\ done/  && do { $capture = 1; };
  }
}

####
# Select on the child process' pipes

my ($rin, $rout, $win, $wout);

for (keys(%pipes)) {
  vec($rin, fileno($pipes{$_}{outrd}), 1) = 1;
  vec($rin, fileno($pipes{$_}{ctlrd}), 1) = 1;

  vec($win, fileno($pipes{$_}{inwr}), 1) = 1;
}

my %output = ();
my $nready;

my @remaining = done(\%inprogress);
my $count = scalar @remaining;

while (scalar (@remaining = done(\%inprogress)) > 0) {
  if ($verbose > 1 && scalar @remaining != $count) {
    my $left;
    if ($count < 5) {
      $left = join ',', @remaining;
    }
    print STDERR "remaining: $count $left\n";
    $count = scalar @remaining;
  }

  $nready = select($rout=$rin, $wout=$win, undef, 1);
  #print STDERR "select: $nready\n";
  next if $nready <= 0;

  LUP: for my $pid (keys(%pipes)) {
    if (vec($wout, fileno($pipes{$pid}{inwr}), 1) == 1) {
#      print STDERR "writable\n";

      if (!$pipes{$pid}{host}) {
        vec($win, fileno($pipes{$pid}{inwr}), 1) = 0;

        my $host = nexttarget(\%inprogress, $pid);
        my $fh = $pipes{$pid}{inwr};
        if (!$host) {
          #print STDERR "close $pid fh\n";
          close($fh);
        } else {
          $pipes{$pid}{host} = $host;
          syswrite($fh, "host: $host\n");
        }
      }
    }

    my $host = $pipes{$pid}{host};

    if (vec($rout, fileno($pipes{$pid}{ctlrd}), 1)) {
      my $fh = $pipes{$pid}{ctlrd};
      my ($buf, $len);

      if (($len = sysread($fh, $buf, 4096)) == 0) {
        #print STDERR "parent failed to read from ctrl pipe for $pid\n";
        #print STDERR Dumper $pipes{$pid};
        vec($rin, fileno($pipes{$pid}{ctlrd}), 1) = 0;
      } else {
        #print STDERR "result: $buf\n";
        my $finished = updateresult(\%inprogress, $pid, $buf);
#        print "finished: $finished\n";
        if (exists $output{$pid} && exists $output{$pid}{$host}) {
          cleanout($host, join '', @{$output{$pid}{$host}});
        }

        # clear host, so that this child can work on the next target
        delete $pipes{$pid}{host};

        # add the input write pipe back to the watched write fds
        vec($win, fileno($pipes{$pid}{inwr}), 1) = 1;
      }
    }

    if (vec($rout, fileno($pipes{$pid}{outrd}), 1)) {
      my $fh = $pipes{$pid}{outrd};
      my ($buf, $len);

      if (($len = sysread($fh, $buf, 4096)) == 0) {
        vec($rin, fileno($pipes{$pid}{outrd}), 1) = 0;
      } else {
        print "output: $buf\n" if $debug;
        push @{$output{$pid}{$host}}, $buf;
      }
    }
  }
}

#print STDERR "select done: $nready\n";

my %byhost;

for my $pid (keys(%output)) {
  for my $host (keys(%{$output{$pid}})) {
    my $buf = join '', @{$output{$pid}{$host}};
    $byhost{$host} = $buf;
  }
}

#for my $host (sort(keys(%byhost))) {
#    my $buf = $byhost{$host};
##    print map { "$host: $_\n" } split /\n/, $buf;
##    print "$host:\n$buf\n\n";
##    print map { "$host: $_\n" }
#    cleanout($host, $buf);
#}

sub process {
  my ($host) = @_;
#  print "host: $host\n";
  my $ret = eval { dostuff($host, $script, \@scriptargs, $user, [@send], [@noclean], [@retrieve]); };
  $@ ? $@ : $ret;
}

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

for (keys(%inprogress)) {
  if ($inprogress{$_}{warning}) {
    push @failed, $_;
  }
  if ($inprogress{$_}{fatal}) {
    push @fatal, $_;
  }
  if ($inprogress{$_}{done}) {
    push @passed, $_;
  }
}

print scalar @passed, " passed ";
# really don't like this message with large numbers of hosts
if ($verbose > 1) {
  printnice(@passed)
} else {
  print "\n";
}

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

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

# Save the report to a file
mkdir("$reportsdir", 0755) unless -d "$reportsdir";
open FILE, ">>$reportsdir/$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);

for my $fn (keys(%fixmodes)) {
  chmod $fixmodes{$fn}, $fn;
  #printf "chmod %o, %s\n", $fixmodes{$fn}, $fn;
}

exit (@failed + @fatal);

#######################################################################
# 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, $args, $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 -W 1 $name >&2")) {
    die "Warning: $name doesn't respond to ping\n";
  }

  if ($pingonly) {
      return;
  }

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

  my @t;
  if (scalar @$noclean + scalar @$send > 0) {
    push @t, "scp";
    push @t, "-o $sshopts" if $sshopts;
    push @t, map(unesc,@$noclean), map(unesc,@$send), "$user\@$name:";

    my $scp = Expect->spawn(@t) ||
      die "Warning: failed to start scp 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;
        }
      ],
      [ 'WARNING: REMOTE HOST',
        sub {
          die "Fatal: scp failed on $name\n";
        }
      ],
      [ 'Permission denied',
        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, 'PS1=$\ ', "sh";

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

#$Expect::Exp_Internal = 1;

  $ssh->expect(120,
    [ 'Are you sure you want to continue ',
      sub {
        print $ssh "yes\r"; exp_continue;
      },
    ],
    [ 'Permission denied, please try again.',
      sub {
        die "Warning: ssh failed on $name\n";
      }
    ],
    [ '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 {
        my $fqdn;
        unless ($name =~ /^\d+\.\d+.\d+\.\d+$/) {
          $fqdn = `host $name | head -1`;
          $fqdn = $name unless $? >> 8;
          $fqdn =~ s/^(\S*) has.*/$1/;
          chomp($fqdn);
          print "\n\nrunning: HOSTNAME=$fqdn; export HOSTNAME;\n\n";
          print $ssh "HOSTNAME=$fqdn; export HOSTNAME;";
        }
        print $ssh "PS1='\$ '; PATH=/usr/local/bin:".
          "/bin:/usr/bin:/usr/sbin:/usr/local/sbin:".
          "/sbin;unset HISTFILE;export PS1;export PATH\r";

        beroot($ssh, $name) unless $noroot;

        my $argstr = join ' ', @$args;
        print $ssh "$prog $script $argstr && ".
          "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;

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

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

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

  $ssh->hard_close();

    die $err if $err;

  print "\n\n";

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

    my @t;
    push @t, "scp";
    push @t, "-o $sshopts" if $sshopts;
    push @t, "$user\@$name:@$retrieve";
    push @t, "$retrievedir/$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();
  }

  1;
}

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

#$Expect::Exp_Internal = 1;

  $ssh->clear_accum();

  if ($usesudo) {
    print $ssh "sudo -K ; if [ -x /usr/bin/pfexec ]; then /usr/bin/pfexec sudo sh; else sudo sh; fi\r";
#    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 "unset HISTFILE; 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.23 2013/07/27 17:09:14 sic Exp $
# vim:sw=2:ts=2:softtabstop=2:expandtab