[PATCH 0/4] rproxy: addr2line support improvements

[PATCH 0/4] rproxy: addr2line support improvements

[Eric Wong]

Only tested on Linux + GNU addr2line 2.39 so far on Debian;
but I suspect it's a common platform :>

Eric Wong (4):
  rproxy: bail out early on errors reading /proc/$$/cmdline
  rproxy: close pipes in deterministic order
  rproxy: improve addr2line support
  rproxy: cache addr2line output

 lib/Devel/Mwrap/Rproxy.pm | 60 +++++++++++++++++++++++++++++++++------
 1 file changed, 52 insertions(+), 8 deletions(-)

[PATCH 1/4] rproxy: bail out early on errors reading /proc/$$/cmdline

[Eric Wong]

I'm not sure if it's really an issue, but it it narrows down
the places where uninitialized variable warnings can happen.
---
 lib/Devel/Mwrap/Rproxy.pm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/lib/Devel/Mwrap/Rproxy.pm b/lib/Devel/Mwrap/Rproxy.pm
index c96a947..29225c1 100644
--- a/lib/Devel/Mwrap/Rproxy.pm
+++ b/lib/Devel/Mwrap/Rproxy.pm
@@ -29,7 +29,7 @@ my $valid_pid = $^O eq 'linux' ? sub {
 	my ($pid) = @_;
 	if (open(my $fh, '<', "/proc/$pid/cmdline")) {
 		local $/;
-		my $str = <$fh>;
+		my $str = <$fh> // return;
 		$str =~ tr/\0/ /;
 		Plack::Util::encode_html($str);
 	}

[PATCH 2/4] rproxy: close pipes in deterministic order

[Eric Wong]

And always close our write end first so we can shut down
addr2line slightly sooner.
---
 lib/Devel/Mwrap/Rproxy.pm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/lib/Devel/Mwrap/Rproxy.pm b/lib/Devel/Mwrap/Rproxy.pm
index 29225c1..b10fa5b 100644
--- a/lib/Devel/Mwrap/Rproxy.pm
+++ b/lib/Devel/Mwrap/Rproxy.pm
@@ -159,7 +159,7 @@ sub lookup {
 
 sub DESTROY {
 	my ($self) = @_;
-	delete @$self{qw(rd wr)};
+	close($_) for (delete @$self{qw(wr rd)});
 	waitpid(delete $self->{pid}, 0);
 }
 

[PATCH 3/4] rproxy: improve addr2line support

[Eric Wong]

We'll open scripts to resolve shebang lines (necessary for Perl
scripts), and resolve non-absolute paths from to absolute paths
based on $PATH (based on git).

There's also a perl-debug||/usr/bin/debugperl special case for
Debian, since there's (AFAIK) no -dbgsym package on Debian
bullseye which covers /usr/bin/perl.
---
 lib/Devel/Mwrap/Rproxy.pm | 34 ++++++++++++++++++++++++++++++----
 1 file changed, 30 insertions(+), 4 deletions(-)

diff --git a/lib/Devel/Mwrap/Rproxy.pm b/lib/Devel/Mwrap/Rproxy.pm
index b10fa5b..43c1372 100644
--- a/lib/Devel/Mwrap/Rproxy.pm
+++ b/lib/Devel/Mwrap/Rproxy.pm
@@ -63,10 +63,13 @@ our %addr2line; # { exe|lib => Devel::Mwrap::Rproxy::A2L }
 # addr2line bidirectional pipe wrapper
 sub a2l {
 	my ($exe, $addr) = @_;
-	my $a2l = $addr2line{$exe} //= Devel::Mwrap::Rproxy::A2L->new($exe);
+	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;
+	$line =~ /\?\?/ ? "$line $exe $addr" :
+		($line =~ /\S/ ? $line : "$exe $addr");
 }
 
 sub call { # PSGI entry point
@@ -101,7 +104,7 @@ sub call { # PSGI entry point
 				while (<$c>) {
 					s/\\n/\0\0/g;
 					s!(["\0])
-						(/[^\("\0]+) # exe
+						([^\("\0]+) # exe
 						\(([^\)"\0]+)\) # addr
 						(["\0])!
 						$1.a2l($2,$3).$4!gex;
@@ -111,7 +114,7 @@ sub call { # PSGI entry point
 			} else {
 				while (<$c>) {
 					s!>
-						(/[^\(<]+) # exe
+						([^\(<]+) # exe
 						\(([^\)<]+)\) # addr
 						<!
 						'>'.a2l($1,$2).'<'!gex;
@@ -131,6 +134,29 @@ 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

[PATCH 4/4] rproxy: cache addr2line output

[Eric Wong]

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