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

   1 package Catalyst::Plugin::Session::State::Cookie;
   2 use base qw/Catalyst::Plugin::Session::State Class::Accessor::Fast/;
   3
   4 use strict;
   5 use warnings;
   6
   7 use MRO::Compat;
   8 use Catalyst::Utils ();
   9
  10 our $VERSION = "0.11";
  11
  12 BEGIN { __PACKAGE__->mk_accessors(qw/_deleted_session_id/) }
  13
  14 sub setup_session {
  15     my $c = shift;
  16
  17     $c->maybe::next::method(@_);
  18
  19     $c->config->{session}{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->config->{session}{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->config->{session};
  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     $cookie->{secure} = 1 if $cfg->{cookie_secure};
  76
  77     return $cookie;
  78 }
  79
  80 sub calc_expiry { # compat
  81     my $c = shift;
  82     $c->maybe::next::method( @_ ) || $c->calculate_session_cookie_expires( @_ );
  83 }
  84
  85 sub calculate_session_cookie_expires {
  86     my $c   = shift;
  87     my $cfg = $c->config->{session};
  88
  89     my $value = $c->maybe::next::method(@_);
  90     return $value if $value;
  91
  92     if ( exists $cfg->{cookie_expires} ) {
  93         if ( $cfg->{cookie_expires} > 0 ) {
  94             return time() + $cfg->{cookie_expires};
  95         }
  96         else {
  97             return undef;
  98         }
  99     }
 100     else {
 101         return $c->session_expires;
 102     }
 103 }
 104
 105 sub get_session_cookie {
 106     my $c = shift;
 107
 108     my $cookie_name = $c->config->{session}{cookie_name};
 109
 110     return $c->request->cookies->{$cookie_name};
 111 }
 112
 113 sub get_session_id {
 114     my $c = shift;
 115
 116     if ( !$c->_deleted_session_id and my $cookie = $c->get_session_cookie ) {
 117         my $sid = $cookie->value;
 118         $c->log->debug(qq/Found sessionid "$sid" in cookie/) if $c->debug;
 119         return $sid if $sid;
 120     }
 121
 122     $c->maybe::next::method(@_);
 123 }
 124
 125 sub delete_session_id {
 126     my ( $c, $sid ) = @_;
 127
 128     $c->_deleted_session_id(1); # to prevent get_session_id from returning it
 129
 130     $c->update_session_cookie( $c->make_session_cookie( $sid, expires => 0 ) );
 131
 132     $c->maybe::next::method($sid);
 133 }
 134
 135 __PACKAGE__
 136
 137 __END__
 138
 139 =pod
 140
 141 =head1 NAME
 142
 143 Catalyst::Plugin::Session::State::Cookie - Maintain session IDs using cookies.
 144
 145 =head1 SYNOPSIS
 146
 147     use Catalyst qw/Session Session::State::Cookie Session::Store::Foo/;
 148
 149 =head1 DESCRIPTION
 150
 151 In order for L<Catalyst::Plugin::Session> to work the session ID needs to be
 152 stored on the client, and the session data needs to be stored on the server.
 153
 154 This plugin stores the session ID on the client using the cookie mechanism.
 155
 156 =head1 METHODS
 157
 158 =over 4
 159
 160 =item make_session_cookie
 161
 162 Returns a hash reference with the default values for new cookies.
 163
 164 =item update_session_cookie $hash_ref
 165
 166 Sets the cookie based on C<cookie_name> in the response object.
 167
 168 =item calc_expiry
 169
 170 =item calculate_session_cookie_expires
 171
 172 =item cookie_is_rejecting
 173
 174 =item delete_session_id
 175
 176 =item extend_session_id
 177
 178 =item get_session_cookie
 179
 180 =item get_session_id
 181
 182 =item set_session_id
 183
 184 =back
 185
 186 =head1 EXTENDED METHODS
 187
 188 =over 4
 189
 190 =item prepare_cookies
 191
 192 Will restore if an appropriate cookie is found.
 193
 194 =item finalize_cookies
 195
 196 Will set a cookie called C<session> if it doesn't exist or if its value is not
 197 the current session id.
 198
 199 =item setup_session
 200
 201 Will set the C<cookie_name> parameter to its default value if it isn't set.
 202
 203 =back
 204
 205 =head1 CONFIGURATION
 206
 207 =over 4
 208
 209 =item cookie_name
 210
 211 The name of the cookie to store (defaults to C<Catalyst::Utils::apprefix($c) . '_session'>).
 212
 213 =item cookie_domain
 214
 215 The name of the domain to store in the cookie (defaults to current host)
 216
 217 =item cookie_expires
 218
 219 Number of seconds from now you want to elapse before cookie will expire.
 220 Set to 0 to create a session cookie, ie one which will die when the
 221 user's browser is shut down.
 222
 223 =item cookie_secure
 224
 225 If this attribute set true, the cookie will only be sent via HTTPS.
 226
 227 =item cookie_path
 228
 229 The path of the request url where cookie should be baked.
 230
 231 =back
 232
 233 For example, you could stick this in MyApp.pm:
 234
 235   __PACKAGE__->config( session => {
 236      cookie_domain  => '.mydomain.com',
 237   });
 238
 239 =head1 CAVEATS
 240
 241 Sessions have to be created before the first write to be saved. For example:
 242
 243         sub action : Local {
 244                 my ( $self, $c ) = @_;
 245                 $c->res->write("foo");
 246                 $c->session( ... );
 247                 ...
 248         }
 249
 250 Will cause a session ID to not be set, because by the time a session is
 251 actually created the headers have already been sent to the client.
 252
 253 =head1 SEE ALSO
 254
 255 L<Catalyst>, L<Catalyst::Plugin::Session>.
 256
 257 =head1 AUTHORS
 258
 259 Yuval Kogman E<lt>nothingmuch@woobling.orgE<gt>
 260
 261 =head1 CONTRIBUTORS
 262
 263 This module is derived from L<Catalyst::Plugin::Session::FastMmap> code, and
 264 has been heavily modified since.
 265
 266   Andrew Ford
 267   Andy Grundman
 268   Christian Hansen
 269   Marcus Ramberg
 270   Jonathan Rockway E<lt>jrockway@cpan.orgE<gt>
 271   Sebastian Riedel
 272
 273 =head1 COPYRIGHT
 274
 275 This program is free software, you can redistribute it and/or modify it
 276 under the same terms as Perl itself.
 277
 278 =cut
 279
 280 1;