git.maemo.org Git - pkg-perl/blob - deb-src/libio-socket-ssl-perl/libio-socket-ssl-perl-1.16/t/cert_no_file.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 # Tests the use if SSL_cert instead of SSL_cert_file
   6 # because Net::SSLeay does not implement the necessary functions
   7 # to create a X509 from file/string (PEM_read_bio_X509) I just
   8 # create a server with SSL_cert_file and get the X509 from it using
   9 # Net::SSLeay::get_certificate.
  10 # Test should also test if SSL_cert is an array of X509*
  11 # and if SSL_key is an EVP_PKEY* but with the current function in
  12 # Net::SSLeay I don't see a way to test it
  13
  14 use Net::SSLeay;
  15 use Socket;
  16 use IO::Socket::SSL;
  17 use strict;
  18
  19 use vars qw( $SSL_SERVER_ADDR );
  20 do "t/ssl_settings.req" || do "ssl_settings.req";
  21
  22 if ( grep { $^O =~m{$_} } qw( MacOS VOS vmesa riscos amigaos ) ) {
  23     print "1..0 # Skipped: fork not implemented on this platform\n";
  24     exit
  25 }
  26
  27 $|=1;
  28 print "1..9\n";
  29
  30 my $ID = 'server';
  31 my %server_args = (
  32     LocalAddr => $SSL_SERVER_ADDR,
  33     Listen => 2,
  34     ReuseAddr => 1,
  35     SSL_server => 1,
  36     SSL_verify_mode => 0x00,
  37     SSL_ca_file => "certs/test-ca.pem",
  38     SSL_key_file => "certs/client-key.pem",
  39 );
  40
  41 my ($x509,@server);
  42 foreach my $test ( 1,2,3 ) {
  43     my %args = %server_args;
  44     my $spec;
  45     if ( $test == 1 ) {
  46         # 1st test:  create server with SSL_cert_file
  47         $args{SSL_cert_file} = "certs/client-cert.pem";
  48         $spec = 'Using SSL_cert_file';
  49     } elsif ( $test == 2 ) {
  50         # 2nd test:  use x509 from previous server
  51         # with SSL_cert instead of SSL_cert_file
  52         $args{SSL_cert} = $x509;
  53         $spec = 'Using SSL_cert';
  54     } elsif ( $test == 3 ) {
  55         # 3rd test: empty SSL_cert, so that default
  56         # SSL_cert_file gets not used
  57         # server creation should fail
  58         $spec = 'Empty SSL_cert';
  59         $args{SSL_cert} = undef;
  60     }
  61
  62     # create server
  63     my $server = IO::Socket::SSL->new( %args ) || do {
  64         notok( "$spec: $!" );
  65         next;
  66     };
  67     my ($port) = unpack_sockaddr_in( getsockname($server) );
  68     #DEBUG( "Server listening to $SSL_SERVER_ADDR:$port" );
  69     ok("Server Initialization $spec");
  70     push @server,$server;
  71
  72
  73     # then connect to it from a child
  74     defined( my $pid = fork() ) || die $!;
  75     if ( $pid == 0 ) {
  76         close($server);
  77         $ID = 'client';
  78
  79         my $to_server = IO::Socket::SSL->new(
  80             PeerAddr => $SSL_SERVER_ADDR,
  81             PeerPort => $port,
  82             SSL_verify_mode => 0x00,
  83         );
  84         if ( $test == 3 ) {
  85             notok( "$spec: connect suceeded" ) if $to_server;
  86             ok( "$spec: connect failed" );
  87             exit;
  88         } elsif ( ! $to_server ) {
  89             notok( "connect failed: $!" );
  90             exit
  91         };
  92         ok( "client connected $spec" );
  93         <$to_server>; # wait for close from parent
  94         exit;
  95     }
  96
  97     my $to_client = $server->accept;
  98     if ( $test == 3 ) {
  99         notok( "$spec: accept suceeded" ) if $to_client;
 100         ok( "$spec: accept failed" );
 101     } elsif ( ! $to_client ) {
 102         notok( "$spec: accept failed: $!" );
 103         kill(9,$pid);
 104     } else {
 105         ok( "Server accepted $spec" );
 106         # save the X509 certificate from the server
 107         $x509 ||= Net::SSLeay::get_certificate($to_client->_get_ssl_object);
 108     }
 109
 110     close($to_client) if $to_client;
 111     wait;
 112 }
 113
 114
 115
 116 sub ok { print "ok # [$ID] @_\n"; }
 117 sub notok { print "not ok # [$ID] @_\n"; }