#!/usr/pkg/bin/perl -w
# gus_xml-rpc_bridge.pl
# Copyright 2005-09-10 by Gan Uesli Starling
# XML-RPC cgi script written in Perl.
# See POD at EOF for full description.
# 77 lines of code & 20 comment lines.

use strict;
use Frontier::RPC2;
use Frontier::Client;
use Sys::Hostname::Long;

# Make an object to represent the XML-RPC server.
my $host_name = hostname_long();

my $server = "http://$host_name:8080/RPC2";

# Create the pass-through XML-RPC client.
$server = Frontier::Client->new(url => $server);

# Create the pass-through XML-RPC encoder/decoder.
my $coder = Frontier::RPC2->new;

# Bridge an incoming CGI call to XML-RPC.
# Note: Method name and args may even be encrypted
# since they are merely parsed and passed though.
sub bridge_call  { 

    # Get our CGI request information.
    my $method = $ENV{'REQUEST_METHOD'};
    my $type   = $ENV{'CONTENT_TYPE'};
    my $length = $ENV{'CONTENT_LENGTH'};

    # Perform some sanity checks.
    http_error(405, "Must use 'POST' method, not '$method'.") 
        unless $method eq "POST";
    http_error(400, "Must use 'text/xml' content type, not '$type'.") 
        unless $type eq "text/xml";
    http_error(411, "Length may not be zero.") unless $length > 0;

    # Fetch our body.
    my $body;
    my $count = read STDIN, $body, $length;
    http_error(400, "Length mismatch: $count versus $length.") 
        unless $count == $length;     
    
    # Decode body and bridge to stand-alone XML-RPC server
    my $href = $coder->decode($body); 
    $method = ${$href}{'method_name'};
    my $aref = ${$href}{'value'};
    my $response = $server->call($method, @$aref);
        
    # Prepare and return the bridged response.
    $response = $coder->encode_response($response); 
    send_xml($response);
}

# Send an HTTP error and exit.
sub http_error ($$) {
    my ($code, $message) = @_;
    my $code = "HTTP Error $code";   
    send_xml(
        $coder->encode_response($code, $message)
    );
    exit 0;
}

# Send an XML document (but don't exit).
sub send_xml ($) {
    my ($xml_string) = @_;
    my $length = length($xml_string);
    print <<"EOD";
Status: 200 OK
Content-type: text/xml
Content-length: $length

EOD
    # We want precise control over whitespace here.
    print $xml_string;
}

bridge_call();

__END__

=head1 NAME

XML-RPC Bridge

=head1 VERSION

Release date = 2005-09-10

=head1 SYNOPSIS 

B<C<perl gus_xml-rpc_bridge.pl>>

B<C<http://127.0.0.1/cgi-bin/gus_xml-rpc_bridge.pl>>

B<C<http://127.0.0.1/RPC2>>

=head1 DESCRIPTION

An XML-RPC CGI bridge for port-forwarding fromB<C< cgi-bin >>in Apache webserver to stand-alone XML-RPC server running on the same PC.

=head1 INSTALLATION

Treat the same as any other CGI script on Apache web server.

=head2 For Apache on UNIX

Copy this script into thevof your Apache server. Then check its shebang for your own path to Perl, which...unless you run NetBSD OS...may be something other thanB<C< /usr/pkg/bin/perl >>. Make it executable by performingB<C< chmod 755 >>upon it.

That done, you could simply employ the full URL ofB<C< your_domain/cgi-bin/gus_xml-rpc_bridge.pl >> as the server URL for clients. But it is more elegant to have a URL likeB<C< your_domain/RPC2 >>instead. And it is easy, just add this line to yourB<C< httpd.conf >>file, as below for NetBSD.

ScriptAlias /RPC2 "/usr/pkg/libexec/cgi-bin/gus_xml-rpc_bridge.pl"

=head2 for Apache on Win32

It can be done. That is certain. But this author has not used Apache on Win32 for several years and has forgotten how. Whoever can provide details, please email me.

=head1 DEPENDENCIES

=head2 Perl Modules

Install these into Perl via ActiveState PPM, else into NetBSD pkgsrc or CPAN as appropriate for your OS:B<C< Frontier::Client >>,B<C< Frontier::RPC2 >>,B<C< Sys::Hostname::Long>>.

=head2 Companion XML-RPC Scripts

Particularly useful together with the companion Perl scriptsB<C< gus_xml-rpc_server.pl >>(running on same PC) andB<C< gus_xml-rpc_client_tk.pl >>(running on some other network-attached PC). This Perl CGI script will permit the bridging of a firewall by forwarding from port 80 on Apache through to port 8080 on XML-RPC...and back again. Refer to documentation for companion scripts at these URLs: L<http://starling.us/tet/gus_perl/gus_xml-rpc_pl/gus_xml-rpc_server.html> and L<http://starling.us/tet/gus_perl/gus_xml-rpc_pl/gus_xml-rpc_client_tk.html>.

Of course, the bridge, client and server may all be run on a single PC for testing and experimentation.

=head1 AUTHOR

Gan Uesli Starling <F<gan@starling.us>>

=head1 COPYRIGHT

Copyright (c) 2005, Gan Uesli Starling. All rights reserved.
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

=head1 SCRIPT CATEGORIES

Network

=cut