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