X-Git-Url: http://www.git.stargrave.org/?a=blobdiff_plain;f=t%2Fnntpd-tls.t;h=2a76867a290b44bebc67fbda817927e6eb452f16;hb=refs%2Fheads%2Fmaster;hp=00b03b66835e152a7b3e7fb3eb3fcac56c326b66;hpb=595854982a59f369ab605794f05c046c86253468;p=public-inbox.git diff --git a/t/nntpd-tls.t b/t/nntpd-tls.t index 00b03b66..2a76867a 100644 --- a/t/nntpd-tls.t +++ b/t/nntpd-tls.t @@ -1,93 +1,59 @@ -# Copyright (C) 2019 all contributors +#!perl -w +# Copyright (C) 2019-2021 all contributors # License: AGPL-3.0+ use strict; -use warnings; -use Test::More; -use File::Temp qw(tempdir); -use Socket qw(SOCK_STREAM); -foreach my $mod (qw(DBD::SQLite IO::Socket::SSL Net::NNTP)) { - eval "require $mod"; - plan skip_all => "$mod missing for $0" if $@; -} +use v5.10.1; +use PublicInbox::TestCommon; +use Socket qw(SOCK_STREAM IPPROTO_TCP SOL_SOCKET); +# IO::Poll and Net::NNTP are part of the standard library, but +# distros may split them off... +require_mods(qw(DBD::SQLite IO::Socket::SSL Net::NNTP IO::Poll)); +Net::NNTP->can('starttls') or + plan skip_all => 'Net::NNTP does not support TLS'; + my $cert = 'certs/server-cert.pem'; my $key = 'certs/server-key.pem'; unless (-r $key && -r $cert) { plan skip_all => - "certs/ missing for $0, run ./create-certs.perl in certs/"; + "certs/ missing for $0, run $^X ./create-certs.perl in certs/"; } use_ok 'PublicInbox::TLS'; use_ok 'IO::Socket::SSL'; -require './t/common.perl'; -require PublicInbox::InboxWritable; -require PublicInbox::MIME; -require PublicInbox::SearchIdx; +our $need_zlib; +eval { require Compress::Raw::Zlib } or + $need_zlib = 'Compress::Raw::Zlib missing'; my $version = 2; # v2 needs newer git require_git('2.6') if $version >= 2; -my $tmpdir = tempdir('pi-nntpd-tls-XXXXXX', TMPDIR => 1, CLEANUP => 1); +my ($tmpdir, $for_destroy) = tmpdir(); my $err = "$tmpdir/stderr.log"; my $out = "$tmpdir/stdout.log"; -my $mainrepo = "$tmpdir"; -my $pi_config = "$tmpdir/pi_config"; my $group = 'test-nntpd-tls'; my $addr = $group . '@example.com'; -my $nntpd = 'blib/script/public-inbox-nntpd'; -my %opts = ( - LocalAddr => '127.0.0.1', - ReuseAddr => 1, - Proto => 'tcp', - Type => SOCK_STREAM, - Listen => 1024, -); -my $starttls = IO::Socket::INET->new(%opts); -my $nntps = IO::Socket::INET->new(%opts); -my ($pid, $tail_pid); -END { - foreach ($pid, $tail_pid) { - kill 'TERM', $_ if defined $_; - } -}; - -my $ibx = PublicInbox::Inbox->new({ - mainrepo => $mainrepo, - name => 'nntpd-tls', - version => $version, - -primary_address => $addr, - indexlevel => 'basic', -}); -$ibx = PublicInbox::InboxWritable->new($ibx, {nproc=>1}); -$ibx->init_inbox(0); -{ - open my $fh, '>', $pi_config or die "open: $!\n"; - print $fh < $version, indexlevel => 'basic', + sub { + my ($im, $ibx) = @_; + $pi_config = "$ibx->{inboxdir}/pi_config"; + open my $fh, '>', $pi_config or BAIL_OUT "open: $!"; + print $fh <{inboxdir} address = $addr indexlevel = basic newsgroup = $group EOF - ; - close $fh or die "close: $!\n"; -} - -{ - my $im = $ibx->importer(0); - my $mime = PublicInbox::MIME->new(do { - open my $fh, '<', 't/data/0001.patch' or die; - local $/; - <$fh> - }); - ok($im->add($mime), 'message added'); - $im->done; - if ($version == 1) { - my $s = PublicInbox::SearchIdx->new($ibx, 1); - $s->index_sync; - } -} - -my $nntps_addr = $nntps->sockhost . ':' . $nntps->sockport; -my $starttls_addr = $starttls->sockhost . ':' . $starttls->sockport; + close $fh or BAIL_OUT "close: $!"; + $im->add(eml_load 't/data/0001.patch') or BAIL_OUT; +}; +$pi_config //= "$ibx->{inboxdir}/pi_config"; +undef $ibx; +my $nntps_addr = tcp_host_port($nntps); +my $starttls_addr = tcp_host_port($starttls); my $env = { PI_CONFIG => $pi_config }; +my $td; for my $args ( [ "--cert=$cert", "--key=$key", @@ -97,32 +63,40 @@ for my $args ( for ($out, $err) { open my $fh, '>', $_ or die "truncate: $!"; } - if (my $tail_cmd = $ENV{TAIL}) { # don't assume GNU tail - $tail_pid = fork; - if (defined $tail_pid && $tail_pid == 0) { - exec(split(' ', $tail_cmd), $out, $err); - } - } - my $cmd = [ $nntpd, '-W0', @$args, "--stdout=$out", "--stderr=$err" ]; - $pid = spawn_listener($env, $cmd, [ $starttls, $nntps ]); + my $cmd = [ '-nntpd', '-W0', @$args, "--stdout=$out", "--stderr=$err" ]; + $td = start_script($cmd, $env, { 3 => $starttls, 4 => $nntps }); my %o = ( SSL_hostname => 'server.local', SSL_verifycn_name => 'server.local', - SSL => 1, SSL_verify_mode => SSL_VERIFY_PEER(), SSL_ca_file => 'certs/test-ca.pem', ); my $expect = { $group => [qw(1 1 n)] }; + # start negotiating a slow TLS connection + my $slow = tcp_connect($nntps, Blocking => 0); + $slow = IO::Socket::SSL->start_SSL($slow, SSL_startHandshake => 0, %o); + my $slow_done = $slow->connect_SSL; + my @poll; + if ($slow_done) { + diag('W: connect_SSL early OK, slow client test invalid'); + use PublicInbox::Syscall qw(EPOLLIN EPOLLOUT); + @poll = (fileno($slow), EPOLLIN | EPOLLOUT); + } else { + @poll = (fileno($slow), PublicInbox::TLS::epollbit()); + } + # we should call connect_SSL much later... + # NNTPS - my $c = Net::NNTP->new($nntps_addr, %o); + my $c = Net::NNTP->new($nntps_addr, %o, SSL => 1); my $list = $c->list; is_deeply($list, $expect, 'NNTPS LIST works'); + unlike(get_capa($c), qr/\bSTARTTLS\r\n/, + 'STARTTLS not advertised for NNTPS'); is($c->command('QUIT')->response(), Net::Cmd::CMD_OK(), 'QUIT works'); is(0, sysread($c, my $buf, 1), 'got EOF after QUIT'); # STARTTLS - delete $o{SSL}; $c = Net::NNTP->new($starttls_addr, %o); $list = $c->list; is_deeply($list, $expect, 'plain LIST works'); @@ -130,6 +104,8 @@ for my $args ( is($c->code, 382, 'got 382 for STARTTLS'); $list = $c->list; is_deeply($list, $expect, 'LIST works after STARTTLS'); + unlike(get_capa($c), qr/\bSTARTTLS\r\n/, + 'STARTTLS not advertised after STARTTLS'); # Net::NNTP won't let us do dumb things, but we need to test # dumb things, so use Net::Cmd directly: @@ -140,6 +116,7 @@ for my $args ( # STARTTLS with bad hostname $o{SSL_hostname} = $o{SSL_verifycn_name} = 'server.invalid'; $c = Net::NNTP->new($starttls_addr, %o); + like(get_capa($c), qr/\bSTARTTLS\r\n/, 'STARTTLS advertised'); $list = $c->list; is_deeply($list, $expect, 'plain LIST works again'); ok(!$c->starttls, 'STARTTLS fails with bad hostname'); @@ -154,22 +131,83 @@ for my $args ( $c = Net::NNTP->new($nntps_addr, %o, SSL => 1); ok($c, 'NNTPS succeeds again with valid hostname'); + # slow TLS connection did not block the other fast clients while + # connecting, finish it off: + until ($slow_done) { + IO::Poll::_poll(-1, @poll); + $slow_done = $slow->connect_SSL and last; + @poll = (fileno($slow), PublicInbox::TLS::epollbit()); + } + $slow->blocking(1); + ok(sysread($slow, my $greet, 4096) > 0, 'slow got greeting'); + like($greet, qr/\A201 /, 'got expected greeting'); + is(syswrite($slow, "QUIT\r\n"), 6, 'slow wrote QUIT'); + ok(sysread($slow, my $end, 4096) > 0, 'got EOF'); + is(sysread($slow, my $eof, 4096), 0, 'got EOF'); + $slow = undef; + + test_lei(sub { + lei_ok qw(ls-mail-source), "nntp://$starttls_addr", + \'STARTTLS not used by default'; + ok(!lei(qw(ls-mail-source -c nntp.starttls=true), + "nntp://$starttls_addr"), 'STARTTLS verify fails'); + like $lei_err, qr/STARTTLS requested/, + 'STARTTLS noted in stderr'; + }); + + SKIP: { + skip 'TCP_DEFER_ACCEPT is Linux-only', 2 if $^O ne 'linux'; + my $var = eval { Socket::TCP_DEFER_ACCEPT() } // 9; + defined(my $x = getsockopt($nntps, IPPROTO_TCP, $var)) or die; + ok(unpack('i', $x) > 0, 'TCP_DEFER_ACCEPT set on NNTPS'); + defined($x = getsockopt($starttls, IPPROTO_TCP, $var)) or die; + is(unpack('i', $x), 0, 'TCP_DEFER_ACCEPT is 0 on plain NNTP'); + }; + SKIP: { + skip 'SO_ACCEPTFILTER is FreeBSD-only', 2 if $^O ne 'freebsd'; + if (system('kldstat -m accf_data >/dev/null')) { + skip 'accf_data not loaded? kldload accf_data', 2; + } + require PublicInbox::Daemon; + my $x = getsockopt($nntps, SOL_SOCKET, + $PublicInbox::Daemon::SO_ACCEPTFILTER); + like($x, qr/\Adataready\0+\z/, 'got dataready accf for NNTPS'); + $x = getsockopt($starttls, IPPROTO_TCP, + $PublicInbox::Daemon::SO_ACCEPTFILTER); + is($x, undef, 'no BSD accept filter for plain NNTP'); + }; + $c = undef; - kill('TERM', $pid); - is($pid, waitpid($pid, 0), 'nntpd exited successfully'); + $td->kill; + $td->join; is($?, 0, 'no error in exited process'); - $pid = undef; my $eout = eval { open my $fh, '<', $err or die "open $err failed: $!"; local $/; <$fh>; }; unlike($eout, qr/wide/i, 'no Wide character warnings'); - if (defined $tail_pid) { - kill 'TERM', $tail_pid; - waitpid($tail_pid, 0); - $tail_pid = undef; - } } done_testing(); + +sub get_capa { + my ($sock) = @_; + syswrite($sock, "CAPABILITIES\r\n"); + my $capa = ''; + do { + my $r = sysread($sock, $capa, 8192, length($capa)); + die "unexpected: $!" unless defined($r); + die 'unexpected EOF' if $r == 0; + } until $capa =~ /\.\r\n\z/; + + my $deflate_capa = qr/\r\nCOMPRESS DEFLATE\r\n/; + if ($need_zlib) { + unlike($capa, $deflate_capa, + 'COMPRESS DEFLATE NOT advertised '.$need_zlib); + } else { + like($capa, $deflate_capa, 'COMPRESS DEFLATE advertised'); + } + $capa; +} + 1;