File Coverage

blib/lib/Catalyst/Plugin/Session.pm
Criterion Covered Total %
statement 160 300 53.3
branch 36 114 31.5
condition 23 62 37.1
subroutine 36 63 57.1
pod 35 35 100.0
total 290 574 50.5


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             package Catalyst::Plugin::Session;
4              
5 3     3   354149 use Moose;
  3         1309834  
  3         22  
6             with 'MooseX::Emulate::Class::Accessor::Fast';
7 3     3   22882 use MRO::Compat;
  3         8  
  3         103  
8 3     3   2053 use Catalyst::Exception ();
  3         278833  
  3         114  
9 3     3   2064 use Digest ();
  3         1892  
  3         72  
10 3     3   22 use overload ();
  3         8  
  3         47  
11 3     3   1396 use Object::Signature ();
  3         12823  
  3         61  
12 3     3   1589 use HTML::Entities ();
  3         17867  
  3         139  
13 3     3   22 use Carp;
  3         17  
  3         215  
14 3     3   21 use List::Util qw/ max /;
  3         5  
  3         196  
15              
16 3     3   24 use namespace::clean -except => 'meta';
  3         7  
  3         27  
17              
18             our $VERSION = '0.41';
19             $VERSION = eval $VERSION;
20              
21             my @session_data_accessors; # used in delete_session
22              
23             __PACKAGE__->mk_accessors(
24             "_session_delete_reason",
25             @session_data_accessors = qw/
26             _sessionid
27             _session
28             _session_expires
29             _extended_session_expires
30             _session_data_sig
31             _flash
32             _flash_keep_keys
33             _flash_key_hashes
34             _tried_loading_session_id
35             _tried_loading_session_data
36             _tried_loading_session_expires
37             _tried_loading_flash_data
38             _needs_early_session_finalization
39             /
40             );
41              
42             sub _session_plugin_config {
43 15     15   27 my $c = shift;
44             # FIXME - Start warning once all the state/store modules have also been updated.
45             #$c->log->warn("Deprecated 'session' config key used, please use the key 'Plugin::Session' instead")
46             # if exists $c->config->{session}
47             #$c->config->{'Plugin::Session'} ||= delete($c->config->{session}) || {};
48 15   100     49 $c->config->{'Plugin::Session'} ||= $c->config->{session} || {};
      33        
49             }
50              
51             sub setup {
52 5     5 1 17740 my $c = shift;
53              
54 5         27 $c->maybe::next::method(@_);
55              
56 5         75 $c->check_session_plugin_requirements;
57 2         50 $c->setup_session;
58              
59 2         20 return $c;
60             }
61              
62             sub check_session_plugin_requirements {
63 5     5 1 10 my $c = shift;
64              
65 5 100 100     14 unless ( $c->isa("Catalyst::Plugin::Session::State")
66             && $c->isa("Catalyst::Plugin::Session::Store") )
67             {
68 3         56 my $err =
69             ( "The Session plugin requires both Session::State "
70             . "and Session::Store plugins to be used as well." );
71              
72 3         8 $c->log->fatal($err);
73 3         31 Catalyst::Exception->throw($err);
74             }
75             }
76              
77             sub setup_session {
78 2     2 1 5 my $c = shift;
79              
80 2         8 my $cfg = $c->_session_plugin_config;
81              
82 2         33 %$cfg = (
83             expires => 7200,
84             verify_address => 0,
85             verify_user_agent => 0,
86             expiry_threshold => 0,
87             %$cfg,
88             );
89              
90 2         6 $c->maybe::next::method();
91             }
92              
93             sub prepare_action {
94 1     1 1 24 my $c = shift;
95              
96 1         5 $c->maybe::next::method(@_);
97              
98 1 50 33     17 if ( $c->_session_plugin_config->{flash_to_stash}
      33        
99             and $c->sessionid
100             and my $flash_data = $c->flash )
101             {
102 1         142 @{ $c->stash }{ keys %$flash_data } = values %$flash_data;
  1         5  
103             }
104             }
105              
106             sub finalize_headers {
107 0     0 1 0 my $c = shift;
108              
109             # fix cookie before we send headers
110 0         0 $c->_save_session_expires;
111              
112             # Force extension of session_expires before finalizing headers, so a pos
113             # up to date. First call to session_expires will extend the expiry, subs
114             # just return the previously extended value.
115 0         0 $c->session_expires;
116 0 0       0 $c->finalize_session if $c->_needs_early_session_finalization;
117              
118 0         0 return $c->maybe::next::method(@_);
119             }
120              
121             sub finalize_body {
122 6     6 1 3327 my $c = shift;
123              
124             # We have to finalize our session *before* $c->engine->finalize_xxx is called,
125             # because we do not want to send the HTTP response before the session is stored/committed to
126             # the session database (or whatever Session::Store you use).
127 6 50       20 $c->finalize_session unless $c->_needs_early_session_finalization;
128 6         38 $c->_clear_session_instance_data;
129              
130 6         70 return $c->maybe::next::method(@_);
131             }
132              
133             sub finalize_session {
134 6     6 1 810 my $c = shift;
135              
136 6         30 $c->maybe::next::method(@_);
137              
138 6         100 $c->_save_session_id;
139 6         19 $c->_save_session;
140 6         20 $c->_save_flash;
141              
142             }
143              
144             sub _session_updated {
145 12     12   21 my $c = shift;
146              
147 12 100       26 if ( my $session_data = $c->_session ) {
148              
149 3     3   3043 no warnings 'uninitialized';
  3         6  
  3         1963  
150 11 100       1285 if ( Object::Signature::signature($session_data) ne
151             $c->_session_data_sig )
152             {
153 7         1197 return $session_data;
154             } else {
155 4         710 return;
156             }
157              
158             } else {
159              
160 1         120 return;
161              
162             }
163             }
164              
165             sub _save_session_id {
166 6     6   12 my $c = shift;
167              
168             # we already called set when allocating
169             # no need to tell the state plugins anything new
170             }
171              
172             sub _save_session_expires {
173 0     0   0 my $c = shift;
174              
175 0 0       0 if ( defined($c->_session_expires) ) {
176              
177 0 0       0 if (my $sid = $c->sessionid) {
178              
179 0         0 my $current = $c->_get_stored_session_expires;
180 0         0 my $extended = $c->session_expires;
181 0 0       0 if ($extended > $current) {
182 0         0 $c->store_session_data( "expires:$sid" => $extended );
183             }
184              
185             }
186             }
187             }
188              
189             sub _save_session {
190 12     12   20 my $c = shift;
191              
192 12 100       27 if ( my $session_data = $c->_session_updated ) {
193              
194 7         22 $session_data->{__updated} = time();
195 7         23 my $sid = $c->sessionid;
196 7         44 $c->store_session_data( "session:$sid" => $session_data );
197             }
198             }
199              
200             sub _save_flash {
201 6     6   12 my $c = shift;
202              
203 6 50       20 if ( my $flash_data = $c->_flash ) {
204              
205 6   100     722 my $hashes = $c->_flash_key_hashes || {};
206 6   100     773 my $keep = $c->_flash_keep_keys || {};
207 6         699 foreach my $key ( keys %$hashes ) {
208 2 50 33     13 if ( !exists $keep->{$key} and Object::Signature::signature( \$flash_data->{$key} ) eq $hashes->{$key} ) {
209 2         75 delete $flash_data->{$key};
210             }
211             }
212              
213 6         16 my $sid = $c->sessionid;
214              
215 6         33 my $session_data = $c->_session;
216 6 100       698 if (%$flash_data) {
217 4         10 $session_data->{__flash} = $flash_data;
218             }
219             else {
220 2         5 delete $session_data->{__flash};
221             }
222 6         19 $c->_session($session_data);
223 6         2103 $c->_save_session;
224             }
225             }
226              
227             sub _load_session_expires {
228 6     6   10 my $c = shift;
229 6 50       29 return $c->_session_expires if $c->_tried_loading_session_expires;
230 6         701 $c->_tried_loading_session_expires(1);
231              
232 6 50       1806 if ( my $sid = $c->sessionid ) {
233 6         40 my $expires = $c->_get_stored_session_expires;
234              
235 6 50       54 if ( $expires >= time() ) {
236 6         21 $c->_session_expires( $expires );
237 6         1935 return $expires;
238             } else {
239 0         0 $c->delete_session( "session expired" );
240 0         0 return 0;
241             }
242             }
243              
244 0         0 return;
245             }
246              
247             sub _load_session {
248 6     6   756 my $c = shift;
249 6 50       17 return $c->_session if $c->_tried_loading_session_data;
250 6         703 $c->_tried_loading_session_data(1);
251              
252 6 50       1888 if ( my $sid = $c->sessionid ) {
253 6 50       39 if ( $c->_load_session_expires ) { # > 0
254              
255 6   50     21 my $session_data = $c->get_session_data("session:$sid") || return;
256 6         54 $c->_session($session_data);
257              
258 3     3   33 no warnings 'uninitialized'; # ne __address
  3         9  
  3         9345  
259 6 0 33     2115 if ( $c->_session_plugin_config->{verify_address}
      0        
260             && exists $session_data->{__address}
261             && $session_data->{__address} ne $c->request->address )
262             {
263             $c->log->warn(
264             "Deleting session $sid due to address mismatch ("
265 0         0 . $session_data->{__address} . " != "
266             . $c->request->address . ")"
267             );
268 0         0 $c->delete_session("address mismatch");
269 0         0 return;
270             }
271 6 50 33     97 if ( $c->_session_plugin_config->{verify_user_agent}
272             && $session_data->{__user_agent} ne $c->request->user_agent )
273             {
274             $c->log->warn(
275             "Deleting session $sid due to user agent mismatch ("
276 0         0 . $session_data->{__user_agent} . " != "
277             . $c->request->user_agent . ")"
278             );
279 0         0 $c->delete_session("user agent mismatch");
280 0         0 return;
281             }
282              
283 6 50       68 $c->log->debug(qq/Restored session "$sid"/) if $c->debug;
284 6 50       45 $c->_session_data_sig( Object::Signature::signature($session_data) ) if $session_data;
285 6         2314 $c->_expire_session_keys;
286              
287 6         25 return $session_data;
288             }
289             }
290              
291 0         0 return;
292             }
293              
294             sub _load_flash {
295 6     6   731 my $c = shift;
296 6 50       21 return $c->_flash if $c->_tried_loading_flash_data;
297 6         719 $c->_tried_loading_flash_data(1);
298              
299 6 50       1820 if ( my $sid = $c->sessionid ) {
300              
301 6         41 my $session_data = $c->session;
302 6         41 $c->_flash($session_data->{__flash});
303              
304 6 100       1957 if ( my $flash_data = $c->_flash )
305             {
306 3         428 $c->_flash_key_hashes({ map { $_ => Object::Signature::signature( \$flash_data->{$_} ) } keys %$flash_data });
  3         12  
307              
308 3         1179 return $flash_data;
309             }
310             }
311              
312 3         345 return;
313             }
314              
315             sub _expire_session_keys {
316 6     6   15 my ( $c, $data ) = @_;
317              
318 6         10 my $now = time;
319              
320 6   50     25 my $expire_times = ( $data || $c->_session || {} )->{__expire_keys} || {};
321 6         749 foreach my $key ( grep { $expire_times->{$_} < $now } keys %$expire_times ) {
  0         0  
322 0         0 delete $c->_session->{$key};
323 0         0 delete $expire_times->{$key};
324             }
325             }
326              
327             sub _clear_session_instance_data {
328 6     6   11 my $c = shift;
329 6         25 $c->$_(undef) for @session_data_accessors;
330 6         21982 $c->maybe::next::method(@_); # allow other plugins to hook in on this
331             }
332              
333             sub change_session_id {
334 0     0 1 0 my $c = shift;
335              
336 0         0 my $sessiondata = $c->session;
337 0         0 my $oldsid = $c->sessionid;
338 0         0 my $newsid = $c->create_session_id;
339              
340 0 0       0 if ($oldsid) {
341 0 0       0 $c->log->debug(qq/change_sessid: deleting session data from "$oldsid"/) if $c->debug;
342 0         0 $c->delete_session_data("${_}:${oldsid}") for qw/session expires flash/;
343             }
344              
345 0 0       0 $c->log->debug(qq/change_sessid: storing session data to "$newsid"/) if $c->debug;
346 0         0 $c->store_session_data( "session:$newsid" => $sessiondata );
347              
348 0         0 return $newsid;
349             }
350              
351             sub delete_session {
352 0     0 1 0 my ( $c, $msg ) = @_;
353              
354 0 0       0 $c->log->debug("Deleting session" . ( defined($msg) ? "($msg)" : '(no reason given)') ) if $c->debug;
    0          
355              
356             # delete the session data
357 0 0       0 if ( my $sid = $c->sessionid ) {
358 0         0 $c->delete_session_data("${_}:${sid}") for qw/session expires flash/;
359 0         0 $c->delete_session_id($sid);
360             }
361              
362             # reset the values in the context object
363             # see the BEGIN block
364 0         0 $c->_clear_session_instance_data;
365              
366 0         0 $c->_session_delete_reason($msg);
367             }
368              
369             sub session_delete_reason {
370 0     0 1 0 my $c = shift;
371              
372 0         0 $c->session_is_valid; # check that it was loaded
373              
374 0         0 $c->_session_delete_reason(@_);
375             }
376              
377             sub session_expires {
378 0     0 1 0 my $c = shift;
379              
380 0 0       0 if ( defined( my $expires = $c->_extended_session_expires ) ) {
    0          
381 0         0 return $expires;
382             } elsif ( defined( $expires = $c->_load_session_expires ) ) {
383 0         0 return $c->extend_session_expires( $expires );
384             } else {
385 0         0 return 0;
386             }
387             }
388              
389             sub extend_session_expires {
390 0     0 1 0 my ( $c, $expires ) = @_;
391              
392 0   0     0 my $threshold = $c->_session_plugin_config->{expiry_threshold} || 0;
393              
394 0 0       0 if ( my $sid = $c->sessionid ) {
395 0         0 my $expires = $c->_get_stored_session_expires;
396 0         0 my $cutoff = $expires - $threshold;
397              
398 0 0 0     0 if (!$threshold || $cutoff <= time || $c->_session_updated) {
      0        
399              
400 0         0 $c->_extended_session_expires( my $updated = $c->calculate_initial_session_expires() );
401 0         0 $c->extend_session_id( $sid, $updated );
402              
403 0         0 return $updated;
404              
405             } else {
406              
407 0         0 return $expires;
408              
409             }
410              
411             } else {
412              
413 0         0 return;
414              
415             }
416              
417             }
418              
419             sub change_session_expires {
420 0     0 1 0 my ( $c, $expires ) = @_;
421              
422 0   0     0 $expires ||= 0;
423 0         0 my $sid = $c->sessionid;
424 0         0 my $time_exp = time() + $expires;
425 0         0 $c->store_session_data( "expires:$sid" => $time_exp );
426             }
427              
428             sub _get_stored_session_expires {
429 6     6   12 my ($c) = @_;
430              
431 6 50       14 if ( my $sid = $c->sessionid ) {
432 6   50     41 return $c->get_session_data("expires:$sid") || 0;
433             } else {
434 0         0 return 0;
435             }
436             }
437              
438             sub initial_session_expires {
439 0     0 1 0 my $c = shift;
440 0         0 return ( time() + $c->_session_plugin_config->{expires} );
441             }
442              
443             sub calculate_initial_session_expires {
444 0     0 1 0 my ($c) = @_;
445 0         0 return max( $c->initial_session_expires, $c->_get_stored_session_expires );
446             }
447              
448             sub calculate_extended_session_expires {
449 0     0 1 0 my ( $c, $prev ) = @_;
450 0         0 return ( time() + $prev );
451             }
452              
453             sub reset_session_expires {
454 0     0 1 0 my ( $c, $sid ) = @_;
455              
456 0         0 my $exp = $c->calculate_initial_session_expires;
457 0         0 $c->_session_expires( $exp );
458             #
459             # since we're setting _session_expires directly, make load_session_expires
460             # actually use that value.
461             #
462 0         0 $c->_tried_loading_session_expires(1);
463 0         0 $c->_extended_session_expires( $exp );
464 0         0 $exp;
465             }
466              
467             sub sessionid {
468 41     41 1 85 my $c = shift;
469              
470 41   33     94 return $c->_sessionid || $c->_load_sessionid;
471             }
472              
473             sub _load_sessionid {
474 0     0   0 my $c = shift;
475 0 0       0 return if $c->_tried_loading_session_id;
476 0         0 $c->_tried_loading_session_id(1);
477              
478 0 0       0 if ( defined( my $sid = $c->get_session_id ) ) {
479 0 0       0 if ( $c->validate_session_id($sid) ) {
480             # temporarily set the inner key, so that validation will work
481 0         0 $c->_sessionid($sid);
482 0         0 return $sid;
483             } else {
484 0         0 $sid = HTML::Entities::encode_entities($sid);
485 0         0 my $err = "Tried to set invalid session ID '$sid'";
486 0         0 $c->log->error($err);
487 0         0 Catalyst::Exception->throw($err);
488             }
489             }
490              
491 0         0 return;
492             }
493              
494             sub session_is_valid {
495 0     0 1 0 my $c = shift;
496              
497             # force a check for expiry, but also __address, etc
498 0 0       0 if ( $c->_load_session ) {
499 0         0 return 1;
500             } else {
501 0         0 return;
502             }
503             }
504              
505             sub validate_session_id {
506 0     0 1 0 my ( $c, $sid ) = @_;
507              
508 0 0       0 $sid and $sid =~ /^[a-f\d]+$/i;
509             }
510              
511             sub session {
512 10     10 1 5593 my $c = shift;
513              
514 10   33     31 my $session = $c->_session || $c->_load_session || do {
515             $c->create_session_id_if_needed;
516             $c->initialize_session_data;
517             };
518              
519 10 50       531 if (@_) {
520 0 0       0 my $new_values = @_ > 1 ? { @_ } : $_[0];
521 0 0       0 croak('session takes a hash or hashref') unless ref $new_values;
522              
523 0         0 for my $key (keys %$new_values) {
524 0         0 $session->{$key} = $new_values->{$key};
525             }
526             }
527              
528 10         39 $session;
529             }
530              
531             sub keep_flash {
532 0     0 1 0 my ( $c, @keys ) = @_;
533 0   0     0 my $href = $c->_flash_keep_keys || $c->_flash_keep_keys({});
534 0         0 (@{$href}{@keys}) = ((undef) x @keys);
  0         0  
535             }
536              
537             sub _flash_data {
538 13     13   22 my $c = shift;
539 13 100 100     49 $c->_flash || $c->_load_flash || do {
540 3         13 $c->create_session_id_if_needed;
541 3         22 $c->_flash( {} );
542             };
543             }
544              
545             sub _set_flash {
546 13     13   19 my $c = shift;
547 13 100       31 if (@_) {
548 1 50       6 my $items = @_ > 1 ? {@_} : $_[0];
549 1 50       16 croak('flash takes a hash or hashref') unless ref $items;
550 1         5 @{ $c->_flash }{ keys %$items } = values %$items;
  1         4  
551             }
552             }
553              
554             sub flash {
555 13     13 1 16718 my $c = shift;
556 13         35 $c->_flash_data;
557 13         1973 $c->_set_flash(@_);
558 13         158 return $c->_flash;
559             }
560              
561             sub clear_flash {
562 1     1 1 17 my $c = shift;
563              
564             #$c->delete_session_data("flash:" . $c->sessionid); # should this be in here? or delayed till finalization?
565 1         5 $c->_flash_key_hashes({});
566 1         345 $c->_flash_keep_keys({});
567 1         374 $c->_flash({});
568             }
569              
570             sub session_expire_key {
571 0     0 1 0 my ( $c, %keys ) = @_;
572              
573 0         0 my $now = time;
574 0         0 @{ $c->session->{__expire_keys} }{ keys %keys } =
575 0         0 map { $now + $_ } values %keys;
  0         0  
576             }
577              
578             sub initialize_session_data {
579 0     0 1 0 my $c = shift;
580              
581 0         0 my $now = time;
582              
583             return $c->_session(
584             {
585             __created => $now,
586             __updated => $now,
587              
588             (
589             $c->_session_plugin_config->{verify_address}
590             ? ( __address => $c->request->address||'' )
591             : ()
592             ),
593             (
594             $c->_session_plugin_config->{verify_user_agent}
595 0 0 0     0 ? ( __user_agent => $c->request->user_agent||'' )
    0 0        
596             : ()
597             ),
598             }
599             );
600             }
601              
602             sub generate_session_id {
603 0     0 1 0 my $c = shift;
604              
605 0         0 my $digest = $c->_find_digest();
606 0         0 $digest->add( $c->session_hash_seed() );
607 0         0 return $digest->hexdigest;
608             }
609              
610             sub create_session_id_if_needed {
611 3     3 1 5 my $c = shift;
612 3 50       7 $c->create_session_id unless $c->sessionid;
613             }
614              
615             sub create_session_id {
616 0     0 1   my $c = shift;
617              
618 0           my $sid = $c->generate_session_id;
619              
620 0 0         $c->log->debug(qq/Created session "$sid"/) if $c->debug;
621              
622 0           $c->_sessionid($sid);
623 0           $c->reset_session_expires;
624 0           $c->set_session_id($sid);
625              
626 0           return $sid;
627             }
628              
629             my $counter;
630              
631             sub session_hash_seed {
632 0     0 1   my $c = shift;
633              
634 0           return join( "", ++$counter, time, rand, $$, {}, overload::StrVal($c), );
635             }
636              
637             my $usable;
638              
639             sub _find_digest () {
640 0 0   0     unless ($usable) {
641 0           foreach my $alg (qw/SHA-1 SHA-256 MD5/) {
642 0 0         if ( eval { Digest->new($alg) } ) {
  0            
643 0           $usable = $alg;
644 0           last;
645             }
646             }
647             Catalyst::Exception->throw(
648 0 0         "Could not find a suitable Digest module. Please install "
649             . "Digest::SHA1, Digest::SHA, or Digest::MD5" )
650             unless $usable;
651             }
652              
653 0           return Digest->new($usable);
654             }
655              
656             sub dump_these {
657 0     0 1   my $c = shift;
658              
659             (
660 0 0         $c->maybe::next::method(),
661              
662             $c->_sessionid
663             ? ( [ "Session ID" => $c->sessionid ], [ Session => $c->session ], )
664             : ()
665             );
666             }
667              
668              
669 0     0 1   sub get_session_id { shift->maybe::next::method(@_) }
670 0     0 1   sub set_session_id { shift->maybe::next::method(@_) }
671 0     0 1   sub delete_session_id { shift->maybe::next::method(@_) }
672 0     0 1   sub extend_session_id { shift->maybe::next::method(@_) }
673              
674             __PACKAGE__->meta->make_immutable;
675              
676             __END__
677              
678             =pod
679              
680             =head1 NAME
681              
682             Catalyst::Plugin::Session - Generic Session plugin - ties together server side storage and client side state required to maintain session data.
683              
684             =head1 SYNOPSIS
685              
686             # To get sessions to "just work", all you need to do is use these plugins:
687              
688             use Catalyst qw/
689             Session
690             Session::Store::FastMmap
691             Session::State::Cookie
692             /;
693              
694             # you can replace Store::FastMmap with Store::File - both have sensible
695             # default configurations (see their docs for details)
696              
697             # more complicated backends are available for other scenarios (DBI storage,
698             # etc)
699              
700              
701             # after you've loaded the plugins you can save session data
702             # For example, if you are writing a shopping cart, it could be implemented
703             # like this:
704              
705             sub add_item : Local {
706             my ( $self, $c ) = @_;
707              
708             my $item_id = $c->req->param("item");
709              
710             # $c->session is a hash ref, a bit like $c->stash
711             # the difference is that it' preserved across requests
712              
713             push @{ $c->session->{items} }, $item_id;
714              
715             $c->forward("MyView");
716             }
717              
718             sub display_items : Local {
719             my ( $self, $c ) = @_;
720              
721             # values in $c->session are restored
722             $c->stash->{items_to_display} =
723             [ map { MyModel->retrieve($_) } @{ $c->session->{items} } ];
724              
725             $c->forward("MyView");
726             }
727              
728             =head1 DESCRIPTION
729              
730             The Session plugin is the base of two related parts of functionality required
731             for session management in web applications.
732              
733             The first part, the State, is getting the browser to repeat back a session key,
734             so that the web application can identify the client and logically string
735             several requests together into a session.
736              
737             The second part, the Store, deals with the actual storage of information about
738             the client. This data is stored so that the it may be revived for every request
739             made by the same client.
740              
741             This plugin links the two pieces together.
742              
743             =head1 RECOMENDED BACKENDS
744              
745             =over 4
746              
747             =item Session::State::Cookie
748              
749             The only really sane way to do state is using cookies.
750              
751             =item Session::Store::File
752              
753             A portable backend, based on Cache::File.
754              
755             =item Session::Store::FastMmap
756              
757             A fast and flexible backend, based on Cache::FastMmap.
758              
759             =back
760              
761             =head1 METHODS
762              
763             =over 4
764              
765             =item sessionid
766              
767             An accessor for the session ID value.
768              
769             =item session
770              
771             Returns a hash reference that might contain unserialized values from previous
772             requests in the same session, and whose modified value will be saved for future
773             requests.
774              
775             This method will automatically create a new session and session ID if none
776             exists.
777              
778             You can also set session keys by passing a list of key/value pairs or a
779             hashref.
780              
781             $c->session->{foo} = "bar"; # This works.
782             $c->session(one => 1, two => 2); # And this.
783             $c->session({ answer => 42 }); # And this.
784              
785             =item session_expires
786              
787             This method returns the time when the current session will expire, or 0 if
788             there is no current session. If there is a session and it already expired, it
789             will delete the session and return 0 as well.
790              
791             =item flash
792              
793             This is like Ruby on Rails' flash data structure. Think of it as a stash that
794             lasts for longer than one request, letting you redirect instead of forward.
795              
796             The flash data will be cleaned up only on requests on which actually use
797             $c->flash (thus allowing multiple redirections), and the policy is to delete
798             all the keys which haven't changed since the flash data was loaded at the end
799             of every request.
800              
801             Note that use of the flash is an easy way to get data across requests, but
802             it's also strongly disrecommended, due it it being inherently plagued with
803             race conditions. This means that it's unlikely to work well if your
804             users have multiple tabs open at once, or if your site does a lot of AJAX
805             requests.
806              
807             L<Catalyst::Plugin::StatusMessage> is the recommended alternative solution,
808             as this doesn't suffer from these issues.
809              
810             sub moose : Local {
811             my ( $self, $c ) = @_;
812              
813             $c->flash->{beans} = 10;
814             $c->response->redirect( $c->uri_for("foo") );
815             }
816              
817             sub foo : Local {
818             my ( $self, $c ) = @_;
819              
820             my $value = $c->flash->{beans};
821              
822             # ...
823              
824             $c->response->redirect( $c->uri_for("bar") );
825             }
826              
827             sub bar : Local {
828             my ( $self, $c ) = @_;
829              
830             if ( exists $c->flash->{beans} ) { # false
831              
832             }
833             }
834              
835             =item clear_flash
836              
837             Zap all the keys in the flash regardless of their current state.
838              
839             =item keep_flash @keys
840              
841             If you want to keep a flash key for the next request too, even if it hasn't
842             changed, call C<keep_flash> and pass in the keys as arguments.
843              
844             =item delete_session REASON
845              
846             This method is used to invalidate a session. It takes an optional parameter
847             which will be saved in C<session_delete_reason> if provided.
848              
849             NOTE: This method will B<also> delete your flash data.
850              
851             =item session_delete_reason
852              
853             This accessor contains a string with the reason a session was deleted. Possible
854             values include:
855              
856             =over 4
857              
858             =item *
859              
860             C<address mismatch>
861              
862             =item *
863              
864             C<session expired>
865              
866             =back
867              
868             =item session_expire_key $key, $ttl
869              
870             Mark a key to expire at a certain time (only useful when shorter than the
871             expiry time for the whole session).
872              
873             For example:
874              
875             __PACKAGE__->config('Plugin::Session' => { expires => 10000000000 }); # "forever"
876             (NB If this number is too large, Y2K38 breakage could result.)
877              
878             # later
879              
880             $c->session_expire_key( __user => 3600 );
881              
882             Will make the session data survive, but the user will still be logged out after
883             an hour.
884              
885             Note that these values are not auto extended.
886              
887             =item change_session_id
888              
889             By calling this method you can force a session id change while keeping all
890             session data. This method might come handy when you are paranoid about some
891             advanced variations of session fixation attack.
892              
893             If you want to prevent this session fixation scenario:
894              
895             0) let us have WebApp with anonymous and authenticated parts
896             1) a hacker goes to vulnerable WebApp and gets a real sessionid,
897             just by browsing anonymous part of WebApp
898             2) the hacker inserts (somehow) this values into a cookie in victim's browser
899             3) after the victim logs into WebApp the hacker can enter his/her session
900              
901             you should call change_session_id in your login controller like this:
902              
903             if ($c->authenticate( { username => $user, password => $pass } )) {
904             # login OK
905             $c->change_session_id;
906             ...
907             } else {
908             # login FAILED
909             ...
910             }
911              
912             =item change_session_expires $expires
913              
914             You can change the session expiration time for this session;
915              
916             $c->change_session_expires( 4000 );
917              
918             Note that this only works to set the session longer than the config setting.
919              
920             =back
921              
922             =head1 INTERNAL METHODS
923              
924             =over 4
925              
926             =item setup
927              
928             This method is extended to also make calls to
929             C<check_session_plugin_requirements> and C<setup_session>.
930              
931             =item check_session_plugin_requirements
932              
933             This method ensures that a State and a Store plugin are also in use by the
934             application.
935              
936             =item setup_session
937              
938             This method populates C<< $c->config('Plugin::Session') >> with the default values
939             listed in L</CONFIGURATION>.
940              
941             =item prepare_action
942              
943             This method is extended.
944              
945             Its only effect is if the (off by default) C<flash_to_stash> configuration
946             parameter is on - then it will copy the contents of the flash to the stash at
947             prepare time.
948              
949             =item finalize_headers
950              
951             This method is extended and will extend the expiry time before sending
952             the response.
953              
954             =item finalize_body
955              
956             This method is extended and will call finalize_session before the other
957             finalize_body methods run. Here we persist the session data if a session exists.
958              
959             =item initialize_session_data
960              
961             This method will initialize the internal structure of the session, and is
962             called by the C<session> method if appropriate.
963              
964             =item create_session_id
965              
966             Creates a new session ID using C<generate_session_id> if there is no session ID
967             yet.
968              
969             =item validate_session_id SID
970              
971             Make sure a session ID is of the right format.
972              
973             This currently ensures that the session ID string is any amount of case
974             insensitive hexadecimal characters.
975              
976             =item generate_session_id
977              
978             This method will return a string that can be used as a session ID. It is
979             supposed to be a reasonably random string with enough bits to prevent
980             collision. It basically takes C<session_hash_seed> and hashes it using SHA-1,
981             MD5 or SHA-256, depending on the availability of these modules.
982              
983             =item session_hash_seed
984              
985             This method is actually rather internal to generate_session_id, but should be
986             overridable in case you want to provide more random data.
987              
988             Currently it returns a concatenated string which contains:
989              
990             =over 4
991              
992             =item * A counter
993              
994             =item * The current time
995              
996             =item * One value from C<rand>.
997              
998             =item * The stringified value of a newly allocated hash reference
999              
1000             =item * The stringified value of the Catalyst context object
1001              
1002             =back
1003              
1004             in the hopes that those combined values are entropic enough for most uses. If
1005             this is not the case you can replace C<session_hash_seed> with e.g.
1006              
1007             sub session_hash_seed {
1008             open my $fh, "<", "/dev/random";
1009             read $fh, my $bytes, 20;
1010             close $fh;
1011             return $bytes;
1012             }
1013              
1014             Or even more directly, replace C<generate_session_id>:
1015              
1016             sub generate_session_id {
1017             open my $fh, "<", "/dev/random";
1018             read $fh, my $bytes, 20;
1019             close $fh;
1020             return unpack("H*", $bytes);
1021             }
1022              
1023             Also have a look at L<Crypt::Random> and the various openssl bindings - these
1024             modules provide APIs for cryptographically secure random data.
1025              
1026             =item finalize_session
1027              
1028             Clean up the session during C<finalize>.
1029              
1030             This clears the various accessors after saving to the store.
1031              
1032             =item dump_these
1033              
1034             See L<Catalyst/dump_these> - ammends the session data structure to the list of
1035             dumped objects if session ID is defined.
1036              
1037              
1038             =item calculate_extended_session_expires
1039              
1040             =item calculate_initial_session_expires
1041              
1042             =item create_session_id_if_needed
1043              
1044             =item delete_session_id
1045              
1046             =item extend_session_expires
1047              
1048             Note: this is *not* used to give an individual user a longer session. See
1049             'change_session_expires'.
1050              
1051             =item extend_session_id
1052              
1053             =item get_session_id
1054              
1055             =item reset_session_expires
1056              
1057             =item session_is_valid
1058              
1059             =item set_session_id
1060              
1061             =item initial_session_expires
1062              
1063             =back
1064              
1065             =head1 USING SESSIONS DURING PREPARE
1066              
1067             The earliest point in time at which you may use the session data is after
1068             L<Catalyst::Plugin::Session>'s C<prepare_action> has finished.
1069              
1070             State plugins must set $c->session ID before C<prepare_action>, and during
1071             C<prepare_action> L<Catalyst::Plugin::Session> will actually load the data from
1072             the store.
1073              
1074             sub prepare_action {
1075             my $c = shift;
1076              
1077             # don't touch $c->session yet!
1078              
1079             $c->NEXT::prepare_action( @_ );
1080              
1081             $c->session; # this is OK
1082             $c->sessionid; # this is also OK
1083             }
1084              
1085             =head1 CONFIGURATION
1086              
1087             $c->config('Plugin::Session' => {
1088             expires => 1234,
1089             });
1090              
1091             All configuation parameters are provided in a hash reference under the
1092             C<Plugin::Session> key in the configuration hash.
1093              
1094             =over 4
1095              
1096             =item expires
1097              
1098             The time-to-live of each session, expressed in seconds. Defaults to 7200 (two
1099             hours).
1100              
1101             =item expiry_threshold
1102              
1103             Only update the session expiry time if it would otherwise expire
1104             within this many seconds from now.
1105              
1106             The purpose of this is to keep the session store from being updated
1107             when nothing else in the session is updated.
1108              
1109             Defaults to 0 (in which case, the expiration will always be updated).
1110              
1111             =item verify_address
1112              
1113             When true, C<< $c->request->address >> will be checked at prepare time. If it is
1114             not the same as the address that initiated the session, the session is deleted.
1115              
1116             Defaults to false.
1117              
1118             =item verify_user_agent
1119              
1120             When true, C<< $c->request->user_agent >> will be checked at prepare time. If it
1121             is not the same as the user agent that initiated the session, the session is
1122             deleted.
1123              
1124             Defaults to false.
1125              
1126             =item flash_to_stash
1127              
1128             This option makes it easier to have actions behave the same whether they were
1129             forwarded to or redirected to. On prepare time it copies the contents of
1130             C<flash> (if any) to the stash.
1131              
1132             =back
1133              
1134             =head1 SPECIAL KEYS
1135              
1136             The hash reference returned by C<< $c->session >> contains several keys which
1137             are automatically set:
1138              
1139             =over 4
1140              
1141             =item __expires
1142              
1143             This key no longer exists. Use C<session_expires> instead.
1144              
1145             =item __updated
1146              
1147             The last time a session was saved to the store.
1148              
1149             =item __created
1150              
1151             The time when the session was first created.
1152              
1153             =item __address
1154              
1155             The value of C<< $c->request->address >> at the time the session was created.
1156             This value is only populated if C<verify_address> is true in the configuration.
1157              
1158             =item __user_agent
1159              
1160             The value of C<< $c->request->user_agent >> at the time the session was created.
1161             This value is only populated if C<verify_user_agent> is true in the configuration.
1162              
1163             =back
1164              
1165             =head1 CAVEATS
1166              
1167             =head2 Round the Robin Proxies
1168              
1169             C<verify_address> could make your site inaccessible to users who are behind
1170             load balanced proxies. Some ISPs may give a different IP to each request by the
1171             same client due to this type of proxying. If addresses are verified these
1172             users' sessions cannot persist.
1173              
1174             To let these users access your site you can either disable address verification
1175             as a whole, or provide a checkbox in the login dialog that tells the server
1176             that it's OK for the address of the client to change. When the server sees that
1177             this box is checked it should delete the C<__address> special key from the
1178             session hash when the hash is first created.
1179              
1180             =head2 Race Conditions
1181              
1182             In this day and age where cleaning detergents and Dutch football (not the
1183             American kind) teams roam the plains in great numbers, requests may happen
1184             simultaneously. This means that there is some risk of session data being
1185             overwritten, like this:
1186              
1187             =over 4
1188              
1189             =item 1.
1190              
1191             request a starts, request b starts, with the same session ID
1192              
1193             =item 2.
1194              
1195             session data is loaded in request a
1196              
1197             =item 3.
1198              
1199             session data is loaded in request b
1200              
1201             =item 4.
1202              
1203             session data is changed in request a
1204              
1205             =item 5.
1206              
1207             request a finishes, session data is updated and written to store
1208              
1209             =item 6.
1210              
1211             request b finishes, session data is updated and written to store, overwriting
1212             changes by request a
1213              
1214             =back
1215              
1216             For applications where any given user's session is only making one request
1217             at a time this plugin should be safe enough.
1218              
1219             =head1 AUTHORS
1220              
1221             Andy Grundman
1222              
1223             Christian Hansen
1224              
1225             Yuval Kogman, C<nothingmuch@woobling.org>
1226              
1227             Sebastian Riedel
1228              
1229             Tomas Doran (t0m) C<bobtfish@bobtfish.net> (current maintainer)
1230              
1231             Sergio Salvi
1232              
1233             kmx C<kmx@volny.cz>
1234              
1235             Florian Ragwitz (rafl) C<rafl@debian.org>
1236              
1237             Kent Fredric (kentnl)
1238              
1239             And countless other contributers from #catalyst. Thanks guys!
1240              
1241             =head1 Contributors
1242              
1243             Devin Austin (dhoss) <dhoss@cpan.org>
1244              
1245             Robert Rothenberg <rrwo@cpan.org> (on behalf of Foxtons Ltd.)
1246              
1247             =head1 COPYRIGHT & LICENSE
1248              
1249             Copyright (c) 2005 the aforementioned authors. All rights
1250             reserved. This program is free software; you can redistribute
1251             it and/or modify it under the same terms as Perl itself.
1252              
1253             =cut
1254              
1255