#!/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 ] [SCP OPTIONS...] FILE... :\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: