X-Git-Url: http://www.git.stargrave.org/?a=blobdiff_plain;f=t%2Fnntpd-tls.t;h=c97d179daf9d4fb13c4331b55e3b160342831cbb;hb=9689c65f42c0acc9021953b29ce55730c4cd841d;hp=82b63f3e443cee55820b614cf7442a94b4655600;hpb=3eb26fe04dae68612c841e749abd2848ce78ae59;p=public-inbox.git diff --git a/t/nntpd-tls.t b/t/nntpd-tls.t index 82b63f3e..c97d179d 100644 --- a/t/nntpd-tls.t +++ b/t/nntpd-tls.t @@ -3,51 +3,44 @@ use strict; use warnings; use Test::More; -use File::Temp qw(tempdir); use Socket qw(SOCK_STREAM IPPROTO_TCP SOL_SOCKET); +use PublicInbox::TestCommon; # 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'; +IO::Socket::SSL->VERSION(2.007) or + plan skip_all => 'IO::Socket::SSL <2.007 not supported by Net::NNTP'; 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 $inboxdir = "$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 $starttls = tcp_server(); my $nntps = tcp_server(); -my ($pid, $tail_pid); -END { - foreach ($pid, $tail_pid) { - kill 'TERM', $_ if defined $_; - } -}; - my $ibx = PublicInbox::Inbox->new({ - mainrepo => $mainrepo, + inboxdir => $inboxdir, name => 'nntpd-tls', version => $version, -primary_address => $addr, @@ -59,7 +52,7 @@ $ibx->init_inbox(0); open my $fh, '>', $pi_config or die "open: $!\n"; print $fh <sockhost . ':' . $nntps->sockport; my $starttls_addr = $starttls->sockhost . ':' . $starttls->sockport; my $env = { PI_CONFIG => $pi_config }; +my $td; for my $args ( [ "--cert=$cert", "--key=$key", @@ -95,14 +89,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', @@ -112,22 +100,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'); @@ -139,6 +130,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: @@ -149,6 +142,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'); @@ -180,7 +174,7 @@ for my $args ( 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; @@ -200,21 +194,36 @@ for my $args ( }; $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;