174 lines
4.2 KiB
Perl
Executable File
174 lines
4.2 KiB
Perl
Executable File
#!/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 xCAT::Utils;
|
|
use Thread qw(yield);
|
|
use Getopt::Long;
|
|
use POSIX qw(:signal_h :errno_h :sys_wait_h);
|
|
my $interface;
|
|
my $opts;
|
|
Getopt::Long::Configure("require_order");
|
|
Getopt::Long::Configure("posix_default");
|
|
Getopt::Long::Configure("no_gnu_compat");
|
|
Getopt::Long::Configure("bundling");
|
|
|
|
my %nodehdl;
|
|
my $xcathost='localhost:3001';
|
|
if ($ENV{XCATHOST}) {
|
|
$xcathost=$ENV{XCATHOST};
|
|
}
|
|
|
|
if (!(@ARGV)) {
|
|
&usage;
|
|
exit(1);
|
|
|
|
}
|
|
if (!GetOptions(
|
|
'h|help' => \$help,
|
|
'v|version' => \$version,
|
|
'o|options=s' => \$opts,
|
|
'f|fanout=s' => \$fanout,
|
|
'i|interface=s' => \$interface))
|
|
{
|
|
&usage;
|
|
exit(1);
|
|
}
|
|
if ($help) {
|
|
&usage;
|
|
exit(0);
|
|
}
|
|
if ($version) {
|
|
my $version = xCAT::Utils->Version();
|
|
print "$version \n";
|
|
exit(0);
|
|
}
|
|
my $pshmaxp = 64;
|
|
# determine fanout
|
|
if ($ENV{XCATPSHFANOUT}) {
|
|
$pshmaxp=$ENV{XCATPSHFANOUT};
|
|
}
|
|
if ($fanout) { # see if they overroad the fanout from the command line
|
|
$pshmaxp=$fanout;
|
|
}
|
|
(my $noderange,my $destloc) = split(/:/,$ARGV[1]);
|
|
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} = \&reaper;
|
|
sub reaper {
|
|
while (($pid = waitpid(-1,WNOHANG)) > 0) {
|
|
$children--;
|
|
}
|
|
if ($children and $pid == -1) { #for whatever reason, rsync processes slip by frequently
|
|
$children = 0;
|
|
}
|
|
$SIG{CHLD} = \&reaper;
|
|
}
|
|
|
|
|
|
if ($interface) {
|
|
foreach (@nodes) {
|
|
s/$/-$interface/;
|
|
}
|
|
}
|
|
foreach (@nodes) {
|
|
my $node=$_;
|
|
while ($children > $pshmaxp) { processoutput($inputs); }
|
|
my $child;
|
|
$children++;
|
|
scpnode(\$child,$node,@ARGV[0],$destloc,$opts);
|
|
$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 $dest = shift;
|
|
my $opts = shift;
|
|
my $cmd="rsync -az$opts $file $node:$dest 2>&1 |";
|
|
open($$out,"rsync -az$opts $file $node:$dest 2>&1 |");
|
|
}
|
|
sub usage {
|
|
print "Usage: prsync filename [filename ...] noderange:destinationdirectory\n";
|
|
print " prsync [-f fanout] [-o rsync options] [filename filename ...] [directory directory ...]";
|
|
print " noderange:destinationdirectory\n";
|
|
print " prsync {-h|--help|-v|--version}\n";
|
|
}
|
|
|