]> mj.ucw.cz Git - moe.git/commitdiff
Generalized the Perl connection interface to a package.
authorMartin Mares <mj@ucw.cz>
Tue, 5 Jun 2007 10:16:21 +0000 (12:16 +0200)
committerMartin Mares <mj@ucw.cz>
Tue, 5 Jun 2007 10:16:21 +0000 (12:16 +0200)
submit/MO/Submit.pm [new file with mode: 0644]
submit/test.pl

diff --git a/submit/MO/Submit.pm b/submit/MO/Submit.pm
new file mode 100644 (file)
index 0000000..5852b80
--- /dev/null
@@ -0,0 +1,128 @@
+# A Perl module for communicating with the MO Submit Server
+# (c) 2007 Martin Mares <mj@ucw.cz>
+
+package MO::Submit;
+
+use strict;
+use warnings;
+
+use IO::Socket::INET;
+use IO::Socket::SSL; # qw(debug3);
+use Sherlock::Object;
+
+sub new($) {
+       my $self = {
+               "Server" => "localhost:8888",
+               "Key" => "client-key.pem",
+               "Cert" => "client-cert.pem",
+               "CACert" => "ca-cert.pem",
+               "user" => "testuser",
+               "sk" => undef,
+               "error" => undef,
+       };
+       # FIXME: Read config file
+       return bless $self;
+}
+
+sub log($$) {
+       my ($self, $msg) = @_;
+       print STDERR "LOG: $msg\n";
+}
+
+sub err($$) {
+       my ($self, $msg) = @_;
+       print STDERR "ERROR: $msg\n";
+       $self->{"error"} = $msg;
+}
+
+sub is_connected($) {
+       my $self = shift @_;
+       return defined $self->{"sk"};
+}
+
+sub disconnect($) {
+       my $self = shift @_;
+       if ($self->is_connected) {
+               close $self->{"sk"};
+               $self->{"sk"} = undef;
+               $self->log("Disconnected");
+       }
+}
+
+sub connect($) {
+       my $self = shift @_;
+       !defined $self->{"sk"} or close $self->{"sk"};
+       $self->log("Connecting to submit server");
+       my $sk = new IO::Socket::INET(
+               PeerAddr => $self->{"Server"},
+               Proto => "tcp",
+       );
+       if (!defined $sk) {
+               $self->err("Cannot connect to server: $!");
+               return undef;
+       }
+       my $z = <$sk>;
+       if (!defined $z) {
+               $self->err("Server failed to send a welcome message");
+               close $sk;
+               return undef;
+       }
+       chomp $z;
+       if ($z !~ /^\+/) {
+               $self->err("Server rejected the connection: $z");
+               close $sk;
+               return undef;
+       }
+       if ($z =~ /TLS/) {
+               $self->log("Starting TLS");
+               $sk = IO::Socket::SSL->start_SSL(
+                       $sk,
+                       SSL_version => 'TLSv1',
+                       SSL_use_cert => 1,
+                       SSL_key_file => "client-key.pem",
+                       SSL_cert_file => "client-cert.pem",
+                       SSL_ca_file => "ca-cert.pem",
+                       SSL_verify_mode => 3,
+               );
+               if (!defined $sk) {
+                       $self->err("Cannot establish TLS connection: " . IO::Socket::SSL::errstr());
+                       return undef;
+               }
+       }
+       $self->{"sk"} = $sk;
+
+       $self->log("Logging in");
+       my $req = new Sherlock::Object("U" => $self->{"user"});
+       my $reply = $self->request($req);
+       my $err = $reply->get("-");
+       if (defined $err) {
+               $self->err("Cannot log in: $err");
+               $self->disconnect;
+               return undef;
+       }
+
+       $self->log("Connected");
+       return 1;
+}
+
+sub request($$) {
+       my ($self, $obj) = @_;
+       my $sk = $self->{"sk"};
+       $obj->write($sk);       ### FIXME: Flushing
+       print $sk "\n";
+       return $self->reply;
+}
+
+sub reply($) {
+       my ($self, $obj) = @_;
+       my $sk = $self->{"sk"};
+       my $reply = new Sherlock::Object;
+       if ($reply->read($sk)) {
+               return $reply;
+       } else {
+               $self->err("Connection broken");
+               return undef;
+       }
+}
+
+1;
index ff36335eeb9beede311aa3ffab18dd2981a3e476..6b4b7b18a9349f4134735d155cc49fde65602e24 100755 (executable)
@@ -3,55 +3,14 @@
 use strict;
 use warnings;
 
-use IO::Socket::INET;
-use IO::Socket::SSL; # qw(debug3);
-
+use lib ".";
 use lib "lib/perl5";
-use Sherlock::Object;
-
-my $sk = new IO::Socket::INET(
-#      PeerAddr => "nikam.ms.mff.cuni.cz:443",
-       PeerAddr => "localhost:8888",
-       Proto => "tcp",
-) or die "Cannot connect to server: $!";
-
-my $z = <$sk>;
-defined $z or die "Server failed to send welcome message\n";
-$z =~ /^\+/ or die "Server reported error: $z";
-print $z;
 
-if ($z =~ /TLS/) {
-       $sk = IO::Socket::SSL->start_SSL(
-               $sk,
-               SSL_version => 'TLSv1',
-               SSL_use_cert => 1,
-               SSL_key_file => "client-key.pem",
-               SSL_cert_file => "client-cert.pem",
-               SSL_ca_file => "ca-cert.pem",
-               SSL_verify_mode => 3,
-       ) or die "Cannot establish TLS connection: " . IO::Socket::SSL::errstr() . "\n";
-}
-
-sub req($) {
-       my $x = shift @_;
-       $x->write($sk);
-       print $sk "\n";
-}
-
-sub reply() {
-       my $x = new Sherlock::Object;
-       $x->read($sk) or die "Incomplete reply";
-       $x->get('+') or die "-" . $x->get('-') . "\n";
-       return $x;
-}
-
-my $req;
-my $reply;
+use MO::Submit;
+use Sherlock::Object;
 
-$req = new Sherlock::Object;
-$req->set("U" => "testuser");
-req($req);
-$reply = reply();
+my $conn = new MO::Submit;
+$conn->connect or die;
 
 #$req = new Sherlock::Object;
 #$req->set("!" => "SUBMIT", "T" => "plans", "X" => "pas", "S" => 100);
@@ -60,10 +19,8 @@ $reply = reply();
 #print $sk "<..................................................................................................>";
 #$reply = reply();
 
-$req = new Sherlock::Object;
-$req->set("!" => "STATUS");
-req($req);
-$reply = reply();
-$reply->write_indented(*STDOUT);
+my $r = new Sherlock::Object("!" => "STATUS");
+$r = $conn->request($r) or die;
+$r->write_indented(*STDOUT);
 
-close $sk;
+$conn->disconnect;