diff options
Diffstat (limited to 't/nntpd.t')
| -rw-r--r-- | t/nntpd.t | 283 |
1 files changed, 197 insertions, 86 deletions
@@ -1,64 +1,34 @@ -# Copyright (C) 2015-2020 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 PublicInbox::TestCommon; -require_mods(qw(DBD::SQLite)); -require PublicInbox::SearchIdx; -require PublicInbox::Msgmap; -require PublicInbox::InboxWritable; -use Email::Simple; -use IO::Socket; +use strict; use v5.10.1; use PublicInbox::TestCommon; +require_mods(qw(DBD::SQLite Net::NNTP)); +use PublicInbox::Eml; use Socket qw(IPPROTO_TCP TCP_NODELAY); -use Net::NNTP; use Sys::Hostname; +use POSIX qw(_exit); +use PublicInbox::SHA; +use PublicInbox::DS; -# FIXME: make easier to test both versions -my $version = $ENV{PI_TEST_VERSION} || 2; +# t/nntpd-v2.t wraps this for v2 +my $version = $ENV{PI_TEST_VERSION} || 1; require_git('2.6') if $version == 2; +use_ok 'PublicInbox::Msgmap'; +my $fast_idle = eval { require PublicInbox::Inotify; 1 } // + eval { require IO::KQueue; 1 }; my ($tmpdir, $for_destroy) = tmpdir(); my $home = "$tmpdir/pi-home"; my $err = "$tmpdir/stderr.log"; my $out = "$tmpdir/stdout.log"; -my $inboxdir = "$tmpdir/main.git"; +my $inboxdir = "$tmpdir/inbox"; my $group = 'test-nntpd'; my $addr = $group . '@example.com'; -SKIP: { - skip "git 2.6+ required for V2Writable", 1 if $version == 1; - use_ok 'PublicInbox::V2Writable'; -} - -my %opts; my $sock = tcp_server(); +my $host_port = tcp_host_port($sock); my $td; -my $len; - -my $ibx = { - inboxdir => $inboxdir, - name => $group, - version => $version, - -primary_address => $addr, - indexlevel => 'basic', -}; -$ibx = PublicInbox::Inbox->new($ibx); -{ - local $ENV{HOME} = $home; - my @cmd = ('-init', $group, $inboxdir, 'http://example.com/', $addr); - push @cmd, "-V$version", '-Lbasic'; - ok(run_script(\@cmd), 'init OK'); - is(system(qw(git config), "--file=$home/.public-inbox/config", - "publicinbox.$group.newsgroup", $group), - 0, 'enabled newsgroup'); - my $len; - $ibx = PublicInbox::InboxWritable->new($ibx); - my $im = $ibx->importer; - - # ensure successful message delivery - { - my $mime = Email::MIME->new(<<EOF); +my $eml = PublicInbox::Eml->new(<<EOF); To: =?utf-8?Q?El=C3=A9anor?= <you\@example.com> From: =?utf-8?Q?El=C3=A9anor?= <me\@example.com> Cc: $addr @@ -71,28 +41,65 @@ References: <ref tab squeezed> This is a test message for El\xc3\xa9anor EOF - my $list_id = $addr; - $list_id =~ s/@/./; - $mime->header_set('List-Id', "<$list_id>"); - $len = length($mime->as_string); - $im->add($mime); - $im->done; - if ($version == 1) { - my $s = PublicInbox::SearchIdx->new($ibx, 1); - $s->index_sync; - } - } +my $list_id = $addr; +$list_id =~ s/@/./; +$eml->header_set('List-Id', "<$list_id>"); +my $str = $eml->as_string; +$str =~ s/(?<!\r)\n/\r\n/sg; +my $len = length($str); +undef $str; - ok($sock, 'sock created'); +my $ibx = create_inbox "v$version", version => $version, indexlevel => 'basic', + tmpdir => $inboxdir, sub { + my ($im, $ibx) = @_; + $im->add($eml) or BAIL_OUT; +}; +undef $eml; +my $other = create_inbox "other$version", version => $version, + indexlevel => 'basic', sub { + my ($im) = @_; + $im->add(eml_load 't/utf8.eml') or BAIL_OUT; +}; + +local $ENV{HOME} = $home; +mkdir $home or BAIL_OUT $!; +mkdir "$home/.public-inbox" or BAIL_OUT $!; +open my $cfgfh, '>', "$home/.public-inbox/config" or BAIL_OUT $!; +print $cfgfh <<EOF or BAIL_OUT; +[publicinbox "$group"] + inboxdir = $inboxdir + url = http://example.com/abc + address = $addr + indexlevel = basic + newsgroup = $group +[publicinbox "xyz"] + inboxdir = $other->{inboxdir} + url = http://example.com/xyz + address = e\@example.com + indexlevel = basic + newsgroup = x.y.z +[publicinboxMda] + spamcheck = none +EOF +close $cfgfh or BAIL_OUT; + +{ my $cmd = [ '-nntpd', '-W0', "--stdout=$out", "--stderr=$err" ]; $td = start_script($cmd, undef, { 3 => $sock }); - my $host_port = $sock->sockhost . ':' . $sock->sockport; my $n = Net::NNTP->new($host_port); my $list = $n->list; + ok(delete $list->{'x.y.z'}, 'deleted x.y.z group'); is_deeply($list, { $group => [ qw(1 1 n) ] }, 'LIST works'); is_deeply([$n->group($group)], [ qw(0 1 1), $group ], 'GROUP works'); is_deeply($n->listgroup($group), [1], 'listgroup OK'); # TODO: Net::NNTP::listgroup does not support range at the moment + my $s = tcp_connect($sock); + sysread($s, my $buf, 4096); + is($buf, "201 " . hostname . " ready - post via email\r\n", + 'got greeting'); + syswrite($s, "LISTGROUP $group 1-1\r\n"); + $buf = read_til_dot($s); + like($buf, qr/\r\n1\r\n/s, 'LISTGROUP with range works'); { my $expect = [ qw(Subject: From: Date: Message-ID: @@ -104,11 +111,6 @@ EOF $n->can('starttls') or skip('Net::NNTP too old to support STARTTLS', 2); require_mods('IO::Socket::SSL', 2); - eval { - IO::Socket::SSL->VERSION(2.007); - } or skip(<<EOF, 2); -IO::Socket::SSL <2.007 not supported by Net::NNTP -EOF ok(!$n->starttls, 'STARTTLS fails when unconfigured'); is($n->code, 580, 'got 580 code on server w/o TLS'); }; @@ -125,8 +127,8 @@ EOF 'references' => '<reftabsqueezed>', ); - my $s = tcp_connect($sock); - sysread($s, my $buf, 4096); + $s = tcp_connect($sock); + sysread($s, $buf, 4096); is($buf, "201 " . hostname . " ready - post via email\r\n", 'got greeting'); @@ -203,6 +205,7 @@ EOF is_deeply($n->head(1), $n->head('<nntp@example.com>'), 'HEAD OK'); is_deeply($n->body(1), $n->body('<nntp@example.com>'), 'BODY OK'); + is_deeply($n->nntpstat(1), '<nntp@example.com>', 'STAT'); is($n->body(1)->[0], "This is a test message for El\xc3\xa9anor\n", 'body really matches'); my $art = $n->article(1); @@ -232,7 +235,7 @@ EOF is_deeply($n->xhdr(qw(list-id 1-)), {}, 'XHDR on invalid header returns empty'); - my $mids = $n->newnews(0, '*'); + my $mids = $n->newnews(0, $group); is_deeply($mids, ['<nntp@example.com>'], 'NEWNEWS works'); { my $t0 = time; @@ -242,7 +245,7 @@ EOF ok($date <= $t1, 'valid date before stop'); } if ('leafnode interop') { - my $for_leafnode = PublicInbox::MIME->new(<<""); + my $for_leafnode = PublicInbox::Eml->new(<<""); From: longheader\@example.com To: $addr Subject: none @@ -250,12 +253,9 @@ Date: Fri, 02 Oct 1993 00:00:00 +0000 my $long_hdr = 'for-leafnode-'.('y'x200).'@example.com'; $for_leafnode->header_set('Message-ID', "<$long_hdr>"); + my $im = $ibx->importer(0); $im->add($for_leafnode); $im->done; - if ($version == 1) { - my $s = PublicInbox::SearchIdx->new($ibx, 1); - $s->index_sync; - } my $hdr = $n->head("<$long_hdr>"); my $expect = qr/\AMessage-ID: /i . qr/\Q<$long_hdr>\E/; ok(scalar(grep(/$expect/, @$hdr)), 'Message-ID not folded'); @@ -268,7 +268,7 @@ Date: Fri, 02 Oct 1993 00:00:00 +0000 $for_leafnode->header_set('Message-ID', @mids); $for_leafnode->body_set('not-a-dupe'); my $warn = ''; - $SIG{__WARN__} = sub { $warn .= join('', @_) }; + local $SIG{__WARN__} = sub { $warn .= join('', @_) }; $im->add($for_leafnode); $im->done; like($warn, qr/reused/, 'warned for reused MID'); @@ -279,42 +279,103 @@ Date: Fri, 02 Oct 1993 00:00:00 +0000 } } + ok($n->article('<testmessage@example.com>'), + 'cross newsgroup ARTICLE by Message-ID'); + ok($n->body('<testmessage@example.com>'), + 'cross newsgroup BODY by Message-ID'); + ok($n->head('<testmessage@example.com>'), + 'cross newsgroup HEAD by Message-ID'); + is($n->xpath('<testmessage@example.com>'), 'x.y.z/1', 'xpath hit'); + is($n->xpath('<non-existent@example.com>'), undef, 'xpath miss'); + # pipelined requests: { my $nreq = 90; + my $nart = 2; syswrite($s, "GROUP $group\r\n"); my $res = <$s>; my $rdr = fork; if ($rdr == 0) { - use POSIX qw(_exit); for (1..$nreq) { <$s> =~ /\A224 / or _exit(1); <$s> =~ /\A1/ or _exit(2); <$s> eq ".\r\n" or _exit(3); } + my %sums; + for (1..$nart) { + <$s> =~ /\A220 / or _exit(4); + my $dig = PublicInbox::SHA->new(1); + while (my $l = <$s>) { + last if $l eq ".\r\n"; + $dig->add($l); + } + $dig = $dig->hexdigest; + $sums{$dig}++; + } + if ($nart) { + scalar(keys(%sums)) == 1 or _exit(5); + (values(%sums))[0] == $nart or _exit(6); + } _exit(0); } for (1..$nreq) { syswrite($s, "XOVER 1\r\n"); } + syswrite($s, "ARTICLE 1\r\n" x $nart); is($rdr, waitpid($rdr, 0), 'reader done'); is($? >> 8, 0, 'no errors'); } + my $noerr = { 2 => \(my $null) }; SKIP: { - if ($INC{'Search/Xapian.pm'} && ($ENV{TEST_RUN_MODE}//1)) { - skip 'Search/Xapian.pm pre-loaded (by t/run.perl?)', 1; + if ($INC{'Search/Xapian.pm'} || $INC{'Xapian.pm'} && + ($ENV{TEST_RUN_MODE} // 2)) { + skip 'Xapian.pm pre-loaded (by xt/check-run.t?)', 1; } - my @of = `lsof -p $td->{pid} 2>/dev/null`; - skip('lsof broken', 1) if (!scalar(@of) || $?); - my @xap = grep m!Search/Xapian!, @of; - is_deeply(\@xap, [], 'Xapian not loaded in nntpd'); + my @of = lsof_pid $td->{pid}, $noerr; + my @xap = grep m!\bXapian\b!, @of; + is_deeply(\@xap, [], 'Xapian not loaded in nntpd') or + diag explain(\@of); } + # -compact requires Xapian + SKIP: { + require_mods('Xapian', 1); + have_xapian_compact 1; + is(xsys(qw(git config), "--file=$home/.public-inbox/config", + "publicinbox.$group.indexlevel", 'medium'), + 0, 'upgraded indexlevel'); + my $ex = eml_load('t/data/0001.patch'); + is($n->article($ex->header('Message-ID')), undef, + 'article did not exist'); + my $im = $ibx->importer(0); + $im->add($ex); + $im->done; + { + my $f = $ibx->mm->{dbh}->sqlite_db_filename; + my $tmp = "$tmpdir/tmp.sqlite3"; + $ibx->mm->{dbh}->sqlite_backup_to_file($tmp); + delete $ibx->{mm}; + rename($tmp, $f) or BAIL_OUT "rename($tmp, $f): $!"; + } + ok(run_script([qw(-index -c -j0 --reindex), $ibx->{inboxdir}], + undef, $noerr), '-compacted'); + tick($fast_idle ? 0.1 : 2.1); + $art = $n->article($ex->header('Message-ID')); + ok($art, 'new article retrieved after compact'); + $^O eq 'linux' or + skip "lsof /(deleted)/ check untested on $^O", 1; + my $fd = "/proc/$td->{pid}/fd"; + -d $fd or skip '/proc/PID/fd missing', 1; + my @of = map readlink, glob "$fd/*"; + my @d = grep /\(deleted\)/, grep !/batch-command\.err/, @of; + is_deeply(\@d, [], 'no deleted files') or diag explain(\@d); + }; + SKIP: { test_watch($tmpdir, $host_port, $group) }; { setsockopt($s, IPPROTO_TCP, TCP_NODELAY, 1); syswrite($s, 'HDR List-id 1-'); - select(undef, undef, undef, 0.15); + tick(0.15); ok($td->kill, 'killed nntpd'); - select(undef, undef, undef, 0.15); + tick(0.15); syswrite($s, "\r\n"); $buf = ''; do { @@ -325,15 +386,14 @@ Date: Fri, 02 Oct 1993 00:00:00 +0000 'got 5xx response for unoptimized HDR'); is(scalar @r, 1, 'only one response line'); } - $n = $s = undef; $td->join; - my $eout = eval { - local $/; + is($?, 0, 'no error in exited process'); + my $eout = do { open my $fh, '<', $err or die "open $err failed: $!"; + local $/; <$fh>; }; - is($?, 0, 'no error in exited process'); unlike($eout, qr/wide/i, 'no Wide character warnings'); } @@ -349,4 +409,55 @@ sub read_til_dot { $buf; } +sub test_watch { + my ($tmpdir, $host_port, $group) = @_; + use_ok 'PublicInbox::Watch'; + use_ok 'PublicInbox::InboxIdle'; + use_ok 'PublicInbox::Config'; + require_git('1.8.5', 4); + my $old_env = { HOME => $ENV{HOME} }; + my $home = "$tmpdir/watch_home"; + mkdir $home or BAIL_OUT $!; + mkdir "$home/.public-inbox" or BAIL_OUT $!; + local $ENV{HOME} = $home; + my $name = 'watchnntp'; + my $addr = "i1\@example.com"; + my $url = "http://example.com/i1"; + my $inboxdir = "$tmpdir/watchnntp"; + my $cmd = ['-init', '-V1', '-Lbasic', $name, $inboxdir, $url, $addr]; + my $nntpurl = "nntp://$host_port/$group"; + run_script($cmd) or BAIL_OUT("init $name"); + xsys(qw(git config), "--file=$home/.public-inbox/config", + "publicinbox.$name.watch", + $nntpurl) == 0 or BAIL_OUT "git config $?"; + # try again with polling + xsys(qw(git config), "--file=$home/.public-inbox/config", + 'nntp.PollInterval', 0.11) == 0 + or BAIL_OUT "git config $?"; + my $cfg = PublicInbox::Config->new; + PublicInbox::DS->Reset; + my $ii = PublicInbox::InboxIdle->new($cfg); + my $cb = sub { @PublicInbox::DS::post_loop_do = (sub {}) }; + my $obj = bless \$cb, 'PublicInbox::TestCommon::InboxWakeup'; + $cfg->each_inbox(sub { $_[0]->subscribe_unlock('ident', $obj) }); + my $watcherr = "$tmpdir/watcherr"; + open my $err_wr, '>', $watcherr or BAIL_OUT $!; + open my $err, '<', $watcherr or BAIL_OUT $!; + my $w = start_script(['-watch'], undef, { 2 => $err_wr }); + + diag 'waiting for initial fetch...'; + PublicInbox::DS::event_loop(); + diag 'inbox unlocked on initial fetch'; + $w->kill; + $w->join; + is($?, 0, 'no error in exited -watch process'); + $cfg->each_inbox(sub { shift->unsubscribe_unlock('ident') }); + $ii->close; + PublicInbox::DS->Reset; + my @err = grep(!/^(?:I:|#)/, <$err>); + is(@err, 0, 'no warnings/errors from -watch'.join(' ', @err)); + my @ls = xqx(['git', "--git-dir=$inboxdir", qw(ls-tree -r HEAD)]); + isnt(scalar(@ls), 0, 'imported something'); +} + 1; |