# Copyright (C) 2019 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 $@; } 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/"; } use_ok 'PublicInbox::TLS'; use_ok 'IO::Socket::SSL'; require './t/common.perl'; require PublicInbox::InboxWritable; require PublicInbox::MIME; require PublicInbox::SearchIdx; 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 $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 <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; my $env = { PI_CONFIG => $pi_config }; for my $args ( [ "--cert=$cert", "--key=$key", "-lnntps://$nntps_addr", "-lnntp://$starttls_addr" ], ) { 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 %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)] }; # NNTPS my $c = Net::NNTP->new($nntps_addr, %o); my $list = $c->list; is_deeply($list, $expect, 'NNTPS LIST works'); # STARTTLS delete $o{SSL}; $c = Net::NNTP->new($starttls_addr, %o); $list = $c->list; is_deeply($list, $expect, 'plain LIST works'); ok($c->starttls, 'STARTTLS succeeds'); is($c->code, 382, 'got 382 for STARTTLS'); $list = $c->list; is_deeply($list, $expect, 'LIST works after STARTTLS'); # Net::NNTP won't let us do dumb things, but we need to test # dumb things, so use Net::Cmd directly: my $n = $c->command('STARTTLS')->response(); is($n, Net::Cmd::CMD_ERROR(), 'error attempting STARTTLS again'); is($c->code, 502, '502 according to RFC 4642 sec#2.2.1'); $c = undef; kill('TERM', $pid); is($pid, waitpid($pid, 0), 'nntpd exited successfully'); 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(); 1;