775 lines
24 KiB
Perl
775 lines
24 KiB
Perl
package FU 0.1;
|
|
use v5.36;
|
|
use Carp 'confess';
|
|
use IO::Socket;
|
|
use POSIX;
|
|
use FU::Util;
|
|
|
|
|
|
sub import($pkg, @opt) {
|
|
my %opt = map +($_,1), @opt;
|
|
|
|
_spawn() if $opt{-spawn};
|
|
|
|
no strict 'refs';
|
|
my $c = caller;
|
|
*{$c.'::fu'} = \&fu;
|
|
}
|
|
|
|
|
|
our $REQ = {}; # Internal request-local data
|
|
our $fu = bless {}, 'FU::obj'; # App request-local data
|
|
sub fu() { $fu }
|
|
|
|
|
|
sub debug { state $v = 0; $v = $_[0] if @_; $v }
|
|
sub log_slow_pages { state $v = 0; $v = $_[0] if @_; $v }
|
|
sub log_queries { state $v = 0; $v = $_[0] if @_; $v }
|
|
sub max_request_body { state $v = 10*1024*1024; $v = $_[0] if @_; $v }
|
|
|
|
sub mime_types() { state $v = {qw{
|
|
7z application/x-7z-compressed
|
|
aac audio/aac
|
|
atom application/atom+xml
|
|
avi video/x-msvideo
|
|
avif image/avif
|
|
bin application/octet-stream
|
|
bmp image/bmp
|
|
bz application/x-bzip2
|
|
css text/css
|
|
csv text/csv
|
|
gif image/gif
|
|
htm text/html
|
|
html text/html
|
|
ico image/x-icon
|
|
jpeg image/jpeg
|
|
jpg image/jpeg
|
|
js application/javascript
|
|
json application/json
|
|
jxl image/jxl
|
|
mjs application/javascript
|
|
mp3 audio/mpeg
|
|
mp4 video/mp4
|
|
mp4v video/mp4
|
|
mpg4 video/mp4
|
|
mpg video/mpeg
|
|
mpeg video/mpeg
|
|
oga audio/ogg
|
|
ogg audio/ogg
|
|
ogv video/ogg
|
|
otf font/otf
|
|
pdf application/pdf
|
|
png image/png
|
|
rar application/x-rar-compressed
|
|
rss application/rss+xml
|
|
svg image/svg+xml
|
|
tar application/x-tar
|
|
tiff image/tiff
|
|
ttf font/ttf
|
|
txt text/plain
|
|
webp image/webp
|
|
webm video/webm
|
|
xhtml text/html
|
|
xml application/xml
|
|
xsd application/xml
|
|
xsl application/xml
|
|
zip application/zip
|
|
}} }
|
|
|
|
|
|
our $INIT_DB;
|
|
our $DB;
|
|
sub _connect_db { $DB = ref $INIT_DB eq 'CODE' ? $INIT_DB->() : FU::Pg->connect($INIT_DB) }
|
|
sub init_db($info) {
|
|
require FU::Pg;
|
|
$INIT_DB = $info;
|
|
_connect_db;
|
|
}
|
|
|
|
|
|
my @before_request;
|
|
my @after_request;
|
|
sub before_request :prototype(&) ($f) { push @before_request, $f }
|
|
sub after_request :prototype(&) ($f) { push @after_request, $f }
|
|
|
|
|
|
my %path_routes;
|
|
my %re_routes;
|
|
|
|
sub _add_route($path, $sub, $method) {
|
|
if (ref $path eq 'REGEXP' || ref $path eq 'Regexp') {
|
|
push $re_routes{$method}->@*, [ qr/^$path$/, $sub ];
|
|
} elsif (!ref $path) {
|
|
confess("A route has already been registered for $method $path") if $path_routes{$method}{$path};
|
|
$path_routes{$method}{$path} = $sub;
|
|
} else {
|
|
confess('Path argument in route registration must be a string or regex');
|
|
}
|
|
}
|
|
|
|
sub get :prototype($&) { push @_, 'GET'; &_add_route; }
|
|
sub post :prototype($&) { push @_, 'POST'; &_add_route; }
|
|
sub delete :prototype($&) { push @_, 'DELETE'; &_add_route; }
|
|
sub options :prototype($&) { push @_, 'OPTIONS'; &_add_route; }
|
|
sub put :prototype($&) { push @_, 'PUT'; &_add_route; }
|
|
sub patch :prototype($&) { push @_, 'PATCH'; &_add_route; }
|
|
sub query :prototype($&) { push @_, 'QUERY'; &_add_route; }
|
|
|
|
|
|
sub _err_500 {
|
|
fu->_error_page(500, '500 - Extraterrestrial Server Error', <<~_);
|
|
Ouch! Something went wrong on the server. Perhaps a misconfiguration,
|
|
perhaps a bug, or perhaps just a temporary issue caused by regular
|
|
maintenance or maybe even alien interference. Details of this error have
|
|
been written to a log file. If the issue persists, please contact the site
|
|
admin to let them know that they might have some fixing to do.
|
|
_
|
|
};
|
|
my %onerr = (
|
|
400 => sub {
|
|
fu->_error_page(400, '400 - Bad Request', 'The server was not happy with your offer.');
|
|
},
|
|
404 => sub {
|
|
fu->_error_page(404, '404 - Page Not Found', <<~_);
|
|
Whatever it is you were looking for, this probably isn't it.
|
|
<br><small>Unless you were looking for an error page, in which case:
|
|
Congratulations!</small>
|
|
_
|
|
},
|
|
413 => sub {
|
|
fu->_error_page(413, '413 - Request Entity Too Large', <<~_);
|
|
That's an odd way of saying that you were probably trying to upload a large
|
|
file. Too large, in fact, for the server to handle. If you believe this
|
|
error to be mistaken, you can ask the site admin to increase the maximum
|
|
allowed upload size.
|
|
_
|
|
},
|
|
500 => \&_err_500,
|
|
'*' => sub($code, @) {
|
|
fu->_error_page($code, "$code - Unknown error", 'Welp, something went wrong processing your request.');
|
|
},
|
|
);
|
|
sub on_error :prototype($&) { $onerr{$_[0]} = $_[1] }
|
|
|
|
|
|
my($monitor_check, @monitor_paths);
|
|
sub monitor_path { push @monitor_paths, @_ }
|
|
sub monitor_check :prototype(&) { $monitor_check = $_[0] }
|
|
|
|
sub _monitor {
|
|
state %data;
|
|
return 1 if $monitor_check && $monitor_check->();
|
|
|
|
require File::Find;
|
|
eval {
|
|
File::Find::find({
|
|
wanted => sub {
|
|
my $m = (stat)[9];
|
|
$data{$_} //= $m;
|
|
die if $m > $data{$_};
|
|
},
|
|
no_chdir => 1
|
|
}, $0, values %INC, @monitor_paths);
|
|
0
|
|
} // 1;
|
|
}
|
|
|
|
|
|
sub _decode_utf8 {
|
|
fu->error(400, 'Invalid UTF-8 in request') if !utf8::decode($_[0]);
|
|
# Disallow any control codes, except for x09 (tab), x0a (newline) and x0d (carriage return)
|
|
fu->error(400, 'Invalid control character in request') if $_[0] =~ /[\x00-\x08\x0b\x0c\x0e-\x1f]/;
|
|
}
|
|
|
|
our $hdrname_re = qr/[!#\$\%&'\*\+-\.^_`\|~0-9a-zA-Z]+/;
|
|
|
|
# rfc7230 used as reference, though strict conformance is not a goal.
|
|
# Does not limit size of headers, so not suitable for deployment in untrusted networks.
|
|
sub _http_read_request($sock, $req) {
|
|
local $/ = "\r\n";
|
|
my $line = $sock->getline;
|
|
fu->error(400, 'Client disconnect before request was read') if !defined $line;
|
|
fu->error(400, 'Invalid request') if $line !~ /^(GET|POST|DELETE|OPTIONS|PUT|PATCH|QUERY)\s+(\S+)\s+HTTP\/1\.[01]\r\n$/;
|
|
$req->{method} = $1;
|
|
($req->{path}, $req->{qs}) = split /\?/, $2 =~ s{^https?://[^/]+/}{/}r, 2;
|
|
$req->{path} =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
|
|
_decode_utf8 $req->{path};
|
|
_decode_utf8 $req->{qs} if defined $req->{qs};
|
|
|
|
while (1) {
|
|
# Turns out header line folding has been officially deprecated, so I'm
|
|
# going to be lazy and only support single-line headers.
|
|
$line = $sock->getline;
|
|
fu->error(400, 'Client disconnect before request was read') if !defined $line;
|
|
last if $line eq "\r\n";
|
|
fu->error(400, 'Invalid request header syntax') if $line !~ /^($hdrname_re):\s*(.+)\r\n$/;
|
|
my($hdr, $val) = (lc $1, $2 =~ s/\s*$//r);
|
|
_decode_utf8 $val;
|
|
if (exists $req->{hdr}{$hdr}) {
|
|
$req->{hdr}{$hdr} .= ($hdr eq 'cookie' ? '; ' : ', ') . $val;
|
|
} else {
|
|
$req->{hdr}{$hdr} = $val;
|
|
}
|
|
}
|
|
|
|
fu->error(400, 'Unexpected Transfer-Encoding request header') if $req->{hdr}{'transfer-encoding'};
|
|
my $len = $req->{hdr}{'content-length'} // 0;
|
|
fu->error(400, 'Invalid Content-Length request header') if $len !~ /^(?:0|[1-9][0-9]*)$/;
|
|
fu->error(413, 'Request body too large') if $len > max_request_body;
|
|
|
|
$req->{body} = '';
|
|
while ($len > 0) {
|
|
my $r = $sock->read($req->{body}, $len, -1);
|
|
fu->error(400, 'Client disconnect before request was read') if !$r
|
|
}
|
|
}
|
|
|
|
|
|
|
|
sub _is_done($e) { ref $@ eq 'FU::err' && $@->[0] == 200 }
|
|
|
|
sub _log_err($e) {
|
|
return if !$e;
|
|
return if !debug && ref $@ eq 'FU::err' && $@->[0] != 500;
|
|
warn $e =~ /\n$/ ? $e : "$e\n";
|
|
}
|
|
|
|
sub _do_req($c) {
|
|
if ($c->{monitor} && _monitor) {
|
|
warn "File change detected, restarting process.\n" if debug;
|
|
FU::Util::fdpass_send(fileno($c->{supervisor_sock}), fileno($c->{client_sock}), 'f0000');
|
|
exit;
|
|
}
|
|
|
|
local $REQ = {};
|
|
local $fu = bless {}, 'FU::obj';
|
|
|
|
$REQ->{ip} = $c->{client_sock} isa 'IO::Socket::INET' ? $c->{client_sock}->peerhost : '127.0.0.1';
|
|
fu->reset;
|
|
|
|
my $ok = eval {
|
|
_http_read_request($c->{client_sock}, $REQ);
|
|
|
|
for my $h (@before_request) { $h->() }
|
|
|
|
my $path = fu->path;
|
|
my $r = $path_routes{ fu->method }{$path};
|
|
if ($r) { $r->() }
|
|
else {
|
|
for $r ($re_routes{ fu->method }->@*) {
|
|
if($path =~ $r->[0]) {
|
|
$r->[1]->(@{^CAPTURE});
|
|
fu->done;
|
|
}
|
|
}
|
|
fu->error(404);
|
|
}
|
|
1;
|
|
};
|
|
my $err = $ok || _is_done($@) ? undef : $@;
|
|
_log_err $err;
|
|
|
|
for my $h (@after_request) {
|
|
$ok = eval { $h->(); 1 };
|
|
_log_err $@ if !$ok;
|
|
$err = $@ if !$err && !$ok && !_is_done($@);
|
|
}
|
|
|
|
# Commit transaction, if we have one that's not done yet.
|
|
if (!$err && $REQ->{txn} && $REQ->{txn}->status ne 'done' && !eval { $REQ->{txn}->commit; 1 }) {
|
|
_log_err "Transaction commit failed: $@";
|
|
$err = $@;
|
|
}
|
|
|
|
if ($err) {
|
|
fu->reset;
|
|
my($code, $msg) = ref $@ eq 'FU::err' ? $@->@* : (500, $err);
|
|
eval {
|
|
($onerr{$code} || $onerr{'*'})->($code, $msg);
|
|
1;
|
|
} || _err_500();
|
|
}
|
|
|
|
fu->_flush($c->{client_sock});
|
|
$c->{client_sock}->close;
|
|
|
|
exit if $c->{max_reqs} && !--$c->{max_reqs};
|
|
}
|
|
|
|
sub _supervisor($c) {
|
|
my ($rsock, $wsock) = IO::Socket->socketpair(IO::Socket::AF_UNIX(), IO::Socket::SOCK_STREAM(), IO::Socket::PF_UNSPEC());
|
|
|
|
my %childs; # pid => 1: spawned, 2: signalled ready
|
|
$SIG{CHLD} = sub { $wsock->syswrite('c0000',1) };
|
|
$SIG{HUP} = $SIG{TERM} = $SIG{INT} = sub($sig,@) {
|
|
kill 'TERM', keys %childs;
|
|
return if $sig eq 'HUP';
|
|
$SIG{$sig} = undef;
|
|
kill $sig, $$;
|
|
exit 1;
|
|
};
|
|
|
|
require Fcntl;
|
|
fcntl $c->{listen_sock}, Fcntl::F_SETFD(), 0;
|
|
fcntl $wsock, Fcntl::F_SETFD(), 0;
|
|
|
|
$ENV{FU_MONITOR} = $c->{monitor};
|
|
$ENV{FU_MAX_REQS} = $c->{max_reqs};
|
|
$ENV{FU_DEBUG} = debug;
|
|
$ENV{FU_SUPERVISOR_FD} = fileno $wsock;
|
|
$ENV{FU_LISTEN_FD} = fileno $c->{listen_sock};
|
|
|
|
my $err = 0;
|
|
my @client_fd;
|
|
while (1) {
|
|
while ((my $pid = waitpid(-1, POSIX::WNOHANG())) > 0) {
|
|
$err = 1 if POSIX::WIFEXITED($?) && POSIX::WEXITSTATUS($?) != 0;
|
|
if (!$err && (!$childs{$pid} || $childs{$pid} != 2)) {
|
|
$err = 1;
|
|
warn "Script exited before calling FU::run()\n";
|
|
}
|
|
delete $childs{$pid};
|
|
}
|
|
|
|
# Don't bother spawning more than 1 at a time while in error state
|
|
my $spawn = !$err ? $c->{proc} - keys %childs : (grep $_ == 1, values %childs) ? 0 : 1;
|
|
for (1..$spawn) {
|
|
my $client = shift @client_fd;
|
|
my $pid = fork;
|
|
die $! if !defined $pid;
|
|
if (!$pid) { # child
|
|
$SIG{CHLD} = $SIG{HUP} = $SIG{INT} = $SIG{TERM} = undef;
|
|
if ($client) {
|
|
$ENV{FU_CLIENT_FD} = $client;
|
|
} elsif ($err) {
|
|
# In error state, wait with loading the script until we've received a request.
|
|
# Otherwise we'll end up in an infinite spawning loop if the script doesn't start properly.
|
|
my $sock = $c->{listen_sock}->accept() or die $!;
|
|
fcntl $sock, Fcntl::F_SETFD, 0 if $sock;
|
|
$ENV{FU_CLIENT_FD} = fileno $sock;
|
|
}
|
|
exec $^X, (map "-I$_", @INC), $0;
|
|
exit 1;
|
|
}
|
|
$client && IO::Socket->new_from_fd($client, 'r'); # close() the fd if we have one
|
|
$childs{$pid} = 1;
|
|
}
|
|
|
|
# Assumption: we never get short reads.
|
|
my ($fd, $msg) = FU::Util::fdpass_recv(fileno($rsock), 5);
|
|
push @client_fd, $fd if $fd;
|
|
next if !$msg;
|
|
next if $msg eq 'c0000'; # child died
|
|
next if $msg eq 'f0000'; # child is about to exit and passed a client fd to us
|
|
|
|
if ($msg =~ /^r/) { # child ready
|
|
my $pid = unpack 'V', substr $msg, 1;
|
|
$childs{$pid} = 2 if $childs{$pid};
|
|
$err = 0;
|
|
}
|
|
}
|
|
}
|
|
|
|
sub _spawn {
|
|
state %c;
|
|
return if keys %c && !@_; # already checked if we need to spawn
|
|
|
|
if (!keys %c) {
|
|
%c = (
|
|
http => $ENV{FU_HTTP} // '127.0.0.1:3000',
|
|
fcgi => $ENV{FU_FCGI},
|
|
proc => $ENV{FU_PROC} // 1,
|
|
monitor => $ENV{FU_MONITOR} // 0,
|
|
max_reqs => $ENV{FU_MAX_REQS} // 0,
|
|
listen_sock => $ENV{FU_LISTEN_FD} && IO::Socket->new_from_fd($ENV{FU_LISTEN_FD}, 'r'),
|
|
client_sock => $ENV{FU_CLIENT_FD} && IO::Socket->new_from_fd($ENV{FU_CLIENT_FD}, 'r+'),
|
|
supervisor_sock => $ENV{FU_SUPERVISOR_FD} && IO::Socket->new_from_fd($ENV{FU_SUPERVISOR_FD}, 'w'),
|
|
!$ENV{FU_SUPERVISOR_FD} && @_ && defined $_[0] ? @_ : (),
|
|
);
|
|
debug $ENV{FU_DEBUG} if exists $ENV{FU_DEBUG};
|
|
|
|
for (@_ ? () : @ARGV) {
|
|
$c{http} = $1 if /^--http=(.+)$/;
|
|
$c{fcgi} = $1 if /^--fcgi=(.+)$/;
|
|
$c{proc} = $1 if /^--proc=([0-9]+)$/;
|
|
$c{monitor} = 1 if /^--monitor$/;
|
|
$c{monitor} = 0 if /^--no-monitor$/;
|
|
$c{max_reqs} = $1 if /^--max-reqs=([0-9]+)$/;
|
|
debug 1 if /^--debug$/;
|
|
debug 0 if /^--no-debug$/;
|
|
}
|
|
};
|
|
|
|
# Single process, no need for a supervisor
|
|
my $need_supervisor = !$c{supervisor_sock} && !$c{client_sock} && ($c{proc} > 1 || $c{monitor} || $c{max_reqs});
|
|
return if !@_ && !$need_supervisor;
|
|
|
|
if (!$c{listen_sock}) {
|
|
my $addr = $c{fcgi} || $c{http};
|
|
$c{listen_sock} = IO::Socket->new(
|
|
Listen => 5,
|
|
Type => IO::Socket::SOCK_STREAM(),
|
|
$addr =~ m{^(unix:|/)(.+)$} ? do {
|
|
my $path = ($1 eq '/' ? '/' : '').$2;
|
|
unlink $path if -S $path;
|
|
+(Domain => IO::Socket::AF_UNIX(), Local => $path)
|
|
} : (
|
|
Domain => IO::Socket::AF_INET(),
|
|
ReuseAddr => 1,
|
|
Proto => 'tcp',
|
|
LocalAddr => $addr,
|
|
)
|
|
) or die "Unable to create listen socket: $!\n";
|
|
print "Listening on $addr\n" if debug;
|
|
}
|
|
|
|
if ($need_supervisor) {
|
|
_supervisor \%c;
|
|
} else {
|
|
$c{supervisor_sock}->syswrite('r'.pack 'V', $$) if $c{supervisor_sock};
|
|
my $stop = 0;
|
|
local $SIG{HUP} = 'IGNORE';
|
|
local $SIG{TERM} = $SIG{INT} = sub { $stop = 1 };
|
|
_do_req \%c if $c{client_sock};
|
|
while (!$stop) {
|
|
_do_req \%c if ($c{client_sock} = $c{listen_sock}->accept);
|
|
}
|
|
}
|
|
}
|
|
|
|
sub run(%conf) {
|
|
confess "FU::run() called with configuration options, but FU has already been loaded with -spawn" if keys %conf;
|
|
# Clean up any state we may have accumulated during initialization.
|
|
$REQ = {};
|
|
$fu = bless {}, 'FU::obj';
|
|
_spawn(keys %conf ? \%conf : undef);
|
|
}
|
|
|
|
|
|
|
|
package FU::obj;
|
|
|
|
use Carp 'confess';
|
|
|
|
sub fu() { $FU::fu }
|
|
sub debug { FU::debug }
|
|
|
|
sub db_conn { $FU::DB || FU::_connect_db }
|
|
|
|
sub db {
|
|
$REQ->{txn} ||= do {
|
|
my $txn = eval { fu->db_conn->txn };
|
|
if (!$txn) {
|
|
# Can't start a transaction? We might be screwed, try to reconnect.
|
|
FU::_connect_db;
|
|
$txn = fu->db_conn->txn; # Let this error if it also fails
|
|
}
|
|
$txn
|
|
};
|
|
}
|
|
|
|
sub sql { fu->db->q(@_) }
|
|
|
|
|
|
|
|
|
|
# Request information methods
|
|
|
|
sub path { $FU::REQ->{path} }
|
|
sub method { $FU::REQ->{method} }
|
|
sub header($, $h) { $FU::REQ->{hdr}{ lc $h } }
|
|
sub headers { $FU::REQ->{hdr} }
|
|
sub ip { $FU::REQ->{ip} }
|
|
|
|
|
|
|
|
|
|
# Response generation methods
|
|
|
|
sub done { die bless [200,'Done'], 'FU::err' }
|
|
sub error($,$code,$msg=$code) { die bless [$code,$msg], 'FU::err' }
|
|
|
|
sub reset {
|
|
my $r = $FU::REQ;
|
|
$r->{status} = 200;
|
|
$r->{reshdr} = [
|
|
'content-type', 'text/html; charset=UTF-8',
|
|
];
|
|
$r->{resbody} = '';
|
|
}
|
|
|
|
sub status($, $code) { $FU::REQ->{status} = $code }
|
|
sub set_body($, $data) { $FU::REQ->{resbody} = $data } # TODO: replace with a regular 'print'
|
|
|
|
|
|
sub _validate_header($hdr, $val) {
|
|
confess "Invalid response header '$hdr'" if $hdr !~ /^$FU::hdrname_re$/;
|
|
confess "Invalid attempt to set response header containing a newline" if $val =~ /[\r\n]/;
|
|
}
|
|
|
|
sub add_header($, $hdr, $val) {
|
|
_validate_header($hdr, $val);
|
|
push $FU::REQ->{reshdr}->@*, lc $hdr, $val;
|
|
}
|
|
|
|
sub set_header($, $hdr, $val=undef) {
|
|
_validate_header($hdr, $val);
|
|
$hdr = lc $hdr;
|
|
# Not very efficient *shrug*
|
|
my @r;
|
|
for my ($ihdr, $ival) ($FU::REQ->{reshdr}->@*) {
|
|
push @r, $ihdr, $ival if $ihdr ne $hdr;
|
|
}
|
|
push @r, $hdr, $val if defined $val;
|
|
$FU::REQ->{reshdr} = \@r;
|
|
}
|
|
|
|
sub _error_page($, $code, $title, $msg) {
|
|
fu->reset;
|
|
fu->status($code);
|
|
my $body = <<~_;
|
|
<!DOCTYPE html>
|
|
<html>
|
|
<head>
|
|
<meta name="viewport" content="width=device-width, initial-scale=1">
|
|
<style type="text/css">
|
|
body { margin: 40px auto; max-width:700px; line-height:1.6; font-size: 18px; color:#444; padding:0 10px }
|
|
h1 { line-height:1.2 }
|
|
</style>
|
|
<title>$title</title>
|
|
</head>
|
|
<body>
|
|
<h1>$title</h1>
|
|
<p>$msg</p>
|
|
</body>
|
|
</html>
|
|
_
|
|
utf8::encode($body);
|
|
fu->set_body($body);
|
|
}
|
|
|
|
sub _flush($, $sock) {
|
|
my $r = $FU::REQ;
|
|
$sock->printf("HTTP/1.0 %d Hello\r\n", $r->{status});
|
|
|
|
if ($r->{status} == 204) {
|
|
fu->set_header('content-length', undef);
|
|
fu->set_header('content-encoding', undef);
|
|
} else {
|
|
fu->set_header('content-length', length $r->{resbody});
|
|
}
|
|
for my ($hdr, $val) ($r->{reshdr}->@*) {
|
|
utf8::encode($hdr);
|
|
utf8::encode($val);
|
|
$sock->printf("%s: %s\r\n", $hdr, $val);
|
|
}
|
|
$sock->print("\r\n");
|
|
|
|
$sock->print($r->{resbody}) if (fu->method//'') ne 'HEAD' && $r->{status} != 204;
|
|
$sock->flush;
|
|
}
|
|
|
|
|
|
|
|
package FU::err;
|
|
|
|
use overload '""' => sub { sprintf "FU exception code %d: %s", $_[0][0], $_[0][1] };
|
|
|
|
|
|
1;
|
|
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
FU - Framework Ultimatum: A Lean and Efficient Zero-Dependency Web Framework.
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use v5.36;
|
|
use FU -spawn;
|
|
|
|
FU::get qr{/hello/(.+)}, sub($who) {
|
|
fu->set_body("<h1>Hello, $who!</h1>");
|
|
};
|
|
|
|
FU::run;
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
=head2 Distribution Overview
|
|
|
|
This top-level C<FU> module is a web framework. The C<FU> distribution also
|
|
includes a bunch of modules that the framework depends on or which are
|
|
otherwise useful when building web backends. These modules are standalone and
|
|
can be used independently of the framework:
|
|
|
|
=over
|
|
|
|
=item * L<FU::Util> - JSON parsing & formatting.
|
|
|
|
=item * L<FU::Pg> - PostgreSQL client.
|
|
|
|
=back
|
|
|
|
Note that everything in this distribution requires a moderately recent version
|
|
of Perl (5.36+), a C compiler and a 64-bit POSIXy system (not Windows, that
|
|
is).
|
|
|
|
=head2 Framework Overview
|
|
|
|
=head2 Importing FU
|
|
|
|
You'll usually want to add the following statement somewhere near the top of
|
|
your script:
|
|
|
|
use FU -spawn;
|
|
|
|
The C<-spawn> option tells C<FU> to read running configuration from environment
|
|
variables and command-line arguments during early startup, see L</"Running the
|
|
Site"> below.
|
|
|
|
I<TODO: more import options>
|
|
|
|
=head2 Framework Configuration
|
|
|
|
=over
|
|
|
|
=item FU::monitor_path(@paths)
|
|
|
|
Add filesystem paths to be monitored for changes when running in monitor mode
|
|
(see C<--monitor> in L</"Running the Site">). When given a directory, all files
|
|
under the directory are recursively checked. The given paths do not actually
|
|
have to exist, errors are silently discarded. Relative paths are resolved to
|
|
the current working directory at the time that the paths are checked for
|
|
changes, so you may want to pass absolute paths if you ever call C<chdir()>.
|
|
|
|
You do not have to add the current script or files in C<%INC>, these are
|
|
monitored by default.
|
|
|
|
=item FU::monitor_check($sub)
|
|
|
|
Register a subroutine to be called in monitor mode. The subroutine should
|
|
return a true value to signal that something has changed and the process should
|
|
reload, false otherwise. The subroutine is called before any filesystem paths
|
|
are checked (as in C<FU::monitor_path>), so if you run any build system things
|
|
here, file modifications are properly detected and trigger a reload.
|
|
|
|
Only one subroutine can be registered at a time. Be careful to ensure that the
|
|
subroutine returns a false value at some point, otherwise you may end up in a
|
|
restart loop.
|
|
|
|
=back
|
|
|
|
=head2 Handlers & Routing
|
|
|
|
=head2 The 'fu' Object
|
|
|
|
=head2 Request Information
|
|
|
|
=head2 Generating Responses
|
|
|
|
=head2 Running the Site
|
|
|
|
When your script is done setting L</"Framework Configuration"> and registering
|
|
L</"Handlers & Routing">, it should call C<FU::run> to actually start serving
|
|
the website:
|
|
|
|
=over
|
|
|
|
=item FU::run(%options)
|
|
|
|
In normal circumstances, this function does not return.
|
|
|
|
When FU has been loaded with the C<-spawn> flag, C<%options> are read from the
|
|
environment variables or command line arguments documented below. Otherwise,
|
|
the following corresponding options can be passed instead: I<http>, I<fcgi>,
|
|
I<proc>, I<monitor>, I<max_reqs>, I<listen_sock>.
|
|
|
|
=back
|
|
|
|
Command-line options are read only when FU has been loaded with C<-spawn>, the
|
|
environment variables are always read.
|
|
|
|
=over
|
|
|
|
=item FU_HTTP=addr
|
|
|
|
=item --http=addr
|
|
|
|
Start a local web server on the given address. I<addr> can be an C<ip:port>
|
|
combination to listen on TCP, or a path (optionally prefixed with C<unix:>) to
|
|
listen on a UNIX socket. E.g.
|
|
|
|
./your-script.pl --http=127.0.0.1:8000
|
|
./your-script.pl --http=unix:/path/to/socket
|
|
|
|
B<WARNING:> The built-in HTTP server is only intended for local development
|
|
setups, it is NOT suitable for production deployments in its current form. It
|
|
does not enforce a limit on request header size, does not support HTTPS and has
|
|
no provisions for extracting the client IP address when behind a reverse proxy.
|
|
Please use FastCGI instead for internet-facing deployments.
|
|
|
|
=item FU_FCGI=addr
|
|
|
|
=item --fcgi=addr
|
|
|
|
Like the HTTP counterpart above, but listen on a FastCGI socket instead. If
|
|
this option is set, it takes precedence over the HTTP option.
|
|
|
|
=item FU_PROC=n
|
|
|
|
=item --proc=n
|
|
|
|
How many worker processes to spawn, defaults to 1.
|
|
|
|
=item FU_MONITOR=0/1
|
|
|
|
=item --monitor or --no-monitor
|
|
|
|
When enabled, worker processes will monitor for file changes and automatically
|
|
restart on changes. This is immensely useful during development, but comes at a
|
|
significant cost in performance - better not enable this in production.
|
|
|
|
=item FU_MAX_REQS=n
|
|
|
|
=item --max-reqs=n
|
|
|
|
Worker processes can automatically restart after handling a number of requests.
|
|
Set to 0 (the default) to disable this feature. This option can be useful when
|
|
your worker processes keep accumulating memory over time. A little pruning here
|
|
and there can never hurt.
|
|
|
|
=item FU_DEBUG=0/1
|
|
|
|
=item --debug or --no-debug
|
|
|
|
Set the initial value for C<FU::debug>.
|
|
|
|
=item LISTEN_FD=num
|
|
|
|
Listen for incoming connections on the given file descriptor instead of
|
|
creating a new listen socket. This is mainly useful if you are using an
|
|
external process manager.
|
|
|
|
=back
|
|
|
|
When C<--monitor> or C<--max-reqs> are set or C<<--proc>> is larger than 1, FU
|
|
starts a supervisor process to ensure the requested number of worker processes
|
|
are running and that they are restarted when necessary. When FU has been loaded
|
|
with the C<-spawn> flag, this supervisor process runs directly from the context
|
|
of the C<use FU> statement - that is, before the rest of your script has even
|
|
loaded. This saves valuable resources: the supervisor has no need of your
|
|
website code nor does it need an active connection to your database to do its
|
|
job. Without the C<-spawn> flag, the supervisor has to run from C<FU::run>,
|
|
which is less efficient but does allow for more flexible configuration from
|
|
within your script.
|
|
|
|
When not running in supervisor mode, no separate worker processes are started
|
|
and requests are instead handled directly in the starting process.
|
|
|
|
In supervisor mode, sending C<SIGHUP> causes all worker processes to reload
|
|
their code. In both modes, C<SIGTERM> or C<SIGINT> can be used to trigger a
|
|
clean shutdown.
|
|
|
|
I<TODO:> Alternate FastCGI spawning options & server config examples.
|