changeset 1861:7b7b64569f55

Tests: reworked mail SSL tests to use IO::Socket::SSL. Relevant infrastructure is provided in Test::Nginx::IMAP (and also POP3 and SMTP for completeness). This also ensures that SSL handshake and various read operations are guarded with timeouts.
author Maxim Dounin <mdounin@mdounin.ru>
date Thu, 18 May 2023 18:07:08 +0300
parents 58951cf933e1
children 7681a970f6bd
files lib/Test/Nginx/IMAP.pm lib/Test/Nginx/POP3.pm lib/Test/Nginx/SMTP.pm mail_ssl.t mail_ssl_conf_command.t mail_ssl_session_reuse.t
diffstat 6 files changed, 197 insertions(+), 123 deletions(-) [+]
line wrap: on
line diff
--- a/lib/Test/Nginx/IMAP.pm
+++ b/lib/Test/Nginx/IMAP.pm
@@ -20,17 +20,40 @@ sub new {
 	my $self = {};
 	bless $self, shift @_;
 
-	$self->{_socket} = IO::Socket::INET->new(
-		Proto => "tcp",
-		PeerAddr => "127.0.0.1:" . port(8143),
-		@_
-	)
-		or die "Can't connect to nginx: $!\n";
+	my $port = {@_}->{'SSL'} ? 8993 : 8143;
+
+	eval {
+		local $SIG{ALRM} = sub { die "timeout\n" };
+		local $SIG{PIPE} = sub { die "sigpipe\n" };
+		alarm(8);
+
+		$self->{_socket} = IO::Socket::INET->new(
+			Proto => "tcp",
+			PeerAddr => "127.0.0.1:" . port($port),
+			@_
+		)
+			or die "Can't connect to nginx: $!\n";
 
-	if ({@_}->{'SSL'}) {
-		require IO::Socket::SSL;
-		IO::Socket::SSL->start_SSL($self->{_socket}, @_)
-			or die $IO::Socket::SSL::SSL_ERROR . "\n";
+		if ({@_}->{'SSL'}) {
+			require IO::Socket::SSL;
+			IO::Socket::SSL->start_SSL(
+				$self->{_socket},
+				SSL_verify_mode =>
+					IO::Socket::SSL::SSL_VERIFY_NONE(),
+				@_
+			)
+				or die $IO::Socket::SSL::SSL_ERROR . "\n";
+
+			my $s = $self->{_socket};
+			log_in("ssl cipher: " . $s->get_cipher());
+			log_in("ssl cert: " . $s->peer_certificate('issuer'));
+		}
+
+		alarm(0);
+	};
+	alarm(0);
+	if ($@) {
+		log_in("died: $@");
 	}
 
 	$self->{_socket}->autoflush(1);
@@ -39,6 +62,11 @@ sub new {
 	return $self;
 }
 
+sub DESTROY {
+	my $self = shift;
+	$self->{_socket}->close();
+}
+
 sub eof {
 	my $self = shift;
 	return $self->{_socket}->eof();
@@ -109,6 +137,11 @@ sub can_read {
 	IO::Select->new($self->{_socket})->can_read($timo || 3);
 }
 
+sub socket {
+	my ($self) = @_;
+	$self->{_socket};
+}
+
 ###############################################################################
 
 sub imap_test_daemon {
--- a/lib/Test/Nginx/POP3.pm
+++ b/lib/Test/Nginx/POP3.pm
@@ -20,17 +20,40 @@ sub new {
 	my $self = {};
 	bless $self, shift @_;
 
-	$self->{_socket} = IO::Socket::INET->new(
-		Proto => "tcp",
-		PeerAddr => "127.0.0.1:" . port(8110),
-		@_
-	)
-		or die "Can't connect to nginx: $!\n";
+	my $port = {@_}->{'SSL'} ? 8995 : 8110;
+
+	eval {
+		local $SIG{ALRM} = sub { die "timeout\n" };
+		local $SIG{PIPE} = sub { die "sigpipe\n" };
+		alarm(8);
+
+		$self->{_socket} = IO::Socket::INET->new(
+			Proto => "tcp",
+			PeerAddr => "127.0.0.1:" . port($port),
+			@_
+		)
+			or die "Can't connect to nginx: $!\n";
 
-	if ({@_}->{'SSL'}) {
-		require IO::Socket::SSL;
-		IO::Socket::SSL->start_SSL($self->{_socket}, @_)
-			or die $IO::Socket::SSL::SSL_ERROR . "\n";
+		if ({@_}->{'SSL'}) {
+			require IO::Socket::SSL;
+			IO::Socket::SSL->start_SSL(
+				$self->{_socket},
+				SSL_verify_mode =>
+					IO::Socket::SSL::SSL_VERIFY_NONE(),
+				@_
+			)
+				or die $IO::Socket::SSL::SSL_ERROR . "\n";
+
+			my $s = $self->{_socket};
+			log_in("ssl cipher: " . $s->get_cipher());
+			log_in("ssl cert: " . $s->peer_certificate('issuer'));
+		}
+
+		alarm(0);
+	};
+	alarm(0);
+	if ($@) {
+		log_in("died: $@");
 	}
 
 	$self->{_socket}->autoflush(1);
@@ -39,6 +62,11 @@ sub new {
 	return $self;
 }
 
+sub DESTROY {
+	my $self = shift;
+	$self->{_socket}->close();
+}
+
 sub eof {
 	my $self = shift;
 	return $self->{_socket}->eof();
@@ -109,6 +137,11 @@ sub can_read {
 	IO::Select->new($self->{_socket})->can_read($timo || 3);
 }
 
+sub socket {
+	my ($self) = @_;
+	$self->{_socket};
+}
+
 ###############################################################################
 
 sub pop3_test_daemon {
--- a/lib/Test/Nginx/SMTP.pm
+++ b/lib/Test/Nginx/SMTP.pm
@@ -20,17 +20,40 @@ sub new {
 	my $self = {};
 	bless $self, shift @_;
 
-	$self->{_socket} = IO::Socket::INET->new(
-		Proto => "tcp",
-		PeerAddr => "127.0.0.1:" . port(8025),
-		@_
-	)
-		or die "Can't connect to nginx: $!\n";
+	my $port = {@_}->{'SSL'} ? 8465 : 8025;
+
+	eval {
+		local $SIG{ALRM} = sub { die "timeout\n" };
+		local $SIG{PIPE} = sub { die "sigpipe\n" };
+		alarm(8);
+
+		$self->{_socket} = IO::Socket::INET->new(
+			Proto => "tcp",
+			PeerAddr => "127.0.0.1:" . port($port),
+			@_
+		)
+			or die "Can't connect to nginx: $!\n";
 
-	if ({@_}->{'SSL'}) {
-		require IO::Socket::SSL;
-		IO::Socket::SSL->start_SSL($self->{_socket}, @_)
-			or die $IO::Socket::SSL::SSL_ERROR . "\n";
+		if ({@_}->{'SSL'}) {
+			require IO::Socket::SSL;
+			IO::Socket::SSL->start_SSL(
+				$self->{_socket},
+				SSL_verify_mode =>
+					IO::Socket::SSL::SSL_VERIFY_NONE(),
+				@_
+			)
+				or die $IO::Socket::SSL::SSL_ERROR . "\n";
+
+			my $s = $self->{_socket};
+			log_in("ssl cipher: " . $s->get_cipher());
+			log_in("ssl cert: " . $s->peer_certificate('issuer'));
+		}
+
+		alarm(0);
+	};
+	alarm(0);
+	if ($@) {
+		log_in("died: $@");
 	}
 
 	$self->{_socket}->autoflush(1);
@@ -39,6 +62,11 @@ sub new {
 	return $self;
 }
 
+sub DESTROY {
+	my $self = shift;
+	$self->{_socket}->close();
+}
+
 sub eof {
 	my $self = shift;
 	return $self->{_socket}->eof();
@@ -115,6 +143,11 @@ sub can_read {
 	IO::Select->new($self->{_socket})->can_read($timo || 3);
 }
 
+sub socket {
+	my ($self) = @_;
+	$self->{_socket};
+}
+
 ###############################################################################
 
 sub smtp_test_daemon {
--- a/mail_ssl.t
+++ b/mail_ssl.t
@@ -27,19 +27,8 @@ select STDOUT; $| = 1;
 
 local $SIG{PIPE} = 'IGNORE';
 
-eval {
-	require Net::SSLeay;
-	Net::SSLeay::load_error_strings();
-	Net::SSLeay::SSLeay_add_ssl_algorithms();
-	Net::SSLeay::randomize();
-};
-plan(skip_all => 'Net::SSLeay not installed') if $@;
-
-eval { exists &Net::SSLeay::P_alpn_selected or die; };
-plan(skip_all => 'Net::SSLeay with OpenSSL ALPN support required') if $@;
-
-my $t = Test::Nginx->new()->has(qw/mail mail_ssl imap pop3 smtp/)
-	->has_daemon('openssl')->plan(18);
+my $t = Test::Nginx->new()->has(qw/mail mail_ssl imap pop3 smtp socket_ssl/)
+	->has_daemon('openssl')->plan(19);
 
 $t->write_file_expand('nginx.conf', <<'EOF');
 
@@ -143,7 +132,6 @@ foreach my $name ('localhost', 'inherits
 		or die "Can't create certificate for $name: $!\n";
 }
 
-my $ctx = Net::SSLeay::CTX_new() or die("Failed to create SSL_CTX $!");
 $t->write_file('password', 'localhost');
 
 open OLDERR, ">&", \*STDERR; close STDERR;
@@ -164,15 +152,24 @@ my ($s, $ssl);
 
 # ssl_certificate inheritance
 
-($s, $ssl) = get_ssl_socket(8145);
-like(Net::SSLeay::dump_peer_certificate($ssl), qr/CN=localhost/, 'CN');
+$s = Test::Nginx::IMAP->new(PeerAddr => '127.0.0.1:' . port(8145), SSL => 1);
+$s->ok('greeting ssl');
+
+like($s->socket()->dump_peer_certificate(), qr/CN=localhost/, 'CN');
 
-($s, $ssl) = get_ssl_socket(8148);
-like(Net::SSLeay::dump_peer_certificate($ssl), qr/CN=inherits/, 'CN inner');
+$s = Test::Nginx::IMAP->new(PeerAddr => '127.0.0.1:' . port(8148), SSL => 1);
+$s->read();
+
+like($s->socket()->dump_peer_certificate(), qr/CN=inherits/, 'CN inner');
 
 # alpn
 
-ok(get_ssl_socket(8148, ['imap']), 'alpn');
+$s = Test::Nginx::IMAP->new(
+	PeerAddr => '127.0.0.1:' . port(8148),
+	SSL => 1,
+	SSL_alpn_protocols => [ 'imap' ]
+);
+$s->ok('alpn');
 
 SKIP: {
 skip 'LibreSSL too old', 1
@@ -184,8 +181,15 @@ skip 'OpenSSL too old', 1
 
 TODO: {
 local $TODO = 'not yet' unless $t->has_version('1.21.4');
+local $TODO = 'no ALPN support in IO::Socket::SSL'
+	unless $t->has_feature('socket_ssl_alpn');
 
-ok(!get_ssl_socket(8148, ['unknown']), 'alpn rejected');
+$s = Test::Nginx::IMAP->new(
+	PeerAddr => '127.0.0.1:' . port(8148),
+	SSL => 1,
+	SSL_alpn_protocols => [ 'unknown' ]
+);
+ok(!$s->read(), 'alpn rejected');
 
 }
 
@@ -270,16 +274,3 @@ ok(!get_ssl_socket(8148, ['unknown']), '
 $s->ok('smtp starttls only');
 
 ###############################################################################
-
-sub get_ssl_socket {
-	my ($port, $alpn) = @_;
-
-	my $s = IO::Socket::INET->new('127.0.0.1:' . port($port));
-	my $ssl = Net::SSLeay::new($ctx) or die("Failed to create SSL $!");
-	Net::SSLeay::set_alpn_protos($ssl, $alpn) if defined $alpn;
-	Net::SSLeay::set_fd($ssl, fileno($s));
-	Net::SSLeay::connect($ssl) == 1 or return;
-	return ($s, $ssl);
-}
-
-###############################################################################
--- a/mail_ssl_conf_command.t
+++ b/mail_ssl_conf_command.t
@@ -16,6 +16,7 @@ BEGIN { use FindBin; chdir($FindBin::Bin
 
 use lib 'lib';
 use Test::Nginx;
+use Test::Nginx::IMAP;
 
 ###############################################################################
 
@@ -24,15 +25,8 @@ select STDOUT; $| = 1;
 
 local $SIG{PIPE} = 'IGNORE';
 
-eval {
-	require Net::SSLeay;
-	Net::SSLeay::load_error_strings();
-	Net::SSLeay::SSLeay_add_ssl_algorithms();
-	Net::SSLeay::randomize();
-};
-plan(skip_all => 'Net::SSLeay not installed') if $@;
-
-my $t = Test::Nginx->new()->has(qw/mail mail_ssl imap openssl:1.0.2/)
+my $t = Test::Nginx->new()
+	->has(qw/mail mail_ssl imap openssl:1.0.2 socket_ssl_reused/)
 	->has_daemon('openssl');
 
 plan(skip_all => 'no ssl_conf_command') if $t->has_module('BoringSSL');
@@ -50,7 +44,7 @@ mail {
     auth_http  http://127.0.0.1:8080;   # unused
 
     server {
-        listen       127.0.0.1:8443 ssl;
+        listen       127.0.0.1:8993 ssl;
         protocol     imap;
 
         ssl_protocols TLSv1.2;
@@ -93,32 +87,28 @@ foreach my $name ('localhost', 'override
 
 ###############################################################################
 
-my $ctx = Net::SSLeay::CTX_new() or die("Failed to create SSL_CTX $!");
+my $s;
 
-my ($s, $ssl) = get_ssl_socket();
-like(Net::SSLeay::dump_peer_certificate($ssl), qr/CN=override/, 'Certificate');
+$s = Test::Nginx::IMAP->new(
+	SSL => 1,
+	SSL_session_cache_size => 100
+);
+$s->read();
+
+like($s->socket()->dump_peer_certificate(), qr/CN=override/, 'Certificate');
 
-my $ses = Net::SSLeay::get_session($ssl);
-($s, $ssl) = get_ssl_socket(ses => $ses);
-ok(Net::SSLeay::session_reused($ssl), 'SessionTicket');
+$s = Test::Nginx::IMAP->new(
+	SSL => 1,
+	SSL_reuse_ctx => $s->socket()
+);
+ok($s->socket()->get_session_reused(), 'SessionTicket');
 
-($s, $ssl) = get_ssl_socket(ciphers =>
-	'ECDHE-RSA-AES128-GCM-SHA256:ECDHE-RSA-AES256-GCM-SHA384');
-is(Net::SSLeay::get_cipher($ssl),
+$s = Test::Nginx::IMAP->new(
+	SSL => 1,
+	SSL_cipher_list =>
+		'ECDHE-RSA-AES128-GCM-SHA256:ECDHE-RSA-AES256-GCM-SHA384'
+);
+is($s->socket()->get_cipher(),
 	'ECDHE-RSA-AES128-GCM-SHA256', 'ServerPreference');
 
 ###############################################################################
-
-sub get_ssl_socket {
-	my (%extra) = @_;
-
-	my $s = IO::Socket::INET->new('127.0.0.1:' . port(8443));
-	my $ssl = Net::SSLeay::new($ctx) or die("Failed to create SSL $!");
-	Net::SSLeay::set_session($ssl, $extra{ses}) if $extra{ses};
-	Net::SSLeay::set_cipher_list($ssl, $extra{ciphers}) if $extra{ciphers};
-	Net::SSLeay::set_fd($ssl, fileno($s));
-	Net::SSLeay::connect($ssl) or die("ssl connect");
-	return ($s, $ssl);
-}
-
-###############################################################################
--- a/mail_ssl_session_reuse.t
+++ b/mail_ssl_session_reuse.t
@@ -17,6 +17,7 @@ BEGIN { use FindBin; chdir($FindBin::Bin
 
 use lib 'lib';
 use Test::Nginx;
+use Test::Nginx::IMAP;
 
 ###############################################################################
 
@@ -25,15 +26,7 @@ select STDOUT; $| = 1;
 
 local $SIG{PIPE} = 'IGNORE';
 
-eval {
-	require Net::SSLeay;
-	Net::SSLeay::load_error_strings();
-	Net::SSLeay::SSLeay_add_ssl_algorithms();
-	Net::SSLeay::randomize();
-};
-plan(skip_all => 'Net::SSLeay not installed') if $@;
-
-my $t = Test::Nginx->new()->has(qw/mail mail_ssl imap/)
+my $t = Test::Nginx->new()->has(qw/mail mail_ssl imap socket_ssl_sslversion/)
 	->has_daemon('openssl')->plan(7);
 
 $t->write_file_expand('nginx.conf', <<'EOF');
@@ -125,8 +118,6 @@ foreach my $name ('localhost') {
 		or die "Can't create certificate for $name: $!\n";
 }
 
-my $ctx = Net::SSLeay::CTX_new() or die("Failed to create SSL_CTX $!");
-
 $t->run();
 
 ###############################################################################
@@ -142,6 +133,10 @@ my $ctx = Net::SSLeay::CTX_new() or die(
 # - only cache off
 
 TODO: {
+local $TODO = 'no TLSv1.3 sessions, old Net::SSLeay'
+	if $Net::SSLeay::VERSION < 1.88 && test_tls13();
+local $TODO = 'no TLSv1.3 sessions, old IO::Socket::SSL'
+	if $IO::Socket::SSL::VERSION < 2.061 && test_tls13();
 local $TODO = 'no TLSv1.3 sessions in LibreSSL'
 	if $t->has_module('LibreSSL') && test_tls13();
 
@@ -165,28 +160,27 @@ is(test_reuse(8999), 0, 'cache off not r
 ###############################################################################
 
 sub test_tls13 {
-	my ($s, $ssl) = get_ssl_socket(8993);
-	return (Net::SSLeay::version($ssl) > 0x303);
+	my $s = Test::Nginx::IMAP->new(SSL => 1);
+	return ($s->socket()->get_sslversion_int() > 0x303);
 }
 
 sub test_reuse {
 	my ($port) = @_;
-	my ($s, $ssl) = get_ssl_socket($port);
-	Net::SSLeay::read($ssl);
-	my $ses = Net::SSLeay::get_session($ssl);
-	($s, $ssl) = get_ssl_socket($port, $ses);
-	return Net::SSLeay::session_reused($ssl);
-}
+
+	my $s = Test::Nginx::IMAP->new(
+		PeerAddr => '127.0.0.1:' . port($port),
+		SSL => 1,
+		SSL_session_cache_size => 100
+	);
+	$s->read();
 
-sub get_ssl_socket {
-	my ($port, $ses) = @_;
+	$s = Test::Nginx::IMAP->new(
+		PeerAddr => '127.0.0.1:' . port($port),
+		SSL => 1,
+		SSL_reuse_ctx => $s->socket()
+	);
 
-	my $s = IO::Socket::INET->new('127.0.0.1:' . port($port));
-	my $ssl = Net::SSLeay::new($ctx) or die("Failed to create SSL $!");
-	Net::SSLeay::set_session($ssl, $ses) if defined $ses;
-	Net::SSLeay::set_fd($ssl, fileno($s));
-	Net::SSLeay::connect($ssl) == 1 or return;
-	return ($s, $ssl);
+	return $s->socket()->get_session_reused();
 }
 
 ###############################################################################