From mboxrd@z Thu Jan  1 00:00:00 1970
Return-Path: <e@80x24.org>
X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on dcvr.yhbt.net
X-Spam-Level: 
X-Spam-ASN:  
X-Spam-Status: No, score=-4.2 required=3.0 tests=ALL_TRUSTED,BAYES_00,
	DKIM_SIGNED,DKIM_VALID,DKIM_VALID_AU,DKIM_VALID_EF shortcircuit=no
	autolearn=ham autolearn_force=no version=3.4.6
Received: from localhost (dcvr.yhbt.net [127.0.0.1])
	by dcvr.yhbt.net (Postfix) with ESMTP id C29561FA2D
	for <mwrap-perl@80x24.org>; Wed, 28 Dec 2022 10:05:35 +0000 (UTC)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=80x24.org;
	s=selector1; t=1672221935;
	bh=oeH4IPiGtlHiGILu9TVjOUsTAZwro4BY7r1pKAF8z14=;
	h=From:To:Subject:Date:In-Reply-To:References:From;
	b=ReXABGcD8CCVwkM9sRFh1jrSA/T7gBAieobqoroi5W/nh5yJaCfynyV8pW+8YzV1n
	 pnQKsSpgghrTdXU7lvmj4I06+Rp3RuOjD5CP2lbFRTFIyavxZP5VOUir/l0vHPjGoF
	 uqu4/EeTw7sWA+YcT6NWTs8XvbG7mARDjn5Z8PiY=
From: Eric Wong <e@80x24.org>
To: mwrap-perl@80x24.org
Subject: [PATCH 4/4] rproxy: cache addr2line output
Date: Wed, 28 Dec 2022 10:05:35 +0000
Message-Id: <20221228100535.2252158-5-e@80x24.org>
In-Reply-To: <20221228100535.2252158-1-e@80x24.org>
References: <20221228100535.2252158-1-e@80x24.org>
MIME-Version: 1.0
Content-Transfer-Encoding: 8bit
List-Id: <mwrap-perl.yhbt.net>

We'll hoist out exe resolution into its own sub and rely on
reusing stat info (via `stat(_)') to give us ctime + size info
to use as a cache key.
---
 lib/Devel/Mwrap/Rproxy.pm | 78 ++++++++++++++++++++++++---------------
 1 file changed, 48 insertions(+), 30 deletions(-)

diff --git a/lib/Devel/Mwrap/Rproxy.pm b/lib/Devel/Mwrap/Rproxy.pm
index 43c1372..9b12405 100644
--- a/lib/Devel/Mwrap/Rproxy.pm
+++ b/lib/Devel/Mwrap/Rproxy.pm
@@ -59,17 +59,53 @@ sub list {
 }
 
 our %addr2line; # { exe|lib => Devel::Mwrap::Rproxy::A2L }
+my %cache; # "$exe\0$addr$st_ctime$st_size" => $line
+my $cache_exp = 0;
+my $cache_time = 1800;
+
+sub resolve_exe ($$) {
+	my ($exe, $st) = @_;
+	# n.b. this assumes PATH is identical across the rproxy and
+	# mwrap-httpd process, which may not always be the case:
+	if (index($exe, '/') < 0 && !-r $exe) {
+		for my $p (split(/:/, $ENV{PATH})) {
+			$p .= "/$exe";
+			if (-x $p) {
+				$exe = $p;
+				last;
+			}
+		}
+	}
+	my $fh;
+	if (-T $exe && open($fh, '<', $exe)) { # is it text? use shebang
+		my $l = readline($fh);
+		$exe = ($l =~ /\A\#\![ \t]*(\S+)/) ? $1 : $^X;
+	}
+	return unless -e $exe;
+
+	# Debian `perl-debug' is special:
+	($exe eq '/usr/bin/perl' && -x '/usr/bin/debugperl') and
+		$exe = '/usr/bin/debugperl';
+	my @st = stat(_);
+	$$st = pack('dd', $st[10], $st[7]); # ctime + size
+	$exe;
+}
 
 # addr2line bidirectional pipe wrapper
 sub a2l {
 	my ($exe, $addr) = @_;
-	my $a2l = $addr2line{$exe} //=
-		Devel::Mwrap::Rproxy::A2L->new($exe) //
-		return "$exe $addr";
-	chomp(my $line = $a2l->lookup($addr));
-	$line = Plack::Util::encode_html($line);
-	$line =~ /\?\?/ ? "$line $exe $addr" :
-		($line =~ /\S/ ? $line : "$exe $addr");
+	$exe = resolve_exe($exe, \(my $st)) // return "$exe($addr)";
+	$cache{"$addr\0$exe$st"} //= do {
+		my $a2l = $addr2line{$exe} //=
+			Devel::Mwrap::Rproxy::A2L->new($exe);
+
+		$a2l ? do {
+			chomp(my $line = $a2l->lookup($addr));
+			$line = Plack::Util::encode_html($line);
+			$line =~ /\?\?/ ? "$line $exe($addr)" :
+				($line =~ /\S/ ? $line : "$exe($addr)");
+		} : "$exe($addr)"
+	}
 }
 
 sub call { # PSGI entry point
@@ -97,6 +133,11 @@ sub call { # PSGI entry point
 	sub {
 		my ($wcb) = @_;
 		my $http_out = $wcb->([$code, \@hdr]);
+		my $now = time;
+		if ($now > $cache_exp) {
+			undef %cache;
+			$cache_exp = $now + $cache_time;
+		}
 		eval {
 			local %addr2line;
 			# extract executable|library(address)
@@ -134,29 +175,6 @@ use v5.12;
 
 sub new {
 	my ($cls, $exe) = @_;
-	# n.b. this assumes PATH is identical across the rproxy and
-	# mwrap-httpd process, which may not always be the case:
-	if (index($exe, '/') < 0 && !-r $exe) {
-		for my $p (split(/:/, $ENV{PATH})) {
-			$p .= "/$exe";
-			if (-x $p) {
-				$exe = $p;
-				last;
-			}
-		}
-	}
-	my $fh;
-	if (-T $exe && open($fh, '<', $exe)) { # is it text? use shebang
-		my $l = readline($fh);
-		$exe = ($l =~ /\A\#\![ \t]*(\S+)/) ? $1 : $^X;
-	}
-	return unless -e $exe;
-
-	# Debian `perl-debug' is special:
-	if ($exe eq '/usr/bin/perl' && -x '/usr/bin/debugperl') {
-		$exe = '/usr/bin/debugperl';
-	}
-
 	pipe(my ($rd, $_wr)) or die "pipe: $!";
 	pipe(my ($_rd, $wr)) or die "pipe: $!";
 	# -f/--functions needs -p/--pretty-print to go with it