diff options
| -rw-r--r-- | lib/PublicInbox/Daemon.pm | 54 | ||||
| -rw-r--r-- | lib/PublicInbox/IMAP.pm | 10 | ||||
| -rw-r--r-- | lib/PublicInbox/IMAPD.pm | 2 | ||||
| -rw-r--r-- | lib/PublicInbox/NNTP.pm | 10 | ||||
| -rw-r--r-- | lib/PublicInbox/NNTPD.pm | 2 | ||||
| -rw-r--r-- | lib/PublicInbox/POP3.pm | 10 | ||||
| -rw-r--r-- | lib/PublicInbox/POP3D.pm | 2 | ||||
| -rw-r--r-- | lib/PublicInbox/TLS.pm | 28 | ||||
| -rw-r--r-- | 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'); |