From: Martin Mares <mj@ucw.cz>
Date: Tue, 5 Jun 2007 10:16:21 +0000 (+0200)
Subject: Generalized the Perl connection interface to a package.
X-Git-Tag: python-dummy-working~398
X-Git-Url: http://mj.ucw.cz/gitweb/?a=commitdiff_plain;h=c05f79a5d7b6d14d938d25198846c173f27e8b39;p=eval.git

Generalized the Perl connection interface to a package.
---

diff --git a/submit/MO/Submit.pm b/submit/MO/Submit.pm
new file mode 100644
index 0000000..5852b80
--- /dev/null
+++ b/submit/MO/Submit.pm
@@ -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;
diff --git a/submit/test.pl b/submit/test.pl
index ff36335..6b4b7b1 100755
--- a/submit/test.pl
+++ b/submit/test.pl
@@ -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;