about summary refs log tree commit homepage
diff options
context:
space:
mode:
authorEric Wong <e@80x24.org>2023-01-11 01:12:47 +0000
committerEric Wong <mwrap-perl@80x24.org>2023-01-11 04:23:31 +0000
commit86d350a3854af1a5a292972d4f70154e61ce5e80 (patch)
treedc66a0462297f7bda0d7d95628dfe1a1919578cc
parent8ce0068f470f3dad3a2920e7fdeedeee235c44eb (diff)
downloadmwrap-86d350a3854af1a5a292972d4f70154e61ce5e80.tar.gz
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.
-rw-r--r--MANIFEST1
-rw-r--r--Makefile.PL3
-rw-r--r--lib/Devel/Mwrap/Rproxy.pm33
-rw-r--r--script/mwrap-decode-csv57
4 files changed, 79 insertions, 15 deletions
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