FU: Add fu->set_cookie() (+ uri_unescape '+' fix)

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<Max-Age>:
+
+  fu->set_cookie(my_cookie => '', 'Max-Age' => 0);
+
+C<%attributes> can be any of the supported L<cookie
+attributes|https://developer.mozilla.org/en-US/docs/Web/HTTP/Reference/Headers/Set-Cookie>.
+The C<Expires> 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<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
@@ -1408,7 +1468,6 @@ one of the following status codes or an alias:
 
 =back
 
-I<TODO:> Setting cookies.
 
 
 =head2 Running the Site

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;
 }