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'
10 eval {require "t/ssl_settings.req";} ||
11 eval {require "ssl_settings.req";};
13 print "1..0 # Skipped: test cert has expired\n";
16 $GUARANTEED_TO_HAVE_NONBLOCKING_SOCKETS = eval "use 5.006; use IO::Select; return 1";
17 $NET_SSLEAY_VERSION = $Net::SSLeay::VERSION;
19 $OPENSSL_VERSION = &Net::SSLeay::OPENSSL_VERSION_NUMBER if ($NET_SSLEAY_VERSION>=1.19);
20 $CAN_PEEK = ($OPENSSL_VERSION >= 0x0090601f) ? 1 : 0;
26 if (/MacOS/ or /VOS/ or /vmesa/ or /riscos/ or /amigaos/) {
27 print "1..0 # Skipped: fork not implemented on this platform\n";
32 if ($GUARANTEED_TO_HAVE_NONBLOCKING_SOCKETS) {
34 $numtests+=4 if ($NET_SSLEAY_VERSION>=1.16)
37 if ($NET_SSLEAY_VERSION>=1.16) {
41 #We can only test SSL_peek if OpenSSL is v0.9.6a or better
46 print "1..$numtests\n";
48 %extra_options = ($Net::SSLeay::VERSION>=1.16) ?
49 (SSL_key_file => "certs/client-key.enc", SSL_passwd_cb => sub { return "opossum" }) :
50 (SSL_key_file => "certs/client-key.pem");
53 my $server = IO::Socket::SSL->new(
54 LocalAddr => $SSL_SERVER_ADDR,
58 SSL_verify_mode => 0x00,
59 SSL_ca_file => "certs/test-ca.pem",
61 SSL_cert_file => "certs/client-cert.pem",
62 SSL_version => 'TLSv1',
63 SSL_cipher_list => 'HIGH',
64 SSL_error_trap => \&error_trap,
72 &ok("Server Initialization");
74 print "not " if (!defined fileno($server));
75 &ok("Server Fileno Check");
77 my ($SSL_SERVER_PORT) = unpack_sockaddr_in( $server->sockname );
83 %extra_options = ($Net::SSLeay::VERSION>=1.16) ?
84 (SSL_key_file => "certs/server-key.enc", SSL_passwd_cb => sub { return "bluebell" },
85 SSL_verify_callback => \&verify_sub) :
86 (SSL_key_file => "certs/server-key.pem");
89 my $client = new IO::Socket::INET(PeerAddr => $SSL_SERVER_ADDR,
90 PeerPort => $SSL_SERVER_PORT);
92 print $client "Test\n";
93 (<$client> eq "This server is SSL only") || print "not ";
94 &ok("Client non-SSL connection");
97 $client = new IO::Socket::SSL(PeerAddr => $SSL_SERVER_ADDR,
98 PeerPort => $SSL_SERVER_PORT,
99 SSL_verify_mode => 0x01,
100 SSL_ca_file => "certs/test-ca.pem",
102 SSL_cert_file => "certs/server-cert.pem",
103 SSL_version => 'TLSv1',
104 SSL_cipher_list => 'HIGH',
109 my ($ok, $ctx_store, $cert, $error) = @_;
110 unless ($ok && $ctx_store && $cert && !$error)
111 { print("not ok #client failure\n") && exit; }
112 ($cert =~ /IO::Socket::SSL Test CA/) || print "not";
113 &ok("Client Verify-sub Check");
118 $client || (print("not ok #client failure\n") && exit);
119 &ok("Client Initialization");
121 $client->fileno() || print "not ";
122 &ok("Client Fileno Check");
124 # $client->untaint() if ($HAVE_SCALAR_UTIL); # In the future...
126 $client->dump_peer_certificate() || print "not ";
127 &ok("Client Peer Certificate Check");
129 $client->peer_certificate("issuer") || print "not ";
130 &ok("Client Peer Certificate Issuer Check");
132 $client->get_cipher() || print "not ";
133 &ok("Client Cipher Check");
135 $client->syswrite('00waaaanf00', 7, 2);
139 $client->read($buffer,2);
140 print "not " if ($buffer ne 'ok');
141 &ok("Client Peek Check");
144 $client->print("Test\n");
145 send($client, "Test\n", 0);
146 $client->printf("\$%.2f\n%d\n%c\n%s", 1.0444442342, 4.0, ord("y"), "Test\nBeaver\nBeaver\n");
147 shutdown($client, 1);
149 my $buffer="\0\0aaaaaaaaaaaaaaaaaaaa";
150 $client->sysread($buffer, 7, 2);
151 print "not " if ($buffer ne "\0\0waaaanf");
152 &ok("Client Sysread Check");
156 # if ($HAVE_SCALAR_UTIL) {
157 # print "not " if (is_tainted($buffer));
161 my @array = $client->getline();
162 print "not " if (@array != 1 or $array[0] ne "Test\n");
163 &ok("Client Getline Check");
165 print "not " if ($client->getc ne "\$");
166 &ok("Client Getc Check");
168 @array = $client->getlines;
169 print "not " if (@array != 6);
170 &ok("Client Getlines Check 1");
172 print "not " if ($array[0] != "1.04\n");
173 &ok("Client Getlines Check 2");
175 print "not " if ($array[1] ne "4\n");
176 &ok("Client Getlines Check 3");
178 print "not " if ($array[2] ne "y\n");
179 &ok("Client Getlines Check 4");
181 print "not " if (join("", @array[3..5]) ne "Test\nBeaver\nBeaver\n");
182 &ok("Client Getlines Check 5");
184 print "not " if (defined(<$client>));
185 &ok("Client Finished Reading Check");
187 $client->close(SSL_no_shutdown => 1);
189 my $client_2 = new IO::Socket::INET(PeerAddr => $SSL_SERVER_ADDR,
190 PeerPort => $SSL_SERVER_PORT);
192 print "not " if (!$client_2);
193 &ok("Second Client Initialization");
195 $client_2 = IO::Socket::SSL->new_from_fd($client_2->fileno, '+<>',
196 SSL_reuse_ctx => $client,
197 SSL_cipher_list => 'HIGH');
198 print "not " if (!$client_2);
199 &ok("Client Init from Fileno Check");
200 $buffer = <$client_2>;
202 print "not " unless ($buffer eq "Boojums\n");
203 &ok("Client (fileno) Readline Check");
205 $client_2->close(SSL_ctx_free => 1);
207 if ($GUARANTEED_TO_HAVE_NONBLOCKING_SOCKETS) {
208 my $client_3 = new IO::Socket::SSL(PeerAddr => $SSL_SERVER_ADDR,
209 PeerPort => $SSL_SERVER_PORT,
210 SSL_verify_mode => 0x01,
211 SSL_ca_file => "certs/test-ca.pem",
213 SSL_cert_file => "certs/server-cert.pem",
214 SSL_version => 'TLSv1',
215 SSL_cipher_list => 'HIGH',
219 print "not " if (!$client_3);
220 &ok("Client Nonblocking Check 1");
223 my $client_4 = new IO::Socket::SSL(PeerAddr => $SSL_SERVER_ADDR,
224 PeerPort => $SSL_SERVER_PORT,
225 SSL_reuse_ctx => $client_3,
227 SSL_cipher_list => 'HIGH');
228 print "not " if (!$client_4);
229 &ok("Client Nonblocking Check 2");
230 $client_3->close(SSL_ctx_free => 1);
236 my $client = $server->accept;
240 print $self "This server is SSL only";
245 $error_trapped or print "not ";
246 &ok("Server non-SSL Client Check");
248 if ($client && $client->opened) {
249 print "not ok # client stayed alive!\n";
252 &ok("Server Kill-client Check");
254 ($client, $peer) = $server->accept;
257 print "not ok # no client\n";
260 &ok("Server Client Accept Check");
262 print "not " unless defined $peer;
263 &ok("Accept returning peer address check.");
266 fileno($client) || print "not ";
267 &ok("Server Client Fileno Check");
272 $client->peek($buffer, 7, 2);
273 print "not " if ($buffer ne "\0\0waaaanf");
274 &ok("Server Peek Check");
276 print "not " if ($client->pending() != 7);
277 &ok("Server Pending Check");
286 sysread($client, $buffer, 7, 2);
287 print "not " if ($buffer ne "\0\0waaaanf");
288 &ok("Server Sysread Check");
291 my @array = scalar <$client>;
292 print "not " if ($array[0] ne "Test\n");
293 &ok("Server Getline Check");
296 recv($client, my $recv_buffer, 5, 0);
297 print "not " if ($recv_buffer ne "Test\n");
298 &ok("Server Recv Check");
300 print "not " if (getc($client) ne "\$");
301 &ok("Server Getc Check");
305 print "not " if (@array != 6);
306 &ok("Server Getlines Check 1");
308 print "not " if ($array[0] != "1.04\n");
309 &ok("Server Getlines Check 2");
311 print "not " if ($array[1] ne "4\n");
312 &ok("Server Getlines Check 3");
314 print "not " if ($array[2] ne "y\n");
315 &ok("Server Getlines Check 4");
317 print "not " if (join("", @array[3..5]) ne "Test\nBeaver\nBeaver\n");
318 &ok("Server Getlines Check 5");
321 syswrite($client, '00waaaanf00', 7, 2);
322 print($client "Test\n");
323 printf $client "\$%.2f\n%d\n%c\n%s", (1.0444442342, 4.0, ord("y"), "Test\nBeaver\nBeaver\n");
327 ($client, $packed) = $server->accept;
328 &bail unless $client;
329 print "not " unless (inet_ntoa((unpack_sockaddr_in($packed))[1]) eq "127.0.0.1");
330 &ok("Peer address check");
332 if ($GUARANTEED_TO_HAVE_NONBLOCKING_SOCKETS) {
333 $client->blocking(0);
334 $client->read($buffer, 20, 0);
335 print "not " if $SSL_ERROR != SSL_WANT_READ;
336 &ok("Server Nonblocking Check 1");
339 print "not " unless ($client->opened);
340 &ok("Server Client Opened Check 1");
342 print $client "Boojums\n";
346 ${*$client}{'_SSL_opened'} = 1;
347 print "not " if ($client->opened);
348 &ok("Server Client Opened Check 2");
349 ${*$client}{'_SSL_opened'} = 0;
352 if ($GUARANTEED_TO_HAVE_NONBLOCKING_SOCKETS) {
353 $client = $server->accept;
354 print "not " if (!$client->opened);
355 &ok("Server Nonblocking Check 2");
358 $server->blocking(0);
359 IO::Select->new($server)->can_read(30);
360 $client = $server->accept;
361 while ( ! $client ) {
362 #DEBUG( "$!,$SSL_ERROR" );
363 if ( $! == EAGAIN ) {
364 if ( $SSL_ERROR == SSL_WANT_WRITE ) {
365 IO::Select->new( $server->opening )->can_write(30);
367 IO::Select->new( $server->opening )->can_read(30);
372 $client = $server->accept;
375 print "not " unless ($client && $client->opened);
376 &ok("Server Nonblocking Check 3");
380 $server->close(SSL_ctx_free => 1);
388 print "Bail Out! $IO::Socket::SSL::ERROR";
394 # my $nada = substr($arg, 0, 0);
396 # eval {eval "# $nada"};