Session: encode HTML entities in error
[catagits/Catalyst-Plugin-Session.git] / lib / Catalyst / Plugin / Session.pm
1 #!/usr/bin/perl
2
3 package Catalyst::Plugin::Session;
4
5 use Moose;
6 with 'MooseX::Emulate::Class::Accessor::Fast';
7 use MRO::Compat;
8 use Catalyst::Exception ();
9 use Digest              ();
10 use overload            ();
11 use Object::Signature   ();
12 use HTML::Entities      ();
13 use Carp;
14 use List::Util qw/ max /;
15
16 use namespace::clean -except => 'meta';
17
18 our $VERSION = '0.40';
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     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     $c->config->{'Plugin::Session'} ||= $c->config->{session} || {};
49 }
50
51 sub setup {
52     my $c = shift;
53
54     $c->maybe::next::method(@_);
55
56     $c->check_session_plugin_requirements;
57     $c->setup_session;
58
59     return $c;
60 }
61
62 sub check_session_plugin_requirements {
63     my $c = shift;
64
65     unless ( $c->isa("Catalyst::Plugin::Session::State")
66         && $c->isa("Catalyst::Plugin::Session::Store") )
67     {
68         my $err =
69           (     "The Session plugin requires both Session::State "
70               . "and Session::Store plugins to be used as well." );
71
72         $c->log->fatal($err);
73         Catalyst::Exception->throw($err);
74     }
75 }
76
77 sub setup_session {
78     my $c = shift;
79
80     my $cfg = $c->_session_plugin_config;
81
82     %$cfg = (
83         expires        => 7200,
84         verify_address => 0,
85         verify_user_agent => 0,
86         expiry_threshold => 0,
87         %$cfg,
88     );
89
90     $c->maybe::next::method();
91 }
92
93 sub prepare_action {
94     my $c = shift;
95
96     $c->maybe::next::method(@_);
97
98     if (    $c->_session_plugin_config->{flash_to_stash}
99         and $c->sessionid
100         and my $flash_data = $c->flash )
101     {
102         @{ $c->stash }{ keys %$flash_data } = values %$flash_data;
103     }
104 }
105
106 sub finalize_headers {
107     my $c = shift;
108
109     # fix cookie before we send headers
110     $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     $c->session_expires;
116     $c->finalize_session if $c->_needs_early_session_finalization;
117
118     return $c->maybe::next::method(@_);
119 }
120
121 sub finalize_body {
122     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     $c->finalize_session unless $c->_needs_early_session_finalization;
128     $c->_clear_session_instance_data;
129
130     return $c->maybe::next::method(@_);
131 }
132
133 sub finalize_session {
134     my $c = shift;
135
136     $c->maybe::next::method(@_);
137
138     $c->_save_session_id;
139     $c->_save_session;
140     $c->_save_flash;
141
142 }
143
144 sub _session_updated {
145     my $c = shift;
146
147     if ( my $session_data = $c->_session ) {
148
149         no warnings 'uninitialized';
150         if ( Object::Signature::signature($session_data) ne
151             $c->_session_data_sig )
152         {
153             return $session_data;
154         } else {
155             return;
156         }
157
158     } else {
159
160         return;
161
162     }
163 }
164
165 sub _save_session_id {
166     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     my $c = shift;
174
175     if ( defined($c->_session_expires) ) {
176
177         if (my $sid = $c->sessionid) {
178
179             my $current  = $c->_get_stored_session_expires;
180             my $extended = $c->session_expires;
181             if ($extended > $current) {
182                 $c->store_session_data( "expires:$sid" => $extended );
183             }
184
185         }
186     }
187 }
188
189 sub _save_session {
190     my $c = shift;
191
192     if ( my $session_data = $c->_session_updated ) {
193
194         $session_data->{__updated} = time();
195         my $sid = $c->sessionid;
196         $c->store_session_data( "session:$sid" => $session_data );
197     }
198 }
199
200 sub _save_flash {
201     my $c = shift;
202
203     if ( my $flash_data = $c->_flash ) {
204
205         my $hashes = $c->_flash_key_hashes || {};
206         my $keep = $c->_flash_keep_keys || {};
207         foreach my $key ( keys %$hashes ) {
208             if ( !exists $keep->{$key} and Object::Signature::signature( \$flash_data->{$key} ) eq $hashes->{$key} ) {
209                 delete $flash_data->{$key};
210             }
211         }
212
213         my $sid = $c->sessionid;
214
215         my $session_data = $c->_session;
216         if (%$flash_data) {
217             $session_data->{__flash} = $flash_data;
218         }
219         else {
220             delete $session_data->{__flash};
221         }
222         $c->_session($session_data);
223         $c->_save_session;
224     }
225 }
226
227 sub _load_session_expires {
228     my $c = shift;
229     return $c->_session_expires if $c->_tried_loading_session_expires;
230     $c->_tried_loading_session_expires(1);
231
232     if ( my $sid = $c->sessionid ) {
233         my $expires =  $c->_get_stored_session_expires;
234
235         if ( $expires >= time() ) {
236             $c->_session_expires( $expires );
237             return $expires;
238         } else {
239             $c->delete_session( "session expired" );
240             return 0;
241         }
242     }
243
244     return;
245 }
246
247 sub _load_session {
248     my $c = shift;
249     return $c->_session if $c->_tried_loading_session_data;
250     $c->_tried_loading_session_data(1);
251
252     if ( my $sid = $c->sessionid ) {
253         if ( $c->_load_session_expires ) {    # > 0
254
255             my $session_data = $c->get_session_data("session:$sid") || return;
256             $c->_session($session_data);
257
258             no warnings 'uninitialized';    # ne __address
259             if (   $c->_session_plugin_config->{verify_address}
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                       . $session_data->{__address} . " != "
266                       . $c->request->address . ")"
267                 );
268                 $c->delete_session("address mismatch");
269                 return;
270             }
271             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                       . $session_data->{__user_agent} . " != "
277                       . $c->request->user_agent . ")"
278                 );
279                 $c->delete_session("user agent mismatch");
280                 return;
281             }
282
283             $c->log->debug(qq/Restored session "$sid"/) if $c->debug;
284             $c->_session_data_sig( Object::Signature::signature($session_data) ) if $session_data;
285             $c->_expire_session_keys;
286
287             return $session_data;
288         }
289     }
290
291     return;
292 }
293
294 sub _load_flash {
295     my $c = shift;
296     return $c->_flash if $c->_tried_loading_flash_data;
297     $c->_tried_loading_flash_data(1);
298
299     if ( my $sid = $c->sessionid ) {
300
301         my $session_data = $c->session;
302         $c->_flash($session_data->{__flash});
303
304         if ( my $flash_data = $c->_flash )
305         {
306             $c->_flash_key_hashes({ map { $_ => Object::Signature::signature( \$flash_data->{$_} ) } keys %$flash_data });
307
308             return $flash_data;
309         }
310     }
311
312     return;
313 }
314
315 sub _expire_session_keys {
316     my ( $c, $data ) = @_;
317
318     my $now = time;
319
320     my $expire_times = ( $data || $c->_session || {} )->{__expire_keys} || {};
321     foreach my $key ( grep { $expire_times->{$_} < $now } keys %$expire_times ) {
322         delete $c->_session->{$key};
323         delete $expire_times->{$key};
324     }
325 }
326
327 sub _clear_session_instance_data {
328     my $c = shift;
329     $c->$_(undef) for @session_data_accessors;
330     $c->maybe::next::method(@_); # allow other plugins to hook in on this
331 }
332
333 sub change_session_id {
334     my $c = shift;
335
336     my $sessiondata = $c->session;
337     my $oldsid = $c->sessionid;
338     my $newsid = $c->create_session_id;
339
340     if ($oldsid) {
341         $c->log->debug(qq/change_sessid: deleting session data from "$oldsid"/) if $c->debug;
342         $c->delete_session_data("${_}:${oldsid}") for qw/session expires flash/;
343     }
344
345     $c->log->debug(qq/change_sessid: storing session data to "$newsid"/) if $c->debug;
346     $c->store_session_data( "session:$newsid" => $sessiondata );
347
348     return $newsid;
349 }
350
351 sub delete_session {
352     my ( $c, $msg ) = @_;
353
354     $c->log->debug("Deleting session" . ( defined($msg) ? "($msg)" : '(no reason given)') ) if $c->debug;
355
356     # delete the session data
357     if ( my $sid = $c->sessionid ) {
358         $c->delete_session_data("${_}:${sid}") for qw/session expires flash/;
359         $c->delete_session_id($sid);
360     }
361
362     # reset the values in the context object
363     # see the BEGIN block
364     $c->_clear_session_instance_data;
365
366     $c->_session_delete_reason($msg);
367 }
368
369 sub session_delete_reason {
370     my $c = shift;
371
372     $c->session_is_valid; # check that it was loaded
373
374     $c->_session_delete_reason(@_);
375 }
376
377 sub session_expires {
378     my $c = shift;
379
380     if ( defined( my $expires = $c->_extended_session_expires ) ) {
381         return $expires;
382     } elsif ( defined( $expires = $c->_load_session_expires ) ) {
383         return $c->extend_session_expires( $expires );
384     } else {
385         return 0;
386     }
387 }
388
389 sub extend_session_expires {
390     my ( $c, $expires ) = @_;
391
392     my $threshold = $c->_session_plugin_config->{expiry_threshold} || 0;
393
394     if ( my $sid = $c->sessionid ) {
395         my $expires = $c->_get_stored_session_expires;
396         my $cutoff  = $expires - $threshold;
397
398         if (!$threshold || $cutoff <= time || $c->_session_updated) {
399
400             $c->_extended_session_expires( my $updated = $c->calculate_initial_session_expires() );
401             $c->extend_session_id( $sid, $updated );
402
403             return $updated;
404
405         } else {
406
407             return $expires;
408
409         }
410
411     } else {
412
413         return;
414
415     }
416
417 }
418
419 sub change_session_expires {
420     my ( $c, $expires ) = @_;
421
422     $expires ||= 0;
423     my $sid = $c->sessionid;
424     my $time_exp = time() + $expires;
425     $c->store_session_data( "expires:$sid" => $time_exp );
426 }
427
428 sub _get_stored_session_expires {
429     my ($c) = @_;
430
431     if ( my $sid = $c->sessionid ) {
432         return $c->get_session_data("expires:$sid") || 0;
433     } else {
434         return 0;
435     }
436 }
437
438 sub initial_session_expires {
439     my $c = shift;
440     return ( time() + $c->_session_plugin_config->{expires} );
441 }
442
443 sub calculate_initial_session_expires {
444     my ($c) = @_;
445     return max( $c->initial_session_expires, $c->_get_stored_session_expires );
446 }
447
448 sub calculate_extended_session_expires {
449     my ( $c, $prev ) = @_;
450     return ( time() + $prev );
451 }
452
453 sub reset_session_expires {
454     my ( $c, $sid ) = @_;
455
456     my $exp = $c->calculate_initial_session_expires;
457     $c->_session_expires( $exp );
458     #
459     # since we're setting _session_expires directly, make load_session_expires
460     # actually use that value.
461     #
462     $c->_tried_loading_session_expires(1);
463     $c->_extended_session_expires( $exp );
464     $exp;
465 }
466
467 sub sessionid {
468     my $c = shift;
469
470     return $c->_sessionid || $c->_load_sessionid;
471 }
472
473 sub _load_sessionid {
474     my $c = shift;
475     return if $c->_tried_loading_session_id;
476     $c->_tried_loading_session_id(1);
477
478     if ( defined( my $sid = $c->get_session_id ) ) {
479         if ( $c->validate_session_id($sid) ) {
480             # temporarily set the inner key, so that validation will work
481             $c->_sessionid($sid);
482             return $sid;
483         } else {
484             $sid = HTML::Entities::encode_entities($sid);
485             my $err = "Tried to set invalid session ID '$sid'";
486             $c->log->error($err);
487             Catalyst::Exception->throw($err);
488         }
489     }
490
491     return;
492 }
493
494 sub session_is_valid {
495     my $c = shift;
496
497     # force a check for expiry, but also __address, etc
498     if ( $c->_load_session ) {
499         return 1;
500     } else {
501         return;
502     }
503 }
504
505 sub validate_session_id {
506     my ( $c, $sid ) = @_;
507
508     $sid and $sid =~ /^[a-f\d]+$/i;
509 }
510
511 sub session {
512     my $c = shift;
513
514     my $session = $c->_session || $c->_load_session || do {
515         $c->create_session_id_if_needed;
516         $c->initialize_session_data;
517     };
518
519     if (@_) {
520       my $new_values = @_ > 1 ? { @_ } : $_[0];
521       croak('session takes a hash or hashref') unless ref $new_values;
522
523       for my $key (keys %$new_values) {
524         $session->{$key} = $new_values->{$key};
525       }
526     }
527
528     $session;
529 }
530
531 sub keep_flash {
532     my ( $c, @keys ) = @_;
533     my $href = $c->_flash_keep_keys || $c->_flash_keep_keys({});
534     (@{$href}{@keys}) = ((undef) x @keys);
535 }
536
537 sub _flash_data {
538     my $c = shift;
539     $c->_flash || $c->_load_flash || do {
540         $c->create_session_id_if_needed;
541         $c->_flash( {} );
542     };
543 }
544
545 sub _set_flash {
546     my $c = shift;
547     if (@_) {
548         my $items = @_ > 1 ? {@_} : $_[0];
549         croak('flash takes a hash or hashref') unless ref $items;
550         @{ $c->_flash }{ keys %$items } = values %$items;
551     }
552 }
553
554 sub flash {
555     my $c = shift;
556     $c->_flash_data;
557     $c->_set_flash(@_);
558     return $c->_flash;
559 }
560
561 sub clear_flash {
562     my $c = shift;
563
564     #$c->delete_session_data("flash:" . $c->sessionid); # should this be in here? or delayed till finalization?
565     $c->_flash_key_hashes({});
566     $c->_flash_keep_keys({});
567     $c->_flash({});
568 }
569
570 sub session_expire_key {
571     my ( $c, %keys ) = @_;
572
573     my $now = time;
574     @{ $c->session->{__expire_keys} }{ keys %keys } =
575       map { $now + $_ } values %keys;
576 }
577
578 sub initialize_session_data {
579     my $c = shift;
580
581     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                 ? ( __user_agent => $c->request->user_agent||'' )
596                 : ()
597             ),
598         }
599     );
600 }
601
602 sub generate_session_id {
603     my $c = shift;
604
605     my $digest = $c->_find_digest();
606     $digest->add( $c->session_hash_seed() );
607     return $digest->hexdigest;
608 }
609
610 sub create_session_id_if_needed {
611     my $c = shift;
612     $c->create_session_id unless $c->sessionid;
613 }
614
615 sub create_session_id {
616     my $c = shift;
617
618     my $sid = $c->generate_session_id;
619
620     $c->log->debug(qq/Created session "$sid"/) if $c->debug;
621
622     $c->_sessionid($sid);
623     $c->reset_session_expires;
624     $c->set_session_id($sid);
625
626     return $sid;
627 }
628
629 my $counter;
630
631 sub session_hash_seed {
632     my $c = shift;
633
634     return join( "", ++$counter, time, rand, $$, {}, overload::StrVal($c), );
635 }
636
637 my $usable;
638
639 sub _find_digest () {
640     unless ($usable) {
641         foreach my $alg (qw/SHA-1 SHA-256 MD5/) {
642             if ( eval { Digest->new($alg) } ) {
643                 $usable = $alg;
644                 last;
645             }
646         }
647         Catalyst::Exception->throw(
648                 "Could not find a suitable Digest module. Please install "
649               . "Digest::SHA1, Digest::SHA, or Digest::MD5" )
650           unless $usable;
651     }
652
653     return Digest->new($usable);
654 }
655
656 sub dump_these {
657     my $c = shift;
658
659     (
660         $c->maybe::next::method(),
661
662         $c->_sessionid
663         ? ( [ "Session ID" => $c->sessionid ], [ Session => $c->session ], )
664         : ()
665     );
666 }
667
668
669 sub get_session_id { shift->maybe::next::method(@_) }
670 sub set_session_id { shift->maybe::next::method(@_) }
671 sub delete_session_id { shift->maybe::next::method(@_) }
672 sub extend_session_id { shift->maybe::next::method(@_) }
673
674 __PACKAGE__;
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