File Coverage

lib/Dancer/Session/Cookie.pm
Criterion Covered Total %
statement 83 85 97.6
branch 16 22 72.7
condition 5 5 100.0
subroutine 25 27 92.5
pod 8 8 100.0
total 137 147 93.2


line stmt bran cond sub pod time code
1             package Dancer::Session::Cookie;
2             our $AUTHORITY = 'cpan:YANICK';
3             $Dancer::Session::Cookie::VERSION = '0.26';
4 10     10   930395 use strict;
  10         21  
  10         268  
5 10     10   53 use warnings;
  10         20  
  10         309  
6             # ABSTRACT: Encrypted cookie-based session backend for Dancer
7             # VERSION
8              
9 10     10   49 use base 'Dancer::Session::Abstract';
  10         18  
  10         7160  
10              
11 10     10   16854 use Session::Storage::Secure 0.010;
  10         825187  
  10         441  
12 10     10   107 use Crypt::CBC;
  10         25  
  10         349  
13 10     10   8524 use String::CRC32;
  10         4584  
  10         743  
14 10     10   66 use Crypt::Rijndael;
  10         24  
  10         263  
15 10     10   6428 use Time::Duration::Parse;
  10         19662  
  10         66  
16              
17 10     10   613 use Dancer 1.3113 ':syntax'; # 1.3113 for on_reset_state and fixed after hook
  10         191  
  10         90  
18 10     10   4736 use Dancer::Cookie ();
  10         20  
  10         148  
19 10     10   48 use Dancer::Cookies ();
  10         26  
  10         135  
20 10     10   48 use Storable ();
  10         25  
  10         166  
21 10     10   52 use MIME::Base64 ();
  10         14  
  10         8774  
