git.maemo.org Git - pkg-perl/blob - deb-src/libio-socket-ssl-perl/libio-socket-ssl-perl-1.16/t/startssl.t

   1 #!perl -w
   2 # Before `make install' is performed this script should be runnable with
   3 # `make test'. After `make install' it should work as `perl t/nonblock.t'
   4
   5
   6 use Net::SSLeay;
   7 use Socket;
   8 use IO::Socket::SSL;
   9 use IO::Select;
  10 use Errno qw(EAGAIN EINPROGRESS );
  11 use strict;
  12
  13 use vars qw( $SSL_SERVER_ADDR );
  14 do "t/ssl_settings.req" || do "ssl_settings.req";
  15
  16 if ( ! eval "use 5.006; use IO::Select; return 1" ) {
  17     print "1..0 # Skipped: no support for nonblocking sockets\n";
  18     exit;
  19 }
  20 if ( grep { $^O =~m{$_} } qw( MacOS VOS vmesa riscos amigaos ) ) {
  21     print "1..0 # Skipped: fork not implemented on this platform\n";
  22     exit
  23 }
  24
  25 $|=1;
  26 print "1..9\n";
  27
  28
  29 my $server = IO::Socket::INET->new(
  30     LocalAddr => $SSL_SERVER_ADDR,
  31     Listen => 2,
  32     ReuseAddr => 1,
  33 );
  34
  35 print "not ok\n", exit if !$server;
  36 ok("Server Initialization");
  37
  38 print "not " if (!defined fileno($server));
  39 ok("Server Fileno Check");
  40
  41 my ($SSL_SERVER_PORT) = unpack_sockaddr_in( $server->sockname );
  42
  43
  44 defined( my $pid = fork() ) || die $!;
  45 if ( $pid == 0 ) {
  46
  47     close($server);
  48
  49     my %extra_options = $Net::SSLeay::VERSION>=1.16 ?
  50         (
  51             SSL_key_file => "certs/server-key.enc",
  52             SSL_passwd_cb => sub { return "bluebell" },
  53 #           SSL_verify_callback => \&verify_sub
  54         ) : (
  55             SSL_key_file => "certs/server-key.pem"
  56         );
  57
  58     my $client = IO::Socket::INET->new( "$SSL_SERVER_ADDR:$SSL_SERVER_PORT" )
  59         || print "not ";
  60     ok( "client tcp connect" );
  61
  62     unless ( IO::Socket::SSL->start_SSL( $client,
  63         SSL_version => 'TLSv1',
  64         SSL_cipher_list => 'HIGH',
  65         %extra_options
  66     )) {
  67         #DEBUG( $SSL_ERROR );
  68         print "not ";
  69     }
  70     ok( "sslify client" );
  71
  72     UNIVERSAL::isa( $client,'IO::Socket::SSL' ) || print "not ";
  73     ok( 'client reblessed as IO::Socket::SSL' );
  74
  75     print $client "hannibal\n";
  76
  77     exit;
  78 }
  79
  80 my $csock = $server->accept || print "not ";
  81 ok( "tcp accept" );
  82
  83 my %extra_options = $Net::SSLeay::VERSION>=1.16 ?
  84     (
  85         SSL_key_file => "certs/client-key.enc",
  86         SSL_passwd_cb => sub { return "opossum" }
  87     ) : (
  88         SSL_key_file => "certs/client-key.pem"
  89     );
  90
  91 IO::Socket::SSL->start_SSL( $csock,
  92     SSL_server => 1,
  93     SSL_verify_mode => 0x00,
  94     SSL_ca_file => "certs/test-ca.pem",
  95     SSL_use_cert => 1,
  96     SSL_cert_file => "certs/client-cert.pem",
  97     SSL_version => 'TLSv1',
  98     SSL_cipher_list => 'HIGH',
  99     %extra_options
 100 ) || print "not ";
 101 #DEBUG( $IO::Socket::SSL::ERROR );
 102 ok( 'sslify server' );
 103
 104 UNIVERSAL::isa( $csock,'IO::Socket::SSL' ) || print "not ";
 105 ok( 'server reblessed as IO::Socket::SSL' );
 106
 107 my $l = <$csock>;
 108 #DEBUG($l);
 109 print "not " if $l ne "hannibal\n";
 110 ok( "received client message" );
 111
 112
 113 wait;
 114
 115
 116
 117 sub ok { print "ok #$_[0]\n"; }
 118