#!/usr/bin/perl
use 5.010;
our $VERSION = '0.28';
our %SPEC;
$SPEC{serve} = {
v => 1.1,
summary => 'Serve Perl modules over HTTP(S) using Riap::HTTP protocol',
description => <<'_',
This is a simple command-line front-end for making Perl modules accessible over
HTTP(S), using the Riap::HTTP protocol. First the specified Perl modules will be
loaded. Modules which do not contain Rinci metadata will be equipped with
metadata using Perinci::Sub::Gen::ForModule. After that, a PSGI application will
be run with the Gepok or Starman PSGI server. The PSGI application serves
requests for function calls (or other kinds of Riap request) over HTTP. Perl
modules not specified in the command-line arguments will not be accessible,
since Perinci::Access::InProcess is used with load=>0.
Modules can be accessed using URL:
This program is not recommended to be used in production, and there are not many
configuration options provided. For production, it is recommended that you
construct your own PSGI application and compose the
Plack::Middleware::PeriAHS::* middlewares directly.
_
args => {
modules => {
schema => ['array*' => {
of => 'str*',
min_len => 1,
}],
pos => 0,
greedy => 1,
summary => 'List of modules to load',
description => <<'_',
Either specify exact module name or one using wildcard (e.g. 'Foo::Bar::*', in
which Module::List will be used to load all modules under 'Foo::Bar::').
_
},
riap_access_log_path => {
schema => ['str' => {}],
summary => 'Path for Riap request access log file',
description => <<'_',
Default is ~/peri-htserve-riap_access.log
_
},
riap_access_log_size => {
schema => ['int' => {}],
summary => 'Maximum size for Riap request access log file',
description => <<'_',
Default is to use File::Write::Rotate's default (10485760, a.k.a. 10MB).
If size exceeds this, file will be rotated.
_
},
riap_access_log_histories => {
schema => ['int' => {}],
summary => 'Number of old Riap request access log files to keep',
description => <<'_',
Default is to use File::Write::Rotate's default (10).
_
},
server => {
schema => ['str*' => {
in => [qw/Starman Gepok/],
default => 'Gepok',
}],
summary => 'Choose PSGI server',
description => <<'_',
Currently only Starman or Gepok is supported. Default is Gepok.
_
},
starman_host => {
schema => ['str' => {}],
summary => 'Will be passed to Starman',
},
starman_port => {
schema => ['int' => {}],
summary => 'Will be passed to Starman',
},
gepok_http_ports => {
schema => ['str' => {}],
summary => 'Will be passed to Gepok',
},
gepok_https_ports => {
schema => ['str' => {}],
summary => 'Will be passed to Gepok',
},
gepok_unix_sockets => {
schema => ['str' => {}],
summary => 'Will be passed to Gepok',
},
gepok_ssl_key_file => {
schema => ['str' => {}],
summary => 'Will be passed to Gepok',
},
gepok_ssl_cert_file => {
schema => ['str' => {}],
summary => 'Will be passed to Gepok',
},
daemonize => {
schema => ['bool' => {
default => 0,
}],
summary => 'If true, will daemonize into background',
cmdline_aliases => {D=>{}},
},
library => {
schema => ['array' => {
of => 'str*',
}],
summary => 'Add directory to library search path, a la Perl\'s -I',
cmdline_aliases => {I=>{}},
},
parse_form => {
schema => ['bool'],
summary => 'Passed to Plack::Middleware::PeriAHS::ParseRequest',
},
parse_reform => {
schema => ['bool'],
summary => 'Passed to Plack::Middleware::PeriAHS::ParseRequest',
},
parse_path_info => {
schema => ['bool'],
summary => 'Passed to Plack::Middleware::PeriAHS::ParseRequest',
},
},
'_perinci.sub.wrapper.validate_args' => 0,
};
sub serve {
my %args = @_;
my $server = $args{server};
$log->infof("Starting server (using %s) ...", $server);
my $riap_access_log_path = $args{riap_access_log_path} //
File::HomeDir->my_home . "/peri-htserve-riap_access.log";
for my $dir (@{ $args{library} // [] }) {
lib->import($dir);
}
my @modules;
for my $m (@{$args{modules}}) {
if ($m =~ /(.+::)\*$/) {
my $res = list_modules($1, {list_modules=>1});
push @modules, keys %$res;
} else {
push @modules, $m;
}
}
$log->debugf("Modules to load: %s", \@modules);
for my $m (@modules) {
$log->infof("Loading module %s ...", $m);
eval { load $m };
return [500, "Failed to load module $m: $@"] if $@;
gen_meta_for_module(module=>$m, load=>0);
}
my $fwr;
{
my ($dir, $leaf) = $riap_access_log_path =~ m!(.+)/(.+)!;
if (!$dir) { $dir = "."; $leaf = $riap_access_log_path }
$fwr = File::Write::Rotate->new(
dir => $dir,
prefix => $leaf,
size => $args{riap_access_log_size},
histories => $args{riap_access_log_histories},
);
}
my $app =
builder {
enable(
"PeriAHS::LogAccess",
dest => $fwr,
);
enable(
"PeriAHS::ParseRequest",
parse_path_info => $args{parse_path_info},
parse_form => $args{parse_form},
parse_reform => $args{parse_reform},
);
enable "PeriAHS::Respond";
};
my @argv;
push @argv, "-s", $server;
if ($server eq 'Starman') {
for (qw/host port/) {
push @argv, "--$_", $args{"starman_$_"} if $args{"starman_$_"};
}
} else {
if (!$args{gepok_http_ports} &&
!$args{gepok_https_ports} &&
!$args{gepok_unix_sockets}) {
$args{gepok_http_ports} = "*:5000";
}
for (qw/http_port https_ports unix_sockets
ssl_key_file ssl_cert_file/) {
push @argv, "--$_", $args{"gepok_$_"} if $args{"gepok_$_"};
}
}
push @argv, "-D" if $args{daemonize};
my $runner = Plack::Runner->new;
$runner->parse_options(@argv);
$runner->run($app);
[200, "OK"];
}
Perinci::CmdLine->new(url => '/main/serve')->run;