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