root/trunk/hotstuff/dxs/cdxs.pl

#!/usr/bin/perl
#
# Server for compressed SOAP messages for DXS (cDXS protocol)
# Copyright (C) 2005 - 2007 Josef Spillner <josef@kstuff.org>
# Published under 'GNU AGPLv3 or later' conditions

use SOAP::Lite;
use Data::Dumper;
use IO::Socket;

use DXS;

##############################

sub deserialize_inner{
        my $x = shift(@_);

        if(!$x){
                return;
        }

        my @ar;
        if(ref($x) eq "ARRAY"){
                @ar = @{$x};
        }else{
                bless $x, SOAP::Data;
                @ar = $x->value();
        }

        my $s = "";
        foreach my $y(@ar){
                my $tmp = $y->value();
                $s .= $y->name();
                if(ref($tmp) ne "SOAP::Data"){
                        $s .= "(";
                }
                if(substr($tmp, 0, 4) eq "REF("){
                        my $f = $y->value();
                        my %ref = %{$$f};
                        $s .= deserialize_inner($ref{"_value"});
                }elsif(ref($tmp) eq "SOAP::Data"){
                        $s .= deserialize_inner($tmp);
                }else{
                        $tmp =~ s/\(/\\\(/g;
                        $tmp =~ s/\)/\\\)/g;
                        $s .= $tmp;
                }
                if(ref($tmp) ne "SOAP::Data"){
                        $s .= ")\n";
                }
        }
        return $s;
}

sub deserialize{
        my $name = shift(@_);
        my $params = shift(@_);

        my $s = "";
        $s .= "$name(";
        $s .= deserialize_inner($params);
        $s .= ")\n";
        return $s;
}

sub serialize{
        my $input = shift(@_);
        my $inner = shift(@_);

        $input =~ m/([^(]+)(?:\((.+)\))?/;

        my $method = $1;
        my $rest = $2;
        my @entries;

        #print "-> $method\n";
        #print "-> $rest\n";

        if($rest =~ /[^(]+\(.+\)/){
                $rest = substr($rest, 0, length($rest) - 1);
                my @params = split(/\)[,\n\ ]/, $rest);
                my @xdata;
                foreach my $param(@params){
                        $param = "$param)";
                        #print " :: $param\n";

                        my $xdataref = serialize($param, 1);
                        @xdata = (@xdata, @{$xdataref});
                }
                my $data = SOAP::Data->name($method => \SOAP::Data->value(@xdata));
                @entries = (@entries, $data);
        }else{
                #print "ok\n";
                my $data = SOAP::Data->name($method => $rest);
                @entries = (@entries, $data);
        }

        if($inner){
                return [@entries];
        }

        my $data = $entries[0];
        my $f = $data->value();
        my %ref = %{$$f};
        return ($method, $ref{"_value"});
}

##############################

sub handle{
        my $inputtree = shift(@_);

        my ($method, $input) = serialize($inputtree);

        my $som = SOAP::SOM->new($input);
        my @args = ($som);
        my $ret = eval("DXS::$method(DXS, \@args)");

        my $outputtree = deserialize("$method" . "Response", $ret);
        return $outputtree;
}

my $port = 30303;

my $proto = getprotobyname("tcp");
socket(SERVER, PF_INET, SOCK_STREAM, $proto);
setsockopt(SERVER, SOL_SOCKET, SO_REUSEADDR, pack("l", 1));

bind(SERVER, sockaddr_in($port, INADDR_ANY));
listen(SERVER, SOMAXCONN);
print "cDXS server started on $port...\n";

my $in;
while(1){
        $sock = accept(CLIENT, SERVER);

        print "* connection!\n";
        my $input = "";
        my $reader = 1;
        while($reader){
                my $in = <CLIENT>;
                chomp $in;
                print "-- $in\n";
                if($in eq ""){
                        last;
                }
                $input .= "$in\n";
                if($in eq ")"){
                        $reader = 0;
                }
                if($in =~ /^\S+\(\)$/){
                        $reader = 0;
                }
        }
        $response = handle($input);
        print "RESPONSE: $response\n";
        print CLIENT $response;
        close(CLIENT);
        print "* terminated.\n";
}

##############################

my $server = SOAP::Data->name("server" => "Desktop Exchange Service (DXS)");
my $version = SOAP::Data->name("version" => "0.1");
my $provider = SOAP::Data->name("provider" => "foo");
my $url = SOAP::Data->name("url" => "bar");
my $x = [$server, $version, $provider, $url];

##############################

my $inputtree = deserialize("GHNSInfoResponse", $x);
print $inputtree;

###############################

$inputtree = "GHNSSubscription(id(0) subscription(1))";

my $output = serialize($inputtree, 1);

print deserialize_inner($output);

###############################

my $category = SOAP::Data->name("category" => "example");
my $r = [$category];

my $method = "GHNSList";

###############################

my $som = SOAP::SOM->new($r);
my @args = ($som);
my $ret = eval("DXS::$method(DXS, \@args)");

my $outputtree = deserialize("$method" . "Response", $ret);
print $outputtree;