[PATCH] daemon: reload TLS certs and keys on SIGHUP

[PATCH] daemon: reload TLS certs and keys on SIGHUP

[Eric Wong]

This allows new TLS certificates to be loaded for new clients
without having to timeout or drop existing clients with
established connections on the .  This should benefit users with
admins who expire certificates frequently (as encouraged by
Let's Encrypt).
---
 lib/PublicInbox/Daemon.pm | 54 +++++++++++++----------------------
 lib/PublicInbox/IMAP.pm   | 10 +++----
 lib/PublicInbox/IMAPD.pm  |  2 +-
 lib/PublicInbox/NNTP.pm   | 10 +++----
 lib/PublicInbox/NNTPD.pm  |  2 +-
 lib/PublicInbox/POP3.pm   | 10 +++----
 lib/PublicInbox/POP3D.pm  |  2 +-
 lib/PublicInbox/TLS.pm    | 28 +++++++++++++++++--
 t/httpd-https.t           | 59 +++++++++++++++++++++++++++++----------
 9 files changed, 107 insertions(+), 70 deletions(-)

diff --git a/lib/PublicInbox/Daemon.pm b/lib/PublicInbox/Daemon.pm
index 20b07b83..67b26d2e 100644
--- a/lib/PublicInbox/Daemon.pm
+++ b/lib/PublicInbox/Daemon.pm
@@ -29,7 +29,7 @@ my (@cfg_listen, $stdout, $stderr, $group, $user, $pid_file, $daemonize);
 my $worker_processes = 1;
 my @listeners;
 my (%pids, %logs);
-my %tls_opt; # scheme://sockname => args for IO::Socket::SSL->start_SSL
+my %tls_opt; # scheme://sockname => args for IO::Socket::SSL::SSL_Context->new
 my $reexec_pid;
 my ($uid, $gid);
 my ($default_cert, $default_key);
@@ -55,43 +55,31 @@ sub listener_opt ($) {
 	$o;
 }
 
+sub check_absolute ($$) {
+	my ($var, $val) = @_;
+	die <<EOM if index($val // '/', '/') != 0;
+$var must be an absolute path when using --daemonize: $val
+EOM
+}
+
 sub accept_tls_opt ($) {
 	my ($opt) = @_;
 	my $o = ref($opt) eq 'HASH' ? $opt : listener_opt($opt);
 	return if !defined($o->{cert});
 	require PublicInbox::TLS;
-	my %ctx_opt = (SSL_server => 1);
+	my @ctx_opt;
 	# parse out hostname:/path/to/ mappings:
 	for my $k (qw(cert key)) {
 		$o->{$k} // next;
-		my $x = $ctx_opt{'SSL_'.$k.'_file'} = {};
+		push(@ctx_opt, "SSL_${k}_file", {});
 		foreach my $path (@{$o->{$k}}) {
 			my $host = '';
 			$path =~ s/\A([^:]+):// and $host = $1;
-			$x->{$host} = $path;
+			$ctx_opt[-1]->{$host} = $path;
 			check_absolute($k, $path) if $daemonize;
 		}
 	}
-	my $ctx = IO::Socket::SSL::SSL_Context->new(%ctx_opt) or
-		die 'SSL_Context->new: '.PublicInbox::TLS::err();
-
-	# save ~34K per idle connection (cf. SSL_CTX_set_mode(3ssl))
-	# RSS goes from 346MB to 171MB with 10K idle NNTPS clients on amd64
-	# cf. https://rt.cpan.org/Ticket/Display.html?id=129463
-	my $mode = eval { Net::SSLeay::MODE_RELEASE_BUFFERS() };
-	if ($mode && $ctx->{context}) {
-		eval { Net::SSLeay::CTX_set_mode($ctx->{context}, $mode) };
-		warn "W: $@ (setting SSL_MODE_RELEASE_BUFFERS)\n" if $@;
-	}
-
-	{ SSL_server => 1, SSL_startHandshake => 0, SSL_reuse_ctx => $ctx };
-}
-
-sub check_absolute ($$) {
-	my ($var, $val) = @_;
-	die <<EOM if index($val // '/', '/') != 0;
-$var must be an absolute path when using --daemonize: $val
-EOM
+	\@ctx_opt;
 }
 
 sub do_chown ($) {
@@ -637,12 +625,11 @@ EOF
 	exit # never gets here, just for documentation
 }
 
-sub tls_start_cb ($$) {
-	my ($opt, $orig_post_accept) = @_;
+sub tls_cb {
+	my ($post_accept, $tlsd) = @_;
 	sub {
 		my ($io, $addr, $srv) = @_;
-		my $ssl = IO::Socket::SSL->start_SSL($io, %$opt);
-		$orig_post_accept->($ssl, $addr, $srv);
+		$post_accept->(PublicInbox::TLS::start($io, $tlsd), $addr, $srv)
 	}
 }
 
@@ -669,21 +656,20 @@ sub daemon_loop ($) {
 	my $refresh = sub {
 		my ($sig) = @_;
 		for my $xn (values %$xnetd) {
+			delete $xn->{tlsd}->{ssl_ctx}; # PublicInbox::TLS::start
 			eval { $xn->{refresh}->($sig) };
 			warn "refresh $@\n" if $@;
 		}
 	};
 	my %post_accept;
-	while (my ($k, $v) = each %tls_opt) {
+	while (my ($k, $ctx_opt) = each %tls_opt) {
 		my $l = $k;
 		$l =~ s!\A([^:]+)://!!;
 		my $scheme = $1 // '';
 		my $xn = $xnetd->{$l} // $xnetd->{''};
-		if ($scheme =~ m!\A(?:https|imaps|nntps|pop3s)!) {
-			$post_accept{$l} = tls_start_cb($v, $xn->{post_accept});
-		} elsif ($xn->{tlsd}) { # STARTTLS, $k eq '' is OK
-			$xn->{tlsd}->{accept_tls} = $v;
-		}
+		$xn->{tlsd}->{ssl_ctx_opt} //= $ctx_opt;
+		$scheme =~ m!\A(?:https|imaps|nntps|pop3s)! and
+			$post_accept{$l} = tls_cb(@$xn{qw(post_accept tlsd)});
 	}
 	my $sig = {
 		HUP => $refresh,
diff --git a/lib/PublicInbox/IMAP.pm b/lib/PublicInbox/IMAP.pm
index 0f0f9b3a..19ead70c 100644
--- a/lib/PublicInbox/IMAP.pm
+++ b/lib/PublicInbox/IMAP.pm
@@ -121,7 +121,7 @@ sub capa ($) {
 		$capa .= ' COMPRESS=DEFLATE';
 	} else {
 		if (!($self->{sock} // $self)->can('accept_SSL') &&
-			$self->{imapd}->{accept_tls}) {
+			$self->{imapd}->{ssl_ctx_opt}) {
 			$capa .= ' STARTTLS';
 		}
 		$capa .= ' AUTH=ANONYMOUS';
@@ -1230,14 +1230,12 @@ sub cmd_compress ($$$) {
 
 sub cmd_starttls ($$) {
 	my ($self, $tag) = @_;
-	my $sock = $self->{sock} or return;
-	if ($sock->can('stop_SSL') || $self->compressed) {
+	(($self->{sock} // return)->can('stop_SSL') || $self->compressed) and
 		return "$tag BAD TLS or compression already enabled\r\n";
-	}
-	my $opt = $self->{imapd}->{accept_tls} or
+	$self->{imapd}->{ssl_ctx_opt} or
 		return "$tag BAD can not initiate TLS negotiation\r\n";
 	$self->write(\"$tag OK begin TLS negotiation now\r\n");
-	$self->{sock} = IO::Socket::SSL->start_SSL($sock, %$opt);
+	PublicInbox::TLS::start($self->{sock}, $self->{imapd});
 	$self->requeue if PublicInbox::DS::accept_tls_step($self);
 	undef;
 }
diff --git a/lib/PublicInbox/IMAPD.pm b/lib/PublicInbox/IMAPD.pm
index 9a5bdcfe..6038fd88 100644
--- a/lib/PublicInbox/IMAPD.pm
+++ b/lib/PublicInbox/IMAPD.pm
@@ -18,7 +18,7 @@ sub new {
 		mailboxes => {},
 		err => \*STDERR,
 		out => \*STDOUT,
-		# accept_tls => { SSL_server => 1, ..., SSL_reuse_ctx => ... }
+		# ssl_ctx_opt => { SSL_cert_file => ..., SSL_key_file => ... }
 		# pi_cfg => PublicInbox::Config
 		# idler => PublicInbox::InboxIdle
 	}, $class;
diff --git a/lib/PublicInbox/NNTP.pm b/lib/PublicInbox/NNTP.pm
index 791fe2a9..9ae1353a 100644
--- a/lib/PublicInbox/NNTP.pm
+++ b/lib/PublicInbox/NNTP.pm
@@ -85,7 +85,7 @@ sub cmd_capabilities ($;$) {
 	my ($self, undef) = @_;
 	my $res = $CAPABILITIES;
 	if (!$self->{sock}->can('accept_SSL') &&
-			$self->{nntpd}->{accept_tls}) {
+			$self->{nntpd}->{ssl_ctx_opt}) {
 		$res .= "STARTTLS\r\n";
 	}
 	$res .= ".\r\n";
@@ -885,13 +885,13 @@ sub cmd_xover ($;$) {
 
 sub cmd_starttls ($) {
 	my ($self) = @_;
-	my $sock = $self->{sock} or return;
 	# RFC 4642 2.2.1
-	return r502 if ($sock->can('accept_SSL') || $self->compressed);
-	my $opt = $self->{nntpd}->{accept_tls} or
+	(($self->{sock} // return)->can('stop_SSL') || $self->compressed) and
+		return r502;
+	$self->{nntpd}->{ssl_ctx_opt} or
 		return \"580 can not initiate TLS negotiation\r\n";
 	$self->write(\"382 Continue with TLS negotiation\r\n");
-	$self->{sock} = IO::Socket::SSL->start_SSL($sock, %$opt);
+	PublicInbox::TLS::start($self->{sock}, $self->{nntpd});
 	$self->requeue if PublicInbox::DS::accept_tls_step($self);
 	undef;
 }
diff --git a/lib/PublicInbox/NNTPD.pm b/lib/PublicInbox/NNTPD.pm
index 9e232ef6..15a72bac 100644
--- a/lib/PublicInbox/NNTPD.pm
+++ b/lib/PublicInbox/NNTPD.pm
@@ -17,7 +17,7 @@ sub new {
 		err => \*STDERR,
 		out => \*STDOUT,
 		# pi_cfg => $pi_cfg,
-		# accept_tls => { SSL_server => 1, ..., SSL_reuse_ctx => ... }
+		# ssl_ctx_opt => { SSL_cert_file => ..., SSL_key_file => ... }
 		# idler => PublicInbox::InboxIdle
 	}, $class;
 }
diff --git a/lib/PublicInbox/POP3.pm b/lib/PublicInbox/POP3.pm
index 203c91a6..7469922b 100644
--- a/lib/PublicInbox/POP3.pm
+++ b/lib/PublicInbox/POP3.pm
@@ -130,12 +130,12 @@ sub cmd_pass {
 
 sub cmd_stls {
 	my ($self) = @_;
-	my $sock = $self->{sock} or return;
-	return \"-ERR TLS already enabled\r\n" if $sock->can('stop_SSL');
-	my $opt = $self->{pop3d}->{accept_tls} or
+	($self->{sock} // return)->can('stop_SSL') and
+		return \"-ERR TLS already enabled\r\n";
+	$self->{pop3d}->{ssl_ctx_opt} or
 		return \"-ERR can't start TLS negotiation\r\n";
 	$self->write(\"+OK begin TLS negotiation now\r\n");
-	$self->{sock} = IO::Socket::SSL->start_SSL($sock, %$opt);
+	PublicInbox::TLS::start($self->{sock}, $self->{pop3d});
 	$self->requeue if PublicInbox::DS::accept_tls_step($self);
 	undef;
 }
@@ -281,7 +281,7 @@ sub cmd_dele {
 sub cmd_capa {
 	my ($self) = @_;
 	my $STLS = !$self->{ibx} && !$self->{sock}->can('stop_SSL') &&
-			$self->{pop3d}->{accept_tls} ? "\nSTLS\r" : '';
+			$self->{pop3d}->{ssl_ctx_opt} ? "\nSTLS\r" : '';
 	$self->{expire} = ''; # "EXPIRE 0" allows clients to avoid DELE commands
 	<<EOM;
 +OK Capability list follows\r
diff --git a/lib/PublicInbox/POP3D.pm b/lib/PublicInbox/POP3D.pm
index 5cfe9613..764f9ffe 100644
--- a/lib/PublicInbox/POP3D.pm
+++ b/lib/PublicInbox/POP3D.pm
@@ -45,7 +45,7 @@ sub new {
 		# lock_path => ...
 		# interprocess lock is the $pop3state/txn.locks file
 		# txn_locks => {}, # intraworker locks
-		# accept_tls => { SSL_server => 1, ..., SSL_reuse_ctx => ... }
+		# ssl_ctx_opt => { SSL_cert_file => ..., SSL_key_file => ... }
 	}, $cls;
 }
 
diff --git a/lib/PublicInbox/TLS.pm b/lib/PublicInbox/TLS.pm
index 3fe16a62..3ce57f1b 100644
--- a/lib/PublicInbox/TLS.pm
+++ b/lib/PublicInbox/TLS.pm
@@ -1,4 +1,4 @@
-# Copyright (C) 2019-2021 all contributors <meta@public-inbox.org>
+# Copyright (C) all contributors <meta@public-inbox.org>
 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
 
 # IO::Socket::SSL support code
@@ -6,7 +6,7 @@ package PublicInbox::TLS;
 use strict;
 use IO::Socket::SSL;
 use PublicInbox::Syscall qw(EPOLLIN EPOLLOUT);
-use Carp qw(carp);
+use Carp qw(carp croak);
 
 sub err () { $SSL_ERROR }
 
@@ -18,4 +18,28 @@ sub epollbit () {
 	undef;
 }
 
+sub _ctx_new ($) {
+	my ($tlsd) = @_;
+	my $ctx = IO::Socket::SSL::SSL_Context->new(
+				@{$tlsd->{ssl_ctx_opt}}, SSL_server => 1) or
+		croak "SSL_Context->new: $SSL_ERROR";
+
+	# save ~34K per idle connection (cf. SSL_CTX_set_mode(3ssl))
+	# RSS goes from 346MB to 171MB with 10K idle NNTPS clients on amd64
+	# cf. https://rt.cpan.org/Ticket/Display.html?id=129463
+	my $mode = eval { Net::SSLeay::MODE_RELEASE_BUFFERS() };
+	if ($mode && $ctx->{context}) {
+		eval { Net::SSLeay::CTX_set_mode($ctx->{context}, $mode) };
+		warn "W: $@ (setting SSL_MODE_RELEASE_BUFFERS)\n" if $@;
+	}
+	$ctx;
+}
+
+sub start {
+	my ($io, $tlsd) = @_;
+	IO::Socket::SSL->start_SSL($io, SSL_server => 1,
+		SSL_reuse_ctx => ($tlsd->{ssl_ctx} //= _ctx_new($tlsd)),
+		SSL_startHandshake => 0);
+}
+
 1;
diff --git a/t/httpd-https.t b/t/httpd-https.t
index d42d7c50..b0cd7eab 100644
--- a/t/httpd-https.t
+++ b/t/httpd-https.t
@@ -1,15 +1,15 @@
-# Copyright (C) 2019-2021 all contributors <meta@public-inbox.org>
+#!perl -w
+# Copyright (C) all contributors <meta@public-inbox.org>
 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
-use strict;
-use warnings;
-use Test::More;
+use v5.12;
 use Socket qw(SOCK_STREAM IPPROTO_TCP SOL_SOCKET);
 use PublicInbox::TestCommon;
+use File::Copy qw(cp);
 # IO::Poll is part of the standard library, but distros may split them off...
 require_mods(qw(IO::Socket::SSL IO::Poll Plack::Util));
-my $cert = 'certs/server-cert.pem';
-my $key = 'certs/server-key.pem';
-unless (-r $key && -r $cert) {
+my @certs = qw(certs/server-cert.pem certs/server-key.pem
+	certs/server2-cert.pem certs/server2-key.pem);
+if (scalar(grep { -r $_ } @certs) != scalar(@certs)) {
 	plan skip_all =>
 		"certs/ missing for $0, run $^X ./create-certs.perl in certs/";
 }
@@ -22,6 +22,20 @@ my $out = "$tmpdir/stdout.log";
 my $https = tcp_server();
 my $td;
 my $https_addr = tcp_host_port($https);
+my $cert = "$tmpdir/cert.pem";
+my $key = "$tmpdir/key.pem";
+cp('certs/server-cert.pem', $cert) or xbail $!;
+cp('certs/server-key.pem', $key) or xbail $!;
+
+my $check_url_scheme = sub {
+	my ($s, $line) = @_;
+	$s->print("GET /url_scheme HTTP/1.1\r\n\r\nHost: example.com\r\n\r\n")
+		or xbail "failed to write HTTP request: $! (line $line)";
+	my $buf = '';
+	sysread($s, $buf, 2007, length($buf)) until $buf =~ /\r\n\r\nhttps?/;
+	like($buf, qr!\AHTTP/1\.1 200!, "read HTTPS response (line $line)");
+	like($buf, qr!\r\nhttps\z!, "psgi.url_scheme is 'https' (line $line)");
+};
 
 for my $args (
 	[ "-lhttps://$https_addr/?key=$key,cert=$cert" ],
@@ -53,12 +67,7 @@ for my $args (
 	# normal HTTPS
 	my $c = tcp_connect($https);
 	IO::Socket::SSL->start_SSL($c, %o);
-	$c->print("GET /url_scheme HTTP/1.1\r\n\r\nHost: example.com\r\n\r\n")
-		or xbail "failed to write HTTP request: $!";
-	my $buf = '';
-	sysread($c, $buf, 2007, length($buf)) until $buf =~ /\r\n\r\nhttps?/;
-	like($buf, qr!\AHTTP/1\.1 200!, 'read HTTP response');
-	like($buf, qr!\r\nhttps\z!, "psgi.url_scheme is 'https'");
+	$check_url_scheme->($c, __LINE__);
 
 	# HTTPS with bad hostname
 	$c = tcp_connect($https);
@@ -81,7 +90,7 @@ for my $args (
 	$slow->blocking(1);
 	ok($slow->print("GET /empty HTTP/1.1\r\n\r\nHost: example.com\r\n\r\n"),
 		'wrote HTTP request from slow');
-	$buf = '';
+	my $buf = '';
 	sysread($slow, $buf, 666, length($buf)) until $buf =~ /\r\n\r\n/;
 	like($buf, qr!\AHTTP/1\.1 200!, 'read HTTP response from slow');
 	$slow = undef;
@@ -105,7 +114,27 @@ for my $args (
 		like($x, qr/\Adataready\0+\z/, 'got dataready accf for https');
 	};
 
-	$c = undef;
+	# switch cert and key:
+	cp('certs/server2-cert.pem', $cert) or xbail $!;
+	cp('certs/server2-key.pem', $key) or xbail $!;
+	$td->kill('HUP') or xbail "kill: $!";
+	tick(); # wait for SIGHUP to take effect (hopefully :x)
+
+	my $d = tcp_connect($https);
+	$d = IO::Socket::SSL->start_SSL($d, %o);
+	is($d, undef, 'HTTPS fails with bad hostname after new cert on HUP');
+
+	$d = tcp_connect($https);
+	$o{SSL_hostname} = $o{SSL_verifycn_name} = 'server2.local';
+	is(IO::Socket::SSL->start_SSL($d, %o), $d,
+		'new hostname to match cert works after HUP');
+	$check_url_scheme->($d, __LINE__);
+
+	# existing connection w/ old cert still works:
+	$check_url_scheme->($c, __LINE__);
+
+	undef $c;
+	undef $d;
 	$td->kill;
 	$td->join;
 	is($?, 0, 'no error in exited process');

Re: [PATCH] daemon: reload TLS certs and keys on SIGHUP

[Eric Wong]

Eric Wong <e@80x24.org> wrote:
> This allows new TLS certificates to be loaded for new clients
> without having to timeout or drop existing clients with
> established connections on the .  This should benefit users with

That should read:

  This allows new TLS certificates to be loaded for new clients
  without having to timeout nor drop existing clients with
  established connections made with the old certs.

:x