From feda2830239fe2c173411147161db90dc9c304f9 Mon Sep 17 00:00:00 2001
From: Christian Garbs <mitch@cgarbs.de>
Date: Sat, 27 Dec 2008 01:01:01 +0100
Subject: [PATCH] add RPC over SCGI talker (rough draft)

buggy: does not do anything, can't connect twice
---
 xmlrtorrent/SocketTalker.pm | 90 +++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 90 insertions(+)
 create mode 100644 xmlrtorrent/SocketTalker.pm

diff --git a/xmlrtorrent/SocketTalker.pm b/xmlrtorrent/SocketTalker.pm
new file mode 100644
index 0000000..453b7f6
--- /dev/null
+++ b/xmlrtorrent/SocketTalker.pm
@@ -0,0 +1,90 @@
+# Talker using SCGI over Unix Domain Socket
+#
+# (c) 2008 by Christian Garbs <mitch@cgarbs.de>
+# licensed under GNU GPL v2
+
+package xmlrtorrent::SocketTalker;
+use xmlrtorrent::TalkerBase;
+@ISA = qw(xmlrtorrent::TalkerBase);
+
+use RPC::XML;
+use IO::Socket::UNIX;
+use strict;
+
+sub new {
+    my $class = shift;
+    my $self = $class->SUPER::new();
+
+    $self->{'NAME'} = 'socket';
+    $self->{'DESC'} = 'talker using SCGI over Unix Domain Socket';
+    $self->{'_PARAMS'} = {
+	'SOCKET' => ['', 'filename of socket'],
+    };
+
+    bless($self, $class);
+
+    $self->_prepare_parameters();
+
+    return $self;
+}
+
+sub _create_netstring($$) {
+    my $self = shift;
+    my $string = shift;
+    my $len = length $string;
+    return "$len:$string,";
+}
+
+sub _create_scgi_header($$$) {
+    my $self = shift;
+    my ($name, $value) = (@_);
+    return "$name\0$value\0";
+}
+
+sub send_request {
+    my $self = shift;
+    my @params = @_;
+
+    unless (exists($self->{'_PARAMS'}->{'SOCKET'}) and defined($self->{'_PARAMS'}->{'SOCKET'}) and ($self->{'_PARAMS'}->{'SOCKET'} ne '')) {
+	return 'socket talker: SOCKET not set';
+    }
+
+    # prepare socket
+    my $socket = IO::Socket::UNIX->new(
+				       'Type' => SOCK_STREAM,
+				       'Local' => $self->{'_PARAMS'}->{'SOCKET'},
+				       )
+	or return "socket: cannot connect to SOCKET: $!";
+    $socket->autoflush(1);  # default since 1.18, but be sure
+
+    # prepare XML RPC request
+    my $rpc_request = RPC::XML::request->new(@params);
+
+    # prpepare SCGI request
+    my $scgi_request = 
+	$self->_create_netstring(
+				 $self->_create_scgi_header('CONTENT_LENGTH', length $rpc_request)
+				 .
+				 $self->_create_scgi_header('SCGI', '1')
+				 )
+	.
+	$rpc_request;
+    
+    # write to socket
+    $socket->print($scgi_request);
+    
+    # read from socket
+    while (my $line = <$socket>) {
+	last if ($line =~ /^$/);  # munch headers
+    }
+    my $ret = '';
+    while (my $line = <$socket>) {
+	$ret .= $line;
+    }
+
+    $socket->close();
+
+    return $ret;
+}
+
+1;
-- 
1.8.3.1