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