[PATCH] t/imapd: workaround a Perl 5.36.0 readline regression

[Eric Wong <e@80x24.org>]

Buffered readline (and read) ops under Perl 5.36.0 fails to read
new data after writes are made by other file handles (or
processes).

To fix and improve our test, introduce a new, (currently)
test-only TailNotify class to use inotify or kevent if available
to workaround it while avoiding infinite polling loops.  Further
refinements to these test APIs since we use the same pattern for
testing daemons in many places.

This also fixes the TEST_KILL_IMAPD condition in t/imapd.t under
GNU/Linux, AFAIK that test was never reliable under FreeBSD.

Link: https://bugs.debian.org/1040947
---
 Broken SSD leads to upgrading to Debian bookworm earlier than I
 anticipated, which lead to chasing more nasty bugs....
 And I think the SSD is dying, too, or my ancient laptop
 is prone to destroying SSDs :<

 MANIFEST                      |   1 +
 lib/PublicInbox/TailNotify.pm |  89 ++++++++++++++++++++++++++++
 t/imapd.t                     | 105 +++++++++++++++++++++-------------
 t/tail_notify.t               |  38 ++++++++++++
 4 files changed, 192 insertions(+), 41 deletions(-)
 create mode 100644 lib/PublicInbox/TailNotify.pm
 create mode 100644 t/tail_notify.t

diff --git a/MANIFEST b/MANIFEST
index dc895016..52883835 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -338,6 +338,7 @@ lib/PublicInbox/Spawn.pm
 lib/PublicInbox/SpawnPP.pm
 lib/PublicInbox/Syscall.pm
 lib/PublicInbox/TLS.pm
+lib/PublicInbox/TailNotify.pm
 lib/PublicInbox/TestCommon.pm
 lib/PublicInbox/Tmpfile.pm
 lib/PublicInbox/URIimap.pm
