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")
  34         && $c->isa("Catalyst::Plugin::Session::Store") )
  35     {
  36         my $err =
  37           (     "The Session plugin requires both Session::State "
  38               . "and Session::Store plugins to be used as well." );
  39
  40         $c->log->fatal($err);
  41         Catalyst::Exception->throw($err);
  42     }
  43 }
  44
  45 sub setup_session {
  46     my $c = shift;
  47
  48     my $cfg = ( $c->config->{session} ||= {} );
  49
  50     %$cfg = (
  51         expires        => 7200,
  52         verify_address => 1,
  53         %$cfg,
  54     );
  55
  56     $c->NEXT::setup_session();
  57 }
  58
  59 sub finalize {
  60     my $c = shift;
  61
  62     if ( $c->{session} ) {
  63
  64         # all sessions are extended at the end of the request
  65         my $now = time;
  66         @{ $c->{session} }{qw/__updated __expires/} =
  67           ( $now, $c->config->{session}{expires} + $now );
  68         $c->store_session_data( $c->sessionid, $c->{session} );
  69     }
  70
  71     $c->NEXT::finalize(@_);
  72 }
  73
  74 sub prepare_action {
  75     my $c = shift;
  76
  77     my $ret = $c->NEXT::prepare_action;
  78
  79     my $sid = $c->sessionid || return;
  80
  81     $c->log->debug(qq/Found session "$sid"/) if $c->debug;
  82
  83     my $s = $c->{session} ||= $c->get_session_data($sid);
  84     if ( !$s or $s->{__expires} < time ) {
  85
  86         # session expired
  87         $c->log->debug("Deleting session $sid (expired)") if $c->debug;
  88         $c->delete_session("session expired");
  89         return $ret;
  90     }
  91
  92     if (   $c->config->{session}{verify_address}
  93         && $c->{session}{__address}
  94         && $c->{session}{__address} ne $c->request->address )
  95     {
  96         $c->log->warn(
  97                 "Deleting session $sid due to address mismatch ("
  98               . $c->{session}{__address} . " != "
  99               . $c->request->address . ")",
 100         );
 101         $c->delete_session("address mismatch");
 102         return $ret;
 103     }
 104 }
 105
 106 sub delete_session {
 107     my ( $c, $msg ) = @_;
 108
 109     # delete the session data
 110     my $sid = $c->sessionid;
 111     $c->delete_session_data($sid);
 112
 113     # reset the values in the context object
 114     $c->{session} = undef;
 115     $c->sessionid(undef);
 116     $c->session_delete_reason($msg);
 117 }
 118
 119 sub session {
 120     my $c = shift;
 121
 122     return $c->{session} if $c->{session};
 123
 124     my $sid = $c->generate_session_id;
 125     $c->sessionid($sid);
 126
 127     $c->log->debug(qq/Created session "$sid"/) if $c->debug;
 128
 129     return $c->initialize_session_data;
 130 }
 131
 132 sub initialize_session_data {
 133     my $c = shift;
 134
 135     my $now = time;
 136
 137     return $c->{session} = {
 138         __created => $now,
 139         __updated => $now,
 140         __expires => $now + $c->config->{session}{expires},
 141
 142         (
 143             $c->config->{session}{verify_address}
 144             ? ( __address => $c->request->address )
 145             : ()
 146         ),
 147     };
 148 }
 149
 150 # refactor into Catalyst::Plugin::Session::ID::Weak ?
 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 =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