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