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