mirror of
				https://github.com/xcat2/xcat-core.git
				synced 2025-10-30 02:42:41 +00:00 
			
		
		
		
	git-svn-id: https://svn.code.sf.net/p/xcat/code/xcat-core/trunk@3895 8638fb3e-16cb-4fca-ae20-7b5d299a9bcd
		
			
				
	
	
		
			160 lines
		
	
	
		
			3.9 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable File
		
	
	
	
	
			
		
		
	
	
			160 lines
		
	
	
		
			3.9 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;
 | |
| 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};
 | |
| }
 | |
| 
 | |
| my $pshmaxp = 64; #TODO: should this be server dictated or local conf?
 | |
| if (!(@ARGV)) {
 | |
|        &usage;
 | |
|        exit(1);
 | |
|    
 | |
| }
 | |
| if (!GetOptions(
 | |
|   'h|help'     => \$help,
 | |
|   'v|version'  => \$version,
 | |
|   '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 $noderange,my $destloc) = split(/:/,$ARGV[1]);
 | |
| my $client = IO::Socket::SSL->new(
 | |
|                 PeerAddr=>$xcathost,
 | |
|                 SSL_key_file=>$ENV{HOME}."/.xcat/client-cred.pem",
 | |
|                 SSL_cert_file=>$ENV{HOME}."/.xcat/client-cred.pem",
 | |
|                 SSL_ca_file => $ENV{HOME}."/.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);
 | |
|   $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;
 | |
|   open($$out,"rsync -az $file $node:$dest 2>&1 |");
 | |
| }
 | |
| sub usage {
 | |
|     print "Usage: prsync filename [filename ...] noderange:destinationdirectory\n";
 | |
|     print "       prsync  [rsync-opts] [filename filename ...] [directory directory ...]\n";
 | |
|     print "       noderange:destinationdirectory\n";
 | |
|     print "       prsync {-h|--help|-v|--version}\n";
 | |
| }
 |