README.md

The purpose for mojoxy is to be like Toadfarm, except every app has its own Perl interpretter and libraries and runs under its own security restrictions. Toadfarm mounts several apps into one running Mojolicious app, whereas mojoxy is a simple Mojolicious app that redirects requests to other Mojolicious apps via http+socket. Individual apps can be restarted this way without restarting other apps.

Would like to handle ACME requests automatically as well as use 8.18's new proxy feature to also be a proxy server (not reverse proxy -- useful for fetching websites that are blocked, e.g., also useful for inspecting traffic)

Mojolicious::Command::router

package Mojolicious::Command::router;
use Mojo::Base 'Mojolicious::Command';

use Mojo::Log;
use Mojo::UserAgent;
use Mojo::Server::Prefork;
use Mojo::File 'path';
use Mojo::Util qw'dumper getopt';
use Mojo::Collection 'c';
use Mojo::ByteStream 'b';

use Mojoxy;

has description =>
  'Start application with pre-forking HTTP and WebSocket server';
has usage => sub { shift->extract_usage };

sub run {
  my ($self, @args) = @_;
  my $redirects;
  my $server = Mojo::Server::Prefork->new(app => Mojoxy->new);
  getopt \@args,
    'a|accepts=i'            => sub { $server->accepts($_[1]) },
    'b|backlog=i'            => sub { $server->backlog($_[1]) },
    'c|clients=i'            => sub { $server->max_clients($_[1]) },
    'G|graceful-timeout=i'   => sub { $server->graceful_timeout($_[1]) },
    'I|heartbeat-interval=i' => sub { $server->heartbeat_interval($_[1]) },
    'H|heartbeat-timeout=i'  => sub { $server->heartbeat_timeout($_[1]) },
    'i|inactivity-timeout=i' => sub { $server->inactivity_timeout($_[1]) },
    'l|listen=s'             => \my @listen,
    'P|pid-file=s'           => sub { $server->pid_file($_[1]) },
    'p|proxy'                => sub { $server->reverse_proxy(1) },
    'r|requests=i'           => sub { $server->max_requests($_[1]) },
    's|spare=i'              => sub { $server->spare($_[1]) },
    'w|workers=i'            => sub { $server->workers($_[1]) },
    'L|log=s'                => \$ENV{MOJOXY_LOG},
    'r|redirects=s'          => sub { $redirects = c(b(path($_)->slurp)->split("\n")) },
    's|status=s'             => \(my $status = 404),
    'S|sockets=s'            => \$ENV{MOJOXY_SOCKETS};

  my $log = Mojo::Log->new;
  $log->path($ENV{MOJOXY_LOG})
    if $ENV{MOJOXY_LOG} && (-f $ENV{MOJOXY_LOG} && -w _ || -d path($ENV{MOJOXY_LOG})->dirname && -w _);
  $ENV{MOJOXY_SOCKETS} && -d $ENV{MOJOXY_SOCKETS}
    or die "Usage: $0 -S /path/to/socketdir\n";

  my $ua = Mojo::UserAgent->new;
  $server->listen(\@listen) if @listen;
  $server->unsubscribe('request')->on(request => sub {
    my ($server, $tx) = @_;

    # Setup the request
    my $req = $tx->req->clone;
    my $host = $req->headers->host;

    return $server->app->handler($tx) if $host eq 'proxy';

    # Determine which socket to use
    my $socket = path($ENV{MOJOXY_SOCKETS});
    my @host = split /\./, ($req->headers->host || 'default');
    $socket = $socket->child($_) foreach reverse @host;
    $socket = $socket->child('.root') if -e $socket->to_abs && -d _;
    $log->error(sprintf '%s (%s) [no app at %s]', $host, $status, $socket->to_abs) and return abort($tx, $status)
      unless -e $socket->to_abs && -S _;

    # app socket exists and so the app should be running and accessible
    # A client receiving an EMPTY 404 probably indicates that the app is not running
    # An app MUST remove sockets upon removal / uninstallation
    $req->url->scheme('http+unix')->host($socket->to_abs);
    $ua->start(Mojo::Transaction::HTTP->new(req => $req) => sub {
      my ($ua, $proxy_tx) = @_;
      my $level = 'debug';
      my $message = '';
      unless ( $proxy_tx->res->code ) {
        $level = 'error';
        $proxy_tx->res->code(502);
        $message = sprintf 'app probably not running at %s', $socket->to_abs;
      }
      $log->$level(sprintf '%s (%s) [%s]', $host, $proxy_tx->res->code, $message);
      $tx->res($proxy_tx->res)->resume;
    });
  });
  $server->run;
}

