FU
view release on metacpan or search on metacpan
} else {
for $r ($re_routes{ fu->method }->@*) {
if($path =~ $r->[0]) {
$REQ->{trace_han} = [ $r->[0], $r->[2] ];
$r->[1]->(@{^CAPTURE});
fu->done;
}
}
fu->notfound;
}
1;
};
return if !$ok && ref $@ eq 'FU::err' && $@->[0] == -1;
$REQ->{trace_exn} = $ok ? undef : $@;
my $err = $ok || _is_done($@) ? undef : $@;
_log_err $err;
for my $h (@after_request) {
$ok = eval { $h->[0]->(); 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) {
my($code, $msg) = $err isa 'FU::err' ? @$err : $err isa 'FU::Validate::err' ? (400, $err) : (500, $err);
fu->reset;
fu->status($code);
my $ok = eval { ($onerr{$code} || $onerr{500})->($code, $msg) };
if (!$ok && !_is_done($@)) {
_log_err $@;
_err_500();
}
}
$REQ->{trace_end} = clock_gettime(CLOCK_MONOTONIC);
eval {
fu->_flush($c->{fcgi_obj} || $c->{client_sock});
1;
} || do {
log_write "Error writing response: $@\n";
$c->{client_sock} = $c->{fcgi_obj} = undef;
};
if (debug && $REQ->{trace_id} && $debug_info->{history} && $debug_info->{storage}) {
require FU::DebugImpl;
FU::DebugImpl::save();
}
my $proc_ms = ($REQ->{trace_end} - $REQ->{trace_start}) * 1000;
log_write(sprintf "%.0fms%s %s-%s %d-%s\n", $proc_ms,
$REQ->{trace_nsql} ?
sprintf ' (sql %.0f+%.0fms, %d/%d/%d)',
($REQ->{trace_sqlexec}||0)*1000, ($REQ->{trace_sqlprep}||0)*1000,
$REQ->{trace_nsqldirect}||0, $REQ->{trace_nsqlprep}||0, $REQ->{trace_nsql} : '',
$REQ->{status}, ($REQ->{reshdr}{'content-type'}//'-') =~ s/;.+$//r,
length($REQ->{resbody}), substr($REQ->{reshdr}{'content-encoding'}//'r', 0, 1)
) if FU::debug || $proc_ms > (FU::log_slow_reqs||1e10);
}
sub _run_loop($c) {
my $stop = 0;
my $count = 0;
local $SIG{HUP} = 'IGNORE';
local $SIG{TERM} = $SIG{INT} = sub { $stop = 1 };
my sub passclient {
FU::Util::fdpass_send(fileno($c->{supervisor_sock}), fileno($c->{client_sock}), 'f0000')
if $c->{supervisor_sock} && $c->{client_sock};
exit;
}
my sub setstate($state) {
$0 = sprintf "%s: %s [#%d%s]", $procname, $state, $count, $c->{max_reqs} ? "/$c->{max_reqs}" : '' if $procname;
}
while (!$stop) {
setstate 'idle';
$c->{client_sock} ||= $c->{listen_sock}->accept || next;
$c->{fcgi_obj} ||= $c->{listen_proto} eq 'fcgi' && FU::fcgi::new(fileno $c->{client_sock}, $c->{proc});
if ($c->{monitor} && _monitor) {
log_write "File change detected, restarting process.\n" if debug;
passclient;
}
setstate 'working';
_do_req $c;
$c->{client_sock} = $c->{fcgi_obj} = undef if !($c->{fcgi_obj} && $c->{fcgi_obj}->keepalive);
$count++;
passclient if $c->{max_reqs} && $count >= $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',5) };
$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;
$r->{multipart} ? ('Body (multipart):', _fmt_section join "\n", map $_->describe, $r->{multipart}->@*) :
$r->{json} ? ('Body (JSON):', _fmt_section FU::Util::json_format($r->{json}, pretty => 1, canonical => 1)) :
$r->{formdata} ? ('Body (formdata):', _fmt_section FU::Util::json_format($r->{formdata}, pretty => 1, canonical => 1)) :
length $r->{body} ? do {
my $b = substr $r->{body}, 0, 4096;
my $trunc = length $r->{body} > 4096 ? ', truncated' : '';
utf8::decode($b) ? ("Body (utf8$trunc):", _fmt_section($b =~ s/\r//rg =~ s/\n{4,}/\n[..]\n/rg))
: ("Body (hex$trunc):", _fmt_section(unpack('H*', $b) =~ s/(.{128})/$1\n/rg))
} : (),
'Message:', _fmt_section $msg
);
}
# 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} }
sub _getfield($data, @a) {
if (@a == 1 && !ref $a[0]) {
fu->error(400, "Expected top-level to be a hash") if ref $data ne 'HASH';
return $data->{$a[0]};
}
my $schema = FU::Validate->compile(@a > 1 ? { keys => {@a} } : $a[0]);
my $res = $schema->validate($data);
return @a == 2 ? $res->{$a[0]} : $res;
}
sub query {
shift;
return $FU::REQ->{qs} if !@_;
$FU::REQ->{qs_parsed} ||= eval { FU::Util::query_decode($FU::REQ->{qs}) } || fu->error(400, $@);
_getfield $FU::REQ->{qs_parsed}, @_;
}
sub cookie {
shift;
return fu->header('cookie') if !@_;
$FU::REQ->{cookie} ||= do {
my %c;
for my $c (split /; /, fu->header('cookie')||'') {
my($n, $v) = split /=/, $c, 2;
if (!defined $v) {}
elsif (!exists $c{$n}) { $c{$n} = $v }
elsif (ref $c{$n}) { push $c{$n}->@*, $v }
else { $c{$n} = [ $c{$n}, $v ] }
}
\%c
};
_getfield $FU::REQ->{cookie}, @_;
}
sub json {
shift;
fu->error(400, "Invalid content type for json") if (fu->header('content-type')||'') !~ m{^application/json(?:;\s*charset=utf-?8)?$}i;
return FU::Util::utf8_decode(my $x = $FU::REQ->{body}) if !@_;
$FU::REQ->{json} ||= eval {
FU::Util::json_parse($FU::REQ->{body}, utf8 => 1)
} || fu->error(400, "JSON parse error: $@");
_getfield $FU::REQ->{json}, @_;
}
sub formdata {
shift;
fu->error(400, "Invalid content type for form data") if (fu->header('content-type')||'') ne 'application/x-www-form-urlencoded';
return FU::Util::utf8_decode(my $x = $FU::REQ->{body}) if !@_;
$FU::REQ->{formdata} ||= eval {
FU::Util::query_decode($FU::REQ->{body});
} || fu->error(400, $@);
_getfield $FU::REQ->{formdata}, @_;
}
sub multipart {
require FU::MultipartFormData;
$FU::REQ->{multipart} ||= eval {
FU::MultipartFormData->parse(fu->header('content-type')||'', $FU::REQ->{body})
} || fu->error(400, $@);
}
# Response generation methods
sub done { die bless [200,'Done',FU::_caller_info], 'FU::err' }
sub error($,$code,$msg=$code) { die bless [$code,$msg,FU::_caller_info], 'FU::err' }
sub denied { fu->error(403) }
sub notfound { fu->error(404) }
sub status($, $code) { $FU::REQ->{status} = $code }
sub set_body($, $data) {
confess "Invalid undef body" if !defined $data;
confess "Invalid attempt to set body to $data" if ref $data;
$FU::REQ->{resbody} = $data;
}
sub reset {
fu->status(200);
fu->set_body('');
$FU::REQ->{reshdr} = {
'content-type', 'text/html',
};
delete $FU::REQ->{rescookie};
}
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 defined $val && $val =~ /[\r\n]/;
}
sub add_header($, $hdr, $val) {
_validate_header($hdr, $val);
$hdr = lc $hdr;
my $h = $FU::REQ->{reshdr};
if (!defined $h->{$hdr}) { $h->{$hdr} = $val }
elsif (ref $h->{$hdr}) { push $h->{$hdr}->@*, $val }
else { $h->{$hdr} = [ $h->{$hdr}, $val ] }
}
sub set_header($, $hdr, $val=undef) {
_validate_header($hdr, $val);
$FU::REQ->{reshdr}{ lc $hdr } = $val;
}
sub set_cookie($, $name, $val=undef, %opt) {
confess "Invalid cookie name '$name'" if $name !~ /^$FU::hdrname_re$/;
return delete $FU::REQ->{rescookie}{$name} if !defined $val;
confess "Invalid cookie value: $val" if $val =~ /[\0-\x1f\x7f-\x{10ffff}\s\r\n\t",;\\]/;
my $c = "$name=$val";
for my ($k,$v) (%opt) {
$k = lc $k; # attributes are case-insensitive
if ($k eq 'domain') {
confess "Invalid cookie domain: $v" if $v !~ $FU::Validate::re_domain;
} elsif ($k eq 'expires') {
confess "Cookie 'Expires' attribute should be a UNIX timestamp" if defined $v && $v !~ /^[0-9]+$/;
$v = FU::Util::httpdate_format($v || 0);
} elsif ($k eq 'httponly') {
$c .= "; $k" if $v;
next;
} elsif ($k eq 'max-age') {
confess "Invalid 'Max-Age' cookie attribute: $v" if $v !~ /^[0-9]+$/;
} elsif ($k eq 'partitioned') {
$c .= "; $k" if $v;
next;
} elsif ($k eq 'path') {
confess "Invalid 'Path' cookie attribute: $v" if $v =~ /[\0-\x1f\x7f-\x{10ffff}\s\r\n\t",;\\]/;
} elsif ($k eq 'secure') {
$c .= "; $k" if $v;
next;
} elsif ($k eq 'samesite') {
confess "Invalid 'SameSite' cookie attribute: $v" if $v !~ /^(?:Strict|Lax|None)$/;
}
$c .= "; $k=$v";
}
$FU::REQ->{rescookie}{$name} = $c;
}
sub send_json($, $data) {
fu->set_header('content-type', 'application/json');
fu->set_body(FU::Util::json_format($data, canonical => 1, utf8 => 1));
fu->done;
}
sub send_file($, $root, $path) {
# This also catches files with '..' somewhere in the middle of the name.
# Let's just disallow that to simplify this check, I'd err on the side of
# caution.
return if $path =~ /\.\./;
my $fn = "$root/$path";
return if !-f $fn;
my $m = (stat $fn)[9];
return if !defined $m;
fu->set_header('last-modified', FU::Util::httpdate_format($m));
my $ims = fu->header('if-modified-since');
$ims = FU::Util::httpdate_parse($ims) if $ims;
if ($ims && $ims > $m) {
fu->status(304);
fu->done;
}
my $ctype = FU::mime_types->{$path =~ m{\.([^/\.]+)$} ? lc $1 : ''};
{
open my $fh, '<', $fn or confess "Unable to open '$fn': $!";
local $/=undef;
my $body = <$fh>;
$ctype ||= substr($body, 0, 1024) =~ /[\x00-\x08\x0e-\x1f]/ ? 'application/octet-stream' : 'text/plain';
fu->set_body($body);
}
fu->set_header('content-type', $ctype);
fu->done;
}
sub redirect($, $code, $location) {
state $alias = {qw/ perm 301 temp 302 tempget 303 tempsame 307 permsame 308 /};
fu->status($alias->{$code} // $code);
fu->set_header(location => "$location");
fu->set_header('content-type', 'text/plain');
fu->set_body("Redirecting to $location\n");
fu->done;
}
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 _finalize {
state $hasgzip = FU::Util::gzip_lib();
state $hasbrotli = eval { FU::Util::brotli_compress(6, ''); 1 };
my $r = $FU::REQ;
fu->add_header('set-cookie', $_) for $r->{rescookie} ? sort values $r->{rescookie}->%* : ();
if ($r->{status} == 204 || $r->{status} == 304) {
delete $r->{reshdr}{'content-length'};
delete $r->{reshdr}{'content-encoding'};
delete $r->{reshdr}{'content-type'};
$r->{resbody} = '';
} else {
my @vary = ref $r->{reshdr}{vary} eq 'ARRAY' ? $r->{reshdr}{vary}->@* : defined $r->{reshdr}{vary} ? ($r->{reshdr}{vary}) : ();
if (($hasgzip || $hasbrotli) && length($r->{resbody}) > 256
&& !defined $r->{reshdr}{'content-encoding'}
&& FU::compress_mimes->{$r->{reshdr}{'content-type'}}
) {
push @vary, 'accept-encoding';
if ($hasbrotli && ($r->{hdr}{'accept-encoding'}||'') =~ /\bbr\b/) {
$r->{resbody_orig} = $r->{resbody};
$r->{resbody} = FU::Util::brotli_compress(6, $r->{resbody});
$r->{reshdr}{'content-encoding'} = 'br';
} elsif ($hasgzip && ($r->{hdr}{'accept-encoding'}||'') =~ /\bgzip\b/) {
$r->{resbody_orig} = $r->{resbody};
$r->{resbody} = FU::Util::gzip_compress(6, $r->{resbody});
$r->{reshdr}{'content-encoding'} = 'gzip';
}
}
$r->{reshdr}{vary} = @vary ? join ', ', @vary : undef;
$r->{reshdr}{'content-length'} = length $r->{resbody};
$r->{resbody} = '' if (fu->method//'') eq 'HEAD';
}
$r->{reshdr}{'content-type'} .= '; charset=UTF-8' if FU::utf8_mimes->{ $r->{reshdr}{'content-type'}||'' };
}
sub _flush($, $sock) {
_finalize;
my $r = $FU::REQ;
if ($sock isa 'FU::fcgi') {
$sock->print('Status: ');
$sock->print($r->{status});
$sock->print("\r\n");
} else {
$sock->printf("HTTP/1.0 %d Hello\r\n", $r->{status});
$sock->printf("date: %s\r\n", FU::Util::httpdate_format time);
$sock->print("server: FU\r\n");
}
for my ($hdr, $val) ($r->{reshdr}->%*) {
utf8::encode($hdr);
for (!defined $val ? () : ref $val ? @$val : ($val)) {
utf8::encode($_);
$sock->print($hdr);
$sock->print(': ');
$sock->print($_);
$sock->print("\r\n");
}
}
$sock->print("\r\n");
$sock->print($r->{resbody});
$sock->flush;
}
package FU::err;
use overload '""' => sub { sprintf "FU exception code %d: %s", $_[0][0], $_[0][1] };
1;
__END__
=head1 NAME
FU - A Lean and Efficient Zero-Dependency Web Framework.
=head1 SYNOPSIS
use v5.36;
use FU -spawn;
use FU::XMLWriter ':html5_';
sub myhtml_($title, $body) {
fu->set_body(html_ sub {
head_ sub {
title_ $title;
};
body_ $body;
});
}
fu->set_cookie(auth => $auth_token,
Expires => time()+30*24*3600,
Domain => 'example.com',
Secure => 1,
SameSite => 'Lax'
);
This method does not encode or escape the cookie value in any way. If you want
to set a non-ASCII value or a value containing characters that are not
permitted in the C<Set-Cookie> header, use C<uri_escape()> in L<FU::Util> or
your favorite alternative cookie-safe encoding.
=item fu->set_body($data)
Set the (raw, binary) body of the response to C<$data>. This method is not very
convenient for writing dynamic responses, so usually you'll want to use a
templating system or L<FU::XMLWriter>:
use FU::XMLWriter ':html5_';
fu->set_body(html_ sub {
body_ sub {
h1_ "Hello, world!";
};
});
=item fu->send_json($data)
Encode C<$data> as JSON (using C<json_format> in L<FU::Util>), set an
appropriate C<Content-Type> header and send it to the client. Calls C<<
fu->done >>.
=item fu->send_file($root, $path)
If a file identified by C<"$root/$path"> exists, set that as response and call
C<< fu->done >>. Returns normally if the file does not exist. This method is
mainly intended to serve small static files from a directory:
FU::before_request {
# We can set custom headers before send_file()
fu->set_header('cache-control', 'max-age=31536000');
# Attempt to serve files from '/static/files'
fu->send_file('/static/files', fu->path);
# If that fails, fall back to another directory
fu->send_file('/more/static/files', fu->path);
# Otherwise, continue processing the request as normal
fu->reset;
};
C<$path> may be an untrusted string from the client, this method prevents path
traversal attacks that go below the given C<$root>. It does follow symlinks,
though.
This method loads the entire file contents in memory and does not support range
requests, so DO NOT use it to send large files. Actual web servers are much
more efficient at serving static files.
The content-type header is determined from the file extension in C<$path>,
using the configured C<FU::mime_types>. As fallback, files that look like they
might be text get C<text/plain> and binary files are served with
C<application/octet-stream>.
This method sets an appropriate C<last-modified> header and supports
conditional requests with C<if-modified-since>.
=item fu->redirect($code, $location)
Generates a HTTP redirect response and calls C<< fu->done >>. C<$code> can be
one of the following status codes or an alias:
Status Alias Semantics
----------------------------------------
301 perm Permanent, method may or may not change to GET
302 temp Temporary, method may or may not change to GET
303 tempget Temporary to GET
307 tempsame Temporary without changing method
308 permsame Permanent without changing method
=back
=head1 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
( run in 2.122 seconds using v1.01-cache-2.11-cpan-524268b4103 )