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/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 | 28 | ||||
-rw-r--r-- | xt/mem-nntpd-tls.t | 20 | ||||
-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/pop3d-mpop.t | 17 | ||||
-rw-r--r-- | xt/solver.t | 61 |
18 files changed, 490 insertions, 142 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/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 75f2911f..53adb11b 100644 --- a/xt/mem-imapd-tls.t +++ b/xt/mem-imapd-tls.t @@ -6,8 +6,8 @@ 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; diff --git a/xt/mem-nntpd-tls.t b/xt/mem-nntpd-tls.t index 6e34d233..ec639a8b 100644 --- a/xt/mem-nntpd-tls.t +++ b/xt/mem-nntpd-tls.t @@ -9,7 +9,7 @@ use Socket qw(SOCK_STREAM IPPROTO_TCP SOL_SOCKET); require_mods(qw(-nntpd)); require PublicInbox::InboxWritable; require PublicInbox::SearchIdx; -use PublicInbox::Syscall qw(:epoll); +use PublicInbox::Syscall; use PublicInbox::DS; my $version = 2; # v2 needs newer git require_git('2.6') if $version >= 2; @@ -104,8 +104,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); foreach my $n (1..$nfd) { my $io = tcp_connect($nntps, Blocking => 0); @@ -119,15 +119,15 @@ foreach my $n (1..$nfd) { # try not to overflow the listen() backlog: if (!($n % 128) && $n != $DONE) { diag("nr: ($n) $DONE/$nfd"); - PublicInbox::DS->SetLoopTimeout(-1); - PublicInbox::DS->SetPostLoopCallback(sub { $DONE != $n }); + $PublicInbox::DS::loop_timeout = -1; + @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; + @PublicInbox::DS::post_loop_do = (\&once); } } my $pid = $td->{pid}; @@ -140,8 +140,8 @@ $dump_rss->(); # run the event loop normally, now: if ($DONE != $nfd) { - PublicInbox::DS->SetLoopTimeout(-1); - PublicInbox::DS->SetPostLoopCallback(sub { + $PublicInbox::DS::loop_timeout = -1; + @PublicInbox::DS::post_loop_do = (sub { diag "done: ".time." $DONE"; $DONE != $nfd; }); @@ -163,7 +163,7 @@ done_testing(); package NNTPC; use v5.12; use parent qw(PublicInbox::DS); -use PublicInbox::Syscall qw(EPOLLIN EPOLLOUT EPOLLONESHOT); +use PublicInbox::Syscall qw(EPOLLOUT EPOLLONESHOT); use Data::Dumper; # return true if complete, false if incomplete (or failure) 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/pop3d-mpop.t b/xt/pop3d-mpop.t index 8648b953..ff8bb5dc 100644 --- a/xt/pop3d-mpop.t +++ b/xt/pop3d-mpop.t @@ -5,15 +5,15 @@ use v5.12; use File::Path qw(make_path); use PublicInbox::TestCommon; -use PublicInbox::Spawn qw(which spawn); +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 = which('uuidgen') or plan skip_all => 'uuidgen(1) missing'; -require_mods(qw(DBD::SQLite)); -require_git('2.6'); # for v2 -require_mods(qw(File::FcntlLock)) if $^O !~ /\A(?:linux|freebsd)\z/; +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"; @@ -41,8 +41,7 @@ chomp(my $uuid = xqx([$uuidgen])); make_path("$tmpdir/home/.config/mpop", map { "$tmpdir/md/$_" } qw(new cur tmp)); -SKIP: { - my $mpop = which('mpop') or skip('mpop(1) missing', 1); +{ open my $fh, '>', "$tmpdir/home/.config/mpop/config" or xbail "open $!"; chmod 0600, $fh; @@ -53,7 +52,7 @@ delivery maildir $tmpdir/md account default host ${\$sock->sockhost} port ${\$sock->sockport} -user $uuid\@$newsgroup +user $uuid\@$newsgroup?limit=10000 auth user password anonymous received_header off @@ -65,7 +64,7 @@ EOM 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; diff --git a/xt/solver.t b/xt/solver.t index 32cd43cf..372d003b 100644 --- a/xt/solver.t +++ b/xt/solver.t @@ -5,11 +5,12 @@ 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; @@ -29,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 "$url failed"; - diag $res->content; + 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(); |