* [PATCH 01/13] gcf2: take non-ref scalar request arg
2023-10-01 9:54 [PATCH 00/13] various warning/diagnostic fixes Eric Wong
@ 2023-10-01 9:54 ` Eric Wong
2023-10-01 9:54 ` [PATCH 02/13] t/git: show git_version in diag output Eric Wong
` (11 subsequent siblings)
12 siblings, 0 replies; 14+ messages in thread
From: Eric Wong @ 2023-10-01 9:54 UTC (permalink / raw)
To: meta
Asking callers to pass a scalar reference is awkward and
doesn't benefit modern Perl with CoW support. Unlike
some constant error messages, it can't save any allocations
at all since there's no constant strings being passed to
libgit2.
---
lib/PublicInbox/Gcf2Client.pm | 8 ++++----
lib/PublicInbox/GitAsyncCat.pm | 4 ++--
t/gcf2_client.t | 32 ++++++++++++++++----------------
3 files changed, 22 insertions(+), 22 deletions(-)
diff --git a/lib/PublicInbox/Gcf2Client.pm b/lib/PublicInbox/Gcf2Client.pm
index 8ac44a5e..8e313c84 100644
--- a/lib/PublicInbox/Gcf2Client.pm
+++ b/lib/PublicInbox/Gcf2Client.pm
@@ -11,6 +11,7 @@ use PublicInbox::Spawn qw(spawn);
use Socket qw(AF_UNIX SOCK_STREAM);
use PublicInbox::Syscall qw(EPOLLIN);
use PublicInbox::ProcessPipe;
+use autodie qw(socketpair);
# fields:
# sock => socket to Gcf2::loop
@@ -26,8 +27,7 @@ sub new {
my $self = bless {}, __PACKAGE__;
# ensure the child process has the same @INC we do:
my $env = { PERL5LIB => join(':', @INC) };
- my ($s1, $s2);
- socketpair($s1, $s2, AF_UNIX, SOCK_STREAM, 0) or die "socketpair $!";
+ socketpair(my $s1, my $s2, AF_UNIX, SOCK_STREAM, 0);
$s1->blocking(0);
$opt->{0} = $opt->{1} = $s2;
my $cmd = [$^X, qw[-MPublicInbox::Gcf2 -e PublicInbox::Gcf2::loop]];
@@ -41,8 +41,8 @@ sub new {
sub gcf2_async ($$$;$) {
my ($self, $req, $cb, $arg) = @_;
my $inflight = $self->{inflight} or return $self->close;
- PublicInbox::Git::write_all($self, $$req, \&cat_async_step, $inflight);
- push @$inflight, $req, $cb, $arg;
+ PublicInbox::Git::write_all($self, $req, \&cat_async_step, $inflight);
+ push @$inflight, \$req, $cb, $arg; # ref prevents Git.pm retries
}
# ensure PublicInbox::Git::cat_async_step never calls cat_async_retry
diff --git a/lib/PublicInbox/GitAsyncCat.pm b/lib/PublicInbox/GitAsyncCat.pm
index 71ee1147..f8b2a9fc 100644
--- a/lib/PublicInbox/GitAsyncCat.pm
+++ b/lib/PublicInbox/GitAsyncCat.pm
@@ -18,7 +18,7 @@ sub ibx_async_cat ($$$$) {
require PublicInbox::Gcf2Client;
PublicInbox::Gcf2Client::new();
} // 0)) { # 0: do not retry if libgit2 or Inline::C are missing
- $GCF2C->gcf2_async(\"$oid $git->{git_dir}\n", $cb, $arg);
+ $GCF2C->gcf2_async("$oid $git->{git_dir}\n", $cb, $arg);
\undef;
} else { # read-only end of git-cat-file pipe
$git->cat_async($oid, $cb, $arg);
@@ -42,7 +42,7 @@ sub ibx_async_prefetch {
if (!defined($ibx->{topdir}) && $GCF2C) {
if (!@{$GCF2C->{inflight} // []}) {
$oid .= " $git->{git_dir}\n";
- return $GCF2C->gcf2_async(\$oid, $cb, $arg); # true
+ return $GCF2C->gcf2_async($oid, $cb, $arg); # true
}
} elsif ($git->{epwatch}) {
return $git->async_prefetch($oid, $cb, $arg);
diff --git a/t/gcf2_client.t b/t/gcf2_client.t
index 6d059cad..33ee2c91 100644
--- a/t/gcf2_client.t
+++ b/t/gcf2_client.t
@@ -1,10 +1,10 @@
#!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.12;
use PublicInbox::TestCommon;
-use Test::More;
use Cwd qw(getcwd);
+use autodie qw(open close);
use PublicInbox::Import;
use PublicInbox::DS;
@@ -17,7 +17,7 @@ PublicInbox::Import::init_bare($git_a);
PublicInbox::Import::init_bare($git_b);
my $fi_data = './t/git.fast-import-data';
my $rdr = {};
-open $rdr->{0}, '<', $fi_data or BAIL_OUT $!;
+open $rdr->{0}, '<', $fi_data;
xsys([qw(git fast-import --quiet)], { GIT_DIR => $git_a }, $rdr);
is($?, 0, 'fast-import succeeded');
@@ -26,9 +26,9 @@ my $called = 0;
my $err_f = "$tmpdir/err";
{
PublicInbox::DS->Reset;
- open my $err, '>>', $err_f or BAIL_OUT $!;
+ open my $err, '>>', $err_f;
my $gcf2c = PublicInbox::Gcf2Client::new({ 2 => $err });
- $gcf2c->gcf2_async(\"$tree $git_a\n", sub {
+ $gcf2c->gcf2_async("$tree $git_a\n", sub {
my ($bref, $oid, $type, $size, $arg) = @_;
is($oid, $tree, 'got expected OID');
is($size, 30, 'got expected length');
@@ -39,12 +39,12 @@ my $err_f = "$tmpdir/err";
}, 'hi');
$gcf2c->cat_async_step($gcf2c->{inflight});
- open $err, '<', $err_f or BAIL_OUT $!;
+ open $err, '<', $err_f;
my $estr = do { local $/; <$err> };
is($estr, '', 'nothing in stderr');
my $trunc = substr($tree, 0, 39);
- $gcf2c->gcf2_async(\"$trunc $git_a\n", sub {
+ $gcf2c->gcf2_async("$trunc $git_a\n", sub {
my ($bref, $oid, $type, $size, $arg) = @_;
is(undef, $bref, 'missing bref is undef');
is($oid, $trunc, 'truncated OID printed');
@@ -55,30 +55,30 @@ my $err_f = "$tmpdir/err";
}, 'bye');
$gcf2c->cat_async_step($gcf2c->{inflight});
- open $err, '<', $err_f or BAIL_OUT $!;
+ open $err, '<', $err_f;
$estr = do { local $/; <$err> };
like($estr, qr/retrying/, 'warned about retry');
# try failed alternates lookup
PublicInbox::DS->Reset;
- open $err, '>', $err_f or BAIL_OUT $!;
+ open $err, '>', $err_f;
$gcf2c = PublicInbox::Gcf2Client::new({ 2 => $err });
- $gcf2c->gcf2_async(\"$tree $git_b\n", sub {
+ $gcf2c->gcf2_async("$tree $git_b\n", sub {
my ($bref, $oid, $type, $size, $arg) = @_;
is(undef, $bref, 'missing bref from alt is undef');
$called++;
});
$gcf2c->cat_async_step($gcf2c->{inflight});
- open $err, '<', $err_f or BAIL_OUT $!;
+ open $err, '<', $err_f;
$estr = do { local $/; <$err> };
like($estr, qr/retrying/, 'warned about retry before alt update');
# now try successful alternates lookup
- open my $alt, '>>', "$git_b/objects/info/alternates" or BAIL_OUT $!;
- print $alt "$git_a/objects\n" or BAIL_OUT $!;
- close $alt or BAIL_OUT;
+ open my $alt, '>>', "$git_b/objects/info/alternates";
+ print $alt "$git_a/objects\n";
+ close $alt;
my $expect = xqx(['git', "--git-dir=$git_a", qw(cat-file tree), $tree]);
- $gcf2c->gcf2_async(\"$tree $git_a\n", sub {
+ $gcf2c->gcf2_async("$tree $git_a\n", sub {
my ($bref, $oid, $type, $size, $arg) = @_;
is($oid, $tree, 'oid match on alternates retry');
is($$bref, $expect, 'tree content matched');
^ permalink raw reply related [flat|nested] 14+ messages in thread* [PATCH 02/13] t/git: show git_version in diag output
2023-10-01 9:54 [PATCH 00/13] various warning/diagnostic fixes Eric Wong
2023-10-01 9:54 ` [PATCH 01/13] gcf2: take non-ref scalar request arg Eric Wong
@ 2023-10-01 9:54 ` Eric Wong
2023-10-01 9:54 ` [PATCH 03/13] process_pipe: don't run `close' unless requested Eric Wong
` (10 subsequent siblings)
12 siblings, 0 replies; 14+ messages in thread
From: Eric Wong @ 2023-10-01 9:54 UTC (permalink / raw)
To: meta
This is useful to ensure we're testing properly with git <= 2.35
to ensure we don't break --batch-check support for those users.
---
t/git.t | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/t/git.t b/t/git.t
index bde6d35b..b7df6186 100644
--- a/t/git.t
+++ b/t/git.t
@@ -1,8 +1,7 @@
#!perl -w
# Copyright (C) all contributors <meta@public-inbox.org>
# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
-use strict;
-use v5.10.1;
+use v5.12;
use PublicInbox::TestCommon;
my ($dir, $for_destroy) = tmpdir();
use PublicInbox::Import;
@@ -205,4 +204,5 @@ is(git_quote($s = "hello\nworld"), '"hello\\nworld"', 'quoted LF');
is(git_quote($s = "hello\x06world"), '"hello\\006world"', 'quoted \\x06');
is(git_unquote($s = '"hello\\006world"'), "hello\x06world", 'unquoted \\x06');
-done_testing();
+diag 'git_version='.sprintf('%vd', PublicInbox::Git::git_version());
+done_testing;
^ permalink raw reply related [flat|nested] 14+ messages in thread* [PATCH 03/13] process_pipe: don't run `close' unless requested
2023-10-01 9:54 [PATCH 00/13] various warning/diagnostic fixes Eric Wong
2023-10-01 9:54 ` [PATCH 01/13] gcf2: take non-ref scalar request arg Eric Wong
2023-10-01 9:54 ` [PATCH 02/13] t/git: show git_version in diag output Eric Wong
@ 2023-10-01 9:54 ` Eric Wong
2023-10-01 9:54 ` [PATCH 04/13] git: improve error reporting Eric Wong
` (9 subsequent siblings)
12 siblings, 0 replies; 14+ messages in thread
From: Eric Wong @ 2023-10-01 9:54 UTC (permalink / raw)
To: meta
If a user is relying on reference counts to invalidate FDs
(as we do in many places), rely on them instead of explicit
`close'. This forces us to do a better job of managing refs
and avoiding redundant fields which make our code more fragile.
---
lib/PublicInbox/ProcessPipe.pm | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/lib/PublicInbox/ProcessPipe.pm b/lib/PublicInbox/ProcessPipe.pm
index 16971801..ba2c1ecb 100644
--- a/lib/PublicInbox/ProcessPipe.pm
+++ b/lib/PublicInbox/ProcessPipe.pm
@@ -58,7 +58,7 @@ sub FILENO { fileno($_[0]->{fh}) }
sub _close ($;$) {
my ($self, $wait) = @_;
my ($fh, $pid) = delete(@$self{qw(fh pid)});
- my $ret = defined($fh) ? close($fh) : '';
+ my $ret = (defined($fh) && $wait) ? close($fh) : ($fh = '');
return $ret unless defined($pid) && $self->{ppid} == $$;
if ($wait) { # caller cares about the exit status:
# synchronous wait via defined(wantarray) on awaitpid:
^ permalink raw reply related [flat|nested] 14+ messages in thread* [PATCH 04/13] git: improve error reporting
2023-10-01 9:54 [PATCH 00/13] various warning/diagnostic fixes Eric Wong
` (2 preceding siblings ...)
2023-10-01 9:54 ` [PATCH 03/13] process_pipe: don't run `close' unless requested Eric Wong
@ 2023-10-01 9:54 ` Eric Wong
2023-10-01 9:54 ` [PATCH 05/13] git: packed_bytes: deal with glob+stat TOCTTOU Eric Wong
` (8 subsequent siblings)
12 siblings, 0 replies; 14+ messages in thread
From: Eric Wong @ 2023-10-01 9:54 UTC (permalink / raw)
To: meta
We can use autodie for socketpair to handle errors for us,
but we need Time::HiRes::stat so we must write the error message
ourselves if stat-ing the git executable fails.
---
lib/PublicInbox/Git.pm | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/lib/PublicInbox/Git.pm b/lib/PublicInbox/Git.pm
index 5003be53..1dbd10b7 100644
--- a/lib/PublicInbox/Git.pm
+++ b/lib/PublicInbox/Git.pm
@@ -10,6 +10,7 @@ package PublicInbox::Git;
use strict;
use v5.10.1;
use parent qw(Exporter PublicInbox::DS);
+use autodie qw(socketpair);
use POSIX ();
use IO::Handle; # ->blocking
use Socket qw(AF_UNIX SOCK_STREAM);
@@ -57,7 +58,7 @@ my ($GIT_EXE, $GIT_VER);
sub check_git_exe () {
$GIT_EXE = which('git') // die "git not found in $ENV{PATH}";
- my @st = stat($GIT_EXE) or die "stat: $!";
+ my @st = stat($GIT_EXE) or die "stat($GIT_EXE): $!";
my $st = pack('dd', $st[10], $st[7]);
if ($st ne $EXE_ST) {
my $rd = popen_rd([ $GIT_EXE, '--version' ]);
@@ -144,8 +145,7 @@ sub last_check_err {
sub _sock_cmd {
my ($self, $batch, $err_c) = @_;
$self->{sock} and Carp::confess('BUG: {sock} exists');
- my ($s1, $s2);
- socketpair($s1, $s2, AF_UNIX, SOCK_STREAM, 0) or die "socketpair $!";
+ socketpair(my $s1, my $s2, AF_UNIX, SOCK_STREAM, 0);
$s1->blocking(0);
my $opt = { pgid => 0, 0 => $s2, 1 => $s2 };
my $gd = $self->{git_dir};
^ permalink raw reply related [flat|nested] 14+ messages in thread* [PATCH 05/13] git: packed_bytes: deal with glob+stat TOCTTOU
2023-10-01 9:54 [PATCH 00/13] various warning/diagnostic fixes Eric Wong
` (3 preceding siblings ...)
2023-10-01 9:54 ` [PATCH 04/13] git: improve error reporting Eric Wong
@ 2023-10-01 9:54 ` Eric Wong
2023-10-01 9:54 ` [PATCH 06/13] lei rediff: `git diff -O<order-file>' support Eric Wong
` (7 subsequent siblings)
12 siblings, 0 replies; 14+ messages in thread
From: Eric Wong @ 2023-10-01 9:54 UTC (permalink / raw)
To: meta
There's not much we can do about this aside from just ignoring
errors and considering un-stat-able files as zero-sized.
There's no syscalls which expose FUSE3 `readdirplus' type
functionality to userspace to avoid this problem.
---
lib/PublicInbox/Git.pm | 4 +---
1 file changed, 1 insertion(+), 3 deletions(-)
diff --git a/lib/PublicInbox/Git.pm b/lib/PublicInbox/Git.pm
index 1dbd10b7..0fd621e1 100644
--- a/lib/PublicInbox/Git.pm
+++ b/lib/PublicInbox/Git.pm
@@ -486,9 +486,7 @@ sub packed_bytes {
my ($self) = @_;
my $n = 0;
my $pack_dir = git_path($self, 'objects/pack');
- foreach my $p (bsd_glob("$pack_dir/*.pack", GLOB_NOSORT)) {
- $n += -s $p;
- }
+ $n += (-s $_ // 0) for (bsd_glob("$pack_dir/*.pack", GLOB_NOSORT));
$n
}
^ permalink raw reply related [flat|nested] 14+ messages in thread* [PATCH 06/13] lei rediff: `git diff -O<order-file>' support
2023-10-01 9:54 [PATCH 00/13] various warning/diagnostic fixes Eric Wong
` (4 preceding siblings ...)
2023-10-01 9:54 ` [PATCH 05/13] git: packed_bytes: deal with glob+stat TOCTTOU Eric Wong
@ 2023-10-01 9:54 ` Eric Wong
2023-10-01 9:54 ` [PATCH 07/13] lei: correct exit signal Eric Wong
` (6 subsequent siblings)
12 siblings, 0 replies; 14+ messages in thread
From: Eric Wong @ 2023-10-01 9:54 UTC (permalink / raw)
To: meta
We can't use the `-O' switch since it conflicts with
--only|-O= to specify externals. Thus we'll introduce
a more verbose `--order-file=FILE' option when running
`git diff'.
---
lib/PublicInbox/LEI.pm | 6 +++---
lib/PublicInbox/LeiRediff.pm | 1 +
2 files changed, 4 insertions(+), 3 deletions(-)
diff --git a/lib/PublicInbox/LEI.pm b/lib/PublicInbox/LEI.pm
index beb0f897..48c5644b 100644
--- a/lib/PublicInbox/LEI.pm
+++ b/lib/PublicInbox/LEI.pm
@@ -159,7 +159,7 @@ our @diff_opt = qw(unified|U=i output-indicator-new=s output-indicator-old=s
rename-empty! check ws-error-highlight=s full-index binary
abbrev:i break-rewrites|B:s find-renames|M:s find-copies:s
find-copies-harder irreversible-delete|D l=i diff-filter=s
- S=s G=s find-object=s pickaxe-all pickaxe-regex O=s R
+ S=s G=s find-object=s pickaxe-all pickaxe-regex R
relative:s text|a ignore-cr-at-eol ignore-space-at-eol
ignore-space-change|b ignore-all-space|w ignore-blank-lines
inter-hunk-context=i function-context|W exit-code ext-diff
@@ -198,8 +198,8 @@ our %CMD = ( # sorted in order of importance/use:
'rediff' => [ '--stdin|LOCATION...',
'regenerate a diff with different options',
'stdin|', # /|\z/ must be first for lone dash
- qw(git-dir=s@ cwd! verbose|v+ color:s no-color drq:1 dequote-only:1),
- @diff_opt, @lxs_opt, @net_opt, @c_opt ],
+ qw(git-dir=s@ cwd! verbose|v+ color:s no-color drq:1 dequote-only:1
+ order-file=s), @diff_opt, @lxs_opt, @net_opt, @c_opt ],
'mail-diff' => [ '--stdin|LOCATION...', 'diff the contents of emails',
'stdin|', # /|\z/ must be first for lone dash
diff --git a/lib/PublicInbox/LeiRediff.pm b/lib/PublicInbox/LeiRediff.pm
index efd24d17..6cc6131b 100644
--- a/lib/PublicInbox/LeiRediff.pm
+++ b/lib/PublicInbox/LeiRediff.pm
@@ -82,6 +82,7 @@ sub _lei_diff_prepare ($$) {
push @$cmd, $c ? "-$c" : "--$o";
}
}
+ push(@$cmd, "-O$opt->{'order-file'}") if $opt->{'order-file'};
}
sub diff_ctxq ($$) {
^ permalink raw reply related [flat|nested] 14+ messages in thread* [PATCH 07/13] lei: correct exit signal
2023-10-01 9:54 [PATCH 00/13] various warning/diagnostic fixes Eric Wong
` (5 preceding siblings ...)
2023-10-01 9:54 ` [PATCH 06/13] lei rediff: `git diff -O<order-file>' support Eric Wong
@ 2023-10-01 9:54 ` Eric Wong
2023-10-01 9:54 ` [PATCH 08/13] lei mail-diff: don't remove temporary subdirectory Eric Wong
` (5 subsequent siblings)
12 siblings, 0 replies; 14+ messages in thread
From: Eric Wong @ 2023-10-01 9:54 UTC (permalink / raw)
To: meta
The first argument passed to Perl signal handlers is a
signal name (e.g. "TERM") and not an integer that can
be passed to the `exit' perlop. Thus we must look up the
integer value from the POSIX module.
---
lib/PublicInbox/LEI.pm | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/lib/PublicInbox/LEI.pm b/lib/PublicInbox/LEI.pm
index 48c5644b..1b14d5e1 100644
--- a/lib/PublicInbox/LEI.pm
+++ b/lib/PublicInbox/LEI.pm
@@ -1310,9 +1310,9 @@ sub lazy_start {
local $quit = do {
my (undef, $eof_p) = PublicInbox::PktOp->pair;
sub {
- $exit_code //= shift;
+ $exit_code //= eval("POSIX::SIG$_[0] + 128") if @_;
eval 'PublicInbox::LeiNoteEvent::flush_task()';
- my $lis = $pil or exit($exit_code);
+ my $lis = $pil or exit($exit_code // 0);
# closing eof_p triggers \&noop wakeup
$listener = $eof_p = $pil = $path = undef;
$lis->close; # DS::close
^ permalink raw reply related [flat|nested] 14+ messages in thread* [PATCH 08/13] lei mail-diff: don't remove temporary subdirectory
2023-10-01 9:54 [PATCH 00/13] various warning/diagnostic fixes Eric Wong
` (6 preceding siblings ...)
2023-10-01 9:54 ` [PATCH 07/13] lei: correct exit signal Eric Wong
@ 2023-10-01 9:54 ` Eric Wong
2023-10-01 9:54 ` [PATCH 09/13] lei_store: unlink stderr buffer early Eric Wong
` (4 subsequent siblings)
12 siblings, 0 replies; 14+ messages in thread
From: Eric Wong @ 2023-10-01 9:54 UTC (permalink / raw)
To: meta
->{curdir} is localized inside MailDiff->dump_eml anyways, so it
was attempting to remove `undef' :x. Since most messages don't
have too many attachments, save some opcodes on our end and just
let File::Temp::Dir->DESTROY handle all the cleanup.
---
lib/PublicInbox/LeiMailDiff.pm | 2 --
1 file changed, 2 deletions(-)
diff --git a/lib/PublicInbox/LeiMailDiff.pm b/lib/PublicInbox/LeiMailDiff.pm
index 5e2e4b0b..af6ecf82 100644
--- a/lib/PublicInbox/LeiMailDiff.pm
+++ b/lib/PublicInbox/LeiMailDiff.pm
@@ -7,7 +7,6 @@ package PublicInbox::LeiMailDiff;
use v5.12;
use parent qw(PublicInbox::IPC PublicInbox::LeiInput PublicInbox::MailDiff);
use PublicInbox::Spawn qw(run_wait);
-use File::Path ();
require PublicInbox::LeiRediff;
sub diff_a ($$) {
@@ -21,7 +20,6 @@ sub diff_a ($$) {
my $rdr = { -C => "$self->{tmp}" };
@$rdr{1, 2} = @$lei{1, 2};
run_wait($cmd, $lei->{env}, $rdr) and $lei->child_error($?);
- File::Path::remove_tree($self->{curdir});
}
sub input_eml_cb { # used by PublicInbox::LeiInput::input_fh
^ permalink raw reply related [flat|nested] 14+ messages in thread* [PATCH 09/13] lei_store: unlink stderr buffer early
2023-10-01 9:54 [PATCH 00/13] various warning/diagnostic fixes Eric Wong
` (7 preceding siblings ...)
2023-10-01 9:54 ` [PATCH 08/13] lei mail-diff: don't remove temporary subdirectory Eric Wong
@ 2023-10-01 9:54 ` Eric Wong
2023-10-01 9:54 ` [PATCH 10/13] overidx: fix version comparison Eric Wong
` (3 subsequent siblings)
12 siblings, 0 replies; 14+ messages in thread
From: Eric Wong @ 2023-10-01 9:54 UTC (permalink / raw)
To: meta
While we're at it, ensure we clear the Perl internal EOF
marker before attempting to read the appended-to file
handle since newer Perl may leave the internal EOF marker set.
---
lib/PublicInbox/LeiStore.pm | 15 ++++++++-------
1 file changed, 8 insertions(+), 7 deletions(-)
diff --git a/lib/PublicInbox/LeiStore.pm b/lib/PublicInbox/LeiStore.pm
index 727de066..9923ec3f 100644
--- a/lib/PublicInbox/LeiStore.pm
+++ b/lib/PublicInbox/LeiStore.pm
@@ -27,7 +27,7 @@ use PublicInbox::MDA;
use PublicInbox::Spawn qw(spawn);
use PublicInbox::MdirReader;
use PublicInbox::LeiToMail;
-use File::Temp ();
+use File::Temp qw(tmpnam);
use POSIX ();
use IO::Handle (); # ->autoflush
use Sys::Syslog qw(syslog openlog);
@@ -110,7 +110,9 @@ sub search {
# follows the stderr file
sub _tail_err {
my ($self) = @_;
- print { $self->{-err_wr} } readline($self->{-tmp_err});
+ my $err = $self->{-tmp_err} // return;
+ $err->clearerr; # clear EOF marker
+ print { $self->{-err_wr} } readline($err);
}
sub eidx_init {
@@ -566,11 +568,10 @@ sub xchg_stderr {
_tail_err($self) if $self->{-err_wr};
my $dir = $self->{priv_eidx}->{topdir};
return unless -e $dir;
- my $old = delete $self->{-tmp_err};
- my $pfx = POSIX::strftime('%Y%m%d%H%M%S', gmtime(time));
- my $err = File::Temp->new(TEMPLATE => "$pfx.$$.err-XXXX",
- SUFFIX => '.err', DIR => $dir);
- open STDERR, '>>', $err->filename or die "dup2: $!";
+ delete $self->{-tmp_err};
+ my ($err, $name) = tmpnam();
+ open STDERR, '>>', $name or die "dup2: $!";
+ unlink($name);
STDERR->autoflush(1); # shared with shard subprocesses
$self->{-tmp_err} = $err; # separate file description for RO access
undef;
^ permalink raw reply related [flat|nested] 14+ messages in thread* [PATCH 10/13] overidx: fix version comparison
2023-10-01 9:54 [PATCH 00/13] various warning/diagnostic fixes Eric Wong
` (8 preceding siblings ...)
2023-10-01 9:54 ` [PATCH 09/13] lei_store: unlink stderr buffer early Eric Wong
@ 2023-10-01 9:54 ` Eric Wong
2023-10-01 9:54 ` [PATCH 11/13] treewide: enable warnings in all exec-ed processes Eric Wong
` (2 subsequent siblings)
12 siblings, 0 replies; 14+ messages in thread
From: Eric Wong @ 2023-10-01 9:54 UTC (permalink / raw)
To: meta
We can't use $DBD::SQLite::sqlite_version_number with older versions of
DBD::SQLite. Thus we need to treat the $DBD::SQLite::sqlite_version
string (e.g. "3.8.3", not v-string) and convert it to a v-string with
eval for version comparisons to determine if we can fork multiple
children when using SQLite.
Fixes: fa04201baae9 ("lei: force --jobs=1,1 for SQLite < 3.8.3")
---
lib/PublicInbox/OverIdx.pm | 9 +++++----
1 file changed, 5 insertions(+), 4 deletions(-)
diff --git a/lib/PublicInbox/OverIdx.pm b/lib/PublicInbox/OverIdx.pm
index 6cc86d5d..5cea3706 100644
--- a/lib/PublicInbox/OverIdx.pm
+++ b/lib/PublicInbox/OverIdx.pm
@@ -671,13 +671,14 @@ sub vivify_xvmd {
}
sub fork_ok {
- return 1 if $DBD::SQLite::sqlite_version >= 3008003;
+ state $fork_ok = eval("v$DBD::SQLite::sqlite_version") ge v3.8.3;
+ return 1 if $fork_ok;
my ($opt) = @_;
my @j = split(/,/, $opt->{jobs} // '');
state $warned;
- grep { $_ > 1 } @j and $warned //= warn('DBD::SQLite version is ',
- $DBD::SQLite::sqlite_version,
- ", need >= 3008003 (3.8.3) for --jobs > 1\n");
+ grep { $_ > 1 } @j and $warned //= warn(<<EOM);
+DBD::SQLite version is v$DBD::SQLite::sqlite_version, need >= v3.8.3 for --jobs > 1
+EOM
$opt->{jobs} = '1,1';
undef;
}
^ permalink raw reply related [flat|nested] 14+ messages in thread* [PATCH 11/13] treewide: enable warnings in all exec-ed processes
2023-10-01 9:54 [PATCH 00/13] various warning/diagnostic fixes Eric Wong
` (9 preceding siblings ...)
2023-10-01 9:54 ` [PATCH 10/13] overidx: fix version comparison Eric Wong
@ 2023-10-01 9:54 ` Eric Wong
2023-10-01 9:54 ` [PATCH 12/13] lei: ->fail only allows integer exit codes Eric Wong
2023-10-01 9:54 ` [PATCH 13/13] lei: deal with clients with blocked stderr Eric Wong
12 siblings, 0 replies; 14+ messages in thread
From: Eric Wong @ 2023-10-01 9:54 UTC (permalink / raw)
To: meta
While forked processes inherit from the parent, exec-ed
processes need the `-w' flag passed to them. To determine
whether or not we should pass them, we must check the `$^W'
global perlvar, first.
We'll also favor `perl -e' over `perl -E' in places where
we don't rely on the latest features, since `-E' incurs
slightly more startup time overhead from loading feature.pm
(while `perl -Mv5.12' does not).
---
lib/PublicInbox/Gcf2Client.pm | 3 ++-
lib/PublicInbox/LeiRediff.pm | 4 ++--
script/lei | 4 ++--
t/edit.t | 29 +++++++++++++++--------------
t/extsearch.t | 2 +-
t/lei-q-save.t | 4 ++--
t/mbox_reader.t | 6 +++---
t/spawn.t | 4 ++--
8 files changed, 29 insertions(+), 27 deletions(-)
diff --git a/lib/PublicInbox/Gcf2Client.pm b/lib/PublicInbox/Gcf2Client.pm
index 8e313c84..4a0348b4 100644
--- a/lib/PublicInbox/Gcf2Client.pm
+++ b/lib/PublicInbox/Gcf2Client.pm
@@ -30,7 +30,8 @@ sub new {
socketpair(my $s1, my $s2, AF_UNIX, SOCK_STREAM, 0);
$s1->blocking(0);
$opt->{0} = $opt->{1} = $s2;
- my $cmd = [$^X, qw[-MPublicInbox::Gcf2 -e PublicInbox::Gcf2::loop]];
+ my $cmd = [$^X, $^W ? ('-w') : (),
+ qw[-MPublicInbox::Gcf2 -e PublicInbox::Gcf2::loop]];
my $pid = spawn($cmd, $env, $opt);
my $sock = PublicInbox::ProcessPipe->maybe_new($pid, $s1);
$self->{inflight} = [];
diff --git a/lib/PublicInbox/LeiRediff.pm b/lib/PublicInbox/LeiRediff.pm
index 6cc6131b..a886931c 100644
--- a/lib/PublicInbox/LeiRediff.pm
+++ b/lib/PublicInbox/LeiRediff.pm
@@ -140,7 +140,7 @@ EOM
sub wait_requote { # OnDestroy callback
my ($lei, $pid, $old_1) = @_;
- $lei->{1} = $old_1; # closes stdin of `perl -pE 's/^/> /'`
+ $lei->{1} = $old_1; # closes stdin of `perl -pe 's/^/> /'`
waitpid($pid, 0) == $pid or die "BUG(?) waitpid: \$!=$! \$?=$?";
$lei->child_error($?) if $?;
}
@@ -150,7 +150,7 @@ sub requote ($$) {
my $old_1 = $lei->{1};
my $opt = { 1 => $old_1, 2 => $lei->{2} };
# $^X (perl) is overkill, but maybe there's a weird system w/o sed
- my ($w, $pid) = popen_wr([$^X, '-pE', "s/^/$pfx/"], $lei->{env}, $opt);
+ my ($w, $pid) = popen_wr([$^X, '-pe', "s/^/$pfx/"], $lei->{env}, $opt);
$w->autoflush(1);
binmode $w, ':utf8'; # incompatible with ProcessPipe due to syswrite
$lei->{1} = $w;
diff --git a/script/lei b/script/lei
index a77ea880..1d90be0a 100755
--- a/script/lei
+++ b/script/lei
@@ -92,8 +92,8 @@ my $addr = pack_sockaddr_un($path);
socket($sock, AF_UNIX, SOCK_SEQPACKET, 0) or die "socket: $!";
unless (connect($sock, $addr)) { # start the daemon if not started
local $ENV{PERL5LIB} = join(':', @INC);
- open(my $daemon, '-|', $^X, qw[-MPublicInbox::LEI
- -E PublicInbox::LEI::lazy_start(@ARGV)],
+ open(my $daemon, '-|', $^X, $^W ? ('-w') : (),
+ qw[-MPublicInbox::LEI -e PublicInbox::LEI::lazy_start(@ARGV)],
$path, $! + 0, $narg) or die "popen: $!";
while (<$daemon>) { warn $_ } # EOF when STDERR is redirected
close($daemon) or warn <<"";
diff --git a/t/edit.t b/t/edit.t
index e6e0f9cf..1621df3b 100644
--- a/t/edit.t
+++ b/t/edit.t
@@ -1,5 +1,5 @@
#!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>
# edit frontend behavior test (t/replace.t for backend)
use strict;
@@ -24,10 +24,11 @@ local $ENV{PI_CONFIG} = $cfgfile;
my ($in, $out, $err, $cmd, $cur, $t);
my $git = PublicInbox::Git->new("$ibx->{inboxdir}/git/0.git");
my $opt = { 0 => \$in, 1 => \$out, 2 => \$err };
+my $ipe = "$^X -w -i -p -e";
$t = '-F FILE'; {
$in = $out = $err = '';
- local $ENV{MAIL_EDITOR} = "$^X -i -p -e 's/boolean prefix/bool pfx/'";
+ local $ENV{MAIL_EDITOR} = "$ipe 's/boolean prefix/bool pfx/'";
$cmd = [ '-edit', "-F$file", $inboxdir ];
ok(run_script($cmd, undef, $opt), "$t edit OK");
$cur = PublicInbox::Eml->new($ibx->msg_by_mid($mid));
@@ -37,7 +38,7 @@ $t = '-F FILE'; {
$t = '-m MESSAGE_ID'; {
$in = $out = $err = '';
- local $ENV{MAIL_EDITOR} = "$^X -i -p -e 's/bool pfx/boolean prefix/'";
+ local $ENV{MAIL_EDITOR} = "$ipe 's/bool pfx/boolean prefix/'";
$cmd = [ '-edit', "-m$mid", $inboxdir ];
ok(run_script($cmd, undef, $opt), "$t edit OK");
$cur = PublicInbox::Eml->new($ibx->msg_by_mid($mid));
@@ -48,7 +49,7 @@ $t = '-m MESSAGE_ID'; {
$t = 'no-op -m MESSAGE_ID'; {
$in = $out = $err = '';
my $before = $git->qx(qw(rev-parse HEAD));
- local $ENV{MAIL_EDITOR} = "$^X -i -p -e 's/bool pfx/boolean prefix/'";
+ local $ENV{MAIL_EDITOR} = "$ipe 's/bool pfx/boolean prefix/'";
$cmd = [ '-edit', "-m$mid", $inboxdir ];
ok(run_script($cmd, undef, $opt), "$t succeeds");
my $prev = $cur;
@@ -64,7 +65,7 @@ $t = 'no-op -m MESSAGE_ID'; {
$t = 'no-op -m MESSAGE_ID w/Status: header'; { # because mutt does it
$in = $out = $err = '';
my $before = $git->qx(qw(rev-parse HEAD));
- local $ENV{MAIL_EDITOR} = "$^X -i -p -e 's/^Subject:.*/Status: RO\\n\$&/'";
+ local $ENV{MAIL_EDITOR} = "$ipe 's/^Subject:.*/Status: RO\\n\$&/'";
$cmd = [ '-edit', "-m$mid", $inboxdir ];
ok(run_script($cmd, undef, $opt), "$t succeeds");
my $prev = $cur;
@@ -80,7 +81,7 @@ $t = 'no-op -m MESSAGE_ID w/Status: header'; { # because mutt does it
$t = '-m MESSAGE_ID can change Received: headers'; {
$in = $out = $err = '';
- local $ENV{MAIL_EDITOR} = "$^X -i -p -e 's/^Subject:.*/Received: x\\n\$&/'";
+ local $ENV{MAIL_EDITOR} = "$ipe 's/^Subject:.*/Received: x\\n\$&/'";
$cmd = [ '-edit', "-m$mid", $inboxdir ];
ok(run_script($cmd, undef, $opt), "$t succeeds");
$cur = PublicInbox::Eml->new($ibx->msg_by_mid($mid));
@@ -91,7 +92,7 @@ $t = '-m MESSAGE_ID can change Received: headers'; {
$t = '-m miss'; {
$in = $out = $err = '';
- local $ENV{MAIL_EDITOR} = "$^X -i -p -e 's/boolean/FAIL/'";
+ local $ENV{MAIL_EDITOR} = "$ipe 's/boolean/FAIL/'";
$cmd = [ '-edit', "-m$mid-miss", $inboxdir ];
ok(!run_script($cmd, undef, $opt), "$t fails on invalid MID");
like($err, qr/No message found/, "$t shows error");
@@ -99,7 +100,7 @@ $t = '-m miss'; {
$t = 'non-interactive editor failure'; {
$in = $out = $err = '';
- local $ENV{MAIL_EDITOR} = "$^X -i -p -e 'END { exit 1 }'";
+ local $ENV{MAIL_EDITOR} = "$ipe 'END { exit 1 }'";
$cmd = [ '-edit', "-m$mid", $inboxdir ];
ok(!run_script($cmd, undef, $opt), "$t detected");
like($err, qr/END \{ exit 1 \}' failed:/, "$t shows error");
@@ -109,7 +110,7 @@ $t = 'mailEditor set in config'; {
$in = $out = $err = '';
my $rc = xsys(qw(git config), "--file=$cfgfile",
'publicinbox.maileditor',
- "$^X -i -p -e 's/boolean prefix/bool pfx/'");
+ "$ipe 's/boolean prefix/bool pfx/'");
is($rc, 0, 'set publicinbox.mailEditor');
local $ENV{MAIL_EDITOR};
delete $ENV{MAIL_EDITOR};
@@ -123,20 +124,20 @@ $t = 'mailEditor set in config'; {
$t = '--raw and mbox escaping'; {
$in = $out = $err = '';
- local $ENV{MAIL_EDITOR} = "$^X -i -p -e 's/^\$/\\nFrom not mbox\\n/'";
+ local $ENV{MAIL_EDITOR} = "$ipe 's/^\$/\\nFrom not mbox\\n/'";
$cmd = [ '-edit', "-m$mid", '--raw', $inboxdir ];
ok(run_script($cmd, undef, $opt), "$t succeeds");
$cur = PublicInbox::Eml->new($ibx->msg_by_mid($mid));
like($cur->body, qr/^From not mbox/sm, 'put "From " line into body');
- local $ENV{MAIL_EDITOR} = "$^X -i -p -e 's/^>From not/\$& an/'";
+ local $ENV{MAIL_EDITOR} = "$ipe 's/^>From not/\$& an/'";
$cmd = [ '-edit', "-m$mid", $inboxdir ];
ok(run_script($cmd, undef, $opt), "$t succeeds with mbox escaping");
$cur = PublicInbox::Eml->new($ibx->msg_by_mid($mid));
like($cur->body, qr/^From not an mbox/sm,
'changed "From " line unescaped');
- local $ENV{MAIL_EDITOR} = "$^X -i -p -e 's/^From not an mbox\\n//s'";
+ local $ENV{MAIL_EDITOR} = "$ipe 's/^From not an mbox\\n//s'";
$cmd = [ '-edit', "-m$mid", '--raw', $inboxdir ];
ok(run_script($cmd, undef, $opt), "$t succeeds again");
$cur = PublicInbox::Eml->new($ibx->msg_by_mid($mid));
@@ -154,7 +155,7 @@ $t = 'reuse Message-ID'; {
$t = 'edit ambiguous Message-ID with -m'; {
$in = $out = $err = '';
- local $ENV{MAIL_EDITOR} = "$^X -i -p -e 's/bool pfx/boolean prefix/'";
+ local $ENV{MAIL_EDITOR} = "$ipe 's/bool pfx/boolean prefix/'";
$cmd = [ '-edit', "-m$mid", $inboxdir ];
ok(!run_script($cmd, undef, $opt), "$t fails w/o --force");
like($err, qr/Multiple messages with different content found matching/,
@@ -164,7 +165,7 @@ $t = 'edit ambiguous Message-ID with -m'; {
$t .= ' and --force'; {
$in = $out = $err = '';
- local $ENV{MAIL_EDITOR} = "$^X -i -p -e 's/^Subject:.*/Subject:x/i'";
+ local $ENV{MAIL_EDITOR} = "$ipe 's/^Subject:.*/Subject:x/i'";
$cmd = [ '-edit', "-m$mid", '--force', $inboxdir ];
ok(run_script($cmd, undef, $opt), "$t succeeds");
like($err, qr/Will edit all of them/, "$t notes all will be edited");
diff --git a/t/extsearch.t b/t/extsearch.t
index 19eaf3b5..2995cf95 100644
--- a/t/extsearch.t
+++ b/t/extsearch.t
@@ -151,7 +151,7 @@ if ('inbox edited') {
my ($in, $out, $err);
$in = $out = $err = '';
my $opt = { 0 => \$in, 1 => \$out, 2 => \$err };
- my $env = { MAIL_EDITOR => "$^X -i -p -e 's/test message/BEST MSG/'" };
+ my $env = { MAIL_EDITOR => "$^X -w -i -p -e 's/test message/BEST MSG/'" };
my $cmd = [ qw(-edit -Ft/utf8.eml), "$home/v2test" ];
ok(run_script($cmd, $env, $opt), '-edit');
ok(run_script([qw(-extindex --all), "$home/extindex"], undef, $opt),
diff --git a/t/lei-q-save.t b/t/lei-q-save.t
index d09c8397..1d9d5a51 100644
--- a/t/lei-q-save.t
+++ b/t/lei-q-save.t
@@ -227,7 +227,7 @@ test_lei(sub {
my @lss = glob("$home/" .
'.local/share/lei/saved-searches/*/lei.saved-search');
my $out = xqx([qw(git config -f), $lss[0], 'lei.q.output']);
- xsys($^X, qw(-i -p -e), "s/\\[/\\0/", $lss[0])
+ xsys($^X, qw(-w -i -p -e), "s/\\[/\\0/", $lss[0])
and xbail "-ipe $lss[0]: $?";
lei_ok qw(ls-search);
like($lei_err, qr/bad config line.*?\Q$lss[0]\E/,
@@ -235,7 +235,7 @@ test_lei(sub {
lei_ok qw(up --all), \'up works with bad config';
like($lei_err, qr/bad config line.*?\Q$lss[0]\E/,
'git config parse error shown w/ lei up');
- xsys($^X, qw(-i -p -e), "s/\\0/\\[/", $lss[0])
+ xsys($^X, qw(-w -i -p -e), "s/\\0/\\[/", $lss[0])
and xbail "-ipe $lss[0]: $?";
lei_ok qw(ls-search);
is($lei_err, '', 'no errors w/ fixed config');
diff --git a/t/mbox_reader.t b/t/mbox_reader.t
index 87e8f397..14248a2d 100644
--- a/t/mbox_reader.t
+++ b/t/mbox_reader.t
@@ -113,10 +113,10 @@ EOM
SKIP: {
use PublicInbox::Spawn qw(popen_rd);
- my $fh = popen_rd([ $^X, '-E', <<'' ]);
-say "From x@y Fri Oct 2 00:00:00 1993";
+ my $fh = popen_rd([ $^X, qw(-w -Mv5.12 -e), <<'' ]);
+say 'From x@y Fri Oct 2 00:00:00 1993';
print "a: b\n\n", "x" x 70000, "\n\n";
-say "From x@y Fri Oct 2 00:00:00 2010";
+say 'From x@y Fri Oct 2 00:00:00 2010';
print "Final: bit\n\n", "Incomplete\n\n";
exit 1
diff --git a/t/spawn.t b/t/spawn.t
index 9ed3be36..04589437 100644
--- a/t/spawn.t
+++ b/t/spawn.t
@@ -62,7 +62,7 @@ elsif ($pid > 0) {
}
EOF
my $oldset = PublicInbox::DS::block_signals();
- my $rd = popen_rd([$^X, '-e', $script]);
+ my $rd = popen_rd([$^X, qw(-w -e), $script]);
diag 'waiting for child to reap grandchild...';
chomp(my $line = readline($rd));
my ($rdy, $pid) = split(/ /, $line);
@@ -185,7 +185,7 @@ SKIP: {
require BSD::Resource;
defined(BSD::Resource::RLIMIT_CPU())
} or skip 'BSD::Resource::RLIMIT_CPU missing', 3;
- my $cmd = [ $^X, ($^W ? ('-w') : ()), '-e', <<'EOM' ];
+ my $cmd = [ $^X, qw(-w -e), <<'EOM' ];
use POSIX qw(:signal_h);
use BSD::Resource qw(times);
use Time::HiRes qw(time); # gettimeofday
^ permalink raw reply related [flat|nested] 14+ messages in thread* [PATCH 12/13] lei: ->fail only allows integer exit codes
2023-10-01 9:54 [PATCH 00/13] various warning/diagnostic fixes Eric Wong
` (10 preceding siblings ...)
2023-10-01 9:54 ` [PATCH 11/13] treewide: enable warnings in all exec-ed processes Eric Wong
@ 2023-10-01 9:54 ` Eric Wong
2023-10-01 9:54 ` [PATCH 13/13] lei: deal with clients with blocked stderr Eric Wong
12 siblings, 0 replies; 14+ messages in thread
From: Eric Wong @ 2023-10-01 9:54 UTC (permalink / raw)
To: meta
We can't use floating point numbers nor Inf/-Inf as exit codes;
but we can allow `-1' as shorthand for 255.
---
lib/PublicInbox/LEI.pm | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/lib/PublicInbox/LEI.pm b/lib/PublicInbox/LEI.pm
index 1b14d5e1..1899bf38 100644
--- a/lib/PublicInbox/LEI.pm
+++ b/lib/PublicInbox/LEI.pm
@@ -524,7 +524,7 @@ sub sigpipe_handler { # handles SIGPIPE from @WQ_KEYS workers
sub fail ($;@) {
my ($lei, @msg) = @_;
- my $exit_code = looks_like_number($msg[0]) ? shift(@msg) : undef;
+ my $exit_code = ($msg[0]//'') =~ /\A-?[0-9]+\z/ ? shift(@msg) : undef;
local $current_lei = $lei;
$lei->{failed}++;
if (@msg) {
^ permalink raw reply related [flat|nested] 14+ messages in thread* [PATCH 13/13] lei: deal with clients with blocked stderr
2023-10-01 9:54 [PATCH 00/13] various warning/diagnostic fixes Eric Wong
` (11 preceding siblings ...)
2023-10-01 9:54 ` [PATCH 12/13] lei: ->fail only allows integer exit codes Eric Wong
@ 2023-10-01 9:54 ` Eric Wong
12 siblings, 0 replies; 14+ messages in thread
From: Eric Wong @ 2023-10-01 9:54 UTC (permalink / raw)
To: meta
lei/store can get stuck if lei-daemon is blocked, and lei-daemon
can get stuck when a clients stderr is redirected to a pager
that isn't consumed.
So start relying on Time::HiRes::alarm to generate SIGALRM to
break out of the `print' perlop. Unfortunately, this isn't easy
since Perl auto-restarts all writes, so we dup(2) the
destination FD and close the copy in the SIGALRM handler to
force `print' to return.
Most programs (MUAs, editors, etc.) aren't equipped to deal with
non-blocking STDERR, so we can't make the stderr file description
non-blocking.
Another way to solve this problem would be to have script/lei
send a non-blocking pipe to lei-daemon in the {2} slot and
make script/lei splice messages from the pipe to stderr.
Unfortunately, that requires more work and forces more
complexity into script/lei and slow down normal cases where
stderr doesn't get blocked.
---
lib/PublicInbox/LEI.pm | 3 ++-
lib/PublicInbox/LeiStore.pm | 8 ++++++--
lib/PublicInbox/LeiStoreErr.pm | 27 +++++++++++++++++++++++++--
3 files changed, 33 insertions(+), 5 deletions(-)
diff --git a/lib/PublicInbox/LEI.pm b/lib/PublicInbox/LEI.pm
index 1899bf38..06bc7ebd 100644
--- a/lib/PublicInbox/LEI.pm
+++ b/lib/PublicInbox/LEI.pm
@@ -1287,7 +1287,7 @@ sub lazy_start {
undef $lk;
my @st = stat($path) or die "stat($path): $!";
my $dev_ino_expect = pack('dd', $st[0], $st[1]); # dev+ino
- local $oldset = PublicInbox::DS::block_signals();
+ local $oldset = PublicInbox::DS::block_signals(POSIX::SIGALRM);
die "incompatible narg=$narg" if $narg != 5;
$PublicInbox::IPC::send_cmd or die <<"";
(Socket::MsgHdr || Inline::C) missing/unconfigured (narg=$narg);
@@ -1369,6 +1369,7 @@ sub lazy_start {
strftime('%Y-%m-%dT%H:%M:%SZ', gmtime(time))," $$ ", @_);
};
local $SIG{PIPE} = 'IGNORE';
+ local $SIG{ALRM} = 'IGNORE';
open STDERR, '>&STDIN' or die "redirect stderr failed: $!";
open STDOUT, '>&STDIN' or die "redirect stdout failed: $!";
# $daemon pipe to `lei' closed, main loop begins:
diff --git a/lib/PublicInbox/LeiStore.pm b/lib/PublicInbox/LeiStore.pm
index 9923ec3f..0cb78f79 100644
--- a/lib/PublicInbox/LeiStore.pm
+++ b/lib/PublicInbox/LeiStore.pm
@@ -33,6 +33,7 @@ use IO::Handle (); # ->autoflush
use Sys::Syslog qw(syslog openlog);
use Errno qw(EEXIST ENOENT);
use PublicInbox::Syscall qw(rename_noreplace);
+use PublicInbox::LeiStoreErr;
sub new {
my (undef, $dir, $opt) = @_;
@@ -112,7 +113,10 @@ sub _tail_err {
my ($self) = @_;
my $err = $self->{-tmp_err} // return;
$err->clearerr; # clear EOF marker
- print { $self->{-err_wr} } readline($err);
+ my @msg = readline($err);
+ PublicInbox::LeiStoreErr::emit($self->{-err_wr}, @msg) and return;
+ # syslog is the last resort if lei-daemon broke
+ syslog('warning', '%s', $_) for @msg;
}
sub eidx_init {
@@ -627,12 +631,12 @@ sub write_prepare {
# Mail we import into lei are private, so headers filtered out
# by -mda for public mail are not appropriate
local @PublicInbox::MDA::BAD_HEADERS = ();
+ local $SIG{ALRM} = 'IGNORE';
$self->wq_workers_start("lei/store $dir", 1, $lei->oldset, {
lei => $lei,
-err_wr => $w,
to_close => [ $r ],
}, \&_sto_atexit);
- require PublicInbox::LeiStoreErr;
PublicInbox::LeiStoreErr->new($r, $lei);
}
$lei->{sto} = $self;
diff --git a/lib/PublicInbox/LeiStoreErr.pm b/lib/PublicInbox/LeiStoreErr.pm
index 47fa2277..fe4af51e 100644
--- a/lib/PublicInbox/LeiStoreErr.pm
+++ b/lib/PublicInbox/LeiStoreErr.pm
@@ -9,6 +9,30 @@ use parent qw(PublicInbox::DS);
use PublicInbox::Syscall qw(EPOLLIN);
use Sys::Syslog qw(openlog syslog closelog);
use IO::Handle (); # ->blocking
+use Time::HiRes ();
+use autodie qw(open);
+our $err_wr;
+
+# We don't want blocked stderr on clients to block lei/store or lei-daemon.
+# We can't make stderr non-blocking since it can break MUAs or anything
+# lei might spawn. So we setup a timer to wake us up after a second if
+# printing to a user's stderr hasn't completed, yet. Unfortunately,
+# EINTR alone isn't enough since Perl auto-restarts writes on signals,
+# so to interrupt writes to clients with blocked stderr, we dup the
+# error output to $err_wr ahead-of-time and close $err_wr in the
+# SIGALRM handler to ensure `print' gets aborted:
+
+sub abort_err_wr { close($err_wr) if $err_wr; undef $err_wr }
+
+sub emit ($@) {
+ my ($efh, @msg) = @_;
+ open(local $err_wr, '>&', $efh); # fdopen(dup(fileno($efh)), "w")
+ local $SIG{ALRM} = \&abort_err_wr;
+ Time::HiRes::alarm(1.0, 0.1);
+ my $ret = print $err_wr @msg;
+ Time::HiRes::alarm(0);
+ $ret;
+}
sub new {
my ($cls, $rd, $lei) = @_;
@@ -26,8 +50,7 @@ sub event_step {
for my $lei (values %PublicInbox::DS::DescriptorMap) {
my $cb = $lei->can('store_path') // next;
next if $cb->($lei) ne $self->{store_path};
- my $err = $lei->{2} // next;
- print $err $buf and $printed = 1;
+ emit($lei->{2} // next, $buf) and $printed = 1;
}
if (!$printed) {
openlog('lei/store', 'pid,nowait,nofatal,ndelay', 'user');
^ permalink raw reply related [flat|nested] 14+ messages in thread