File Coverage

blib/lib/Dancer/Session/ElasticSearch.pm

Criterion	Covered	Total	%
statement	9	9	100.0
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	12	12	100.0

package Dancer::Session::ElasticSearch;

use strict;
use warnings;
use base 'Dancer::Session::Abstract';

use v5.10.0;
use Dancer qw(:syntax);
use ElasticSearch;
use Try::Tiny;
use Digest::HMAC_SHA1 qw();

our $VERSION   = 1.007;
our $es        = undef;
our $data      = {};

sub create {
    my $self = __PACKAGE__->new;

    $data = {};

    my $id = $self->_es->index( data => $data )->{_id};

    $self->id( $self->_sign($id) );

    return $self;
}

sub flush {
    my $self = shift;

    my $session_data = $data->{$self->id};

    try {
        my $id           = $self->_verify( $self->id );
        $self->_es->index( data => {%$session_data}, id => $id );
        $data    = {};
    }
    catch {
        warning("Could not flush session ID ". $self->id . " - $_");
        return;
    };

    return $self;
}

sub retrieve {
    my ( $self, $session_id ) = @_;

    my $session_data = try {
        # return what we have if the session is_lazy
        return $data->{$session_id} if defined $data->{$session_id} and $self->is_lazy;

        my $id  = $self->_verify($session_id);
        my $get = $self->_es->get( id => $id, ignore_missing => 1 );

        # store data locally if we're lazy
        my $source = defined $get ? $get->{_source} : {};
        $data->{$session_id} = $source if $self->is_lazy;

        return $source;
    }
    catch {
        warning("Could not retrieve session ID $session_id - $_");
        return;
    };

    $session_data->{id} = $session_id;

    return bless $session_data, __PACKAGE__;
}

sub destroy {
    my $self = shift;
    try {
        $self->_es->delete( id => $self->id );
        $self->write_session_id(0);
        delete $self->{id};
        $data = {};
    }
    catch {
        warning( "Could not delete session ID " . $self->id . " - $_" );
        return;
    };
}

sub init { }

sub is_lazy {
    return setting('session_options')->{is_lazy} // 1;
}

# internal methods

sub _es {

    return $es if defined $es;

    my $settings = setting('session_options');

    $es = ElasticSearch->new( %{ $settings->{connection} } );
    $es->use_type( $settings->{type}   // 'session' );
    $es->use_index( $settings->{index} // 'session' );

    return $es;

}

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

    my $settings = setting('session_options');
    my $length = $settings->{signing}{length} || 10;

    my $salt = join "",
        ( '.', '/', 0 .. 9, 'A' .. 'Z', 'a' .. 'z' )
        [ map { rand 64 } ( 1 .. $length ) ];
    my $hash = $self->_hash( $id, $salt );

    return ( $hash . $salt . $id );
}

sub _verify {
    my ( $self, $string ) = @_;

    my $settings = setting('session_options');
    my $length = $settings->{signing}{length} || 10;

    my ( $hash, $salt, $id ) = unpack "A${length}A${length}A*", $string;

    return $hash eq $self->_hash( $id, $salt )
        ? $id
        : die "Session ID not verified";
}

sub _hash {
    my ( $self, $id, $salt ) = @_;
    my $settings = setting('session_options');
    my $secret   = $settings->{signing}{secret};
    my $length   = $settings->{signing}{length} || 10;

    return
        lc substr( Digest::HMAC_SHA1::hmac_sha1_hex( $id, $secret . $salt ),
        0, $length );
}

1;

__END__