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 __PACKAGE__
 143
 144 __END__
 145
 146 =pod
 147
 148 =head1 NAME
 149
 150 Catalyst::Plugin::Session::State::Cookie - Maintain session IDs using cookies.
 151
 152 =head1 SYNOPSIS
 153
 154     use Catalyst qw/Session Session::State::Cookie Session::Store::Foo/;
 155
 156 =head1 DESCRIPTION
 157
 158 In order for L<Catalyst::Plugin::Session> to work the session ID needs to be
 159 stored on the client, and the session data needs to be stored on the server.
 160
 161 This plugin stores the session ID on the client using the cookie mechanism.
 162
 163 =head1 METHODS
 164
 165 =over 4
 166
 167 =item make_session_cookie
 168
 169 Returns a hash reference with the default values for new cookies.
 170
 171 =item update_session_cookie $hash_ref
 172
 173 Sets the cookie based on C<cookie_name> in the response object.
 174
 175 =item calc_expiry
 176
 177 =item calculate_session_cookie_expires
 178
 179 =item cookie_is_rejecting
 180
 181 =item delete_session_id
 182
 183 =item extend_session_id
 184
 185 =item get_session_cookie
 186
 187 =item get_session_id
 188
 189 =item set_session_id
 190
 191 =back
 192
 193 =head1 EXTENDED METHODS
 194
 195 =over 4
 196
 197 =item prepare_cookies
 198
 199 Will restore if an appropriate cookie is found.
 200
 201 =item finalize_cookies
 202
 203 Will set a cookie called C<session> if it doesn't exist or if its value is not
 204 the current session id.
 205
 206 =item setup_session
 207
 208 Will set the C<cookie_name> parameter to its default value if it isn't set.
 209
 210 =back
 211
 212 =head1 CONFIGURATION
 213
 214 =over 4
 215
 216 =item cookie_name
 217
 218 The name of the cookie to store (defaults to C<Catalyst::Utils::apprefix($c) . '_session'>).
 219
 220 =item cookie_domain
 221
 222 The name of the domain to store in the cookie (defaults to current host)
 223
 224 =item cookie_expires
 225
 226 Number of seconds from now you want to elapse before cookie will expire.
 227 Set to 0 to create a session cookie, ie one which will die when the
 228 user's browser is shut down.
 229
 230 =item cookie_secure
 231
 232 If this attribute B<set to 0> the cookie will not have the secure flag.
 233
 234 If this attribute B<set to 1> (or true for backward compatibility) - the cookie
 235 send by the server to the client will got the secure flag that tells the browser
 236 to send this cookies back to the server only via HTTPS.
 237
 238 If this attribute B<set to 2> then the cookie will got the secure flag only if
 239 the request that caused cookie generation was sent over https (this option is
 240 not good if you are mixing https and http in you application).
 241
 242 Default vaule is 0.
 243
 244 =item cookie_httponly
 245
 246 If this attribute B<set to 0>, the cookie will not have HTTPOnly flag.
 247
 248 If this attribute B<set to 1>, the cookie will got HTTPOnly flag that should
 249 prevent client side Javascript accessing the cookie value - this makes some
 250 sort of session hijacking attacks significantly harder. Unfortunately not all
 251 browsers support this flag (MSIE 6 SP1+, Firefox 3.0.0.6+, Opera 9.5+); if
 252 a browser is not aware of HTTPOnly the flag will be ignored.
 253
 254 Default value is 1.
 255
 256 Note1: Many peole are confused by the name "HTTPOnly" - it B<does not mean>
 257 that this cookie works only over HTTP and not over HTTPS.
 258
 259 Note2: This parameter requires Catalyst::Runtime 5.80005 otherwise is skipped.
 260
 261 =item cookie_path
 262
 263 The path of the request url where cookie should be baked.
 264
 265 =back
 266
 267 For example, you could stick this in MyApp.pm:
 268
 269   __PACKAGE__->config( 'Plugin::Session' => {
 270      cookie_domain  => '.mydomain.com',
 271   });
 272
 273 =head1 CAVEATS
 274
 275 Sessions have to be created before the first write to be saved. For example:
 276
 277         sub action : Local {
 278                 my ( $self, $c ) = @_;
 279                 $c->res->write("foo");
 280                 $c->session( ... );
 281                 ...
 282         }
 283
 284 Will cause a session ID to not be set, because by the time a session is
 285 actually created the headers have already been sent to the client.
 286
 287 =head1 SEE ALSO
 288
 289 L<Catalyst>, L<Catalyst::Plugin::Session>.
 290
 291 =head1 AUTHORS
 292
 293 Yuval Kogman E<lt>nothingmuch@woobling.orgE<gt>
 294
 295 =head1 CONTRIBUTORS
 296
 297 This module is derived from L<Catalyst::Plugin::Session::FastMmap> code, and
 298 has been heavily modified since.
 299
 300   Andrew Ford
 301   Andy Grundman
 302   Christian Hansen
 303   Marcus Ramberg
 304   Jonathan Rockway E<lt>jrockway@cpan.orgE<gt>
 305   Sebastian Riedel
 306   Florian Ragwitz
 307
 308 =head1 COPYRIGHT
 309
 310 Copyright (c) 2005 - 2009
 311 the Catalyst::Plugin::Session::State::Cookie L</AUTHORS> and L</CONTRIBUTORS>
 312 as listed above.
 313
 314 =head1 LICENSE
 315
 316 This program is free software, you can redistribute it and/or modify it
 317 under the same terms as Perl itself.
 318
 319 =cut
 320
 321 1;