#!/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 %sslargs; if (defined($ENV{'XCATSSLVER'})) { $sslargs{SSL_version} = $ENV{'XCATSSLVER'}; } 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 => SSL_VERIFY_PEER, SSL_verifycn_scheme => "none", %sslargs, ); 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"; }