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 my $sk = new IO::Socket::INET(
  10 #       PeerAddr => "nikam.ms.mff.cuni.cz:443",
  11         PeerAddr => "localhost:8888",
  12         Proto => "tcp",
  13 ) or die "Cannot connect to server: $!";
  14
  15 my $z = <$sk>;
  16 defined $z or die "Server failed to send welcome message\n";
  17 $z =~ /^\+/ or die "Server reported error: $z";
  18 print $z;
  19
  20 if ($z =~ /TLS/) {
  21         $sk = IO::Socket::SSL->start_SSL(
  22                 $sk,
  23                 SSL_version => 'TLSv1',
  24                 SSL_use_cert => 1,
  25                 SSL_key_file => "client-key.pem",
  26                 SSL_cert_file => "client-cert.pem",
  27                 SSL_ca_file => "ca-cert.pem",
  28                 SSL_verify_mode => 3,
  29         ) or die "Cannot establish TLS connection: " . IO::Socket::SSL::errstr() . "\n";
  30 }
  31
  32 sub sendobj($) {
  33         my ($h) = @_;
  34         foreach my $x (keys %{$h}) {
  35                 print $sk $x, $h->{$x}, "\n";
  36         }
  37         print $sk "\n";
  38         # FIXME: flush
  39 };
  40
  41 sub recvobj() {
  42         my $h = {};
  43         while (<$sk>) {
  44                 chomp;
  45                 /^(.)(.*)$/ || last;
  46                 $h->{$1} = $2;
  47         }
  48         if (defined $h->{'-'}) { die "-" . $h->{'-'} . "\n"; }
  49         return $h;
  50 }
  51
  52 sub printobj($) {
  53         my ($h) = @_;
  54         foreach my $x (keys %{$h}) {
  55                 print $x, $h->{$x}, "\n";
  56         }
  57 }
  58
  59 sendobj({ 'U' => 'testuser' });
  60 recvobj();
  61
  62 #sendobj({ '!' => 'SUBMIT', 'T' => 'plans', 'S' => 100, 'X' => 'c' });
  63 #recvobj();
  64 #print $sk "<";
  65 #foreach my $x (1..98) { print $sk "."; }
  66 #print $sk ">";
  67 #recvobj();
  68
  69 sendobj({ '!' => 'STATUS' });
  70 printobj(recvobj());
  71
  72 close $sk;