From 2cbe071c5c2fe4d1cd89a69210604aaac47bb35e Mon Sep 17 00:00:00 2001
From: Eric Wong <e@80x24.org>
Date: Wed, 28 Dec 2022 10:05:35 +0000
Subject: rproxy: cache addr2line output

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 e98aebe..8dc78a2 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
-- 
cgit v1.2.3-24-ge0c7