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