22              
23             # crydec
24             my $CIPHER = undef;
25             my $STORE = undef;
26              
27             # cache session here instead of flushing/reading from cookie all the time
28             my $SESSION = undef;
29              
30 99     99 1 1013 sub is_lazy { 1 }; # avoid calling flush needlessly
31              
32             sub init {
33 36     36 1 25379 my ($self) = @_;
34              
35 36         841 $self->SUPER::init();
36              
37 36 100       11126 my $key = setting("session_cookie_key") # XXX default to smth with warning
38             or die "The setting session_cookie_key must be defined";
39              
40 34         865 my $duration = $self->_session_expires_as_duration;
41              
42 34         368 $CIPHER = Crypt::CBC->new(
43             -key => $key,
44             -cipher => 'Rijndael',
45             );
46              
47 34 100       4767 $STORE = Session::Storage::Secure->new(
48             secret_key => $key,
49             ( $duration ? ( default_duration => $duration ) : () ),
50             sereal_encoder_options => { snappy => 1, stringify_unknown => 1 },
51             sereal_decoder_options => { validate_utf8 => 1 },
52             );
53             }
54              
55             # return our cached ID if we have it instead of looking in a cookie
56             sub read_session_id {
57 204     204 1 83472 my ($self) = @_;
58 204 100       688 return $SESSION->id
59             if defined $SESSION;
60 56         332 return $self->SUPER::read_session_id;
61             }
62              
63             sub retrieve {
64 192     192 1 5661 my ( $class, $id ) = @_;
65             # if we have a cached session, hand that back instead
66             # of decrypting again
67 192 100 100     681 return $SESSION
68             if $SESSION && $SESSION->id eq $id;
69              
70 43         89 my $ses = eval {
71 43 100       221 if ( my $hash = $STORE->decode($id) ) {
72             # we recover a plain hash, so reconstruct into object
73 42         22603 bless $hash, $class;
74             }
75             else {
76 1         42 _old_retrieve($id);
77             }
78             };
79              
80 43         542 return $SESSION = $ses;
81             }
82              
83             # support decoding old cookies
84             sub _old_retrieve {
85 1     1   2 my ($id) = @_;
86             # 1. decrypt and deserialize $id
87 1         5 my $plain_text = _old_decrypt($id);
88             # 2. deserialize
89 0 0       0 $plain_text && Storable::thaw($plain_text);
90             }
91              
92             sub create {
93             # cache the newly created session
94 22     22 1 53332 return $SESSION = Dancer::Session::Cookie->new;
95             }
96              
97             # we don't write session ID when told; we do it in the after hook
98       204 1   sub write_session_id { }
99              
100             # we don't flush when we're told; we do it in the after hook
101       0 1   sub flush { }
102              
103             sub destroy {
104 4     4 1 21 my $self = shift;
105              
106             # gross hack; replace guts with new session guts
107 4         6 %$self = %{ Dancer::Session::Cookie->new };
  4         13  
108              
109 4         1338 return 1;
110             }
111              
112             # Copied from Dancer::Session::Abstract::write_session_id and
113             # refactored for testing
114             hook 'after' => sub {
115             my $response = shift;
116              
117             if ($SESSION) {
118             # UGH! Awful hack because Dancer instantiates responses
119             # and headers too many times and locks out new cookies
120             $response->{_built_cookies} = 0;
121              
122             my $c = Dancer::Cookie->new( $SESSION->_cookie_params );
123             Dancer::Cookies->set_cookie_object( $c->name => $c );
124             }
125             };
126              
127             # Make sure that the session is initially undefined for every request
128             hook 'on_reset_state' => sub {
129             my $is_forward = shift;
130             undef $SESSION unless $is_forward;
131             };
132              
133             # modified from Dancer::Session::Abstract::write_session_id to add
134             # support for session_cookie_path
135             sub _cookie_params {
136 67     67   5413 my $self = shift;
137 67         244 my $name = $self->session_name;
138 67         647 my $duration = $self->_session_expires_as_duration;
139 67 50 100     179 my %cookie = (
140             name => $name,
141             value => $self->_cookie_value,
142             path => setting('session_cookie_path') || '/',
143             domain => setting('session_domain'),
144             secure => setting('session_secure'),
145             http_only => defined( setting("session_is_http_only") )
146             ? setting("session_is_http_only")
147             : 1,
148             );
149 67 100       233778 if ( defined $duration ) {
150 26         97 $cookie{expires} = time + $duration;
151             }
152 67         544 return %cookie;
153             }
154              
155             # refactored for testing
156             sub _cookie_value {
157 69     69   17373 my ($self) = @_;
158             # copy self guts so we aren't serializing a blessed object.
159             # we don't set expires, because default_duration will handle it
160 69         466 return $STORE->encode( {%$self} );
161             }
162              
163             # session_expires could be natural language
164             sub _session_expires_as_duration {
165 101     101   160 my ($self) = @_;
166 101         277 my $session_expires = setting('session_expires');
167 101 100       2093 return unless defined $session_expires;
168 33         47 my $duration = eval { parse_duration($session_expires) };
  33         108  
169 33 50       952 die "Could not parse session_expires: $session_expires"
170             unless defined $duration;
171 33         75 return $duration;
172             }
173              
174             # legacy algorithm
175             sub _old_decrypt {
176 1     1   2 my $cookie = shift;
177              
178 1         2 $cookie =~ tr{_*-}{=+/};
179              
180 1     0   6 $SIG{__WARN__} = sub { };
181 1         17 my ( $crc32, $plain_text ) = unpack "La*",
182             $CIPHER->decrypt( MIME::Base64::decode($cookie) );
183 0 0         return $crc32 == String::CRC32::crc32($plain_text) ? $plain_text : undef;
184             }
185              
186             1;
187              
188             =pod
189              
190             =encoding UTF-8
191              
192             =head1 NAME
193              
194             Dancer::Session::Cookie - Encrypted cookie-based session backend for Dancer
195              
196             =head1 VERSION
197              
198             version 0.26
199              
200             =head1 SYNOPSIS
201              
202             Your F:
203              
204             session: "cookie"
205             session_cookie_key: "this random key IS NOT very random"
206              
207             =head1 DESCRIPTION
208              
209             This module implements a session engine for sessions stored entirely
210             in cookies. Usually only B is stored in cookies and
211             the session data itself is saved in some external storage, e.g.
212             database. This module allows to avoid using external storage at
213             all.
214              
215             Since server cannot trust any data returned by client in cookies, this
216             module uses cryptography to ensure integrity and also secrecy. The
217             data your application stores in sessions is completely protected from
218             both tampering and analysis on the client-side.
219              
220             Do be aware that browsers limit the size of individual cookies, so this method
221             is not suitable if you wish to store a large amount of data. Browsers typically
222             limit the size of a cookie to 4KB, but that includes the space taken to store
223             the cookie's name, expiration and other attributes as well as its content.
224              
225             =head1 CONFIGURATION
226              
227             The setting B should be set to C in order to use this session
228             engine in a Dancer application. See L.
229              
230             A mandatory setting is needed as well: B, which should
231             contain a random string of at least 16 characters (shorter keys are
232             not cryptographically strong using AES in CBC mode).
233              
234             The optional B setting can also be passed,
235             which will provide the duration time of the cookie. If it's not present, the
236             cookie won't have an expiration value.
237              
238             Here is an example configuration to use in your F:
239              
240             session: "cookie"
241             session_cookie_key: "kjsdf07234hjf0sdkflj12*&(@*jk"
242             session_expires: 1 hour
243              
244             Compromising B will disclose session data to
245             clients and proxies or eavesdroppers and will also allow tampering,
246             for example session theft. So, your F should be kept at
247             least as secure as your database passwords or even more.
248              
249             Also, changing B will have an effect of immediate
250             invalidation of all sessions issued with the old value of key.
251              
252             B can be used to control the path of the session
253             cookie. The default is /.
254              
255             The global B setting is honoured and a secure (https
256             only) cookie will be used if set.
257              
258             =head1 DEPENDENCY
259              
260             This module depends on L. Legacy support is provided
261             using L, L, L, L and
262             L.
263              
264             =head1 SEE ALSO
265              
266             See L for details about session usage in route handlers.
267              
268             See L,
269             L, L for alternative implementation of this mechanism.
270              
271             =head1 AUTHORS
272              
273             =over 4
274              
275             =item *
276              
277             Alex Kapranoff
278              
279             =item *
280              
281             Alex Sukria
282              
283             =item *
284              
285             David Golden
286              
287             =item *
288              
289             Yanick Champoux
290              
291             =back
292              
293             =head1 COPYRIGHT AND LICENSE
294              
295             This software is copyright (c) 2015 by Alex Kapranoff.
296              
297             This is free software; you can redistribute it and/or modify it under
298             the same terms as the Perl 5 programming language system itself.
299              
300             =cut
301              
302             __END__