1#!perl -w
2# Before `make install' is performed this script should be runnable with
3# `make test'. After `make install' it should work as `perl t/core.t'
4
5use Net::SSLeay;
6use Socket;
7use IO::Socket::SSL;
8eval {require "t/ssl_settings.req";} ||
9eval {require "ssl_settings.req";};
10
11$NET_SSLEAY_VERSION = $Net::SSLeay::VERSION;
12
13$numtests = 35;
14$|=1;
15
16foreach ($^O) {
17    if (/MacOS/ or /VOS/ or /vmesa/ or /riscos/ or /amigaos/) {
18	print "1..0 # Skipped: fork not implemented on this platform\n";
19	exit;
20    }
21}
22
23if ($NET_SSLEAY_VERSION < 1.26) {
24    print "1..0 \# Skipped: Net::SSLeay version less than 1.26\n";
25    exit;
26}
27
28print "1..$numtests\n";
29
30my %server_options = (
31    SSL_key_file => "certs/server-key.enc", 
32    SSL_passwd_cb => sub { return "bluebell" },
33    LocalAddr => $SSL_SERVER_ADDR,
34    Listen => 2,
35    Timeout => 30,
36    ReuseAddr => 1,
37    SSL_verify_mode => SSL_VERIFY_NONE, 
38    SSL_ca_file => "certs/test-ca.pem",
39    SSL_cert_file => "certs/server-cert.pem",
40    SSL_version => 'TLSv1',
41    SSL_cipher_list => 'HIGH'
42);
43
44
45my @servers = (IO::Socket::SSL->new( %server_options),
46	       IO::Socket::SSL->new( %server_options),
47	       IO::Socket::SSL->new( %server_options));
48
49if (!$servers[0] or !$servers[1] or !$servers[2]) {
50    print "not ok # Server init\n";
51    exit;
52}
53&ok("Server initialization");
54
55my ($SSL_SERVER_PORT)  = unpack_sockaddr_in( $servers[0]->sockname );
56my ($SSL_SERVER_PORT2) = unpack_sockaddr_in( $servers[1]->sockname );
57my ($SSL_SERVER_PORT3) = unpack_sockaddr_in( $servers[2]->sockname );
58
59
60unless (fork) {
61    close $_ foreach @servers;
62    my $ctx = IO::Socket::SSL::SSL_Context->new(
63	 SSL_passwd_cb => sub { return "opossum" },
64    	 SSL_verify_mode => SSL_VERIFY_PEER,
65	 SSL_ca_file => "certs/test-ca.pem",
66	 SSL_ca_path => '',
67	 SSL_version => 'TLSv1',
68	 SSL_cipher_list => 'HIGH',
69	 SSL_session_cache_size => 4
70    );
71
72
73    if (! defined $ctx->{'session_cache'}) {
74	print "not ok \# Context init\n";
75	exit;
76    }
77    &ok("Context init");
78
79    
80    # Bogus session test
81    unless ($ctx->session_cache("bogus", "bogus", 0)) {
82	print "not ";
83    }
84    &ok("Superficial Cache Addition Test");
85
86    unless ($ctx->session_cache("bogus1", "bogus1", 0)) {
87	print "not ";
88    }
89    &ok("Superficial Cache Addition Test 2");
90
91    my $cache = $ctx->{'session_cache'};
92
93    if (keys(%$cache) != 4) {
94	print "not ";
95    }
96    &ok("Cache Keys Check 1");
97
98    unless ($cache->{'bogus1:bogus1'} and $cache->{'bogus:bogus'}) {
99	print "not ";
100    }
101    &ok("Cache Keys Check 2");
102
103    my ($bogus, $bogus1) = ($cache->{'bogus:bogus'}, $cache->{'bogus1:bogus1'});
104    unless ($cache->{'_head'} eq $bogus1) {
105	print "not ";
106    }
107    &ok("Cache Head Check");
108
109    unless ($bogus1->{prev} eq $bogus and
110	    $bogus1->{next} eq $bogus and
111	    $bogus->{prev} eq $bogus1 and
112	    $bogus->{next} eq $bogus1) {
113	print "not ";
114    }
115    &ok("Cache Link Check");
116
117
118    IO::Socket::SSL::set_default_context($ctx);
119
120    my $sock3 = IO::Socket::INET->new(
121    	PeerAddr => $SSL_SERVER_ADDR,
122	PeerPort => $SSL_SERVER_PORT3
123    );
124    my @clients = (
125	IO::Socket::SSL->new("$SSL_SERVER_ADDR:$SSL_SERVER_PORT"),
126        IO::Socket::SSL->new("$SSL_SERVER_ADDR:$SSL_SERVER_PORT2"),
127        IO::Socket::SSL->start_SSL( $sock3 ),
128    );
129    
130    if (!$clients[0] or !$clients[1] or !$clients[2]) {
131	print "not ok \# Client init\n";
132	exit;
133    }
134    &ok("Client init");
135
136    # Make sure that first 'bogus' entry has been removed
137    if (keys(%$cache) != 6) {
138	print "not ";
139    }
140    &ok("Cache Keys Check 3");
141
142    if ($cache->{'bogus:bogus'}) {
143	print "not ";
144    }
145    &ok("Cache Removal Test");
146
147    if ($cache->{'_head'}->{prev} ne $bogus1) {
148	print "not ";
149    }
150    &ok("Cache Tail Check");
151
152    if ($cache->{'_head'} ne $cache->{"$SSL_SERVER_ADDR:$SSL_SERVER_PORT3"}) {
153	print "not ";
154    }
155    &ok("Cache Insertion Test");
156
157    my @server_ports = ($SSL_SERVER_PORT, $SSL_SERVER_PORT2, $SSL_SERVER_PORT3);
158    for (0..2) {
159	if (Net::SSLeay::get_session($clients[$_]->_get_ssl_object) ne 
160	    $cache->{"$SSL_SERVER_ADDR:$server_ports[$_]"}->{session}) {
161	    print "not ";
162	}
163	&ok("Cache Entry Test $_");
164	close $clients[$_];
165    }
166
167    @clients = (
168    	IO::Socket::SSL->new("$SSL_SERVER_ADDR:$SSL_SERVER_PORT"),
169	IO::Socket::SSL->new("$SSL_SERVER_ADDR:$SSL_SERVER_PORT2"),
170	IO::Socket::SSL->new("$SSL_SERVER_ADDR:$SSL_SERVER_PORT3")
171    );
172
173    if (keys(%$cache) != 6) {
174	print "not ";
175    }
176    &ok("Cache Keys Check 4");
177
178    if (!$cache->{'bogus1:bogus1'}) {
179	print "not ";
180    }
181    &ok("Cache Keys Check 5");
182
183    for (0..2) {
184	if (Net::SSLeay::get_session($clients[$_]->_get_ssl_object) ne 
185	    $cache->{"$SSL_SERVER_ADDR:$server_ports[$_]"}->{session}) {
186	    print "not ";
187	}
188	&ok("Second Cache Entry Test $_");
189	unless ($clients[$_]->print("Test $_\n")) {
190	    print "not ";
191	}
192	&ok("Write Test $_");
193	unless ($clients[$_]->readline eq "Ok $_\n") {
194	    print "not ";
195	}
196	&ok("Read Test $_");
197	close $clients[$_];
198    }
199
200    exit(0);
201}
202
203my @clients = map { scalar $_->accept } @servers;
204if (!$clients[0] or !$clients[1] or !$clients[2]) {
205    print "not ok \# Client init\n";
206    exit;
207}
208&ok("Client init");
209
210close $_ foreach (@clients);
211
212
213@clients = map { scalar $_->accept } @servers;
214if (!$clients[0] or !$clients[1] or !$clients[2]) {
215    print $SSL_ERROR;
216    print "not ok \# Client init 2\n";
217    exit;
218}
219&ok("Client init 2");
220
221for (0..2) {
222    unless ($clients[$_]->readline eq "Test $_\n") {
223	print "not ";
224    }
225    &ok("Server Read $_");
226    unless ($clients[$_]->print("Ok $_\n")) {
227	print "not ";
228    }
229    &ok("Server Write $_");
230    close $clients[$_];
231    close $servers[$_];
232}
233
234wait;
235
236
237sub ok {
238    print "ok #$_[0]\n";
239}
240
241sub bail {
242	print "Bail Out! $IO::Socket::SSL::ERROR";
243}
244