mirror of
https://github.com/xcat2/xcat-core.git
synced 2025-05-31 10:06:39 +00:00
1337 lines
52 KiB
Perl
1337 lines
52 KiB
Perl
#!/usr/bin/env perl
|
|
# IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html
|
|
package xCAT::Client;
|
|
|
|
BEGIN
|
|
{
|
|
$::XCATROOT = $ENV{'XCATROOT'} ? $ENV{'XCATROOT'} : -d '/opt/xcat' ? '/opt/xcat' : '/usr';
|
|
}
|
|
|
|
# if AIX - make sure we include perl 5.8.2 in INC path.
|
|
# Needed to find perl dependencies shipped in deps tarball.
|
|
use Storable qw/nstore_fd fd_retrieve/;
|
|
if ($^O =~ /^aix/i) {
|
|
unshift(@INC, qw(/usr/opt/perl5/lib/5.8.2/aix-thread-multi /usr/opt/perl5/lib/5.8.2 /usr/opt/perl5/lib/site_perl/5.8.2/aix-thread-multi /usr/opt/perl5/lib/site_perl/5.8.2));
|
|
}
|
|
use IO::Handle;
|
|
use MIME::Base64 qw(decode_base64);
|
|
use IO::Socket::SSL;
|
|
|
|
my $inet6support;
|
|
if ($^O =~ /^aix/i) { # disable AIX IPV6 TODO fix
|
|
$inet6support = 0;
|
|
} else {
|
|
$inet6support = eval { require Socket6; 1; };
|
|
}
|
|
if ($inet6support) {
|
|
$inet6support = eval { require IO::Socket::INET6; 1; };
|
|
}
|
|
if ($inet6support) {
|
|
$inet6support = eval { require IO::Socket::SSL; IO::Socket::SSL->import('inet6'); 1; };
|
|
}
|
|
|
|
if ($^O =~ /^linux/i) {
|
|
|
|
# Is IPv6 enabled on the MN or xcat client node at all?
|
|
my $ipv6enabled = `ip -6 -o addr 2> /dev/null`;
|
|
if (!$ipv6enabled) {
|
|
$inet6support = 0;
|
|
}
|
|
}
|
|
|
|
unless ($inet6support) {
|
|
eval { require Socket };
|
|
eval { require IO::Socket::INET };
|
|
eval { require IO::Socket::SSL; IO::Socket::SSL->import('inet4') };
|
|
}
|
|
|
|
|
|
use XML::Simple; #smaller than libxml....
|
|
use Fcntl;
|
|
use POSIX qw/:errno_h/;
|
|
use IO::Select;
|
|
$XML::Simple::PREFERRED_PARSER = 'XML::Parser';
|
|
|
|
#require Data::Dumper;
|
|
my $xcathost = 'localhost:3001';
|
|
my $plugins_dir;
|
|
my %resps;
|
|
my $EXITCODE; # save the bitmask of all exit codes returned by calls to handle_response()
|
|
1;
|
|
|
|
|
|
sub rspclean {
|
|
my $response = shift;
|
|
my $callback = shift;
|
|
my $rsps = XMLin($response, SuppressEmpty => undef, ForceArray => 1);
|
|
foreach my $rsp (@{ $rsps->{xcatresponse} }) {
|
|
|
|
#add ESC back
|
|
foreach my $key (keys %$rsp) {
|
|
if (ref($rsp->{$key}) eq 'ARRAY') {
|
|
foreach my $text (@{ $rsp->{$key} }) {
|
|
next unless defined $text;
|
|
$text =~ s/xxxxESCxxxx/\e/g;
|
|
}
|
|
}
|
|
else {
|
|
$rsp->{$key} =~ s/xxxxESCxxxx/\e/g;
|
|
}
|
|
}
|
|
$callback->($rsp);
|
|
if ($rsp->{serverdone}) {
|
|
return 1;
|
|
}
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
sub send_request {
|
|
my $request = shift;
|
|
my $sock = shift;
|
|
my $encode = shift;
|
|
if ($encode eq "xml") {
|
|
my $msg = XMLout($request, RootName => 'xcatrequest', NoAttr => 1, KeyAttr => []);
|
|
if ($ENV{XCATXMLTRACE}) { print $msg; }
|
|
if ($ENV{XCATXMLWARNING}) {
|
|
validateXML($msg);
|
|
}
|
|
print $sock $msg;
|
|
$sock->flush();
|
|
} else {
|
|
nstore_fd($request, $sock);
|
|
$sock->flush();
|
|
}
|
|
}
|
|
#################################
|
|
# submit_request will take an xCAT command and pass it to the xCAT
|
|
# server for execution.
|
|
# Note must not put a require or use for Utils.pm in the non-bypass path
|
|
#
|
|
# If the XCATBYPASS env var is set, the connection to the server/daemon
|
|
# will be bypassed and the plugin will be called directly. If it is
|
|
# set to one or more directories (separated by ":"), all perl modules
|
|
# in those directories will be loaded in as plugins (for duplicate
|
|
# commands, last one in wins). If it is set to any other value
|
|
# (e.g. "yes", "default", whatever string you want) the default plugin
|
|
# directory /opt/xcat/lib/perl/xCAT_plugin will be used.
|
|
#
|
|
# Input:
|
|
# Request hash - A hash ref containing the input command and args to be
|
|
# passed to the plugin. The the xcatd daemon (or this routine when
|
|
# XCATBYPASS) reads the {noderange} entry and builds a flattened array
|
|
# of nodes that gets added as request->{node}
|
|
# The format for the request hash is:
|
|
# { command => [ 'xcatcmd' ],
|
|
# noderange => [ 'noderange_string' ],
|
|
# arg => [ 'arg1', 'arg2', '...', 'argn' ]
|
|
# }
|
|
# Callback - A subroutine ref that will be called to process the output
|
|
# from the plugin.
|
|
#
|
|
# NOTE: The request hash will get converted to XML when passed to the
|
|
# xcatd daemon, and will get converted back to a hash before being
|
|
# passed to the plugin. The XMLin ForceArray option is used to
|
|
# force all XML constructs to be arrays so that the plugin code
|
|
# and callback routines can access the data consistently.
|
|
# The input request and the response hash created by the plugin should
|
|
# always create hashes with array values.
|
|
#################################
|
|
sub submit_request {
|
|
my $request = shift;
|
|
my $callback = shift;
|
|
my $keyfile = shift;
|
|
my $certfile = shift;
|
|
my $cafile = shift;
|
|
|
|
# get home directory
|
|
my @user = getpwuid($>);
|
|
my $homedir = $user[7];
|
|
unless ($keyfile) { $keyfile = $homedir . "/.xcat/client-cred.pem"; }
|
|
unless ($certfile) { $certfile = $homedir . "/.xcat/client-cred.pem"; }
|
|
unless ($cafile) { $cafile = $homedir . "/.xcat/ca.pem"; }
|
|
$xCAT::Client::EXITCODE = 0; # clear out exit code before invoking the plugin
|
|
if (ref($request) eq 'HASH') { # the request is an array, not pure XML
|
|
$request->{clienttype}->[0] = "cli"; # setup clienttype for auditlog
|
|
}
|
|
|
|
# If XCATBYPASS is set, invoke the plugin process_request method directly
|
|
# without going through the socket connection to the xcatd daemon
|
|
if ($ENV{XCATBYPASS}) {
|
|
|
|
#add current userid to the request
|
|
if (ref($request) eq 'HASH') { # the request is an array, not pure XML
|
|
if (!(defined($request->{username}))) {
|
|
$request->{username}->[0] = getpwuid($>);
|
|
}
|
|
|
|
# only allow root to run
|
|
unless ($request->{username}->[0] =~ /root/) {
|
|
print("WARNING: Only allow root to run XCATBYPASS mode, your current user ID is $request->{username}->[0].\n");
|
|
return 0;
|
|
}
|
|
}
|
|
|
|
# Load plugins from either specified or default dir
|
|
require xCAT::Table;
|
|
my %cmd_handlers;
|
|
my @plugins_dirs = split('\:', $ENV{XCATBYPASS});
|
|
if (-d $plugins_dirs[0]) {
|
|
foreach (@plugins_dirs) {
|
|
$plugins_dir = $_;
|
|
scan_plugins();
|
|
}
|
|
} else {
|
|
|
|
# figure out default plugins dir
|
|
#my $sitetab=xCAT::Table->new('site');
|
|
#unless ($sitetab) {
|
|
# print ("ERROR: Unable to open basic site table for configuration\n");
|
|
#}
|
|
$plugins_dir = $::XCATROOT . '/lib/perl/xCAT_plugin';
|
|
scan_plugins();
|
|
}
|
|
|
|
populate_site_hash();
|
|
|
|
# don't do XML transformation -- assume request is well-formed
|
|
# my $xmlreq=XMLout($request,RootName=>xcatrequest,NoAttr=>1,KeyAttr=>[]);
|
|
# $request = XMLin($xmlreq,SuppressEmpty=>undef,ForceArray=>1) ;
|
|
|
|
|
|
# Call the plugin directly
|
|
# ${"xCAT_plugin::".$modname."::"}{process_request}->($request,$callback);
|
|
plugin_command($request, undef, $callback);
|
|
return 0;
|
|
}
|
|
|
|
# No XCATBYPASS, so establish a socket connection with the xcatd daemon
|
|
# and submit the request
|
|
if ($ENV{XCATHOST}) {
|
|
$xcathost = $ENV{XCATHOST};
|
|
}
|
|
my %connargs = ();
|
|
if ($xcathost =~ s/%([^\]|:]*)//) {
|
|
$connargs{PeerScope} = $1;
|
|
}
|
|
$connargs{PeerAddr} = $xcathost;
|
|
$connargs{Timeout} = 15;
|
|
if ($connargs{PeerScope} and $connargs{PeerScope} =~ /[a-zA-Z]/) { #non-numeric, need to translate...
|
|
my @ipdata = `ip link`;
|
|
@ipdata = grep(/[^@]$connargs{PeerScope}(:|@)/, @ipdata);
|
|
if (scalar(@ipdata) != 1) {
|
|
print STDERR "Unable to identify scope " . $connargs{PeerScope} . "\n";
|
|
exit(1);
|
|
}
|
|
$connargs{PeerScope} = $ipdata[0];
|
|
$connargs{PeerScope} =~ s/:.*//;
|
|
}
|
|
|
|
|
|
my $pclient;
|
|
if ($inet6support) {
|
|
$pclient = IO::Socket::INET6->new(
|
|
%connargs,
|
|
);
|
|
} else {
|
|
$pclient = IO::Socket::INET->new(
|
|
PeerAddr => $xcathost,
|
|
Timeout => 15,
|
|
);
|
|
}
|
|
unless ($pclient) {
|
|
print "Unable to open socket connection to xcatd daemon on $xcathost.\n";
|
|
print "Verify that the xcatd daemon is running and that your SSL setup is correct.\n";
|
|
if ($@ =~ /SSL Timeout/) {
|
|
die "Connection failure: SSL Timeout or incorrect certificates in ~/.xcat";
|
|
} else {
|
|
die "Connection failure: $@"
|
|
}
|
|
}
|
|
my $client;
|
|
my %sslargs;
|
|
if (defined($ENV{'XCATSSLVER'})) {
|
|
$sslargs{SSL_version} = $ENV{'XCATSSLVER'};
|
|
}
|
|
if (-r $keyfile and -r $certfile and -r $cafile) {
|
|
$client = IO::Socket::SSL->start_SSL($pclient,
|
|
SSL_key_file => $keyfile,
|
|
SSL_cert_file => $certfile,
|
|
SSL_ca_file => $cafile,
|
|
SSL_verify_mode => SSL_VERIFY_PEER,
|
|
SSL_verifycn_scheme => "none",
|
|
SSL_use_cert => 1,
|
|
Timeout => 0,
|
|
%sslargs,
|
|
);
|
|
} else {
|
|
print "warning: the client certificates under $homedir/.xcat/ are not setup correctly, please run '/opt/xcat/share/xcat/scripts/setup-local-client.sh"." $ENV{'USER'}' as 'root' to generate the client certificates; otherwise, the SSL connection between xcat client and xcatd will be setup without certificate verification and open to Man-In-The-Middle attacks.\n";
|
|
#Using the default of SSL_verify_mode of SSL_VERIFY_NONE for client is deprecated!
|
|
#need to specify SSL_verify_mode => SSL_VERIFY_NONE explicitly
|
|
$client = IO::Socket::SSL->start_SSL($pclient,
|
|
SSL_verify_mode => SSL_VERIFY_NONE,
|
|
Timeout => 0,
|
|
);
|
|
}
|
|
unless ($client) {
|
|
print "Unable to open socket connection to xcatd daemon on $xcathost.\n";
|
|
print "Verify that the xcatd daemon is running and that your SSL setup is correct.\n";
|
|
if ($@ =~ /SSL Timeout/) {
|
|
die "Connection failure: SSL Timeout or incorrect certificates in ~/.xcat";
|
|
} else {
|
|
die "Connection failure: $@"
|
|
}
|
|
}
|
|
|
|
my $msg;
|
|
my $encode = "xml";
|
|
|
|
#storable encoding is unsafe, carry on with the unsafe xml scheme
|
|
#perhaps one day will support faster schemes
|
|
#my $encode = "storable";
|
|
#my $straightprint=0;
|
|
#if ($ENV{XCATXMLTRACE} or $ENV{XCATXMLWARNING}) { $encode="xml"; }
|
|
if (ref($request) eq 'HASH') { # the request is an array, not pure XML
|
|
#print $client "xcatencoding: $encode\n";
|
|
#my $encok=<$client>;
|
|
send_request($request, $client, $encode);
|
|
} else { #XML
|
|
$straightprint = 1;
|
|
$msg = $request;
|
|
print $client $msg;
|
|
}
|
|
|
|
# when receive TERM or INT (ctrl^c) from user, sleep 2s before exit to make
|
|
# sure the server (xcatd) has recevied 'abortcommand' command
|
|
$SIG{TERM} = $SIG{INT} = sub { send_request({ abortcommand => [1] }, $client, $encode); sleep 2; exit 0; };
|
|
my $response;
|
|
my $rsp;
|
|
my $cleanexit = 0;
|
|
if ($encode eq 'xml') {
|
|
my $massresponse = "<massresponse>";
|
|
my $nextcoalescetime = time() + 1;
|
|
my $coalescenow = 0;
|
|
my $flags = fcntl($client, F_GETFL, 0);
|
|
$flags |= O_NONBLOCK; #select can be a bit.. fickle, make sysread work more easily...
|
|
fcntl($client, F_SETFL, $flags);
|
|
my $clientsel = new IO::Select;
|
|
$clientsel->add($client);
|
|
my $line;
|
|
my $newdata = 0;
|
|
|
|
while (1) {
|
|
my $shouldexit;
|
|
if ($newdata and ($coalescenow or time() > $nextcoalescetime)) {
|
|
$coalescenow = 0;
|
|
$newdata = 0;
|
|
$nextcoalescetime = time() + 1;
|
|
$massresponse .= "</massresponse>";
|
|
$shouldexit = rspclean($massresponse, $callback);
|
|
$massresponse = "<massresponse>";
|
|
}
|
|
|
|
if ($shouldexit) {
|
|
$cleanexit = 1;
|
|
last;
|
|
}
|
|
$line = "";
|
|
$clientsel->can_read(0.5);
|
|
my $readbytes;
|
|
do { $readbytes = sysread($client, $line, 65535, length($line)); } while ($readbytes);
|
|
unless (length($line)) {
|
|
if (not defined $readbytes and $! == EAGAIN) { next; }
|
|
last;
|
|
}
|
|
$newdata = 1;
|
|
$response .= $line;
|
|
if ($line =~ m/<\/xcatresponse>\s*\z/) {
|
|
if ($line =~ /serverdone/) { $coalescenow = 1; } #if serverdone was detected, hint at coalesce code to flush things out now
|
|
#this means that coalesce can be triggered by stray words in the output prematurely, but that's harmless
|
|
#replace ESC with xxxxESCxxx because XMLin cannot handle it
|
|
$response =~ s/\e/xxxxESCxxxx/g;
|
|
|
|
if ($ENV{XCATXMLTRACE}) { print $response; }
|
|
$massresponse .= $response;
|
|
$response = '';
|
|
if ($ENV{XCATXMLWARNING}) {
|
|
validateXML($response);
|
|
}
|
|
}
|
|
}
|
|
if (not $cleanexit and $massresponse ne "<massresponse>") {
|
|
$massresponse .= "</massresponse>";
|
|
$cleanexit = rspclean($massresponse, $callback);
|
|
}
|
|
} else { #storable encode
|
|
my $rsp;
|
|
eval { $rsp = fd_retrieve($client); };
|
|
SERVERINPUT: while ($rsp) {
|
|
my @rsps;
|
|
if (ref $rsp eq 'ARRAY') {
|
|
@rsps = @$rsp;
|
|
} else {
|
|
@rsps = ($rsp);
|
|
}
|
|
foreach (@rsps) {
|
|
$callback->($_);
|
|
if ($_->{serverdone}) {
|
|
$cleanexit = 1;
|
|
last SERVERINPUT;
|
|
}
|
|
}
|
|
$rsp = undef;
|
|
eval { $rsp = fd_retrieve($client); };
|
|
}
|
|
}
|
|
$massresponse = "";
|
|
unless ($cleanexit) {
|
|
print STDERR "ERROR/WARNING: communication with the xCAT server seems to have been ended prematurely\n";
|
|
$xCAT::Client::EXITCODE = 1;
|
|
}
|
|
|
|
sub validateXML {
|
|
my $xml = shift;
|
|
my @lines = split /\n/, $xml;
|
|
my $invalidNewline = 0;
|
|
my $contentsColon = 0;
|
|
my $contentsLine;
|
|
|
|
foreach (@lines) {
|
|
if (!$invalidNewline) {
|
|
if (($_ =~ /<contents>/ && $_ !~ /<\/contents>/) ||
|
|
($_ =~ /<desc>/ && $_ !~ /<\/desc>/)) {
|
|
$invalidNewline = 1;
|
|
print "Possible invalid XML using newlines found: \n$xml\n";
|
|
}
|
|
}
|
|
if ($_ =~ /<contents>.+:.+<\/contents>/) {
|
|
$contentsColon = 1;
|
|
$contentsLine = $_;
|
|
}
|
|
if ($_ =~ /<desc>.+<\/desc>/) {
|
|
$contentsColon = 0;
|
|
}
|
|
if ($contentsColon && $_ =~ /<desc><\/desc>/) {
|
|
print "Possible invalid XML found(data contents using colon and blank description): \n$contentsLine\n$_\n";
|
|
$contentsColon = 0;
|
|
}
|
|
}
|
|
}
|
|
|
|
###################################
|
|
# scan_plugins
|
|
# will load all plugin perl modules and build a list of supported
|
|
# commands
|
|
#
|
|
# NOTE: This is copied from xcatd (last merge 11/23/09).
|
|
# TODO: Will eventually move to using common source....
|
|
###################################
|
|
sub scan_plugins {
|
|
my @plugins = glob($plugins_dir . "/*.pm");
|
|
foreach (@plugins) {
|
|
/.*\/([^\/]*).pm$/;
|
|
my $modname = $1;
|
|
unless (eval { require "$_" }) {
|
|
|
|
# xCAT::MsgUtils->message("S","Error loading module ".$_." ...skipping");
|
|
print "Error loading module $_ ...skipping\n";
|
|
next;
|
|
}
|
|
no strict 'refs';
|
|
my $cmd_adds = ${ "xCAT_plugin::" . $modname . "::" }{handled_commands}->();
|
|
foreach (keys %$cmd_adds) {
|
|
my $value = $_;
|
|
if (defined($cmd_handlers{$_})) {
|
|
push @{ $cmd_handlers{$_} }, [ $modname, $cmd_adds->{$_} ];
|
|
} else {
|
|
$cmd_handlers{$_} = [ [ $modname, $cmd_adds->{$_} ] ];
|
|
}
|
|
}
|
|
}
|
|
foreach (@plugins) {
|
|
no strict 'refs';
|
|
/.*\/([^\/]*).pm$/;
|
|
my $modname = $1;
|
|
unless (defined(${ "xCAT_plugin::" . $modname . "::" }{init_plugin})) {
|
|
next;
|
|
}
|
|
${ "xCAT_plugin::" . $modname . "::" }{init_plugin}->(\&do_request);
|
|
}
|
|
}
|
|
|
|
|
|
|
|
|
|
###################################
|
|
# plugin_command
|
|
# will invoke the correct plugin
|
|
#
|
|
# NOTE: This is copied from xcatd (last merge 11/23/09).
|
|
# TODO: Will eventually move to using common source....
|
|
###################################
|
|
sub plugin_command {
|
|
my $req = shift;
|
|
my $sock = shift;
|
|
my $callback = shift;
|
|
my %handler_hash;
|
|
my $usesiteglobal = 0;
|
|
|
|
# We require these only in bypass mode to reduce start up time for the normal case
|
|
#use lib "$::XCATROOT/lib/perl";
|
|
#use xCAT::NodeRange;
|
|
require lib;
|
|
lib->import("$::XCATROOT/lib/perl");
|
|
require xCAT::NodeRange;
|
|
require xCAT::Table;
|
|
|
|
$Main::resps = {};
|
|
my $xmlreq;
|
|
if (ref($req) ne 'HASH') { # the request XML, get an array
|
|
$xmlreq = $req; # save the original XML
|
|
$req = XMLin($xmlreq, SuppressEmpty => undef, ForceArray => 1);
|
|
|
|
}
|
|
my @nodes;
|
|
if ($req->{node}) {
|
|
@nodes = @{ $req->{node} };
|
|
} elsif ($req->{noderange} and $req->{noderange}->[0]) {
|
|
@nodes = xCAT::NodeRange::noderange($req->{noderange}->[0]);
|
|
if (xCAT::NodeRange::nodesmissed()) {
|
|
|
|
# my $rsp = {errorcode=>1,error=>"Invalid nodes in noderange:".join(',',xCAT::NodeRange::nodesmissed)};
|
|
# my $rsp->{serverdone} = {};
|
|
print "Invalid nodes in noderange:" . join(',', xCAT::NodeRange::nodesmissed()) . "\n";
|
|
|
|
# if ($sock) {
|
|
# print $sock XMLout($rsp,RootName=>'xcatresponse' ,NoAttr=>1);
|
|
# }
|
|
# return ($rsp);
|
|
return 1;
|
|
}
|
|
unless (@nodes) {
|
|
$req->{emptynoderange} = [1];
|
|
}
|
|
}
|
|
if (@nodes) { $req->{node} = \@nodes; }
|
|
my %unhandled_nodes;
|
|
foreach (@nodes) {
|
|
$unhandled_nodes{$_} = 1;
|
|
}
|
|
my $useunhandled = 0;
|
|
if (defined($cmd_handlers{ $req->{command}->[0] })) {
|
|
my $hdlspec;
|
|
my @globalhandlers = ();
|
|
my $useglobals = 1; #If it stays 1, then use globals normally, if 0, use only for 'unhandled_nodes, if -1, don't do at all
|
|
foreach (@{ $cmd_handlers{ $req->{command}->[0] } }) {
|
|
$hdlspec = $_->[1];
|
|
my $ownmod = $_->[0];
|
|
if ($hdlspec =~ /^site:/) { #A site entry specifies a plugin
|
|
my $sitekey = $hdlspec;
|
|
$sitekey =~ s/^site://;
|
|
|
|
#$sitetab = xCAT::Table->new('site');
|
|
#my $sent = $sitetab->getAttribs({key=>$sitekey},['value']);
|
|
#if ($sent and $sent->{value}) { #A site style plugin specification is just like
|
|
if ($::XCATSITEVALS{$sitekey}) { #A site style plugin specification is just like
|
|
#a static global, it grabs all nodes rather than some
|
|
$useglobals = -1; #If they tried to specify anything, don't use the default global handlers at all
|
|
unless (@nodes) {
|
|
$handler_hash{ $::XCATSITEVALS{$sitekey} } = 1;
|
|
$usesiteglobal = 1;
|
|
}
|
|
foreach (@nodes) { #Specified a specific plugin, not a table lookup
|
|
$handler_hash{ $::XCATSITEVALS{$sitekey} }->{$_} = 1;
|
|
}
|
|
}
|
|
} elsif ($hdlspec =~ /:/) { #Specificed a table lookup path for plugin name
|
|
if (@nodes) { # only use table lookup plugin if nodelist exists
|
|
# Usage will be handled in common AAAhelp plugin
|
|
|
|
$useglobals = 0; #Only contemplate nodes that aren't caught through searching below in the global handler
|
|
$useunhandled = 1;
|
|
my $table;
|
|
my $cols;
|
|
($table, $cols) = split(/:/, $hdlspec);
|
|
my @colmns = split(/,/, $cols);
|
|
my @columns;
|
|
my $hdlrtable = xCAT::Table->new($table);
|
|
unless ($hdlrtable) {
|
|
|
|
#TODO: proper error handling
|
|
}
|
|
my $node;
|
|
my $colvals = {};
|
|
foreach my $colu (@colmns) {
|
|
if ($colu =~ /=/) { #a value redirect to a pattern/specific name
|
|
my $coln; my $colv;
|
|
($coln, $colv) = split(/=/, $colu, 2);
|
|
$colvals->{$coln} = $colv;
|
|
push(@columns, $coln);
|
|
} else {
|
|
push(@columns, $colu);
|
|
}
|
|
}
|
|
|
|
|
|
unless (@nodes) { #register the plugin in the event of usage
|
|
$handler_hash{$ownmod} = 1;
|
|
$useglobals = 1;
|
|
}
|
|
my $hdlrcache;
|
|
if ($hdlrtable) {
|
|
$hdlrcache = $hdlrtable->getNodesAttribs(\@nodes, \@columns);
|
|
}
|
|
foreach $node (@nodes) {
|
|
unless ($hdlrcache) { next; }
|
|
my $attribs = $hdlrcache->{$node}->[0]; #$hdlrtable->getNodeAttribs($node,\@columns);
|
|
unless (defined($attribs)) { next; }
|
|
foreach (@columns) {
|
|
my $col = $_;
|
|
if (defined($attribs->{$col})) {
|
|
if ($colvals->{$col}) { #A pattern match style request.
|
|
if ($attribs->{$col} =~ /$colvals->{$col}/) {
|
|
$handler_hash{$ownmod}->{$node} = 1;
|
|
delete $unhandled_nodes{$node};
|
|
last;
|
|
}
|
|
} else {
|
|
|
|
# call the plugin that matches the table value for that node
|
|
if ($attribs->{$col} =~ /$ownmod/) {
|
|
$handler_hash{ $attribs->{$col} }->{$node} = 1;
|
|
delete $unhandled_nodes{$node};
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
$hdlrtable->close;
|
|
} # end if (@nodes)
|
|
|
|
} else {
|
|
push @globalhandlers, $hdlspec;
|
|
}
|
|
}
|
|
if ($useglobals == 1) { #Behavior when globals have not been overriden
|
|
my $hdlspec;
|
|
foreach $hdlspec (@globalhandlers) {
|
|
unless (@nodes) {
|
|
$handler_hash{$hdlspec} = 1;
|
|
}
|
|
foreach (@nodes) { #Specified a specific plugin, not a table lookup
|
|
$handler_hash{$hdlspec}->{$_} = 1;
|
|
}
|
|
}
|
|
} elsif ($useglobals == 0) {
|
|
unless (@nodes or $usesiteglobal) { #if something like 'makedhcp -n',
|
|
foreach (keys %handler_hash) {
|
|
if ($handler_hash{$_} == 1) {
|
|
delete($handler_hash{$_})
|
|
}
|
|
}
|
|
}
|
|
foreach $hdlspec (@globalhandlers) {
|
|
unless (@nodes or $usesiteglobal) {
|
|
$handler_hash{$hdlspec} = 1;
|
|
}
|
|
foreach (keys %unhandled_nodes) { #Specified a specific plugin, not a table lookup
|
|
$handler_hash{$hdlspec}->{$_} = 1;
|
|
}
|
|
}
|
|
} #Otherwise, global handler is implicitly disabled
|
|
} else {
|
|
print "Error request: $req->{command}->[0] has no known plugin for it.\n";
|
|
return 1;
|
|
}
|
|
if ($useunhandled) {
|
|
my $queuelist;
|
|
foreach (@{ $cmd_handlers{ $req->{command}->[0] } }) {
|
|
my $queueitem = $_->[1];
|
|
if (($queueitem =~ /:/) and !($queuelist =~ /($queueitem)/)) {
|
|
$queuelist .= "$_->[1];";
|
|
}
|
|
}
|
|
$queuelist =~ s/;$//;
|
|
$queuelist =~ s/:/./g;
|
|
foreach (keys %unhandled_nodes) {
|
|
|
|
# if ($sock) {
|
|
# print $sock XMLout({node=>[{name=>[$_],data=>["Unable to identify plugin for this command, check relevant tables: $queuelist"],errorcode=>[1]}]},NoAttr=>1,RootName=>'xcatresponse');
|
|
# } else {
|
|
my $tabdesc = $queuelist;
|
|
$tabdesc =~ s/=.*$//;
|
|
$callback->({ node => [ { name => [$_], error => [ 'Unable to identify plugin for this command, check relevant tables: ' . $tabdesc ], errorcode => [1] } ] });
|
|
|
|
# }
|
|
}
|
|
}
|
|
|
|
## FOR NOW, DON'T FORK CHILD PROCESS TO MAKE BYPASS SIMPLER AND EASIER TO DEBUG
|
|
# $plugin_numchildren=0;
|
|
# %plugin_children=();
|
|
# $SIG{CHLD} = \&plugin_reaper; #sub {my $plugpid; while (($plugpid = waitpid(-1, WNOHANG)) > 0) { if ($plugin_children{$plugpid}) { delete $plugin_children{$plugpid}; $plugin_numchildren--; } } };
|
|
# my $check_fds;
|
|
# if ($sock) {
|
|
# $check_fds = new IO::Select;
|
|
# }
|
|
foreach (keys %handler_hash) {
|
|
my $modname = $_;
|
|
|
|
# my $shouldbealivepid=$$;
|
|
if (-r $plugins_dir . "/" . $modname . ".pm") {
|
|
require $plugins_dir . "/" . $modname . ".pm";
|
|
|
|
# $plugin_numchildren++;
|
|
# my $pfd; #will be referenced for inter-process messaging.
|
|
# my $parfd; #not causing a problem that I discern yet, but theoretically
|
|
# my $child;
|
|
# if ($sock) { #If $sock not passed in, don't fork..
|
|
# socketpair($pfd, $parfd,AF_UNIX,SOCK_STREAM,PF_UNSPEC) or die "socketpair: $!";
|
|
# #pipe($pfd,$cfd);
|
|
# $parfd->autoflush(1);
|
|
# $pfd->autoflush(1);
|
|
# $child = xCAT::Utils->xfork;
|
|
# } else {
|
|
# $child = 0;
|
|
# }
|
|
# unless (defined $child) { die "Fork failed"; }
|
|
# if ($child == 0) {
|
|
# if ($parfd) { #If xCAT is doing multiple requests in same communication PID, things would get unfortunate otherwise
|
|
# $parent_fd = $parfd;
|
|
# }
|
|
my $oldprogname = $$progname;
|
|
$$progname = $oldprogname . ": $modname instance";
|
|
|
|
# if ($sock) { close $pfd; }
|
|
unless ($handler_hash{$_} == 1) {
|
|
my @nodes = sort { ($a =~ /(\d+)/)[0] <=> ($b =~ /(\d+)/)[0] || $a cmp $b } (keys %{ $handler_hash{$_} });
|
|
$req->{node} = \@nodes;
|
|
}
|
|
no strict "refs";
|
|
|
|
# eval { #REMOVEEVALFORDEBUG
|
|
# if ($dispatch_requests) {
|
|
# backup the original req and recover it after the a run
|
|
my $org_req = {%$req};
|
|
dispatch_request($req, $callback, $modname);
|
|
$req = {%$org_req};
|
|
|
|
# } else {
|
|
# $SIG{CHLD}='DEFAULT';
|
|
# ${"xCAT_plugin::".$modname."::"}{process_request}->($req,$callback,\&do_request);
|
|
# }
|
|
$$progname = $oldprogname;
|
|
|
|
# if ($sock) {
|
|
# close($parent_fd);
|
|
# xexit(0);
|
|
# }
|
|
# }; #REMOVEEVALFORDEBUG
|
|
# if ($sock or $shouldbealivepid != $$) { #We shouldn't still be alive, try to send as much detail to parent as possible as to why
|
|
# my $error= "$modname plugin bug, pid $$, process description: '$$progname'";
|
|
# if ($@) {
|
|
# $error .= " with error '$@'";
|
|
# } else { #Sys::Virt and perhaps Net::SNMP sometimes crashes in a way $@ won't catch..
|
|
# $error .= " with missing eval error, probably due to special manipulation of $@ or strange circumstances in an XS library, remove evals in xcatd marked 'REMOVEEVALFORDEBUG and run xcatd -f for more info";
|
|
# }
|
|
# if (scalar (@nodes)) { #Don't know which of the nodes, so one error message warning about the possibliity..
|
|
# $error .= " while trying to fulfill request for the following nodes: ".join(",",@nodes);
|
|
# }
|
|
# xCAT::MsgUtils->message("S","xcatd: $error");
|
|
# $callback->({error=>[$error],errorcode=>[1]});
|
|
# xexit(0); #Die like we should have done
|
|
# } elsif ($@) { #We are still alive, should be alive, but yet we have an error. This means we are in the case of 'do_request' or something similar. Forward up the death since our communication channel is intact..
|
|
# die $@;
|
|
# }
|
|
# } else {
|
|
# $plugin_children{$child}=1;
|
|
# close $parfd;
|
|
# $check_fds->add($pfd);
|
|
# }
|
|
} else {
|
|
my $pm_name = $plugins_dir . "/" . $modname . ".pm";
|
|
foreach my $node (keys %{ $handler_hash{$_} }) {
|
|
if ($sock) {
|
|
print $sock XMLout({ node => [ { name => [$node], data => ["Cannot find the perl module to complete the operation: $pm_name"], errorcode => [1] } ] }, NoAttr => 1, RootName => 'xcatresponse');
|
|
} else {
|
|
$callback->({ node => [ { name => [$node], data => ["Cannot find the perl module to complete the operation: $pm_name"], errorcode => [1] } ] });
|
|
}
|
|
}
|
|
}
|
|
}
|
|
unless ($sock) { return $Main::resps }
|
|
|
|
# while (($plugin_numchildren > 0) and ($check_fds->count > 0)) { #this tracks end of useful data from children much more closely
|
|
# relay_fds($check_fds,$sock);
|
|
# }
|
|
# #while (relay_fds($check_fds,$sock)) {}
|
|
# my %done;
|
|
# $done{serverdone} = {};
|
|
# if ($req->{transid}) {
|
|
# $done{transid}=$req->{transid}->[0];
|
|
# }
|
|
# if ($sock) {
|
|
# my $clientpresence = new IO::Select; #The client may have gone away without confirmation, don't PIPE over this trivial thing
|
|
# $clientpresence->add($sock);
|
|
# if ($clientpresence->can_write(5)) {
|
|
# print $sock XMLout(\%done,RootName => 'xcatresponse',NoAttr=>1);
|
|
# }
|
|
# }
|
|
}
|
|
|
|
|
|
|
|
|
|
###################################
|
|
# dispatch_request
|
|
# dispatch the requested command
|
|
#
|
|
# NOTE: This is copied from xcatd (last merge 11/23/09).
|
|
# All we really need from this subroutine is to call preprocess_request
|
|
# and to only run the command for nodes handled by the local server
|
|
# Will eventually move to using common source....
|
|
###################################
|
|
sub dispatch_request {
|
|
|
|
# %dispatched_children=();
|
|
require xCAT::Utils;
|
|
my $req = shift;
|
|
$dispatch_cb = shift;
|
|
|
|
my $modname = shift;
|
|
my $reqs = [];
|
|
|
|
# my $child_fdset = new IO::Select;
|
|
no strict "refs";
|
|
|
|
#Hierarchy support. Originally, the default scope for noderange commands was
|
|
#going to be the servicenode associated unless overriden.
|
|
#However, assume for example that you have blades and a blade is the service node
|
|
#rpower being executed by the servicenode for one of its subnodes would have to
|
|
#reach it's own management module. This has the potential to be non-trivial for some quite possible network configurations.
|
|
#Since plugins may commonly experience this, a preprocess_request implementation
|
|
#will for now be required for a command to be scaled through service nodes
|
|
#If the plugin offers a preprocess method, use it to set the request array
|
|
if (defined(${ "xCAT_plugin::" . $modname . "::" }{preprocess_request})) {
|
|
$SIG{CHLD} = 'DEFAULT';
|
|
$reqs = ${ "xCAT_plugin::" . $modname . "::" }{preprocess_request}->($req, $dispatch_cb, \&do_request);
|
|
} else { #otherwise, pass it in without hierarchy support
|
|
$reqs = [$req];
|
|
}
|
|
|
|
# $dispatch_children=0;
|
|
# $SIG{CHLD} = \&dispatch_reaper; #sub {my $cpid; while (($cpid =waitpid(-1, WNOHANG)) > 0) { if ($dispatched_children{$cpid}) { delete $dispatched_children{$cpid}; $dispatch_children--; } } };
|
|
my $onlyone = 0;
|
|
if (defined $reqs and (scalar(@{$reqs}) == 1)) {
|
|
$onlyone = 1;
|
|
}
|
|
|
|
foreach (@{$reqs}) {
|
|
|
|
# my $pfd;
|
|
# my $parfd; #use a private variable so it won't trounce itself recursively
|
|
# my $child;
|
|
delete $_->{noderange};
|
|
|
|
#----- added to Client.pm -----#
|
|
if ($_->{node}) {
|
|
$_->{noderange}->[0] = join(',', @{ $_->{node} });
|
|
}
|
|
|
|
#----- end added to Client.pm -----#
|
|
|
|
if (ref $_->{'_xcatdest'} and (ref $_->{'_xcatdest'}) eq 'ARRAY') {
|
|
$_->{'_xcatdest'} = $_->{'_xcatdest'}->[0];
|
|
}
|
|
if ($onlyone and not($_->{'_xcatdest'} and xCAT::NetworkUtils->thishostisnot($_->{'_xcatdest'}))) {
|
|
$SIG{CHLD} = 'DEFAULT';
|
|
${ "xCAT_plugin::" . $modname . "::" }{process_request}->($_, $dispatch_cb, \&do_request);
|
|
return;
|
|
}
|
|
|
|
# socketpair($pfd, $parfd,AF_UNIX,SOCK_STREAM,PF_UNSPEC) or die "socketpair: $!";
|
|
# $parfd->autoflush(1);
|
|
# $pfd->autoflush(1);
|
|
# $child = xCAT::Utils->xfork;
|
|
# if ($child) {
|
|
# $dispatch_children++;
|
|
# $dispatched_children{$child}=1;
|
|
# $child_fdset->add($pfd);
|
|
# next;
|
|
# }
|
|
# unless (defined $child) {
|
|
# $dispatch_cb->({error=>['Fork failure dispatching request'],errorcode=>[1]});
|
|
# }
|
|
# undef $SIG{CHLD};
|
|
# $dispatch_parentfd = $parfd;
|
|
my @prexcatdests = ();
|
|
my @xcatdests = ();
|
|
if (ref($_->{'_xcatdest'}) eq 'ARRAY') { #If array, consider it an 'anycast' operation, broadcast done through dupe
|
|
#requests, or an alternative join '&' maybe?
|
|
@prexcatdests = @{ $_->{'_xcatdest'} };
|
|
} else {
|
|
@prexcatdests = ($_->{'_xcatdest'});
|
|
}
|
|
foreach (@prexcatdests) {
|
|
if ($_ and /,/) {
|
|
push @xcatdests, split /,/, $_;
|
|
} else {
|
|
push @xcatdests, $_;
|
|
}
|
|
}
|
|
my $xcatdest;
|
|
my $numdests = scalar(@xcatdests);
|
|
my $request_satisfied = 0;
|
|
foreach $xcatdest (@xcatdests) {
|
|
my $dlock;
|
|
if ($xcatdest and xCAT::NetworkUtils->thishostisnot($xcatdest)) {
|
|
|
|
#----- added to Client.pm -----#
|
|
$dispatch_cb->({ warning => [ 'XCATBYPASS is set, skipping hierarchy call to ' . $_->{'_xcatdest'} . '' ] });
|
|
|
|
#----- end added to Client.pm -----#
|
|
|
|
# #mkpath("/var/lock/xcat/"); #For now, limit intra-xCAT requests to one at a time, to mitigate DB handle usage
|
|
# #open($dlock,">","/var/lock/xcat/dispatchto_$xcatdest");
|
|
# #flock($dlock,LOCK_EX);
|
|
# $ENV{XCATHOST} = ($xcatdest =~ /:/ ? $xcatdest : $xcatdest.":3001" );
|
|
# $$progname.=": connection to ".$ENV{XCATHOST};
|
|
# my $errstr;
|
|
# eval {
|
|
# undef $_->{'_xcatdest'};
|
|
# xCAT::Client::submit_request($_,\&dispatch_callback,$xcatdir."/cert/server-cred.pem",$xcatdir."/cert/server-cred.pem",$xcatdir."/cert/ca.pem");
|
|
# };
|
|
# if ($@) {
|
|
# $errstr=$@;
|
|
# }
|
|
# #unlink("/var/lock/xcat/dispatchto_$xcatdest");
|
|
# #flock($dlock,LOCK_UN);
|
|
# if ($errstr) {
|
|
# if ($numdests == 1) {
|
|
# dispatch_callback({error=>["Unable to dispatch command to ".$ENV{XCATHOST}.", command will not make changes to that server ($errstr)"],errorcode=>[1]});
|
|
# xCAT::MsgUtils->message("S","Error dispatching request to ".$ENV{XCATHOST}.": ".$errstr);
|
|
# } else {
|
|
# xCAT::MsgUtils->message("S","Error dispatching request to ".$ENV{XCATHOST}.", trying other service nodes: ".$errstr);
|
|
# }
|
|
# next;
|
|
# } else {
|
|
# $request_satisfied=1;
|
|
# last;
|
|
# }
|
|
} else {
|
|
$$progname .= ": locally executing";
|
|
$SIG{CHLD} = 'DEFAULT';
|
|
|
|
# ${"xCAT_plugin::".$modname."::"}{process_request}->($_,\&dispatch_callback,\&do_request);
|
|
#----- changed in Client.pm -----#
|
|
${ "xCAT_plugin::" . $modname . "::" }{process_request}->($_, $dispatch_cb, \&do_request);
|
|
|
|
#----- end changed in Client.pm -----#
|
|
last;
|
|
}
|
|
}
|
|
|
|
# if ($numdests > 1 and not $request_satisfied) {
|
|
# xCAT::MsgUtils->message("S","Error dispatching a request to all possible service nodes for request");
|
|
# dispatch_callback({error=>["Failed to dispatch command to any of the following service nodes: ".join(",",@xcatdests)],errorcode=>[1]});
|
|
# }
|
|
|
|
# xexit;
|
|
}
|
|
|
|
#while (($dispatch_children > 0) and ($child_fdset->count > 0)) { relay_dispatch($child_fdset) }
|
|
#while (relay_dispatch($child_fdset)) { } #Potentially useless drain.
|
|
}
|
|
|
|
|
|
|
|
###################################
|
|
# do_request
|
|
# called from a plugin to execute another xCAT plugin command internally
|
|
#
|
|
# NOTE: This is copied from xcatd (last merge 11/23/09).
|
|
# Will eventually move to using common source....
|
|
###################################
|
|
sub do_request {
|
|
my $req = shift;
|
|
my $second = shift;
|
|
my $rsphandler = \&build_response;
|
|
my $sock = undef;
|
|
if ($second) {
|
|
if (ref($second) eq "CODE") {
|
|
$rsphandler = $second;
|
|
} elsif (ref($second) eq "GLOB") {
|
|
$sock = $second;
|
|
}
|
|
}
|
|
|
|
#my $sock = shift; #If no sock, will return a response hash
|
|
if ($cmd_handlers{ $req->{command}->[0] }) {
|
|
return plugin_command($req, $sock, $rsphandler);
|
|
} elsif ($req->{command}->[0] eq "noderange" and $req->{noderange}) {
|
|
my @nodes = xCAT::NodeRange::noderange($req->{noderange}->[0]);
|
|
my %resp;
|
|
if (xCAT::NodeRange::nodesmissed()) {
|
|
$resp{warning} = "Invalid nodes in noderange:" . join ',', xCAT::NodeRange::nodesmissed() . "\n";
|
|
}
|
|
$resp{serverdone} = {};
|
|
@{ $resp{node} } = @nodes;
|
|
if ($req->{transid}) {
|
|
$resp{transid} = $req->{transid}->[0];
|
|
}
|
|
if ($sock) {
|
|
print $sock XMLout(\%resp, RootName => 'xcatresponse', NoAttr => 1);
|
|
} else {
|
|
return (\%resp);
|
|
}
|
|
} else {
|
|
my %resp = (error => "Unsupported request");
|
|
$resp{serverdone} = {};
|
|
if ($req->{transid}) {
|
|
$resp{transid} = $req->{transid}->[0];
|
|
}
|
|
if ($sock) {
|
|
print $sock XMLout(\%resp, RootName => 'xcatresponse', NoAttr => 1);
|
|
} else {
|
|
return (\%resp);
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
###################################
|
|
# build_response
|
|
# This callback handles responses from nested level plugin calls.
|
|
# It builds a merged hash of all responses that gets passed back
|
|
# to the calling plugin.
|
|
# Note: Need to create a "deep clone" of this response to add to the
|
|
# return, otherwise next time through the referenced data is overwritten
|
|
#
|
|
###################################
|
|
sub build_response {
|
|
my $rsp = shift;
|
|
require Storable;
|
|
foreach (keys %$rsp) {
|
|
my $subresp = Storable::dclone($rsp->{$_});
|
|
push(@{ $Main::resps->{$_} }, @{$subresp});
|
|
}
|
|
}
|
|
|
|
|
|
|
|
} # end of submit_request()
|
|
|
|
####################################
|
|
# populates all the site attributes into %::XCATSITEVALS
|
|
# This is used with XCATBYPASS=1
|
|
###################################
|
|
sub populate_site_hash {
|
|
%::XCATSITEVALS = ();
|
|
my $sitetab = xCAT::Table->new('site', -create => 0);
|
|
unless ($sitetab) {
|
|
print("ERROR: Unable to open basic site table for configuration\n");
|
|
return;
|
|
}
|
|
my @records = $sitetab->getAllAttribs(qw/key value/);
|
|
foreach (@records) {
|
|
$::XCATSITEVALS{ $_->{key} } = $_->{value};
|
|
}
|
|
}
|
|
|
|
|
|
|
|
##########################################
|
|
# handle_response is a default callback that can be passed into submit_request()
|
|
# It is invoked repeatedly by submit_request() to print out the data returned by
|
|
# the plugin.
|
|
#
|
|
# The normal flow is:
|
|
# -> client cmd (e.g. nodels, which is just a link to xcatclient)
|
|
# -> xcatclient
|
|
# -> submit_request()
|
|
# -> send xml request to xcatd
|
|
# -> xcatd
|
|
# -> process_request() of the plugin
|
|
# <- plugin callback
|
|
# <- xcatd
|
|
# <- xcatd sends xml response to client
|
|
# <- submit_request() read response
|
|
# <- handle_response() prints responses and saves exit codes
|
|
# <- xcatclient gets exit code and exits
|
|
#
|
|
# But in XCATBYPASS mode, the flow is:
|
|
# -> client cmd (e.g. nodels, which is just a link to xcatclient)
|
|
# -> xcatclient
|
|
# -> submit_request()
|
|
# -> process_request() of the plugin
|
|
# <- handle_response() prints responses and saves exit codes
|
|
# <- xcatclient gets exit code and exits
|
|
#
|
|
# Format of the response hash:
|
|
# {data => [ 'data str1', 'data str2', '...' ] }
|
|
#
|
|
# Results are printed as:
|
|
# data str1
|
|
# data str2
|
|
#
|
|
# or:
|
|
# {data => [ {desc => [ 'desc1' ],
|
|
# contents => [ 'contents1' ] },
|
|
# {desc => [ 'desc2 ],
|
|
# contents => [ 'contents2' ] }
|
|
# :
|
|
# ] }
|
|
# NOTE: In this format, only the data array can have more than one
|
|
# element. All other arrays are assumed to be a single element.
|
|
# Results are printed as:
|
|
# desc1: contents1
|
|
# desc2: contents2
|
|
#
|
|
# or:
|
|
# {node => [ {name => ['node1'],
|
|
# data => [ {desc => [ 'node1 desc' ],
|
|
# contents => [ 'node1 contents' ] } ] },
|
|
# {name => ['node2'],
|
|
# data => [ {desc => [ 'node2 desc' ],
|
|
# contents => [ 'node2 contents' ] } ] },
|
|
# :
|
|
# ] }
|
|
# NOTE: Only the node array can have more than one element.
|
|
# All other arrays are assumed to be a single element.
|
|
#
|
|
# This was generated from the corresponding XML:
|
|
# <xcatrequest>
|
|
# <node>
|
|
# <name>node1</name>
|
|
# <data>
|
|
# <desc>node1 desc</desc>
|
|
# <contents>node1 contents</contents>
|
|
# </data>
|
|
# </node>
|
|
# <node>
|
|
# <name>node2</name>
|
|
# <data>
|
|
# <desc>node2 desc</desc>
|
|
# <contents>node2 contents</contents>
|
|
# </data>
|
|
# </node>
|
|
# </xcatrequest>
|
|
#
|
|
# Results are printed as:
|
|
# node_name: desc: contents
|
|
##########################################
|
|
sub handle_response {
|
|
my $rsp = shift;
|
|
if ($ENV{'XCATSHOWXML'}) {
|
|
my $xmlrec = XMLout($rsp, RootName => 'xcatresponse', NoAttr => 1, KeyAttr => []);
|
|
print "$xmlrec\n";
|
|
return;
|
|
}
|
|
|
|
my $msgsource = "";
|
|
if ($ENV{'XCATSHOWSVR'}) {
|
|
unless ($rsp->{NoSvrPrefix}) { # some plugins could disable the prefix forcely by seting the flag in response.
|
|
$msgsource = $rsp->{xcatdsource}->[0] if ($rsp->{xcatdsource});
|
|
}
|
|
}
|
|
if ($rsp->{host}) {
|
|
$msgsource = $rsp->{xcatdsource}->[0] if ($rsp->{xcatdsource});
|
|
}
|
|
|
|
#print "in handle_response\n";
|
|
# Handle errors
|
|
if (defined($rsp->{errorcode})) {
|
|
if (ref($rsp->{errorcode}) eq 'ARRAY') {
|
|
foreach my $ecode (@{ $rsp->{errorcode} }) {
|
|
$xCAT::Client::EXITCODE |= $ecode;
|
|
}
|
|
}
|
|
else {
|
|
$xCAT::Client::EXITCODE |= $rsp->{errorcode};
|
|
} # assume it is a non-reference scalar
|
|
}
|
|
|
|
if ($rsp->{error}) {
|
|
|
|
#print "printing error\n";
|
|
if (ref($rsp->{error}) eq 'ARRAY') {
|
|
foreach my $text (@{ $rsp->{error} }) {
|
|
my $desc = "$text";
|
|
$desc = "[$msgsource]: $desc" if ($msgsource && $desc);
|
|
$desc = "Error: $desc" unless ($rsp->{NoErrorPrefix});
|
|
print STDERR "$desc\n";
|
|
}
|
|
}
|
|
else {
|
|
my $desc = $rsp->{error};
|
|
$desc = "[$msgsource]: $desc" if ($msgsource && $desc);
|
|
$desc = "Error: $desc" unless ($rsp->{NoErrorPrefix});
|
|
print STDERR "$desc\n";
|
|
}
|
|
}
|
|
if ($rsp->{warning}) {
|
|
|
|
#print "printing warning\n";
|
|
if (ref($rsp->{warning}) eq 'ARRAY') {
|
|
foreach my $text (@{ $rsp->{warning} }) {
|
|
my $desc = "$text";
|
|
$desc = "[$msgsource]: $desc" if ($msgsource && $desc);
|
|
$desc = "Warning: $desc" unless ($rsp->{NoWarnPrefix});
|
|
print STDERR "$desc\n";
|
|
}
|
|
}
|
|
else {
|
|
my $desc = $rsp->{warning};
|
|
$desc = "[$msgsource]: $desc" if ($msgsource && $desc);
|
|
$desc = "Warning: $desc" unless ($rsp->{NoWarnPrefix});
|
|
print STDERR "$desc\n";
|
|
}
|
|
}
|
|
if ($rsp->{info}) {
|
|
#print "printing info\n";
|
|
if (ref($rsp->{info}) eq 'ARRAY') {
|
|
foreach my $text (@{ $rsp->{info} }) {
|
|
my $desc = "$text";
|
|
$desc = "[$msgsource]: $desc" if ($msgsource && $desc);
|
|
print "$desc\n";
|
|
}
|
|
}
|
|
else {
|
|
my $desc = $rsp->{info};
|
|
$desc = "[$msgsource]: $desc" if ($msgsource && $desc);
|
|
print "$desc\n";
|
|
}
|
|
}
|
|
|
|
if ($rsp->{sinfo}) {
|
|
if (ref($rsp->{sinfo}) eq 'ARRAY') {
|
|
foreach my $text (@{ $rsp->{sinfo} }) {
|
|
print "$text\r"; $|++;
|
|
}
|
|
}
|
|
else {
|
|
print($rsp->{sinfo} . "\r"); $|++;
|
|
}
|
|
}
|
|
|
|
|
|
|
|
# Handle {node} structure
|
|
my $errflg = 0;
|
|
my $nodes = ($rsp->{node});
|
|
unless (ref $nodes eq 'ARRAY') {
|
|
$nodes = [$nodes];
|
|
}
|
|
if (scalar @{$nodes}) {
|
|
|
|
#print "printing node\n";
|
|
my $node;
|
|
foreach $node (@$nodes) {
|
|
my $desc;
|
|
if (ref($node->{name}) eq 'ARRAY') {
|
|
$desc = $node->{name}->[0];
|
|
} else {
|
|
$desc = $node->{name};
|
|
}
|
|
if ($desc) {
|
|
$desc = "$desc: [$msgsource]" if ($msgsource);
|
|
} else {
|
|
$desc = "[$msgsource]" if ($msgsource);
|
|
}
|
|
if ($node->{errorcode}) {
|
|
if (ref($node->{errorcode}) eq 'ARRAY') {
|
|
foreach my $ecode (@{ $node->{errorcode} }) {
|
|
$xCAT::Client::EXITCODE |= $ecode;
|
|
}
|
|
}
|
|
else {
|
|
$xCAT::Client::EXITCODE |= $node->{errorcode};
|
|
} # assume it is a non-reference scalar
|
|
}
|
|
if ($node->{error}) {
|
|
$desc .= ": Error: " . $node->{error}->[0];
|
|
$errflg = 1;
|
|
}
|
|
if ($node->{warning}) {
|
|
$desc .= ": Warning: " . $node->{warning}->[0];
|
|
$errflg = 1;
|
|
}
|
|
if ($node->{data}) {
|
|
if (ref(\($node->{data})) eq 'SCALAR') {
|
|
$desc = $desc . ": " . $node->{data};
|
|
} elsif (ref($node->{data}) eq 'HASH') {
|
|
if ($node->{data}->{desc}) {
|
|
if (ref($node->{data}->{desc}) eq 'ARRAY') {
|
|
$desc = $desc . ": " . $node->{data}->{desc}->[0];
|
|
} else {
|
|
$desc = $desc . ": " . $node->{data}->{desc};
|
|
}
|
|
}
|
|
if ($node->{data}->{contents}) {
|
|
if (ref($node->{data}->{contents}) eq 'ARRAY') {
|
|
$desc = "$desc: " . $node->{data}->{contents}->[0];
|
|
} else {
|
|
$desc = "$desc: " . $node->{data}->{contents};
|
|
}
|
|
}
|
|
} elsif (ref(\($node->{data}->[0])) eq 'SCALAR') {
|
|
$desc = $desc . ": " . $node->{data}->[0];
|
|
} else {
|
|
if ($node->{data}->[0]->{desc}) {
|
|
$desc = $desc . ": " . $node->{data}->[0]->{desc}->[0];
|
|
}
|
|
if ($node->{data}->[0]->{contents}) {
|
|
$desc = "$desc: " . $node->{data}->[0]->{contents}->[0];
|
|
}
|
|
}
|
|
}
|
|
if ($node->{base64_data}) {
|
|
$desc = $desc . ": " . decode_base64($node->{base64_data}->[0]);
|
|
}
|
|
if ($desc && $desc ne "[$msgsource]") {
|
|
if ($errflg == 1) {
|
|
print STDERR ("$desc\n");
|
|
} else {
|
|
print "$desc\n";
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
# Handle {data} structure with no nodes
|
|
if ($rsp->{data}) {
|
|
|
|
#print "printing data\n";
|
|
my $data = ($rsp->{data});
|
|
my $data_entry;
|
|
foreach $data_entry (@$data) {
|
|
my $desc;
|
|
if (ref(\($data_entry)) eq 'SCALAR') {
|
|
$desc = $data_entry;
|
|
} else {
|
|
if ($data_entry->{desc}) {
|
|
$desc = $data_entry->{desc}->[0];
|
|
}
|
|
if ($data_entry->{contents}) {
|
|
if ($desc) {
|
|
$desc = "$desc: " . $data_entry->{contents}->[0];
|
|
} else {
|
|
$desc = $data_entry->{contents}->[0];
|
|
}
|
|
}
|
|
}
|
|
if ($desc) {
|
|
$desc = "[$msgsource]: $desc" if ($msgsource);
|
|
print "$desc\n";
|
|
}
|
|
}
|
|
}
|
|
} # end of handle_response
|
|
|
|
|
|
|
|
|
|
|
|
|