1#!perl -w 2 3use strict; 4use Net::SSLeay; 5use Socket; 6use IO::Socket::SSL; 7 8if ( 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 15if ( $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 20use vars qw( $SSL_SERVER_ADDR ); 21do "t/ssl_settings.req" || do "ssl_settings.req"; 22 23# if we have an IDN library max the IDN tests too 24my $can_idn = eval { require Encode } && 25 ( eval { require Net::LibIDN } || eval { require Net::IDN::Encode } || eval { require URI; URI->VERSION(1.50) } ); 26 27$|=1; 28my $max = 40; 29$max+=3 if $can_idn; 30print "1..$max\n"; 31 32my $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); 42warn "\$!=$!, \$\@=$@, S\$SSL_ERROR=$SSL_ERROR" if ! $server; 43print "not ok\n", exit if !$server; 44ok("Server Initialization"); 45my $SSL_SERVER_PORT = $server->sockport; 46 47defined( my $pid = fork() ) || die $!; 48if ( $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 Demo 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 'smtp.mydomain.localizing.useless.local' => [], 92 ); 93 if ( $can_idn ) { 94 # check IDN handling 95 my $loewe = "l\366we.idntest.local"; 96 push @tests, ( $loewe => [qw(smtp ldap www)] ); 97 } 98 99 while (@tests) { 100 my ($host,$expect) = splice(@tests,0,2); 101 my %expect = map { $_=>1 } @$expect; 102 for my $typ (qw( smtp ldap www)) { 103 my $is = $client->verify_hostname( $host, $typ ) ? 'pass':'fail'; 104 my $want = $expect{$typ} ? 'pass':'fail'; 105 print "not " if $is ne $want; 106 ok( "$want $host $typ" ); 107 } 108 } 109 110 exit; 111} 112 113my $csock = $server->accept; 114wait; 115 116 117 118sub ok { print "ok #$_[0]\n"; } 119 120