diff options
Diffstat (limited to 'xt')
-rw-r--r-- | xt/check-debris.t | 30 | ||||
-rwxr-xr-x | xt/check-run.t | 271 | ||||
-rw-r--r-- | xt/cmp-msgview.t | 94 | ||||
-rw-r--r-- | xt/create-many-inboxes.t | 2 | ||||
-rw-r--r-- | xt/eml_check_limits.t | 4 | ||||
-rw-r--r-- | xt/git-http-backend.t | 42 | ||||
-rw-r--r-- | xt/git_async_cmp.t | 14 | ||||
-rw-r--r-- | xt/httpd-async-stream.t | 80 | ||||
-rw-r--r-- | xt/imapd-mbsync-oimap.t | 15 | ||||
-rw-r--r-- | xt/imapd-validate.t | 5 | ||||
-rw-r--r-- | xt/lei-auth-fail.t | 7 | ||||
-rw-r--r-- | xt/lei-onion-convert.t | 21 | ||||
-rw-r--r-- | xt/mem-imapd-tls.t | 36 | ||||
-rw-r--r-- | xt/mem-nntpd-tls.t | 254 | ||||
-rw-r--r-- | xt/msgtime_cmp.t | 2 | ||||
-rw-r--r-- | xt/net_writer-imap.t | 8 | ||||
-rw-r--r-- | xt/nntpd-validate.t | 5 | ||||
-rw-r--r-- | xt/perf-msgview.t | 30 | ||||
-rw-r--r-- | xt/perf-obfuscate.t | 64 | ||||
-rw-r--r-- | xt/pop3d-mpop.t | 76 | ||||
-rw-r--r-- | xt/solver.t | 66 |
21 files changed, 826 insertions, 300 deletions
diff --git a/xt/check-debris.t b/xt/check-debris.t new file mode 100644 index 00000000..0bb5091d --- /dev/null +++ b/xt/check-debris.t @@ -0,0 +1,30 @@ +#!perl -w +use v5.12; +use autodie qw(open); +use PublicInbox::TestCommon; +use File::Spec; +my $tmpdir = File::Spec->tmpdir; + +diag "note: writes to `$tmpdir' by others results in false-positives"; + +my %cur = map { $_ => 1 } glob("$tmpdir/*"); +for my $t (@ARGV ? @ARGV : glob('t/*.t')) { + open my $fh, '-|', $^X, '-w', $t; + my @out; + while (<$fh>) { + chomp; + push @out, $_; + next if /^ok / || /\A[0-9]+\.\.[0-9]+\z/; + diag $_; + } + ok(close($fh), $t) or diag(explain(\@out)); + + no_coredump($tmpdir); + + my @remain = grep { !$cur{$_}++ } glob("$tmpdir/*"); + next if !@remain; + is_deeply(\@remain, [], "$t has no leftovers") or + diag "$t added: ",explain(\@remain); +} + +done_testing; diff --git a/xt/check-run.t b/xt/check-run.t new file mode 100755 index 00000000..d12b925d --- /dev/null +++ b/xt/check-run.t @@ -0,0 +1,271 @@ +#!/usr/bin/perl -w +# Copyright (C) all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +# +# Parallel test runner which preloads code and reuses worker processes +# to give a nice speedup over prove(1). It also generates per-test +# .log files (similar to automake tests). +# +# *.t files run by this should not rely on global state. +# +# Usage: $PERL -I lib -w xt/check-run.t -j4 +# Or via prove(1): prove -lvw xt/check-run.t :: -j4 +use v5.12; +use IO::Handle; # ->autoflush +use PublicInbox::TestCommon; +use PublicInbox::Spawn; +use PublicInbox::DS; # already loaded by Spawn via PublicInbox::IO +use Getopt::Long qw(:config gnu_getopt no_ignore_case auto_abbrev); +use Errno qw(EINTR); +use Fcntl qw(:seek); +use POSIX qw(WNOHANG); +use File::Temp (); +my $jobs = 1; +my $repeat = 1; +$| = 1; +our $log_suffix = '.log'; +my ($shuffle, %pids, @err); +GetOptions('j|jobs=i' => \$jobs, + 'repeat=i' => \$repeat, + 'log=s' => \$log_suffix, + 's|shuffle' => \$shuffle, +) or die "Usage: $0 [-j JOBS] [--log=SUFFIX] [--repeat RUNS]"; +if (($ENV{TEST_RUN_MODE} // 2) == 0) { + die "$0 is not compatible with TEST_RUN_MODE=0\n"; +} +my @tests = scalar(@ARGV) ? @ARGV : glob('t/*.t'); +open my $cwd_fh, '<', '.' or die "open .: $!"; +open my $OLDOUT, '>&STDOUT' or die "dup STDOUT: $!"; +open my $OLDERR, '>&STDERR' or die "dup STDERR: $!"; +$OLDOUT->autoflush(1); +$OLDERR->autoflush(1); + +my ($run_log, $tmp_rl); +my $rl = $ENV{TEST_RUN_LOG}; +unless ($rl) { + $tmp_rl = File::Temp->new(CLEANUP => 1); + $rl = $tmp_rl->filename; +} +open $run_log, '+>>', $rl or die "open $rl: $!"; +$run_log->autoflush(1); # one reader, many writers + +key2sub($_) for @tests; # precache + +my ($for_destroy, $lei_env, $lei_daemon_pid, $owner_pid); + +# TEST_LEI_DAEMON_PERSIST is currently broken. I get ECONNRESET from +# lei even with high kern.ipc.soacceptqueue=1073741823 or SOMAXCONN, not +# sure why. Also, testing our internal inotify usage is unreliable +# because lei-daemon uses a single inotify FD for all clients. +if ($ENV{TEST_LEI_DAEMON_PERSIST} && !$ENV{TEST_LEI_DAEMON_PERSIST_DIR} && + (PublicInbox::Spawn->can('recv_cmd4') || + eval { require Socket::MsgHdr })) { + $lei_env = {}; + ($lei_env->{XDG_RUNTIME_DIR}, $for_destroy) = tmpdir; + $ENV{TEST_LEI_DAEMON_PERSIST_DIR} = $lei_env->{XDG_RUNTIME_DIR}; + run_script([qw(lei daemon-pid)], $lei_env, { 1 => \$lei_daemon_pid }); + chomp $lei_daemon_pid; + $lei_daemon_pid =~ /\A[0-9]+\z/ or die "no daemon pid: $lei_daemon_pid"; + kill(0, $lei_daemon_pid) or die "kill $lei_daemon_pid: $!"; + if (my $t = $ENV{GNU_TAIL}) { + system("$t --pid=$lei_daemon_pid -F " . + "$lei_env->{XDG_RUNTIME_DIR}/lei/errors.log >&2 &"); + } + if (my $strace_cmd = $ENV{STRACE_CMD}) { + system("$strace_cmd -p $lei_daemon_pid &"); + } + $owner_pid = $$; +} + +if ($shuffle) { + require List::Util; +} elsif (open(my $prove_state, '<', '.prove') && eval { require YAML::XS }) { + # reuse "prove --state=save" data to start slowest tests, first + my $state = YAML::XS::Load(do { local $/; <$prove_state> }); + my $t = $state->{tests}; + @tests = sort { + ($t->{$b}->{elapsed} // 0) <=> ($t->{$a}->{elapsed} // 0) + } @tests; + if (scalar(@tests) > 1) { + my $end = $#tests > 9 ? 9 : $#tests; + my $nr = $end + 1; + say "# top $nr longest tests (`make check' regenerates)"; + for (grep defined, @tests[0..$end]) { + printf "# %0.6f %s\n", $t->{$_}->{elapsed}, $_; + } + } +} + +our $tb = Test::More->builder; + +sub DIE (;$) { + print $OLDERR @_; + exit(1); +} + +our ($worker, $worker_test); + +sub test_status () { + $? = 255 if $? == 0 && !$tb->is_passing; + my $status = $? ? 'not ok' : 'ok'; + chdir($cwd_fh) or DIE "fchdir: $!"; + if ($log_suffix ne '') { + my $log = $worker_test; + $log =~ s/\.t\z/$log_suffix/; + my $skip = ''; + if (open my $fh, '<', $log) { + my @not_ok = grep(!/^(?:ok |[ \t]*#)/ms, <$fh>); + my $last = $not_ok[-1] // ''; + pop @not_ok if $last =~ /^[0-9]+\.\.[0-9]+$/; + my $pfx = "# $log: "; + print $OLDERR map { $pfx.$_ } @not_ok; + seek($fh, 0, SEEK_SET) or die "seek: $!"; + + # show unique skip texts and the number of times + # each text was skipped + local $/; + my @sk = (<$fh> =~ m/^ok [0-9]+ (# skip [^\n]+)/mgs); + if (@sk) { + my %nr; + my @err = grep { !$nr{$_}++ } @sk; + print $OLDERR "$pfx$_ ($nr{$_})\n" for @err; + $skip = ' # total skipped: '.scalar(@sk); + } + } else { + print $OLDERR "could not open: $log: $!\n"; + } + print $OLDOUT "$status $worker_test$skip\n"; + } +} + +# Test::Builder or Test2::Hub may call exit() from plan(skip_all => ...) +END { test_status() if (defined($worker_test) && $worker == $$) } + +sub run_test ($) { + my ($test) = @_; + syswrite($run_log, "$$ $test\n"); + my $log_fh; + if ($log_suffix ne '') { + my $log = $test; + $log =~ s/\.[^\.]+\z/$log_suffix/ or DIE "can't log for $test"; + open $log_fh, '>', $log or DIE "open $log: $!"; + $log_fh->autoflush(1); + $tb->output($log_fh); + $tb->failure_output($log_fh); + $tb->todo_output($log_fh); + open STDOUT, '>&', $log_fh or DIE "1>$log: $!"; + open STDERR, '>&', $log_fh or DIE "2>$log: $!"; + } + $worker_test = $test; + run_script([$test]); + test_status(); + $worker_test = undef; + push @err, "$test ($?)" if $?; +} + +sub UINT_SIZE () { 4 } + +# worker processes will SIGUSR1 the producer process when it +# sees EOF on the pipe. On FreeBSD 11.2 and Perl 5.30.0, +# sys/ioctl.ph gives the wrong value for FIONREAD(). +my $producer = $$; +my $eof; # we stop respawning if true + +my $start_worker = sub { + my ($j, $rd, $wr, $todo) = @_; + my $pid = fork // DIE "fork: $!"; + if ($pid == 0) { + close $wr; + $SIG{USR1} = undef; # undo parent $SIG{USR1} + $worker = $$; + while (1) { + my $r = sysread($rd, my $buf, UINT_SIZE); + if (!defined($r)) { + next if $! == EINTR; + DIE "sysread: $!"; + } + last if $r == 0; + DIE "short read $r" if $r != UINT_SIZE; + my $t = unpack('I', $buf); + run_test($todo->[$t]); + PublicInbox::DS->Reset; + $tb->reset; + } + kill 'USR1', $producer if !$eof; # sets $eof in $producer + if (@err) { # write to run_log for $sigchld handler + syswrite($run_log, "$$ @err\n"); + DIE join('', map { "E: $_\n" } @err); + } + exit(0); + } else { + $pids{$pid} = $j; + } +}; + +# negative $repeat means loop forever: +for (my $i = $repeat; $i != 0; $i--) { + my @todo = $shuffle ? List::Util::shuffle(@tests) : @tests; + + # single-producer, multi-consumer queue relying on POSIX pipe semantics + # POSIX.1-2008 stipulates a regular file should work, but Linux <3.14 + # had broken read(2) semantics according to the read(2) manpage + pipe(my ($rd, $wr)) or DIE "pipe: $!"; + + # fill the queue before forking so children can start earlier + $wr->autoflush(1); + $wr->blocking(0); + my $todo_buf = pack('I*', 0..$#todo); + my $woff = syswrite($wr, $todo_buf) // DIE "syswrite: $!"; + substr($todo_buf, 0, $woff, ''); + $eof = undef; + local $SIG{USR1} = sub { $eof = 1 }; + my $sigchld = sub { + my ($sig) = @_; + my $flags = $sig ? WNOHANG : 0; + while (1) { + my $pid = waitpid(-1, $flags) or return; + return if $pid < 0; + my $j = delete $pids{$pid}; + if (!defined($j)) { + push @err, "reaped unknown $pid ($?)"; + next; + } + if ($?) { + seek($run_log, 0, SEEK_SET); + chomp(my @t = grep(/^$pid /, <$run_log>)); + $t[0] //= "$pid unknown"; + push @err, "job[$j] ($?) PID=$t[-1]"; + } + # skip_all can exit(0), respawn if needed: + if (!$eof) { + print $OLDERR "# respawning job[$j]\n"; + $start_worker->($j, $rd, $wr, \@todo); + } + } + }; + + # start the workers to consume the queue + for (my $j = 0; $j < $jobs; $j++) { + $start_worker->($j, $rd, $wr, \@todo); + } + { + local $SIG{CHLD} = $sigchld; + # too many tests to fit in the pipe before starting workers, + # send the rest now the workers are running + $wr->blocking(1); + print $wr $todo_buf or DIE; + close $wr; + } + + $sigchld->(0) while scalar(keys(%pids)); + DIE join('', map { "E: $_\n" } @err) if @err; +} + +print $OLDOUT "1..".($repeat * scalar(@tests))."\n" if $repeat >= 0; +if ($lei_env && $$ == $owner_pid) { + my $opt = { 1 => $OLDOUT, 2 => $OLDERR }; + my $cur_daemon_pid; + run_script([qw(lei daemon-pid)], $lei_env, { 1 => \$cur_daemon_pid }); + run_script([qw(lei daemon-kill)], $lei_env, $opt); + DIE "lei daemon restarted\n" if $cur_daemon_pid != $lei_daemon_pid; +} diff --git a/xt/cmp-msgview.t b/xt/cmp-msgview.t deleted file mode 100644 index 9b06f88d..00000000 --- a/xt/cmp-msgview.t +++ /dev/null @@ -1,94 +0,0 @@ -#!perl -w -# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> -# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; -use Test::More; -use Benchmark qw(:all); -use PublicInbox::Inbox; -use PublicInbox::View; -use PublicInbox::TestCommon; -use PublicInbox::Eml; -use Digest::MD5; -require_git(2.19); -require_mods qw(Data::Dumper Email::MIME Plack::Util); -Data::Dumper->import('Dumper'); -require PublicInbox::MIME; -my ($tmpdir, $for_destroy) = tmpdir(); -my $inboxdir = $ENV{GIANT_INBOX_DIR}; -plan skip_all => "GIANT_INBOX_DIR not defined for $0" unless $inboxdir; -my @cat = qw(cat-file --buffer --batch-check --batch-all-objects --unordered); -my $ibx = PublicInbox::Inbox->new({ inboxdir => $inboxdir, name => 'perf' }); -my $git = $ibx->git; -my $fh = $git->popen(@cat); -vec(my $vec = '', fileno($fh), 1) = 1; -select($vec, undef, undef, 60) or die "timed out waiting for --batch-check"; -my $mime_ctx = { - env => { HTTP_HOST => 'example.com', 'psgi.url_scheme' => 'https' }, - ibx => $ibx, - www => Plack::Util::inline_object(style => sub {''}), - obuf => \(my $mime_buf = ''), - mhref => '../', -}; -my $eml_ctx = { %$mime_ctx, obuf => \(my $eml_buf = '') }; -my $n = 0; -my $m = 0; -my $ndiff_html = 0; -my $dig_cls = 'Digest::MD5'; -my $digest_attach = sub { # ensure ->body (not ->body_raw) matches - my ($p, $cmp_arg) = @_; - my $part = shift @$p; - my $dig = $cmp_arg->[0] //= $dig_cls->new; - $dig->add($part->body_raw); - push @$cmp_arg, join(', ', @$p); -}; - -my $git_cb = sub { - my ($bref, $oid) = @_; - local $SIG{__WARN__} = sub { diag "$inboxdir $oid ", @_ }; - ++$m; - my $mime = PublicInbox::MIME->new($$bref); - PublicInbox::View::multipart_text_as_html($mime, $mime_ctx); - my $eml = PublicInbox::Eml->new($$bref); - PublicInbox::View::multipart_text_as_html($eml, $eml_ctx); - if ($eml_buf ne $mime_buf) { - ++$ndiff_html; - open my $fh, '>', "$tmpdir/mime" or die $!; - print $fh $mime_buf or die $!; - close $fh or die $!; - open $fh, '>', "$tmpdir/eml" or die $!; - print $fh $eml_buf or die $!; - close $fh or die $!; - # using `git diff', diff(1) may not be installed - diag "$inboxdir $oid differs"; - diag xqx([qw(git diff), "$tmpdir/mime", "$tmpdir/eml"]); - } - $eml_buf = $mime_buf = ''; - - # don't tolerate differences in attachment downloads - $mime = PublicInbox::MIME->new($$bref); - $mime->each_part($digest_attach, my $mime_cmp = [], 1); - $eml = PublicInbox::Eml->new($$bref); - $eml->each_part($digest_attach, my $eml_cmp = [], 1); - $mime_cmp->[0] = $mime_cmp->[0]->hexdigest; - $eml_cmp->[0] = $eml_cmp->[0]->hexdigest; - # don't have millions of "ok" lines - if (join("\0", @$eml_cmp) ne join("\0", @$mime_cmp)) { - diag Dumper([ $oid, eml => $eml_cmp, mime =>$mime_cmp ]); - is_deeply($eml_cmp, $mime_cmp, "$inboxdir $oid match"); - } -}; -my $t = timeit(1, sub { - while (<$fh>) { - my ($oid, $type) = split / /; - next if $type ne 'blob'; - ++$n; - $git->cat_async($oid, $git_cb); - } - $git->async_wait_all; -}); -is($m, $n, 'rendered all messages'); - -# we'll tolerate minor differences in HTML rendering -diag "$ndiff_html HTML differences"; - -done_testing(); diff --git a/xt/create-many-inboxes.t b/xt/create-many-inboxes.t index d22803e3..3d8932b7 100644 --- a/xt/create-many-inboxes.t +++ b/xt/create-many-inboxes.t @@ -19,7 +19,7 @@ mkpath($many_root); $many_root = abs_path($many_root); $many_root =~ m!\A\Q$cwd\E/! and BAIL_OUT "$many_root must not be in $cwd"; require_git 2.6; -require_mods(qw(DBD::SQLite Search::Xapian)); +require_mods(qw(DBD::SQLite Xapian)); use_ok 'PublicInbox::V2Writable'; my $nr_inbox = $ENV{NR_INBOX} // 10; my $nproc = $ENV{NPROC} || PublicInbox::IPC::detect_nproc() || 2; diff --git a/xt/eml_check_limits.t b/xt/eml_check_limits.t index a6d010af..1f89c6d4 100644 --- a/xt/eml_check_limits.t +++ b/xt/eml_check_limits.t @@ -1,15 +1,13 @@ #!perl -w -# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use v5.10.1; -use Test::More; use PublicInbox::TestCommon; use PublicInbox::Eml; use PublicInbox::Inbox; use List::Util qw(max); use Benchmark qw(:all :hireswallclock); -use PublicInbox::Spawn qw(popen_rd); use Carp (); require_git(2.19); # for --unordered require_mods(qw(BSD::Resource)); diff --git a/xt/git-http-backend.t b/xt/git-http-backend.t index adadebb0..6c384faf 100644 --- a/xt/git-http-backend.t +++ b/xt/git-http-backend.t @@ -1,19 +1,18 @@ -# Copyright (C) 2016-2021 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> # # Ensure buffering behavior in -httpd doesn't cause runaway memory use # or data corruption use strict; -use warnings; -use Test::More; +use v5.10.1; use POSIX qw(setsid); use PublicInbox::TestCommon; -use PublicInbox::Spawn qw(which); my $git_dir = $ENV{GIANT_GIT_DIR}; plan 'skip_all' => 'GIANT_GIT_DIR not defined' unless $git_dir; require_mods(qw(BSD::Resource Plack::Util Plack::Builder - HTTP::Date HTTP::Status Net::HTTP)); + HTTP::Date HTTP::Status HTTP::Tiny)); my $psgi = "./t/git-http-backend.psgi"; my ($tmpdir, $for_destroy) = tmpdir(); my $err = "$tmpdir/stderr.log"; @@ -21,15 +20,12 @@ my $out = "$tmpdir/stdout.log"; my $sock = tcp_server(); my ($host, $port) = tcp_host_port($sock); my $td; +my $http = HTTP::Tiny->new; my $get_maxrss = sub { - my $http = Net::HTTP->new(Host => "$host:$port"); - ok($http, 'Net::HTTP object created for maxrss'); - $http->write_request(GET => '/'); - my ($code, $mess, %h) = $http->read_response_headers; - is($code, 200, 'success reading maxrss'); - my $n = $http->read_entity_body(my $buf, 256); - ok(defined $n, 'read response body'); + my $res = $http->get("http://$host:$port/"); + is($res->{status}, 200, 'success reading maxrss'); + my $buf = $res->{content}; like($buf, qr/\A\d+\n\z/, 'got memory response'); ok(int($buf) > 0, 'got non-zero memory response'); int($buf); @@ -53,19 +49,18 @@ SKIP: { } } skip "no packs found in $git_dir" unless defined $pack; - if ($pack !~ m!(/objects/pack/pack-[a-f0-9]{40}.pack)\z!) { + if ($pack !~ m!(/objects/pack/pack-[a-f0-9]{40,64}.pack)\z!) { skip "bad pack name: $pack"; } - my $url = $1; - my $http = Net::HTTP->new(Host => "$host:$port"); - ok($http, 'Net::HTTP object created'); - $http->write_request(GET => $url); - my ($code, $mess, %h) = $http->read_response_headers; - is(200, $code, 'got 200 success for pack'); - is($max, $h{'Content-Length'}, 'got expected Content-Length for pack'); + my $s = tcp_connect($sock); + print $s "GET $1 HTTP/1.1\r\nHost: $host:$port\r\n\r\n" or xbail $!; + my $hdr = do { local $/ = "\r\n\r\n"; readline($s) }; + like $hdr, qr!\AHTTP/1\.1\s+200\b!, 'got 200 success for pack'; + like $hdr, qr/^content-length:\s*$max\r\n/ims, + 'got expected Content-Length for pack'; - # no $http->read_entity_body, here, since we want to force buffering - foreach my $i (1..3) { + # don't read the body + for my $i (1..3) { sleep 1; my $diff = $get_maxrss->() - $mem_a; note "${diff}K memory increase after $i seconds"; @@ -77,8 +72,7 @@ SKIP: { # make sure Last-Modified + If-Modified-Since works with curl my $nr = 6; skip 'no description', $nr unless -f "$git_dir/description"; my $mtime = (stat(_))[9]; - my $curl = which('curl'); - skip 'curl(1) not found', $nr unless $curl; + my $curl = require_cmd('curl', 1) or skip 'curl(1) not found', $nr; my $url = "http://$host:$port/description"; my $dst = "$tmpdir/desc"; is(xsys($curl, qw(-RsSf), '-o', $dst, $url), 0, 'curl -R'); diff --git a/xt/git_async_cmp.t b/xt/git_async_cmp.t index d66b371f..4038898b 100644 --- a/xt/git_async_cmp.t +++ b/xt/git_async_cmp.t @@ -1,10 +1,10 @@ #!perl -w -# Copyright (C) 2019-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use Test::More; use Benchmark qw(:all); -use Digest::SHA; +use PublicInbox::SHA; use PublicInbox::TestCommon; my $git_dir = $ENV{GIANT_GIT_DIR}; plan 'skip_all' => "GIANT_GIT_DIR not defined for $0" unless defined($git_dir); @@ -20,7 +20,7 @@ my @dig; my $nr = $ENV{NR} || 1; diag "NR=$nr"; my $async = timeit($nr, sub { - my $dig = Digest::SHA->new(1); + my $dig = PublicInbox::SHA->new(1); my $cb = sub { my ($bref) = @_; $dig->add($$bref); @@ -31,27 +31,27 @@ my $async = timeit($nr, sub { my ($oid, undef, undef) = split(/ /); $git->cat_async($oid, $cb); } - close $cat or die "cat: $?"; + $cat->close or xbail "cat: $?"; $git->async_wait_all; push @dig, ['async', $dig->hexdigest ]; }); my $sync = timeit($nr, sub { - my $dig = Digest::SHA->new(1); + my $dig = PublicInbox::SHA->new(1); my $cat = $git->popen(@cat); while (<$cat>) { my ($oid, undef, undef) = split(/ /); my $bref = $git->cat_file($oid); $dig->add($$bref); } - close $cat or die "cat: $?"; + $cat->close or xbail "cat: $?"; push @dig, ['sync', $dig->hexdigest ]; }); ok(scalar(@dig) >= 2, 'got some digests'); my $ref = shift @dig; my $exp = $ref->[1]; -isnt($exp, Digest::SHA->new(1)->hexdigest, 'not empty'); +isnt($exp, PublicInbox::SHA->new(1)->hexdigest, 'not empty'); foreach (@dig) { is($_->[1], $exp, "digest matches $_->[0] <=> $ref->[0]"); } diff --git a/xt/httpd-async-stream.t b/xt/httpd-async-stream.t index c7039f3e..21d09331 100644 --- a/xt/httpd-async-stream.t +++ b/xt/httpd-async-stream.t @@ -1,17 +1,19 @@ #!perl -w -# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> # Expensive test to validate compression and TLS. -use strict; -use Test::More; +use v5.12; +use autodie; +use PublicInbox::IO qw(write_file); +use IO::Uncompress::Gunzip qw(gunzip $GunzipError); use PublicInbox::TestCommon; use PublicInbox::DS qw(now); -use PublicInbox::Spawn qw(which popen_rd); +use PublicInbox::Spawn qw(popen_rd); use Digest::MD5; use POSIX qw(_exit); my $inboxdir = $ENV{GIANT_INBOX_DIR}; plan skip_all => "GIANT_INBOX_DIR not defined for $0" unless $inboxdir; -my $curl = which('curl') or plan skip_all => "curl(1) missing for $0"; +my $curl = require_cmd('curl'); my ($tmpdir, $for_destroy) = tmpdir(); require_mods(qw(DBD::SQLite)); my $JOBS = $ENV{TEST_JOBS} // 4; @@ -23,20 +25,15 @@ diag "TEST_JOBS=$JOBS TEST_ENDPOINT=$endpoint TEST_CURL_OPT=$curl_opt"; my @CURL_OPT = (qw(-HHost:example.com -sSf), split(' ', $curl_opt)); my $make_local_server = sub { + my ($http) = @_; my $pi_config = "$tmpdir/config"; - open my $fh, '>', $pi_config or die "open($pi_config): $!"; - print $fh <<"" or die "print $pi_config: $!"; + write_file '>', $pi_config, <<""; [publicinbox "test"] inboxdir = $inboxdir address = test\@example.com - close $fh or die "close($pi_config): $!"; my ($out, $err) = ("$tmpdir/out", "$tmpdir/err"); - for ($out, $err) { - open my $fh, '>', $_ or die "truncate: $!"; - } - my $http = tcp_server(); - my $rdr = { 3 => $http }; + for ($out, $err) { open my $fh, '>', $_ } # not using multiple workers, here, since we want to increase # the chance of tripping concurrency bugs within PublicInbox/HTTP*.pm @@ -46,10 +43,22 @@ address = test\@example.com my $url = "$host_port/test/$endpoint"; print STDERR "# CMD ". join(' ', @$cmd). "\n"; my $env = { PI_CONFIG => $pi_config }; - (start_script($cmd, $env, $rdr), $url); + (start_script($cmd, $env, { 3 => $http }), $url) }; -my ($td, $url) = $make_local_server->(); +my ($td, $url) = $make_local_server->(my $http = tcp_server()); + +my $s1 = tcp_connect($http); +my $rbuf = do { # pipeline while reading long response + my $req = <<EOM; +GET /test/$endpoint HTTP/1.1\r +Host: example.com\r +\r +EOM + is syswrite($s1, $req), length($req), 'initial long req'; + <$s1>; +}; +like $rbuf, qr!\AHTTP/1\.1 200\b!, 'started reading 200 response'; my $do_get_all = sub { my ($job) = @_; @@ -58,7 +67,7 @@ my $do_get_all = sub { my ($buf, $nr); my $bytes = 0; my $t0 = now(); - my ($rd, $pid) = popen_rd([$curl, @CURL_OPT, $url]); + my $rd = popen_rd([$curl, @CURL_OPT, $url]); while (1) { $nr = sysread($rd, $buf, 65536); last if !$nr; @@ -67,25 +76,23 @@ my $do_get_all = sub { } my $res = $dig->hexdigest; my $elapsed = sprintf('%0.3f', now() - $t0); - close $rd or die "close curl failed: $!\n"; - waitpid($pid, 0) == $pid or die "waitpid failed: $!\n"; - $? == 0 or die "curl failed: $?\n"; + $rd->close or xbail "close curl failed: $! \$?=$?\n"; print STDERR "# $job $$ ($?) $res (${elapsed}s) $bytes bytes\n"; $res; }; my (%pids, %res); for my $job (1..$JOBS) { - pipe(my ($r, $w)) or die; + pipe(my $r, my $w); my $pid = fork; if ($pid == 0) { - close $r or die; + close $r; my $res = $do_get_all->($job); - print $w $res or die; - close $w or die; + print $w $res; + close $w; _exit(0); } - close $w or die; + close $w; $pids{$pid} = [ $job, $r ]; } @@ -98,6 +105,31 @@ while (scalar keys %pids) { push @{$res{$sum}}, $job; } is(scalar keys %res, 1, 'all got the same result'); +{ + my $req = <<EOM; +GET /test/manifest.js.gz HTTP/1.1\r +Host: example.com\r +Connection: close\r +\r +EOM + is syswrite($s1, $req), length($req), + 'pipeline another request while reading long response'; + diag 'reading remainder of slow response'; + my $res = do { local $/ = "\r\n\r\n"; <$s1> }; + like $res, qr/^Transfer-Encoding: chunked\r\n/sm, 'chunked response'; + { + local $/ = "\r\n"; # get to final chunk + while (defined(my $l = <$s1>)) { last if $l eq "0\r\n" } + }; + is scalar(readline($s1)), "\r\n", 'got final CRLF from 1st response'; + diag "second response:"; + $res = do { local $/ = "\r\n\r\n"; <$s1> }; + like $res, qr!\AHTTP/1\.1 200 !, 'response for pipelined req'; + gunzip($s1 => \my $json) or xbail "gunzip $GunzipError"; + my $m = PublicInbox::Config::json()->decode($json); + like $m->{'/test'}->{fingerprint}, qr/\A[0-9a-f]{40,}\z/, + 'acceptable fingerprint in response'; +} $td->kill; $td->join; is($?, 0, 'no error on -httpd exit'); diff --git a/xt/imapd-mbsync-oimap.t b/xt/imapd-mbsync-oimap.t index 0baf5b4c..f99779a1 100644 --- a/xt/imapd-mbsync-oimap.t +++ b/xt/imapd-mbsync-oimap.t @@ -1,12 +1,12 @@ #!perl -w -# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> # ensure mbsync and offlineimap compatibility use strict; use v5.10.1; -use File::Path qw(mkpath); +use File::Path qw(make_path); use PublicInbox::TestCommon; -use PublicInbox::Spawn qw(which spawn); +use PublicInbox::Spawn qw(spawn); require_mods(qw(-imapd)); my $inboxdir = $ENV{GIANT_INBOX_DIR}; (defined($inboxdir) && -d $inboxdir) or @@ -41,8 +41,9 @@ my ($host, $port) = ($sock->sockhost, $sock->sockport); my %pids; SKIP: { - mkpath([map { "$tmpdir/oimapdir/$_" } qw(cur new tmp)]); - my $oimap = which('offlineimap') or skip 'no offlineimap(1)', 1; + make_path(map { "$tmpdir/oimapdir/$_" } qw(cur new tmp)); + my $oimap = require_cmd('offlineimap', 1) or + skip 'no offlineimap(1)', 1; open my $fh, '>', "$tmpdir/.offlineimaprc" or BAIL_OUT "open: $!"; print $fh <<EOF or BAIL_OUT "print: $!"; [general] @@ -77,8 +78,8 @@ EOF } SKIP: { - mkpath([map { "$tmpdir/mbsyncdir/test/$_" } qw(cur new tmp)]); - my $mbsync = which('mbsync') or skip 'no mbsync(1)', 1; + make_path(map { "$tmpdir/mbsyncdir/test/$_" } qw(cur new tmp)); + my $mbsync = require_cmd('mbsync', 1) or skip 'no mbsync(1)', 1; open my $fh, '>', "$tmpdir/.mbsyncrc" or BAIL_OUT "open: $!"; print $fh <<EOF or BAIL_OUT "print: $!"; Create Slave diff --git a/xt/imapd-validate.t b/xt/imapd-validate.t index 5d27d2a0..5d665fa9 100644 --- a/xt/imapd-validate.t +++ b/xt/imapd-validate.t @@ -1,11 +1,12 @@ #!perl -w -# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> # Expensive test to validate compression and TLS. use strict; use v5.10.1; use Symbol qw(gensym); use PublicInbox::DS qw(now); +use PublicInbox::SHA; use POSIX qw(_exit); use PublicInbox::TestCommon; my $inbox_dir = $ENV{GIANT_INBOX_DIR}; @@ -64,7 +65,7 @@ my $do_get_all = sub { my ($desc, $opt) = @_; local $SIG{__DIE__} = sub { print STDERR $desc, ': ', @_; _exit(1) }; my $t0 = now(); - my $dig = Digest::SHA->new(1); + my $dig = PublicInbox::SHA->new(1); my $mic = $imap_client->new(%$opt); $mic->examine($mailbox) or die "examine: $!"; my $uid_base = 1; diff --git a/xt/lei-auth-fail.t b/xt/lei-auth-fail.t index 06cb8533..1ccc2ab2 100644 --- a/xt/lei-auth-fail.t +++ b/xt/lei-auth-fail.t @@ -1,7 +1,8 @@ #!perl -w -# Copyright (C) 2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; use v5.10.1; use PublicInbox::TestCommon; +use v5.12; +use PublicInbox::TestCommon; require_mods(qw(Mail::IMAPClient lei)); # TODO: mock IMAP server which fails at authentication so we don't @@ -13,7 +14,7 @@ test_lei(sub { for my $pfx ([qw(q z:0.. --only), "$ro_home/t1", '-o'], [qw(convert -o mboxrd:/dev/stdout)], [qw(convert t/utf8.eml -o), $imap_fail], - ['import'], [qw(tag +L:INBOX)]) { + ['import'], [qw(tag +L:inbox)]) { ok(!lei(@$pfx, $imap_fail), "IMAP auth failure on @$pfx"); like($lei_err, qr!\bE:.*?imaps?://.*?!sm, 'error shown'); unlike($lei_err, qr!Hunter2!s, 'password not shown'); diff --git a/xt/lei-onion-convert.t b/xt/lei-onion-convert.t index 6dd17065..d3afbbb9 100644 --- a/xt/lei-onion-convert.t +++ b/xt/lei-onion-convert.t @@ -1,10 +1,12 @@ #!perl -w -# Copyright (C) 2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; use v5.10; use PublicInbox::TestCommon; +use v5.12; use PublicInbox::TestCommon; use PublicInbox::MboxReader; +use autodie qw(pipe close); my $test_tor = $ENV{TEST_TOR}; plan skip_all => "TEST_TOR unset" unless $test_tor; +require_mods qw(IO::Socket::Socks IO::Socket::SSL Mail::IMAPClient Net::NNTP); unless ($test_tor =~ m!\Asocks5h://!i) { my $default = 'socks5h://127.0.0.1:9050'; diag "using $default (set TEST_TOR=socks5h://ADDR:PORT to override)"; @@ -19,11 +21,24 @@ my @cnv = qw(lei convert -o mboxrd:/dev/stdout); my @proxy_cli = ("--proxy=$test_tor"); my $proxy_cfg = "proxy=$test_tor"; test_lei(sub { + # ensure TLS + SOCKS works + ok !lei(qw(ls-mail-source imaps://mews.public-inbox.org/ + -c), "imap.$proxy_cfg"), + 'imaps fails on wrong hostname w/ Tor'; + ok !lei(qw(ls-mail-source nntps://mews.public-inbox.org/ + -c), "nntp.$proxy_cfg"), + 'nntps fails on wrong hostname w/ Tor'; + + lei_ok qw(ls-mail-source imaps://news.public-inbox.org/ + -c), "imap.$proxy_cfg"; + lei_ok qw(ls-mail-source nntps://news.public-inbox.org/ + -c), "nntp.$proxy_cfg"; + my $run = {}; for my $args ([$nntp_url, @proxy_cli], [$imap_url, @proxy_cli], [ $nntp_url, '-c', "nntp.$proxy_cfg" ], [ $imap_url, '-c', "imap.$proxy_cfg" ]) { - pipe(my ($r, $w)) or xbail "pipe: $!"; + pipe(my $r, my $w); my $cmd = [@cnv, @$args]; my $td = start_script($cmd, undef, { 1 => $w, run_mode => 0 }); $args->[0] =~ s!\A(.+?://).*!$1...!; diff --git a/xt/mem-imapd-tls.t b/xt/mem-imapd-tls.t index 8992a6fc..53adb11b 100644 --- a/xt/mem-imapd-tls.t +++ b/xt/mem-imapd-tls.t @@ -1,13 +1,13 @@ #!perl -w -# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> # Idle client memory usage test, particularly after EXAMINE when # Message Sequence Numbers are loaded use strict; use v5.10.1; use Socket qw(SOCK_STREAM IPPROTO_TCP SOL_SOCKET); +use PublicInbox::Spawn qw(which); use PublicInbox::TestCommon; -use PublicInbox::Syscall qw(:epoll); use PublicInbox::DS; require_mods(qw(-imapd)); my $inboxdir = $ENV{GIANT_INBOX_DIR}; @@ -72,7 +72,7 @@ if ($TEST_TLS) { $ssl_opt{SSL_startHandshake} = 0; } chomp(my $nfd = `/bin/sh -c 'ulimit -n'`); -$nfd -= 10; +$nfd -= 20; ok($nfd > 0, 'positive FD count'); my $MAX_FD = 10000; $nfd = $MAX_FD if $nfd >= $MAX_FD; @@ -81,8 +81,8 @@ sub once { 0 }; # stops event loop # setup the event loop so that it exits at every step # while we're still doing connect(2) -PublicInbox::DS->SetLoopTimeout(0); -PublicInbox::DS->SetPostLoopCallback(\&once); +$PublicInbox::DS::loop_timeout = 0; +local @PublicInbox::DS::post_loop_do = (\&once); my $pid = $td->{pid}; if ($^O eq 'linux' && open(my $f, '<', "/proc/$pid/status")) { diag(grep(/RssAnon/, <$f>)); @@ -100,30 +100,30 @@ foreach my $n (1..$nfd) { # try not to overflow the listen() backlog: if (!($n % 128) && $DONE != $n) { diag("nr: ($n) $DONE/$nfd"); - PublicInbox::DS->SetLoopTimeout(-1); - PublicInbox::DS->SetPostLoopCallback(sub { $DONE != $n }); + $PublicInbox::DS::loop_timeout = -1; + local @PublicInbox::DS::post_loop_do = (sub { $DONE != $n }); # clear the backlog: PublicInbox::DS::event_loop(); # resume looping - PublicInbox::DS->SetLoopTimeout(0); - PublicInbox::DS->SetPostLoopCallback(\&once); + $PublicInbox::DS::loop_timeout = 0; } } # run the event loop normally, now: diag "done?: @".time." $DONE/$nfd"; if ($DONE != $nfd) { - PublicInbox::DS->SetLoopTimeout(-1); - PublicInbox::DS->SetPostLoopCallback(sub { $DONE != $nfd }); + $PublicInbox::DS::loop_timeout = -1; + local @PublicInbox::DS::post_loop_do = (sub { $DONE != $nfd }); PublicInbox::DS::event_loop(); } is($nfd, $DONE, "$nfd/$DONE done"); -if ($^O eq 'linux' && open(my $f, '<', "/proc/$pid/status")) { +my $lsof = which('lsof'); +if ($^O eq 'linux' && $lsof && open(my $f, '<', "/proc/$pid/status")) { diag(grep(/RssAnon/, <$f>)); - diag " SELF lsof | wc -l ".`lsof -p $$ |wc -l`; - diag "SERVER lsof | wc -l ".`lsof -p $pid |wc -l`; + diag " SELF lsof | wc -l ".`$lsof -p $$ |wc -l`; + diag "SERVER lsof | wc -l ".`$lsof -p $pid |wc -l`; } PublicInbox::DS->Reset; $td->kill; @@ -135,7 +135,7 @@ package IMAPC; use strict; use parent qw(PublicInbox::DS); # fields: step: state machine, zin: Zlib inflate context -use PublicInbox::Syscall qw(EPOLLIN EPOLLOUT EPOLLONESHOT); +use PublicInbox::Syscall qw(EPOLLOUT EPOLLONESHOT); use Errno qw(EAGAIN); # determines where we start event_step use constant FIRST_STEP => ($ENV{TEST_COMPRESS} // 1) ? -2 : 0; @@ -221,13 +221,13 @@ package IMAPCdeflate; use strict; our @ISA; use Compress::Raw::Zlib; -use PublicInbox::IMAPdeflate; +use PublicInbox::IMAP; my %ZIN_OPT; BEGIN { @ISA = qw(IMAPC); %ZIN_OPT = ( -WindowBits => -15, -AppendOutput => 1 ); - *write = \&PublicInbox::IMAPdeflate::write; - *do_read = \&PublicInbox::IMAPdeflate::do_read; + *write = \&PublicInbox::DSdeflate::write; + *do_read = \&PublicInbox::DSdeflate::do_read; }; sub enable { diff --git a/xt/mem-nntpd-tls.t b/xt/mem-nntpd-tls.t new file mode 100644 index 00000000..ec639a8b --- /dev/null +++ b/xt/mem-nntpd-tls.t @@ -0,0 +1,254 @@ +#!perl -w +# Copyright (C) all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +# Idle client memory usage test +use v5.12.1; +use PublicInbox::TestCommon; +use File::Temp qw(tempdir); +use Socket qw(SOCK_STREAM IPPROTO_TCP SOL_SOCKET); +require_mods(qw(-nntpd)); +require PublicInbox::InboxWritable; +require PublicInbox::SearchIdx; +use PublicInbox::Syscall; +use PublicInbox::DS; +my $version = 2; # v2 needs newer git +require_git('2.6') if $version >= 2; +use_ok 'IO::Socket::SSL'; +my ($cert, $key) = qw(certs/server-cert.pem certs/server-key.pem); +unless (-r $key && -r $cert) { + plan skip_all => + "certs/ missing for $0, run ./certs/create-certs.perl"; +} +use_ok 'PublicInbox::TLS'; +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'; +local $SIG{PIPE} = 'IGNORE'; # for NNTPC (below) +my $nntps = tcp_server(); +my $ibx = PublicInbox::Inbox->new({ + inboxdir => $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 <<EOF +[publicinbox "nntpd-tls"] + mainrepo = $mainrepo + address = $addr + indexlevel = basic + newsgroup = $group +EOF + ; + close $fh or die "close: $!\n"; +} + +{ + my $im = $ibx->importer(0); + my $eml = eml_load('t/data/0001.patch'); + ok($im->add($eml), 'message added'); + $im->done; + if ($version == 1) { + my $s = PublicInbox::SearchIdx->new($ibx, 1); + $s->index_sync; + } +} + +my $nntps_addr = tcp_host_port($nntps); +my $env = { PI_CONFIG => $pi_config }; +my $tls = $ENV{TLS} // 1; +my $args = $tls ? ["--cert=$cert", "--key=$key", "-lnntps://$nntps_addr"] : []; +my $cmd = [ '-nntpd', '-W0', @$args, "--stdout=$out", "--stderr=$err" ]; + +# run_mode=0 ensures Test::More FDs don't get shared +my $td = start_script($cmd, $env, { 3 => $nntps, run_mode => 0 }); +my %ssl_opt = ( + SSL_hostname => 'server.local', + SSL_verifycn_name => 'server.local', + SSL_verify_mode => SSL_VERIFY_PEER(), + SSL_ca_file => 'certs/test-ca.pem', +); +my $ctx = IO::Socket::SSL::SSL_Context->new(%ssl_opt); + +# cf. https://rt.cpan.org/Ticket/Display.html?id=129463 +my $mode = eval { Net::SSLeay::MODE_RELEASE_BUFFERS() }; +if ($mode && $ctx->{context}) { + eval { Net::SSLeay::CTX_set_mode($ctx->{context}, $mode) }; + warn "W: $@ (setting SSL_MODE_RELEASE_BUFFERS)\n" if $@; +} + +$ssl_opt{SSL_reuse_ctx} = $ctx; +$ssl_opt{SSL_startHandshake} = 0; + +my %opt = ( + Proto => 'tcp', + PeerAddr => $nntps_addr, + Type => SOCK_STREAM, + Blocking => 0 +); +chomp(my $nfd = `/bin/sh -c 'ulimit -n'`); +$nfd -= 10; +ok($nfd > 0, 'positive FD count'); +my $MAX_FD = 10000; +$nfd = $MAX_FD if $nfd >= $MAX_FD; +our $DONE = 0; +sub once { 0 }; # stops event loop + +# setup the event loop so that it exits at every step +# while we're still doing connect(2) +$PublicInbox::DS::loop_timeout = 0; +local @PublicInbox::DS::post_loop_do = (\&once); + +foreach my $n (1..$nfd) { + my $io = tcp_connect($nntps, Blocking => 0); + $io = IO::Socket::SSL->start_SSL($io, %ssl_opt) if $tls; + NNTPC->new($io); + + # one step through the event loop + # do a little work as we connect: + PublicInbox::DS::event_loop(); + + # try not to overflow the listen() backlog: + if (!($n % 128) && $n != $DONE) { + diag("nr: ($n) $DONE/$nfd"); + $PublicInbox::DS::loop_timeout = -1; + @PublicInbox::DS::post_loop_do = (sub { $DONE != $n }); + + # clear the backlog: + PublicInbox::DS::event_loop(); + + # resume looping + $PublicInbox::DS::loop_timeout = 0; + @PublicInbox::DS::post_loop_do = (\&once); + } +} +my $pid = $td->{pid}; +my $dump_rss = sub { + return if $^O ne 'linux'; + open(my $f, '<', "/proc/$pid/status") or return; + diag(grep(/RssAnon/, <$f>)); +}; +$dump_rss->(); + +# run the event loop normally, now: +if ($DONE != $nfd) { + $PublicInbox::DS::loop_timeout = -1; + @PublicInbox::DS::post_loop_do = (sub { + diag "done: ".time." $DONE"; + $DONE != $nfd; + }); + PublicInbox::DS::event_loop(); +} + +is($nfd, $DONE, 'done'); +$dump_rss->(); +if ($^O eq 'linux') { + diag " SELF lsof | wc -l ".`lsof -p $$ |wc -l`; + diag "SERVER lsof | wc -l ".`lsof -p $pid |wc -l`; +} +PublicInbox::DS->Reset; +$td->kill; +$td->join; +is($?, 0, 'no error in exited process'); +done_testing(); + +package NNTPC; +use v5.12; +use parent qw(PublicInbox::DS); +use PublicInbox::Syscall qw(EPOLLOUT EPOLLONESHOT); +use Data::Dumper; + +# return true if complete, false if incomplete (or failure) +sub connect_tls_step ($) { + my ($self) = @_; + my $sock = $self->{sock} or return; + return 1 if $sock->connect_SSL; + return $self->drop("$!") unless $!{EAGAIN}; + if (my $ev = PublicInbox::TLS::epollbit()) { + unshift @{$self->{wbuf}}, \&connect_tls_step; + PublicInbox::DS::epwait($self->{sock}, $ev | EPOLLONESHOT); + 0; + } else { + $self->drop('BUG? EAGAIN but '.PublicInbox::TLS::err()); + } +} + +sub event_step ($) { + my ($self) = @_; + + # TLS negotiation happens in flush_write via {wbuf} + return unless $self->flush_write && $self->{sock}; + + if ($self->{step} == -2) { + $self->do_read(\(my $buf = ''), 128) or return; + $buf =~ /\A201 / or die "no greeting"; + $self->{step} = -1; + $self->write(\"COMPRESS DEFLATE\r\n"); + } + if ($self->{step} == -1) { + $self->do_read(\(my $buf = ''), 128) or return; + $buf =~ /\A20[0-9] / or die "no compression $buf"; + NNTPCdeflate->enable($self); + $self->{step} = 1; + $self->write(\"DATE\r\n"); + } + if ($self->{step} == 0) { + $self->do_read(\(my $buf = ''), 128) or return; + $buf =~ /\A201 / or die "no greeting"; + $self->{step} = 1; + $self->write(\"DATE\r\n"); + } + if ($self->{step} == 1) { + $self->do_read(\(my $buf = ''), 128) or return; + $buf =~ /\A111 / or die 'no date'; + no warnings 'once'; + $::DONE++; + $self->{step} = 2; # all done + } else { + die "$self->{step} Should never get here ". Dumper($self); + } +} + +sub new { + my ($class, $io) = @_; + my $self = bless {}, $class; + + # wait for connect(), and maybe SSL_connect() + $self->SUPER::new($io, EPOLLOUT|EPOLLONESHOT); + $self->{wbuf} = [ \&connect_tls_step ] if $io->can('connect_SSL'); + $self->{step} = -2; # determines where we start event_step + $self; +}; + +1; +package NNTPCdeflate; +use v5.12; +our @ISA = qw(NNTPC PublicInbox::DS); +use Compress::Raw::Zlib; +use PublicInbox::DSdeflate; +BEGIN { + *write = \&PublicInbox::DSdeflate::write; + *do_read = \&PublicInbox::DSdeflate::do_read; + *event_step = \&NNTPC::event_step; + *flush_write = \&PublicInbox::DS::flush_write; + *close = \&PublicInbox::DS::close; +} + +sub enable { + my ($class, $self) = @_; + my %ZIN_OPT = ( -WindowBits => -15, -AppendOutput => 1 ); + my ($in, $err) = Compress::Raw::Zlib::Inflate->new(%ZIN_OPT); + die "Inflate->new failed: $err" if $err != Z_OK; + bless $self, $class; + $self->{zin} = $in; +} + +1; diff --git a/xt/msgtime_cmp.t b/xt/msgtime_cmp.t index a7ef5245..c63f785e 100644 --- a/xt/msgtime_cmp.t +++ b/xt/msgtime_cmp.t @@ -36,7 +36,7 @@ sub quiet_is_deeply ($$$$$) { ($old->[0] != $cur->[0]) || ($old->[1] != $cur->[1]))) { for ($cur, $old) { - $_->[2] = strftime('%Y-%m-%d %k:%M:%S', gmtime($_->[0])) + $_->[2] = strftime('%F %T', gmtime($_->[0])) } is_deeply($cur, $old, "$func $oid"); diag('got: ', explain($cur)); diff --git a/xt/net_writer-imap.t b/xt/net_writer-imap.t index 333e0e3b..176502ba 100644 --- a/xt/net_writer-imap.t +++ b/xt/net_writer-imap.t @@ -1,5 +1,5 @@ #!perl -w -# Copyright (C) 2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use v5.10.1; use PublicInbox::TestCommon; use Sys::Hostname qw(hostname); @@ -82,7 +82,7 @@ my $mics = do { $nwr->imap_common_init; }; my $mic = (values %$mics)[0]; -my $cleanup = PublicInbox::OnDestroy->new($$, sub { +my $cleanup = on_destroy sub { if (defined($folder)) { my $mic = $nwr->mic_get($uri); $mic->delete($folder) or @@ -92,7 +92,7 @@ my $cleanup = PublicInbox::OnDestroy->new($$, sub { local $ENV{HOME} = $tmpdir; system(qw(git credential-cache exit)); } -}); +}; my $imap_append = $nwr->can('imap_append'); my $smsg = bless { kw => [ 'seen' ] }, 'PublicInbox::Smsg'; $imap_append->($mic, $folder, undef, $smsg, eml_load('t/plack-qp.eml')); @@ -233,7 +233,7 @@ EOM my $pub_cfg = PublicInbox::Config->new; PublicInbox::DS->Reset; my $ii = PublicInbox::InboxIdle->new($pub_cfg); - my $cb = sub { PublicInbox::DS->SetPostLoopCallback(sub {}) }; + my $cb = sub { @PublicInbox::DS::post_loop_do = (sub {}) }; my $obj = bless \$cb, 'PublicInbox::TestCommon::InboxWakeup'; $pub_cfg->each_inbox(sub { $_[0]->subscribe_unlock('ident', $obj) }); my $w = start_script(['-watch'], undef, { 2 => $err_wr }); diff --git a/xt/nntpd-validate.t b/xt/nntpd-validate.t index 83f024f9..a6f3980e 100644 --- a/xt/nntpd-validate.t +++ b/xt/nntpd-validate.t @@ -1,4 +1,4 @@ -# Copyright (C) 2019-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> # Integration test to validate compression. @@ -9,6 +9,7 @@ use Symbol qw(gensym); use Time::HiRes qw(clock_gettime CLOCK_MONOTONIC); use POSIX qw(_exit); use PublicInbox::TestCommon; +use PublicInbox::SHA; my $inbox_dir = $ENV{GIANT_INBOX_DIR}; plan skip_all => "GIANT_INBOX_DIR not defined for $0" unless $inbox_dir; my $mid = $ENV{TEST_MID}; @@ -55,7 +56,7 @@ sub do_get_all { my ($methods) = @_; my $desc = join(',', @$methods); my $t0 = clock_gettime(CLOCK_MONOTONIC); - my $dig = Digest::SHA->new(1); + my $dig = PublicInbox::SHA->new(1); my $digfh = gensym; my $tmpfh; if ($File::Temp::KEEP_ALL) { diff --git a/xt/perf-msgview.t b/xt/perf-msgview.t index cf550c1a..ef261359 100644 --- a/xt/perf-msgview.t +++ b/xt/perf-msgview.t @@ -7,10 +7,12 @@ use PublicInbox::TestCommon; use Benchmark qw(:all); use PublicInbox::Inbox; use PublicInbox::View; -use PublicInbox::Spawn qw(popen_rd); +use PublicInbox::WwwStream; my $inboxdir = $ENV{GIANT_INBOX_DIR} // $ENV{GIANT_PI_DIR}; my $blob = $ENV{TEST_BLOB}; +my $obfuscate = $ENV{PI_OBFUSCATE} ? 1 : 0; +diag "PI_OBFUSCATE=$obfuscate"; plan skip_all => "GIANT_INBOX_DIR not defined for $0" unless $inboxdir; my @cat = qw(cat-file --buffer --batch-check --batch-all-objects); @@ -21,7 +23,8 @@ if (require_git(2.19, 1)) { "git <2.19, cat-file lacks --unordered, locality suffers\n"; } require_mods qw(Plack::Util); -my $ibx = PublicInbox::Inbox->new({ inboxdir => $inboxdir, name => 'name' }); +my $ibx = PublicInbox::Inbox->new({ inboxdir => $inboxdir, name => 'name', + obfuscate => $obfuscate}); my $git = $ibx->git; my $fh = $blob ? undef : $git->popen(@cat); if ($fh) { @@ -31,26 +34,29 @@ if ($fh) { die "timed out waiting for --batch-check"; } -my $ctx = { +my $ctx = bless { env => { HTTP_HOST => 'example.com', 'psgi.url_scheme' => 'https' }, ibx => $ibx, www => Plack::Util::inline_object(style => sub {''}), -}; -my ($mime, $res, $oid, $type); + gz => PublicInbox::GzipFilter::gzip_or_die(), +}, 'PublicInbox::WwwStream'; +my ($eml, $res, $oid, $type); my $n = 0; -my $obuf = ''; my $m = 0; +${$ctx->{obuf}} = ''; +$ctx->{mhref} = '../'; my $cb = sub { - $mime = PublicInbox::Eml->new(shift); - PublicInbox::View::multipart_text_as_html($mime, $ctx); + $eml = PublicInbox::Eml->new(shift); + $eml->each_part(\&PublicInbox::View::add_text_body, $ctx, 1); + $ctx->zflush(grep defined, delete @$ctx{'obuf'}); # compat ++$m; - $obuf = ''; + delete $ctx->{zbuf}; + ${$ctx->{obuf}} = ''; # compat + $ctx->{gz} = PublicInbox::GzipFilter::gzip_or_die(); }; my $t = timeit(1, sub { - $ctx->{obuf} = \$obuf; - $ctx->{mhref} = '../'; if (defined $blob) { my $nr = $ENV{NR} // 10000; for (1..$nr) { @@ -67,6 +73,6 @@ my $t = timeit(1, sub { } $git->async_wait_all; }); -diag 'multipart_text_as_html took '.timestr($t)." for $n <=> $m messages"; +diag 'add_text_body took '.timestr($t)." for $n <=> $m messages"; is($m, $n, 'rendered all messages'); done_testing(); diff --git a/xt/perf-obfuscate.t b/xt/perf-obfuscate.t deleted file mode 100644 index 640309d2..00000000 --- a/xt/perf-obfuscate.t +++ /dev/null @@ -1,64 +0,0 @@ -#!perl -w -# Copyright (C) 2021 all contributors <meta@public-inbox.org> -# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; -use v5.10.1; -use PublicInbox::TestCommon; -use Benchmark qw(:all); -use PublicInbox::Inbox; -use PublicInbox::View; - -my $inboxdir = $ENV{GIANT_INBOX_DIR}; -plan skip_all => "GIANT_INBOX_DIR not defined for $0" unless $inboxdir; - -my $obfuscate = $ENV{PI_OBFUSCATE} ? 1 : 0; -diag "obfuscate=$obfuscate\n"; - -my @cat = qw(cat-file --buffer --batch-check --batch-all-objects); -if (require_git(2.19, 1)) { - push @cat, '--unordered'; -} else { - warn -"git <2.19, cat-file lacks --unordered, locality suffers\n"; -} -require_mods qw(Plack::Util); -use_ok 'Plack::Util'; -my $ibx = PublicInbox::Inbox->new({ inboxdir => $inboxdir, name => 'name' , - obfuscate => $obfuscate}); -my $git = $ibx->git; -my $fh = $git->popen(@cat); -my $vec = ''; -vec($vec, fileno($fh), 1) = 1; -select($vec, undef, undef, 60) or die "timed out waiting for --batch-check"; - -my $ctx = { - env => { HTTP_HOST => 'example.com', 'psgi.url_scheme' => 'https' }, - ibx => $ibx, - www => Plack::Util::inline_object(style => sub {''}), -}; -my ($mime, $res, $oid, $type); -my $n = 0; -my $obuf = ''; -my $m = 0; - -my $cb = sub { - $mime = PublicInbox::Eml->new(shift); - PublicInbox::View::multipart_text_as_html($mime, $ctx); - ++$m; - $obuf = ''; -}; - -my $t = timeit(1, sub { - $ctx->{obuf} = \$obuf; - $ctx->{mhref} = '../'; - while (<$fh>) { - ($oid, $type) = split / /; - next if $type ne 'blob'; - ++$n; - $git->cat_async($oid, $cb); - } - $git->async_wait_all; -}); -diag 'multipart_text_as_html took '.timestr($t)." for $n <=> $m messages"; -is($m, $n, 'rendered all messages'); -done_testing(); diff --git a/xt/pop3d-mpop.t b/xt/pop3d-mpop.t new file mode 100644 index 00000000..ff8bb5dc --- /dev/null +++ b/xt/pop3d-mpop.t @@ -0,0 +1,76 @@ +#!perl -w +# Copyright (C) all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +# ensure mpop compatibility +use v5.12; +use File::Path qw(make_path); +use PublicInbox::TestCommon; +use PublicInbox::Spawn qw(spawn); +my $inboxdir = $ENV{GIANT_INBOX_DIR}; +(defined($inboxdir) && -d $inboxdir) or + plan skip_all => "GIANT_INBOX_DIR not defined for $0"; +plan skip_all => "bad characters in $inboxdir" if $inboxdir =~ m![^\w\.\-/]!; +my $uuidgen = require_cmd('uuidgen'); +my $mpop = require_cmd('mpop'); +require_mods(qw(DBD::SQLite :fcntl_lock)); +require_git(v2.6); # for v2 + +my ($tmpdir, $for_destroy) = tmpdir(); +my $cfg = "$tmpdir/cfg"; +my $newsgroup = 'inbox.test'; +my %pids; +{ + open my $fh, '>', $cfg or xbail "open: $!"; + print $fh <<EOF or xbail "print: $!"; +[publicinbox] + pop3state = $tmpdir/p3s +[publicinbox "test"] + newsgroup = $newsgroup + address = mpop-test\@example.com + inboxdir = $inboxdir +EOF + close $fh or xbail "close: $!"; +} +my ($out, $err) = ("$tmpdir/stdout.log", "$tmpdir/stderr.log"); +my $sock = tcp_server(); +my $cmd = [ '-pop3d', '-W0', "--stdout=$out", "--stderr=$err" ]; +my $env = { PI_CONFIG => $cfg }; +my $td = start_script($cmd, $env, { 3 => $sock }) or xbail "-xbail $?"; +chomp(my $uuid = xqx([$uuidgen])); + +make_path("$tmpdir/home/.config/mpop", + map { "$tmpdir/md/$_" } qw(new cur tmp)); + +{ + open my $fh, '>', "$tmpdir/home/.config/mpop/config" + or xbail "open $!"; + chmod 0600, $fh; + print $fh <<EOM or xbail "print $!"; +defaults +tls off +delivery maildir $tmpdir/md +account default +host ${\$sock->sockhost} +port ${\$sock->sockport} +user $uuid\@$newsgroup?limit=10000 +auth user +password anonymous +received_header off +EOM + close $fh or xbail "close $!"; + delete local $ENV{XDG_CONFIG_HOME}; # mpop uses this + local $ENV{HOME} = "$tmpdir/home"; + my $cmd = [ $mpop, '-q' ]; + my $pid = spawn($cmd, undef, { 1 => 2 }); + $pids{$pid} = $cmd; +} +diag "mpop is writing to $tmpdir/md ..."; +while (scalar keys %pids) { + my $pid = waitpid(-1, 0) or next; + my $cmd = delete $pids{$pid} or next; + is($?, 0, join(' ', @$cmd, 'done')); +} +$td->kill; +$td->join; +is($?, 0, 'no error on -pop3d exit'); +done_testing; diff --git a/xt/solver.t b/xt/solver.t index 880458fb..372d003b 100644 --- a/xt/solver.t +++ b/xt/solver.t @@ -1,16 +1,16 @@ #!perl -w -# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; -use Test::More; +use v5.12; use PublicInbox::TestCommon; use PublicInbox::Config; # this relies on PI_CONFIG // ~/.public-inbox/config my @psgi = qw(HTTP::Request::Common Plack::Test URI::Escape Plack::Builder); -require_mods(qw(DBD::SQLite Search::Xapian), @psgi); +require_mods(qw(DBD::SQLite Xapian), @psgi); use_ok($_) for @psgi; use_ok 'PublicInbox::WWW'; my $cfg = PublicInbox::Config->new; my $www = PublicInbox::WWW->new($cfg); +$www->preload; my $app = sub { my $env = shift; $env->{'psgi.errors'} = \*STDERR; @@ -30,48 +30,52 @@ my $todo = { '6aa8857a11/s/?b=protocol.c', '96f1c7f/s/', # TODO: b=contrib/completion/git-completion.bash 'b76f2c0/s/?b=po/zh_CN.po', + 'c2f3bf071ee90b01f2d629921bb04c4f798f02fa/s/', # tag + '7eb93c89651c47c8095d476251f2e4314656b292/s/', # non-UTF-8 ], + 'sox-devel' => [ + 'c38987e8d20505621b8d872863afa7d233ed1096/s/', # non-UTF-8 + ] }; -my ($ibx_name, $urls, @gone); +my @gone; my $client = sub { my ($cb) = @_; - for (@$urls) { - my $url = "/$ibx_name/$_"; - my $res = $cb->(GET($url)); - is($res->code, 200, $url); - next if $res->code == 200; - # diag $res->content; - diag "$url failed"; + for my $ibx_name (sort keys %$todo) { + diag "testing $ibx_name"; + my $urls = $todo->{$ibx_name}; + for my $u (@$urls) { + my $url = "/$ibx_name/$u"; + my $res = $cb->(GET($url)); + is($res->code, 200, $url); + next if $res->code == 200; + diag "$url failed"; + diag $res->content; + } } }; my $nr = 0; -while (($ibx_name, $urls) = each %$todo) { +while (my ($ibx_name, $urls) = each %$todo) { SKIP: { - if (!$cfg->lookup_name($ibx_name)) { + my $ibx = $cfg->lookup_name($ibx_name); + if (!$ibx) { + push @gone, $ibx_name; + skip(qq{[publicinbox "$ibx_name"] not configured}, + scalar(@$urls)); + } + if (!defined($ibx->{-repo_objs})) { push @gone, $ibx_name; - skip("$ibx_name not configured", scalar(@$urls)); + skip(qq{publicinbox.$ibx_name.coderepo not configured}, + scalar(@$urls)); } - test_psgi($app, $client); $nr++; } } -SKIP: { - require_mods(qw(Plack::Test::ExternalServer), $nr); - delete @$todo{@gone}; - - my $sock = tcp_server() or BAIL_OUT $!; - my ($tmpdir, $for_destroy) = tmpdir(); - my ($out, $err) = map { "$tmpdir/std$_.log" } qw(out err); - my $cmd = [ qw(-httpd -W0), "--stdout=$out", "--stderr=$err" ]; - my $td = start_script($cmd, undef, { 3 => $sock }); - my ($h, $p) = tcp_host_port($sock); - local $ENV{PLACK_TEST_EXTERNALSERVER_URI} = "http://$h:$p"; - while (($ibx_name, $urls) = each %$todo) { - Plack::Test::ExternalServer::test_psgi(client => $client); - } -} +delete @$todo{@gone}; +test_psgi($app, $client); +my $env = { PI_CONFIG => PublicInbox::Config->default_file }; +test_httpd($env, $client, $nr); done_testing(); |