[PATCH 3/3] treewide: avoid getpid for remaining ownership checks

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

There are still some places where on_destroy isn't suitable,
This gets rid of getpid() calls in those cases to reduce
syscall costs and additional runtime overhead.
---
 lib/PublicInbox/DSKQXS.pm |  7 ++++---
 lib/PublicInbox/Daemon.pm | 26 +++++++++-----------------
 lib/PublicInbox/Git.pm    |  8 ++++----
 lib/PublicInbox/IO.pm     | 12 +++++++-----
 lib/PublicInbox/LeiALE.pm |  7 ++++---
 t/spawn.t                 |  3 ++-
 6 files changed, 30 insertions(+), 33 deletions(-)

diff --git a/lib/PublicInbox/DSKQXS.pm b/lib/PublicInbox/DSKQXS.pm
index f84c196a..dc6621e4 100644
--- a/lib/PublicInbox/DSKQXS.pm
+++ b/lib/PublicInbox/DSKQXS.pm
@@ -15,6 +15,7 @@ use v5.12;
 use Symbol qw(gensym);
 use IO::KQueue;
 use Errno qw(EAGAIN);
+use PublicInbox::OnDestroy;
 use PublicInbox::Syscall qw(EPOLLONESHOT EPOLLIN EPOLLOUT EPOLLET);
 
 sub EV_DISPATCH () { 0x0080 }
