submit/test.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use IO::Socket::INET;
   7 use IO::Socket::SSL; # qw(debug3);
   8
   9 use lib "lib/perl5";
  10 use Sherlock::Object;
  11
  12 my $sk = new IO::Socket::INET(
  13 #       PeerAddr => "nikam.ms.mff.cuni.cz:443",
  14         PeerAddr => "localhost:8888",
  15         Proto => "tcp",
  16 ) or die "Cannot connect to server: $!";
  17
  18 my $z = <$sk>;
  19 defined $z or die "Server failed to send welcome message\n";
  20 $z =~ /^\+/ or die "Server reported error: $z";
  21 print $z;
  22
  23 if ($z =~ /TLS/) {
  24         $sk = IO::Socket::SSL->start_SSL(
  25                 $sk,
  26                 SSL_version => 'TLSv1',
  27                 SSL_use_cert => 1,
  28                 SSL_key_file => "client-key.pem",
  29                 SSL_cert_file => "client-cert.pem",
  30                 SSL_ca_file => "ca-cert.pem",
  31                 SSL_verify_mode => 3,
  32         ) or die "Cannot establish TLS connection: " . IO::Socket::SSL::errstr() . "\n";
  33 }
  34
  35 sub sendobj($) {
  36         my ($h) = @_;
  37         foreach my $x (keys %{$h}) {
  38                 print $sk $x, $h->{$x}, "\n";
  39         }
  40         print $sk "\n";
  41         # FIXME: flush
  42 };
  43
  44 sub recvobj() {
  45         my $h = {};
  46         while (<$sk>) {
  47                 chomp;
  48                 /^(.)(.*)$/ || last;
  49                 $h->{$1} = $2;
  50         }
  51         if (defined $h->{'-'}) { die "-" . $h->{'-'} . "\n"; }
  52         return $h;
  53 }
  54
  55 sub printobj($) {
  56         my ($h) = @_;
  57         foreach my $x (keys %{$h}) {
  58                 print $x, $h->{$x}, "\n";
  59         }
  60 }
  61
  62 sub req($) {
  63         my $x = shift @_;
  64         $x->write($sk);
  65         print $sk "\n";
  66 }
  67
  68 sub reply() {
  69         my $x = new Sherlock::Object;
  70         $x->read($sk) or die "Incomplete reply";
  71         $x->get('+') or die "-" . $x->get('-') . "\n";
  72         return $x;
  73 }
  74
  75 my $req;
  76 my $reply;
  77
  78 $req = new Sherlock::Object;
  79 $req->set("U" => "testuser");
  80 req($req);
  81 $reply = reply();
  82
  83 $req = new Sherlock::Object;
  84 $req->set("!" => "STATUS");
  85 req($req);
  86 $reply = reply();
  87 $reply->write(*STDOUT);
  88
  89 close $sk;