1 files changed, 115 insertions, 0 deletions
diff --git a/script/mwrap-rproxy b/script/mwrap-rproxy
new file mode 100644
index 0000000..056e80a
--- /dev/null
+++ b/script/mwrap-rproxy
@@ -0,0 +1,115 @@
+#!perl -w
+# Copyright (C) mwrap hackers <mwrap-perl@80x24.org>
+# License: GPL-3.0+ <https://www.gnu.org/licenses/gpl-3.0.txt>
+# thin wrapper for Devel::Mwrap::Rproxy
+use v5.12; # strict
+eval { require Plack::Runner } or die "Plack not installed: $@\n";
+use Getopt::Long qw(:config no_ignore_case no_auto_abbrev pass_through);
+my $usage = "$0 --socket-dir=/path/to/socket-dir [PLACKUP_OPTIONS]\n";
+my %opt = (deflate => 1);
+GetOptions(\%opt, 'socket-dir=s', 'deflate!', 'help|h') or do {
+        require Pod::Usage; Pod::Usage::pod2usage(1);
+};
+if ($opt{help}) { require Pod::Usage; Pod::Usage::pod2usage(0) }
+my $socket_dir = delete $opt{'socket-dir'};
+$socket_dir //= ($ENV{MWRAP} // '') =~ m!\bsocket_dir:([^,]+)! ? $1 : undef;
+$socket_dir // die $usage;
+require Devel::Mwrap::Rproxy;
+my $rproxy = Devel::Mwrap::Rproxy->new($socket_dir);
+my $app = sub { $rproxy->call(@_) };
+my $runner = Plack::Runner->new;
+$runner->parse_options(@ARGV);
+if (($ENV{LISTEN_PID} // 0) == $$) {
+        my $fds = $ENV{LISTEN_FDS} // '';
+        die "only one LISTEN_FDS=1 supported (got `$fds')\n" if $fds ne '1';
+        if (open(my $s, '<&=', 3)) {
+                my $prev_was_blocking = $s->blocking(1);
+                warn <<"" unless $prev_was_blocking;
+Inherited socket (fd=3) is non-blocking, making it blocking.
+
+                bless $s, 'IO::Socket::INET';
+                $runner->set_options(listen_sock => $s);
+        }
+}
+if ($opt{deflate} && eval { require Plack::Middleware::Deflater } and !$@) {
+        $app = Plack::Middleware::Deflater->wrap($app);
+}
+
+# ensure mwrap_dtor() runs if running under mwrap-perl, ourselves
+sub sigexit { exit 0 }
+$SIG{$_} = \&sigexit for (qw(INT TERM));
+
+$runner->run($app);
+__END__
+=head1 NAME
+
+mwrap-rproxy - reverse proxy for embedded per-process mwrap httpd
+
+=head1 SYNOPSIS
+
+  # start the long-running COMMAND you wish to trace:
+  MWRAP=socket_dir:$DIR mwrap-perl COMMAND
+
+  # in a different terminal, point mwrap-proxy to the mwrap-perl socket_dir
+  mwrap-rproxy --socket-dir=$DIR -l 127.0.0.1:8080
+
+  # open http://127.0.0.1:8080/ in your favorite web browser:
+  w3m http://127.0.0.1:8080/
+
+=head1 DESCRIPTION
+
+B<mwrap-rproxy> is a PSGI reverse proxy to provide access
+via TCP to the native, Unix-socket-only httpd embedded inside
+mwrap core.  It provides a listing of process IDs of each process
+traced via mwrap.
+
+B<mwrap-rproxy> does not have a hard dependency on mwrap-perl itself,
+it exists to provide a convenient interface to programs being
+traced by mwrap-perl.
+
+=head1 OPTIONS
+
+=over 4
+
+=item --socket-dir=DIR
+
+If unset, it will attempt to parse C<socket_dir:> from the C<MWRAP>
+environment (see L<mwrap-perl(1p)>).
+
+=item --no-deflate
+
+L<Plack::Middleware::Deflater(3pm)> is loaded by default if available.
+Using C<--no-deflate> will save CPU cycles at the expense of bandwidth.
+
+=back
+
+Additionally, all options in L<plackup(1p)> are supported.  Notably,
+C<-l>/C<--listen> and C<--path=/prefix> may be useful.
+
+=head1 ENVIRONMENT
+
+mwrap-rproxy supports systemd (and compatible) socket activation via
+C<LISTEN_PID> and C<LISTEN_FDS> variables.  See L<systemd.socket(5)>
+and L<sd_listen_fds(3)>.
+
+C<PLACK_ENV> is also supported as described by L<plackup(1p)>
+
+=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)>
+
+=cut