http://qs321.pair.com?node_id=394400

nenbrian has asked for the wisdom of the Perl Monks concerning the following question:

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:

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

[download]

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;

[download]
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);
}

[download]
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
------------------------------------

;

[download]

Back to Seekers of Perl Wisdom