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 868A61F698
	for <mwrap-perl@80x24.org>; Tue, 27 Dec 2022 14:17:11 +0000 (UTC)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=80x24.org;
	s=selector1; t=1672150631;
	bh=Q4uhGeYfBMMFAq4rgxa2QH1HNqg84NoF+fcRa/hCrnY=;
	h=From:To:Subject:Date:From;
	b=E2XvaQJtZq+19owGZjc2/FL5dI1ylswO8EBIeARXYOC6qHaGy8Cr2gB9sbvsqiZVh
	 U/46Ea/h+VnilnnMg8Uwlc9VE4rvnnk8DKZ2s8MItyxrRLiOeBcoPB5FzlPDSeJYuF
	 c5+jG9JcrO8JJ6FCZk9pE72NnlzDxT67lSBiYuj0=
From: Eric Wong <e@80x24.org>
To: mwrap-perl@80x24.org
Subject: [PATCH] rproxy: support GNU addr2line via pipe
Date: Tue, 27 Dec 2022 14:17:12 +0000
Message-Id: <20221227141712.1473379-1-e@80x24.org>
MIME-Version: 1.0
Content-Transfer-Encoding: 8bit
List-Id: <mwrap-perl.yhbt.net>

We can filter the HTML and CSV and run it through addr2line to
decode addresses from rproxy.  We can't safely run another
process inside the embedded mwrap-httpd since that could
break `waitpid(-1, ...)' in the code we're being injected into.
---
 lib/Devel/Mwrap/Rproxy.pm | 81 ++++++++++++++++++++++++++++++++++++++-
 1 file changed, 80 insertions(+), 1 deletion(-)

diff --git a/lib/Devel/Mwrap/Rproxy.pm b/lib/Devel/Mwrap/Rproxy.pm
index 6db72e6..2b9ccc7 100644
--- a/lib/Devel/Mwrap/Rproxy.pm
+++ b/lib/Devel/Mwrap/Rproxy.pm
@@ -58,6 +58,17 @@ sub list {
 	r(200, $str);
 }
 
+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);
+	chomp(my $line = $a2l->lookup($addr));
+	$line = Plack::Util::encode_html($line);
+	$line =~ /\A\?\?:/ ? "$line $exe $addr" : $line;
+}
+
 sub call { # PSGI entry point
 	my ($self, $env) = @_;
 	my $uri = $env->{REQUEST_URI};
@@ -76,9 +87,77 @@ sub call { # PSGI entry point
 	# this only expects httpd.h output, so no continuation lines:
 	$h = do { local $/ = "\r\n\r\n"; <$c> } // return r(500, "read: $!");
 	my ($code, @hdr) = split(/\r\n/, $h);
+	@hdr = grep(!/^Content-Length:/i, @hdr); # addr2line changes length
+	my $csv = grep(m!^Content-Type: text/csv!i, @hdr);
 	(undef, $code, undef) = split(/ /, $code);
 	@hdr = map { split(/: /, $_, 2) } @hdr;
-	[ $code, \@hdr, $c ];
+	sub {
+		my ($wcb) = @_;
+		my $http_out = $wcb->([$code, \@hdr]);
+		eval {
+			local %addr2line;
+			# extract executable|library(address)
+			if ($csv) {
+				while (<$c>) {
+					s/\\n/\0\0/g;
+					s!(["\0])
+						(/[^\("\0]+) # exe
+						\(([^\)"\0]+)\) # addr
+						(["\0])!
+						$1.a2l($2,$3).$4!gex;
+					s/\0\0/\\n/g;
+					$http_out->write($_);
+				}
+			} else {
+				while (<$c>) {
+					s!>
+						(/[^\(<]+) # exe
+						\(([^\)<]+)\) # addr
+						<!
+						'>'.a2l($1,$2).'<'!gex;
+					$http_out->write($_);
+				}
+			}
+			close $c;
+		};
+		warn "E: $@" if $@;
+		$http_out->close;
+	}
+}
+
+# requires GNU addr2line for stdin/stdout support
+package Devel::Mwrap::Rproxy::A2L;
+use v5.12;
+
+sub new {
+	my ($cls, $exe) = @_;
+	pipe(my ($rd, $_wr)) or die "pipe: $!";
+	pipe(my ($_rd, $wr)) or die "pipe: $!";
+	my $addr2line = $ENV{ADDR2LINE} // 'addr2line';
+	my $pid = fork // die "fork: $!";
+	if ($pid == 0) {
+		close $rd;
+		close $wr;
+		open STDIN, '<&', $_rd or die "STDIN: $!";
+		open STDOUT, '>&', $_wr or die "STDOUT: $!";
+		exec $addr2line, '-e', $exe;
+		die "exec $addr2line -e $exe: $!";
+	}
+	$_rd = $_wr = undef;
+	$wr->autoflush(1);
+	bless { rd => $rd, wr => $wr, pid => $pid }, __PACKAGE__;
+}
+
+sub lookup {
+	my ($self, $addr) = @_;
+	say { $self->{wr} } $addr;
+	readline($self->{rd});
+}
+
+sub DESTROY {
+	my ($self) = @_;
+	delete @$self{qw(rd wr)};
+	waitpid(delete $self->{pid}, 0);
 }
 
 1;