From 80d71e078f6e4fc133bbd413b8e8bcd355c21e11 Mon Sep 17 00:00:00 2001
From: Eric Wong <e@80x24.org>
Date: Wed, 28 Dec 2022 10:05:34 +0000
Subject: rproxy: improve addr2line support

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