From: Eric Wong Date: Wed, 3 Aug 2022 08:06:03 +0000 (+0000) Subject: daemon: reload TLS certs and keys on SIGHUP X-Git-Tag: v1.9.0~60 X-Git-Url: http://www.git.stargrave.org/?p=public-inbox.git;a=commitdiff_plain;h=ec328a09ae172569ac72bafb02eaf1dc2d489867 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). --- 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 <{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 <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 < ... # 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 +# Copyright (C) all contributors # License: AGPL-3.0+ # 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 +#!perl -w +# Copyright (C) all contributors # License: AGPL-3.0+ -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');