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

   1 #!perl -w
   2
   3 use strict;
   4 use Net::SSLeay;
   5 use Socket;
   6 use IO::Socket::SSL;
   7
   8 if ( grep { $^O =~m{$_} } qw( MacOS VOS vmesa riscos amigaos ) ) {
   9         print "1..0 # Skipped: fork not implemented on this platform\n";
  10         exit
  11 }
  12
  13 # subjectAltNames are not supported or buggy in older versions,
  14 # so certificates cannot be checked
  15 if ( $Net::SSLeay::VERSION < 1.33 ) {
  16         print "1..0 # Skipped because of \$Net::SSLeay::VERSION= $Net::SSLeay::VERSION <1.33\n";
  17         exit;
  18 }
  19
  20 use vars qw( $SSL_SERVER_ADDR );
  21 do "t/ssl_settings.req" || do "ssl_settings.req";
  22
  23 # if we have an IDN library max the IDN tests too
  24 my $can_idn  = eval { require Encode } &&
  25         ( eval { require Net::LibIDN } || eval { require Net::IDN::Encode } );
  26
  27 $|=1;
  28 my $max = 37;
  29 $max+=3 if $can_idn;
  30 print "1..$max\n";
  31
  32 my $server = IO::Socket::SSL->new(
  33         LocalAddr => $SSL_SERVER_ADDR,
  34         Listen => 2,
  35         ReuseAddr => 1,
  36         SSL_server => 1,
  37         #SSL_verify_mode => 0x00,
  38         SSL_ca_file => "certs/test-ca.pem",
  39         SSL_cert_file => "certs/server-wildcard.pem",
  40         SSL_key_file => "certs/server-wildcard.pem",
  41 );
  42 warn "\$!=$!, \$\@=$@, S\$SSL_ERROR=$SSL_ERROR" if ! $server;
  43 print "not ok\n", exit if !$server;
  44 ok("Server Initialization");
  45 my $SSL_SERVER_PORT = $server->sockport;
  46
  47 defined( my $pid = fork() ) || die $!;
  48 if ( $pid == 0 ) {
  49
  50         close($server);
  51         my $client = IO::Socket::SSL->new( "$SSL_SERVER_ADDR:$SSL_SERVER_PORT" )
  52                 || print "not ";
  53         ok( "client ssl connect" );
  54
  55         my $issuer = $client->peer_certificate( 'issuer' );
  56         print "not " if $issuer !~m{IO::Socket::SSL Test CA};
  57         ok("issuer");
  58
  59         my $cn = $client->peer_certificate( 'cn' );
  60         print "not " unless $cn eq "server.local";
  61         ok("cn");
  62
  63         my @alt = $client->peer_certificate( 'subjectAltNames' );
  64         my @want = (
  65                 GEN_DNS() => '*.server.local',
  66                 GEN_IPADD() => '127.0.0.1',
  67                 GEN_DNS() => 'www*.other.local',
  68                 GEN_DNS() => 'smtp.mydomain.local',
  69                 GEN_DNS() => 'xn--lwe-sna.idntest.local',
  70         );
  71         while (@want) {
  72                 my ($typ,$text) = splice(@want,0,2);
  73                 my $data = ($typ == GEN_IPADD() ) ? inet_aton($text):$text;
  74                 my ($th,$dh) = splice(@alt,0,2);
  75                 $th == $typ and $dh eq $data or print "not ";
  76                 ok( $text );
  77         }
  78         @alt and print "not ";
  79         ok( 'no more altSubjectNames' );
  80
  81         my @tests = (
  82                 '127.0.0.1' => [qw( smtp ldap www)],
  83                 'server.local' => [qw(smtp ldap)],
  84                 'blafasel.server.local' => [qw(ldap www)],
  85                 'lala.blafasel.server.local' => [],
  86                 'www.other.local' => [qw(www)],
  87                 'www-13.other.local' => [qw(www)],
  88                 'www-13.lala.other.local' => [],
  89                 'smtp.mydomain.local' => [qw(smtp ldap www)],
  90                 'xn--lwe-sna.idntest.local' => [qw(smtp ldap www)],
  91         );
  92         if ( $can_idn ) {
  93                 # check IDN handling
  94                 my $loewe = "l\366we.idntest.local";
  95                 push @tests, ( $loewe => [qw(smtp ldap www)] );
  96         }
  97
  98         while (@tests) {
  99                 my ($host,$expect) = splice(@tests,0,2);
 100                 my %expect = map { $_=>1 } @$expect;
 101                 for my $typ (qw( smtp ldap www)) {
 102                         my $is = $client->verify_hostname( $host, $typ ) ? 'pass':'fail';
 103                         my $want = $expect{$typ} ? 'pass':'fail';
 104                         print "not " if $is ne $want;
 105                         ok( "$want $host $typ" );
 106                 }
 107         }
 108
 109         exit;
 110 }
 111
 112 my $csock = $server->accept;
 113 wait;
 114
 115
 116
 117 sub ok { print "ok #$_[0]\n"; }
 118