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 (); |
9e447f9d |
13 | |
b1cd7d77 |
14 | our $VERSION = "0.02"; |
37160715 |
15 | |
9e447f9d |
16 | BEGIN { |
0974ac06 |
17 | __PACKAGE__->mk_accessors(qw/_sessionid _session session_delete_reason/); |
9e447f9d |
18 | } |
19 | |
20 | sub setup { |
9a9252c2 |
21 | my $c = shift; |
22 | |
23 | $c->NEXT::setup(@_); |
24 | |
25 | $c->check_session_plugin_requirements; |
26 | $c->setup_session; |
27 | |
28 | return $c; |
9e447f9d |
29 | } |
30 | |
31 | sub check_session_plugin_requirements { |
9a9252c2 |
32 | my $c = shift; |
9e447f9d |
33 | |
9a9252c2 |
34 | unless ( $c->isa("Catalyst::Plugin::Session::State") |
35 | && $c->isa("Catalyst::Plugin::Session::Store") ) |
36 | { |
37 | my $err = |
38 | ( "The Session plugin requires both Session::State " |
39 | . "and Session::Store plugins to be used as well." ); |
9e447f9d |
40 | |
9a9252c2 |
41 | $c->log->fatal($err); |
42 | Catalyst::Exception->throw($err); |
43 | } |
9e447f9d |
44 | } |
45 | |
46 | sub setup_session { |
9a9252c2 |
47 | my $c = shift; |
9e447f9d |
48 | |
9a9252c2 |
49 | my $cfg = ( $c->config->{session} ||= {} ); |
9e447f9d |
50 | |
9a9252c2 |
51 | %$cfg = ( |
52 | expires => 7200, |
53 | verify_address => 1, |
54 | %$cfg, |
55 | ); |
9e447f9d |
56 | |
9a9252c2 |
57 | $c->NEXT::setup_session(); |
9e447f9d |
58 | } |
59 | |
60 | sub finalize { |
9a9252c2 |
61 | my $c = shift; |
9e447f9d |
62 | |
0974ac06 |
63 | if ( my $session_data = $c->_session ) { |
9e447f9d |
64 | |
9a9252c2 |
65 | # all sessions are extended at the end of the request |
66 | my $now = time; |
0974ac06 |
67 | @{ $session_data }{qw/__updated __expires/} = |
9a9252c2 |
68 | ( $now, $c->config->{session}{expires} + $now ); |
0974ac06 |
69 | $c->store_session_data( $c->sessionid, $session_data ); |
9a9252c2 |
70 | } |
71 | |
72 | $c->NEXT::finalize(@_); |
9e447f9d |
73 | } |
74 | |
75 | sub prepare_action { |
76 | my $c = shift; |
77 | |
3f182468 |
78 | if ( my $sid = $c->sessionid ) { |
0974ac06 |
79 | no warnings 'uninitialized'; # ne __address |
80 | |
81 | my $session_data = $c->_session || $c->_session( $c->get_session_data($sid) ); |
82 | if ( !$session_data or $session_data->{__expires} < time ) { |
3f182468 |
83 | |
84 | # session expired |
85 | $c->log->debug("Deleting session $sid (expired)") if $c->debug; |
86 | $c->delete_session("session expired"); |
87 | } |
29543a62 |
88 | elsif ($c->config->{session}{verify_address} |
0974ac06 |
89 | && $session_data->{__address} ne $c->request->address ) |
3f182468 |
90 | { |
91 | $c->log->warn( |
92 | "Deleting session $sid due to address mismatch (" |
0974ac06 |
93 | . $session_data->{__address} . " != " |
3f182468 |
94 | . $c->request->address . ")", |
95 | ); |
96 | $c->delete_session("address mismatch"); |
97 | } |
29543a62 |
98 | else { |
99 | $c->log->debug(qq/Restored session "$sid"/) if $c->debug; |
100 | } |
9a9252c2 |
101 | } |
102 | |
3f182468 |
103 | $c->NEXT::prepare_action(@_); |
9e447f9d |
104 | } |
105 | |
106 | sub delete_session { |
9a9252c2 |
107 | my ( $c, $msg ) = @_; |
9e447f9d |
108 | |
9a9252c2 |
109 | # delete the session data |
110 | my $sid = $c->sessionid; |
111 | $c->delete_session_data($sid); |
9e447f9d |
112 | |
9a9252c2 |
113 | # reset the values in the context object |
0974ac06 |
114 | $c->_session(undef); |
115 | $c->_sessionid(undef); |
9a9252c2 |
116 | $c->session_delete_reason($msg); |
9e447f9d |
117 | } |
118 | |
0974ac06 |
119 | sub sessionid { |
120 | my $c = shift; |
121 | |
122 | if ( @_ ) { |
123 | if ( $c->validate_session_id( my $sid = shift ) ) { |
124 | return $c->_sessionid( $sid ); |
125 | } else { |
126 | my $err = "Tried to set invalid session ID '$sid'"; |
127 | $c->log->error( $err ); |
128 | Catalyst::Exception->throw( $err ); |
129 | } |
130 | } |
131 | |
132 | return $c->_sessionid; |
133 | } |
134 | |
135 | sub validate_session_id { |
136 | my ( $c, $sid ) = @_; |
137 | |
138 | $sid =~ /^[a-f\d]+$/i; |
139 | } |
140 | |
9e447f9d |
141 | sub session { |
9a9252c2 |
142 | my $c = shift; |
9e447f9d |
143 | |
0974ac06 |
144 | $c->_session || do { |
145 | my $sid = $c->generate_session_id; |
146 | $c->sessionid($sid); |
9e447f9d |
147 | |
0974ac06 |
148 | $c->log->debug(qq/Created session "$sid"/) if $c->debug; |
9e447f9d |
149 | |
0974ac06 |
150 | $c->initialize_session_data; |
151 | }; |
9e447f9d |
152 | } |
153 | |
154 | sub initialize_session_data { |
9a9252c2 |
155 | my $c = shift; |
9e447f9d |
156 | |
9a9252c2 |
157 | my $now = time; |
9e447f9d |
158 | |
0974ac06 |
159 | return $c->_session({ |
9a9252c2 |
160 | __created => $now, |
161 | __updated => $now, |
162 | __expires => $now + $c->config->{session}{expires}, |
9e447f9d |
163 | |
9a9252c2 |
164 | ( |
165 | $c->config->{session}{verify_address} |
166 | ? ( __address => $c->request->address ) |
167 | : () |
168 | ), |
0974ac06 |
169 | }); |
9e447f9d |
170 | } |
171 | |
9e447f9d |
172 | sub generate_session_id { |
173 | my $c = shift; |
174 | |
175 | my $digest = $c->_find_digest(); |
176 | $digest->add( $c->session_hash_seed() ); |
177 | return $digest->hexdigest; |
178 | } |
179 | |
180 | my $counter; |
9a9252c2 |
181 | |
9e447f9d |
182 | sub session_hash_seed { |
9a9252c2 |
183 | my $c = shift; |
184 | |
185 | return join( "", ++$counter, time, rand, $$, {}, overload::StrVal($c), ); |
9e447f9d |
186 | } |
187 | |
188 | my $usable; |
9a9252c2 |
189 | |
9e447f9d |
190 | sub _find_digest () { |
9a9252c2 |
191 | unless ($usable) { |
7d139eeb |
192 | foreach my $alg (qw/SHA-1 MD5 SHA-256/) { |
193 | eval { |
29543a62 |
194 | my $obj = Digest->new($alg); |
195 | $usable = $alg; |
196 | return $obj; |
197 | }; |
7d139eeb |
198 | } |
199 | $usable |
9a9252c2 |
200 | or Catalyst::Exception->throw( |
201 | "Could not find a suitable Digest module. Please install " |
202 | . "Digest::SHA1, Digest::SHA, or Digest::MD5" ); |
203 | } |
9e447f9d |
204 | |
205 | return Digest->new($usable); |
206 | } |
207 | |
99b2191e |
208 | sub dump_these { |
209 | my $c = shift; |
210 | |
211 | ( |
212 | $c->NEXT::dump_these(), |
213 | |
214 | $c->sessionid |
215 | ? ( [ "Session ID" => $c->sessionid ], [ Session => $c->session ], ) |
216 | : () |
217 | ); |
218 | } |
219 | |
9e447f9d |
220 | __PACKAGE__; |
221 | |
222 | __END__ |
223 | |
224 | =pod |
225 | |
226 | =head1 NAME |
227 | |
228 | Catalyst::Plugin::Session - Generic Session plugin - ties together server side |
fb1a4ac3 |
229 | storage and client side state required to maintain session data. |
9e447f9d |
230 | |
231 | =head1 SYNOPSIS |
232 | |
8f0b4c16 |
233 | # To get sessions to "just work", all you need to do is use these plugins: |
234 | |
235 | use Catalyst qw/ |
236 | Session |
237 | Session::Store::FastMmap |
238 | Session::State::Cookie |
239 | /; |
240 | |
241 | # you can replace Store::FastMmap with Store::File - both have sensible |
242 | # default configurations (see their docs for details) |
243 | |
244 | # more complicated backends are available for other scenarios (DBI storage, |
245 | # etc) |
246 | |
247 | |
248 | # after you've loaded the plugins you can save session data |
249 | # For example, if you are writing a shopping cart, it could be implemented |
250 | # like this: |
9e447f9d |
251 | |
229a5b53 |
252 | sub add_item : Local { |
253 | my ( $self, $c ) = @_; |
254 | |
255 | my $item_id = $c->req->param("item"); |
256 | |
8f0b4c16 |
257 | # $c->session is a hash ref, a bit like $c->stash |
258 | # the difference is that it' preserved across requests |
229a5b53 |
259 | |
260 | push @{ $c->session->{items} }, $item_id; |
261 | |
262 | $c->forward("MyView"); |
263 | } |
264 | |
265 | sub display_items : Local { |
266 | my ( $self, $c ) = @_; |
267 | |
268 | # values in $c->session are restored |
269 | $c->stash->{items_to_display} = |
8f0b4c16 |
270 | [ map { MyModel->retrieve($_) } @{ $c->session->{items} } ]; |
229a5b53 |
271 | |
272 | $c->forward("MyView"); |
273 | } |
274 | |
9e447f9d |
275 | =head1 DESCRIPTION |
276 | |
277 | The Session plugin is the base of two related parts of functionality required |
278 | for session management in web applications. |
279 | |
280 | The first part, the State, is getting the browser to repeat back a session key, |
281 | so that the web application can identify the client and logically string |
282 | several requests together into a session. |
283 | |
284 | The second part, the Store, deals with the actual storage of information about |
285 | the client. This data is stored so that the it may be revived for every request |
286 | made by the same client. |
287 | |
288 | This plugin links the two pieces together. |
289 | |
8f0b4c16 |
290 | =head1 RECCOMENDED BACKENDS |
291 | |
292 | =over 4 |
293 | |
294 | =item Session::State::Cookie |
295 | |
296 | The only really sane way to do state is using cookies. |
297 | |
298 | =item Session::Store::File |
299 | |
300 | A portable backend, based on Cache::File. |
301 | |
302 | =item Session::Store::FastMmap |
303 | |
304 | A fast and flexible backend, based on Cache::FastMmap. |
305 | |
306 | =back |
307 | |
9e447f9d |
308 | =head1 METHODS |
309 | |
310 | =over 4 |
311 | |
312 | =item sessionid |
313 | |
314 | An accessor for the session ID value. |
315 | |
316 | =item session |
317 | |
318 | Returns a hash reference that might contain unserialized values from previous |
319 | requests in the same session, and whose modified value will be saved for future |
320 | requests. |
321 | |
322 | This method will automatically create a new session and session ID if none |
323 | exists. |
324 | |
325 | =item session_delete_reason |
326 | |
327 | This accessor contains a string with the reason a session was deleted. Possible |
328 | values include: |
329 | |
330 | =over 4 |
331 | |
332 | =item * |
333 | |
334 | C<address mismatch> |
335 | |
336 | =item * |
337 | |
338 | C<session expired> |
339 | |
340 | =back |
341 | |
8f0b4c16 |
342 | =back |
343 | |
344 | =item INTERNAL METHODS |
345 | |
346 | =over 4 |
347 | |
9e447f9d |
348 | =item setup |
349 | |
350 | This method is extended to also make calls to |
351 | C<check_session_plugin_requirements> and C<setup_session>. |
352 | |
353 | =item check_session_plugin_requirements |
354 | |
355 | This method ensures that a State and a Store plugin are also in use by the |
356 | application. |
357 | |
358 | =item setup_session |
359 | |
360 | This method populates C<< $c->config->{session} >> with the default values |
361 | listed in L</CONFIGURATION>. |
362 | |
363 | =item prepare_action |
364 | |
365 | This methoid is extended, and will restore session data and check it for |
366 | validity if a session id is defined. It assumes that the State plugin will |
367 | populate the C<sessionid> key beforehand. |
368 | |
369 | =item finalize |
370 | |
371 | This method is extended and will extend the expiry time, as well as persist the |
372 | session data if a session exists. |
373 | |
374 | =item delete_session REASON |
375 | |
376 | This method is used to invalidate a session. It takes an optional parameter |
377 | which will be saved in C<session_delete_reason> if provided. |
378 | |
379 | =item initialize_session_data |
380 | |
381 | This method will initialize the internal structure of the session, and is |
382 | called by the C<session> method if appropriate. |
383 | |
229a5b53 |
384 | =item generate_session_id |
385 | |
386 | This method will return a string that can be used as a session ID. It is |
387 | supposed to be a reasonably random string with enough bits to prevent |
388 | collision. It basically takes C<session_hash_seed> and hashes it using SHA-1, |
389 | MD5 or SHA-256, depending on the availibility of these modules. |
390 | |
391 | =item session_hash_seed |
392 | |
393 | This method is actually rather internal to generate_session_id, but should be |
394 | overridable in case you want to provide more random data. |
395 | |
396 | Currently it returns a concatenated string which contains: |
397 | |
0974ac06 |
398 | =item validate_session_id SID |
399 | |
400 | Make sure a session ID is of the right format. |
401 | |
402 | This currently ensures that the session ID string is any amount of case |
403 | insensitive hexadecimal characters. |
404 | |
229a5b53 |
405 | =over 4 |
406 | |
407 | =item * |
408 | |
409 | A counter |
410 | |
411 | =item * |
412 | |
413 | The current time |
414 | |
415 | =item * |
416 | |
417 | One value from C<rand>. |
418 | |
419 | =item * |
420 | |
421 | The stringified value of a newly allocated hash reference |
422 | |
423 | =item * |
424 | |
425 | The stringified value of the Catalyst context object |
426 | |
427 | =back |
428 | |
429 | In the hopes that those combined values are entropic enough for most uses. If |
430 | this is not the case you can replace C<session_hash_seed> with e.g. |
431 | |
432 | sub session_hash_seed { |
433 | open my $fh, "<", "/dev/random"; |
434 | read $fh, my $bytes, 20; |
435 | close $fh; |
436 | return $bytes; |
437 | } |
438 | |
439 | Or even more directly, replace C<generate_session_id>: |
440 | |
441 | sub generate_session_id { |
442 | open my $fh, "<", "/dev/random"; |
443 | read $fh, my $bytes, 20; |
444 | close $fh; |
445 | return unpack("H*", $bytes); |
446 | } |
447 | |
448 | Also have a look at L<Crypt::Random> and the various openssl bindings - these |
449 | modules provide APIs for cryptographically secure random data. |
450 | |
99b2191e |
451 | =item dump_these |
452 | |
453 | See L<Catalyst/dump_these> - ammends the session data structure to the list of |
454 | dumped objects if session ID is defined. |
455 | |
9e447f9d |
456 | =back |
457 | |
a92c8aeb |
458 | =head1 USING SESSIONS DURING PREPARE |
459 | |
460 | The earliest point in time at which you may use the session data is after |
461 | L<Catalyst::Plugin::Session>'s C<prepare_action> has finished. |
462 | |
463 | State plugins must set $c->session ID before C<prepare_action>, and during |
464 | C<prepare_action> L<Catalyst::Plugin::Session> will actually load the data from |
465 | the store. |
466 | |
467 | sub prepare_action { |
468 | my $c = shift; |
469 | |
470 | # don't touch $c->session yet! |
b1cd7d77 |
471 | |
a92c8aeb |
472 | $c->NEXT::prepare_action( @_ ); |
473 | |
474 | $c->session; # this is OK |
475 | $c->sessionid; # this is also OK |
476 | } |
477 | |
9e447f9d |
478 | =head1 CONFIGURATION |
479 | |
229a5b53 |
480 | $c->config->{session} = { |
481 | expires => 1234, |
482 | }; |
9e447f9d |
483 | |
484 | All configuation parameters are provided in a hash reference under the |
485 | C<session> key in the configuration hash. |
486 | |
487 | =over 4 |
488 | |
489 | =item expires |
490 | |
491 | The time-to-live of each session, expressed in seconds. Defaults to 7200 (two |
492 | hours). |
493 | |
494 | =item verify_address |
495 | |
8c7e922c |
496 | When true, C<<$c->request->address>> will be checked at prepare time. If it is |
497 | not the same as the address that initiated the session, the session is deleted. |
9e447f9d |
498 | |
499 | =back |
500 | |
501 | =head1 SPECIAL KEYS |
502 | |
503 | The hash reference returned by C<< $c->session >> contains several keys which |
504 | are automatically set: |
505 | |
506 | =over 4 |
507 | |
508 | =item __expires |
509 | |
510 | A timestamp whose value is the last second when the session is still valid. If |
511 | a session is restored, and __expires is less than the current time, the session |
512 | is deleted. |
513 | |
514 | =item __updated |
515 | |
516 | The last time a session was saved. This is the value of |
0974ac06 |
517 | C<< $c->session->{__expires} - $c->config->session->{expires} >>. |
9e447f9d |
518 | |
519 | =item __created |
520 | |
521 | The time when the session was first created. |
522 | |
523 | =item __address |
524 | |
525 | The value of C<< $c->request->address >> at the time the session was created. |
8c7e922c |
526 | This value is only populated if C<verify_address> is true in the configuration. |
9e447f9d |
527 | |
528 | =back |
529 | |
c80e9f04 |
530 | =head1 CAVEATS |
531 | |
532 | C<verify_address> could make your site inaccessible to users who are behind |
533 | load balanced proxies. Some ISPs may give a different IP to each request by the |
534 | same client due to this type of proxying. If addresses are verified these |
535 | users' sessions cannot persist. |
536 | |
537 | To let these users access your site you can either disable address verification |
538 | as a whole, or provide a checkbox in the login dialog that tells the server |
539 | that it's OK for the address of the client to change. When the server sees that |
540 | this box is checked it should delete the C<__address> sepcial key from the |
541 | session hash when the hash is first created. |
542 | |
d45028d6 |
543 | =head1 AUTHORS |
544 | |
36316211 |
545 | Andy Grundman |
546 | Christian Hansen |
547 | Yuval Kogman, C<nothingmuch@woobling.org> |
548 | Sebastian Riedel |
d45028d6 |
549 | |
cc40ae4b |
550 | =head1 COPYRIGHT & LICENSE |
d45028d6 |
551 | |
552 | Copyright (c) 2005 the aforementioned authors. All rights |
553 | reserved. This program is free software; you can redistribute |
554 | it and/or modify it under the same terms as Perl itself. |
555 | |
9e447f9d |
556 | =cut |
557 | |
558 | |