sub abort {
  my ($tx, $code) = @_;
  $tx->res->code($code) if $code;
  $tx->resume;
}

1;

=encoding utf8

=head1 NAME

Mojolicious::Command::prefork - Pre-fork command

=head1 SYNOPSIS

  Usage: APPLICATION prefork [OPTIONS]

    ./myapp.pl prefork
    ./myapp.pl prefork -m production -l http://*:8080
    ./myapp.pl prefork -l http://127.0.0.1:8080 -l https://[::]:8081
    ./myapp.pl prefork -l 'https://*:443?cert=./server.crt&key=./server.key'
    ./myapp.pl prefork -l http+unix://%2Ftmp%2Fmyapp.sock -w 12

  Options:
    -a, --accepts <number>               Number of connections for workers to
                                         accept, defaults to 10000
    -b, --backlog <size>                 Listen backlog size, defaults to
                                         SOMAXCONN
    -c, --clients <number>               Maximum number of concurrent
                                         connections, defaults to 1000
    -G, --graceful-timeout <seconds>     Graceful timeout, defaults to 120.
    -I, --heartbeat-interval <seconds>   Heartbeat interval, defaults to 5
    -H, --heartbeat-timeout <seconds>    Heartbeat timeout, defaults to 30
    -h, --help                           Show this summary of available options
        --home <path>                    Path to home directory of your
                                         application, defaults to the value of
                                         MOJO_HOME or auto-detection
    -i, --inactivity-timeout <seconds>   Inactivity timeout, defaults to the
                                         value of MOJO_INACTIVITY_TIMEOUT or 15
    -l, --listen <location>              One or more locations you want to
                                         listen on, defaults to the value of
                                         MOJO_LISTEN or "http://*:3000"
    -m, --mode <name>                    Operating mode for your application,
                                         defaults to the value of
                                         MOJO_MODE/PLACK_ENV or "development"
    -P, --pid-file <path>                Path to process id file, defaults to
                                         "prefork.pid" in a temporary directory
    -p, --proxy                          Activate reverse proxy support,
                                         defaults to the value of
                                         MOJO_REVERSE_PROXY
    -r, --requests <number>              Maximum number of requests per
                                         keep-alive connection, defaults to 100
    -s, --spare <number>                 Temporarily spawn up to this number of
                                         additional workers, defaults to 2
    -w, --workers <number>               Number of workers, defaults to 4

=head1 DESCRIPTION

L<Mojolicious::Command::prefork> starts applications with the
L<Mojo::Server::Prefork> backend.

This is a core command, that means it is always enabled and its code a good
example for learning to build new commands, you're welcome to fork it.

See L<Mojolicious::Commands/"COMMANDS"> for a list of commands that are
available by default.

=head1 ATTRIBUTES

L<Mojolicious::Command::prefork> inherits all attributes from
L<Mojolicious::Command> and implements the following new ones.

=head2 description

  my $description = $prefork->description;
  $prefork        = $prefork->description('Foo');

Short description of this command, used for the command list.

=head2 usage

  my $usage = $prefork->usage;
  $prefork  = $prefork->usage('Foo');

Usage information for this command, used for the help screen.

=head1 METHODS

L<Mojolicious::Command::prefork> inherits all methods from
L<Mojolicious::Command> and implements the following new ones.

=head2 run

  $prefork->run(@ARGV);

Run this command.

=head1 SEE ALSO

L<Mojolicious>, L<Mojolicious::Guides>, L<https://mojolicious.org>.

=cut

mojoxy

#!/usr/bin/env perl
use Mojo::Log;
use Mojo::UserAgent;
use Mojo::Server::Prefork;
use Mojo::File 'path';
use Mojo::Util qw'dumper getopt';
use Mojo::Collection 'c';
use Mojo::ByteStream 'b';

my $redirects;
getopt
  'L|log=s'       => \$ENV{MOJOXY_LOG},
  'r|redirects=s' => sub { $redirects = c(b(path($_)->slurp)->split("\n")) },
  's|status=s'    => \(my $status = 404),
  'S|sockets=s'   => \$ENV{MOJOXY_SOCKETS};

my $log = Mojo::Log->new;
$log->path($ENV{MOJOXY_LOG})
  if $ENV{MOJOXY_LOG} && (-f $ENV{MOJOXY_LOG} && -w _ || -d path($ENV{MOJOXY_LOG})->dirname && -w _);
