git.maemo.org Git - dh-make-perl/blob - dev/i386/libio-socket-ssl-perl/libio-socket-ssl-perl-1.16/t/sessions.t

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