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