use strict; use warnings; use Test::More; use YAML; use Test::TCP 1.13; use File::Temp 0.22; use LWP::UserAgent; use HTTP::Date qw/str2time/; use File::Spec; sub extract_cookie { my ($res) = @_; my @cookies = $res->header('set-cookie'); for my $c (@cookies) { next unless $c =~ /dancer\.session/; my @parts = split /;\s+/, $c; my %hash = map { my ($k, $v) = split /\s*=\s*/; $v ||= 1; (lc($k), $v) } @parts; $hash{expires} = str2time($hash{expires}) if $hash{expires}; return \%hash; } return; } my $tempdir = File::Temp::tempdir(CLEANUP => 1, TMPDIR => 1); my @engines = qw(YAML Simple); if ($ENV{DANCER_TEST_COOKIE}) { push @engines, "cookie"; setting(session_cookie_key => "secret/foo*@!"); } foreach my $engine (@engines) { diag "Testing engine $engine"; Test::TCP::test_tcp( client => sub { my $port = shift; my $ua = LWP::UserAgent->new; $ua->cookie_jar({file => "$tempdir/.cookies.txt"}); # no session cookie set if session not referenced my $res = $ua->get("http://127.0.0.1:$port/no_session_data"); ok $res->is_success, "/no_session_data" or diag explain $res; my $cookie = extract_cookie($res); ok !$cookie, "no cookie set" or diag explain $cookie; # empty session created if session read attempted $res = $ua->get("http://127.0.0.1:$port/read_session"); ok $res->is_success, "/read_session"; $cookie = extract_cookie($res); ok $cookie, "session cookie set" or diag explain $cookie; my $sid1 = $cookie->{"dancer.session"}; like $res->content, qr/name=''/, "empty session"; # set value into session $res = $ua->get("http://127.0.0.1:$port/set_session/larry"); ok $res->is_success, "/set_session/larry"; $cookie = extract_cookie($res); ok $cookie, "session cookie set" or diag explain $cookie; # read value back $res = $ua->get("http://127.0.0.1:$port/read_session"); ok $res->is_success, "/read_session"; $cookie = extract_cookie($res); ok $cookie, "session cookie set" or diag explain $cookie; like $res->content, qr/name='larry'/, "session value looks good"; # session cookie should persist even if we don't touch sessions $res = $ua->get("http://127.0.0.1:$port/no_session_data"); ok $res->is_success, "/no_session_data"; $cookie = extract_cookie($res); ok $cookie, "session cookie set" or diag explain $cookie; # destroy session and check that cookies expiration is set $res = $ua->get("http://127.0.0.1:$port/destroy_session"); ok $res->is_success, "/destroy_session"; $cookie = extract_cookie($res); ok $cookie, "session cookie set" or diag explain $cookie; is $cookie->{"dancer.session"}, $sid1, "correct cookie expired"; ok $cookie->{expires} < time, "session cookie is expired"; # shouldn't be sent session cookie after session destruction $res = $ua->get("http://127.0.0.1:$port/no_session_data"); ok $res->is_success, "/no_session_data"; $cookie = extract_cookie($res); ok !$cookie, "no cookie set" or diag explain $cookie; # set value into session again $res = $ua->get("http://127.0.0.1:$port/set_session/curly"); ok $res->is_success, "/set_session/larry"; $cookie = extract_cookie($res); ok $cookie, "session cookie set" or diag explain $cookie; my $sid2 = $cookie->{"dancer.session"}; isnt $sid2, $sid1, "New session has different ID"; # destroy and create a session in one request $res = $ua->get("http://127.0.0.1:$port/churn_session"); ok $res->is_success, "/churn_session"; $cookie = extract_cookie($res); ok $cookie, "session cookie set" or diag explain $cookie; my $sid3 = $cookie->{"dancer.session"}; isnt $sid3, $sid2, "Changed session has different ID"; # read value back $res = $ua->get("http://127.0.0.1:$port/read_session"); ok $res->is_success, "/read_session"; $cookie = extract_cookie($res); ok $cookie, "session cookie set" or diag explain $cookie; like $res->content, qr/name='damian'/, "session value looks good"; File::Temp::cleanup(); }, server => sub { my $port = shift; use Dancer; get '/no_session_data' => sub { return "session not modified"; }; get '/set_session/*' => sub { my ($name) = splat; session name => $name; }; get '/read_session' => sub { my $name = session('name') || ''; "name='$name'"; }; get '/destroy_session' => sub { my $name = session('name') || ''; context->destroy_session; return "destroyed='$name'"; }; get '/churn_session' => sub { context->destroy_session; session name => 'damian'; return "churned"; }; setting appdir => $tempdir; setting(engines => {session => {$engine => {session_dir => 't/sessions'}}}); setting(session => $engine); set(show_errors => 1, startup_info => 0, environment => 'production', port => $port ); Dancer->runner->server->port($port); start; }, ); } done_testing;