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