xcat-core/xCAT-client/bin/pscp

#!/usr/bin/env perl
# IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html
BEGIN
{
    $::XCATROOT = $ENV{'XCATROOT'} ? $ENV{'XCATROOT'} : -d '/opt/xcat' ? '/opt/xcat' : '/usr';
}
use lib "$::XCATROOT/lib/perl";
use IO::Socket::SSL;
use XML::Simple;
$XML::Simple::PREFERRED_PARSER='XML::Parser';
#use Data::Dumper;
use IO::Handle;
use IO::Select;
use Thread qw(yield);
use xCAT::Utils;
use Getopt::Long qw(:config pass_through require_order);
use POSIX qw(:signal_h :errno_h :sys_wait_h);
my $interface;
GetOptions(
  "interface=s" => \$interface,
  "f|fanout=s" => \$fanout,
  );
my %nodehdl;
my $xcathost='localhost:3001';
if ($ENV{XCATHOST}) {
          $xcathost=$ENV{XCATHOST};
}

sub usage
{
  print $_[0];
  print "Usage: pscp [ -f fanout] [-i <SUFFIX>] [SCP OPTIONS...] FILE... <NODERANGE>:<DESTINATION>\n";
  exit 1;
}

my $pshmaxp = 64; 
if ($fanout) {  # see if they overroad the fanout from the command line
  $pshmaxp=$fanout;
}
if ($ENV{XCATPSHFANOUT}) {  # env variable rules
  $pshmaxp=$ENV{XCATPSHFANOUT};
}


# Processing arguments
usage unless @ARGV;
my $dest = shift;
my @scpargs;
while (@ARGV)
{
  push @scpargs, $dest;
  $dest = shift;
}
my $noderange, $destloc;
if ($dest =~ /:/) { ($noderange, $destloc) = split(/:/, $dest); }
else { usage("No node range specified\n\n"); }

my  @user = getpwuid($>);
my $homedir=$user[7];

my $client = IO::Socket::SSL->new(
                PeerAddr=>$xcathost,
                SSL_key_file=>$homedir."/.xcat/client-cred.pem",
                SSL_cert_file=>$homedir."/.xcat/client-cred.pem",
                SSL_ca_file => $homedir."/.xcat/ca.pem",
                SSL_use_cert => 1,
                #SSL_verify_mode => 1,
             );
die "Connection failure: $!\n" unless ($client);
my %cmdref = (command => 'noderange', noderange => $noderange);
$SIG{ALRM} = sub { die "No response getting noderange" };
alarm(15);
print $client XMLout(\%cmdref,RootName=>'xcatrequest', NoAttr=>1, KeyAttr => []);
alarm(15);
my $response="";
my @nodes=();
while (<$client>) {
  alarm(0);
  $response .= $_;
  if ($response =~ m/<\/xcatresponse>/) {
    $rsp=XMLin($response, ForceArray => ['node']);
    $response='';
    if ($rsp->{warning}) {
      printf "Warning: ".$rsp->{warning}."\n";
    }
    if ($rsp->{error}) {
      die ("ERROR: ".$rsp->{error}."\n");
    } elsif ($rsp->{node}) {
      @nodes=@{$rsp->{node}};
    }
    if ($rsp->{serverdone}) {
      last;
    }
  }
}
close($client);
my $children = 0;
my $inputs = new IO::Select;
$SIG{CHLD} = sub { while (waitpid(-1,WNOHANG) > 0) { $children--; } };
if ($interface) {
  foreach (@nodes) {
    s/$/-$interface/;
  }
}
foreach (@nodes) {
  my $node=$_;
  while ($children > $pshmaxp) { processoutput($inputs); }
  my $child;
  $children++;
  #scpnode(\$child,$node,@ARGV[0],$destloc);
  scpnode(\$child,$node,\@scpargs,$destloc);
  $inputs->add($child);
  $nodehdl{$child} = $node;
}
while ($inputs->count and $children) {
  processoutput($inputs);
}
while (processoutput($inputs)) {};
wait;
exit(0);

sub processoutput { #This way, one arbiter handles output, no interrupting
  my $inputs = shift;
  my @readyins = $inputs->can_read(1);
  my $rc = @readyins;
  my $readyh;
  foreach $readyh (@readyins) {
    my $line = <$readyh>;
    unless ($line) {
      $inputs->remove($readyh);
      print $nodehdl{$readyh}.": done\n";
      close($readyh);
      next;
    }
    chomp($line);
    print $nodehdl{$readyh}.": ".$line."\n";
  }
  #yield;
  return $rc;
}
sub scpnode {
  my $out = shift;
  my $node = shift;
  my $in;
  #my $args = join(" ",@_);
  #my $file = shift;
  my $scpargsr = shift;
  my @scpargs = @{$scpargsr};
  my $dest = shift;
  open($$out, "scp -o BatchMode=yes @scpargs $node:$dest 2>&1 |");
}

# vim: set et sw=2 ts=2 sts=2: