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