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