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 $self = {
  15                 "Server" => "localhost:8888",
  16                 "Key" => "client-key.pem",
  17                 "Cert" => "client-cert.pem",
  18                 "CACert" => "ca-cert.pem",
  19                 "user" => "testuser",
  20                 "sk" => undef,
  21                 "error" => undef,
  22         };
  23         # FIXME: Read config file
  24         return bless $self;
  25 }
  26
  27 sub log($$) {
  28         my ($self, $msg) = @_;
  29         print STDERR "LOG: $msg\n";
  30 }
  31
  32 sub err($$) {
  33         my ($self, $msg) = @_;
  34         print STDERR "ERROR: $msg\n";
  35         $self->{"error"} = $msg;
  36 }
  37
  38 sub is_connected($) {
  39         my $self = shift @_;
  40         return defined $self->{"sk"};
  41 }
  42
  43 sub disconnect($) {
  44         my $self = shift @_;
  45         if ($self->is_connected) {
  46                 close $self->{"sk"};
  47                 $self->{"sk"} = undef;
  48                 $self->log("Disconnected");
  49         }
  50 }
  51
  52 sub connect($) {
  53         my $self = shift @_;
  54         !defined $self->{"sk"} or close $self->{"sk"};
  55         $self->log("Connecting to submit server");
  56         my $sk = new IO::Socket::INET(
  57                 PeerAddr => $self->{"Server"},
  58                 Proto => "tcp",
  59         );
  60         if (!defined $sk) {
  61                 $self->err("Cannot connect to server: $!");
  62                 return undef;
  63         }
  64         my $z = <$sk>;
  65         if (!defined $z) {
  66                 $self->err("Server failed to send a welcome message");
  67                 close $sk;
  68                 return undef;
  69         }
  70         chomp $z;
  71         if ($z !~ /^\+/) {
  72                 $self->err("Server rejected the connection: $z");
  73                 close $sk;
  74                 return undef;
  75         }
  76         if ($z =~ /TLS/) {
  77                 $self->log("Starting TLS");
  78                 $sk = IO::Socket::SSL->start_SSL(
  79                         $sk,
  80                         SSL_version => 'TLSv1',
  81                         SSL_use_cert => 1,
  82                         SSL_key_file => "client-key.pem",
  83                         SSL_cert_file => "client-cert.pem",
  84                         SSL_ca_file => "ca-cert.pem",
  85                         SSL_verify_mode => 3,
  86                 );
  87                 if (!defined $sk) {
  88                         $self->err("Cannot establish TLS connection: " . IO::Socket::SSL::errstr());
  89                         return undef;
  90                 }
  91         }
  92         $self->{"sk"} = $sk;
  93
  94         $self->log("Logging in");
  95         my $req = new Sherlock::Object("U" => $self->{"user"});
  96         my $reply = $self->request($req);
  97         my $err = $reply->get("-");
  98         if (defined $err) {
  99                 $self->err("Cannot log in: $err");
 100                 $self->disconnect;
 101                 return undef;
 102         }
 103
 104         $self->log("Connected");
 105         return 1;
 106 }
 107
 108 sub request($$) {
 109         my ($self, $obj) = @_;
 110         my $sk = $self->{"sk"};
 111         $obj->write($sk);       ### FIXME: Flushing
 112         print $sk "\n";
 113         return $self->reply;
 114 }
 115
 116 sub reply($) {
 117         my ($self, $obj) = @_;
 118         my $sk = $self->{"sk"};
 119         my $reply = new Sherlock::Object;
 120         if ($reply->read($sk)) {
 121                 return $reply;
 122         } else {
 123                 $self->err("Connection broken");
 124                 return undef;
 125         }
 126 }
 127
 128 1;