diff --git a/lib/PublicInbox/TailNotify.pm b/lib/PublicInbox/TailNotify.pm
new file mode 100644
index 00000000..a0347aa5
--- /dev/null
+++ b/lib/PublicInbox/TailNotify.pm
@@ -0,0 +1,89 @@
+# Copyright (C) all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+
+# only used for tests at the moment...
+package PublicInbox::TailNotify;
+use v5.12;
+use parent qw(PublicInbox::DirIdle); # not optimal, maybe..
+use PublicInbox::DS qw(now);
+
+my ($TAIL_MOD, $ino_cls);
+if ($^O eq 'linux' && eval { require PublicInbox::Inotify; 1 }) {
+	$TAIL_MOD = Linux::Inotify2::IN_MOVED_TO() |
+		Linux::Inotify2::IN_CREATE() |
+		Linux::Inotify2::IN_MODIFY();
+	$ino_cls = 'PublicInbox::Inotify';
+} elsif (eval { require PublicInbox::KQNotify }) {
+	$TAIL_MOD = PublicInbox::KQNotify::MOVED_TO_OR_CREATE();
+	$ino_cls = 'PublicInbox::KQNotify';
+} else {
+	require PublicInbox::FakeInotify;
+	$TAIL_MOD = PublicInbox::FakeInotify::MOVED_TO_OR_CREATE() |
+		PublicInbox::FakeInotify::IN_MODIFY();
+}
+require IO::Poll if $ino_cls;
+
+sub reopen_file ($) {
+	my ($self) = @_;
+
+	open my $fh, '<', $self->{fn} or return undef;
+	my @st = stat $fh or die "fstat($self->{fn}): $!";
+	$self->{ino_dev} = "@st[0, 1]";
+	$self->{watch_fh} = $fh; # return value
+}
+
+sub new {
+	my ($cls, $fn) = @_;
+	my $self = bless { fn => $fn }, $cls;
+	if ($ino_cls) {
+		$self->{inot} = $ino_cls->new or die "E: $ino_cls->new: $!";
+		$self->{inot}->blocking(0);
+		my ($dn) = ($fn =~ m!\A(.+)/+[^/]+\z!);
+		$self->{inot}->watch($dn // '.', $TAIL_MOD);
+	} else {
+		$self->{inot} = PublicInbox::FakeInotify->new;
+	}
+	$self->{inot}->watch($fn, $TAIL_MOD);
+	reopen_file($self);
+	$self->{inot}->watch($fn, $TAIL_MOD);
+	$self;
+}
+
+sub getlines {
+	my ($self, $timeo) = @_;
+	my ($fh, $buf, $rfds, @ret, @events);
+	my $end = defined($timeo) ? now + $timeo : undef;
+again:
+	while (1) {
+		@events = $self->{inot}->read; # Linux::Inotify2::read
+		last if @events;
+		return () if defined($timeo) && (!$timeo || (now > $end));
+		my $wait = 0.1;
+		if ($ino_cls) {
+			vec($rfds = '', $self->{inot}->fileno, 1) = 1;
+			if (defined $end) {
+				$wait = $end - now;
+				$wait = 0 if $wait < 0;
+			}
+		}
+		select($rfds, undef, undef, $wait);
+	}
+	# XXX do we care about @events contents?
+	# use Data::Dumper; warn '# ',Dumper(\@events);
+	if ($fh = $self->{watch_fh}) {
+		sysread($fh, $buf, -s $fh) and
+			push @ret, split(/^/sm, $buf);
+		my @st = stat($self->{fn});
+		if (!@st || "@st[0, 1]" ne $self->{ino_dev}) {
+			delete @$self{qw(ino_dev watch_fh)};
+		}
+	}
+	if ($fh = $self->{watch_fh} // reopen_file($self)) {
+		sysread($fh, $buf, -s $fh) and
+			push @ret, split(/^/sm, $buf);
+	}
+	goto again if (!@ret && (!defined($end) || now < $end));
+	@ret;
+}
+
+1;
diff --git a/t/imapd.t b/t/imapd.t
index 0443c7cb..98de40d4 100644
--- a/t/imapd.t
+++ b/t/imapd.t
@@ -2,10 +2,11 @@
 # Copyright (C) all contributors <meta@public-inbox.org>
 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
 # end-to-end IMAP tests, see unit tests in t/imap.t, too
-use strict;
-use v5.10.1;
+use v5.12;
 use Time::HiRes ();
+use PublicInbox::DS qw(now);
 use PublicInbox::TestCommon;
+use PublicInbox::TailNotify;
 use PublicInbox::Config;
 require_mods(qw(-imapd Mail::IMAPClient));
 my $imap_client = 'Mail::IMAPClient';
@@ -436,6 +437,49 @@ ok($mic->logout, 'logged out');
 	like(<$c>, qr/\Atagonly BAD Error in IMAP command/, 'tag-only line');
 }
 
