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