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