FU
view release on metacpan or search on metacpan
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 };
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 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]/;
}
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 $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>
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");
};
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
FU/DebugImpl.pm view on Meta::CPAN
tr_ sub {
td_ $k;
td_ $_;
} for !defined $v ? () : ref $v ? @$v : ($v);
}
};
my $body = $r->{resbody_orig} // $r->{resbody};
if (length $body) {
h2_ 'Body';
section_ class => 'tabs', sub {
my $json = ($r->{reshdr}{'content-type'}||'') =~ /^application\/json/ && eval { FU::Util::json_parse($body, utf8 => 1) };
details_ name => 'resbody', open => !0, sub {
summary_ 'JSON';
pre_ FU::Util::json_format($json, pretty => 1, canonical => 1);
} if $json;
details_ name => 'resbody', open => !0,sub {
my($lbl, $data) = raw_data $body;
summary_ "Raw ($lbl)";
pre_ $data;
};
}
FU/DebugImpl.pm view on Meta::CPAN
#row${_}_c:not(:checked) ~ * label[for=row${_}_c] .open { display: none }
#row${_}_c:not(:checked) ~ * #row${_} { display: none }
}, 0..1000;
}
sub render {
my $q = fu->query;
if (!$q) {
fu->set_body(framework_ [{id => 'lst', title => 'Recent Requests', html => fragment \&listing_ }]);
} elsif ($q eq 'css') {
fu->set_header('content-type', 'text/css');
fu->set_header('cache-control', 'max-age=86400');
fu->set_body(css());
} elsif ($q eq 'cur') {
fu->set_body(framework_ collect);
} elsif ($q eq 'last') {
my $lst = listing;
fu->notfound if !@$lst;
load $lst->[$#$lst];
} elsif ($FU::debug_info->{storage} && $q =~ /^[0-9a-f]{22}$/) {
load $q;
FU/MultipartFormData.pm view on Meta::CPAN
start => pos $data,
}, $pkg;
confess "Missing content-disposition header" if $hdrs !~ /content-disposition:\s*form-data(.+)/i;
my $v = $1;
my $pvalue = qr/("(?:\\[\\"]|[^\\"\r\n]+)*"|[^\s;"]*)/;
confess "Missing 'name' parameter" if $v !~ /;\s*name\s*=\s*$pvalue/;
$d->{name} = utf8_decode _arg $1;
$d->{filename} = utf8_decode _arg $1 if $v =~ /;\s*filename\s*=\s*$pvalue/;
if ($hdrs =~ /content-type:\s*$pvalue(?:\s*;\s*charset\s*=\s*$pvalue)?/i) {
$d->{mime} = utf8_decode _arg $1;
$d->{charset} = utf8_decode _arg $2 if $2;
}
push @a, $d;
}
confess "Missing end-of-data marker" if @a && !defined $a[$#a]{length};
\@a
}
sub name { $_[0]{name} }
/* https://www.rfc-editor.org/rfc/rfc3875 */
/* Request header */
if (p.namelen > 5 && memcmp(p.name, "HTTP_", 5) == 0) {
p.namelen -= 5;
p.name += 5;
for (r=0; r<p.namelen; r++)
p.name[r] = p.name[r] == '_' ? '-' : p.name[r] >= 'A' && p.name[r] <= 'Z' ? p.name[r] | 0x20 : p.name[r];
if (!(p.namelen == 14 && memcmp(p.name, "content-length", 14) == 0)
&& !(p.namelen == 12 && memcmp(p.name, "content-type", 12) == 0)) {
valsv = newSV(p.vallen+1);
hv_store(ctx->headers, p.name, p.namelen, valsv, 0);
}
} else if (p.namelen == 14 && memcmp(p.name, "CONTENT_LENGTH", 14) == 0) {
valsv = newSV(p.vallen+1);
hv_stores(ctx->headers, "content-length", valsv);
} else if (p.namelen == 12 && memcmp(p.name, "CONTENT_TYPE", 12) == 0) {
valsv = newSV(p.vallen+1);
hv_stores(ctx->headers, "content-type", valsv);
} else if (p.namelen == 11 && memcmp(p.name, "REMOTE_ADDR", 11) == 0) {
valsv = newSV(p.vallen+1);
hv_stores(ctx->params, "ip", valsv);
} else if (p.namelen == 12 && memcmp(p.name, "QUERY_STRING", 12) == 0) {
valsv = newSV(p.vallen+1);
hv_stores(ctx->params, "qs", valsv);
} else if (p.namelen == 14 && memcmp(p.name, "REQUEST_METHOD", 14) == 0) {
start;
begin 5, 1, 1;
record 5, 4, "\x0e\x01CONTENT_LENGTH5\x0c\x05CONTENT_TYPEtext/";
record 5, 4, "\x0b\x04REMOTE_ADDRaddr\x0c\x05QUERY_STRINGquery";
record 5, 4, "\x0e\x04REQUEST_METHODPOST\x0b\x06REQUEST_URI/p\x81t\x55/";
record 5, 4, "";
record 5, 5, "hello";
record 5, 5, "";
isrec
{ 'content-length', 5, 'content-type', 'text/' },
{ ip => 'addr', body => 'hello', qs => 'query', path => "/p\x81t\x55/", method => 'POST' };
$f->print("Status: 200\r\n");
$f->print("Something else");
$f->flush;
isrecv "\1\6\0\5\0\x1b\0\0"."Status: 200\r\nSomething else";
isrecv "\1\6\0\5\0\0\0\0";
isrecv "\1\3\0\5\0\x08\0\0"."\0\0\0\0\0\0\0\0";
# Same connection:
begin;
record 1, 4, "\x00\x00\x06\x00HTTP_x\x00\x00";
record 1, 4, "";
record 0, 9, "\x0d\0FCGI_MAX_REQS\x0e\0FCGI_MAX_CONNS\2\3hi987\x0f\0FCGI_MPXS_CONNS";
record 1, 5, "";
isrec {}, {body => ''};
isrecv "\1\x0a\0\0\0\x37\0\0"."\x0d\3FCGI_MAX_REQS123\x0e\3FCGI_MAX_CONNS123\x0f\1FCGI_MPXS_CONNS0";
start;
begin;
record 1, 4, "\x0c\x05CONTENT_TYPEsomet";
record 1, 2, "";
isrec {'content-type','somet'}, {body => ''}, -6;
start;
begin;
record 1, 4, "\x13\x01HTTP_CONTENT_LENGTH3\x0e\x01CONTENT_LENGTH0\x13\x01HTTP_CONTENT_LENGTH5";
record 1, 4, "";
record 1, 5, "";
isrec {'content-length','0'}, {body => ''};
$remote->close;
ok !eval { $f->flush; 1 };
t/multipart.t view on Meta::CPAN
use v5.36;
use Test::More;
use FU::MultipartFormData;
# Example based on https://developer.mozilla.org/en-US/docs/Web/HTTP/Methods/POST
my $t = <<'_' =~ s/\n/\r\n/rg;
--delimiter12345
Content-Disposition: form-data; name="field1"
content-type: hello; charset=x
value1
--delimiter12345
Content-Type: text
Content-Disposition: form-data; filename="example.txt"; name=field2
value2
--delimiter12345
Content-Type: something; charset = " a b \\ c "
Content-Disposition: form-data; name = "field \" name" ;filename= "月姫.jpg"
( run in 0.950 second using v1.01-cache-2.11-cpan-d7f47b0818f )