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