]> Sergey Matveev's repositories - public-inbox.git/blobdiff - lib/PublicInbox/TestCommon.pm
imap+nntp: share COMPRESS implementation
[public-inbox.git] / lib / PublicInbox / TestCommon.pm
index f5b3fae43e8219bcb5a758dd0ed8ea5d8b3bfa12..ecf7a261b6f485447dce78ca6f10fd74660f4201 100644 (file)
@@ -1,4 +1,4 @@
-# Copyright (C) 2015-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>
 
 # internal APIs used only for tests
@@ -11,12 +11,16 @@ use POSIX qw(dup2);
 use IO::Socket::INET;
 use File::Spec;
 our @EXPORT;
+my $lei_loud = $ENV{TEST_LEI_ERR_LOUD};
+my $tail_cmd = $ENV{TAIL};
+our ($lei_opt, $lei_out, $lei_err, $lei_cwdfh);
 BEGIN {
        @EXPORT = qw(tmpdir tcp_server tcp_connect require_git require_mods
                run_script start_script key2sub xsys xsys_e xqx eml_load tick
-               have_xapian_compact json_utf8 setup_public_inboxes
-               tcp_host_port test_lei lei lei_ok
-               $lei $lei_out $lei_err $lei_opt);
+               have_xapian_compact json_utf8 setup_public_inboxes create_inbox
+               tcp_host_port test_lei lei lei_ok $lei_out $lei_err $lei_opt
+               test_httpd xbail require_cmd is_xdeeply tail_f
+               ignore_inline_c_missing);
        require Test::More;
        my @methods = grep(!/\W/, @Test::More::EXPORT);
        eval(join('', map { "*$_=\\&Test::More::$_;" } @methods));
@@ -24,6 +28,8 @@ BEGIN {
        push @EXPORT, @methods;
 }
 
