1e84cb6c43
git-svn-id: https://svn.code.sf.net/p/xcat/code/xcat-core/trunk@611 8638fb3e-16cb-4fca-ae20-7b5d299a9bcd
979 lines
30 KiB
Perl
Executable File
979 lines
30 KiB
Perl
Executable File
#!/usr/bin/env perl
|
|
# IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html
|
|
BEGIN
|
|
{
|
|
$::XCATROOT = $ENV{'XCATROOT'} ? $ENV{'XCATROOT'} : '/opt/xcat';
|
|
}
|
|
use lib "$::XCATROOT/lib/perl";
|
|
use Storable qw(freeze thaw);
|
|
use xCAT::Utils;
|
|
use File::Path;
|
|
use xCAT::Client submit_request;
|
|
|
|
use IO::Socket::SSL;
|
|
if (xCAT::Utils->isLinux()) {
|
|
eval { require Socket6 };
|
|
eval { require IO::Socket::INET6 };
|
|
eval { require IO::Socket::SSL::inet6 };
|
|
} else {
|
|
eval { require Socket };
|
|
eval { require IO::Socket::INET };
|
|
}
|
|
|
|
my $dispatch_requests = 1; # govern whether commands are dispatchable
|
|
use IO::Socket;
|
|
use IO::Handle;
|
|
use IO::Select;
|
|
use XML::Simple;
|
|
use xCAT::Table;
|
|
use Data::Dumper;
|
|
use Getopt::Long;
|
|
use Sys::Syslog;
|
|
use xCAT::NotifHandler;
|
|
use xCAT_monitoring::monitorctrl;
|
|
|
|
|
|
Getopt::Long::Configure("bundling");
|
|
Getopt::Long::Configure("pass_through");
|
|
|
|
|
|
use Storable qw(dclone);
|
|
use POSIX qw(WNOHANG setsid);
|
|
use strict;
|
|
my $pidfile;
|
|
my $foreground;
|
|
GetOptions(
|
|
'pidfile|p=s' => \$pidfile,
|
|
'foreground|f' => \$foreground
|
|
);
|
|
|
|
my $quit = 0;
|
|
my $port;
|
|
my $sport;
|
|
my $domain;
|
|
my $xcatdir;
|
|
my $sitetab=xCAT::Table->new('site');
|
|
unless ($sitetab) {
|
|
print ("ERROR: Unable to open basic site table for configuration\n");
|
|
}
|
|
|
|
my ($tmp) = $sitetab->getAttribs({'key'=>'xcatdport'},'value');
|
|
unless ($tmp) {
|
|
die "ERROR:Need xcatdport defined in site table, try chtab key=xcatdport site.value=3001";
|
|
}
|
|
$port = $tmp->{value};
|
|
$sport = $tmp->{value}+1;
|
|
|
|
|
|
my $plugins_dir=$::XCATROOT.'/lib/perl/xCAT_plugin';
|
|
($tmp) = $sitetab->getAttribs({'key'=>'xcatconfdir'},'value');
|
|
$xcatdir = (($tmp and $tmp->{value}) ? $tmp->{value} : "/etc/xcat");
|
|
|
|
$sitetab->close;
|
|
my $progname;
|
|
$SIG{PIPE} = sub { die "SIGPIPE $$progname encountered a broken pipe (probably Ctrl-C by client)" };
|
|
$progname = \$0;
|
|
sub daemonize {
|
|
chdir('/');
|
|
umask 0;
|
|
my $pid;
|
|
defined($pid = xCAT::Utils->xfork) or die "Can't fork: $!";
|
|
if ($pid) {
|
|
if ($pidfile) {
|
|
open(PFILE, '>', $pidfile);
|
|
print PFILE $pid;
|
|
close (PFILE);
|
|
} else {
|
|
printf ("xCATd starting as PID $pid \n");
|
|
}
|
|
exit;
|
|
}
|
|
open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
|
|
open STDOUT, '>/dev/null';
|
|
open STDERR, '>/dev/null';
|
|
$0='xcatd';
|
|
$progname = \$0;
|
|
setsid or die "Can't start new session";
|
|
}
|
|
|
|
my %cmd_handlers;
|
|
sub do_installm_service {
|
|
#This function servers as a handler for messages from installing nodes
|
|
|
|
my $socket;
|
|
if (xCAT::Utils->isLinux()) {
|
|
$socket = IO::Socket::INET6->new(LocalPort=>$sport,
|
|
Proto => 'tcp',
|
|
ReuseAddr => 1,
|
|
Listen => 64);
|
|
} else {
|
|
$socket = IO::Socket::INET->new(LocalPort=>$sport,
|
|
Proto => 'tcp',
|
|
ReuseAddr => 1,
|
|
Listen => 64);
|
|
}
|
|
|
|
unless ($socket) {
|
|
syslog("local4|err","xcatd unable to open install monitor services on $sport");
|
|
die;
|
|
}
|
|
until ($quit) {
|
|
$SIG{ALRM} = sub { die "XCATTIMEOUT"; };
|
|
my $conn;
|
|
next unless $conn = $socket->accept;
|
|
|
|
my @clients;
|
|
if (xCAT::Utils->isLinux()) {
|
|
@clients = gethostbyaddr($conn->peeraddr,AF_INET6);
|
|
} else {
|
|
@clients = gethostbyaddr($conn->peeraddr,AF_INET);
|
|
}
|
|
|
|
my $validclient=0;
|
|
my $node;
|
|
foreach my $client (@clients) {
|
|
$client =~ s/\..*//;
|
|
($node) = noderange($client); #ensure this is coming from a node IP at least
|
|
if ($node) { #Means the source isn't a valid deal...
|
|
$validclient=1;
|
|
last;
|
|
}
|
|
}
|
|
unless ($validclient) {
|
|
close($conn);
|
|
next;
|
|
}
|
|
my $tftpdir = "/tftpboot/";
|
|
eval {
|
|
alarm(2);
|
|
print $conn "ready\n";
|
|
while (my $text = <$conn>) {
|
|
alarm(0);
|
|
print $conn "done\n";
|
|
$text =~ s/\r//g;
|
|
if ($text =~ /next/) {
|
|
my %request = (
|
|
command => [ 'nodeset' ],
|
|
node => [ $node ],
|
|
arg => [ 'next' ],
|
|
);
|
|
close($conn);
|
|
#node should be blocked, race condition may occur otherwise
|
|
#my $pid=xCAT::Utils->xfork();
|
|
#unless ($pid) { #fork off the nodeset and potential slowness
|
|
plugin_command(\%request,undef,\&convey_response);
|
|
# exit(0);
|
|
#}
|
|
} elsif ($text =~ /^unlocktftpdir/) { #TODO: only nodes in install state should be allowed
|
|
mkpath("$tftpdir/xcat/$node");
|
|
chmod 01777,"$tftpdir/xcat/$node";
|
|
chmod 0666,glob("$tftpdir/xcat/$node/*");
|
|
close($conn);
|
|
} elsif ($text =~ /locktftpdir/) {
|
|
chmod 0755,"$tftpdir/xcat/$node";
|
|
chmod 0644,glob("$tftpdir/xcat/$node/*");
|
|
} elsif ($text =~ /^setiscsiparms/) {
|
|
$text =~ s/^setiscsiparms\s+//;
|
|
my $kname;
|
|
my $iname;
|
|
my $kcmdline;
|
|
($kname,$iname,$kcmdline) = split(/\s+/,$text,3);
|
|
chomp($kcmdline);
|
|
my $noderestab = xCAT::Table->new('noderes',-create=>1);
|
|
$noderestab->setNodeAttribs($node,{kernel=>"xcat/$node/$kname",initrd=>"xcat/$node/$iname",kcmdline=>$kcmdline});
|
|
my $iscsitab = xCAT::Table->new('iscsi',-create=>1);
|
|
$iscsitab->setNodeAttribs($node,{kernel=>"xcat/$node/$kname",initrd=>"xcat/$node/$iname",kcmdline=>$kcmdline});
|
|
my $chaintab = xCAT::Table->new('chain',-create=>1);
|
|
$chaintab->setNodeAttribs($node,{currstate=>'iscsiboot',currchain=>'netboot'});
|
|
$noderestab->close;
|
|
$chaintab->close;
|
|
undef $noderestab;
|
|
undef $chaintab;
|
|
my %request = (
|
|
command => [ 'nodeset' ],
|
|
node => [ $node ],
|
|
arg => [ 'enact' ],
|
|
);
|
|
my $pid=xCAT::Utils->xfork();
|
|
unless ($pid) { #fork off the nodeset and potential slowness
|
|
plugin_command(\%request,undef,\&convey_response);
|
|
exit(0);
|
|
}
|
|
}
|
|
alarm(2);
|
|
}
|
|
alarm(0);
|
|
};
|
|
if ($@) {
|
|
if ($@ =~ /XCATTIMEOUT/) {
|
|
syslog("local4|err","xcatd installmonitor timed out talking to $node");
|
|
} else {
|
|
syslog("local4|err","xcatd: possible BUG encountered by xCAT install monitor service: ".$@);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
sub do_udp_service { #This function opens up a UDP port
|
|
#It will do similar to the standard service, except:
|
|
#-Obviously, unencrypted and messages are not guaranteed
|
|
#-For that reason, more often than not plugins designed with
|
|
#-this method will not expect to have a callback
|
|
#Also, this throttles to handle one message at a time, so no forking either
|
|
#Explicitly, to handle whatever operations nodes periodically send during discover state
|
|
#Could be used for heartbeating and such as desired
|
|
$dispatch_requests=0;
|
|
my $socket;
|
|
my $select = new IO::Select;
|
|
if (xCAT::Utils->isLinux()) {
|
|
$socket = IO::Socket::INET6->new(LocalPort => $port,
|
|
Proto => 'udp',
|
|
Domain => AF_INET);
|
|
} else {
|
|
$socket = IO::Socket::INET->new(LocalPort => $port,
|
|
Proto => 'udp',
|
|
Domain => AF_INET);
|
|
}
|
|
|
|
$select->add($socket);
|
|
openlog("xCAT UDP",'','local4');
|
|
unless ($socket) {
|
|
syslog("err","xCAT UDP service unable to open port $port: $!");
|
|
closelog();
|
|
die "Unable to start UDP on $port";
|
|
}
|
|
my $data;
|
|
my $part;
|
|
my $sport;
|
|
my $client;
|
|
my $peerhost;
|
|
my %packets;
|
|
until ($quit) {
|
|
eval {
|
|
while (1) {
|
|
until ($select->can_read(5)) {if ($quit) { last; }} #Wait for data
|
|
while ($select->can_read(0)) { #Pull all buffer data that can be pulled
|
|
$part = $socket->recv($data,1500);
|
|
($sport,$client) = sockaddr_in($part);
|
|
$packets{inet_ntoa($client)} = [$part,$data];
|
|
}
|
|
foreach my $pkey (keys %packets) {
|
|
($sport,$client) = sockaddr_in($packets{$pkey}->[0]);
|
|
$data=$packets{$pkey}->[1];
|
|
$peerhost=gethostbyaddr($client,AF_INET)."\n";
|
|
my $req = eval { XMLin($data, SuppressEmpty=>undef,ForceArray=>1) };
|
|
if ($req and $req->{command} and ($req->{command}->[0] eq "findme")) {
|
|
$req->{'_xcat_clienthost'}=gethostbyaddr($client,AF_INET)."\n";
|
|
$req->{'_xcat_clientip'}=inet_ntoa($client);
|
|
$req->{'_xcat_clientport'}=$sport;
|
|
if (defined($cmd_handlers{"findme"})) {
|
|
$req->{cacheonly}->[0] = 1;
|
|
plugin_command($req,undef,\&convey_response);
|
|
if ($req->{cacheonly}->[0]) {
|
|
delete $req->{cacheonly};
|
|
plugin_command($req,undef,\&convey_response);
|
|
}
|
|
}
|
|
}
|
|
if ($quit) { last; }
|
|
while ($select->can_read(0)) { #grab any incoming requests during run
|
|
$part = $socket->recv($data,1500);
|
|
($sport,$client) = sockaddr_in($part);
|
|
$packets{inet_ntoa($client)} = [$part,$data];
|
|
}
|
|
#Some of those 'future' packets might be stale dupes of this packet, so...
|
|
delete $packets{$pkey}; #Delete any duplicates of current packet
|
|
}
|
|
if ($quit) { last; }
|
|
}
|
|
};
|
|
if ($@) {
|
|
syslog("local4|err","xcatd: possible BUG encountered by xCAT UDP service: ".$@);
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
|
|
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->{$_}] ];
|
|
}
|
|
}
|
|
}
|
|
}
|
|
scan_plugins;
|
|
unless ($foreground) {
|
|
daemonize;
|
|
}
|
|
$SIG{CHLD} = sub { while (waitpid(-1,WNOHANG) > 0) {} };
|
|
$SIG{TERM} = $SIG{INT} = sub { printf("Asked to quit...\n"); $quit++ };
|
|
|
|
my $pid = xCAT::Utils->xfork;
|
|
defined $pid or die "Unable to fork for UDP/TCP";
|
|
unless ($pid) {
|
|
$$progname="xcatd: UDP listener";
|
|
do_udp_service;
|
|
exit(0);
|
|
}
|
|
$pid = xCAT::Utils->xfork;
|
|
defined $pid or die "Unable to fork installmonitor";
|
|
unless ($pid) {
|
|
$$progname="xcatd: install monitor";
|
|
do_installm_service;
|
|
exit(0);
|
|
}
|
|
$$progname="xcatd: SSL listener";
|
|
openlog("xCAT SSL","","local4");
|
|
my $listener = IO::Socket::SSL->new(
|
|
LocalPort => $port,
|
|
Listen => 64,
|
|
Reuse => 1,
|
|
SSL_key_file=>$xcatdir."/cert/server-key.pem",
|
|
SSL_cert_file=>$xcatdir."/cert/server-cert.pem",
|
|
SSL_ca_file=>$xcatdir."/cert/ca.pem",
|
|
SSL_verify_mode=> 1
|
|
);
|
|
|
|
unless ($listener) {
|
|
kill $pid;
|
|
syslog("err","xCAT service unable to open SSL services on $port: $!");
|
|
closelog();
|
|
die "ERROR:Unable to start xCAT service on port $port.";
|
|
}
|
|
closelog();
|
|
|
|
#setup signal in NotifHandler so that the cache can be updated
|
|
xCAT::NotifHandler::setup($$);
|
|
|
|
#start the monitoring process
|
|
xCAT_monitoring::monitorctrl::start($$);
|
|
|
|
my $peername;
|
|
until ($quit) {
|
|
next unless my $connection=$listener->accept;
|
|
my $child = xCAT::Utils->xfork(); #Yes we fork, IO::Socket::SSL is not threadsafe..
|
|
|
|
unless (defined $child) {
|
|
die "xCATd cannot fork";
|
|
}
|
|
|
|
if ($child == 0) {
|
|
$listener->close;
|
|
my $peerhost=undef;
|
|
my $peer=$connection->peer_certificate("owner");
|
|
if ($peer) {
|
|
$peer =~ m/CN=([^\/]*)/;
|
|
$peername = $1;
|
|
} else {
|
|
$peername=undef;
|
|
}
|
|
$sitetab=xCAT::Table->new('site');
|
|
my ($tmp) = $sitetab->getAttribs({'key'=>'domain'},'value');
|
|
if (defined $tmp->{value}) {
|
|
$domain = $tmp->{value};
|
|
}
|
|
$sitetab->close;
|
|
|
|
if (xCAT::Utils->isLinux()) {
|
|
$peerhost = gethostbyaddr($connection->peeraddr,AF_INET6);
|
|
} else {
|
|
$peerhost = gethostbyaddr($connection->peeraddr,AF_INET);
|
|
}
|
|
|
|
|
|
unless ($peerhost) { $peerhost = gethostbyaddr($connection->peeraddr,AF_INET); }
|
|
$peerhost =~ s/\.$domain\.*$//;
|
|
$peerhost =~ s/-eth\d*$//;
|
|
$peerhost =~ s/-myri\d*$//;
|
|
$peerhost =~ s/-ib\d*$//;
|
|
#printf('info'.": xcatd: connection from ".($peername ? $peername . "@" . $peerhost : $peerhost)."\n");
|
|
$$progname="xCATd SSL: Instance for ".($peername ? $peername ."@".$peerhost : $peerhost);
|
|
service_connection($connection,$peername,$peerhost);
|
|
exit(0);
|
|
}
|
|
$connection->close(SSL_no_shutdown => 1); #Without no shutdown, you can guess what the client ends up thinking..
|
|
}
|
|
$listener->close;
|
|
|
|
#stop the monitoring process
|
|
xCAT_monitoring::monitorctrl::stop($$);
|
|
|
|
my $parent_fd;
|
|
my %resps;
|
|
|
|
|
|
|
|
|
|
|
|
sub plugin_command {
|
|
my $req = shift;
|
|
my $sock = shift;
|
|
my $callback = shift;
|
|
my %handler_hash;
|
|
use xCAT::NodeRange;
|
|
$Main::resps={};
|
|
my @nodes;
|
|
if ($req->{node}) {
|
|
@nodes = @{$req->{node}};
|
|
} elsif ($req->{noderange}) {
|
|
@nodes = noderange($req->{noderange}->[0]);
|
|
if (nodesmissed) {
|
|
my $rsp = {errorcode=>1,error=>"Invalid nodes in noderange:".join(',',nodesmissed)};
|
|
if ($sock) {
|
|
print $sock XMLout($rsp,RootName=>'xcatresponse' ,NoAttr=>1);
|
|
}
|
|
return ($rsp);
|
|
}
|
|
}
|
|
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;
|
|
foreach (@{$cmd_handlers{$req->{command}->[0]}}) {
|
|
$hdlspec =$_->[1];
|
|
my $ownmod = $_->[0];
|
|
if ($hdlspec =~ /:/) { #Specificed a table lookup path for plugin name
|
|
$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;
|
|
}
|
|
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;
|
|
delete $unhandled_nodes{$node};
|
|
last;
|
|
}
|
|
} else {
|
|
$handler_hash{$attribs->{$col}}->{$node} = 1;
|
|
delete $unhandled_nodes{$node};
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
$hdlrtable->close;
|
|
} else {
|
|
unless (@nodes) {
|
|
$handler_hash{$hdlspec} = 1;
|
|
}
|
|
foreach (@nodes) { #Specified a specific plugin, not a table lookup
|
|
$handler_hash{$hdlspec}->{$_} = 1;
|
|
}
|
|
}
|
|
}
|
|
} else {
|
|
return 1; #TODO: error back that request has no known plugin for it
|
|
}
|
|
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]}]});
|
|
}
|
|
}
|
|
}
|
|
my $children=0;
|
|
$SIG{CHLD} = sub {while (waitpid(-1, WNOHANG) > 0) { $children--; } };
|
|
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";
|
|
$children++;
|
|
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) {
|
|
$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";
|
|
if ($dispatch_requests) {
|
|
dispatch_request($req,$callback,$modname);
|
|
} else {
|
|
undef $SIG{CHLD};
|
|
${"xCAT_plugin::".$modname."::"}{process_request}->($req,$callback,\&do_request);
|
|
}
|
|
$$progname=$oldprogname;
|
|
if ($sock) {
|
|
close($parent_fd);
|
|
exit(0);
|
|
}
|
|
} else {
|
|
close $parfd;
|
|
$check_fds->add($pfd);
|
|
}
|
|
}
|
|
}
|
|
unless ($sock) { return $Main::resps };
|
|
while ($children > 0) {
|
|
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); }
|
|
}
|
|
|
|
my $dispatch_dnf=0;
|
|
my $dispatch_cb;
|
|
my $dispatch_parentfd;
|
|
sub dispatch_callback {
|
|
my $rspo = shift;
|
|
unless ($rspo) {
|
|
return;
|
|
}
|
|
my $rsp = {%$rspo}; # deep copy
|
|
delete $rsp->{serverdone};
|
|
unless (%$rsp) { return; }
|
|
if ($dispatch_dnf) {
|
|
$dispatch_cb->($rsp);
|
|
} else {
|
|
print $dispatch_parentfd freeze($rsp);
|
|
print $dispatch_parentfd "\nENDOFFREEZE6sK6xa\n";
|
|
<$dispatch_parentfd>; #Block until parent acks data
|
|
}
|
|
}
|
|
|
|
sub relay_dispatch {
|
|
my $fds = shift;
|
|
my @ready_ins = $fds->can_read(0.2);
|
|
foreach my $rin (@ready_ins) {
|
|
my $data;
|
|
if ($data = <$rin>) {
|
|
while ($data !~ /ENDOFFREEZE6sK6xa/) {
|
|
$data .= <$rin>;
|
|
}
|
|
my $response = thaw($data);
|
|
print $rin "fin\n";
|
|
$dispatch_cb->($response);
|
|
} else {
|
|
$fds->remove($rin);
|
|
close($rin);
|
|
}
|
|
}
|
|
return scalar(@ready_ins);
|
|
}
|
|
|
|
sub dispatch_request {
|
|
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
|
|
undef $SIG{CHLD};
|
|
if (defined(${"xCAT_plugin::".$modname."::"}{preprocess_request})) {
|
|
$reqs = ${"xCAT_plugin::".$modname."::"}{preprocess_request}->($req,$dispatch_cb,\&do_request);
|
|
} else { #otherwise, pass it in without hierarchy support
|
|
$reqs = [$req];
|
|
}
|
|
|
|
my $childrn=0;
|
|
$SIG{CHLD} = sub {while (waitpid(-1, WNOHANG) > 0) { $childrn--; } };
|
|
foreach (@{$reqs}) {
|
|
my $pfd;
|
|
my $parfd; #use a private variable so it won't trounce itself recursively
|
|
my $child;
|
|
delete $_->{noderange};
|
|
socketpair($pfd, $parfd,AF_UNIX,SOCK_STREAM,PF_UNSPEC) or die "socketpair: $!";
|
|
$parfd->autoflush(1);
|
|
$pfd->autoflush(1);
|
|
$child = xCAT::Utils->xfork;
|
|
if ($child) {
|
|
$child_fdset->add($pfd);
|
|
$childrn++;
|
|
next;
|
|
}
|
|
unless (defined $child) {
|
|
$dispatch_cb->({error=>['Fork failure dispatching request'],errorcode=>[1]});
|
|
}
|
|
$dispatch_parentfd = $parfd;
|
|
if ($_->{'_xcatdest'} and thishostisnot($_->{'_xcatdest'})) {
|
|
$ENV{XCATHOST} = ( $_->{'_xcatdest'} =~ /:/ ? $_->{'_xcatdest'} : $_->{'_xcatdest'}.":3001" );
|
|
eval {
|
|
undef $_->{'_xcatdest'};
|
|
xCAT::Client::submit_request($_,\&dispatch_callback,$xcatdir."/cert/server-key.pem",$xcatdir."/cert/server-cert.pem",$xcatdir."/cert/ca.pem");
|
|
};
|
|
if ($@) {
|
|
dispatch_callback({error=>["Error dispatching command to ".$ENV{XCATHOST}.""],errorcode=>[1]});
|
|
syslog("local4|err","Error dispatching request: ".$@);
|
|
}
|
|
} else {
|
|
undef $SIG{CHLD};
|
|
${"xCAT_plugin::".$modname."::"}{process_request}->($_,\&dispatch_callback,\&do_request);
|
|
}
|
|
exit;
|
|
}
|
|
while ($childrn > 0) { relay_dispatch($child_fdset) }
|
|
while (relay_dispatch($child_fdset)) { } #Potentially useless drain.
|
|
}
|
|
|
|
sub thishostisnot {
|
|
my $comparison = shift;
|
|
my @ips = split /\n/,`/sbin/ip addr`;
|
|
my $comp=inet_aton($comparison);
|
|
foreach (@ips) {
|
|
if (/^\s*inet/) {
|
|
my @ents = split(/\s+/);
|
|
my $ip=$ents[2];
|
|
$ip =~ s/\/.*//;
|
|
if (inet_aton($ip) eq $comp) {
|
|
return 0;
|
|
}
|
|
#print Dumper(inet_aton($ip));
|
|
}
|
|
}
|
|
return 1;
|
|
}
|
|
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 = noderange($req->{noderange}->[0]);
|
|
my %resp;
|
|
if (nodesmissed) {
|
|
$resp{warning}="Invalid nodes in noderange:".join ',',nodesmissed;
|
|
}
|
|
$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);
|
|
}
|
|
}
|
|
}
|
|
|
|
sub convey_response {
|
|
my $resp=shift;
|
|
#TODO: This is where the following will/may happen:
|
|
#-Track transaction id
|
|
#-Save output for deferred commands
|
|
unless ($parent_fd) {
|
|
build_response($resp);
|
|
return;
|
|
}
|
|
print $parent_fd XMLout($resp,KeyAttr=>[], NoAttr=>1,RootName=>'xcatresponse');
|
|
<$parent_fd>; #Block until parent acks data
|
|
# KeyAttr => [], NoAttr => 1)
|
|
}
|
|
|
|
sub build_response {
|
|
# Handle responses from do_request calls made directly from a plugin
|
|
# Merge this response into the full response hash. We'll collect all
|
|
# the responses and ship it back on the return to the plugin.
|
|
# Note: Need to create a new "deep clone" copy of each response structure
|
|
# otherwise the next call will overwrite the reference we pushed on
|
|
# the response array
|
|
my $resp = shift;
|
|
foreach (keys %$resp) {
|
|
my $subresp = dclone($resp->{$_});
|
|
push (@{$Main::resps->{$_}}, @{$subresp});
|
|
}
|
|
}
|
|
|
|
sub service_connection {
|
|
my $sock = shift;
|
|
my $peername = shift;
|
|
my $peerhost = shift;
|
|
my $peerport = $sock->peerport;
|
|
my %tables=();
|
|
#some paranoid measures could reduce a third party abusing stage3 image to attempting to get USER/PASS for BMCs:
|
|
# -Well, minimally, ignore requests if requesting node is not in spconfig mode (stage3)
|
|
# -Option to generate a random password per 'getipmi' request. This reduces the exposure to a D.O.S. hopefully
|
|
#Give only 15 seconds of silence allowed or terminate connection. Using alarm since we are in thread-unsafe world anyway
|
|
my $timedout = 0;
|
|
|
|
$SIG{ALRM} = sub { $timedout = 1; die; };
|
|
eval {
|
|
my $request;
|
|
my $req=undef;
|
|
alarm(15);
|
|
while (<$sock>) {
|
|
alarm(0);
|
|
$request .= $_;
|
|
#$req = eval { XMLin($request, ForceArray => [ 'attribute' , 'attributepair' ]) };
|
|
if ($request =~ m/<\/xcatrequest>/) {
|
|
$req = eval { XMLin($request, SuppressEmpty=>undef,ForceArray=>1) };
|
|
#we have a full request..
|
|
#printf $request."\n";
|
|
$request="";
|
|
if (validate($peername,$peerhost,$req)) {
|
|
$req->{'_xcat_authname'} = [$peername];
|
|
$req->{'_xcat_clienthost'} = [$peerhost];
|
|
$req->{'_xcat_clientport'}= [$peerport];
|
|
$$progname="xCATd SSL: ".$req->{command}->[0]." for ".($peername ? $peername ."@".$peerhost : $peerhost);
|
|
if ($cmd_handlers{$req->{command}->[0]}) {
|
|
return plugin_command($req,$sock,\&convey_response);
|
|
} elsif ($req->{command}->[0] eq "noderange" and $req->{noderange}) {
|
|
my @nodes = noderange($req->{noderange}->[0]);
|
|
my %resp;
|
|
if (nodesmissed) {
|
|
$resp{warning}="Invalid nodes in noderange:".join ',',nodesmissed;
|
|
}
|
|
$resp{serverdone} = {};
|
|
@{$resp{node}}=@nodes;
|
|
if ($req->{transid}) {
|
|
$resp{transid}=$req->{transid}->[0];
|
|
}
|
|
print $sock XMLout(\%resp,RootName => 'xcatresponse',NoAttr=>1);
|
|
next;
|
|
} else {
|
|
my %resp=(error=>"Unsupported request");
|
|
$resp{serverdone} = {};
|
|
if ($req->{transid}) {
|
|
$resp{transid}=$req->{transid}->[0];
|
|
}
|
|
print $sock XMLout(\%resp,RootName => 'xcatresponse',NoAttr=>1);
|
|
next;
|
|
}
|
|
} else {
|
|
my %resp=(error=>"Permission denied for request");
|
|
$resp{serverdone} = {};
|
|
if ($req->{transid}) {
|
|
$resp{transid}=$req->{transid}->[0];
|
|
}
|
|
my $response=XMLout(\%resp,RootName =>'xcatresponse',NoAttr => 1);
|
|
print $sock $response;
|
|
next;
|
|
}
|
|
}
|
|
alarm(15);
|
|
}
|
|
};
|
|
if ($@) { # The eval statement caught a program bug..
|
|
unless ($@ =~ /^SIGPIPE/) {
|
|
syslog("local4|err","xcatd: possible BUG encountered by xCAT TCP service: ".$@);
|
|
} else {
|
|
syslog("local4|info","xcatd: Unexpected client disconnect");
|
|
}
|
|
}
|
|
alarm(0);
|
|
foreach (keys %tables) {
|
|
$tables{$_}->commit;
|
|
}
|
|
$sock->close;
|
|
if ($timedout == 1) {
|
|
printf ("Client timeout");
|
|
}
|
|
}
|
|
|
|
sub relay_fds { #Relays file descriptors from pipes to children to the SSL socket
|
|
my $fds = shift;
|
|
my $sock = shift;
|
|
unless ($sock) { return 0; }
|
|
my $collate = ( scalar @_ > 0 ? shift : 0);
|
|
my @readyset = $fds->can_read(1);
|
|
my $rfh;
|
|
my $rc = @readyset;
|
|
my $text;
|
|
foreach $rfh (@readyset) { #go through each child, extract a complete, atomic message
|
|
my $line;
|
|
while ($line = <$rfh>) { #Will break on complete </xcatresponse> messages, avoid interleave
|
|
print $sock $line;
|
|
if ($line =~ /<\/xcatresponse>/) {
|
|
last;
|
|
}
|
|
}
|
|
if ($line) {
|
|
print $rfh "fin\n"; #Notify convey_response message done
|
|
} else {
|
|
$fds->remove($rfh);
|
|
close($rfh);
|
|
}
|
|
}
|
|
return $rc;
|
|
}
|
|
|
|
sub validate {
|
|
#BIG TODO, make this do something meaningful
|
|
#here is where we check if $peername is allowed to do $request. $peername if set signifies client has a
|
|
#cert that the xCAT CA accepted. This will be a policy table with $peername as key
|
|
#things like 'stage2/stage3' and install images will have no client certificate.
|
|
#A client key for something that a third party could easily tftp down themselves means nothing
|
|
#however, privacy between the nodes can be maintained, and $peerhost will be checked just like 1.2.0.
|
|
# returns 1 if policy engine allows the action, 0 if denied
|
|
my $peername=shift;
|
|
my $peerhost=shift;
|
|
my $request=shift;
|
|
my $policytable = xCAT::Table->new('policy');
|
|
unless ($policytable) {
|
|
syslog("err","Unable to open policy data, denying");
|
|
return 0;
|
|
}
|
|
my @policies = $policytable->getTable;
|
|
$policytable->close;
|
|
my $rule;
|
|
foreach $rule (@policies) {
|
|
if ($rule->{name} and $rule->{name} ne '*') {
|
|
#TODO: more complex matching (lists, wildcards)
|
|
next unless ($peername eq $rule->{name});
|
|
}
|
|
if ($rule->{time} and $rule->{time} ne '*') {
|
|
#TODO: time ranges
|
|
}
|
|
if ($rule->{host} and $rule->{host} ne '*') {
|
|
#TODO: more complex matching (lists, noderanges?, wildcards)
|
|
next unless ($peerhost eq $rule->{host});
|
|
}
|
|
if ($rule->{commands} and $rule->{commands} ne '*') {
|
|
#TODO: syntax for multiple commands
|
|
next unless ($request->{command}->[0] eq $rule->{commands});
|
|
}
|
|
if ($rule->{parameters} and $rule->{parameters} ne '*') {
|
|
next; #TODO: not ignore this field
|
|
}
|
|
if ($rule->{noderange} and $rule->{noderange} ne '*') {
|
|
next; #TODO: not ignore this field
|
|
}
|
|
# If we are still in, that means this rule is the first match and dictates behavior.
|
|
if ($rule->{rule}) {
|
|
if ($rule->{rule} =~ /allow/i or $rule->{rule} =~ /accept/i) {
|
|
my $logst = "xCAT: Allowing ".$request->{command}->[0];
|
|
if ($peername) { $logst .= " for " . $peername };
|
|
syslog("authpriv|info",$logst);
|
|
return 1;
|
|
} else {
|
|
my $logst = "xCAT: Denying ".$request->{command}->[0];
|
|
if ($peername) { $logst .= " for " . $peername };
|
|
syslog("authpriv|info",$logst);
|
|
return 0;
|
|
}
|
|
} else { #Shouldn't be possible....
|
|
syslog("err","Impossible line in xcatd reached");
|
|
return 0;
|
|
}
|
|
}
|
|
#Reached end of policy table, reject by default.
|
|
syslog("err","Request matched no policy rule: ".$request->{command}->[0]);
|
|
return 0;
|
|
}
|
|
|