diff options
author | Eric Wong <e@80x24.org> | 2023-01-11 01:12:47 +0000 |
---|---|---|
committer | Eric Wong <mwrap-perl@80x24.org> | 2023-01-11 04:23:31 +0000 |
commit | 86d350a3854af1a5a292972d4f70154e61ce5e80 (patch) | |
tree | dc66a0462297f7bda0d7d95628dfe1a1919578cc | |
parent | 8ce0068f470f3dad3a2920e7fdeedeee235c44eb (diff) | |
download | mwrap-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-- | MANIFEST | 1 | ||||
-rw-r--r-- | Makefile.PL | 3 | ||||
-rw-r--r-- | lib/Devel/Mwrap/Rproxy.pm | 33 | ||||
-rw-r--r-- | script/mwrap-decode-csv | 57 |
4 files changed, 79 insertions, 15 deletions
@@ -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 |