#!perl -w
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl t/core.t'
use Net::SSLeay;
use Socket;
use IO::Socket::SSL;
eval {require "t/ssl_settings.req";} ||
eval {require "ssl_settings.req";};
$NET_SSLEAY_VERSION = $Net::SSLeay::VERSION;
$numtests = 35;
$|=1;
foreach ($^O) {
if (/MacOS/ or /VOS/ or /vmesa/ or /riscos/ or /amigaos/) {
print "1..0 # Skipped: fork not implemented on this platform\n";
exit;
}
}
if ($NET_SSLEAY_VERSION < 1.26) {
print "1..0 \# Skipped: Net::SSLeay version less than 1.26\n";
exit;
}
print "1..$numtests\n";
my %server_options = (
SSL_key_file => "certs/server-key.enc",
SSL_passwd_cb => sub { return "bluebell" },
LocalAddr => $SSL_SERVER_ADDR,
Listen => 2,
Timeout => 30,
ReuseAddr => 1,
SSL_verify_mode => SSL_VERIFY_NONE,
SSL_ca_file => "certs/test-ca.pem",
SSL_cert_file => "certs/server-cert.pem",
SSL_version => 'TLSv1',
SSL_cipher_list => 'HIGH'
);
my @servers = (IO::Socket::SSL->new( %server_options),
IO::Socket::SSL->new( %server_options),
IO::Socket::SSL->new( %server_options));
if (!$servers[0] or !$servers[1] or !$servers[2]) {
print "not ok # Server init\n";
exit;
}
&ok("Server initialization");
my ($SSL_SERVER_PORT) = unpack_sockaddr_in( $servers[0]->sockname );
my ($SSL_SERVER_PORT2) = unpack_sockaddr_in( $servers[1]->sockname );
my ($SSL_SERVER_PORT3) = unpack_sockaddr_in( $servers[2]->sockname );
unless (fork) {
close $_ foreach @servers;
my $ctx = IO::Socket::SSL::SSL_Context->new(
SSL_passwd_cb => sub { return "opossum" },
SSL_verify_mode => SSL_VERIFY_PEER,
SSL_ca_file => "certs/test-ca.pem",
SSL_ca_path => '',
SSL_version => 'TLSv1',
SSL_cipher_list => 'HIGH',
SSL_session_cache_size => 4
);
if (! defined $ctx->{'session_cache'}) {
print "not ok \# Context init\n";
exit;
}
&ok("Context init");
# Bogus session test
unless ($ctx->session_cache("bogus", "bogus", 0)) {
print "not ";
}
&ok("Superficial Cache Addition Test");
unless ($ctx->session_cache("bogus1", "bogus1", 0)) {
print "not ";
}
&ok("Superficial Cache Addition Test 2");
my $cache = $ctx->{'session_cache'};
if (keys(%$cache) != 4) {
print "not ";
}
&ok("Cache Keys Check 1");
unless ($cache->{'bogus1:bogus1'} and $cache->{'bogus:bogus'}) {
print "not ";
}
&ok("Cache Keys Check 2");
my ($bogus, $bogus1) = ($cache->{'bogus:bogus'}, $cache->{'bogus1:bogus1'});
unless ($cache->{'_head'} eq $bogus1) {
print "not ";
}
&ok("Cache Head Check");
unless ($bogus1->{prev} eq $bogus and
$bogus1->{next} eq $bogus and
$bogus->{prev} eq $bogus1 and
$bogus->{next} eq $bogus1) {
print "not ";
}
&ok("Cache Link Check");
IO::Socket::SSL::set_default_context($ctx);
my $sock3 = IO::Socket::INET->new(
PeerAddr => $SSL_SERVER_ADDR,
PeerPort => $SSL_SERVER_PORT3
);
my @clients = (
IO::Socket::SSL->new(
PeerAddr => "$SSL_SERVER_ADDR:$SSL_SERVER_PORT",
SSL_verify_mode => 0
),
IO::Socket::SSL->new(
PeerAddr => "$SSL_SERVER_ADDR:$SSL_SERVER_PORT2",
SSL_verify_mode => 0
),
IO::Socket::SSL->start_SSL( $sock3 , SSL_verify_mode => 0),
);
if (!$clients[0] or !$clients[1] or !$clients[2]) {
print "not ok \# Client init\n";
exit;
}
&ok("Client init");
# Make sure that first 'bogus' entry has been removed
if (keys(%$cache) != 6) {
print "not ";
}
&ok("Cache Keys Check 3");
if ($cache->{'bogus:bogus'}) {
print "not ";
}
&ok("Cache Removal Test");
if ($cache->{'_head'}->{prev} ne $bogus1) {
print "not ";
}
&ok("Cache Tail Check");
if ($cache->{'_head'} ne $cache->{"$SSL_SERVER_ADDR:$SSL_SERVER_PORT3"}) {
print "not ";
}
&ok("Cache Insertion Test");
my @server_ports = ($SSL_SERVER_PORT, $SSL_SERVER_PORT2, $SSL_SERVER_PORT3);
for (0..2) {
if (Net::SSLeay::get_session($clients[$_]->_get_ssl_object) ne
$cache->{"$SSL_SERVER_ADDR:$server_ports[$_]"}->{session}) {
print "not ";
}
&ok("Cache Entry Test $_");
close $clients[$_];
}
@clients = map {
IO::Socket::SSL->new(
PeerAddr => $SSL_SERVER_ADDR,
PeerPort => $_,
SSL_verify_mode => 0,
)
} ( $SSL_SERVER_PORT, $SSL_SERVER_PORT2, $SSL_SERVER_PORT3 );
if (keys(%$cache) != 6) {
print "not ";
}
&ok("Cache Keys Check 4");
if (!$cache->{'bogus1:bogus1'}) {
print "not ";
}
&ok("Cache Keys Check 5");
for (0..2) {
if (Net::SSLeay::get_session($clients[$_]->_get_ssl_object) ne
$cache->{"$SSL_SERVER_ADDR:$server_ports[$_]"}->{session}) {
print "not ";
}
&ok("Second Cache Entry Test $_");
unless ($clients[$_]->print("Test $_\n")) {
print "not ";
}
&ok("Write Test $_");
unless ($clients[$_]->readline eq "Ok $_\n") {
print "not ";
}
&ok("Read Test $_");
close $clients[$_];
}
exit(0);
}
my @clients = map { scalar $_->accept } @servers;
if (!$clients[0] or !$clients[1] or !$clients[2]) {
print "not ok \# Client init\n";
exit;
}
&ok("Client init");
close $_ foreach (@clients);
@clients = map { scalar $_->accept } @servers;
if (!$clients[0] or !$clients[1] or !$clients[2]) {
print $SSL_ERROR;
print "not ok \# Client init 2\n";
exit;
}
&ok("Client init 2");
for (0..2) {
unless ($clients[$_]->readline eq "Test $_\n") {
print "not ";
}
&ok("Server Read $_");
unless ($clients[$_]->print("Ok $_\n")) {
print "not ";
}
&ok("Server Write $_");
close $clients[$_];
close $servers[$_];
}
wait;
sub ok {
print "ok #$_[0]\n";
}
sub bail {
print "Bail Out! $IO::Socket::SSL::ERROR";
}