X-Git-Url: http://www.git.stargrave.org/?p=public-inbox.git;a=blobdiff_plain;f=t%2Fnntpd-tls.t;h=2a76867a290b44bebc67fbda817927e6eb452f16;hp=e3ecdd4fa0ecd4d83c4122b17ab31ff17a5e0afe;hb=4eee5af6011cc8cdefb66c9729952c7eff5c0b0b;hpb=8ef878ebc6f9f3a337341a3aa42a84fc190032a3 diff --git a/t/nntpd-tls.t b/t/nntpd-tls.t index e3ecdd4f..2a76867a 100644 --- a/t/nntpd-tls.t +++ b/t/nntpd-tls.t @@ -1,16 +1,13 @@ -# 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 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... -foreach my $mod (qw(DBD::SQLite IO::Socket::SSL Net::NNTP IO::Poll)) { - eval "require $mod"; - plan skip_all => "$mod missing for $0" if $@; -} +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'; @@ -18,81 +15,45 @@ 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", @@ -102,14 +63,8 @@ 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', @@ -119,22 +74,25 @@ for my $args ( my $expect = { $group => [qw(1 1 n)] }; # start negotiating a slow TLS connection - my $slow = IO::Socket::INET->new( - Proto => 'tcp', - PeerAddr => $nntps_addr, - Type => SOCK_STREAM, - Blocking => 0, - ); + my $slow = tcp_connect($nntps, Blocking => 0); $slow = IO::Socket::SSL->start_SSL($slow, SSL_startHandshake => 0, %o); my $slow_done = $slow->connect_SSL; - diag('W: connect_SSL early OK, slow client test invalid') if $slow_done; - my @poll = (fileno($slow), PublicInbox::TLS::epollbit()); + 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, 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'); @@ -146,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: @@ -156,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'); @@ -185,9 +146,18 @@ for my $args ( 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 = Socket::TCP_DEFER_ACCEPT(); + 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; @@ -199,29 +169,45 @@ for my $args ( skip 'accf_data not loaded? kldload accf_data', 2; } require PublicInbox::Daemon; - my $var = PublicInbox::Daemon::SO_ACCEPTFILTER(); - my $x = getsockopt($nntps, SOL_SOCKET, $var); + 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, $var); + $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;