daemon: reload TLS certs and keys on SIGHUP

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.  This should
benefit users with admins who expire certificates frequently (as
encouraged by Let's Encrypt).

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');