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 BEGIN {
  16         __PACKAGE__->mk_accessors(qw/sessionid session_delete_reason/);
  17 }
  18
  19 sub setup {
  20         my $c = shift;
  21
  22         $c->NEXT::setup(@_);
  23
  24         $c->check_session_plugin_requirements;
  25         $c->setup_session;
  26
  27         return $c;
  28 }
  29
  30 sub check_session_plugin_requirements {
  31         my $c = shift;
  32
  33         unless ( $c->isa("Catalyst::Plugin::Session::State") && $c->isa("Catalyst::Plugin::Session::Store") ) {
  34                 my $err = (
  35                         "The Session plugin requires both Session::State " .
  36                         "and Session::Store plugins to be used as well."
  37                 );
  38
  39                 $c->log->fatal($err);
  40                 Catalyst::Exception->throw($err);
  41         }
  42 }
  43
  44 sub setup_session {
  45         my $c = shift;
  46
  47         my $cfg = ($c->config->{session} ||= {});
  48
  49         %$cfg = (
  50                 expires        => 7200,
  51                 verify_address => 1,
  52                 %$cfg,
  53         );
  54
  55         $c->NEXT::setup_session();
  56 }
  57
  58 sub finalize {
  59         my $c = shift;
  60
  61         if ($c->{session}) {
  62                 # all sessions are extended at the end of the request
  63                 my $now = time;
  64                 @{ $c->{session} }{qw/__updated __expires/} = ($now, $c->config->{session}{expires} + $now);
  65                 $c->store_session_data( $c->sessionid, $c->{session} );
  66         }
  67
  68         $c->NEXT::finalize(@_);
  69 }
  70
  71 sub prepare_action {
  72     my $c = shift;
  73
  74
  75         my $ret = $c->NEXT::prepare_action;
  76
  77         my $sid = $c->sessionid || return;
  78
  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                 # session expired
  84                 $c->log->debug("Deleting session $sid (expired)") if $c->debug;
  85                 $c->delete_session("session expired");
  86                 return $ret;
  87         }
  88
  89         if ( $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} . " != " . $c->request->address . ")",
  96                 );
  97                 $c->delete_session("address mismatch");
  98                 return $ret;
  99         }
 100 }
 101
 102 sub delete_session {
 103         my ( $c, $msg ) = @_;
 104
 105         # delete the session data
 106         my $sid = $c->sessionid;
 107         $c->delete_session_data($sid);
 108
 109         # reset the values in the context object
 110         $c->{session} = undef;
 111         $c->sessionid(undef);
 112         $c->session_delete_reason($msg);
 113 }
 114
 115 sub session {
 116         my $c = shift;
 117
 118     return $c->{session} if $c->{session};
 119
 120         my $sid = $c->generate_session_id;
 121         $c->sessionid($sid);
 122
 123         $c->log->debug(qq/Created session "$sid"/) if $c->debug;
 124
 125         return $c->initialize_session_data;
 126 }
 127
 128 sub initialize_session_data {
 129         my $c = shift;
 130
 131         my $now = time;
 132
 133         return $c->{session} = {
 134                 __created => $now,
 135                 __updated => $now,
 136                 __expires => $now + $c->config->{session}{expires},
 137
 138                 ($c->config->{session}{verify_address}
 139                         ? (__address => $c->request->address)
 140                         : ()
 141                 ),
 142         };
 143 }
 144
 145
 146
 147
 148 # refactor into Catalyst::Plugin::Session::ID::Weak ?
 149
 150 sub generate_session_id {
 151     my $c = shift;
 152
 153     my $digest = $c->_find_digest();
 154     $digest->add( $c->session_hash_seed() );
 155     return $digest->hexdigest;
 156 }
 157
 158 my $counter;
 159 sub session_hash_seed {
 160         my $c = shift;
 161
 162     return join("",
 163                 ++$counter,
 164                 time,
 165         rand,
 166         $$,
 167                 {},
 168                 overload::StrVal($c),
 169     );
 170 }
 171
 172 my $usable;
 173 sub _find_digest () {
 174         unless ($usable) {
 175                 $usable = List::Util::first(sub { eval { Digest->new($_) } }, qw/SHA-1 MD5 SHA-256/)
 176                         or Catalyst::Exception->throw(
 177                                 "Could not find a suitable Digest module. Please install " .
 178                                 "Digest::SHA1, Digest::SHA, or Digest::MD5"
 179                         );
 180         }
 181
 182     return Digest->new($usable);
 183 }
 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 =head1 DESCRIPTION
 202
 203 The Session plugin is the base of two related parts of functionality required
 204 for session management in web applications.
 205
 206 The first part, the State, is getting the browser to repeat back a session key,
 207 so that the web application can identify the client and logically string
 208 several requests together into a session.
 209
 210 The second part, the Store, deals with the actual storage of information about
 211 the client. This data is stored so that the it may be revived for every request
 212 made by the same client.
 213
 214 This plugin links the two pieces together.
 215
 216 =head1 METHODS
 217
 218 =over 4
 219
 220 =item sessionid
 221
 222 An accessor for the session ID value.
 223
 224 =item session
 225
 226 Returns a hash reference that might contain unserialized values from previous
 227 requests in the same session, and whose modified value will be saved for future
 228 requests.
 229
 230 This method will automatically create a new session and session ID if none
 231 exists.
 232
 233 =item session_delete_reason
 234
 235 This accessor contains a string with the reason a session was deleted. Possible
 236 values include:
 237
 238 =over 4
 239
 240 =item *
 241
 242 C<address mismatch>
 243
 244 =item *
 245
 246 C<session expired>
 247
 248 =back
 249
 250 =item setup
 251
 252 This method is extended to also make calls to
 253 C<check_session_plugin_requirements> and C<setup_session>.
 254
 255 =item check_session_plugin_requirements
 256
 257 This method ensures that a State and a Store plugin are also in use by the
 258 application.
 259
 260 =item setup_session
 261
 262 This method populates C<< $c->config->{session} >> with the default values
 263 listed in L</CONFIGURATION>.
 264
 265 =item prepare_action
 266
 267 This methoid is extended, and will restore session data and check it for
 268 validity if a session id is defined. It assumes that the State plugin will
 269 populate the C<sessionid> key beforehand.
 270
 271 =item finalize
 272
 273 This method is extended and will extend the expiry time, as well as persist the
 274 session data if a session exists.
 275
 276 =item delete_session REASON
 277
 278 This method is used to invalidate a session. It takes an optional parameter
 279 which will be saved in C<session_delete_reason> if provided.
 280
 281 =item initialize_session_data
 282
 283 This method will initialize the internal structure of the session, and is
 284 called by the C<session> method if appropriate.
 285
 286 =back
 287
 288 =head1 CONFIGURATION
 289
 290         $c->config->{session} = {
 291                 expires => 1234,
 292         };
 293
 294 All configuation parameters are provided in a hash reference under the
 295 C<session> key in the configuration hash.
 296
 297 =over 4
 298
 299 =item expires
 300
 301 The time-to-live of each session, expressed in seconds. Defaults to 7200 (two
 302 hours).
 303
 304 =item verify_address
 305
 306 When false, C<< $c->request->address >> will be checked at prepare time. If it
 307 is not the same as the address that initiated the session, the session is
 308 deleted.
 309
 310 =back
 311
 312 =head1 SPECIAL KEYS
 313
 314 The hash reference returned by C<< $c->session >> contains several keys which
 315 are automatically set:
 316
 317 =over 4
 318
 319 =item __expires
 320
 321 A timestamp whose value is the last second when the session is still valid. If
 322 a session is restored, and __expires is less than the current time, the session
 323 is deleted.
 324
 325 =item __updated
 326
 327 The last time a session was saved. This is the value of
 328 C<< $c->{session}{__expires} - $c->config->{session}{expires} >>.
 329
 330 =item __created
 331
 332 The time when the session was first created.
 333
 334 =item __address
 335
 336 The value of C<< $c->request->address >> at the time the session was created.
 337 This value is only populated of C<verify_address> is true in the configuration.
 338
 339 =back
 340
 341 =cut
 342
 343