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.

1 files 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