git.maemo.org Git - dh-make-perl/blob - dev/i386/libio-socket-ssl-perl/libio-socket-ssl-perl-1.16/t/start-stopssl.t

   1
   2 use strict;
   3 use IO::Socket::INET;
   4 use IO::Socket::SSL;
   5
   6 if ( grep { $^O =~m{$_} } qw( MacOS VOS vmesa riscos amigaos ) ) {
   7     print "1..0 # Skipped: fork not implemented on this platform\n";
   8     exit
   9 }
  10
  11 use vars qw( $SSL_SERVER_ADDR );
  12 do "t/ssl_settings.req" || do "ssl_settings.req";
  13
  14 $|=1;
  15 my @tests = qw( start stop start close );
  16 print "1..16\n";
  17
  18 my $server = IO::Socket::INET->new(
  19     LocalAddr => $SSL_SERVER_ADDR,
  20     Listen => 2,
  21     ReuseAddr => 1,
  22 ) || die "not ok #tcp listen failed: $!\n";
  23 print "ok #listen\n";
  24 my ($SSL_SERVER_PORT) = unpack_sockaddr_in( $server->sockname );
  25
  26 defined( my $pid = fork() ) || die $!;
  27 $pid ? server():client();
  28 wait;
  29 exit(0);
  30
  31
  32 sub client {
  33     close($server);
  34     my $client = IO::Socket::INET->new( "$SSL_SERVER_ADDR:$SSL_SERVER_PORT" ) or
  35         die "not ok #client connect: $!\n";
  36     $client->autoflush;
  37     print "ok #client connect\n";
  38
  39     for my $test (@tests) {
  40         alarm(15);
  41         #print STDERR "begin test $test\n";
  42         if ( $test eq 'start' ) {
  43             print $client "start\n";
  44             sleep(1); # avoid race condition, if client calls start but server is not yet available
  45
  46             #print STDERR ">>$$(client) start\n";
  47             IO::Socket::SSL->start_SSL( $client )
  48                 || die "not ok #client::start_SSL: $SSL_ERROR\n";
  49             #print STDERR "<<$$(client) start\n";
  50             print "ok # client::start_SSL\n";
  51
  52             ref($client) eq "IO::Socket::SSL" or print "not ";
  53             print "ok #  client::class=".ref($client)."\n";
  54
  55         } elsif ( $test eq 'stop' ) {
  56             print $client "stop\n";
  57             $client->stop_SSL || die "not ok #client::stop_SSL\n";
  58             print "ok # client::stop_SSL\n";
  59
  60             ref($client) eq "IO::Socket::INET" or print "not ";
  61             print "ok #  client::class=".ref($client)."\n";
  62
  63         } elsif ( $test eq 'close' ) {
  64             print $client "close\n";
  65             my $class = ref($client);
  66             $client->close || die "not ok # client::close\n";
  67             print "ok # client::close\n";
  68
  69             ref($client) eq $class or print "not ";
  70             print "ok #  client::class=".ref($client)."\n";
  71             last;
  72         }
  73         #print STDERR "cont test $test\n";
  74
  75         defined( my $line = <$client> ) or return;
  76         die "'$line'" if $line ne "OK\n";
  77     }
  78 }
  79
  80
  81 sub server {
  82     my $client = $server->accept || die $!;
  83     $client->autoflush;
  84     while (1) {
  85         alarm(15);
  86         defined( my $line = <$client> ) or last;
  87         chomp($line);
  88         if ( $line eq 'start' ) {
  89             #print STDERR ">>$$ start\n";
  90             IO::Socket::SSL->start_SSL( $client,
  91                 SSL_server => 1,
  92                 SSL_cert_file => "certs/client-cert.pem",
  93                 SSL_key_file => "certs/client-key.pem"
  94             ) || die "not ok #server::start_SSL: $SSL_ERROR\n";
  95             #print STDERR "<<$$ start\n";
  96
  97             ref($client) eq "IO::Socket::SSL" or print "not ";
  98             print "ok # server::class=".ref($client)."\n";
  99             print $client "OK\n";
 100
 101         } elsif ( $line eq 'stop' ) {
 102             $client->stop_SSL || die "not ok #server::stop_SSL\n";
 103             print "ok #server::stop_SSL\n";
 104
 105             ref($client) eq "IO::Socket::INET" or print "not ";
 106             print "ok # class=".ref($client)."\n";
 107             print $client "OK\n";
 108
 109         } elsif ( $line eq 'close' ) {
 110             my $class = ref($client);
 111             $client->close || die "not ok #server::close\n";
 112             print "ok #server::close\n";
 113
 114             ref($client) eq $class or print "not ";
 115             print "ok # class=".ref($client)."\n";
 116             last;
 117         }
 118     }
 119 }
 120