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