| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
package Catalyst::Plugin::Session; |
|
4
|
3
|
|
|
3
|
|
150
|
use base qw/Class::Accessor::Fast/; |
|
|
3
|
|
|
|
|
44
|
|
|
|
3
|
|
|
|
|
57
|
|
|
5
|
|
|
|
|
|
|
|
|
6
|
3
|
|
|
3
|
|
54
|
use strict; |
|
|
3
|
|
|
|
|
27
|
|
|
|
3
|
|
|
|
|
42
|
|
|
7
|
3
|
|
|
3
|
|
48
|
use warnings; |
|
|
3
|
|
|
|
|
30
|
|
|
|
3
|
|
|
|
|
46
|
|
|
8
|
|
|
|
|
|
|
|
|
9
|
3
|
|
|
3
|
|
158
|
use NEXT; |
|
|
3
|
|
|
|
|
33
|
|
|
|
3
|
|
|
|
|
79
|
|
|
10
|
3
|
|
|
3
|
|
111
|
use Catalyst::Exception (); |
|
|
3
|
|
|
|
|
907
|
|
|
|
3
|
|
|
|
|
36
|
|
|
11
|
3
|
|
|
3
|
|
163
|
use Digest (); |
|
|
3
|
|
|
|
|
32
|
|
|
|
3
|
|
|
|
|
30
|
|
|
12
|
3
|
|
|
3
|
|
101
|
use overload (); |
|
|
3
|
|
|
|
|
28
|
|
|
|
3
|
|
|
|
|
33
|
|
|
13
|
3
|
|
|
3
|
|
296
|
use Object::Signature (); |
|
|
3
|
|
|
|
|
31
|
|
|
|
3
|
|
|
|
|
31
|
|
|
14
|
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
our $VERSION = "0.14"; |
|
16
|
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
my @session_data_accessors; |
|
18
|
|
|
|
|
|
|
BEGIN { |
|
19
|
3
|
|
|
3
|
|
99
|
__PACKAGE__->mk_accessors( |
|
20
|
|
|
|
|
|
|
"_session_delete_reason", |
|
21
|
|
|
|
|
|
|
@session_data_accessors = qw/ |
|
22
|
|
|
|
|
|
|
_sessionid |
|
23
|
|
|
|
|
|
|
_session |
|
24
|
|
|
|
|
|
|
_session_expires |
|
25
|
|
|
|
|
|
|
_extended_session_expires |
|
26
|
|
|
|
|
|
|
_session_data_sig |
|
27
|
|
|
|
|
|
|
_flash |
|
28
|
|
|
|
|
|
|
_flash_keep_keys |
|
29
|
|
|
|
|
|
|
_flash_key_hashes |
|
30
|
|
|
|
|
|
|
_tried_loading_session_id |
|
31
|
|
|
|
|
|
|
_tried_loading_session_data |
|
32
|
|
|
|
|
|
|
_tried_loading_session_expires |
|
33
|
|
|
|
|
|
|
_tried_loading_flash_data |
|
34
|
|
|
|
|
|
|
/ |
|
35
|
|
|
|
|
|
|
); |
|
36
|
|
|
|
|
|
|
} |
|
37
|
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
sub setup { |
|
39
|
5
|
|
|
5
|
1
|
229
|
my $c = shift; |
|
40
|
|
|
|
|
|
|
|
|
41
|
5
|
|
|
|
|
97
|
$c->NEXT::setup(@_); |
|
42
|
|
|
|
|
|
|
|
|
43
|
5
|
|
|
|
|
1554
|
$c->check_session_plugin_requirements; |
|
44
|
2
|
|
|
|
|
33
|
$c->setup_session; |
|
45
|
|
|
|
|
|
|
|
|
46
|
2
|
|
|
|
|
477
|
return $c; |
|
47
|
|
|
|
|
|
|
} |
|
48
|
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
sub check_session_plugin_requirements { |
|
50
|
5
|
|
|
5
|
1
|
50
|
my $c = shift; |
|
51
|
|
|
|
|
|
|
|
|
52
|
5
|
100
|
100
|
|
|
59
|
unless ( $c->isa("Catalyst::Plugin::Session::State") |
|
53
|
|
|
|
|
|
|
&& $c->isa("Catalyst::Plugin::Session::Store") ) |
|
54
|
|
|
|
|
|
|
{ |
|
55
|
3
|
|
|
|
|
4037
|
my $err = |
|
56
|
|
|
|
|
|
|
( "The Session plugin requires both Session::State " |
|
57
|
|
|
|
|
|
|
. "and Session::Store plugins to be used as well." ); |
|
58
|
|
|
|
|
|
|
|
|
59
|
3
|
|
|
|
|
61
|
$c->log->fatal($err); |
|
60
|
3
|
|
|
|
|
781
|
Catalyst::Exception->throw($err); |
|
61
|
|
|
|
|
|
|
} |
|
62
|
|
|
|
|
|
|
} |
|
63
|
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
sub setup_session { |
|
65
|
2
|
|
|
2
|
1
|
19
|
my $c = shift; |
|
66
|
|
|
|
|
|
|
|
|
67
|
2
|
|
100
|
|
|
23
|
my $cfg = ( $c->config->{session} ||= {} ); |
|
68
|
|
|
|
|
|
|
|
|
69
|
2
|
|
|
|
|
54
|
%$cfg = ( |
|
70
|
|
|
|
|
|
|
expires => 7200, |
|
71
|
|
|
|
|
|
|
verify_address => 0, |
|
72
|
|
|
|
|
|
|
%$cfg, |
|
73
|
|
|
|
|
|
|
); |
|
74
|
|
|
|
|
|
|
|
|
75
|
2
|
|
|
|
|
42
|
$c->NEXT::setup_session(); |
|
76
|
|
|
|
|
|
|
} |
|
77
|
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
sub prepare_action { |
|
79
|
1
|
|
|
1
|
1
|
338
|
my $c = shift; |
|
80
|
|
|
|
|
|
|
|
|
81
|
1
|
50
|
33
|
|
|
20
|
if ( $c->config->{session}{flash_to_stash} |
|
|
|
|
33
|
|
|
|
|
|
82
|
|
|
|
|
|
|
and $c->sessionid |
|
83
|
|
|
|
|
|
|
and my $flash_data = $c->flash ) |
|
84
|
|
|
|
|
|
|
{ |
|
85
|
1
|
|
|
|
|
26
|
@{ $c->stash }{ keys %$flash_data } = values %$flash_data; |
|
|
1
|
|
|
|
|
15
|
|
|
86
|
|
|
|
|
|
|
} |
|
87
|
|
|
|
|
|
|
|
|
88
|
1
|
|
|
|
|
216
|
$c->NEXT::prepare_action(@_); |
|
89
|
|
|
|
|
|
|
} |
|
90
|
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
sub finalize { |
|
92
|
6
|
|
|
6
|
1
|
243
|
my $c = shift; |
|
93
|
|
|
|
|
|
|
|
|
94
|
6
|
|
|
|
|
79
|
$c->finalize_session; |
|
95
|
|
|
|
|
|
|
|
|
96
|
6
|
|
|
|
|
1642
|
$c->NEXT::finalize(@_); |
|
97
|
|
|
|
|
|
|
} |
|
98
|
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
sub finalize_session { |
|
100
|
6
|
|
|
6
|
1
|
51
|
my $c = shift; |
|
101
|
|
|
|
|
|
|
|
|
102
|
6
|
|
|
|
|
114
|
$c->NEXT::finalize_session; |
|
103
|
|
|
|
|
|
|
|
|
104
|
6
|
|
|
|
|
1674
|
$c->_save_session_id; |
|
105
|
6
|
|
|
|
|
78
|
$c->_save_session; |
|
106
|
6
|
|
|
|
|
211
|
$c->_save_flash; |
|
107
|
6
|
|
|
|
|
2196
|
$c->_save_session_expires; |
|
108
|
|
|
|
|
|
|
|
|
109
|
6
|
|
|
|
|
235
|
$c->_clear_session_instance_data; |
|
110
|
|
|
|
|
|
|
} |
|
111
|
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
sub _save_session_id { |
|
113
|
6
|
|
|
6
|
|
58
|
my $c = shift; |
|
114
|
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
} |
|
118
|
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
sub _save_session_expires { |
|
120
|
6
|
|
|
6
|
|
54
|
my $c = shift; |
|
121
|
|
|
|
|
|
|
|
|
122
|
6
|
50
|
|
|
|
85
|
if ( defined($c->_session_expires) ) { |
|
123
|
0
|
|
|
|
|
0
|
my $expires = $c->session_expires; |
|
124
|
|
|
|
|
|
|
|
|
125
|
0
|
|
|
|
|
0
|
my $sid = $c->sessionid; |
|
126
|
0
|
|
|
|
|
0
|
$c->store_session_data( "expires:$sid" => $expires ); |
|
127
|
|
|
|
|
|
|
} |
|
128
|
|
|
|
|
|
|
} |
|
129
|
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
sub _save_session { |
|
131
|
6
|
|
|
6
|
|
51
|
my $c = shift; |
|
132
|
|
|
|
|
|
|
|
|
133
|
6
|
50
|
|
|
|
143
|
if ( my $session_data = $c->_session ) { |
|
134
|
|
|
|
|
|
|
|
|
135
|
3
|
|
|
3
|
|
115
|
no warnings 'uninitialized'; |
|
|
3
|
|
|
|
|
29
|
|
|
|
3
|
|
|
|
|
46
|
|
|
136
|
0
|
0
|
|
|
|
0
|
if ( Object::Signature::signature($session_data) ne |
|
137
|
|
|
|
|
|
|
$c->_session_data_sig ) |
|
138
|
|
|
|
|
|
|
{ |
|
139
|
0
|
|
|
|
|
0
|
$session_data->{__updated} = time(); |
|
140
|
0
|
|
|
|
|
0
|
my $sid = $c->sessionid; |
|
141
|
0
|
|
|
|
|
0
|
$c->store_session_data( "session:$sid" => $session_data ); |
|
142
|
|
|
|
|
|
|
} |
|
143
|
|
|
|
|
|
|
} |
|
144
|
|
|
|
|
|
|
} |
|
145
|
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
sub _save_flash { |
|
147
|
6
|
|
|
6
|
|
51
|
my $c = shift; |
|
148
|
|
|
|
|
|
|
|
|
149
|
6
|
50
|
|
|
|
72
|
if ( my $flash_data = $c->_flash ) { |
|
150
|
|
|
|
|
|
|
|
|
151
|
6
|
|
50
|
|
|
200
|
my $hashes = $c->_flash_key_hashes || {}; |
|
152
|
6
|
|
100
|
|
|
151
|
my $keep = $c->_flash_keep_keys || {}; |
|
153
|
6
|
|
|
|
|
152
|
foreach my $key ( keys %$hashes ) { |
|
154
|
2
|
50
|
33
|
|
|
38
|
if ( !exists $keep->{$key} and Object::Signature::signature( \$flash_data->{$key} ) eq $hashes->{$key} ) { |
|
155
|
2
|
|
|
|
|
25
|
delete $flash_data->{$key}; |
|
156
|
|
|
|
|
|
|
} |
|
157
|
|
|
|
|
|
|
} |
|
158
|
|
|
|
|
|
|
|
|
159
|
6
|
|
|
|
|
88
|
my $sid = $c->sessionid; |
|
160
|
|
|
|
|
|
|
|
|
161
|
6
|
100
|
|
|
|
983
|
if (%$flash_data) { |
|
162
|
4
|
|
|
|
|
51
|
$c->store_session_data( "flash:$sid", $flash_data ); |
|
163
|
|
|
|
|
|
|
} |
|
164
|
|
|
|
|
|
|
else { |
|
165
|
2
|
|
|
|
|
29
|
$c->delete_session_data("flash:$sid"); |
|
166
|
|
|
|
|
|
|
} |
|
167
|
|
|
|
|
|
|
} |
|
168
|
|
|
|
|
|
|
} |
|
169
|
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
sub _load_session_expires { |
|
171
|
0
|
|
|
0
|
|
0
|
my $c = shift; |
|
172
|
0
|
0
|
|
|
|
0
|
return $c->_session_expires if $c->_tried_loading_session_expires; |
|
173
|
0
|
|
|
|
|
0
|
$c->_tried_loading_session_expires(1); |
|
174
|
|
|
|
|
|
|
|
|
175
|
0
|
0
|
|
|
|
0
|
if ( my $sid = $c->sessionid ) { |
|
176
|
0
|
|
0
|
|
|
0
|
my $expires = $c->get_session_data("expires:$sid") || 0; |
|
177
|
|
|
|
|
|
|
|
|
178
|
0
|
0
|
|
|
|
0
|
if ( $expires >= time() ) { |
|
179
|
0
|
|
|
|
|
0
|
$c->_session_expires( $expires ); |
|
180
|
0
|
|
|
|
|
0
|
return $expires; |
|
181
|
|
|
|
|
|
|
} else { |
|
182
|
0
|
|
|
|
|
0
|
$c->delete_session( "session expired" ); |
|
183
|
0
|
|
|
|
|
0
|
return 0; |
|
184
|
|
|
|
|
|
|
} |
|
185
|
|
|
|
|
|
|
} |
|
186
|
|
|
|
|
|
|
|
|
187
|
0
|
|
|
|
|
0
|
return; |
|
188
|
|
|
|
|
|
|
} |
|
189
|
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
sub _load_session { |
|
191
|
0
|
|
|
0
|
|
0
|
my $c = shift; |
|
192
|
0
|
0
|
|
|
|
0
|
return $c->_session if $c->_tried_loading_session_data; |
|
193
|
0
|
|
|
|
|
0
|
$c->_tried_loading_session_data(1); |
|
194
|
|
|
|
|
|
|
|
|
195
|
0
|
0
|
|
|
|
0
|
if ( my $sid = $c->sessionid ) { |
|
196
|
0
|
0
|
|
|
|
0
|
if ( $c->_load_session_expires ) { |
|
197
|
|
|
|
|
|
|
|
|
198
|
0
|
|
0
|
|
|
0
|
my $session_data = $c->get_session_data("session:$sid") || return; |
|
199
|
0
|
|
|
|
|
0
|
$c->_session($session_data); |
|
200
|
|
|
|
|
|
|
|
|
201
|
3
|
|
|
3
|
|
68
|
no warnings 'uninitialized'; |
|
|
3
|
|
|
|
|
34
|
|
|
|
3
|
|
|
|
|
45
|
|
|
202
|
0
|
0
|
0
|
|
|
0
|
if ( $c->config->{session}{verify_address} |
|
203
|
|
|
|
|
|
|
&& $session_data->{__address} ne $c->request->address ) |
|
204
|
|
|
|
|
|
|
{ |
|
205
|
0
|
|
|
|
|
0
|
$c->log->warn( |
|
206
|
|
|
|
|
|
|
"Deleting session $sid due to address mismatch (" |
|
207
|
|
|
|
|
|
|
. $session_data->{__address} . " != " |
|
208
|
|
|
|
|
|
|
. $c->request->address . ")" |
|
209
|
|
|
|
|
|
|
); |
|
210
|
0
|
|
|
|
|
0
|
$c->delete_session("address mismatch"); |
|
211
|
0
|
|
|
|
|
0
|
return; |
|
212
|
|
|
|
|
|
|
} |
|
213
|
|
|
|
|
|
|
|
|
214
|
0
|
0
|
|
|
|
0
|
$c->log->debug(qq/Restored session "$sid"/) if $c->debug; |
|
215
|
0
|
0
|
|
|
|
0
|
$c->_session_data_sig( Object::Signature::signature($session_data) ) if $session_data; |
|
216
|
0
|
|
|
|
|
0
|
$c->_expire_session_keys; |
|
217
|
|
|
|
|
|
|
|
|
218
|
0
|
|
|
|
|
0
|
return $session_data; |
|
219
|
|
|
|
|
|
|
} |
|
220
|
|
|
|
|
|
|
} |
|
221
|
|
|
|
|
|
|
|
|
222
|
0
|
|
|
|
|
0
|
return; |
|
223
|
|
|
|
|
|
|
} |
|
224
|
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
sub _load_flash { |
|
226
|
6
|
|
|
6
|
|
155
|
my $c = shift; |
|
227
|
6
|
50
|
|
|
|
76
|
return $c->_flash if $c->_tried_loading_flash_data; |
|
228
|
6
|
|
|
|
|
168
|
$c->_tried_loading_flash_data(1); |
|
229
|
|
|
|
|
|
|
|
|
230
|
6
|
50
|
|
|
|
154
|
if ( my $sid = $c->sessionid ) { |
|
231
|
6
|
50
|
33
|
|
|
5660
|
if ( my $flash_data = $c->_flash |
|
232
|
|
|
|
|
|
|
|| $c->_flash( $c->get_session_data("flash:$sid") ) ) |
|
233
|
|
|
|
|
|
|
{ |
|
234
|
6
|
|
|
|
|
2146
|
$c->_flash_key_hashes({ map { $_ => Object::Signature::signature( \$flash_data->{$_} ) } keys %$flash_data }); |
|
|
3
|
|
|
|
|
45
|
|
|
235
|
|
|
|
|
|
|
|
|
236
|
6
|
|
|
|
|
217
|
return $flash_data; |
|
237
|
|
|
|
|
|
|
} |
|
238
|
|
|
|
|
|
|
} |
|
239
|
|
|
|
|
|
|
|
|
240
|
0
|
|
|
|
|
0
|
return; |
|
241
|
|
|
|
|
|
|
} |
|
242
|
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
sub _expire_session_keys { |
|
244
|
0
|
|
|
0
|
|
0
|
my ( $c, $data ) = @_; |
|
245
|
|
|
|
|
|
|
|
|
246
|
0
|
|
|
|
|
0
|
my $now = time; |
|
247
|
|
|
|
|
|
|
|
|
248
|
0
|
|
0
|
|
|
0
|
my $expire_times = ( $data || $c->_session || {} )->{__expire_keys} || {}; |
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
249
|
0
|
|
|
|
|
0
|
foreach my $key ( grep { $expire_times->{$_} < $now } keys %$expire_times ) { |
|
|
0
|
|
|
|
|
0
|
|
|
250
|
0
|
|
|
|
|
0
|
delete $c->_session->{$key}; |
|
251
|
0
|
|
|
|
|
0
|
delete $expire_times->{$key}; |
|
252
|
|
|
|
|
|
|
} |
|
253
|
|
|
|
|
|
|
} |
|
254
|
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
sub _clear_session_instance_data { |
|
256
|
6
|
|
|
6
|
|
55
|
my $c = shift; |
|
257
|
6
|
|
|
|
|
47
|
$c->$_(undef) for @session_data_accessors; |
|
|
6
|
|
|
|
|
85
|
|
|
258
|
6
|
|
|
|
|
150
|
$c->NEXT::_clear_session_instance_data; |
|
259
|
|
|
|
|
|
|
} |
|
260
|
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
sub delete_session { |
|
262
|
0
|
|
|
0
|
1
|
0
|
my ( $c, $msg ) = @_; |
|
263
|
|
|
|
|
|
|
|
|
264
|
0
|
0
|
|
|
|
0
|
$c->log->debug("Deleting session" . ( defined($msg) ? "($msg)" : '(no reason given)') ) if $c->debug; |
|
|
|
0
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
|
|
267
|
0
|
0
|
|
|
|
0
|
if ( my $sid = $c->sessionid ) { |
|
268
|
0
|
|
|
|
|
0
|
$c->delete_session_data("${_}:${sid}") for qw/session expires flash/; |
|
|
0
|
|
|
|
|
0
|
|
|
269
|
0
|
|
|
|
|
0
|
$c->delete_session_id($sid); |
|
270
|
|
|
|
|
|
|
} |
|
271
|
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
|
|
274
|
0
|
|
|
|
|
0
|
$c->_clear_session_instance_data; |
|
275
|
|
|
|
|
|
|
|
|
276
|
0
|
|
|
|
|
0
|
$c->_session_delete_reason($msg); |
|
277
|
|
|
|
|
|
|
} |
|
278
|
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
sub session_delete_reason { |
|
280
|
0
|
|
|
0
|
1
|
0
|
my $c = shift; |
|
281
|
|
|
|
|
|
|
|
|
282
|
0
|
|
|
|
|
0
|
$c->session_is_valid; |
|
283
|
|
|
|
|
|
|
|
|
284
|
0
|
|
|
|
|
0
|
$c->_session_delete_reason(@_); |
|
285
|
|
|
|
|
|
|
} |
|
286
|
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
sub session_expires { |
|
288
|
0
|
|
|
0
|
1
|
0
|
my $c = shift; |
|
289
|
|
|
|
|
|
|
|
|
290
|
0
|
0
|
|
|
|
0
|
if ( defined( my $expires = $c->_extended_session_expires ) ) { |
|
|
|
0
|
|
|
|
|
|
|
291
|
0
|
|
|
|
|
0
|
return $expires; |
|
292
|
|
|
|
|
|
|
} elsif ( defined( $expires = $c->_load_session_expires ) ) { |
|
293
|
0
|
|
|
|
|
0
|
return $c->extend_session_expires( $expires ); |
|
294
|
|
|
|
|
|
|
} else { |
|
295
|
0
|
|
|
|
|
0
|
return 0; |
|
296
|
|
|
|
|
|
|
} |
|
297
|
|
|
|
|
|
|
} |
|
298
|
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
sub extend_session_expires { |
|
300
|
0
|
|
|
0
|
0
|
0
|
my ( $c, $expires ) = @_; |
|
301
|
0
|
|
|
|
|
0
|
$c->_extended_session_expires( my $updated = $c->calculate_extended_session_expires( $expires ) ); |
|
302
|
0
|
|
|
|
|
0
|
$c->extend_session_id( $c->sessionid, $updated ); |
|
303
|
0
|
|
|
|
|
0
|
return $updated; |
|
304
|
|
|
|
|
|
|
} |
|
305
|
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
sub calculate_initial_session_expires { |
|
307
|
0
|
|
|
0
|
0
|
0
|
my $c = shift; |
|
308
|
0
|
|
|
|
|
0
|
return ( time() + $c->config->{session}{expires} ); |
|
309
|
|
|
|
|
|
|
} |
|
310
|
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
sub calculate_extended_session_expires { |
|
312
|
0
|
|
|
0
|
0
|
0
|
my ( $c, $prev ) = @_; |
|
313
|
0
|
|
|
|
|
0
|
$c->calculate_initial_session_expires; |
|
314
|
|
|
|
|
|
|
} |
|
315
|
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
sub reset_session_expires { |
|
317
|
0
|
|
|
0
|
0
|
0
|
my ( $c, $sid ) = @_; |
|
318
|
|
|
|
|
|
|
|
|
319
|
0
|
|
|
|
|
0
|
my $exp = $c->calculate_initial_session_expires; |
|
320
|
0
|
|
|
|
|
0
|
$c->_session_expires( $exp ); |
|
321
|
0
|
|
|
|
|
0
|
$c->_extended_session_expires( $exp ); |
|
322
|
0
|
|
|
|
|
0
|
$exp; |
|
323
|
|
|
|
|
|
|
} |
|
324
|
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
sub sessionid { |
|
326
|
13
|
|
|
13
|
1
|
268
|
my $c = shift; |
|
327
|
|
|
|
|
|
|
|
|
328
|
13
|
|
33
|
|
|
151
|
return $c->_sessionid || $c->_load_sessionid; |
|
329
|
|
|
|
|
|
|
} |
|
330
|
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
sub _load_sessionid { |
|
332
|
0
|
|
|
0
|
|
0
|
my $c = shift; |
|
333
|
0
|
0
|
|
|
|
0
|
return if $c->_tried_loading_session_id; |
|
334
|
0
|
|
|
|
|
0
|
$c->_tried_loading_session_id(1); |
|
335
|
|
|
|
|
|
|
|
|
336
|
0
|
0
|
|
|
|
0
|
if ( defined( my $sid = $c->get_session_id ) ) { |
|
337
|
0
|
0
|
|
|
|
0
|
if ( $c->validate_session_id($sid) ) { |
|
338
|
|
|
|
|
|
|
|
|
339
|
0
|
|
|
|
|
0
|
$c->_sessionid($sid); |
|
340
|
0
|
|
|
|
|
0
|
return $sid; |
|
341
|
|
|
|
|
|
|
} else { |
|
342
|
0
|
|
|
|
|
0
|
my $err = "Tried to set invalid session ID '$sid'"; |
|
343
|
0
|
|
|
|
|
0
|
$c->log->error($err); |
|
344
|
0
|
|
|
|
|
0
|
Catalyst::Exception->throw($err); |
|
345
|
|
|
|
|
|
|
} |
|
346
|
|
|
|
|
|
|
} |
|
347
|
|
|
|
|
|
|
|
|
348
|
0
|
|
|
|
|
0
|
return; |
|
349
|
|
|
|
|
|
|
} |
|
350
|
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
sub session_is_valid { |
|
352
|
0
|
|
|
0
|
0
|
0
|
my $c = shift; |
|
353
|
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
|
|
355
|
0
|
0
|
|
|
|
0
|
if ( $c->_load_session ) { |
|
356
|
0
|
|
|
|
|
0
|
return 1; |
|
357
|
|
|
|
|
|
|
} else { |
|
358
|
0
|
|
|
|
|
0
|
return; |
|
359
|
|
|
|
|
|
|
} |
|
360
|
|
|
|
|
|
|
} |
|
361
|
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
sub validate_session_id { |
|
363
|
0
|
|
|
0
|
1
|
0
|
my ( $c, $sid ) = @_; |
|
364
|
|
|
|
|
|
|
|
|
365
|
0
|
0
|
|
|
|
0
|
$sid and $sid =~ /^[a-f\d]+$/i; |
|
366
|
|
|
|
|
|
|
} |
|
367
|
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
sub session { |
|
369
|
0
|
|
|
0
|
1
|
0
|
my $c = shift; |
|
370
|
|
|
|
|
|
|
|
|
371
|
0
|
0
|
0
|
|
|
0
|
$c->_session || $c->_load_session || do { |
|
372
|
0
|
|
|
|
|
0
|
$c->create_session_id_if_needed; |
|
373
|
0
|
|
|
|
|
0
|
$c->initialize_session_data; |
|
374
|
|
|
|
|
|
|
}; |
|
375
|
|
|
|
|
|
|
} |
|
376
|
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
sub keep_flash { |
|
378
|
0
|
|
|
0
|
1
|
0
|
my ( $c, @keys ) = @_; |
|
379
|
0
|
|
0
|
|
|
0
|
my $href = $c->_flash_keep_keys || $c->_flash_keep_keys({}); |
|
380
|
0
|
|
|
|
|
0
|
(@{$href}{@keys}) = ((undef) x @keys); |
|
|
0
|
|
|
|
|
0
|
|
|
381
|
|
|
|
|
|
|
} |
|
382
|
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
sub _flash_data { |
|
384
|
11
|
|
|
11
|
|
108
|
my $c = shift; |
|
385
|
11
|
50
|
66
|
|
|
136
|
$c->_flash || $c->_load_flash || do { |
|
386
|
0
|
|
|
|
|
0
|
$c->create_session_id_if_needed; |
|
387
|
0
|
|
|
|
|
0
|
$c->_flash( {} ); |
|
388
|
|
|
|
|
|
|
}; |
|
389
|
|
|
|
|
|
|
} |
|
390
|
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
sub _set_flash { |
|
392
|
11
|
|
|
11
|
|
95
|
my $c = shift; |
|
393
|
11
|
100
|
|
|
|
112
|
if (@_) { |
|
394
|
1
|
50
|
|
|
|
15
|
my $items = @_ > 1 ? {@_} : $_[0]; |
|
395
|
1
|
50
|
|
|
|
13
|
croak('flash takes a hash or hashref') unless ref $items; |
|
396
|
1
|
|
|
|
|
13
|
@{ $c->_flash }{ keys %$items } = values %$items; |
|
|
1
|
|
|
|
|
11
|
|
|
397
|
|
|
|
|
|
|
} |
|
398
|
|
|
|
|
|
|
} |
|
399
|
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
sub flash { |
|
401
|
11
|
|
|
11
|
1
|
753
|
my $c = shift; |
|
402
|
11
|
|
|
|
|
347
|
$c->_flash_data; |
|
403
|
11
|
|
|
|
|
204
|
$c->_set_flash(@_); |
|
404
|
11
|
|
|
|
|
127
|
return $c->_flash; |
|
405
|
|
|
|
|
|
|
} |
|
406
|
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
sub clear_flash { |
|
408
|
1
|
|
|
1
|
1
|
235
|
my $c = shift; |
|
409
|
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
|
|
411
|
1
|
|
|
|
|
14
|
$c->_flash_key_hashes({}); |
|
412
|
1
|
|
|
|
|
25
|
$c->_flash_keep_keys({}); |
|
413
|
1
|
|
|
|
|
23
|
$c->_flash({}); |
|
414
|
|
|
|
|
|
|
} |
|
415
|
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
sub session_expire_key { |
|
417
|
0
|
|
|
0
|
1
|
|
my ( $c, %keys ) = @_; |
|
418
|
|
|
|
|
|
|
|
|
419
|
0
|
|
|
|
|
|
my $now = time; |
|
420
|
0
|
|
|
|
|
|
@{ $c->session->{__expire_keys} }{ keys %keys } = |
|
|
0
|
|
|
|
|
|
|
|
421
|
0
|
|
|
|
|
|
map { $now + $_ } values %keys; |
|
422
|
|
|
|
|
|
|
} |
|
423
|
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
sub initialize_session_data { |
|
425
|
0
|
|
|
0
|
1
|
|
my $c = shift; |
|
426
|
|
|
|
|
|
|
|
|
427
|
0
|
|
|
|
|
|
my $now = time; |
|
428
|
|
|
|
|
|
|
|
|
429
|
0
|
0
|
|
|
|
|
return $c->_session( |
|
430
|
|
|
|
|
|
|
{ |
|
431
|
|
|
|
|
|
|
__created => $now, |
|
432
|
|
|
|
|
|
|
__updated => $now, |
|
433
|
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
( |
|
435
|
|
|
|
|
|
|
$c->config->{session}{verify_address} |
|
436
|
|
|
|
|
|
|
? ( __address => $c->request->address ) |
|
437
|
|
|
|
|
|
|
: () |
|
438
|
|
|
|
|
|
|
), |
|
439
|
|
|
|
|
|
|
} |
|
440
|
|
|
|
|
|
|
); |
|
441
|
|
|
|
|
|
|
} |
|
442
|
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
sub generate_session_id { |
|
444
|
0
|
|
|
0
|
1
|
|
my $c = shift; |
|
445
|
|
|
|
|
|
|
|
|
446
|
0
|
|
|
|
|
|
my $digest = $c->_find_digest(); |
|
447
|
0
|
|
|
|
|
|
$digest->add( $c->session_hash_seed() ); |
|
448
|
0
|
|
|
|
|
|
return $digest->hexdigest; |
|
449
|
|
|
|
|
|
|
} |
|
450
|
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
sub create_session_id_if_needed { |
|
452
|
0
|
|
|
0
|
0
|
|
my $c = shift; |
|
453
|
0
|
0
|
|
|
|
|
$c->create_session_id unless $c->sessionid; |
|
454
|
|
|
|
|
|
|
} |
|
455
|
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
sub create_session_id { |
|
457
|
0
|
|
|
0
|
1
|
|
my $c = shift; |
|
458
|
|
|
|
|
|
|
|
|
459
|
0
|
|
|
|
|
|
my $sid = $c->generate_session_id; |
|
460
|
|
|
|
|
|
|
|
|
461
|
0
|
0
|
|
|
|
|
$c->log->debug(qq/Created session "$sid"/) if $c->debug; |
|
462
|
|
|
|
|
|
|
|
|
463
|
0
|
|
|
|
|
|
$c->_sessionid($sid); |
|
464
|
0
|
|
|
|
|
|
$c->reset_session_expires; |
|
465
|
0
|
|
|
|
|
|
$c->set_session_id($sid); |
|
466
|
|
|
|
|
|
|
|
|
467
|
0
|
|
|
|
|
|
return $sid; |
|
468
|
|
|
|
|
|
|
} |
|
469
|
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
my $counter; |
|
471
|
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
sub session_hash_seed { |
|
473
|
0
|
|
|
0
|
1
|
|
my $c = shift; |
|
474
|
|
|
|
|
|
|
|
|
475
|
0
|
|
|
|
|
|
return join( "", ++$counter, time, rand, $$, {}, overload::StrVal($c), ); |
|
476
|
|
|
|
|
|
|
} |
|
477
|
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
my $usable; |
|
479
|
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
sub _find_digest () { |
|
481
|
0
|
0
|
|
0
|
|
|
unless ($usable) { |
|
482
|
0
|
|
|
|
|
|
foreach my $alg (qw/SHA-1 SHA-256 MD5/) { |
|
483
|
0
|
0
|
|
|
|
|
if ( eval { Digest->new($alg) } ) { |
|
|
0
|
|
|
|
|
|
|
|
484
|
0
|
|
|
|
|
|
$usable = $alg; |
|
485
|
0
|
|
|
|
|
|
last; |
|
486
|
|
|
|
|
|
|
} |
|
487
|
|
|
|
|
|
|
} |
|
488
|
|
|
|
|
|
|
Catalyst::Exception->throw( |
|
489
|
0
|
0
|
|
|
|
|
"Could not find a suitable Digest module. Please install " |
|
490
|
|
|
|
|
|
|
. "Digest::SHA1, Digest::SHA, or Digest::MD5" ) |
|
491
|
|
|
|
|
|
|
unless $usable; |
|
492
|
|
|
|
|
|
|
} |
|
493
|
|
|
|
|
|
|
|
|
494
|
0
|
|
|
|
|
|
return Digest->new($usable); |
|
495
|
|
|
|
|
|
|
} |
|
496
|
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
sub dump_these { |
|
498
|
0
|
|
|
0
|
1
|
|
my $c = shift; |
|
499
|
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
( |
|
501
|
0
|
0
|
|
|
|
|
$c->NEXT::dump_these(), |
|
502
|
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
$c->sessionid |
|
504
|
|
|
|
|
|
|
? ( [ "Session ID" => $c->sessionid ], [ Session => $c->session ], ) |
|
505
|
|
|
|
|
|
|
: () |
|
506
|
|
|
|
|
|
|
); |
|
507
|
|
|
|
|
|
|
} |
|
508
|
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
|
|
510
|
0
|
|
|
0
|
0
|
|
sub get_session_id { shift->NEXT::get_session_id(@_) } |
|
511
|
0
|
|
|
0
|
0
|
|
sub set_session_id { shift->NEXT::set_session_id(@_) } |
|
512
|
0
|
|
|
0
|
0
|
|
sub delete_session_id { shift->NEXT::delete_session_id(@_) } |
|
513
|
0
|
|
|
0
|
0
|
|
sub extend_session_id { shift->NEXT::extend_session_id(@_) } |
|
514
|
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
__PACKAGE__; |
|
516
|
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
__END__ |
|
518
|
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
=pod |
|
520
|
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
=head1 NAME |
|
522
|
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
Catalyst::Plugin::Session - Generic Session plugin - ties together server side |
|
524
|
|
|
|
|
|
|
storage and client side state required to maintain session data. |
|
525
|
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
527
|
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
# To get sessions to "just work", all you need to do is use these plugins: |
|
529
|
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
use Catalyst qw/ |
|
531
|
|
|
|
|
|
|
Session |
|
532
|
|
|
|
|
|
|
Session::Store::FastMmap |
|
533
|
|
|
|
|
|
|
Session::State::Cookie |
|
534
|
|
|
|
|
|
|
/; |
|
535
|
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
# you can replace Store::FastMmap with Store::File - both have sensible |
|
537
|
|
|
|
|
|
|
# default configurations (see their docs for details) |
|
538
|
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
# more complicated backends are available for other scenarios (DBI storage, |
|
540
|
|
|
|
|
|
|
# etc) |
|
541
|
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
# after you've loaded the plugins you can save session data |
|
544
|
|
|
|
|
|
|
# For example, if you are writing a shopping cart, it could be implemented |
|
545
|
|
|
|
|
|
|
# like this: |
|
546
|
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
sub add_item : Local { |
|
548
|
|
|
|
|
|
|
my ( $self, $c ) = @_; |
|
549
|
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
my $item_id = $c->req->param("item"); |
|
551
|
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
# $c->session is a hash ref, a bit like $c->stash |
|
553
|
|
|
|
|
|
|
# the difference is that it' preserved across requests |
|
554
|
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
push @{ $c->session->{items} }, $item_id; |
|
556
|
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
$c->forward("MyView"); |
|
558
|
|
|
|
|
|
|
} |
|
559
|
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
sub display_items : Local { |
|
561
|
|
|
|
|
|
|
my ( $self, $c ) = @_; |
|
562
|
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
# values in $c->session are restored |
|
564
|
|
|
|
|
|
|
$c->stash->{items_to_display} = |
|
565
|
|
|
|
|
|
|
[ map { MyModel->retrieve($_) } @{ $c->session->{items} } ]; |
|
566
|
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
$c->forward("MyView"); |
|
568
|
|
|
|
|
|
|
} |
|
569
|
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
571
|
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
The Session plugin is the base of two related parts of functionality required |
|
573
|
|
|
|
|
|
|
for session management in web applications. |
|
574
|
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
The first part, the State, is getting the browser to repeat back a session key, |
|
576
|
|
|
|
|
|
|
so that the web application can identify the client and logically string |
|
577
|
|
|
|
|
|
|
several requests together into a session. |
|
578
|
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
The second part, the Store, deals with the actual storage of information about |
|
580
|
|
|
|
|
|
|
the client. This data is stored so that the it may be revived for every request |
|
581
|
|
|
|
|
|
|
made by the same client. |
|
582
|
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
This plugin links the two pieces together. |
|
584
|
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
=head1 RECCOMENDED BACKENDS |
|
586
|
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
=over 4 |
|
588
|
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
=item Session::State::Cookie |
|
590
|
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
The only really sane way to do state is using cookies. |
|
592
|
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
=item Session::Store::File |
|
594
|
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
A portable backend, based on Cache::File. |
|
596
|
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
=item Session::Store::FastMmap |
|
598
|
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
A fast and flexible backend, based on Cache::FastMmap. |
|
600
|
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
=back |
|
602
|
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
=head1 METHODS |
|
604
|
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
=over 4 |
|
606
|
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
=item sessionid |
|
608
|
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
An accessor for the session ID value. |
|
610
|
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
=item session |
|
612
|
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
Returns a hash reference that might contain unserialized values from previous |
|
614
|
|
|
|
|
|
|
requests in the same session, and whose modified value will be saved for future |
|
615
|
|
|
|
|
|
|
requests. |
|
616
|
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
This method will automatically create a new session and session ID if none |
|
618
|
|
|
|
|
|
|
exists. |
|
619
|
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
=item session_expires |
|
621
|
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
=item session_expires $reset |
|
623
|
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
This method returns the time when the current session will expire, or 0 if |
|
625
|
|
|
|
|
|
|
there is no current session. If there is a session and it already expired, it |
|
626
|
|
|
|
|
|
|
will delete the session and return 0 as well. |
|
627
|
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
If the C<$reset> parameter is true, and there is a session ID the expiry time |
|
629
|
|
|
|
|
|
|
will be reset to the current time plus the time to live (see |
|
630
|
|
|
|
|
|
|
L</CONFIGURATION>). This is used when creating a new session. |
|
631
|
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
=item flash |
|
633
|
|
|
|
|
|
|
|
|
634
|
|
|
|
|
|
|
This is like Ruby on Rails' flash data structure. Think of it as a stash that |
|
635
|
|
|
|
|
|
|
lasts for longer than one request, letting you redirect instead of forward. |
|
636
|
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
The flash data will be cleaned up only on requests on which actually use |
|
638
|
|
|
|
|
|
|
$c->flash (thus allowing multiple redirections), and the policy is to delete |
|
639
|
|
|
|
|
|
|
all the keys which haven't changed since the flash data was loaded at the end |
|
640
|
|
|
|
|
|
|
of every request. |
|
641
|
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
sub moose : Local { |
|
643
|
|
|
|
|
|
|
my ( $self, $c ) = @_; |
|
644
|
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
$c->flash->{beans} = 10; |
|
646
|
|
|
|
|
|
|
$c->response->redirect( $c->uri_for("foo") ); |
|
647
|
|
|
|
|
|
|
} |
|
648
|
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
sub foo : Local { |
|
650
|
|
|
|
|
|
|
my ( $self, $c ) = @_; |
|
651
|
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
my $value = $c->flash->{beans}; |
|
653
|
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
# ... |
|
655
|
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
$c->response->redirect( $c->uri_for("bar") ); |
|
657
|
|
|
|
|
|
|
} |
|
658
|
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
sub bar : Local { |
|
660
|
|
|
|
|
|
|
my ( $self, $c ) = @_; |
|
661
|
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
if ( exists $c->flash->{beans} ) { # false |
|
663
|
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
} |
|
665
|
|
|
|
|
|
|
} |
|
666
|
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
=item clear_flash |
|
668
|
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
Zap all the keys in the flash regardless of their current state. |
|
670
|
|
|
|
|
|
|
|
|
671
|
|
|
|
|
|
|
=item keep_flash @keys |
|
672
|
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
If you wawnt to keep a flash key for the next request too, even if it hasn't |
|
674
|
|
|
|
|
|
|
changed, call C<keep_flash> and pass in the keys as arguments. |
|
675
|
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
=item delete_session REASON |
|
677
|
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
This method is used to invalidate a session. It takes an optional parameter |
|
679
|
|
|
|
|
|
|
which will be saved in C<session_delete_reason> if provided. |
|
680
|
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
=item session_delete_reason |
|
682
|
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
This accessor contains a string with the reason a session was deleted. Possible |
|
684
|
|
|
|
|
|
|
values include: |
|
685
|
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
=over 4 |
|
687
|
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
=item * |
|
689
|
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
C<address mismatch> |
|
691
|
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
=item * |
|
693
|
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
C<session expired> |
|
695
|
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
=back |
|
697
|
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
=item session_expire_key $key, $ttl |
|
699
|
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
Mark a key to expire at a certain time (only useful when shorter than the |
|
701
|
|
|
|
|
|
|
expiry time for the whole session). |
|
702
|
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
For example: |
|
704
|
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
__PACKAGE__->config->{session}{expires} = 1000000000000; # forever |
|
706
|
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
# later |
|
708
|
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
$c->session_expire_key( __user => 3600 ); |
|
710
|
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
Will make the session data survive, but the user will still be logged out after |
|
712
|
|
|
|
|
|
|
an hour. |
|
713
|
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
Note that these values are not auto extended. |
|
715
|
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
=back |
|
717
|
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
=head1 INTERNAL METHODS |
|
719
|
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
=over 4 |
|
721
|
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
=item setup |
|
723
|
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
This method is extended to also make calls to |
|
725
|
|
|
|
|
|
|
C<check_session_plugin_requirements> and C<setup_session>. |
|
726
|
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
=item check_session_plugin_requirements |
|
728
|
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
This method ensures that a State and a Store plugin are also in use by the |
|
730
|
|
|
|
|
|
|
application. |
|
731
|
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
=item setup_session |
|
733
|
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
This method populates C<< $c->config->{session} >> with the default values |
|
735
|
|
|
|
|
|
|
listed in L</CONFIGURATION>. |
|
736
|
|
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
=item prepare_action |
|
738
|
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
This methoid is extended. |
|
740
|
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
It's only effect is if the (off by default) C<flash_to_stash> configuration |
|
742
|
|
|
|
|
|
|
parameter is on - then it will copy the contents of the flash to the stash at |
|
743
|
|
|
|
|
|
|
prepare time. |
|
744
|
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
=item finalize |
|
746
|
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
This method is extended and will extend the expiry time, as well as persist the |
|
748
|
|
|
|
|
|
|
session data if a session exists. |
|
749
|
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
=item initialize_session_data |
|
751
|
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
This method will initialize the internal structure of the session, and is |
|
753
|
|
|
|
|
|
|
called by the C<session> method if appropriate. |
|
754
|
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
=item create_session_id |
|
756
|
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
Creates a new session id using C<generate_session_id> if there is no session ID |
|
758
|
|
|
|
|
|
|
yet. |
|
759
|
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
=item validate_session_id SID |
|
761
|
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
Make sure a session ID is of the right format. |
|
763
|
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
This currently ensures that the session ID string is any amount of case |
|
765
|
|
|
|
|
|
|
insensitive hexadecimal characters. |
|
766
|
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
=item generate_session_id |
|
768
|
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
This method will return a string that can be used as a session ID. It is |
|
770
|
|
|
|
|
|
|
supposed to be a reasonably random string with enough bits to prevent |
|
771
|
|
|
|
|
|
|
collision. It basically takes C<session_hash_seed> and hashes it using SHA-1, |
|
772
|
|
|
|
|
|
|
MD5 or SHA-256, depending on the availibility of these modules. |
|
773
|
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
=item session_hash_seed |
|
775
|
|
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
This method is actually rather internal to generate_session_id, but should be |
|
777
|
|
|
|
|
|
|
overridable in case you want to provide more random data. |
|
778
|
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
Currently it returns a concatenated string which contains: |
|
780
|
|
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
=over 4 |
|
782
|
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
=item * |
|
784
|
|
|
|
|
|
|
|
|
785
|
|
|
|
|
|
|
A counter |
|
786
|
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
=item * |
|
788
|
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
The current time |
|
790
|
|
|
|
|
|
|
|
|
791
|
|
|
|
|
|
|
=item * |
|
792
|
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
One value from C<rand>. |
|
794
|
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
=item * |
|
796
|
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
The stringified value of a newly allocated hash reference |
|
798
|
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
=item * |
|
800
|
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
The stringified value of the Catalyst context object |
|
802
|
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
=back |
|
804
|
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
In the hopes that those combined values are entropic enough for most uses. If |
|
806
|
|
|
|
|
|
|
this is not the case you can replace C<session_hash_seed> with e.g. |
|
807
|
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
sub session_hash_seed { |
|
809
|
|
|
|
|
|
|
open my $fh, "<", "/dev/random"; |
|
810
|
|
|
|
|
|
|
read $fh, my $bytes, 20; |
|
811
|
|
|
|
|
|
|
close $fh; |
|
812
|
|
|
|
|
|
|
return $bytes; |
|
813
|
|
|
|
|
|
|
} |
|
814
|
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
Or even more directly, replace C<generate_session_id>: |
|
816
|
|
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
sub generate_session_id { |
|
818
|
|
|
|
|
|
|
open my $fh, "<", "/dev/random"; |
|
819
|
|
|
|
|
|
|
read $fh, my $bytes, 20; |
|
820
|
|
|
|
|
|
|
close $fh; |
|
821
|
|
|
|
|
|
|
return unpack("H*", $bytes); |
|
822
|
|
|
|
|
|
|
} |
|
823
|
|
|
|
|
|
|
|
|
824
|
|
|
|
|
|
|
Also have a look at L<Crypt::Random> and the various openssl bindings - these |
|
825
|
|
|
|
|
|
|
modules provide APIs for cryptographically secure random data. |
|
826
|
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
=item finalize_session |
|
828
|
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
Clean up the session during C<finalize>. |
|
830
|
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
This clears the various accessors after saving to the store. |
|
832
|
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
=item dump_these |
|
834
|
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
See L<Catalyst/dump_these> - ammends the session data structure to the list of |
|
836
|
|
|
|
|
|
|
dumped objects if session ID is defined. |
|
837
|
|
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
=back |
|
839
|
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
=head1 USING SESSIONS DURING PREPARE |
|
841
|
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
The earliest point in time at which you may use the session data is after |
|
843
|
|
|
|
|
|
|
L<Catalyst::Plugin::Session>'s C<prepare_action> has finished. |
|
844
|
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
State plugins must set $c->session ID before C<prepare_action>, and during |
|
846
|
|
|
|
|
|
|
C<prepare_action> L<Catalyst::Plugin::Session> will actually load the data from |
|
847
|
|
|
|
|
|
|
the store. |
|
848
|
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
sub prepare_action { |
|
850
|
|
|
|
|
|
|
my $c = shift; |
|
851
|
|
|
|
|
|
|
|
|
852
|
|
|
|
|
|
|
# don't touch $c->session yet! |
|
853
|
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
$c->NEXT::prepare_action( @_ ); |
|
855
|
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
$c->session; # this is OK |
|
857
|
|
|
|
|
|
|
$c->sessionid; # this is also OK |
|
858
|
|
|
|
|
|
|
} |
|
859
|
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
=head1 CONFIGURATION |
|
861
|
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
$c->config->{session} = { |
|
863
|
|
|
|
|
|
|
expires => 1234, |
|
864
|
|
|
|
|
|
|
}; |
|
865
|
|
|
|
|
|
|
|
|
866
|
|
|
|
|
|
|
All configuation parameters are provided in a hash reference under the |
|
867
|
|
|
|
|
|
|
C<session> key in the configuration hash. |
|
868
|
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
=over 4 |
|
870
|
|
|
|
|
|
|
|
|
871
|
|
|
|
|
|
|
=item expires |
|
872
|
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
The time-to-live of each session, expressed in seconds. Defaults to 7200 (two |
|
874
|
|
|
|
|
|
|
hours). |
|
875
|
|
|
|
|
|
|
|
|
876
|
|
|
|
|
|
|
=item verify_address |
|
877
|
|
|
|
|
|
|
|
|
878
|
|
|
|
|
|
|
When true, C<<$c->request->address>> will be checked at prepare time. If it is |
|
879
|
|
|
|
|
|
|
not the same as the address that initiated the session, the session is deleted. |
|
880
|
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
Defaults to false. |
|
882
|
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
=item flash_to_stash |
|
884
|
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
This option makes it easier to have actions behave the same whether they were |
|
886
|
|
|
|
|
|
|
forwarded to or redirected to. On prepare time it copies the contents of |
|
887
|
|
|
|
|
|
|
C<flash> (if any) to the stash. |
|
888
|
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
=back |
|
890
|
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
=head1 SPECIAL KEYS |
|
892
|
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
The hash reference returned by C<< $c->session >> contains several keys which |
|
894
|
|
|
|
|
|
|
are automatically set: |
|
895
|
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
=over 4 |
|
897
|
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
=item __expires |
|
899
|
|
|
|
|
|
|
|
|
900
|
|
|
|
|
|
|
This key no longer exists. Use C<session_expires> instead. |
|
901
|
|
|
|
|
|
|
|
|
902
|
|
|
|
|
|
|
=item __updated |
|
903
|
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
The last time a session was saved to the store. |
|
905
|
|
|
|
|
|
|
|
|
906
|
|
|
|
|
|
|
=item __created |
|
907
|
|
|
|
|
|
|
|
|
908
|
|
|
|
|
|
|
The time when the session was first created. |
|
909
|
|
|
|
|
|
|
|
|
910
|
|
|
|
|
|
|
=item __address |
|
911
|
|
|
|
|
|
|
|
|
912
|
|
|
|
|
|
|
The value of C<< $c->request->address >> at the time the session was created. |
|
913
|
|
|
|
|
|
|
This value is only populated if C<verify_address> is true in the configuration. |
|
914
|
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
=back |
|
916
|
|
|
|
|
|
|
|
|
917
|
|
|
|
|
|
|
=head1 CAVEATS |
|
918
|
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
=head2 Round the Robin Proxies |
|
920
|
|
|
|
|
|
|
|
|
921
|
|
|
|
|
|
|
C<verify_address> could make your site inaccessible to users who are behind |
|
922
|
|
|
|
|
|
|
load balanced proxies. Some ISPs may give a different IP to each request by the |
|
923
|
|
|
|
|
|
|
same client due to this type of proxying. If addresses are verified these |
|
924
|
|
|
|
|
|
|
users' sessions cannot persist. |
|
925
|
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
To let these users access your site you can either disable address verification |
|
927
|
|
|
|
|
|
|
as a whole, or provide a checkbox in the login dialog that tells the server |
|
928
|
|
|
|
|
|
|
that it's OK for the address of the client to change. When the server sees that |
|
929
|
|
|
|
|
|
|
this box is checked it should delete the C<__address> sepcial key from the |
|
930
|
|
|
|
|
|
|
session hash when the hash is first created. |
|
931
|
|
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
=head2 Race Conditions |
|
933
|
|
|
|
|
|
|
|
|
934
|
|
|
|
|
|
|
In this day and age where cleaning detergents and dutch football (not the |
|
935
|
|
|
|
|
|
|
american kind) teams roam the plains in great numbers, requests may happen |
|
936
|
|
|
|
|
|
|
simultaneously. This means that there is some risk of session data being |
|
937
|
|
|
|
|
|
|
overwritten, like this: |
|
938
|
|
|
|
|
|
|
|
|
939
|
|
|
|
|
|
|
=over 4 |
|
940
|
|
|
|
|
|
|
|
|
941
|
|
|
|
|
|
|
=item 1. |
|
942
|
|
|
|
|
|
|
|
|
943
|
|
|
|
|
|
|
request a starts, request b starts, with the same session id |
|
944
|
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
=item 2. |
|
946
|
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
session data is loaded in request a |
|
948
|
|
|
|
|
|
|
|
|
949
|
|
|
|
|
|
|
=item 3. |
|
950
|
|
|
|
|
|
|
|
|
951
|
|
|
|
|
|
|
session data is loaded in request b |
|
952
|
|
|
|
|
|
|
|
|
953
|
|
|
|
|
|
|
=item 4. |
|
954
|
|
|
|
|
|
|
|
|
955
|
|
|
|
|
|
|
session data is changed in request a |
|
956
|
|
|
|
|
|
|
|
|
957
|
|
|
|
|
|
|
=item 5. |
|
958
|
|
|
|
|
|
|
|
|
959
|
|
|
|
|
|
|
request a finishes, session data is updated and written to store |
|
960
|
|
|
|
|
|
|
|
|
961
|
|
|
|
|
|
|
=item 6. |
|
962
|
|
|
|
|
|
|
|
|
963
|
|
|
|
|
|
|
request b finishes, session data is updated and written to store, overwriting |
|
964
|
|
|
|
|
|
|
changes by request a |
|
965
|
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
=back |
|
967
|
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
If this is a concern in your application, a soon to be developed locking |
|
969
|
|
|
|
|
|
|
solution is the only safe way to go. This will have a bigger overhead. |
|
970
|
|
|
|
|
|
|
|
|
971
|
|
|
|
|
|
|
For applications where any given user is only making one request at a time this |
|
972
|
|
|
|
|
|
|
plugin should be safe enough. |
|
973
|
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
=head1 AUTHORS |
|
975
|
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
=over 4 |
|
977
|
|
|
|
|
|
|
|
|
978
|
|
|
|
|
|
|
=item Andy Grundman |
|
979
|
|
|
|
|
|
|
|
|
980
|
|
|
|
|
|
|
=item Christian Hansen |
|
981
|
|
|
|
|
|
|
|
|
982
|
|
|
|
|
|
|
=item Yuval Kogman, C<nothingmuch@woobling.org> (current maintainer) |
|
983
|
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
=item Sebastian Riedel |
|
985
|
|
|
|
|
|
|
|
|
986
|
|
|
|
|
|
|
=back |
|
987
|
|
|
|
|
|
|
|
|
988
|
|
|
|
|
|
|
And countless other contributers from #catalyst. Thanks guys! |
|
989
|
|
|
|
|
|
|
|
|
990
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
|
991
|
|
|
|
|
|
|
|
|
992
|
|
|
|
|
|
|
Copyright (c) 2005 the aforementioned authors. All rights |
|
993
|
|
|
|
|
|
|
reserved. This program is free software; you can redistribute |
|
994
|
|
|
|
|
|
|
it and/or modify it under the same terms as Perl itself. |
|
995
|
|
|
|
|
|
|
|
|
996
|
|
|
|
|
|
|
=cut |
|
997
|
|
|
|
|
|
|
|
|
998
|
|
|
|
|
|
|
|
|
999
|
|
|
|
|
|
|
|