Hello Perl Monks,
I am working on an application that uses RPC::XML, and
I have noticed that under certain circumstances the
server replies with seemingly garbled binary data when
it should be returning an XML-RPC response. It seems to
happen unpredictably, and simply changing the data sent
by the client in the method call arguments seems to
trigger it.
It is hard to refine the code down to a small program
that demonstrates the problem, however my co-worker and
I have gotten it down to the smallest size that still
represents what we are trying to do. One thing that we
do which is a little bit strange is that we send a large
ammount of data to the server as an argument to a method
call. The data are XML documents themselves, which have
been Base64-encoded and passed as string arguments to
XML-RPC method calls.
Code demonstrating this problem included below.
A tcpdump of one of our sessions (in pcap format)
containing the corrupted response can be found
Here. A dump of the TCP stream (by ethereal) can
be found
Here.
Some background:
- Perl version: 5.8.0
- RPC::XML package version: 1.30
- Platform: HP-UX
For a completely apples-to-oranges comparison, the
problem does not seem to happen (or at least has not
been observed yet) on Linux with Perl version 5.8.4
and RPC::XML version 1.26.
Our best working theory is that the XML-RPC server is
compressing the response, but it isn't clear why it does
so for certain application data but not for others.
Also, if it compresses the data, presumably the XML-RPC
client should know how to uncompress it.
Any insight into this problem and how to solve it would
be much appreciated.
UPDATE
It's worse than we thought! The problem can be
reproduced with a very simple method call. I can include
all of the code here (in readmore tags, of course). See
below.
The following will demonstrate the problem, but it won't
be obvious without a packet trace.
$ ./d.pl
$ ./tickle localhost system.introspection
Thanks,
-nenbrian
Perl package "D.pm" (needed by d.pl, below)
package D;
use strict;
sub new {
my $self;
$self = {};
$self->{Server} = undef;
$self->{InitialMethods} = undef;
my $parser = XML::LibXML->new();
bless $self;
return $self;
}
sub setServer {
my ($self, $server) = @_;
$self->{InitialMethods} = { map { $_ => 1 } keys %{$server->{__met
+hod_table}} };
$self->{Server} = $server;
}
sub initialize {
my ($self) = @_;
my $server = $self->{Server};
# General exported functions for D
$server->add_method(
{
name => 'd.apply',
version => '1.0',
hidden => 0,
code => sub { $self->apply(@_) },
signature => [ 'string string' ],
help => q{ prints a string }
}
);
$self->getMethodList();
}
sub getMethodList {
my ($self) = @_;
my $server = $self->{Server};
# Not all RPC::XML version implement list_methods
print "DEBUG($$): getMethodList called.\n";
my @list = keys %{$server->{__method_table}};
my @ordered_list = sort @list;
print "DEBUG($$): first_method: ";
print join("\nDEBUG($$): next_method: ", @ordered_list);
print "\n";
return \@ordered_list;
}
sub apply {
my ($self, $server, $string) = @_;
print "apply: entered\n";
my $temp = "we are now in the apply function: $string\n";
return $temp;
}
1;
Perl script "d.pl" (RPC::XML server)
#!/usr/bin/perl -w
BEGIN {push @INC, (".", "..")};
use strict;
use XML::LibXML;
use XML::LibXSLT;
use Getopt::Long;
use RPC::XML::Server;
use RPC::XML::Client;
use D;
use Data::Dumper;
$|=1;
my $debug=1;
$SIG{CHLD} = "IGNORE";
while (1) {
my ($server, $d);
$server = RPC::XML::Server->new(
port => 9000,
queue => 1024
);
$d = D->new();
$d->setServer($server);
$d->initialize();
eval {
# This loop will not exit unless the server dies
$server->server_loop('INT', sub { die("AAAAACK!!!");} );
};
print "Restarting loop!\n";
exec($0, @ARGV);
}
Perl script "tickle" (RPC::XML client)
#!/usr/bin/perl
use RPC::XML::Client;
use Data::Dumper;
# Usage: ticket server function [ argument ]
$server = shift @ARGV;
$function = shift @ARGV;
$client = RPC::XML::Client->new("http://$server:9000/");
if ($#ARGV) {
#if (defined $argument and length($argument) > 0) {
#print "tickle: sending with argument: ".Dumper($argument)."\n";
$response = $client->send_request($function, @ARGV);
} else {
$response = $client->send_request($function);
}
my $response_ref_type = ref($response);
my $dump;
# upon shutdown, there is no response, since function does not return
if ($function eq "xcd.shutdown") {
$dump = "no response: shutting down";
} elsif (! ref $response) {
$dump = $response;
} elsif (! $response->is_fault) {
$dump = Dumper($response->value);
} else {
$dump = Dumper($response);
}
print <<
Return:
reponse ref type: $response_ref_type
------------------------------------
$dump
------------------------------------
;