+sub xbail (@) { BAIL_OUT join(' ', map { ref() ? (explain($_)) : ($_) } @_) }
+
 sub eml_load ($) {
        my ($path, $cb) = @_;
        open(my $fh, '<', $path) or die "open $path: $!";
@@ -37,7 +43,7 @@ sub tmpdir (;$) {
        unless (defined $base) {
                ($base) = ($0 =~ m!\b([^/]+)\.[^\.]+\z!);
        }
-       my $tmpdir = File::Temp->newdir("pi-$base-$$-XXXXXX", TMPDIR => 1);
+       my $tmpdir = File::Temp->newdir("pi-$base-$$-XXXX", TMPDIR => 1);
        ($tmpdir->dirname, $tmpdir);
 }
 
@@ -83,6 +89,18 @@ sub tcp_connect {
        $s;
 }
 
+sub require_cmd ($;$) {
+       my ($cmd, $maybe) = @_;
+       require PublicInbox::Spawn;
+       my $bin = PublicInbox::Spawn::which($cmd);
+       return $bin if $bin;
+       $maybe ? 0 : plan(skip_all => "$cmd missing from PATH for $0");
+}
+
+sub have_xapian_compact () {
+       require_cmd($ENV{XAPIAN_COMPACT} || 'xapian-compact', 1);
+}
+
 sub require_git ($;$) {
        my ($req, $maybe) = @_;
        my ($req_maj, $req_min, $req_sub) = split(/\./, $req);
@@ -104,20 +122,29 @@ sub require_mods {
        my $maybe = pop @mods if $mods[-1] =~ /\A[0-9]+\z/;
        my @need;
        while (my $mod = shift(@mods)) {
+               if ($mod eq 'lei') {
+                       require_git(2.6, $maybe ? $maybe : ());
+                       push @mods, qw(DBD::SQLite Search::Xapian);
+                       $mod = 'json'; # fall-through
+               }
                if ($mod eq 'json') {
-                       $mod = 'Cpanel::JSON::XS||JSON::MaybeXS||'.
-                               'JSON||JSON::PP'
+                       $mod = 'Cpanel::JSON::XS||JSON::MaybeXS||JSON||JSON::PP'
+               } elsif ($mod eq '-httpd') {
+                       push @mods, qw(Plack::Builder Plack::Util);
+                       next;
+               } elsif ($mod eq '-imapd') {
+                       push @mods, qw(Parse::RecDescent DBD::SQLite
+                                       Email::Address::XS||Mail::Address);
+                       next;
+               } elsif ($mod eq '-nntpd') {
+                       push @mods, qw(DBD::SQLite);
+                       next;
                }
                if ($mod eq 'Search::Xapian') {
                        if (eval { require PublicInbox::Search } &&
                                PublicInbox::Search::load_xapian()) {
                                next;
                        }
-               } elsif ($mod eq 'Search::Xapian::WritableDatabase') {
-                       if (eval { require PublicInbox::SearchIdx } &&
-                               PublicInbox::SearchIdx::load_xapian_writable()){
-                                       next;
-                       }
                } elsif (index($mod, '||') >= 0) { # "Foo||Bar"
                        my $ok;
                        for my $m (split(/\Q||\E/, $mod)) {
@@ -131,6 +158,7 @@ sub require_mods {
                        eval "require $mod";
                }
                if ($@) {
+                       diag "require $mod: $@" if $mod =~ /Gcf2/;
                        push @need, $mod;
                } elsif ($mod eq 'IO::Socket::SSL' &&
                        # old versions of IO::Socket::SSL aren't supported
@@ -155,8 +183,8 @@ sub key2script ($) {
        'blib/script/'.$key;
 }
 
-my @io_mode = ([ *STDIN{IO}, '<&' ], [ *STDOUT{IO}, '>&' ],
-               [ *STDERR{IO}, '>&' ]);
+my @io_mode = ([ *STDIN{IO}, '+<&' ], [ *STDOUT{IO}, '+>&' ],
+               [ *STDERR{IO}, '+>&' ]);
 
 sub _prepare_redirects ($) {
        my ($fhref) = @_;
@@ -254,11 +282,20 @@ sub run_script ($;$$) {
        my $sub = $run_mode == 0 ? undef : key2sub($key);
        my $fhref = [];
        my $spawn_opt = {};
+       my @tail_paths;
        for my $fd (0..2) {
                my $redir = $opt->{$fd};
                my $ref = ref($redir);
                if ($ref eq 'SCALAR') {
-                       open my $fh, '+>', undef or die "open: $!";
+                       my $fh;
+                       if ($tail_cmd && $ENV{TAIL_ALL} && $fd > 0) {
+                               require File::Temp;
+                               $fh = File::Temp->new("fd.$fd-XXXX", TMPDIR=>1);
+                               push @tail_paths, $fh->filename;
+                       } else {
+                               open $fh, '+>', undef;
+                       }
+                       $fh or xbail $!;
                        $fhref->[$fd] = $fh;
                        $spawn_opt->{$fd} = $fh;
                        next if $fd > 0;
@@ -271,6 +308,7 @@ sub run_script ($;$$) {
                        die "unable to deal with $ref $redir";
                }
        }
+       my $tail = @tail_paths ? tail_f(@tail_paths) : undef;
        if ($key =~ /-(index|convert|extindex|convert|xcpdb)\z/) {
                unshift @argv, '--no-fsync';
        }
@@ -278,6 +316,10 @@ sub run_script ($;$$) {
                # spawn an independent new process, like real-world use cases:
                require PublicInbox::Spawn;
                my $cmd = [ key2script($key), @argv ];
+               if (my $d = $opt->{'-C'}) {
+                       $cmd->[0] = File::Spec->rel2abs($cmd->[0]);
+                       $spawn_opt->{'-C'} = $d;
+               }
                my $pid = PublicInbox::Spawn::spawn($cmd, $env, $spawn_opt);
                if (defined $pid) {
                        my $r = waitpid($pid, 0) // die "waitpid: $!";
@@ -286,18 +328,32 @@ sub run_script ($;$$) {
        } else { # localize and run everything in the same process:
                # note: "local *STDIN = *STDIN;" and so forth did not work in
                # old versions of perl
+               my $umask = umask;
                local %ENV = $env ? (%ENV, %$env) : %ENV;
-               local %SIG = %SIG;
+               local @SIG{keys %SIG} = map { undef } values %SIG;
+               local $SIG{FPE} = 'IGNORE'; # Perl default
                local $0 = join(' ', @$cmd);
                my $orig_io = _prepare_redirects($fhref);
+               my $cwdfh = $lei_cwdfh;
+               if (my $d = $opt->{'-C'}) {
+                       unless ($cwdfh) {
+                               opendir $cwdfh, '.' or die "opendir .: $!";
+                       }
+                       chdir $d or die "chdir $d: $!";
+               }
                _run_sub($sub, $key, \@argv);
+               eval { PublicInbox::Inbox::cleanup_task() };
+               die "fchdir(restore): $!" if $cwdfh && !chdir($cwdfh);
                _undo_redirects($orig_io);
                select STDOUT;
+               umask($umask);
        }
 
+       { local $?; undef $tail };
        # slurp the redirects back into user-supplied strings
        for my $fd (1..2) {
                my $fh = $fhref->[$fd] or next;
+               next unless -f $fh;
                seek($fh, 0, SEEK_SET) or die "seek: $!";
                my $redir = $opt->{$fd};
                local $/;
@@ -312,17 +368,17 @@ sub tick (;$) {
        1;
 }
 
-sub wait_for_tail ($;$) {
+sub wait_for_tail {
        my ($tail_pid, $want) = @_;
-       my $wait = 2;
+       my $wait = 2; # "tail -F" sleeps 1.0s at-a-time w/o inotify/kevent
        if ($^O eq 'linux') { # GNU tail may use inotify
                state $tail_has_inotify;
-               return tick if $want < 0 && $tail_has_inotify;
-               my $end = time + $wait;
+               return tick if !$want && $tail_has_inotify; # before TERM
+               my $end = time + $wait; # wait for startup:
                my @ino;
                do {
                        @ino = grep {
-                               readlink($_) =~ /\binotify\b/
+                               (readlink($_) // '') =~ /\binotify\b/
                        } glob("/proc/$tail_pid/fd/*");
                } while (!@ino && time <= $end and tick);
                return if !@ino;
@@ -367,13 +423,24 @@ sub xqx {
        wantarray ? split(/^/m, $out) : $out;
 }
 
+sub tail_f (@) {
+       $tail_cmd or return; # "tail -F" or "tail -f"
+       for (@_) { open(my $fh, '>>', $_) or die $! };
+       my $cmd = [ split(/ /, $tail_cmd), @_ ];
+       require PublicInbox::Spawn;
+       my $pid = PublicInbox::Spawn::spawn($cmd, undef, { 1 => 2 });
+       wait_for_tail($pid, scalar @_);
+       require PublicInbox::AutoReap;
+       PublicInbox::AutoReap->new($pid, \&wait_for_tail);
+}
+
 sub start_script {
        my ($cmd, $env, $opt) = @_;
        my ($key, @argv) = @$cmd;
        my $run_mode = $ENV{TEST_RUN_MODE} // $opt->{run_mode} // 2;
        my $sub = $run_mode == 0 ? undef : key2sub($key);
-       my $tail_pid;
-       if (my $tail_cmd = $ENV{TAIL}) {
+       my $tail;
+       if ($tail_cmd) {
                my @paths;
                for (@argv) {
                        next unless /\A--std(?:err|out)=(.+)\z/;
@@ -391,17 +458,7 @@ sub start_script {
                                }
                        }
                }
-               if (@paths) {
-                       $tail_pid = fork // die "fork: $!";
-                       if ($tail_pid == 0) {
-                               # make sure files exist, first
-                               open my $fh, '>>', $_ for @paths;
-                               open(STDOUT, '>&STDERR') or die "1>&2: $!";
-                               exec(split(' ', $tail_cmd), @paths);
-                               die "$tail_cmd failed: $!";
-                       }
-                       wait_for_tail($tail_pid, scalar @paths);
-               }
+               $tail = tail_f(@paths);
        }
        my $pid = fork // die "fork: $!\n";
        if ($pid == 0) {
@@ -426,6 +483,7 @@ sub start_script {
                        $ENV{LISTEN_PID} = $$;
                        $ENV{LISTEN_FDS} = $fds;
                }
+               if ($opt->{-C}) { chdir($opt->{-C}) or die "chdir: $!" }
                $0 = join(' ', @$cmd);
                if ($sub) {
                        eval { PublicInbox::DS->Reset };
@@ -436,17 +494,14 @@ sub start_script {
                        die "FAIL: ",join(' ', $key, @argv), ": $!\n";
                }
        }
-       PublicInboxTestProcess->new($pid, $tail_pid);
-}
-
-sub have_xapian_compact () {
-       require PublicInbox::Spawn;
-       # $ENV{XAPIAN_COMPACT} is used by PublicInbox/Xapcmd.pm, too
-       PublicInbox::Spawn::which($ENV{XAPIAN_COMPACT} || 'xapian-compact');
+       require PublicInbox::AutoReap;
+       my $td = PublicInbox::AutoReap->new($pid);
+       $td->{-extra} = $tail;
+       $td;
 }
 
-our ($err_skip, $lei_opt, $lei_out, $lei_err);
-our $lei = sub {
+# favor lei() or lei_ok() over $lei for new code
+sub lei (@) {
        my ($cmd, $env, $xopt) = @_;
        $lei_out = $lei_err = '';
        if (!ref($cmd)) {
@@ -454,85 +509,129 @@ our $lei = sub {
                $cmd = [ grep { defined && !ref } @_ ];
        }
        my $res = run_script(['lei', @$cmd], $env, $xopt // $lei_opt);
-       $err_skip and
-               $lei_err = join('', grep(!/$err_skip/, split(/^/m, $lei_err)));
+       if ($lei_err ne '') {
+               if ($lei_err =~ /Use of uninitialized/ ||
+                       $lei_err =~ m!\bArgument .*? isn't numeric in !) {
+                       fail "lei_err=$lei_err";
+               } else {
+                       diag "lei_err=$lei_err" if $lei_loud;
+               }
+       }
        $res;
 };
 
-sub lei (@) { $lei->(@_) }
-
 sub lei_ok (@) {
-       my $msg = ref($_[-1]) ? pop(@_) : undef;
+       state $PWD = $ENV{PWD} // Cwd::getcwd();
+       my $msg = ref($_[-1]) eq 'SCALAR' ? pop(@_) : undef;
+       my $tmpdir = quotemeta(File::Spec->tmpdir);
        # filter out anything that looks like a path name for consistent logs
-       my @msg = grep(!m!\A/!, @_);
-       ok($lei->(@_), "lei @msg". ($msg ? " ($$msg)" : ''));
+       my @msg = ref($_[0]) eq 'ARRAY' ? @{$_[0]} : @_;
+       if (!$lei_loud) {
+               for (@msg) {
+                       s!\A([a-z0-9]+://)[^/]+/!$1\$HOST_PORT/!;
+                       s!$tmpdir\b/(?:[^/]+/)?!\$TMPDIR/!g;
+                       s!\Q$PWD\E\b!\$PWD!g;
+               }
+       }
+       ok(lei(@_), "lei @msg". ($msg ? " ($$msg)" : '')) or
+               diag "\$?=$? err=$lei_err";
 }
 
 sub json_utf8 () {
        state $x = ref(PublicInbox::Config->json)->new->utf8->canonical;
 }
 
+sub is_xdeeply ($$$) {
+       my ($x, $y, $desc) = @_;
+       my $ok = is_deeply($x, $y, $desc);
+       diag explain([$x, '!=', $y]) if !$ok;
+       $ok;
+}
+
+sub ignore_inline_c_missing {
+       $_[0] = join('', grep(/\S/, grep(!/compilation aborted/,
+               grep(!/\bInline\b/, split(/^/m, $_[0])))));
+}
+
 sub test_lei {
 SKIP: {
        my ($cb) = pop @_;
        my $test_opt = shift // {};
-       require_git(2.6) or skip('git 2.6+ required for lei test', 2);
-       require_mods(qw(json DBD::SQLite Search::Xapian), 2);
+       local $lei_cwdfh;
+       opendir $lei_cwdfh, '.' or xbail "opendir .: $!";
+       require_git(2.6, 1) or skip('git 2.6+ required for lei test', 2);
+       my $mods = $test_opt->{mods} // [ 'lei' ];
+       require_mods(@$mods, 2);
+
+       # set PERL_INLINE_DIRECTORY before clobbering XDG_CACHE_HOME
+       require PublicInbox::Spawn;
        require PublicInbox::Config;
-       delete local $ENV{XDG_DATA_HOME};
-       delete local $ENV{XDG_CONFIG_HOME};
-       local $ENV{GIT_COMMITTER_EMAIL} = 'lei@example.com';
-       local $ENV{GIT_COMMITTER_NAME} = 'lei user';
+       require File::Path;
+
+       local %ENV = %ENV;
+       delete $ENV{XDG_DATA_HOME};
+       delete $ENV{XDG_CONFIG_HOME};
+       delete $ENV{XDG_CACHE_HOME};
+       $ENV{GIT_COMMITTER_EMAIL} = 'lei@example.com';
+       $ENV{GIT_COMMITTER_NAME} = 'lei user';
+       $ENV{LANG} = $ENV{LC_ALL} = 'C';
        my (undef, $fn, $lineno) = caller(0);
        my $t = "$fn:$lineno";
-       require PublicInbox::Spawn;
-       state $lei_daemon = PublicInbox::Spawn->can('send_cmd4') ||
-                               eval { require Socket::MsgHdr; 1 };
-       # XXX fix and move this inside daemon-only before 1.7 release
-       skip <<'EOM', 1 unless $lei_daemon;
-Socket::MsgHdr missing or Inline::C is unconfigured/missing
-EOM
+       state $lei_daemon = PublicInbox::Spawn->can('send_cmd4') || do {
+                       require PublicInbox::Syscall;
+                       PublicInbox::Syscall->can('send_cmd4');
+               } || eval { require Socket::MsgHdr; 1 };
+       unless ($lei_daemon) {
+               skip('Inline::C unconfigured/missing '.
+'(mkdir -p ~/.cache/public-inbox/inline-c) OR Socket::MsgHdr missing',
+                       1);
+       }
        $lei_opt = { 1 => \$lei_out, 2 => \$lei_err };
-       my ($daemon_pid, $for_destroy);
+       my ($daemon_pid, $for_destroy, $daemon_xrd);
        my $tmpdir = $test_opt->{tmpdir};
+       File::Path::mkpath($tmpdir) if (defined $tmpdir && !-d $tmpdir);
        ($tmpdir, $for_destroy) = tmpdir unless $tmpdir;
+       state $persist_xrd = $ENV{TEST_LEI_DAEMON_PERSIST_DIR};
        SKIP: {
-               skip 'TEST_LEI_ONESHOT set', 1 if $ENV{TEST_LEI_ONESHOT};
+               $ENV{TEST_LEI_ONESHOT} and
+                       xbail 'TEST_LEI_ONESHOT no longer supported';
                my $home = "$tmpdir/lei-daemon";
                mkdir($home, 0700) or BAIL_OUT "mkdir: $!";
                local $ENV{HOME} = $home;
-               my $xrd = "$home/xdg_run";
-               mkdir($xrd, 0700) or BAIL_OUT "mkdir: $!";
-               local $ENV{XDG_RUNTIME_DIR} = $xrd;
+               my $persist;
+               if ($persist_xrd && !$test_opt->{daemon_only}) {
+                       $persist = $daemon_xrd = $persist_xrd;
+               } else {
+                       $daemon_xrd = "$home/xdg_run";
+                       mkdir($daemon_xrd, 0700) or BAIL_OUT "mkdir: $!";
+               }
+               local $ENV{XDG_RUNTIME_DIR} = $daemon_xrd;
                $cb->();
-               ok($lei->(qw(daemon-pid)), "daemon-pid after $t");
-               chomp($daemon_pid = $lei_out);
-               if ($daemon_pid) {
-                       ok(kill(0, $daemon_pid), "daemon running after $t");
-                       ok($lei->(qw(daemon-kill)), "daemon-kill after $t");
+               if ($persist) { # remove before ~/.local gets removed
+                       File::Path::rmtree([glob("$home/*")]);
+                       File::Path::rmtree("$home/.config");
                } else {
-                       fail("daemon not running after $t");
+                       lei_ok(qw(daemon-pid), \"daemon-pid after $t");
+                       chomp($daemon_pid = $lei_out);
+                       if (!$daemon_pid) {
+                               fail("daemon not running after $t");
+                               skip 'daemon died unexpectedly', 2;
+                       }
+                       ok(kill(0, $daemon_pid), "daemon running after $t");
+                       lei_ok(qw(daemon-kill), \"daemon-kill after $t");
                }
        }; # SKIP for lei_daemon
-       unless ($test_opt->{daemon_only}) {
-               $ENV{TEST_LEI_DAEMON_ONLY} and
-                       skip 'TEST_LEI_DAEMON_ONLY set', 1;
-               require_ok 'PublicInbox::LEI';
-               my $home = "$tmpdir/lei-oneshot";
-               mkdir($home, 0700) or BAIL_OUT "mkdir: $!";
-               local $ENV{HOME} = $home;
-               # force sun_path[108] overflow:
-               my $xrd = "$home/1shot-test".('.sun_path' x 108);
-               local $err_skip = qr!\Q$xrd!; # for $lei->() filtering
-               local $ENV{XDG_RUNTIME_DIR} = $xrd;
-               $cb->();
-       }
        if ($daemon_pid) {
                for (0..10) {
                        kill(0, $daemon_pid) or last;
                        tick;
                }
-               ok(!kill(0, $daemon_pid), "$t daemon stopped after oneshot");
+               ok(!kill(0, $daemon_pid), "$t daemon stopped");
+               my $f = "$daemon_xrd/lei/errors.log";
+               open my $fh, '<', $f or BAIL_OUT "$f: $!";
+               my @l = <$fh>;
+               is_xdeeply(\@l, [],
+                       "$t daemon XDG_RUNTIME_DIR/lei/errors.log empty");
        }
 }; # SKIP if missing git 2.6+ || Xapian || SQLite || json
 } # /test_lei
@@ -540,7 +639,7 @@ EOM
 # returns the pathname to a ~/.public-inbox/config in scalar context,
 # ($test_home, $pi_config_pathname) in list context
 sub setup_public_inboxes () {
-       my $test_home = "t/home1";
+       my $test_home = "t/home2";
        my $pi_config = "$test_home/.public-inbox/config";
        my $stamp = "$test_home/setup-stamp";
        my @ret = ($test_home, $pi_config);
@@ -554,10 +653,11 @@ sub setup_public_inboxes () {
 
        local $ENV{PI_CONFIG} = $pi_config;
        for my $V (1, 2) {
-               run_script([qw(-init), "-V$V", "t$V",
-                               '--newsgroup', "t.$V",
+               run_script([qw(-init --skip-docdata), "-V$V",
+                               '--newsgroup', "t.v$V", "t$V",
                                "$test_home/t$V", "http://example.com/t$V",
-                               "t$V\@example.com" ]) or BAIL_OUT "init v$V";
+                               "t$V\@example.com" ]) or xbail "init v$V";
+               unlink "$test_home/t$V/description" or xbail "unlink $!";
        }
        require PublicInbox::Config;
        require PublicInbox::InboxWritable;
@@ -565,6 +665,7 @@ sub setup_public_inboxes () {
        my $seen = 0;
        $cfg->each_inbox(sub {
                my ($ibx) = @_;
+               $ibx->{-no_fsync} = 1;
                my $im = PublicInbox::InboxWritable->new($ibx)->importer(0);
                my $V = $ibx->version;
                my @eml = (glob('t/*.eml'), 't/data/0001.patch');
@@ -574,49 +675,89 @@ sub setup_public_inboxes () {
                        $seen++;
                }
                $im->done;
-               if ($V == 1) {
-                       run_script(['-index', $ibx->{inboxdir}]) or
-                               BAIL_OUT 'index v1';
-               }
        });
        $seen or BAIL_OUT 'no imports';
        open my $fh, '>', $stamp or BAIL_OUT "open $stamp: $!";
        @ret;
-};
-
-package PublicInboxTestProcess;
-use strict;
-
-# prevent new threads from inheriting these objects
-sub CLONE_SKIP { 1 }
-
-sub new {
-       my ($klass, $pid, $tail_pid) = @_;
-       bless { pid => $pid, tail_pid => $tail_pid, owner => $$ }, $klass;
-}
-
-sub kill {
-       my ($self, $sig) = @_;
-       CORE::kill($sig // 'TERM', $self->{pid});
 }
 
-sub join {
-       my ($self, $sig) = @_;
-       my $pid = delete $self->{pid} or return;
-       CORE::kill($sig, $pid) if defined $sig;
-       my $ret = waitpid($pid, 0) // die "waitpid($pid): $!";
-       $ret == $pid or die "waitpid($pid) != $ret";
+sub create_inbox ($$;@) {
+       my $ident = shift;
+       my $cb = pop;
+       my %opt = @_;
+       require PublicInbox::Lock;
+       require PublicInbox::InboxWritable;
+       require PublicInbox::Import;
+       my ($base) = ($0 =~ m!\b([^/]+)\.[^\.]+\z!);
+       my ($db) = (PublicInbox::Import::default_branch() =~ m!([^/]+)\z!);
+       my $dir = "t/data-gen/$base.$ident-$db";
+       my $new = !-d $dir;
+       if ($new) {
+               mkdir $dir; # may race
+               -d $dir or BAIL_OUT "$dir could not be created: $!";
+       }
+       my $lk = bless { lock_path => "$dir/creat.lock" }, 'PublicInbox::Lock';
+       $opt{inboxdir} = File::Spec->rel2abs($dir);
+       $opt{name} //= $ident;
+       my $scope = $lk->lock_for_scope;
+       my $pre_cb = delete $opt{pre_cb};
+       $pre_cb->($dir) if $pre_cb && $new;
+       $opt{-no_fsync} = 1;
+       my $no_gc = delete $opt{-no_gc};
+       my $tmpdir = delete $opt{tmpdir};
+       my $addr = $opt{address} // [];
+       $opt{-primary_address} //= $addr->[0] // "$ident\@example.com";
+       my $parallel = delete($opt{importer_parallel}) // 0;
+       my $creat_opt = { nproc => delete($opt{nproc}) // 1 };
+       my $ibx = PublicInbox::InboxWritable->new({ %opt }, $creat_opt);
+       if (!-f "$dir/creat.stamp") {
+               my $im = $ibx->importer($parallel);
+               $cb->($im, $ibx);
+               $im->done if $im;
+               unless ($no_gc) {
+                       my @to_gc = $ibx->version == 1 ? ($ibx->{inboxdir}) :
+                                       glob("$ibx->{inboxdir}/git/*.git");
+                       for my $dir (@to_gc) {
+                               xsys_e([ qw(git gc -q) ], { GIT_DIR => $dir });
+                       }
+               }
+               open my $s, '>', "$dir/creat.stamp" or
+                       BAIL_OUT "error creating $dir/creat.stamp: $!";
+       }
+       if ($tmpdir) {
+               undef $ibx;
+               xsys([qw(/bin/cp -Rp), $dir, $tmpdir]) == 0 or
+                       BAIL_OUT "cp $dir $tmpdir";
+               $opt{inboxdir} = $tmpdir;
+               $ibx = PublicInbox::InboxWritable->new(\%opt);
+       }
+       $ibx;
 }
 
-sub DESTROY {
-       my ($self) = @_;
-       return if $self->{owner} != $$;
-       if (my $tail_pid = delete $self->{tail_pid}) {
-               PublicInbox::TestCommon::wait_for_tail($tail_pid, -1);
-               CORE::kill('TERM', $tail_pid);
+sub test_httpd ($$;$) {
+       my ($env, $client, $skip) = @_;
+       for (qw(PI_CONFIG TMPDIR)) {
+               $env->{$_} or BAIL_OUT "$_ unset";
        }
-       $self->join('TERM');
-}
+       SKIP: {
+               require_mods(qw(Plack::Test::ExternalServer), $skip // 1);
+               my $sock = tcp_server() or die;
+               my ($out, $err) = map { "$env->{TMPDIR}/std$_.log" } qw(out err);
+               my $cmd = [ qw(-httpd -W0), "--stdout=$out", "--stderr=$err" ];
+               my $td = start_script($cmd, $env, { 3 => $sock });
+               my ($h, $p) = tcp_host_port($sock);
+               local $ENV{PLACK_TEST_EXTERNALSERVER_URI} = "http://$h:$p";
+               Plack::Test::ExternalServer::test_psgi(client => $client);
+               $td->join('TERM');
+               open my $fh, '<', $err or BAIL_OUT $!;
+               my $e = do { local $/; <$fh> };
+               if ($e =~ s/^Plack::Middleware::ReverseProxy missing,\n//gms) {
+                       $e =~ s/^URL generation for redirects .*\n//gms;
+               }
+               is($e, '', 'no errors');
+       }
+};
+
 
 package PublicInbox::TestCommon::InboxWakeup;
 use strict;