lib/Catalyst/Plugin/Session.pm

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