2007-10-26 22:44:33 +00:00
#!/usr/bin/env perl
# IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html
package xCAT::Client ;
2007-12-11 19:15:28 +00:00
BEGIN
{
2008-01-14 16:58:23 +00:00
$ ::XCATROOT = $ ENV { 'XCATROOT' } ? $ ENV { 'XCATROOT' } : - d '/opt/xcat' ? '/opt/xcat' : '/usr' ;
2008-03-24 16:14:59 +00:00
}
2007-12-03 12:53:41 +00:00
2009-07-28 17:29:16 +00:00
# if AIX - make sure we include perl 5.8.2 in INC path.
# Needed to find perl dependencies shipped in deps tarball.
if ( $^O =~ /^aix/i ) {
use lib "/usr/opt/perl5/lib/5.8.2/aix-thread-multi" ;
use lib "/usr/opt/perl5/lib/5.8.2" ;
use lib "/usr/opt/perl5/lib/site_perl/5.8.2/aix-thread-multi" ;
use lib "/usr/opt/perl5/lib/site_perl/5.8.2" ;
}
2008-03-10 18:05:26 +00:00
my $ inet6support ;
2009-06-02 11:38:34 +00:00
if ( $^O =~ /^aix/i ) { # disable AIX IPV6 TODO fix
2009-06-01 20:39:29 +00:00
$ inet6support = 0 ;
2009-06-02 18:39:33 +00:00
} else {
$ inet6support = eval { require Socket6 } ;
2009-06-01 20:39:29 +00:00
}
2008-03-10 18:05:26 +00:00
if ( $ inet6support ) {
$ inet6support = eval { require IO::Socket::INET6 } ;
}
if ( $ inet6support ) {
2009-05-29 13:53:49 +00:00
$ inet6support = eval { require IO::Socket::SSL ; IO::Socket::SSL - > import ( 'inet6' ) ; } ;
2008-03-10 18:05:26 +00:00
}
unless ( $ inet6support ) {
eval { require Socket } ;
eval { require IO::Socket::INET } ;
2009-05-29 13:53:49 +00:00
eval { require IO::Socket::SSL ; IO::Socket::SSL - > import ( ) } ;
2007-12-03 12:53:41 +00:00
}
2008-05-22 18:57:51 +00:00
2007-10-26 22:44:33 +00:00
use XML::Simple ;
2009-07-16 14:44:50 +00:00
$ XML:: Simple:: PREFERRED_PARSER = 'XML::Parser' ;
2008-04-05 14:53:35 +00:00
require Data::Dumper ;
2007-10-26 22:44:33 +00:00
use Storable qw( dclone ) ;
my $ xcathost = 'localhost:3001' ;
2007-12-03 20:29:30 +00:00
my $ plugins_dir ;
2007-10-26 22:44:33 +00:00
my % resps ;
2008-02-14 14:25:49 +00:00
my $ EXITCODE ; # save the bitmask of all exit codes returned by calls to handle_response()
2007-10-26 22:44:33 +00:00
1 ;
#################################
# submit_request will take an xCAT command and pass it to the xCAT
# server for execution.
2008-02-14 14:25:49 +00:00
#
2007-10-26 22:44:33 +00:00
# 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
2008-02-14 14:25:49 +00:00
# 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
2007-12-11 19:15:28 +00:00
# directory /opt/xcat/lib/perl/xCAT_plugin will be used.
2007-10-26 22:44:33 +00:00
#
# 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.
2008-02-14 14:25:49 +00:00
#
2007-10-26 22:44:33 +00:00
# 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
2008-02-14 14:25:49 +00:00
# and callback routines can access the data consistently.
2007-10-26 22:44:33 +00:00
# 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 ;
2008-01-25 15:07:53 +00:00
my $ keyfile = shift ;
my $ certfile = shift ;
my $ cafile = shift ;
2009-03-30 14:19:17 +00:00
require xCAT::Utils ;
unless ( $ keyfile ) { $ keyfile = xCAT::Utils - > getHomeDir ( ) . "/.xcat/client-cred.pem" ; }
unless ( $ certfile ) { $ certfile = xCAT::Utils - > getHomeDir ( ) . "/.xcat/client-cred.pem" ; }
unless ( $ cafile ) { $ cafile = xCAT::Utils - > getHomeDir ( ) . "/.xcat/ca.pem" ; }
2008-02-14 14:25:49 +00:00
$ xCAT:: Client:: EXITCODE = 0 ; # clear out exit code before invoking the plugin
2007-10-26 22:44:33 +00:00
2007-12-03 20:29:30 +00:00
2007-10-26 22:44:33 +00:00
# If XCATBYPASS is set, invoke the plugin process_request method directly
# without going through the socket connection to the xcatd daemon
if ( $ ENV { XCATBYPASS } ) {
# Load plugins from either specified or default dir
2008-04-17 12:46:39 +00:00
require xCAT::Table ;
2007-10-26 22:44:33 +00:00
my % cmd_handlers ;
my @ plugins_dirs = split ( '\:' , $ ENV { XCATBYPASS } ) ;
if ( - d $ plugins_dirs [ 0 ] ) {
foreach ( @ plugins_dirs ) {
$ plugins_dir = $ _ ;
scan_plugins ( ) ;
}
} else {
2007-12-03 20:29:30 +00:00
# figure out default plugins dir
my $ sitetab = xCAT::Table - > new ( 'site' ) ;
unless ( $ sitetab ) {
print ( "ERROR: Unable to open basic site table for configuration\n" ) ;
}
2007-12-11 19:15:28 +00:00
$ plugins_dir = $ ::XCATROOT . '/lib/perl/xCAT_plugin' ;
2007-10-26 22:44:33 +00:00
scan_plugins ( ) ;
}
# 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 } ;
}
2008-03-28 15:55:41 +00:00
my $ client ;
if ( - r $ keyfile and - r $ certfile and - r $ cafile ) {
$ client = IO::Socket::SSL - > new (
2007-10-26 22:44:33 +00:00
PeerAddr = > $ xcathost ,
2008-01-25 15:07:53 +00:00
SSL_key_file = > $ keyfile ,
SSL_cert_file = > $ certfile ,
SSL_ca_file = > $ cafile ,
2007-10-26 22:44:33 +00:00
SSL_use_cert = > 1 ,
2009-09-01 18:03:46 +00:00
Timeout = > 15 ,
2007-10-26 22:44:33 +00:00
) ;
2008-03-28 15:55:41 +00:00
} else {
$ client = IO::Socket::SSL - > new (
2009-09-01 18:03:46 +00:00
PeerAddr = > $ xcathost ,
Timeout = > 15 ,
2008-03-28 15:55:41 +00:00
) ;
}
unless ( $ client ) {
if ( $@ =~ /SSL Timeout/ ) {
die "Connection failure: SSL Timeout or incorrect certificates in ~/.xcat" ;
} else {
die "Connection failure: $@"
}
}
2008-04-14 13:55:17 +00:00
my $ msg = XMLout ( $ request , RootName = > 'xcatrequest' , NoAttr = > 1 , KeyAttr = > [] ) ;
2008-04-21 15:28:28 +00:00
$ SIG { TERM } = $ SIG { INT } = sub { print $ client XMLout ( { abortcommand = > 1 } , RootName = > 'xcatrequest' , NoAttr = > 1 , KeyAttr = > [] ) ; exit 0 ; } ;
2007-10-26 22:44:33 +00:00
print $ client $ msg ;
my $ response ;
my $ rsp ;
2008-04-25 21:09:18 +00:00
my $ cleanexit = 0 ;
2007-10-26 22:44:33 +00:00
while ( <$client> ) {
$ response . = $ _ ;
2009-08-09 15:58:41 +00:00
if ( m/<\/xcatresponse>/ ) {
2007-10-26 22:44:33 +00:00
$ rsp = XMLin ( $ response , SuppressEmpty = > undef , ForceArray = > 1 ) ;
$ response = '' ;
$ callback - > ( $ rsp ) ;
if ( $ rsp - > { serverdone } ) {
2008-04-25 21:09:18 +00:00
$ cleanexit = 1 ;
2007-10-26 22:44:33 +00:00
last ;
}
}
}
2008-04-25 21:09:18 +00:00
unless ( $ cleanexit ) {
print STDERR "ERROR/WARNING: communication with the xCAT server seems to have been ended prematurely\n" ;
}
2007-10-26 22:44:33 +00:00
###################################
# scan_plugins
2008-02-14 14:25:49 +00:00
# will load all plugin perl modules and build a list of supported
2007-10-26 22:44:33 +00:00
# commands
#
2008-05-22 18:57:51 +00:00
# NOTE: This is copied from xcatd (last merge 5/21/08).
# TODO: Will eventually move to using common source....
2007-10-26 22:44:33 +00:00
###################################
sub scan_plugins {
my @ plugins = glob ( $ plugins_dir . "/*.pm" ) ;
foreach ( @ plugins ) {
/.*\/([^\/]*).pm$/ ;
my $ modname = $ 1 ;
require "$_" ;
no strict 'refs' ;
my $ cmd_adds = $ { "xCAT_plugin::" . $ modname . "::" } { handled_commands } - > ( ) ;
foreach ( keys %$ cmd_adds ) {
my $ value = $ _ ;
if ( defined ( $ cmd_handlers { $ _ } ) ) {
my $ add = 1 ;
#This next bit of code iterates through the handlers.
#If the value doesn't contain an equal, and has an equivalent entry added by
# another plugin already, don't add (otherwise would hit the DB multiple times)
# a better idea, restructure the cmd_handlers as a multi-level hash
# prove out this idea real quick before doing that
foreach ( @ { $ cmd_handlers { $ _ } } ) {
if ( ( $ _ - > [ 1 ] eq $ cmd_adds - > { $ value } ) and ( ( $ cmd_adds - > { $ value } !~ /=/ ) or ( $ _ - > [ 0 ] eq $ modname ) ) ) {
$ add = 0 ;
}
}
if ( $ add ) { push @ { $ cmd_handlers { $ _ } } , [ $ modname , $ cmd_adds - > { $ _ } ] ; }
#die "Conflicting handler information from $modname";
} else {
$ cmd_handlers { $ _ } = [ [ $ modname , $ cmd_adds - > { $ _ } ] ] ;
}
}
}
}
###################################
# plugin_command
2008-02-14 14:25:49 +00:00
# will invoke the correct plugin
2007-10-26 22:44:33 +00:00
#
2008-05-22 18:57:51 +00:00
# NOTE: This is copied from xcatd (last merge 5/21/08).
# TODO: Will eventually move to using common source....
2007-10-26 22:44:33 +00:00
###################################
sub plugin_command {
my $ req = shift ;
my $ sock = shift ;
my $ callback = shift ;
my % handler_hash ;
2008-04-17 12:46:39 +00:00
# We require these only in bypass mode to reduce start up time for the normal case
#use lib "$::XCATROOT/lib/perl";
2008-03-27 15:32:21 +00:00
#use xCAT::NodeRange;
2008-04-17 12:46:39 +00:00
require lib ;
lib - > import ( "$::XCATROOT/lib/perl" ) ;
require xCAT::NodeRange ;
require xCAT::Table ;
2007-10-26 22:44:33 +00:00
$ Main:: resps = { } ;
my @ nodes ;
if ( $ req - > { node } ) {
@ nodes = @ { $ req - > { node } } ;
2008-05-22 18:57:51 +00:00
} elsif ( $ req - > { noderange } and $ req - > { noderange } - > [ 0 ] ) {
2008-04-05 14:53:35 +00:00
@ nodes = xCAT::NodeRange:: noderange ( $ req - > { noderange } - > [ 0 ] ) ;
if ( xCAT::NodeRange:: nodesmissed ( ) ) {
# my $rsp = {errorcode=>1,error=>"Invalid nodes in noderange:".join(',',xCAT::NodeRange::nodesmissed)};
2009-03-25 14:31:39 +00:00
# my $rsp->{serverdone} = {};
2009-07-15 19:33:01 +00:00
print "Invalid nodes in noderange:" . join ( ',' , xCAT::NodeRange:: nodesmissed ( ) ) . "\n" ;
2007-10-26 22:44:33 +00:00
# if ($sock) {
# print $sock XMLout($rsp,RootName=>'xcatresponse' ,NoAttr=>1);
# }
# return ($rsp);
return 1 ;
}
2008-05-22 18:57:51 +00:00
unless ( @ nodes ) {
$ req - > { emptynoderange } = [ 1 ] ;
}
2007-10-26 22:44:33 +00:00
}
if ( @ nodes ) { $ req - > { node } = \ @ nodes ; }
2008-05-22 18:57:51 +00:00
my % unhandled_nodes ;
foreach ( @ nodes ) {
$ unhandled_nodes { $ _ } = 1 ;
}
my $ useunhandled = 0 ;
2007-10-26 22:44:33 +00:00
if ( defined ( $ cmd_handlers { $ req - > { command } - > [ 0 ] } ) ) {
my $ hdlspec ;
foreach ( @ { $ cmd_handlers { $ req - > { command } - > [ 0 ] } } ) {
$ hdlspec = $ _ - > [ 1 ] ;
my $ ownmod = $ _ - > [ 0 ] ;
if ( $ hdlspec =~ /:/ ) { #Specificed a table lookup path for plugin name
2008-05-22 18:57:51 +00:00
$ useunhandled = 1 ;
2007-10-26 22:44:33 +00:00
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 ) ;
}
}
2008-05-22 18:57:51 +00:00
unless ( @ nodes ) { #register the plugin in the event of usage
$ handler_hash { $ ownmod } = 1 ;
}
2007-10-26 22:44:33 +00:00
foreach $ node ( @ nodes ) {
my $ attribs = $ hdlrtable - > getNodeAttribs ( $ node , \ @ columns ) ;
unless ( defined ( $ attribs ) ) { next ; } #TODO: This really ought to craft an unsupported response for this request
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 ;
2008-05-22 18:57:51 +00:00
delete $ unhandled_nodes { $ node } ;
2007-10-26 22:44:33 +00:00
last ;
}
} else {
$ handler_hash { $ attribs - > { $ col } } - > { $ node } = 1 ;
2008-05-22 18:57:51 +00:00
delete $ unhandled_nodes { $ node } ;
2007-10-26 22:44:33 +00:00
last ;
}
}
}
}
2008-05-22 18:57:51 +00:00
$ hdlrtable - > close ;
2007-10-26 22:44:33 +00:00
} else {
unless ( @ nodes ) {
$ handler_hash { $ hdlspec } = 1 ;
}
foreach ( @ nodes ) { #Specified a specific plugin, not a table lookup
$ handler_hash { $ hdlspec } - > { $ _ } = 1 ;
}
}
}
} else {
print "$req->{command}->[0] xCAT command not found \n" ;
return 1 ; #TODO: error back that request has no known plugin for it
}
2008-05-22 18:57:51 +00:00
if ( $ useunhandled ) {
my $ queuelist ;
foreach ( @ { $ cmd_handlers { $ req - > { command } - > [ 0 ] } - > [ 0 ] } ) {
unless ( /:/ ) {
next ;
}
$ queuelist . = "$_," ;
}
$ 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 {
$ callback - > ( { node = > [ { name = > [ $ _ ] , data = > [ 'Unable to identify plugin for this command, check relevant tables' ] , errorcode = > [ 1 ] } ] } ) ;
# }
}
}
2007-10-26 22:44:33 +00:00
## FOR NOW, DON'T FORK CHILD PROCESS TO MAKE BYPASS SIMPLER AND EASIER TO DEBUG
2008-05-22 18:57:51 +00:00
# $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--; } } };
2007-10-26 22:44:33 +00:00
# my $check_fds;
# if ($sock) {
# $check_fds = new IO::Select;
# }
foreach ( keys % handler_hash ) {
my $ modname = $ _ ;
if ( - r $ plugins_dir . "/" . $ modname . ".pm" ) {
require $ plugins_dir . "/" . $ modname . ".pm" ;
2008-05-22 18:57:51 +00:00
# $plugin_numchildren++;
2007-10-26 22:44:33 +00:00
# my $pfd; #will be referenced for inter-process messaging.
2008-05-22 18:57:51 +00:00
# my $parfd; #not causing a problem that I discern yet, but theoretically
2007-10-26 22:44:33 +00:00
# my $child;
# if ($sock) { #If $sock not passed in, don't fork..
2008-05-22 18:57:51 +00:00
# socketpair($pfd, $parfd,AF_UNIX,SOCK_STREAM,PF_UNSPEC) or die "socketpair: $!";
2007-10-26 22:44:33 +00:00
# #pipe($pfd,$cfd);
2008-05-22 18:57:51 +00:00
# $parfd->autoflush(1);
2007-10-26 22:44:33 +00:00
# $pfd->autoflush(1);
2008-05-22 18:57:51 +00:00
# $child = xCAT::Utils->xfork;
2007-10-26 22:44:33 +00:00
# } else {
# $child = 0;
# }
# unless (defined $child) { die "Fork failed"; }
# if ($child == 0) {
2008-05-22 18:57:51 +00:00
# $parent_fd = $parfd;
my $ oldprogname = $$ progname ;
$$ progname = $ oldprogname . ": $modname instance" ;
2007-10-26 22:44:33 +00:00
# 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" ;
2008-05-22 18:57:51 +00:00
# if ($dispatch_requests) {
dispatch_request ( $ req , $ callback , $ modname ) ;
# } else {
# undef $SIG{CHLD};
# ${"xCAT_plugin::".$modname."::"}{process_request}->($req,$callback,\&do_request);
# }
$$ progname = $ oldprogname ;
2007-10-26 22:44:33 +00:00
# if ($sock) {
# close($parent_fd);
2008-05-22 18:57:51 +00:00
# xexit(0);
2007-10-26 22:44:33 +00:00
# }
# } else {
2008-05-22 18:57:51 +00:00
# $plugin_children{$child}=1;
# close $parfd;
2007-10-26 22:44:33 +00:00
# $check_fds->add($pfd);
# }
2009-03-25 14:31:39 +00:00
} 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 ] } ] } ) ;
}
}
2007-10-26 22:44:33 +00:00
}
}
unless ( $ sock ) { return $ Main:: resps } ;
2008-05-22 18:57:51 +00:00
# while (($plugin_numchildren > 0) and ($check_fds->count > 0)) { #this tracks end of useful data from children much more closely
2007-10-26 22:44:33 +00:00
# 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) { print $sock XMLout(\%done,RootName => 'xcatresponse',NoAttr=>1); }
}
2008-05-22 18:57:51 +00:00
###################################
# dispatch_request
# dispatch the requested command
#
# NOTE: This is copied from xcatd (last merge 5/21/08).
# 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=();
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 } ) ) {
undef $ SIG { CHLD } ;
$ 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--; } } };
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 } } ) ;
}
# 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;
if ( $ _ - > { '_xcatdest' } and thishostisnot ( $ _ - > { '_xcatdest' } ) ) {
#----- added to Client.pm -----#
$ dispatch_cb - > ( { warning = > [ 'XCATBYPASS is set, skipping hierarchy call to ' . $ _ - > { '_xcatdest' } . '' ] } ) ;
# $ENV{XCATHOST} = ( $_->{'_xcatdest'} =~ /:/ ? $_->{'_xcatdest'} : $_->{'_xcatdest'}.":3001" );
# $$progname.=": connection to ".$ENV{XCATHOST};
# eval {
# undef $_->{'_xcatdest'};
# xCAT::Client::submit_request($_,\&dispatch_callback,$xcatdir."/cert/server-cred.pem",$xcatdir."/cert/server-cred.pem",$xcatdir."/cert/ca.pem");
# };
# if ($@) {
# dispatch_callback({error=>["Error dispatching command to ".$ENV{XCATHOST}.""],errorcode=>[1]});
# syslog("local4|err","Error dispatching request: ".$@);
# }
} else {
$$ progname . = ": locally executing" ;
undef $ SIG { CHLD } ;
$ { "xCAT_plugin::" . $ modname . "::" } { process_request } - > ( $ _ , $ dispatch_cb , \ & do_request ) ;
}
# xexit;
}
#while (($dispatch_children > 0) and ($child_fdset->count > 0)) { relay_dispatch($child_fdset) }
#while (relay_dispatch($child_fdset)) { } #Potentially useless drain.
}
###################################
# thishostisnot
# does the requested IP belong to this local host?
#
# NOTE: This is copied from xcatd (last merge 5/21/08).
# Will eventually move to using common source....
###################################
sub thishostisnot {
my $ comparison = shift ;
# use "ip addr" for linux, since ifconfig
# doesn't list "ip addr add" aliases for linux
#
my $ cmd = ( $^O !~ /^aix/i ) ? "/sbin/ip addr" : "ifconfig -a" ;
my @ ips = split /\n/ , `$cmd` ;
####
# TODO: AIX will hang on the inet_aton call if it gets passed an IPv6
# address, since we have not added INET6 support to AIX yet.
# The ifconfig -a output may contain an IPv6 address for localhost.
2008-10-19 17:29:03 +00:00
# This code should only get called if using hierarchy
2008-05-22 18:57:51 +00:00
####
my $ comp = IO::Socket:: inet_aton ( $ comparison ) ;
foreach ( @ ips ) {
2008-10-19 17:29:03 +00:00
if ( xCAT::Utils - > isAIX ( ) ) {
# don't want "inet6" entry - causes error in inet_aton
if ( /^\s*inet\s+/ ) {
my @ ents = split ( /\s+/ ) ;
my $ ip = $ ents [ 2 ] ;
$ ip =~ s/\/.*// ;
if ( IO::Socket:: inet_aton ( $ ip ) eq $ comp ) {
return 0 ;
}
}
} else {
if ( /^\s*inet/ ) {
my @ ents = split ( /\s+/ ) ;
my $ ip = $ ents [ 2 ] ;
$ ip =~ s/\/.*// ;
if ( IO::Socket:: inet_aton ( $ ip ) eq $ comp ) {
return 0 ;
}
}
2008-05-22 18:57:51 +00:00
}
}
return 1 ;
}
2007-10-26 22:44:33 +00:00
###################################
# do_request
# called from a plugin to execute another xCAT plugin command internally
#
2008-05-22 18:57:51 +00:00
# NOTE: This is copied from xcatd (last merge 5/21/08).
2007-10-26 22:44:33 +00:00
# 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 } ) {
2008-04-05 14:53:35 +00:00
my @ nodes = xCAT::NodeRange:: noderange ( $ req - > { noderange } - > [ 0 ] ) ;
2007-10-26 22:44:33 +00:00
my % resp ;
2008-04-05 14:53:35 +00:00
if ( xCAT::NodeRange:: nodesmissed ( ) ) {
$ resp { warning } = "Invalid nodes in noderange:" . join ',' , xCAT::NodeRange:: nodesmissed ( ) . "\n" ;
2007-10-26 22:44:33 +00:00
}
$ 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 ;
foreach ( keys %$ rsp ) {
my $ subresp = dclone ( $ rsp - > { $ _ } ) ;
push ( @ { $ Main:: resps - > { $ _ } } , @ { $ subresp } ) ;
}
}
2008-02-14 14:25:49 +00:00
} # end of submit_request()
##########################################
# handle_response is a default callback that can be passed into submit_response()
# It is invoked repeatedly by submit_response() 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 ;
2008-02-18 15:57:25 +00:00
#print "in handle_response\n";
2008-02-14 14:25:49 +00:00
# Handle errors
if ( $ 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
}
2008-02-18 15:57:25 +00:00
if ( $ rsp - > { error } ) {
#print "printing error\n";
2008-04-07 13:09:39 +00:00
if ( ref ( $ rsp - > { error } ) eq 'ARRAY' ) { foreach my $ text ( @ { $ rsp - > { error } } ) { print STDERR "Error: $text\n" ; } }
2008-02-18 15:57:25 +00:00
else { print ( "Error: " . $ rsp - > { error } . "\n" ) ; }
}
2008-02-14 14:25:49 +00:00
if ( $ rsp - > { warning } ) {
2008-02-18 15:57:25 +00:00
#print "printing warning\n";
2008-04-07 13:09:39 +00:00
if ( ref ( $ rsp - > { warning } ) eq 'ARRAY' ) { foreach my $ text ( @ { $ rsp - > { warning } } ) { print STDERR "Warning: $text\n" ; } }
2008-02-14 14:25:49 +00:00
else { print ( "Warning: " . $ rsp - > { warning } . "\n" ) ; }
}
2008-02-18 15:57:25 +00:00
if ( $ rsp - > { info } ) {
#print "printing info\n";
if ( ref ( $ rsp - > { info } ) eq 'ARRAY' ) { foreach my $ text ( @ { $ rsp - > { info } } ) { print "$text\n" ; } }
else { print ( $ rsp - > { info } . "\n" ) ; }
2008-02-14 14:25:49 +00:00
}
2008-06-02 20:28:43 +00:00
if ( $ rsp - > { sinfo } ) {
if ( ref ( $ rsp - > { sinfo } ) eq 'ARRAY' ) { foreach my $ text ( @ { $ rsp - > { sinfo } } ) { print "$text\r" ; $| + + ; } }
else { print ( $ rsp - > { sinfo } . "\r" ) ; $| + + ; }
}
2008-02-14 14:25:49 +00:00
# Handle {node} structure
2008-04-08 11:49:06 +00:00
my $ errflg = 0 ;
2008-02-18 15:57:25 +00:00
if ( scalar @ { $ rsp - > { node } } ) {
#print "printing node\n";
2008-02-14 14:25:49 +00:00
my $ nodes = ( $ rsp - > { node } ) ;
my $ node ;
foreach $ node ( @$ nodes ) {
my $ desc = $ node - > { name } - > [ 0 ] ;
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
}
2008-03-04 19:38:16 +00:00
if ( $ node - > { error } ) {
$ desc . = ": Error: " . $ node - > { error } - > [ 0 ] ;
2008-04-08 11:49:06 +00:00
$ errflg = 1 ;
2008-03-04 19:38:16 +00:00
}
2008-02-14 14:25:49 +00:00
if ( $ node - > { data } ) {
if ( 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 ( $ desc ) {
2008-04-08 11:49:06 +00:00
if ( $ errflg == 1 ) {
print STDERR ( "$desc\n" ) ;
} else {
print "$desc\n" ;
}
2008-02-14 14:25:49 +00:00
}
}
}
# Handle {data} structure with no nodes
2008-02-21 21:10:35 +00:00
if ( $ rsp - > { data } ) {
2008-02-18 15:57:25 +00:00
#print "printing data\n";
2008-02-14 14:25:49 +00:00
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 ] ;
}
}
}
2008-02-21 21:10:35 +00:00
if ( $ desc ) { print "$desc\n" ; }
2008-02-14 14:25:49 +00:00
}
}
} # end of handle_response
2007-10-26 22:44:33 +00:00