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