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__ |