+{
+	ok(my $ic = $imap_client->new(%mic_opt), 'logged in');
+	my $mb = "$ibx[0]->{newsgroup}.$first_range";
+	ok($ic->examine($mb), "EXAMINE $mb");
+	my $uidnext = $ic->uidnext($mb); # we'll fetch BODYSTRUCTURE on this
+	my $im = $ibx[0]->importer(0);
+	$im->add(PublicInbox::Eml->new(<<EOF)) or BAIL_OUT;
+Subject: test Ævar
+Message-ID: <smtputf8-delivered-mess\@age>
+From: Ævar Arnfjörð Bjarmason <avarab\@example>
+To: git\@vger.kernel.org
+
+EOF
+	$im->done;
+	my $envl = $ic->get_envelope($uidnext);
+	is($envl->{subject}, 'test Ævar', 'UTF-8 subject');
+	is($envl->{sender}->[0]->{personalname}, 'Ævar Arnfjörð Bjarmason',
+		'UTF-8 sender[0].personalname');
+	SKIP: {
+		skip 'need compress for comparisons', 1 if !$can_compress;
+		ok($ic = $imap_client->new(%mic_opt), 'uncompressed logged in');
+		ok($ic && $ic->compress, 'compress enabled');
+		ok($ic->examine($mb), "EXAMINE $mb");
+		my $raw = $ic->get_envelope($uidnext);
+		is_deeply($envl, $raw, 'raw and compressed match');
+	}
+}
+
+my $wait_re = sub {
+	my ($tail_notify, $re) = @_;
+	my $end = now() + 5;
+	my (@l, @all);
+	until (grep(/$re/, @l = $tail_notify->getlines(5)) || now > $end) {
+		push @all, @l;
+		@l = ();
+	}
+	return \@l if @l;
+	diag explain(\@all);
+	xbail "never got `$re' message";
+};
+
+my $watcherr = "$tmpdir/watcherr";
+
 SKIP: {
 	use_ok 'PublicInbox::InboxIdle';
 	require_git '1.8.5', 4;
@@ -460,16 +504,16 @@ SKIP: {
 	my $cb = sub { @PublicInbox::DS::post_loop_do = (sub {}) };
 	my $obj = bless \$cb, 'PublicInbox::TestCommon::InboxWakeup';
 	$cfg->each_inbox(sub { $_[0]->subscribe_unlock('ident', $obj) });
-	my $watcherr = "$tmpdir/watcherr";
 	open my $err_wr, '>>', $watcherr or BAIL_OUT $!;
-	open my $err, '<', $watcherr or BAIL_OUT $!;
+	my $errw = PublicInbox::TailNotify->new($watcherr);
 	my $w = start_script(['-watch'], undef, { 2 => $err_wr });
 
 	diag 'waiting for initial fetch...';
 	PublicInbox::DS::event_loop();
 	diag 'inbox unlocked on initial fetch, waiting for IDLE';
 
-	tick until (grep(/# \S+ idling/, <$err>));
+	$wait_re->($errw, qr/# \S+ idling/);
+
 	open my $fh, '<', 't/iso-2202-jp.eml' or BAIL_OUT $!;
 	$old_env->{ORIGINAL_RECIPIENT} = $addr;
 	ok(run_script([qw(-mda --no-precheck)], $old_env, { 0 => $fh }),
@@ -486,7 +530,8 @@ SKIP: {
 		or BAIL_OUT "git config $?";
 	$w->kill('HUP');
 	diag 'waiting for -watch reload + initial fetch';
-	tick until (grep(/# will check/, <$err>));
+
+	$wait_re->($errw, qr/# will check/);
 
 	open $fh, '<', 't/psgi_attach.eml' or BAIL_OUT $!;
 	ok(run_script([qw(-mda --no-precheck)], $old_env, { 0 => $fh }),
@@ -503,19 +548,24 @@ SKIP: {
 	$cfg->each_inbox(sub { shift->unsubscribe_unlock('ident') });
 	$ii->close;
 	PublicInbox::DS->Reset;
-	seek($err, 0, 0);
-	my @err = grep(!/^(?:I:|#)/, <$err>);
+	open my $errfh, '<', $watcherr or xbail "open: $!";
+	my @err = grep(!/^(?:I:|#)/, <$errfh>);
 	is(@err, 0, 'no warnings/errors from -watch'.join(' ', @err));
 
-	if ($ENV{TEST_KILL_IMAPD}) { # not sure how reliable this test can be
+	SKIP: { # not sure how reliable this test can be
+		skip 'TEST_KILL_IMAPD not set', 1 if !$ENV{TEST_KILL_IMAPD};
+		$^O eq 'linux' or
+			diag "TEST_KILL_IMAPD may not be reliable under $^O";
 		xsys(qw(git config), "--file=$home/.public-inbox/config",
 			qw(--unset imap.PollInterval)) == 0
 			or BAIL_OUT "git config $?";
-		truncate($err_wr, 0) or BAIL_OUT $!;
+		unlink $watcherr or xbail $!;
+		open my $err_wr, '>>', $watcherr or xbail $!;
 		my @t0 = times;
 		$w = start_script(['-watch'], undef, { 2 => $err_wr });
-		seek($err, 0, 0);
-		tick until (grep(/# \S+ idling/, <$err>));
+
+		$wait_re->($errw, qr/# \S+ idling/);
+
 		diag 'killing imapd, waiting for CPU spins';
 		my $delay = 0.11;
 		$td->kill(9);
@@ -528,39 +578,12 @@ SKIP: {
 		my $thresh = (0.9 * $delay);
 		diag "c=$c, threshold=$thresh";
 		ok($c < $thresh, 'did not burn much CPU');
-		is_deeply([grep(/ line \d+$/m, <$err>)], [],
+		open $errfh, '<', $watcherr or xbail "open: $!";
+		is_deeply([grep(/ line \d+$/m, <$errfh>)], [],
 				'no backtraces from errors');
 	}
 }
 
-{
-	ok(my $ic = $imap_client->new(%mic_opt), 'logged in');
-	my $mb = "$ibx[0]->{newsgroup}.$first_range";
-	ok($ic->examine($mb), "EXAMINE $mb");
-	my $uidnext = $ic->uidnext($mb); # we'll fetch BODYSTRUCTURE on this
-	my $im = $ibx[0]->importer(0);
-	$im->add(PublicInbox::Eml->new(<<EOF)) or BAIL_OUT;
-Subject: test Ævar
-Message-ID: <smtputf8-delivered-mess\@age>
-From: Ævar Arnfjörð Bjarmason <avarab\@example>
-To: git\@vger.kernel.org
-
-EOF
-	$im->done;
-	my $envl = $ic->get_envelope($uidnext);
-	is($envl->{subject}, 'test Ævar', 'UTF-8 subject');
-	is($envl->{sender}->[0]->{personalname}, 'Ævar Arnfjörð Bjarmason',
-		'UTF-8 sender[0].personalname');
-	SKIP: {
-		skip 'need compress for comparisons', 1 if !$can_compress;
-		ok($ic = $imap_client->new(%mic_opt), 'uncompressed logged in');
-		ok($ic && $ic->compress, 'compress enabled');
-		ok($ic->examine($mb), "EXAMINE $mb");
-		my $raw = $ic->get_envelope($uidnext);
-		is_deeply($envl, $raw, 'raw and compressed match');
-	}
-}
-
 $td->kill;
 $td->join;
 is($?, 0, 'no error in exited process') if !$ENV{TEST_KILL_IMAPD};
diff --git a/t/tail_notify.t b/t/tail_notify.t
new file mode 100644
index 00000000..82480ebc
--- /dev/null
+++ b/t/tail_notify.t
@@ -0,0 +1,38 @@
+#!perl -w
+# Copyright (C) all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+use v5.12;
+use PublicInbox::TestCommon;
+use POSIX qw(_exit);
+my ($tmpdir, $for_destroy) = tmpdir();
+use_ok 'PublicInbox::TailNotify';
+my $f = "$tmpdir/log";
+open my $fh, '>>', $f or xbail $!;
+my $tn = PublicInbox::TailNotify->new($f);
+my @x = $tn->getlines(1);
+is_deeply(\@x, [], 'nothing, yet');
+my $pid = fork // xbail "fork: $!";
+if ($pid == 0) {
+	tick;
+	syswrite $fh, "hi\n" // xbail "syswrite: $!";
+	_exit(0);
+}
+@x = $tn->getlines;
+is_deeply(\@x, [ "hi\n" ], 'got line');
+waitpid($pid, 0) // xbail "waitpid: $!";
+is($?, 0, 'writer done');
+
+$pid = fork // xbail "fork: $!";
+if ($pid == 0) {
+	tick;
+	unlink $f // xbail "unlink($f): $!";
+	open $fh, '>>', $f or xbail $!;
+	syswrite $fh, "bye\n" // xbail "syswrite: $!";
+	_exit(0);
+}
+@x = $tn->getlines;
+is_deeply(\@x, [ "bye\n" ], 'got line after reopen');
+waitpid($pid, 0) // xbail "waitpid: $!";
+is($?, 0, 'writer done');
+
+done_testing;