submit/MO/Submit.pm

   1 # A Perl module for communicating with the MO Submit Server
   2 # (c) 2007 Martin Mares <mj@ucw.cz>
   3
   4 package MO::Submit;
   5
   6 use strict;
   7 use warnings;
   8
   9 use IO::Socket::INET;
  10 use IO::Socket::SSL; # qw(debug3);
  11 use Sherlock::Object;
  12
  13 sub new($) {
  14         my $self = {
  15                 "Server" => "localhost:8888",
  16                 "Key" => "client-key.pem",
  17                 "Cert" => "client-cert.pem",
  18                 "CACert" => "ca-cert.pem",
  19                 "Trace" => 0,
  20                 "user" => "testuser",
  21                 "sk" => undef,
  22                 "error" => undef,
  23         };
  24         # FIXME: Read config file
  25         return bless $self;
  26 }
  27
  28 sub DESTROY($) {
  29         my $self = shift @_;
  30         $self->disconnect;
  31 }
  32
  33 sub log($$) {
  34         my ($self, $msg) = @_;
  35         print STDERR "LOG: $msg\n" if $self->{"Trace"};
  36 }
  37
  38 sub err($$) {
  39         my ($self, $msg) = @_;
  40         print STDERR "ERROR: $msg\n" if $self->{"Trace"};
  41         $self->{"error"} = $msg;
  42         $self->disconnect;
  43 }
  44
  45 sub is_connected($) {
  46         my $self = shift @_;
  47         return defined $self->{"sk"};
  48 }
  49
  50 sub disconnect($) {
  51         my $self = shift @_;
  52         if ($self->is_connected) {
  53                 close $self->{"sk"};
  54                 $self->{"sk"} = undef;
  55                 $self->log("Disconnected");
  56         }
  57 }
  58
  59 sub connect($) {
  60         my $self = shift @_;
  61         $self->disconnect;
  62         $self->log("Connecting to submit server");
  63         my $sk = new IO::Socket::INET(
  64                 PeerAddr => $self->{"Server"},
  65                 Proto => "tcp",
  66         );
  67         if (!defined $sk) {
  68                 $self->err("Cannot connect to server: $!");
  69                 return undef;
  70         }
  71         my $z = <$sk>;
  72         if (!defined $z) {
  73                 $self->err("Server failed to send a welcome message");
  74                 close $sk;
  75                 return undef;
  76         }
  77         chomp $z;
  78         if ($z !~ /^\+/) {
  79                 $self->err("Server rejected the connection: $z");
  80                 close $sk;
  81                 return undef;
  82         }
  83         if ($z =~ /TLS/) {
  84                 $self->log("Starting TLS");
  85                 $sk = IO::Socket::SSL->start_SSL(
  86                         $sk,
  87                         SSL_version => 'TLSv1',
  88                         SSL_use_cert => 1,
  89                         SSL_key_file => "client-key.pem",
  90                         SSL_cert_file => "client-cert.pem",
  91                         SSL_ca_file => "ca-cert.pem",
  92                         SSL_verify_mode => 3,
  93                 );
  94                 if (!defined $sk) {
  95                         $self->err("Cannot establish TLS connection: " . IO::Socket::SSL::errstr());
  96                         return undef;
  97                 }
  98         }
  99         $self->{"sk"} = $sk;
 100
 101         $self->log("Logging in");
 102         my $req = new Sherlock::Object("U" => $self->{"user"});
 103         my $reply = $self->request($req);
 104         my $err = $reply->get("-");
 105         if (defined $err) {
 106                 $self->err("Cannot log in: $err");
 107                 return undef;
 108         }
 109
 110         $self->log("Connected");
 111         return 1;
 112 }
 113
 114 sub request($$) {
 115         my ($self, $obj) = @_;
 116         my $sk = $self->{"sk"};
 117         $obj->write($sk);       ### FIXME: Flushing
 118         if ($sk->error) {
 119                 $self->err("Connection broken");
 120                 return undef;
 121         }
 122         print $sk "\n";
 123         return $self->reply;
 124 }
 125
 126 sub reply($) {
 127         my ($self, $obj) = @_;
 128         my $sk = $self->{"sk"};
 129         my $reply = new Sherlock::Object;
 130         if ($reply->read($sk)) {
 131                 return $reply;
 132         } else {
 133                 $self->err("Connection broken");
 134                 return undef;
 135         }
 136 }
 137
 138 sub send_file($$$) {
 139         my ($self, $fh, $size) = @_;
 140         my $sk = $self->{"sk"};
 141         while ($size) {
 142                 my $l = ($size < 4096 ? $size : 4096);
 143                 my $buf = "";
 144                 if ($fh->read($buf, $l) != $l) {
 145                         $self->err("File shrunk during upload");
 146                         return undef;
 147                 }
 148                 $sk->write($buf, $l);
 149                 if ($sk->error) {
 150                         $self->err("Connection broken");
 151                         return undef;
 152                 }
 153                 $size -= $l;
 154         }
 155         return $self->reply;
 156 }
 157
 158 1;