xcat-core/xCAT-server-2.0/sbin/xcatd
2008-03-05 16:57:27 +00:00

982 lines
31 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} and $req->{noderange}->[0]) {
@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);
}
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;
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;
}