lib/Catalyst/Plugin/Session/State/Cookie.pm

   1 package Catalyst::Plugin::Session::State::Cookie;
   2 use Moose;
   3 use namespace::autoclean;
   4
   5 extends 'Catalyst::Plugin::Session::State';
   6
   7 use MRO::Compat;
   8 use Catalyst::Utils ();
   9
  10 our $VERSION = "0.17";
  11
  12 has _deleted_session_id => ( is => 'rw' );
  13
  14 sub setup_session {
  15     my $c = shift;
  16
  17     $c->maybe::next::method(@_);
  18
  19     $c->_session_plugin_config->{cookie_name}
  20         ||= Catalyst::Utils::appprefix($c) . '_session';
  21 }
  22
  23 sub extend_session_id {
  24     my ( $c, $sid, $expires ) = @_;
  25
  26     if ( my $cookie = $c->get_session_cookie ) {
  27         $c->update_session_cookie( $c->make_session_cookie( $sid ) );
  28     }
  29
  30     $c->maybe::next::method( $sid, $expires );
  31 }
  32
  33 sub set_session_id {
  34     my ( $c, $sid ) = @_;
  35
  36     $c->update_session_cookie( $c->make_session_cookie( $sid ) );
  37
  38     return $c->maybe::next::method($sid);
  39 }
  40
  41 sub update_session_cookie {
  42     my ( $c, $updated ) = @_;
  43
  44     unless ( $c->cookie_is_rejecting( $updated ) ) {
  45         my $cookie_name = $c->_session_plugin_config->{cookie_name};
  46         $c->response->cookies->{$cookie_name} = $updated;
  47     }
  48 }
  49
  50 sub cookie_is_rejecting {
  51     my ( $c, $cookie ) = @_;
  52
  53     if ( $cookie->{path} ) {
  54         return 1 if index '/'.$c->request->path, $cookie->{path};
  55     }
  56
  57     return 0;
  58 }
  59
  60 sub make_session_cookie {
  61     my ( $c, $sid, %attrs ) = @_;
  62
  63     my $cfg    = $c->_session_plugin_config;
  64     my $cookie = {
  65         value => $sid,
  66         ( $cfg->{cookie_domain} ? ( domain => $cfg->{cookie_domain} ) : () ),
  67         ( $cfg->{cookie_path} ? ( path => $cfg->{cookie_path} ) : () ),
  68         %attrs,
  69     };
  70
  71     unless ( exists $cookie->{expires} ) {
  72         $cookie->{expires} = $c->calculate_session_cookie_expires();
  73     }
  74
  75     #beware: we have to accept also the old syntax "cookie_secure = true"
  76     my $sec = $cfg->{cookie_secure} || 0; # default = 0 (not set)
  77     $cookie->{secure} = 1 unless ( ($sec==0) || ($sec==2) );
  78     $cookie->{secure} = 1 if ( ($sec==2) && $c->req->secure );
  79
  80     $cookie->{httponly} = $cfg->{cookie_httponly};
  81     $cookie->{httponly} = 1
  82         unless defined $cookie->{httponly}; # default = 1 (set httponly)
  83
  84     return $cookie;
  85 }
  86
  87 sub calc_expiry { # compat
  88     my $c = shift;
  89     $c->maybe::next::method( @_ ) || $c->calculate_session_cookie_expires( @_ );
  90 }
  91
  92 sub calculate_session_cookie_expires {
  93     my $c   = shift;
  94     my $cfg = $c->_session_plugin_config;
  95
  96     my $value = $c->maybe::next::method(@_);
  97     return $value if $value;
  98
  99     if ( exists $cfg->{cookie_expires} ) {
 100         if ( $cfg->{cookie_expires} > 0 ) {
 101             return time() + $cfg->{cookie_expires};
 102         }
 103         else {
 104             return undef;
 105         }
 106     }
 107     else {
 108         return $c->session_expires;
 109     }
 110 }
 111
 112 sub get_session_cookie {
 113     my $c = shift;
 114
 115     my $cookie_name = $c->_session_plugin_config->{cookie_name};
 116
 117     return $c->request->cookies->{$cookie_name};
 118 }
 119
 120 sub get_session_id {
 121     my $c = shift;
 122
 123     if ( !$c->_deleted_session_id and my $cookie = $c->get_session_cookie ) {
 124         my $sid = $cookie->value;
 125         $c->log->debug(qq/Found sessionid "$sid" in cookie/) if $c->debug;
 126         return $sid if $sid;
 127     }
 128
 129     $c->maybe::next::method(@_);
 130 }
 131
 132 sub delete_session_id {
 133     my ( $c, $sid ) = @_;
 134
 135     $c->_deleted_session_id(1); # to prevent get_session_id from returning it
 136
 137     $c->update_session_cookie( $c->make_session_cookie( $sid, expires => 0 ) );
 138
 139     $c->maybe::next::method($sid);
 140 }
 141
 142 1;
 143 __END__
 144
 145 =head1 NAME
 146
 147 Catalyst::Plugin::Session::State::Cookie - Maintain session IDs using cookies.
 148
 149 =head1 SYNOPSIS
 150
 151     use Catalyst qw/Session Session::State::Cookie Session::Store::Foo/;
 152
 153 =head1 DESCRIPTION
 154
 155 In order for L<Catalyst::Plugin::Session> to work the session ID needs to be
 156 stored on the client, and the session data needs to be stored on the server.
 157
 158 This plugin stores the session ID on the client using the cookie mechanism.
 159
 160 =head1 METHODS
 161
 162 =over 4
 163
 164 =item make_session_cookie
 165
 166 Returns a hash reference with the default values for new cookies.
 167
 168 =item update_session_cookie $hash_ref
 169
 170 Sets the cookie based on C<cookie_name> in the response object.
 171
 172 =item calc_expiry
 173
 174 =item calculate_session_cookie_expires
 175
 176 =item cookie_is_rejecting
 177
 178 =item delete_session_id
 179
 180 =item extend_session_id
 181
 182 =item get_session_cookie
 183
 184 =item get_session_id
 185
 186 =item set_session_id
 187
 188 =back
 189
 190 =head1 EXTENDED METHODS
 191
 192 =over 4
 193
 194 =item prepare_cookies
 195
 196 Will restore if an appropriate cookie is found.
 197
 198 =item finalize_cookies
 199
 200 Will set a cookie called C<session> if it doesn't exist or if its value is not
 201 the current session id.
 202
 203 =item setup_session
 204
 205 Will set the C<cookie_name> parameter to its default value if it isn't set.
 206
 207 =back
 208
 209 =head1 CONFIGURATION
 210
 211 =over 4
 212
 213 =item cookie_name
 214
 215 The name of the cookie to store (defaults to C<Catalyst::Utils::apprefix($c) . '_session'>).
 216
 217 =item cookie_domain
 218
 219 The name of the domain to store in the cookie (defaults to current host)
 220
 221 =item cookie_expires
 222
 223 Number of seconds from now you want to elapse before cookie will expire.
 224 Set to 0 to create a session cookie, ie one which will die when the
 225 user's browser is shut down.
 226
 227 =item cookie_secure
 228
 229 If this attribute B<set to 0> the cookie will not have the secure flag.
 230
 231 If this attribute B<set to 1> (or true for backward compatibility) - the cookie
 232 sent by the server to the client will get the secure flag that tells the browser
 233 to send this cookie back to the server only via HTTPS.
 234
 235 If this attribute B<set to 2> then the cookie will get the secure flag only if
 236 the request that caused cookie generation was sent over https (this option is
 237 not good if you are mixing https and http in your application).
 238
 239 Default value is 0.
 240
 241 =item cookie_httponly
 242
 243 If this attribute B<set to 0>, the cookie will not have HTTPOnly flag.
 244
 245 If this attribute B<set to 1>, the cookie will got HTTPOnly flag that should
 246 prevent client side Javascript accessing the cookie value - this makes some
 247 sort of session hijacking attacks significantly harder. Unfortunately not all
 248 browsers support this flag (MSIE 6 SP1+, Firefox 3.0.0.6+, Opera 9.5+); if
 249 a browser is not aware of HTTPOnly the flag will be ignored.
 250
 251 Default value is 1.
 252
 253 Note1: Many people are confused by the name "HTTPOnly" - it B<does not mean>
 254 that this cookie works only over HTTP and not over HTTPS.
 255
 256 Note2: This parameter requires Catalyst::Runtime 5.80005 otherwise is skipped.
 257
 258 =item cookie_path
 259
 260 The path of the request url where cookie should be baked.
 261
 262 =back
 263
 264 For example, you could stick this in MyApp.pm:
 265
 266     __PACKAGE__->config( 'Plugin::Session' => {
 267         cookie_domain  => '.mydomain.com',
 268     });
 269
 270 =head1 CAVEATS
 271
 272 Sessions have to be created before the first write to be saved. For example:
 273
 274     sub action : Local {
 275         my ( $self, $c ) = @_;
 276         $c->res->write("foo");
 277         $c->session( ... );
 278         ...
 279     }
 280
 281 Will cause a session ID to not be set, because by the time a session is
 282 actually created the headers have already been sent to the client.
 283
 284 =head1 SEE ALSO
 285
 286 L<Catalyst>, L<Catalyst::Plugin::Session>.
 287
 288 =head1 AUTHORS
 289
 290 Yuval Kogman <nothingmuch@woobling.org>
 291
 292 =head1 CONTRIBUTORS
 293
 294 This module is derived from L<Catalyst::Plugin::Session::FastMmap> code, and
 295 has been heavily modified since.
 296
 297 Andrew Ford
 298
 299 Andy Grundman
 300
 301 Christian Hansen
 302
 303 Marcus Ramberg
 304
 305 Jonathan Rockway <jrockway@cpan.org>
 306
 307 Sebastian Riedel
 308
 309 Florian Ragwitz
 310
 311 =head1 COPYRIGHT
 312
 313 Copyright (c) 2005 - 2009
 314 the Catalyst::Plugin::Session::State::Cookie L</AUTHORS> and L</CONTRIBUTORS>
 315 as listed above.
 316
 317 =head1 LICENSE
 318
 319 This program is free software, you can redistribute it and/or modify it
 320 under the same terms as Perl itself.
 321
 322 =cut