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