add RPC over SCGI talker (rough draft)

buggy: does not do anything, can't connect twice

diff --git a/xmlrtorrent/SocketTalker.pm b/xmlrtorrent/SocketTalker.pm
new file mode 100644 (file)
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;