mirror of
				https://github.com/xcat2/xcat-core.git
				synced 2025-11-03 21:02:34 +00:00 
			
		
		
		
	
		
			
				
	
	
		
			180 lines
		
	
	
		
			4.3 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable File
		
	
	
	
	
			
		
		
	
	
			180 lines
		
	
	
		
			4.3 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 %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 => 1,
 | 
						|
                %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";
 | 
						|
}
 | 
						|
 |