mirror of
https://github.com/xcat2/xcat-core.git
synced 2025-07-15 17:16:10 +00:00
getipmicons structures the data differently from getNodesAttribs. Accomodate by merging each responses data in node by node rather than simply overwriting with the last data.
336 lines
11 KiB
Perl
Executable File
336 lines
11 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
#!/usr/bin/env perl
|
|
# Lenovo(c) 2015 EPL license http://www.eclipse.org/legal/epl-v10.html
|
|
# IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html
|
|
# Run asu64 or iflash64 utility out of band to multiple nodes, either sequentially or in parallel
|
|
BEGIN
|
|
{
|
|
$::XCATROOT = $ENV{'XCATROOT'} ? $ENV{'XCATROOT'} : -d '/opt/xcat' ? '/opt/xcat' : '/usr';
|
|
}
|
|
my $iam = $0;
|
|
use strict;
|
|
close(STDIN);
|
|
open(STDIN,"<","/dev/null");
|
|
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 Getopt::Long;
|
|
use POSIX qw(:signal_h :errno_h :sys_wait_h);
|
|
use Thread qw(yield);
|
|
if ($iam =~ /pasu/) {
|
|
$::utilcmd = '/opt/lenovo/toolscenter/asu/asu64';
|
|
if (! -x $::utilcmd) {
|
|
$::utilcmd = '/opt/ibm/toolscenter/asu/asu64';
|
|
}
|
|
} elsif ($iam =~ /piflash/) {
|
|
$::utilcmd = '/opt/xcat/sbin/iflash64';
|
|
}
|
|
my $interface;
|
|
my $username;
|
|
my $passwd;
|
|
my $fanout;
|
|
my $batchfile;
|
|
my $help;
|
|
Getopt::Long::Configure("require_order");
|
|
Getopt::Long::Configure("bundling");
|
|
Getopt::Long::Configure("no_pass_through");
|
|
if (!GetOptions(
|
|
"i|interface=s" => \$interface,
|
|
"p|passwd=s" => \$passwd,
|
|
'l|loginname=s' => \$username,
|
|
'f|fanout=i' => \$fanout,
|
|
'b|batch=s' => \$batchfile,
|
|
'r|retry' => \$::RETRY,
|
|
'd|donotfilter' => \$::DONOTFILTER,
|
|
"n|nonodecheck" => \$::NONODECHECK, #does not check the noderange, in this case, noderange need to be a simple list of nodes.
|
|
"V|verbose" => \$::VERBOSE,
|
|
'h|help' => \$help,
|
|
) || $help || ($batchfile && scalar(@ARGV)!=1) || (!$batchfile && scalar(@ARGV)<2) ) {
|
|
print "Usage: $iam [-V] [-d] [-n] [-i <hostname-suffix>] [-l <user>] [-p <passwd>] [-f <fanout>] <noderange> <command>\n";
|
|
print " $iam [-V] [-d] [-n] [-i <hostname-suffix>] [-l <user>] [-p <passwd>] [-f <fanout>] -b <batchfile> <noderange>\n";
|
|
exit;
|
|
}
|
|
my %nodehdl;
|
|
my $xcathost='localhost:3001';
|
|
my $pasumaxp = 64;
|
|
if ($ENV{XCATHOST}) {
|
|
$xcathost=$ENV{XCATHOST};
|
|
}
|
|
if ($ENV{XCATPSHFANOUT}) {
|
|
$pasumaxp=$ENV{XCATPSHFANOUT};
|
|
}
|
|
if ($fanout) { # see if they overroad the fanout from the command line
|
|
$pasumaxp=$fanout;
|
|
}
|
|
my $noderange = shift @ARGV;
|
|
my @nodes=();
|
|
|
|
#print "fanout=$fanout, username=$username, noderange=$noderange\n";
|
|
|
|
my $nodeattrs;
|
|
if ($::NONODECHECK) {
|
|
@nodes=split(/,/, $noderange);
|
|
}
|
|
else { # contact xcatd to expand noderange and get ipmi attrs
|
|
# do not need to do this call, because getting the ipmi atts will also give us a list of nodes
|
|
#@nodes = expandnoderange($noderange);
|
|
|
|
# this is reference to a hash, each key is the nodename and the value is a reference to a hash of attr values
|
|
$nodeattrs = getipmiattrs($noderange);
|
|
#print Dumper($nodeattrs);
|
|
#foreach my $k (keys(%$nodeattrs)) {
|
|
# print "$k:\n";
|
|
# my $subhash = $nodeattrs->{$k};
|
|
# foreach my $k2 (keys(%$subhash)) { print " $k2=", $subhash->{$k2}, "\n"; }
|
|
#}
|
|
#exit;
|
|
@nodes = keys(%$nodeattrs);
|
|
}
|
|
|
|
my $children = 0;
|
|
my $inputs = new IO::Select;
|
|
my %pids; # pid => node
|
|
my %exitcodes; # Keep a list of children with known exit codes
|
|
my %foundcodes;
|
|
my @retries; # the nodes that fail with connection error
|
|
|
|
if ($interface) {
|
|
foreach (@nodes) {
|
|
s/$/-$interface/;
|
|
}
|
|
}
|
|
|
|
# Fork the processes for running utility for each node
|
|
#todo: i thought we would need retry logic because i thought utility had problems running
|
|
# in parallel. So far (up to 24 nodes) have not had any problem, but keeping the
|
|
# logic in just in case.
|
|
@retries = @nodes;
|
|
while (scalar(@retries)) {
|
|
@nodes = @retries;
|
|
@retries = ();
|
|
foreach (@nodes) {
|
|
my $node=$_;
|
|
my $ipmiattrs = $nodeattrs->{$node};
|
|
my $bmc = $ipmiattrs->{bmcaddr};
|
|
if (!defined($bmc)) {
|
|
print "$node: the ipmi.bmc attribute is not defined, skipping.\n";
|
|
next;
|
|
}
|
|
|
|
# if we have already forked the max # of simultaneous processes, wait till 1 finishes
|
|
while ($children > $pasumaxp) { processoutput($inputs); }
|
|
|
|
# fork anothe process
|
|
my $child;
|
|
$children++;
|
|
# precedence on the username and password is: cli option, ipmi table, passwd table
|
|
my ($user, $pw);
|
|
if (defined($username)) { $user = $username; } # cli option
|
|
elsif (defined($ipmiattrs->{bmcuser})) { $user = $ipmiattrs->{bmcuser}; }
|
|
if (defined($passwd)) { $pw = $passwd; } # cli option
|
|
elsif (defined($ipmiattrs->{bmcpass})) { $pw = $ipmiattrs->{bmcpass}; }
|
|
if ($::VERBOSE) { print "For node $node using bmc=$bmc, user=$user, pw=$pw\n"; }
|
|
utilnode(\$child,$node,$bmc,$user,$pw,$batchfile,@ARGV); # child is the fd of the child process
|
|
$inputs->add($child);
|
|
$nodehdl{$child} = $node;
|
|
}
|
|
|
|
# quiesce everything
|
|
while ($inputs->count) {
|
|
processoutput($inputs);
|
|
}
|
|
while (processoutput($inputs)) {};
|
|
while (wait != -1) {
|
|
yield;
|
|
}
|
|
}
|
|
|
|
my $exitcode=0;
|
|
foreach (values %pids) {
|
|
my $possible_codes = join ",",keys %foundcodes;
|
|
unless (defined $exitcodes{$_}) {
|
|
print stderr "$_: *** $iam missed exit code, probably one of the following: $possible_codes\n";
|
|
}
|
|
}
|
|
foreach (keys %exitcodes) {
|
|
if ($exitcodes{$_}) {
|
|
print stderr "$_: *** $::utilcmd exited with error code ".$exitcodes{$_}.".\n";
|
|
$exitcode++;
|
|
}
|
|
}
|
|
if ($exitcode) { #Exit code reflects number of failed nodes
|
|
$exitcode=$exitcode%256; #keep from overflowing valid values
|
|
unless ($exitcode) { #if number of failed nodes happened to be evenly divisible by 256, make it non-zero again
|
|
$exitcode++;
|
|
}
|
|
}
|
|
exit($exitcode);
|
|
|
|
# Process output on the select stmt from the forked cmds
|
|
sub processoutput { #This way, one arbiter handles output, no interrupting
|
|
my $inputs = shift; # the select object that contains all the file descriptors
|
|
my @readyins = $inputs->can_read(1); # child fds with some output available
|
|
my $rc = @readyins;
|
|
my $readyh;
|
|
foreach $readyh (@readyins) {
|
|
my $cursel = new IO::Select; # need to do non-blocking reads on this fd
|
|
$cursel->add($readyh);
|
|
while ($cursel->can_read(0)) {
|
|
my $line = <$readyh>;
|
|
unless ($line) {
|
|
$inputs->remove($readyh);
|
|
close($readyh);
|
|
$exitcodes{$nodehdl{$readyh}} = $? >> 8;
|
|
$children--;
|
|
next;
|
|
}
|
|
chomp($line);
|
|
if ($::RETRY && ($line =~ /Connection link error/i) ) {
|
|
if ($::VERBOSE) { print "Need to retry $nodehdl{$readyh}\n"; }
|
|
push @retries, $nodehdl{$readyh};
|
|
} elsif ($::DONOTFILTER || ($line!~/IBM Advanced Settings Utility version/i &&
|
|
$line!~/Lenovo Advanced Settings Utility version/i &&
|
|
$line!~/Licensed Materials - Property of IBM/i &&
|
|
$line!~/Licensed Materials - Property of Lenovo/i &&
|
|
$line!~/\(C\) Copyright IBM Corp. \d+-\d+ All Rights Reserved/i &&
|
|
$line!~/\(C\) Copyright Lenovo Corp. \d+-\d+ All Rights Reserved/i &&
|
|
$line!~/Connected to IMM at IP address/i )) {
|
|
print $nodehdl{$readyh}.": ".$line."\n";
|
|
}
|
|
}
|
|
}
|
|
no strict 'subs';
|
|
IO::Handle::flush(stdout);
|
|
use strict 'subs';
|
|
yield; #Explicitly give all children a chance to refill any buffers
|
|
return $rc;
|
|
}
|
|
|
|
sub utilnode {
|
|
my $out = shift; # this is a reference to the child file descriptor
|
|
my $node = shift;
|
|
my $bmc = shift;
|
|
my $username = shift;
|
|
my $passwd = shift;
|
|
my $batchfile = shift;
|
|
my $args;
|
|
$bmc =~ s/,.*//;
|
|
if ($batchfile) {
|
|
$args = "batch $batchfile";
|
|
} else {
|
|
foreach my $a (@_) { $args .= ' ' . xCAT::Utils->quote($a); }
|
|
}
|
|
my $cmd = "$::utilcmd $args --host '$bmc' --user '$username' --password '$passwd' 2>&1 |";
|
|
if ($::VERBOSE) { print "forking $cmd\n"; }
|
|
my $pid = open($$out, $cmd);
|
|
$pids{$pid} = $node;
|
|
}
|
|
|
|
# Contact xcatd to expand the noderange into a list of nodes
|
|
sub expandnoderange {
|
|
my $noderange = shift @_;
|
|
my @nodes;
|
|
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);
|
|
#todo: get the bmc attr for each node, not the node name itself
|
|
my %cmdref = (command => 'noderange', noderange => $noderange);
|
|
$SIG{ALRM} = sub { die "No response getting noderange" };
|
|
alarm(15);
|
|
my $msg = XMLout(\%cmdref,RootName=>'xcatrequest', NoAttr=>1, KeyAttr => []);
|
|
if ($ENV{XCATXMLTRACE}) { print $msg; }
|
|
print $client $msg;
|
|
alarm(15);
|
|
my $response="";
|
|
while (<$client>) {
|
|
alarm(0);
|
|
$response .= $_;
|
|
if ($response =~ m/<\/xcatresponse>/) {
|
|
if ($ENV{XCATXMLTRACE}) { print $response; }
|
|
my $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);
|
|
if ($::VERBOSE) { print 'Nodes:', join(',',@nodes), "\n"; }
|
|
return @nodes;
|
|
}
|
|
|
|
# Contact xcatd to get from the ipmi table for this list of nodes: bmc, username, password
|
|
sub getipmiattrs {
|
|
my $noderange = shift @_;
|
|
my $nodeattrs = {}; # this will be a reference to a hash
|
|
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 => 'getipmicons', noderange => $noderange);
|
|
$SIG{ALRM} = sub { die "No response getting ipmi attributes" };
|
|
alarm(15);
|
|
my $msg = XMLout(\%cmdref,RootName=>'xcatrequest', NoAttr=>1, KeyAttr => []);
|
|
if ($ENV{XCATXMLTRACE}) { print $msg; }
|
|
print $client $msg;
|
|
alarm(15);
|
|
my $response="";
|
|
while (<$client>) {
|
|
alarm(0);
|
|
$response .= $_;
|
|
if ($response =~ m/<\/xcatresponse>/) {
|
|
if ($ENV{XCATXMLTRACE}) { print $response; }
|
|
my $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}) {
|
|
#print Dumper($rsp->{node});
|
|
foreach (keys %{$rsp->{node}}) {
|
|
$nodeattrs->{$_} = $rsp->{node}->{$_}; # this is reference to a hash, each key is the nodename and the value is a reference to a hash of attr values
|
|
}
|
|
}
|
|
if ($rsp->{serverdone}) {
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
close($client);
|
|
#if ($::VERBOSE) { print 'Nodes:', join(',',$nodeattrs), "\n"; }
|
|
return $nodeattrs;
|
|
}
|
|
|
|
|
|
# vim: set et ts=2 sts=2 sw=2 :
|