diff --git a/FU.pm b/FU.pm index d5978e2..23aac6c 100644 --- a/FU.pm +++ b/FU.pm @@ -6,6 +6,7 @@ use POSIX (); use Time::HiRes 'time'; use FU::Log 'log_write'; use FU::Util; +use FU::Validate; sub import($pkg, @opt) { @@ -641,7 +642,6 @@ sub _getfield($data, @a) { fu->error(400, "Expected top-level to be a hash") if ref $data ne 'HASH'; return $data->{$a[0]}; } - require FU::Validate; my $schema = FU::Validate->compile(@a > 1 ? { keys => {@a} } : $a[0]); my $res = eval { $schema->validate($data) }; fu->error(400, "Input validation failed: $@") if $@; @@ -729,6 +729,39 @@ sub set_header($, $hdr, $val=undef) { $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)); @@ -804,6 +837,8 @@ sub _finalize { state $haszlib = eval { require Compress::Raw::Zlib; 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'}; @@ -1335,6 +1370,31 @@ Add a response header, can be used to add multiple headers with the same name. Add a response header or overwrite the header with a new value if it already exists. Set C<$value> to undef to remove a previously set header. +=item fu->set_cookie($name, $value, %attributes) + +Set or overwrite a cookie. Set C<$value> to undef to remove a previously set +cookie. To fully remove a cookie from the user's browser, set the cookie with +an empty value and zero C: + + fu->set_cookie(my_cookie => '', 'Max-Age' => 0); + +C<%attributes> can be any of the supported L. +The C attribute, when given, must be a UNIX timestamp. Boolean +attributes are interpreted according to Perl's idea of truthiness. For example: + + 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 header, use C in L 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 @@ -1408,7 +1468,6 @@ one of the following status codes or an alias: =back -I Setting cookies. =head2 Running the Site diff --git a/FU/Util.pm b/FU/Util.pm index a9cca1d..a94aa9e 100644 --- a/FU/Util.pm +++ b/FU/Util.pm @@ -32,6 +32,7 @@ sub uri_escape :prototype($) ($s) { sub uri_unescape :prototype($) ($s) { return if !defined $s; utf8::encode($s); + $s =~ tr/+/ /; $s =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; utf8_decode $s; }