xmlrtorrent/SocketTalker.pm

   1 # Talker using SCGI over Unix Domain Socket
   2 #
   3 # (c) 2008 by Christian Garbs <mitch@cgarbs.de>
   4 # licensed under GNU GPL v2
   5
   6 package xmlrtorrent::SocketTalker;
   7 use xmlrtorrent::RTorrentTalkerBase;
   8 @ISA = qw(xmlrtorrent::RTorrentTalkerBase);
   9
  10 use RPC::XML;
  11 use RPC::XML::Parser;
  12 use IO::Socket::UNIX;
  13 use strict;
  14
  15 sub new {
  16     my $class = shift;
  17     my $self = $class->SUPER::new();
  18
  19     $self->{'NAME'} = 'socket';
  20     $self->{'DESC'} = 'talker using SCGI over Unix Domain Socket';
  21     $self->{'_PARAMS'} = {
  22         'SOCKET' => ['', 'filename of socket'],
  23     };
  24     $self->{'__RPCXMLPARSER'} = RPC::XML::Parser->new();
  25
  26     bless($self, $class);
  27
  28     $self->_prepare_parameters();
  29
  30     return $self;
  31 }
  32
  33 sub _create_netstring($$) {
  34     my $self = shift;
  35     my $string = shift;
  36     my $len = length $string;
  37     return "$len:$string,";
  38 }
  39
  40 sub _create_scgi_header($$$) {
  41     my $self = shift;
  42     my ($name, $value) = (@_);
  43     return "$name\0$value\0";
  44 }
  45
  46 sub send_request {
  47     my $self = shift;
  48     my (@params) = (@_);
  49
  50     my $socketfile = $self->_getval('SOCKET');
  51
  52     unless (defined $socketfile and $socketfile ne '') {
  53         return 'socket talker: SOCKET not set';
  54     }
  55
  56     # prepare socket
  57     my $socket = IO::Socket::UNIX->new(
  58                        'Type' => SOCK_STREAM,
  59                         'Peer' => $socketfile,
  60                         )
  61         or return "socket talker: cannot connect to SOCKET: $!";
  62     $socket->autoflush(1);  # default since 1.18, but be sure
  63
  64     # prepare XML RPC request
  65     my $rpc_request = RPC::XML::request->new(@params)->as_string();
  66
  67     # prpepare SCGI request
  68     my $scgi_request =
  69         $self->_create_netstring(
  70                     $self->_create_scgi_header('CONTENT_LENGTH', length $rpc_request)
  71                     .
  72                     $self->_create_scgi_header('SCGI', '1')
  73                     )
  74         .
  75         $rpc_request;
  76
  77     # write to socket
  78     $socket->print($scgi_request);
  79
  80     # read from socket
  81     while (my $line = <$socket>) {
  82         last if ($line =~ /^\s*$/);  # munch headers
  83     }
  84     my $ret = '';
  85     while (my $line = <$socket>) {
  86         $ret .= $line;
  87     }
  88
  89     $socket->close() or return "socket talker: cannot close SOCKET: $!";
  90
  91     return $self->{'__RPCXMLPARSER'}->parse($ret);
  92 }
  93
  94 1;