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