$ENV{MOJOXY_SOCKETS} && -d $ENV{MOJOXY_SOCKETS}
  or die "Usage: $0 -S /path/to/socketdir -L /path/to/log/file\n";

my $ua = Mojo::UserAgent->new;
my $server = Mojo::Server::Prefork->new->unsubscribe('request');
$server->on(request => sub {
  my ($server, $tx) = @_;

  # Setup the request
  my $req = $tx->req->clone;
  my $host = $req->headers->host;

  # mojoxy is a router: it will route your request to the proper internal mojo server
  # but let it also be a proxy using the proxy feature introduced in 8.18,
  # fetching external content and returning it to the useragent
  # Let it also handle all ACME requests $req->url->path =~ /^\.well-known

  # Determine which socket to use
  my $socket = path($ENV{MOJOXY_SOCKETS});
  my @host = split /\./, ($req->headers->host || 'default');
  $socket = $socket->child($_) foreach reverse @host;
  $socket = $socket->child('.root') if -e $socket->to_abs && -d _;
  $log->error(sprintf '%s (%s) [no app at %s]', $host, $status, $socket->to_abs) and return abort($tx, $status)
    unless -e $socket->to_abs && -S _;

  # app socket exists and so the app should be running and accessible
  # A client receiving an EMPTY 404 probably indicates that the app is not running
  # An app MUST remove sockets upon removal / uninstallation
  $req->url->scheme('http+unix')->host($socket->to_abs);
  $ua->start(Mojo::Transaction::HTTP->new(req => $req) => sub {
    my ($ua, $proxy_tx) = @_;
    my $level = 'debug';
    my $message = '';
    unless ( $proxy_tx->res->code ) {
      $level = 'error';
      $proxy_tx->res->code(502);
      $message = sprintf 'app probably not running at %s', $socket->to_abs;
    }
    $log->$level(sprintf '%s (%s) [%s]', $host, $proxy_tx->res->code, $message);
    $tx->res($proxy_tx->res)->resume;
  });
});
$server->run;

sub abort {
  my ($tx, $code) = @_;
  $tx->res->code($code) if $code;
  $tx->resume;
}

Mojoxy.pm

package Mojoxy;
use Mojo::Base 'Mojolicious';

sub startup {
  my $self = shift;
  $self->log->level('error')->path(undef);
  $self->routes->any(
    '/*whatever' => {whatever => '', text => 'Yo!'});
}

1;

ReverseProxy.pm

package Toadfarm::Plugin::ReverseProxy;
use Mojo::Base 'Mojolicious::Plugin';

use Mojo::ByteStream 'b';
use Mojo::Collection 'c';
use Mojo::File 'path';
use Mojo::URL;
use Mojo::UserAgent;
use Mojo::Util 'decamelize';

has [qw/app config host new_req server tx/];

sub register {
  my ($self, $app, $config) = @_;

  $config->{socketdir}  ||= '.';
  $config->{default}    ||= 'localhost';
  $config->{abort_code} ||= 404;

  $self->app($app)->config($config);

  $app->hook(before_server_start => sub {
    shift->unsubscribe('request')->on(request => sub {
      $self->server(shift)->tx(shift)->_inspect_request;

      my ($path, $redirect_to, $code) = $self->_lookup_redirect;
      if ( $redirect_to ) {
        return $self->_redirect($code, $redirect_to, "$code Redirect $path -> $redirect_to");
      } elsif ( my $socket = $self->_get_host_socket ) {
        my ($header, $v) = $self->_check_disable;
        return $self->_reverse_proxy($socket) unless $header && $v;
        return $self->_continue("No Reverse Proxy for $header $v, expecting internal handling");
      }

      $config->{proxy} ? $self->_continue : $self->_abort(404, "Nothing to do for $path");
    });
  });

  # These routes should get added last, after any other plugins
  $app->routes->any('/*whatever' => {whatever => ''} => \&_proxy) if $config->{proxy};
}

sub _abort {
  my ($self, $code, $message) = @_;
  $self->tx->res->code($code) if $code;
  $self->tx->res->message("($code) $message") if $message;
  $self->_debug($message);
  return $self->tx->resume;
}

sub _check_disable {
  my $self = shift;
  while ( my ($header, $v) = each %{$self->config->{disable}} ) {
    $header = decamelize $header;
    return ($header, $v) if $self->new_req->headers->$header =~ $v;
  }
}

