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