]> mj.ucw.cz Git - moe.git/blob - submit/MO/Submit.pm
The first bits of the contest GUI.
[moe.git] / 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;