From 046e84e92ad592c03fac7dd00c2f85a72161fb74 Mon Sep 17 00:00:00 2001
From: David Precious <davidp@preshweb.co.uk>
Date: Tue, 28 Jul 2020 15:03:26 +0100
Subject: [PATCH] Support SameSite cookie attribute.

Needs careful testing.

Also, we probably don't want to set the attribute if the user hasn't
asked us to; at present the code will set it to 'None' - which, while
that's what a standards-compliant browser will interpret the lack of a
SameSite attribute as, it's probably still better to only send it if we
were told to, and omit it if not?
---
 lib/Dancer/Cookie.pm           | 22 +++++++++++++++++-----
 lib/Dancer/Session/Abstract.pm |  2 ++
 t/09_cookies/05_api.t          | 10 +++++++---
 3 files changed, 26 insertions(+), 8 deletions(-)

diff --git a/lib/Dancer/Cookie.pm b/lib/Dancer/Cookie.pm
index 6f2d70331..4f24aaa68 100644
--- a/lib/Dancer/Cookie.pm
+++ b/lib/Dancer/Cookie.pm
@@ -4,10 +4,11 @@ package Dancer::Cookie;
 use strict;
 use warnings;
 
+use Carp;
 use URI::Escape;
 
 use base 'Dancer::Object';
-__PACKAGE__->attributes( qw/name expires domain path secure http_only/ );
+__PACKAGE__->attributes( qw/name expires domain path same_site secure http_only/ );
 
 sub init {
     my ($self, %args) = @_;
@@ -22,6 +23,16 @@ sub init {
         $self->expires($time);
     }
     $self->path('/') unless defined $self->path;
+
+    # If we have a same_site attribute, ensure it's sane:
+    if (my $same_site = $self->same_site) {
+        if ($same_site !~ m{^(Strict|Lax|None)$}) {
+            Carp::croak(
+                "Invalid same_site value '$same_site'"
+                . " - must be 'Strict', 'Lax' or 'None', see RFC6265bis"
+            );
+        }
+    }
 }
 
 sub to_header {
@@ -35,10 +46,11 @@ sub to_header {
     $name =~ s/[=,; \t\r\n\013\014]//mg;
 
     my @headers = $name . '=' . $value;
-    push @headers, "path=" . $self->path        if $self->path;
-    push @headers, "expires=" . $self->expires  if $self->expires;
-    push @headers, "domain=" . $self->domain    if $self->domain;
-    push @headers, "Secure"                     if $self->secure;
+    push @headers, "path="     . $self->path      if $self->path;
+    push @headers, "expires="  . $self->expires   if $self->expires;
+    push @headers, "domain="   . $self->domain    if $self->domain;
+    push @headers, "Secure"                       if $self->secure;
+    push @headers, "SameSite=" . $self->same_site if $self->same_site;
     push @headers, 'HttpOnly'                   unless $no_httponly;
 
     return join '; ', @headers;
diff --git a/lib/Dancer/Session/Abstract.pm b/lib/Dancer/Session/Abstract.pm
index 818e67402..b369da0d3 100644
--- a/lib/Dancer/Session/Abstract.pm
+++ b/lib/Dancer/Session/Abstract.pm
@@ -144,6 +144,8 @@ sub write_session_id {
         secure => setting('session_secure'),
         http_only => defined(setting("session_is_http_only")) ?
                      setting("session_is_http_only") : 1,
+        same_site => defined(setting("session_same_site")) ?
+                    setting("session_same_site") ? 'None',
     );
     if (my $expires = setting('session_expires')) {
         # It's # of seconds from the current time
diff --git a/t/09_cookies/05_api.t b/t/09_cookies/05_api.t
index 461c51ef0..ba0b26a87 100644
--- a/t/09_cookies/05_api.t
+++ b/t/09_cookies/05_api.t
@@ -3,9 +3,10 @@ use Dancer ':syntax';
 
 my @tests = (
     { name => 'foo', value => 42 ,            opts => {}},
-    { name => 'foo', value => 42 ,            opts => { http_only => 1 } },
-    { name => 'msg', value => 'hello; world', opts => {} },
-    { name => 'msg', value => 'hello; world', opts => { http_only => 0 } },
+    { name => 'foo', value => 42 ,            opts => { http_only => 1 }     },
+    { name => 'msg', value => 'hello; world', opts => {}                     },
+    { name => 'msg', value => 'hello; world', opts => { http_only => 0 }     },
+    { name => 'ss',  value => 'samesitetest', opts => { same_site => 'Lax' } },
 );
 
 plan tests => scalar (@tests * 5) + 12;
@@ -21,6 +22,9 @@ foreach my $test (@tests) {
     is $c->http_only,
        (exists($test->{opts}{http_only}) ? $test->{opts}{http_only} : undef),
        "HttpOnly is correctly set";
+    is $c->same_site,
+       (exists($test->{opts}{same_site}) ? $test->{opts}{same_site} : undef),
+       "SameSite is correctly set";
 }
 
 {