From 86d350a3854af1a5a292972d4f70154e61ce5e80 Mon Sep 17 00:00:00 2001
From: Eric Wong <e@80x24.org>
Date: Wed, 11 Jan 2023 01:12:47 +0000
Subject: add mwrap-decode-csv tool

This is a useful companion to the dump_csv: directive.
It also fixes a bug where HTML escaping was unnecessarily done
to the CSV output by -rproxy.
---
 MANIFEST                  |  1 +
 Makefile.PL               |  3 ++-
 lib/Devel/Mwrap/Rproxy.pm | 33 +++++++++++++++------------
 script/mwrap-decode-csv   | 57 +++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 79 insertions(+), 15 deletions(-)
 create mode 100644 script/mwrap-decode-csv

diff --git a/MANIFEST b/MANIFEST
index 096cec9..cf42979 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -20,6 +20,7 @@ mymalloc.h
 picohttpparser.h
 picohttpparser_c.h
 ppport.h
+script/mwrap-decode-csv
 script/mwrap-perl
 script/mwrap-rproxy
 t/httpd-unit.t
diff --git a/Makefile.PL b/Makefile.PL
index dadf80b..41e8f03 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -83,7 +83,8 @@ push @writemakefile_args, (
 	CCFLAGS => "$Config{ccflags} $ccflags",
 	PREREQ_PM => {},
 	ABSTRACT_FROM => 'lib/Devel/Mwrap.pm',
-	EXE_FILES => [qw(script/mwrap-perl script/mwrap-rproxy)],
+	EXE_FILES => [qw(script/mwrap-perl script/mwrap-rproxy
+		script/mwrap-decode-csv)],
 	AUTHOR => 'mwrap hackers <mwrap-perl@80x24.org>',
 	LIBS => $LIBS, # e.g. -lurcu-cds
 	LICENSE => 'gpl_2', # GPL-3.0+, CPAN::Meta::Spec limitation
diff --git a/lib/Devel/Mwrap/Rproxy.pm b/lib/Devel/Mwrap/Rproxy.pm
index d5a9d9d..de65685 100644
--- a/lib/Devel/Mwrap/Rproxy.pm
+++ b/lib/Devel/Mwrap/Rproxy.pm
@@ -11,9 +11,8 @@ package Devel::Mwrap::Rproxy;
 use v5.12; # strict
 use Fcntl qw(SEEK_SET);
 use IO::Socket::UNIX;
-use Plack::Util;
 
-sub new { bless { socket_dir => $_[1]}, $_[0] }
+sub new { require Plack::Util; bless { socket_dir => $_[1]}, $_[0] }
 
 sub r {
 	[ $_[0], [
@@ -104,13 +103,26 @@ sub a2l {
 		$a2l ? do {
 			chomp(my $line = $a2l->lookup($addr));
 			$line =~ s/\Q?? at ??:0\E//; # FreeBSD
-			$line = Plack::Util::encode_html($line);
 			$line =~ /\?\?/ ? "$line $exe($addr)" :
 				($line =~ /\S/ ? $line : "$exe($addr)");
 		} : "$exe($addr)"
 	}
 }
 
+sub decode_csv {
+	my ($in, $out) = @_;
+	while (<$in>) {
+		s/\\n/\0\0/g;
+		s!(["\0])
+			([^\("\0]+) # exe
+			\(([^\)"\0]+)\) # addr
+			(["\0])!
+			$1.a2l($2,$3).$4!gex;
+		s/\0\0/\\n/g;
+		$out->write($_);
+	}
+}
+
 sub call { # PSGI entry point
 	my ($self, $env) = @_;
 	my $uri = $env->{REQUEST_URI};
@@ -152,23 +164,16 @@ sub call { # PSGI entry point
 			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($_);
-				}
+				decode_csv($c, $http_out);
 			} else {
 				while (<$c>) {
 					s!>
 						([^\(<]+) # exe
 						\(([^\)<]+)\) # addr
 						<!
-						'>'.a2l($1,$2).'<'!gex;
+						'>'.Plack::Util::encode_html(
+							a2l($1,$2)).
+						'<'!gex;
 					$http_out->write($_);
 				}
 			}
diff --git a/script/mwrap-decode-csv b/script/mwrap-decode-csv
new file mode 100644
index 0000000..5bbc171
--- /dev/null
+++ b/script/mwrap-decode-csv
@@ -0,0 +1,57 @@
+#!perl -w
+# Copyright (C) mwrap hackers <mwrap-perl@80x24.org>
+# License: GPL-3.0+ <https://www.gnu.org/licenses/gpl-3.0.txt>
+# addr2line decoder for the output of MWRAP=dump_csv:$FILENAME
+use v5.12;
+use Devel::Mwrap::Rproxy;
+use IO::Handle;
+Devel::Mwrap::Rproxy::decode_csv(*STDIN{IO}, *STDOUT{IO});
+__END__
+=head1 NAME
+
+mwrap-decode-csv - decode non-Perl addresses from mwrap CSV dumps
+
+=head1 SYNOPSIS
+
+  MWRAP=dump_csv:$FILENAME,bt:2 mwrap-perl COMMAND...
+
+  mwrap-decode-csv <$FILENAME
+
+=head1 DESCRIPTION
+
+mwrap-decode-csv is a convenient wrapper for L<addr2line(1)>
+for decoding C backtraces from CSV files.
+
+It reads the CSV via standard input, and emits to standard output.
+
+It expects CSV files emitted by a L<mwrap-perl(1p)> via
+C<MWRAP=dump_csv:$FILENAME> or retrieved directly via C<curl --unix-socket>.
+
+It is not needed for CSVs retrieved via L<mwrap-rproxy(1p)>,
+since mwrap-rproxy already performs the same function as mwrap-decode-csv.
+
+To get useful C backtraces of Perl programs, C<MWRAP=bt:$DEPTH>
+directive must be used (carefully).  See L<mwrap-perl(1p)>.
+
+addr2line from GNU binutils 2.39+ (August 2022) is recommended to
+support C<SYMBOL+OFFSET> addresses.
+
+=head1 CONTACT
+
+Feedback welcome via plain-text mail to L<mailto:mwrap-perl@80x24.org>
+
+Mail archives are hosted at L<https://80x24.org/mwrap-perl/>
+
+=head1 COPYRIGHT
+
+Copyright all contributors L<mailto:mwrap-perl@80x24.org>
+
+License: GPL-3.0+ L<https://www.gnu.org/licenses/gpl-3.0.txt>
+
+Source code is at L<https://80x24.org/mwrap-perl.git/>
+
+=head1 SEE ALSO
+
+L<mwrap-perl(1p)>, L<mwrap-rproxy(1)>
+
+=cut
-- 
cgit v1.2.3-24-ge0c7