#!/usr/bin/perl -w

use strict;
use warnings;
use RPC::XML::Server;

=pod

put this in /etc/xinetd.d/xmlrpc and reload xinetd:

service http
{
	id = xmlrpc
	wait = no
	socket_type = stream
	user = root
	server = /root/xmlrpc.pl
}

=cut

# create rpc with just one (anonymous) callback function
my $rpc = RPC::XML::Server->new(no_http => 1);
$rpc->add_proc({
	name => "foobar",
	code => sub {
		return "hello, world -- " . join(" ", @_);
	},
	signature => [ 'string i4 string' ],
	help => "This function returns hello world and its arguments.",
});

# slurp in http header and xml payload
my $http_data = "";
while ($http_data !~ /<\/methodCall>\s*$/) {
  die $! if !sysread(STDIN, $http_data, 4096, length($http_data));
}

# we are interested in the xml payload only
my $xml_request = (split(/\r?\n\r?\n/, $http_data, 2))[1];
die "no xml request" if !$xml_request;

# do the real function call
my $xml_response = $rpc->dispatch($xml_request)->as_string;

# el cheapo http response
print "HTTP/1.0 200 OK\r\n",
  "Content-Length: ", length($xml_response), "\r\n",
  "Content-Type: text/xml\r\n",
  "Connection: Close\r\n",
  "\r\n",
  $xml_response;