mirror of
https://github.com/xcat2/xcat-core.git
synced 2025-08-15 15:50:22 +00:00
d123aab564
Lenovo uses the same asu utility, but a different path. Try to use the lenovo utility, falling back to the IBM location if not found.
398 lines
13 KiB
Perl
Executable File
398 lines
13 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
#!/usr/bin/env perl
|
|
# IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html
|
|
# Run the asu64 utility out of band to multiple nodes, either sequentially or in parallel
|
|
BEGIN
|
|
{
|
|
$::XCATROOT = $ENV{'XCATROOT'} ? $ENV{'XCATROOT'} : -d '/opt/xcat' ? '/opt/xcat' : '/usr';
|
|
}
|
|
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);
|
|
$::asucmd = '/opt/lenovo/toolscenter/asu/asu64';
|
|
if (! -x $::asucmd) {
|
|
$::asucmd = '/opt/ibm/toolscenter/asu/asu64';
|
|
}
|
|
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: pasu [-V] [-d] [-n] [-i <hostname-suffix>] [-l <user>] [-p <passwd>] [-f <fanout>] <noderange> <command>\n";
|
|
print " pasu [-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 ($defaultuser, $defaultpw);
|
|
if (!defined($username) || !defined($passwd)) {
|
|
($defaultuser, $defaultpw) = getdefaultcredentials();
|
|
#if (!defined($username)) { $username = $user; }
|
|
#if (!defined($passwd)) { $passwd = $pw; }
|
|
if ($::VERBOSE) { print "default username=$defaultuser, passwd=$defaultpw\n"; }
|
|
}
|
|
|
|
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 asu for each node
|
|
#todo: i thought we would need retry logic because i thought asu 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->{bmc};
|
|
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->{username})) { $user = $ipmiattrs->{username}; }
|
|
else { $user = $defaultuser; }
|
|
if (defined($passwd)) { $pw = $passwd; } # cli option
|
|
elsif (defined($ipmiattrs->{password})) { $pw = $ipmiattrs->{password}; }
|
|
else { $pw = $defaultpw; }
|
|
if ($::VERBOSE) { print "For node $node using bmc=$bmc, user=$user, pw=$pw\n"; }
|
|
#asunode(\$child,$node,$username,$passwd,@ARGV[1 .. $#ARGV]);
|
|
asunode(\$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 "$_: *** pasu missed exit code, probably one of the following: $possible_codes\n";
|
|
}
|
|
}
|
|
foreach (keys %exitcodes) {
|
|
if ($exitcodes{$_}) {
|
|
print stderr "$_: *** asu 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!~/Licensed Materials - Property of IBM/i &&
|
|
$line!~/\(C\) Copyright IBM 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;
|
|
}
|
|
|
|
# Fork the asu cmd for 1 node
|
|
sub asunode {
|
|
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 = "$::asucmd $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 => 'getNodesAttribs', noderange => $noderange, table => 'ipmi');
|
|
push (@{$cmdref{attr}}, qw(bmc username password));
|
|
$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});
|
|
$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;
|
|
}
|
|
|
|
# Contact xcatd to get the default user/pw for ipmi in the xcat passwd table
|
|
sub getdefaultcredentials {
|
|
my @data;
|
|
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: use lissas new db api instead
|
|
my %cmdref = (command => 'tabdump', arg => 'passwd');
|
|
#push (@{$cmdref->{arg}}, 'passwd');
|
|
$SIG{ALRM} = sub { die "No response getting userid and password" };
|
|
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->{data}) {
|
|
@data=@{$rsp->{data}};
|
|
}
|
|
if ($rsp->{serverdone}) {
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
close($client);
|
|
|
|
# go thru the data lines and find the ipmi row
|
|
my ($user, $pw);
|
|
foreach my $d (@data) {
|
|
#if ($::VERBOSE) { print "$d\n"; }
|
|
my @cols = split(',', $d);
|
|
if ($cols[0] eq '"ipmi"') {
|
|
($user) = $cols[1] =~ /"(.*)"/;
|
|
($pw) = $cols[2] =~ /"(.*)"/;
|
|
last;
|
|
}
|
|
}
|
|
if (!defined($user) || !defined($pw)) { $user = "USERID"; $pw = "PASSW0RD"; }
|
|
return ($user, $pw);
|
|
}
|
|
|
|
# vim: set et ts=2 sts=2 sw=2 :
|