arif/xcat-core
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
33f614b584
xcat-core/xCAT-client/bin/pasu
jjohnson2 3cc5e0cdf4 Fix asu handling of exotic characters 
Exotic characters that may be interpreted by shell
are now quoted to prevent any interpolation.
2015-03-26 15:52:44 -04:00

395 lines
13 KiB
Perl
Executable File
Raw Blame History

#!/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/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 :
Reference in New Issue View Git Blame Copy Permalink