File Coverage

blib/lib/Plack/Middleware/Session/Cookie.pm

Criterion	Covered	Total	%
statement	49	65	75.3
branch	6	16	37.5
condition			n/a
subroutine	17	21	80.9
pod	2	8	25.0
total	74	110	67.2

package Plack::Middleware::Session::Cookie;
use strict;
use parent qw(Plack::Middleware::Session);

use Plack::Util::Accessor qw(secret session_key domain expires path secure httponly
                             partitioned samesite serializer deserializer);

use Digest::HMAC_SHA1;
use MIME::Base64 ();
use Storable ();
use Time::HiRes;
use Plack::Util;

use Plack::Session::State::Cookie;

sub prepare_app {
    my $self = shift;

    die "Plack::Session::Middleware::Cookie requires setting 'secret' option."
      unless $self->secret;

    $self->session_key("plack_session") unless $self->session_key;

    $self->serializer(sub {MIME::Base64::encode(Storable::nfreeze($_[0]), '' )})
      unless $self->serializer;

    $self->deserializer(sub {Storable::thaw(MIME::Base64::decode($_[0]))})
      unless $self->deserializer;

    $self->state( Plack::Session::State::Cookie->new );
    for my $attr (qw(session_key path domain expires secure partitioned httponly samesite)) {
        $self->state->$attr($self->$attr);
    }
}

sub _compare {
    my($s1, $s2) = @_;

    return if length $s1 != length $s2;
    my $r = 0;
    for my $i (0..length($s1) - 1) {
        $r |= ord(substr $s1, $i) ^ ord(substr $s2, $i);
    }

    return $r == 0;
}

sub get_session {
    my($self, $request) = @_;

    my $cookie = $self->state->get_session_id($request) or return;

    my($time, $b64, $sig) = split /:/, $cookie, 3;
    _compare($self->sig($b64), $sig) or return;

    # NOTE: do something with $time?

    my $session = $self->deserializer->($b64);
    return ($self->generate_id, $session);
}

sub generate_id {
    my $self = shift;
    return scalar Time::HiRes::gettimeofday;
}

sub commit { }

sub change_id {
    my($self, $env) = @_;

    my $options = $env->{'psgix.session.options'};

    $options->{id} = $self->generate_id($env);
}

sub expire_session {
    my($self, $id, $res, $env) = @_;
    $self->state->expire_session_id($id, $res, $env->{'psgix.session.options'});
}

sub save_state {
    my($self, $id, $res, $env) = @_;

    my $cookie = $self->_serialize($id, $env->{'psgix.session'});
    $self->state->finalize($cookie, $res, $env->{'psgix.session.options'});
}

sub _serialize {
    my($self, $id, $session) = @_;

    my $b64 = $self->serializer->($session);
    join ":", $id, $b64, $self->sig($b64);
}

sub sig {
    my($self, $b64) = @_;
    return '.' unless $self->secret;
    Digest::HMAC_SHA1::hmac_sha1_hex($b64, $self->secret);
}

1;

__END__