Commit | Line | Data |
9e447f9d |
1 | #!/usr/bin/perl |
2 | |
3 | package Catalyst::Plugin::Session; |
4 | use base qw/Class::Accessor::Fast/; |
5 | |
6 | use strict; |
7 | use warnings; |
8 | |
9 | use NEXT; |
10 | use Catalyst::Exception (); |
9a9252c2 |
11 | use Digest (); |
12 | use overload (); |
13 | use List::Util (); |
9e447f9d |
14 | |
37160715 |
15 | our $VERSION = "0.01"; |
16 | |
9e447f9d |
17 | BEGIN { |
9a9252c2 |
18 | __PACKAGE__->mk_accessors(qw/sessionid session_delete_reason/); |
9e447f9d |
19 | } |
20 | |
21 | sub setup { |
9a9252c2 |
22 | my $c = shift; |
23 | |
24 | $c->NEXT::setup(@_); |
25 | |
26 | $c->check_session_plugin_requirements; |
27 | $c->setup_session; |
28 | |
29 | return $c; |
9e447f9d |
30 | } |
31 | |
32 | sub check_session_plugin_requirements { |
9a9252c2 |
33 | my $c = shift; |
9e447f9d |
34 | |
9a9252c2 |
35 | unless ( $c->isa("Catalyst::Plugin::Session::State") |
36 | && $c->isa("Catalyst::Plugin::Session::Store") ) |
37 | { |
38 | my $err = |
39 | ( "The Session plugin requires both Session::State " |
40 | . "and Session::Store plugins to be used as well." ); |
9e447f9d |
41 | |
9a9252c2 |
42 | $c->log->fatal($err); |
43 | Catalyst::Exception->throw($err); |
44 | } |
9e447f9d |
45 | } |
46 | |
47 | sub setup_session { |
9a9252c2 |
48 | my $c = shift; |
9e447f9d |
49 | |
9a9252c2 |
50 | my $cfg = ( $c->config->{session} ||= {} ); |
9e447f9d |
51 | |
9a9252c2 |
52 | %$cfg = ( |
53 | expires => 7200, |
54 | verify_address => 1, |
55 | %$cfg, |
56 | ); |
9e447f9d |
57 | |
9a9252c2 |
58 | $c->NEXT::setup_session(); |
9e447f9d |
59 | } |
60 | |
61 | sub finalize { |
9a9252c2 |
62 | my $c = shift; |
9e447f9d |
63 | |
9a9252c2 |
64 | if ( $c->{session} ) { |
9e447f9d |
65 | |
9a9252c2 |
66 | # all sessions are extended at the end of the request |
67 | my $now = time; |
68 | @{ $c->{session} }{qw/__updated __expires/} = |
69 | ( $now, $c->config->{session}{expires} + $now ); |
70 | $c->store_session_data( $c->sessionid, $c->{session} ); |
71 | } |
72 | |
73 | $c->NEXT::finalize(@_); |
9e447f9d |
74 | } |
75 | |
76 | sub prepare_action { |
77 | my $c = shift; |
78 | |
9a9252c2 |
79 | my $ret = $c->NEXT::prepare_action; |
9e447f9d |
80 | |
9a9252c2 |
81 | my $sid = $c->sessionid || return; |
9e447f9d |
82 | |
83 | $c->log->debug(qq/Found session "$sid"/) if $c->debug; |
84 | |
9a9252c2 |
85 | my $s = $c->{session} ||= $c->get_session_data($sid); |
86 | if ( !$s or $s->{__expires} < time ) { |
87 | |
88 | # session expired |
89 | $c->log->debug("Deleting session $sid (expired)") if $c->debug; |
90 | $c->delete_session("session expired"); |
91 | return $ret; |
92 | } |
93 | |
94 | if ( $c->config->{session}{verify_address} |
95 | && $c->{session}{__address} |
96 | && $c->{session}{__address} ne $c->request->address ) |
97 | { |
98 | $c->log->warn( |
99 | "Deleting session $sid due to address mismatch (" |
100 | . $c->{session}{__address} . " != " |
101 | . $c->request->address . ")", |
102 | ); |
103 | $c->delete_session("address mismatch"); |
104 | return $ret; |
105 | } |
9e447f9d |
106 | } |
107 | |
108 | sub delete_session { |
9a9252c2 |
109 | my ( $c, $msg ) = @_; |
9e447f9d |
110 | |
9a9252c2 |
111 | # delete the session data |
112 | my $sid = $c->sessionid; |
113 | $c->delete_session_data($sid); |
9e447f9d |
114 | |
9a9252c2 |
115 | # reset the values in the context object |
116 | $c->{session} = undef; |
117 | $c->sessionid(undef); |
118 | $c->session_delete_reason($msg); |
9e447f9d |
119 | } |
120 | |
121 | sub session { |
9a9252c2 |
122 | my $c = shift; |
9e447f9d |
123 | |
124 | return $c->{session} if $c->{session}; |
125 | |
9a9252c2 |
126 | my $sid = $c->generate_session_id; |
127 | $c->sessionid($sid); |
9e447f9d |
128 | |
9a9252c2 |
129 | $c->log->debug(qq/Created session "$sid"/) if $c->debug; |
9e447f9d |
130 | |
9a9252c2 |
131 | return $c->initialize_session_data; |
9e447f9d |
132 | } |
133 | |
134 | sub initialize_session_data { |
9a9252c2 |
135 | my $c = shift; |
9e447f9d |
136 | |
9a9252c2 |
137 | my $now = time; |
9e447f9d |
138 | |
9a9252c2 |
139 | return $c->{session} = { |
140 | __created => $now, |
141 | __updated => $now, |
142 | __expires => $now + $c->config->{session}{expires}, |
9e447f9d |
143 | |
9a9252c2 |
144 | ( |
145 | $c->config->{session}{verify_address} |
146 | ? ( __address => $c->request->address ) |
147 | : () |
148 | ), |
149 | }; |
9e447f9d |
150 | } |
151 | |
9e447f9d |
152 | sub generate_session_id { |
153 | my $c = shift; |
154 | |
155 | my $digest = $c->_find_digest(); |
156 | $digest->add( $c->session_hash_seed() ); |
157 | return $digest->hexdigest; |
158 | } |
159 | |
160 | my $counter; |
9a9252c2 |
161 | |
9e447f9d |
162 | sub session_hash_seed { |
9a9252c2 |
163 | my $c = shift; |
164 | |
165 | return join( "", ++$counter, time, rand, $$, {}, overload::StrVal($c), ); |
9e447f9d |
166 | } |
167 | |
168 | my $usable; |
9a9252c2 |
169 | |
9e447f9d |
170 | sub _find_digest () { |
9a9252c2 |
171 | unless ($usable) { |
172 | $usable = List::Util::first( |
173 | sub { |
174 | eval { Digest->new($_) }; |
175 | }, |
176 | qw/SHA-1 MD5 SHA-256/ |
177 | ) |
178 | or Catalyst::Exception->throw( |
179 | "Could not find a suitable Digest module. Please install " |
180 | . "Digest::SHA1, Digest::SHA, or Digest::MD5" ); |
181 | } |
9e447f9d |
182 | |
183 | return Digest->new($usable); |
184 | } |
185 | |
99b2191e |
186 | sub dump_these { |
187 | my $c = shift; |
188 | |
189 | ( |
190 | $c->NEXT::dump_these(), |
191 | |
192 | $c->sessionid |
193 | ? ( [ "Session ID" => $c->sessionid ], [ Session => $c->session ], ) |
194 | : () |
195 | ); |
196 | } |
197 | |
9e447f9d |
198 | __PACKAGE__; |
199 | |
200 | __END__ |
201 | |
202 | =pod |
203 | |
204 | =head1 NAME |
205 | |
206 | Catalyst::Plugin::Session - Generic Session plugin - ties together server side |
207 | storage and client side tickets required to maintain session data. |
208 | |
209 | =head1 SYNOPSIS |
210 | |
211 | use Catalyst qw/Session Session::Store::FastMmap Session::State::Cookie/; |
212 | |
229a5b53 |
213 | sub add_item : Local { |
214 | my ( $self, $c ) = @_; |
215 | |
216 | my $item_id = $c->req->param("item"); |
217 | |
218 | # $c->session is stored across requests, so |
219 | # other actions will see these values |
220 | |
221 | push @{ $c->session->{items} }, $item_id; |
222 | |
223 | $c->forward("MyView"); |
224 | } |
225 | |
226 | sub display_items : Local { |
227 | my ( $self, $c ) = @_; |
228 | |
229 | # values in $c->session are restored |
230 | $c->stash->{items_to_display} = |
231 | [ map { MyModel->retrieve($_) } @{ $c->session->{items} } ]; |
232 | |
233 | $c->forward("MyView"); |
234 | } |
235 | |
9e447f9d |
236 | =head1 DESCRIPTION |
237 | |
238 | The Session plugin is the base of two related parts of functionality required |
239 | for session management in web applications. |
240 | |
241 | The first part, the State, is getting the browser to repeat back a session key, |
242 | so that the web application can identify the client and logically string |
243 | several requests together into a session. |
244 | |
245 | The second part, the Store, deals with the actual storage of information about |
246 | the client. This data is stored so that the it may be revived for every request |
247 | made by the same client. |
248 | |
249 | This plugin links the two pieces together. |
250 | |
251 | =head1 METHODS |
252 | |
253 | =over 4 |
254 | |
255 | =item sessionid |
256 | |
257 | An accessor for the session ID value. |
258 | |
259 | =item session |
260 | |
261 | Returns a hash reference that might contain unserialized values from previous |
262 | requests in the same session, and whose modified value will be saved for future |
263 | requests. |
264 | |
265 | This method will automatically create a new session and session ID if none |
266 | exists. |
267 | |
268 | =item session_delete_reason |
269 | |
270 | This accessor contains a string with the reason a session was deleted. Possible |
271 | values include: |
272 | |
273 | =over 4 |
274 | |
275 | =item * |
276 | |
277 | C<address mismatch> |
278 | |
279 | =item * |
280 | |
281 | C<session expired> |
282 | |
283 | =back |
284 | |
285 | =item setup |
286 | |
287 | This method is extended to also make calls to |
288 | C<check_session_plugin_requirements> and C<setup_session>. |
289 | |
290 | =item check_session_plugin_requirements |
291 | |
292 | This method ensures that a State and a Store plugin are also in use by the |
293 | application. |
294 | |
295 | =item setup_session |
296 | |
297 | This method populates C<< $c->config->{session} >> with the default values |
298 | listed in L</CONFIGURATION>. |
299 | |
300 | =item prepare_action |
301 | |
302 | This methoid is extended, and will restore session data and check it for |
303 | validity if a session id is defined. It assumes that the State plugin will |
304 | populate the C<sessionid> key beforehand. |
305 | |
306 | =item finalize |
307 | |
308 | This method is extended and will extend the expiry time, as well as persist the |
309 | session data if a session exists. |
310 | |
311 | =item delete_session REASON |
312 | |
313 | This method is used to invalidate a session. It takes an optional parameter |
314 | which will be saved in C<session_delete_reason> if provided. |
315 | |
316 | =item initialize_session_data |
317 | |
318 | This method will initialize the internal structure of the session, and is |
319 | called by the C<session> method if appropriate. |
320 | |
229a5b53 |
321 | =item generate_session_id |
322 | |
323 | This method will return a string that can be used as a session ID. It is |
324 | supposed to be a reasonably random string with enough bits to prevent |
325 | collision. It basically takes C<session_hash_seed> and hashes it using SHA-1, |
326 | MD5 or SHA-256, depending on the availibility of these modules. |
327 | |
328 | =item session_hash_seed |
329 | |
330 | This method is actually rather internal to generate_session_id, but should be |
331 | overridable in case you want to provide more random data. |
332 | |
333 | Currently it returns a concatenated string which contains: |
334 | |
335 | =over 4 |
336 | |
337 | =item * |
338 | |
339 | A counter |
340 | |
341 | =item * |
342 | |
343 | The current time |
344 | |
345 | =item * |
346 | |
347 | One value from C<rand>. |
348 | |
349 | =item * |
350 | |
351 | The stringified value of a newly allocated hash reference |
352 | |
353 | =item * |
354 | |
355 | The stringified value of the Catalyst context object |
356 | |
357 | =back |
358 | |
359 | In the hopes that those combined values are entropic enough for most uses. If |
360 | this is not the case you can replace C<session_hash_seed> with e.g. |
361 | |
362 | sub session_hash_seed { |
363 | open my $fh, "<", "/dev/random"; |
364 | read $fh, my $bytes, 20; |
365 | close $fh; |
366 | return $bytes; |
367 | } |
368 | |
369 | Or even more directly, replace C<generate_session_id>: |
370 | |
371 | sub generate_session_id { |
372 | open my $fh, "<", "/dev/random"; |
373 | read $fh, my $bytes, 20; |
374 | close $fh; |
375 | return unpack("H*", $bytes); |
376 | } |
377 | |
378 | Also have a look at L<Crypt::Random> and the various openssl bindings - these |
379 | modules provide APIs for cryptographically secure random data. |
380 | |
99b2191e |
381 | =item dump_these |
382 | |
383 | See L<Catalyst/dump_these> - ammends the session data structure to the list of |
384 | dumped objects if session ID is defined. |
385 | |
9e447f9d |
386 | =back |
387 | |
388 | =head1 CONFIGURATION |
389 | |
229a5b53 |
390 | $c->config->{session} = { |
391 | expires => 1234, |
392 | }; |
9e447f9d |
393 | |
394 | All configuation parameters are provided in a hash reference under the |
395 | C<session> key in the configuration hash. |
396 | |
397 | =over 4 |
398 | |
399 | =item expires |
400 | |
401 | The time-to-live of each session, expressed in seconds. Defaults to 7200 (two |
402 | hours). |
403 | |
404 | =item verify_address |
405 | |
406 | When false, C<< $c->request->address >> will be checked at prepare time. If it |
407 | is not the same as the address that initiated the session, the session is |
408 | deleted. |
409 | |
410 | =back |
411 | |
412 | =head1 SPECIAL KEYS |
413 | |
414 | The hash reference returned by C<< $c->session >> contains several keys which |
415 | are automatically set: |
416 | |
417 | =over 4 |
418 | |
419 | =item __expires |
420 | |
421 | A timestamp whose value is the last second when the session is still valid. If |
422 | a session is restored, and __expires is less than the current time, the session |
423 | is deleted. |
424 | |
425 | =item __updated |
426 | |
427 | The last time a session was saved. This is the value of |
428 | C<< $c->{session}{__expires} - $c->config->{session}{expires} >>. |
429 | |
430 | =item __created |
431 | |
432 | The time when the session was first created. |
433 | |
434 | =item __address |
435 | |
436 | The value of C<< $c->request->address >> at the time the session was created. |
437 | This value is only populated of C<verify_address> is true in the configuration. |
438 | |
439 | =back |
440 | |
c80e9f04 |
441 | =head1 CAVEATS |
442 | |
443 | C<verify_address> could make your site inaccessible to users who are behind |
444 | load balanced proxies. Some ISPs may give a different IP to each request by the |
445 | same client due to this type of proxying. If addresses are verified these |
446 | users' sessions cannot persist. |
447 | |
448 | To let these users access your site you can either disable address verification |
449 | as a whole, or provide a checkbox in the login dialog that tells the server |
450 | that it's OK for the address of the client to change. When the server sees that |
451 | this box is checked it should delete the C<__address> sepcial key from the |
452 | session hash when the hash is first created. |
453 | |
9e447f9d |
454 | =cut |
455 | |
456 | |