|
Packit |
b893dc |
#!/usr/bin/perl
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
# Tests for SSL_CTX_new and related functions
|
|
Packit |
b893dc |
# Also test handshake state machine retrieval
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
use strict;
|
|
Packit |
b893dc |
use warnings;
|
|
Packit |
b893dc |
use Test::More tests => 44;
|
|
Packit |
b893dc |
use Net::SSLeay;
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
Net::SSLeay::randomize();
|
|
Packit |
b893dc |
Net::SSLeay::load_error_strings();
|
|
Packit |
b893dc |
Net::SSLeay::add_ssl_algorithms();
|
|
Packit |
b893dc |
Net::SSLeay::OpenSSL_add_all_algorithms();
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
sub is_known_proto_version {
|
|
Packit |
b893dc |
return 1 if $_[0] == 0x0000; # Automatic version selection
|
|
Packit |
b893dc |
return 1 if $_[0] == Net::SSLeay::SSL3_VERSION(); # OpenSSL 0.9.8+
|
|
Packit |
b893dc |
return 1 if $_[0] == Net::SSLeay::TLS1_VERSION(); # OpenSSL 0.9.8+
|
|
Packit |
b893dc |
return 1 if $_[0] == Net::SSLeay::TLS1_1_VERSION(); # OpenSSL 0.9.8+
|
|
Packit |
b893dc |
return 1 if $_[0] == Net::SSLeay::TLS1_2_VERSION(); # OpenSSL 0.9.8+
|
|
Packit |
b893dc |
if (eval { Net::SSLeay::TLS1_3_VERSION() }) {
|
|
Packit |
b893dc |
return 1 if $_[0] == Net::SSLeay::TLS1_3_VERSION(); # OpenSSL 1.1.1+
|
|
Packit |
b893dc |
}
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
return;
|
|
Packit |
b893dc |
}
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
# Shortcuts from SSLeay.xs
|
|
Packit |
b893dc |
my $ctx = Net::SSLeay::CTX_new();
|
|
Packit |
b893dc |
ok($ctx, 'CTX_new');
|
|
Packit |
b893dc |
$ctx = Net::SSLeay::CTX_v23_new();
|
|
Packit |
b893dc |
ok($ctx, 'CTX_v23_new');
|
|
Packit |
b893dc |
$ctx = Net::SSLeay::CTX_tlsv1_new();
|
|
Packit |
b893dc |
ok($ctx, 'CTX_tlsv1_new');
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
my $ctx_23 = Net::SSLeay::CTX_new_with_method(Net::SSLeay::SSLv23_method());
|
|
Packit |
b893dc |
ok($ctx_23, 'CTX_new with SSLv23_method');
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
my $ctx_23_client = Net::SSLeay::CTX_new_with_method(Net::SSLeay::SSLv23_client_method());
|
|
Packit |
b893dc |
ok($ctx_23_client, 'CTX_new with SSLv23_client_method');
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
my $ctx_23_server = Net::SSLeay::CTX_new_with_method(Net::SSLeay::SSLv23_server_method());
|
|
Packit |
b893dc |
ok($ctx_23_server, 'CTX_new with SSLv23_server_method');
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
my $ctx_tls1 = Net::SSLeay::CTX_new_with_method(Net::SSLeay::TLSv1_method());
|
|
Packit |
b893dc |
ok($ctx_tls1, 'CTX_new with TLSv1_method');
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
# Retrieve information about the handshake state machine
|
|
Packit |
b893dc |
is(Net::SSLeay::in_connect_init(Net::SSLeay::new($ctx_23_client)), 1, 'in_connect_init() is 1 for client');
|
|
Packit |
b893dc |
is(Net::SSLeay::in_accept_init(Net::SSLeay::new($ctx_23_client)), 0, 'in_accept_init() is 0 for client');
|
|
Packit |
b893dc |
is(Net::SSLeay::in_connect_init(Net::SSLeay::new($ctx_23_server)), 0, 'in_connect_init() is 0 for server');
|
|
Packit |
b893dc |
is(Net::SSLeay::in_accept_init(Net::SSLeay::new($ctx_23_server)), 1, 'in_accept_init() is 1 for server');
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
# Need recent enough OpenSSL or LibreSSL for TLS_method functions
|
|
Packit |
b893dc |
my ($ctx_tls, $ssl_tls, $ctx_tls_client, $ssl_tls_client, $ctx_tls_server, $ssl_tls_server);
|
|
Packit |
b893dc |
if (exists &Net::SSLeay::TLS_method)
|
|
Packit |
b893dc |
{
|
|
Packit |
b893dc |
$ctx_tls = Net::SSLeay::CTX_new_with_method(Net::SSLeay::TLS_method());
|
|
Packit |
b893dc |
ok($ctx_tls, 'CTX_new with TLS_method');
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
$ssl_tls = Net::SSLeay::new($ctx_tls);
|
|
Packit |
b893dc |
ok($ssl_tls, 'New SSL created with ctx_tls');
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
$ctx_tls_client = Net::SSLeay::CTX_new_with_method(Net::SSLeay::TLS_client_method());
|
|
Packit |
b893dc |
ok($ctx_tls_client, 'CTX_new with TLS_client_method');
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
$ctx_tls_server = Net::SSLeay::CTX_new_with_method(Net::SSLeay::TLS_server_method());
|
|
Packit |
b893dc |
ok($ctx_tls_server, 'CTX_new with TLS_server_method');
|
|
Packit |
b893dc |
}
|
|
Packit |
b893dc |
else
|
|
Packit |
b893dc |
{
|
|
Packit |
b893dc |
SKIP: {
|
|
Packit |
b893dc |
skip('Do not have Net::SSLeay::TLS_method', 4);
|
|
Packit |
b893dc |
};
|
|
Packit |
b893dc |
}
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
# Having TLS_method() does not necessarily that proto setters are available
|
|
Packit |
b893dc |
if ($ctx_tls && exists &Net::SSLeay::CTX_set_min_proto_version)
|
|
Packit |
b893dc |
{
|
|
Packit |
b893dc |
my $ver_1_0 = Net::SSLeay::TLS1_VERSION();
|
|
Packit |
b893dc |
ok($ver_1_0, "Net::SSLeay::TLS1_VERSION() returns non-false: $ver_1_0, hex " . sprintf('0x%04x', $ver_1_0));
|
|
Packit |
b893dc |
my $ver_min = Net::SSLeay::TLS1_1_VERSION();
|
|
Packit |
b893dc |
ok($ver_min, "Net::SSLeay::TLS1_1_VERSION() returns non-false: $ver_min, hex " . sprintf('0x%04x', $ver_min));
|
|
Packit |
b893dc |
my $ver_max = Net::SSLeay::TLS1_2_VERSION();
|
|
Packit |
b893dc |
ok($ver_max, "Net::SSLeay::TLS1_2_VERSION() returns $ver_max, hex " . sprintf('0x%04x', $ver_max));
|
|
Packit |
b893dc |
isnt($ver_1_0, $ver_min, 'Version 1_0 and 1_1 values are different');
|
|
Packit |
b893dc |
isnt($ver_min, $ver_max, 'Version 1_1 and 1_2 values are different');
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
my $rv;
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
$rv = Net::SSLeay::CTX_set_min_proto_version($ctx_tls_client, $ver_min);
|
|
Packit |
b893dc |
is($rv, 1, 'Setting client CTX minimum version');
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
$rv = Net::SSLeay::CTX_set_min_proto_version($ctx_tls_client, 0);
|
|
Packit |
b893dc |
is($rv, 1, 'Setting client CTX minimum version to automatic');
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
$rv = Net::SSLeay::CTX_set_min_proto_version($ctx_tls_client, -1);
|
|
Packit |
b893dc |
is($rv, 0, 'Setting client CTX minimum version to bad value');
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
$rv = Net::SSLeay::CTX_set_min_proto_version($ctx_tls_client, $ver_min);
|
|
Packit |
b893dc |
is($rv, 1, 'Setting client CTX minimum version back to good value');
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
$rv = Net::SSLeay::CTX_set_max_proto_version($ctx_tls_client, $ver_max);
|
|
Packit |
b893dc |
is($rv, 1, 'Setting client CTX maximum version');
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
# This SSL should have min and max versions set based on its
|
|
Packit |
b893dc |
# CTX. We test the getters later, if they exist.
|
|
Packit |
b893dc |
$ssl_tls_client = Net::SSLeay::new($ctx_tls_client);
|
|
Packit |
b893dc |
ok($ssl_tls_client, 'New SSL created from client CTX');
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
# This SSL should have min and max versions set to automatic based
|
|
Packit |
b893dc |
# on its CTX. We change them now and test the getters later, if
|
|
Packit |
b893dc |
# they exist.
|
|
Packit |
b893dc |
$ssl_tls_server = Net::SSLeay::new($ctx_tls_server);
|
|
Packit |
b893dc |
ok($ssl_tls_server, 'New SSL created from server CTX');
|
|
Packit |
b893dc |
$rv = Net::SSLeay::set_min_proto_version($ssl_tls_server, Net::SSLeay::TLS1_VERSION());
|
|
Packit |
b893dc |
is($rv, 1, 'Setting SSL minimum version for ssl_tls_server');
|
|
Packit |
b893dc |
$rv = Net::SSLeay::set_max_proto_version($ssl_tls_server, Net::SSLeay::TLS1_2_VERSION());
|
|
Packit |
b893dc |
is($rv, 1, 'Setting SSL maximum version for ssl_tls_server');
|
|
Packit |
b893dc |
}
|
|
Packit |
b893dc |
else
|
|
Packit |
b893dc |
{
|
|
Packit |
b893dc |
SKIP: {
|
|
Packit |
b893dc |
skip('Do not have Net::SSLeay::CTX_get_min_proto_version', 14);
|
|
Packit |
b893dc |
};
|
|
Packit |
b893dc |
}
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
# Having TLS_method() does not necessarily that proto getters are available
|
|
Packit |
b893dc |
if ($ctx_tls && exists &Net::SSLeay::CTX_get_min_proto_version)
|
|
Packit |
b893dc |
{
|
|
Packit |
b893dc |
my $ver;
|
|
Packit |
b893dc |
$ver = Net::SSLeay::CTX_get_min_proto_version($ctx_tls);
|
|
Packit |
b893dc |
ok(is_known_proto_version($ver), 'TLS_method CTX has known minimum version');
|
|
Packit |
b893dc |
$ver = Net::SSLeay::CTX_get_max_proto_version($ctx_tls);
|
|
Packit |
b893dc |
ok(is_known_proto_version($ver), 'TLS_method CTX has known maximum version');
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
$ver = Net::SSLeay::get_min_proto_version($ssl_tls);
|
|
Packit |
b893dc |
ok(is_known_proto_version($ver), 'SSL from TLS_method CTX has known minimum version');
|
|
Packit |
b893dc |
$ver = Net::SSLeay::get_max_proto_version($ssl_tls);
|
|
Packit |
b893dc |
ok(is_known_proto_version($ver), 'SSL from TLS_method CTX has known maximum version');
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
# First see if our CTX has min and max settings enabled
|
|
Packit |
b893dc |
$ver = Net::SSLeay::CTX_get_min_proto_version($ctx_tls_client);
|
|
Packit |
b893dc |
is($ver, Net::SSLeay::TLS1_1_VERSION(), 'TLS_client CTX has minimum version correctly set');
|
|
Packit |
b893dc |
$ver = Net::SSLeay::CTX_get_max_proto_version($ctx_tls_client);
|
|
Packit |
b893dc |
is($ver, Net::SSLeay::TLS1_2_VERSION(), 'TLS_client CTX has maximum version correctly set');
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
# Then see if our client SSL has min and max settings enabled
|
|
Packit |
b893dc |
$ver = Net::SSLeay::get_min_proto_version($ssl_tls_client);
|
|
Packit |
b893dc |
is($ver, Net::SSLeay::TLS1_1_VERSION(), 'SSL from TLS_client CTX has minimum version correctly set');
|
|
Packit |
b893dc |
$ver = Net::SSLeay::get_max_proto_version($ssl_tls_client);
|
|
Packit |
b893dc |
is($ver, Net::SSLeay::TLS1_2_VERSION(), 'SSL from TLS_client CTX has maximum version correctly set');
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
# Then see if our server SSL has min and max settings enabled
|
|
Packit |
b893dc |
$ver = Net::SSLeay::get_min_proto_version($ssl_tls_server);
|
|
Packit |
b893dc |
is($ver, Net::SSLeay::TLS1_VERSION(), 'SSL from TLS_server CTX has minimum version correctly set');
|
|
Packit |
b893dc |
$ver = Net::SSLeay::get_max_proto_version($ssl_tls_server);
|
|
Packit |
b893dc |
is($ver, Net::SSLeay::TLS1_2_VERSION(), 'SSL from TLS_server CTX has maximum version correctly set');
|
|
Packit |
b893dc |
}
|
|
Packit |
b893dc |
else
|
|
Packit |
b893dc |
{
|
|
Packit |
b893dc |
SKIP: {
|
|
Packit |
b893dc |
skip('Do not have Net::SSLeay::CTX_get_min_proto_version', 10);
|
|
Packit |
b893dc |
};
|
|
Packit |
b893dc |
}
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
if (eval {Net::SSLeay::TLS1_3_VERSION()})
|
|
Packit |
b893dc |
{
|
|
Packit |
b893dc |
my $ver_1_2 = Net::SSLeay::TLS1_2_VERSION();
|
|
Packit |
b893dc |
ok($ver_1_2, "Net::SSLeay::TLS1_2_VERSION() returns non-false: $ver_1_2, hex " . sprintf('0x%04x', $ver_1_2));
|
|
Packit |
b893dc |
my $ver_1_3 = Net::SSLeay::TLS1_3_VERSION();
|
|
Packit |
b893dc |
ok($ver_1_3, "Net::SSLeay::TLS1_3_VERSION() returns non-false: $ver_1_3, hex " . sprintf('0x%04x', $ver_1_3));
|
|
Packit |
b893dc |
isnt($ver_1_2, $ver_1_3, 'Version 1_2 and 1_3 values are different');
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
my $rv = 0;
|
|
Packit |
b893dc |
ok(eval {$rv = Net::SSLeay::OP_NO_TLSv1_3()}, 'Have OP_NO_TLSv1_3');
|
|
Packit |
b893dc |
isnt($rv, 0, 'OP_NO_TLSv1_3 returns non-zero value');
|
|
Packit |
b893dc |
}
|
|
Packit |
b893dc |
else
|
|
Packit |
b893dc |
{
|
|
Packit |
b893dc |
SKIP: {
|
|
Packit |
b893dc |
skip('Do not have Net::SSLeay::TLS1_3_VERSION', 5);
|
|
Packit |
b893dc |
};
|
|
Packit |
b893dc |
}
|
|
Packit |
b893dc |
|
|
Packit |
b893dc |
exit(0);
|