@@ -37,7 +38,8 @@ sub kq_flag ($$) {
 
 sub new {
 	my ($class) = @_;
-	bless { kq => IO::KQueue->new, owner_pid => $$ }, $class;
+	my $fgen = $PublicInbox::OnDestroy::fork_gen;
+	bless { kq => IO::KQueue->new, fgen => $fgen }, $class;
 }
 
 # returns a new instance which behaves like signalfd on Linux.
@@ -137,9 +139,8 @@ sub ep_wait {
 sub DESTROY {
 	my ($self) = @_;
 	my $kq = delete $self->{kq} or return;
-	if (delete($self->{owner_pid}) == $$) {
+	delete($self->{fgen}) == $PublicInbox::OnDestroy::fork_gen and
 		POSIX::close($$kq);
-	}
 }
 
 1;
diff --git a/lib/PublicInbox/Daemon.pm b/lib/PublicInbox/Daemon.pm
index 1cc0c9e6..ec76d6b8 100644
--- a/lib/PublicInbox/Daemon.pm
+++ b/lib/PublicInbox/Daemon.pm
@@ -352,8 +352,7 @@ EOF
 	return unless defined $pid_file;
 
 	write_pid($pid_file);
-	# for ->DESTROY:
-	bless { pid => $$, pid_file => \$pid_file }, __PACKAGE__;
+	on_destroy \&unlink_pid_file_safe_ish, \$pid_file;
 }
 
 sub has_busy_clients { # post_loop_do CB
@@ -476,7 +475,7 @@ sub upgrade { # $_[0] = signal name or number (unused)
 			warn "BUG: .oldbin suffix exists: $pid_file\n";
 			return;
 		}
-		unlink_pid_file_safe_ish($$, $pid_file);
+		unlink_pid_file_safe_ish(\$pid_file);
 		$pid_file .= '.oldbin';
 		write_pid($pid_file);
 	}
@@ -509,23 +508,20 @@ sub upgrade_aborted {
 
 	my $file = $pid_file;
 	$file =~ s/\.oldbin\z// or die "BUG: no '.oldbin' suffix in $file";
-	unlink_pid_file_safe_ish($$, $pid_file);
+	unlink_pid_file_safe_ish(\$pid_file);
 	$pid_file = $file;
 	eval { write_pid($pid_file) };
 	warn $@, "\n" if $@;
 }
 
-sub unlink_pid_file_safe_ish ($$) {
-	my ($unlink_pid, $file) = @_;
-	return unless defined $unlink_pid && $unlink_pid == $$;
+sub unlink_pid_file_safe_ish ($) {
+	my ($fref) = @_;
 
-	open my $fh, '<', $file or return;
+	open my $fh, '<', $$fref or return;
 	local $/ = "\n";
 	defined(my $read_pid = <$fh>) or return;
 	chomp $read_pid;
-	if ($read_pid == $unlink_pid) {
-		Net::Server::Daemonize::unlink_pid_file($file);
-	}
+	Net::Server::Daemonize::unlink_pid_file($$fref) if $read_pid == $$;
 }
 
 sub master_quit ($) {
@@ -696,7 +692,7 @@ sub run {
 	$nworker = 1;
 	local (%XNETD, %POST_ACCEPT);
 	daemon_prepare($default_listen);
-	my $for_destroy = daemonize();
+	my $unlink_on_leave = daemonize();
 
 	# localize GCF2C for tests:
 	local $PublicInbox::GitAsyncCat::GCF2C;
@@ -706,7 +702,7 @@ sub run {
 	local %POST_ACCEPT;
 
 	daemon_loop();
-	# ->DESTROY runs when $for_destroy goes out-of-scope
+	# $unlink_on_leave runs
 }
 
 sub write_pid ($) {
@@ -715,8 +711,4 @@ sub write_pid ($) {
 	do_chown($path);
 }
 
-sub DESTROY {
-	unlink_pid_file_safe_ish($_[0]->{pid}, ${$_[0]->{pid_file}});
-}
-
 1;
diff --git a/lib/PublicInbox/Git.pm b/lib/PublicInbox/Git.pm
index af12f141..aea389e8 100644
--- a/lib/PublicInbox/Git.pm
+++ b/lib/PublicInbox/Git.pm
@@ -210,14 +210,14 @@ sub cat_async_retry ($$) {
 sub gcf_inflight ($) {
 	my ($self) = @_;
 	# FIXME: the first {sock} check can succeed but Perl can complain
-	# about calling ->owner_pid on an undefined value.  Not sure why or
-	# how this happens but t/imapd.t can complain about it, sometimes.
+	# about an undefined value.  Not sure why or how this happens but
+	# t/imapd.t can complain about it, sometimes.
 	if ($self->{sock}) {
-		if (eval { $self->{sock}->owner_pid == $$ }) {
+		if (eval { $self->{sock}->can_reap }) {
 			return $self->{inflight};
 		} elsif ($@) {
 			no warnings 'uninitialized';
-			warn "E: $self sock=$self->{sock}: owner_pid failed: ".
+			warn "E: $self sock=$self->{sock}: can_reap failed: ".
 				"$@ (continuing...)";
 		}
 		delete @$self{qw(sock inflight)};
diff --git a/lib/PublicInbox/IO.pm b/lib/PublicInbox/IO.pm
index 5654f3b0..02057600 100644
--- a/lib/PublicInbox/IO.pm
+++ b/lib/PublicInbox/IO.pm
@@ -10,6 +10,7 @@ our @EXPORT_OK = qw(poll_in read_all try_cat write_file);
 use Carp qw(croak);
 use IO::Poll qw(POLLIN);
 use Errno qw(EINTR EAGAIN);
+use PublicInbox::OnDestroy;
 # don't autodie in top-level for Perl 5.16.3 (and maybe newer versions)
 # we have our own ->close, so we scope autodie into each sub
 
@@ -23,7 +24,8 @@ sub attach_pid {
 	my ($io, $pid, @cb_arg) = @_;
 	bless $io, __PACKAGE__;
 	# we share $err (and not $self) with awaitpid to avoid a ref cycle
-	${*$io}{pi_io_reap} = [ $$, $pid, \(my $err) ];
+	${*$io}{pi_io_reap} = [ $PublicInbox::OnDestroy::fork_gen,
+				$pid, \(my $err) ];
 	awaitpid($pid, \&waitcb, \$err, @cb_arg);
 	$io;
 }
@@ -33,9 +35,9 @@ sub attached_pid {
 	${${*$io}{pi_io_reap} // []}[1];
 }
 
-sub owner_pid {
+sub can_reap {
 	my ($io) = @_;
-	${${*$io}{pi_io_reap} // [-1]}[0];
+	${${*$io}{pi_io_reap} // [-1]}[0] == $PublicInbox::OnDestroy::fork_gen;
 }
 
 # caller cares about error result if they call close explicitly
@@ -44,7 +46,7 @@ sub close {
 	my ($io) = @_;
 	my $ret = $io->SUPER::close;
 	my $reap = delete ${*$io}{pi_io_reap};
-	return $ret unless $reap && $reap->[0] == $$;
+	return $ret if ($reap->[0] // -1) != $PublicInbox::OnDestroy::fork_gen;
 	if (defined ${$reap->[2]}) { # reap_pids already reaped asynchronously
 		$? = ${$reap->[2]};
 	} else { # wait synchronously
@@ -56,7 +58,7 @@ sub close {
 sub DESTROY {
 	my ($io) = @_;
 	my $reap = delete ${*$io}{pi_io_reap};
-	if ($reap && $reap->[0] == $$) {
+	if (($reap->[0] // -1) == $PublicInbox::OnDestroy::fork_gen) {
 		$io->SUPER::close;
 		awaitpid($reap->[1]);
 	}
diff --git a/lib/PublicInbox/LeiALE.pm b/lib/PublicInbox/LeiALE.pm
index 528de22c..ce03f5b4 100644
--- a/lib/PublicInbox/LeiALE.pm
+++ b/lib/PublicInbox/LeiALE.pm
@@ -11,6 +11,7 @@ use parent qw(PublicInbox::LeiSearch PublicInbox::Lock);
 use PublicInbox::Git;
 use autodie qw(close open rename seek truncate);
 use PublicInbox::Import;
+use PublicInbox::OnDestroy;
 use PublicInbox::LeiXSearch;
 use Fcntl qw(SEEK_SET);
 
@@ -41,11 +42,11 @@ sub over {} # undef for xoids_for
 
 sub overs_all { # for xoids_for (called only in lei workers?)
 	my ($self) = @_;
-	my $pid = $$;
-	if (($self->{owner_pid} // $pid) != $pid) {
+	my $fgen = $PublicInbox::OnDestroy::fork_gen ;
+	if (($self->{fgen} // $fgen) != $fgen) {
 		delete($_->{over}) for @{$self->{ibxish}};
 	}
-	$self->{owner_pid} = $pid;
+	$self->{fgen} = $fgen;
 	grep(defined, map { $_->over } @{$self->{ibxish}});
 }
 
diff --git a/t/spawn.t b/t/spawn.t
index 5b17ed38..45517852 100644
--- a/t/spawn.t
+++ b/t/spawn.t
@@ -6,6 +6,7 @@ use Test::More;
 use PublicInbox::Spawn qw(which spawn popen_rd run_qx);
 require PublicInbox::Sigfd;
 require PublicInbox::DS;
+use PublicInbox::OnDestroy;
 my $rlimit_map = PublicInbox::Spawn->can('rlimit_map');
 {
 	my $true = which('true');
@@ -171,7 +172,7 @@ EOF
 	my @arg;
 	my $fh = popen_rd(['cat'], undef, { 0 => $r },
 			sub { @arg = @_; warn "x=$$\n" }, 'hi');
-	my $pid = fork // BAIL_OUT $!;
+	my $pid = PublicInbox::OnDestroy::fork_tmp;
 	local $SIG{__WARN__} = sub { _exit(1) };
 	if ($pid == 0) {
 		local $SIG{__DIE__} = sub { _exit(2) };