sub _continue {
  my ($self, $message) = @_;
  $self->_debug("(100) $message");
  return $self->server->app->handler($self->tx);
}

sub _debug {
  $_[1] or return;
  my ($self, $message) = @_;
  $self->app->log->debug(sprintf '[reverse_proxy] %s %s', $self->host, $message)
}

sub _error {
  $_[1] or return;
  my ($self, $message) = @_;
  $self->app->log->error(sprintf '[reverse_proxy] %s %s', $self->host, $message)
}

sub _get_host_socket {
  my $self = shift;
  my $socket = path($self->config->{socketdir})->child(join '.', reverse split /\./, $self->host);
  return unless -S $socket->to_abs;
  return $socket;
}

sub _inspect_request {
  my $self = shift;
  my $new_req = $self->tx->req->clone;
  my $host = $new_req->headers->host;
  $host =~ s/:\d+$//; # curl adds a non-default port number to the host if Host header not set
  $self->host($host)->new_req($new_req);
}

sub _lookup_redirect {
  my $self = shift;
  my $host = $self->host;
  my $redirect = path($self->config->{redirectdir})->child(join '.', reverse split /\./, $host);
  return unless -e $redirect;
  my $lookup = b($redirect->slurp)->split("\n")->map(sub{[split /\s+/, $_]})->grep(sub{$_->[0] eq $self->tx->req->url->path})->first;
  return @$lookup;
}

sub _proxy {
  my $c = shift;

  my $req     = $c->req;
  my $method  = $req->method;
  my $url     = $req->url->to_abs;
  my $headers = $req->headers->clone->dehop->to_hash;
  $c->app->log->debug(sprintf '[proxy] Forwarding "%s %s"', $method, $url);

  $c->proxy->start_p($c->ua->build_tx($method, $url, $headers))->catch(sub {
    my $err = shift;
    $c->render(data => $err, status => 400);
  });
}

sub _redirect {
  my ($self, $code, $location, $message) = @_;
  $self->tx->res->headers->location($location);
  $self->tx->res->code($code || 301);
  $self->_debug("($code) $message");
  return $self->tx->resume;
}

sub _reverse_proxy {
  my ($self, $socket) = @_;
  # app socket exists and so the app should be running and accessible
  # A client receiving an EMPTY 404 probably indicates that the app is not running
  # An app MUST remove sockets upon removal / uninstallation
  $self->new_req->url->scheme('http+unix')->host($socket->to_abs);
  my $ua = Mojo::UserAgent->new;
  return $ua->start(Mojo::Transaction::HTTP->new(req => $self->new_req) => sub {
    my ($ua, $proxy_tx) = @_;
    my $level = '_debug';
    unless ( $proxy_tx->res->code ) {
      $level = '_error';
      $proxy_tx->res->code(502);
      $proxy_tx->res->message(sprintf 'app probably not running at %s', $socket->to_abs);
    }
    $self->$level(sprintf '(%s) %s', $proxy_tx->res->code, $proxy_tx->res->message);
    $self->tx->res($proxy_tx->res)->resume;
  });
}

1;

toadfarm

package Toadfarm::Plugin::ReverseProxy;
use Mojo::Base 'Mojolicious::Plugin';

use Mojo::ByteStream 'b';
use Mojo::Collection 'c';
use Mojo::File 'path';
use Mojo::URL;
use Mojo::UserAgent;
use Mojo::Util 'decamelize';

has [qw/app config host new_req server tx/];

sub register {
  my ($self, $app, $config) = @_;

  $self->app($app)->config($config);

  $app->hook(before_server_start => sub {
    shift->unsubscribe('request')->on(request => sub {
      $self->server(shift)->tx(shift)->_inspect_request;
      $self->_abort(404, "No host specified") unless $self->host;
      my ($path, $redirect_to, $code) = $self->_lookup_redirect;

      if ( $redirect_to ) {
        return $self->_redirect($code, $redirect_to, "$code Redirect $path -> $redirect_to");
      } elsif ( my $socket = $self->_get_host_socket ) {
        my ($header, $v) = $self->_check_disable;
        return $self->_reverse_proxy($socket) unless $header && $v;
        return $self->_continue("No Reverse Proxy for $header $v, expecting internal handling");
      }

      $app->routes->find('proxy') ? $self->_continue : $self->_abort(404, "Nothing to do for $path");
    });
  });
}

sub _abort {
  my ($self, $code, $message) = @_;
  $self->tx->res->code($code) if $code;
  $self->tx->res->message("($code) $message") if $message;
  $self->_debug($message);
  return $self->tx->resume;
}

