Have client default to storable model to reduce XML overhead

git-svn-id: https://svn.code.sf.net/p/xcat/code/xcat-core/trunk@16599 8638fb3e-16cb-4fca-ae20-7b5d299a9bcd
This commit is contained in:
jbjohnso 2013-06-10 18:44:17 +00:00
parent 20b3960c09
commit b4f1b9a6ea
2 changed files with 57 additions and 9 deletions

View File

@ -8,9 +8,11 @@ BEGIN
# 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;
my $inet6support;
if ($^O =~ /^aix/i) { # disable AIX IPV6 TODO fix
@ -77,6 +79,23 @@ sub rspclean {
}
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.
@ -232,20 +251,23 @@ if (ref($request) eq 'HASH') { # the request is an array, not pure XML
);
}
my $msg;
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
$msg=XMLout($request,RootName=>'xcatrequest',NoAttr=>1,KeyAttr=>[]);
print $client "xcatencoding: $encode\n";
my $encok=<$client>;
send_request($request,$client,$encode);
} else { #XML
$straightprint=1;
$msg=$request;
print $client $msg;
}
if ($ENV{XCATXMLTRACE}) { print $msg; }
if($ENV{XCATXMLWARNING}) {
validateXML($msg);
}
$SIG{TERM} = $SIG{INT} = sub { print $client XMLout({abortcommand=>1},RootName=>'xcatrequest',NoAttr=>1,KeyAttr=>[]); exit 0; };
print $client $msg;
$SIG{TERM} = $SIG{INT} = sub { send_request({abortcommand=>1},$client,$encode); exit 0; };
my $response;
my $rsp;
my $cleanexit=0;
if ($encode eq 'xml') {
my $massresponse="<massresponse>";
my $nextcoalescetime=time()+1;
my $coalescenow=0;
@ -299,6 +321,27 @@ if (ref($request) eq 'HASH') { # the request is an array, not pure XML
$massresponse .= "</massresponse>";
$cleanexit = rspclean($massresponse,$callback);
}
} else { #storable encode
my $rsp;
eval { $rsp = fd_retrieve($client); };
while ($rsp) {
my @rsps;
if (ref $rsp eq 'ARRAY') {
@rsps = @$rsp;
} else {
@rsps = ($rsp);
}
foreach (@rsps) {
$callback->($_);
if ($_->{serverdone}) {
$cleanexit=1;
last;
}
}
$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";

View File

@ -98,7 +98,7 @@ unless ($inet6support) {
my $dispatch_requests = 1; # govern whether commands are dispatchable
use IO::Socket;
#use IO::Handle;
use IO::Handle;
use IO::Select;
use XML::Simple;
$XML::Simple::PREFERRED_PARSER='XML::Parser';
@ -1993,7 +1993,11 @@ sub send_response {
}
};
} elsif ($encode eq "storable") {
if ($response->{xcatresponse}) {
$response = $response->{xcatresponse};
}
nstore_fd($response,$sock);
$sock->flush(); #otherwise, the response might actually get deferred until after the close_notify, crazy huh?
}
}
sub get_request {
@ -2049,11 +2053,12 @@ sub service_connection {
while (1) {
unless ($clientsel->can_read(15)) { last; } #don't let an unresponsive client hold us up
my $line = <$sock>; # grab one line, check for mode...
if ($line and $line =~ /^xcatencoding: (.*)\z/) {
if ($line and $line =~ /^xcatencoding: (.*)/) {
unless ($supported_encodes{$1}) {
print $sock "Unsupported encoding $1\n";
last;
}
print $sock "Encoding accepted\n";
$globalencode=$1;
$line = "";
}