sub _check_disable {
  my $self = shift;
  while ( my ($header, $v) = each %{$self->config->{disable}} ) {
    $header = decamelize $header;
    return ($header, $v) if $self->new_req->headers->$header =~ $v;
  }
}

sub _continue {
  my ($self, $message) = @_;
  $self->_debug("(100) $message");
  return $self->server->app->handler($self->tx);
}

sub _debug {
  $_[1] or return;
  my ($self, $message) = @_;
  $self->app->log->debug(sprintf '[reverse_proxy] %s %s', $self->host, $message)
}

sub _error {
  $_[1] or return;
  my ($self, $message) = @_;
  $self->app->log->error(sprintf '[reverse_proxy] %s %s', $self->host, $message)
}

sub _get_host_socket {
  my $self = shift;
  $self->app->log->error('No socketdir defined') and return unless $self->config->{socketdir};
  my $socket = path($self->config->{socketdir})->child(join '.', reverse split /\./, $self->host);
  return unless -S $socket->to_abs;
  return $socket;
}

sub _inspect_request {
  my $self = shift;
  my $new_req = $self->tx->req->clone;
  my $host = $new_req->headers->host;
  $host =~ s/:\d+$//; # curl adds a non-default port number to the host if Host header not set
  $self->host($host)->new_req($new_req);
}

sub _lookup_redirect {
  my $self = shift;
  my $host = $self->host;
  my $redirect = path($self->config->{redirectdir})->child(join '.', reverse split /\./, $host);
  return unless -e $redirect;
  my $lookup = b($redirect->slurp)->split("\n")->map(sub{[split /\s+/, $_]})->grep(sub{$_->[0] eq $self->tx->req->url->path})->first;
  return @$lookup;
}

sub _redirect {
  my ($self, $code, $location, $message) = @_;
  $self->tx->res->headers->location($location);
  $self->tx->res->code($code || 301);
  $self->_debug("($code) $message");
  return $self->tx->resume;
}

sub _reverse_proxy {
  my ($self, $socket) = @_;
  # app socket exists and so the app should be running and accessible
  # A client receiving an EMPTY 404 probably indicates that the app is not running
  # An app MUST remove sockets upon removal / uninstallation
  $self->new_req->url->scheme('http+unix')->host($socket->to_abs);
  return $self->app->ua->start(Mojo::Transaction::HTTP->new(req => $self->new_req) => sub {
    my ($ua, $proxy_tx) = @_;
    my $level = '_debug';
    unless ( $proxy_tx->res->code ) {
      $level = '_error';
      $proxy_tx->res->code(502);
      $proxy_tx->res->message(sprintf 'app probably not running');
    }
    $self->$level(sprintf '(%s) %s at %s', $proxy_tx->res->code, $proxy_tx->res->message, $socket->to_abs);
    $self->tx->res($proxy_tx->res)->resume;
  });
}

1;
package Toadfarm::Plugin::Proxy;
use Mojo::Base 'Mojolicious::Plugin';

sub register {
  my ($self, $app, $config) = @_;

  $app->hook(before_server_start => sub {
    my ($server, $app) = @_;
    # These routes should get added last, after any other plugins
    $app->routes->any('/*whatever' => {whatever => ''} => \&_proxy)->name('proxy');
  });
}

sub _proxy {
  my $c = shift;

  my $req     = $c->req;
  my $method  = $req->method;
  my $url     = $req->url->to_abs;
  my $headers = $req->headers->clone->dehop->to_hash;
  $c->app->log->debug(sprintf '[proxy] Forwarding "%s %s"', $method, $url);

  $c->proxy->start_p($c->ua->build_tx($method, $url, $headers))->catch(sub {
    my $err = shift;
    $c->render(data => $err, status => 400);
  });
}

1;
#!/usr/bin/perl
use Toadfarm -init;
 
logging {
  #combined => 0,
  #path     => "/tmp/toadfarm.log",
  level    => "debug",
};

plugin 'ACME';
plugin 'Toadfarm::Plugin::Proxy' => {
  userinfo => 'u:p',
};
plugin 'Toadfarm::Plugin::ReverseProxy' => {
  socketdir => '/root/boxy/sockets',
  redirectdir => '/root/boxy/redirects',
  disable => {
    'UserAgent' => qr{Github|letsencrypt},
  },
};

#mount "Mojo::HelloWorld" => {};

start ["http://*:80", "https://*:443"]; # needs to be at the last line