Commit | Line | Data |
9e447f9d |
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 (); |
9a9252c2 |
11 | use Digest (); |
12 | use overload (); |
9e447f9d |
13 | |
b1cd7d77 |
14 | our $VERSION = "0.02"; |
37160715 |
15 | |
9e447f9d |
16 | BEGIN { |
9a9252c2 |
17 | __PACKAGE__->mk_accessors(qw/sessionid session_delete_reason/); |
9e447f9d |
18 | } |
19 | |
20 | sub setup { |
9a9252c2 |
21 | my $c = shift; |
22 | |
23 | $c->NEXT::setup(@_); |
24 | |
25 | $c->check_session_plugin_requirements; |
26 | $c->setup_session; |
27 | |
28 | return $c; |
9e447f9d |
29 | } |
30 | |
31 | sub check_session_plugin_requirements { |
9a9252c2 |
32 | my $c = shift; |
9e447f9d |
33 | |
9a9252c2 |
34 | unless ( $c->isa("Catalyst::Plugin::Session::State") |
35 | && $c->isa("Catalyst::Plugin::Session::Store") ) |
36 | { |
37 | my $err = |
38 | ( "The Session plugin requires both Session::State " |
39 | . "and Session::Store plugins to be used as well." ); |
9e447f9d |
40 | |
9a9252c2 |
41 | $c->log->fatal($err); |
42 | Catalyst::Exception->throw($err); |
43 | } |
9e447f9d |
44 | } |
45 | |
46 | sub setup_session { |
9a9252c2 |
47 | my $c = shift; |
9e447f9d |
48 | |
9a9252c2 |
49 | my $cfg = ( $c->config->{session} ||= {} ); |
9e447f9d |
50 | |
9a9252c2 |
51 | %$cfg = ( |
52 | expires => 7200, |
53 | verify_address => 1, |
54 | %$cfg, |
55 | ); |
9e447f9d |
56 | |
9a9252c2 |
57 | $c->NEXT::setup_session(); |
9e447f9d |
58 | } |
59 | |
60 | sub finalize { |
9a9252c2 |
61 | my $c = shift; |
9e447f9d |
62 | |
9a9252c2 |
63 | if ( $c->{session} ) { |
9e447f9d |
64 | |
9a9252c2 |
65 | # all sessions are extended at the end of the request |
66 | my $now = time; |
67 | @{ $c->{session} }{qw/__updated __expires/} = |
68 | ( $now, $c->config->{session}{expires} + $now ); |
69 | $c->store_session_data( $c->sessionid, $c->{session} ); |
70 | } |
71 | |
72 | $c->NEXT::finalize(@_); |
9e447f9d |
73 | } |
74 | |
75 | sub prepare_action { |
76 | my $c = shift; |
77 | |
3f182468 |
78 | if ( my $sid = $c->sessionid ) { |
3f182468 |
79 | my $s = $c->{session} ||= $c->get_session_data($sid); |
80 | if ( !$s or $s->{__expires} < time ) { |
81 | |
82 | # session expired |
83 | $c->log->debug("Deleting session $sid (expired)") if $c->debug; |
84 | $c->delete_session("session expired"); |
85 | } |
29543a62 |
86 | elsif ($c->config->{session}{verify_address} |
3f182468 |
87 | && $c->{session}{__address} |
88 | && $c->{session}{__address} ne $c->request->address ) |
89 | { |
90 | $c->log->warn( |
91 | "Deleting session $sid due to address mismatch (" |
92 | . $c->{session}{__address} . " != " |
93 | . $c->request->address . ")", |
94 | ); |
95 | $c->delete_session("address mismatch"); |
96 | } |
29543a62 |
97 | else { |
98 | $c->log->debug(qq/Restored session "$sid"/) if $c->debug; |
99 | } |
9a9252c2 |
100 | } |
101 | |
3f182468 |
102 | $c->NEXT::prepare_action(@_); |
9e447f9d |
103 | } |
104 | |
105 | sub delete_session { |
9a9252c2 |
106 | my ( $c, $msg ) = @_; |
9e447f9d |
107 | |
9a9252c2 |
108 | # delete the session data |
109 | my $sid = $c->sessionid; |
110 | $c->delete_session_data($sid); |
9e447f9d |
111 | |
9a9252c2 |
112 | # reset the values in the context object |
113 | $c->{session} = undef; |
114 | $c->sessionid(undef); |
115 | $c->session_delete_reason($msg); |
9e447f9d |
116 | } |
117 | |
118 | sub session { |
9a9252c2 |
119 | my $c = shift; |
9e447f9d |
120 | |
121 | return $c->{session} if $c->{session}; |
122 | |
9a9252c2 |
123 | my $sid = $c->generate_session_id; |
124 | $c->sessionid($sid); |
9e447f9d |
125 | |
9a9252c2 |
126 | $c->log->debug(qq/Created session "$sid"/) if $c->debug; |
9e447f9d |
127 | |
9a9252c2 |
128 | return $c->initialize_session_data; |
9e447f9d |
129 | } |
130 | |
131 | sub initialize_session_data { |
9a9252c2 |
132 | my $c = shift; |
9e447f9d |
133 | |
9a9252c2 |
134 | my $now = time; |
9e447f9d |
135 | |
9a9252c2 |
136 | return $c->{session} = { |
137 | __created => $now, |
138 | __updated => $now, |
139 | __expires => $now + $c->config->{session}{expires}, |
9e447f9d |
140 | |
9a9252c2 |
141 | ( |
142 | $c->config->{session}{verify_address} |
143 | ? ( __address => $c->request->address ) |
144 | : () |
145 | ), |
146 | }; |
9e447f9d |
147 | } |
148 | |
9e447f9d |
149 | sub generate_session_id { |
150 | my $c = shift; |
151 | |
152 | my $digest = $c->_find_digest(); |
153 | $digest->add( $c->session_hash_seed() ); |
154 | return $digest->hexdigest; |
155 | } |
156 | |
157 | my $counter; |
9a9252c2 |
158 | |
9e447f9d |
159 | sub session_hash_seed { |
9a9252c2 |
160 | my $c = shift; |
161 | |
162 | return join( "", ++$counter, time, rand, $$, {}, overload::StrVal($c), ); |
9e447f9d |
163 | } |
164 | |
165 | my $usable; |
9a9252c2 |
166 | |
9e447f9d |
167 | sub _find_digest () { |
9a9252c2 |
168 | unless ($usable) { |
7d139eeb |
169 | foreach my $alg (qw/SHA-1 MD5 SHA-256/) { |
170 | eval { |
29543a62 |
171 | my $obj = Digest->new($alg); |
172 | $usable = $alg; |
173 | return $obj; |
174 | }; |
7d139eeb |
175 | } |
176 | $usable |
9a9252c2 |
177 | or Catalyst::Exception->throw( |
178 | "Could not find a suitable Digest module. Please install " |
179 | . "Digest::SHA1, Digest::SHA, or Digest::MD5" ); |
180 | } |
9e447f9d |
181 | |
182 | return Digest->new($usable); |
183 | } |
184 | |
99b2191e |
185 | sub dump_these { |
186 | my $c = shift; |
187 | |
188 | ( |
189 | $c->NEXT::dump_these(), |
190 | |
191 | $c->sessionid |
192 | ? ( [ "Session ID" => $c->sessionid ], [ Session => $c->session ], ) |
193 | : () |
194 | ); |
195 | } |
196 | |
9e447f9d |
197 | __PACKAGE__; |
198 | |
199 | __END__ |
200 | |
201 | =pod |
202 | |
203 | =head1 NAME |
204 | |
205 | Catalyst::Plugin::Session - Generic Session plugin - ties together server side |
fb1a4ac3 |
206 | storage and client side state required to maintain session data. |
9e447f9d |
207 | |
208 | =head1 SYNOPSIS |
209 | |
8f0b4c16 |
210 | # To get sessions to "just work", all you need to do is use these plugins: |
211 | |
212 | use Catalyst qw/ |
213 | Session |
214 | Session::Store::FastMmap |
215 | Session::State::Cookie |
216 | /; |
217 | |
218 | # you can replace Store::FastMmap with Store::File - both have sensible |
219 | # default configurations (see their docs for details) |
220 | |
221 | # more complicated backends are available for other scenarios (DBI storage, |
222 | # etc) |
223 | |
224 | |
225 | # after you've loaded the plugins you can save session data |
226 | # For example, if you are writing a shopping cart, it could be implemented |
227 | # like this: |
9e447f9d |
228 | |
229a5b53 |
229 | sub add_item : Local { |
230 | my ( $self, $c ) = @_; |
231 | |
232 | my $item_id = $c->req->param("item"); |
233 | |
8f0b4c16 |
234 | # $c->session is a hash ref, a bit like $c->stash |
235 | # the difference is that it' preserved across requests |
229a5b53 |
236 | |
237 | push @{ $c->session->{items} }, $item_id; |
238 | |
239 | $c->forward("MyView"); |
240 | } |
241 | |
242 | sub display_items : Local { |
243 | my ( $self, $c ) = @_; |
244 | |
245 | # values in $c->session are restored |
246 | $c->stash->{items_to_display} = |
8f0b4c16 |
247 | [ map { MyModel->retrieve($_) } @{ $c->session->{items} } ]; |
229a5b53 |
248 | |
249 | $c->forward("MyView"); |
250 | } |
251 | |
9e447f9d |
252 | =head1 DESCRIPTION |
253 | |
254 | The Session plugin is the base of two related parts of functionality required |
255 | for session management in web applications. |
256 | |
257 | The first part, the State, is getting the browser to repeat back a session key, |
258 | so that the web application can identify the client and logically string |
259 | several requests together into a session. |
260 | |
261 | The second part, the Store, deals with the actual storage of information about |
262 | the client. This data is stored so that the it may be revived for every request |
263 | made by the same client. |
264 | |
265 | This plugin links the two pieces together. |
266 | |
8f0b4c16 |
267 | =head1 RECCOMENDED BACKENDS |
268 | |
269 | =over 4 |
270 | |
271 | =item Session::State::Cookie |
272 | |
273 | The only really sane way to do state is using cookies. |
274 | |
275 | =item Session::Store::File |
276 | |
277 | A portable backend, based on Cache::File. |
278 | |
279 | =item Session::Store::FastMmap |
280 | |
281 | A fast and flexible backend, based on Cache::FastMmap. |
282 | |
283 | =back |
284 | |
9e447f9d |
285 | =head1 METHODS |
286 | |
287 | =over 4 |
288 | |
289 | =item sessionid |
290 | |
291 | An accessor for the session ID value. |
292 | |
293 | =item session |
294 | |
295 | Returns a hash reference that might contain unserialized values from previous |
296 | requests in the same session, and whose modified value will be saved for future |
297 | requests. |
298 | |
299 | This method will automatically create a new session and session ID if none |
300 | exists. |
301 | |
302 | =item session_delete_reason |
303 | |
304 | This accessor contains a string with the reason a session was deleted. Possible |
305 | values include: |
306 | |
307 | =over 4 |
308 | |
309 | =item * |
310 | |
311 | C<address mismatch> |
312 | |
313 | =item * |
314 | |
315 | C<session expired> |
316 | |
317 | =back |
318 | |
8f0b4c16 |
319 | =back |
320 | |
321 | =item INTERNAL METHODS |
322 | |
323 | =over 4 |
324 | |
9e447f9d |
325 | =item setup |
326 | |
327 | This method is extended to also make calls to |
328 | C<check_session_plugin_requirements> and C<setup_session>. |
329 | |
330 | =item check_session_plugin_requirements |
331 | |
332 | This method ensures that a State and a Store plugin are also in use by the |
333 | application. |
334 | |
335 | =item setup_session |
336 | |
337 | This method populates C<< $c->config->{session} >> with the default values |
338 | listed in L</CONFIGURATION>. |
339 | |
340 | =item prepare_action |
341 | |
342 | This methoid is extended, and will restore session data and check it for |
343 | validity if a session id is defined. It assumes that the State plugin will |
344 | populate the C<sessionid> key beforehand. |
345 | |
346 | =item finalize |
347 | |
348 | This method is extended and will extend the expiry time, as well as persist the |
349 | session data if a session exists. |
350 | |
351 | =item delete_session REASON |
352 | |
353 | This method is used to invalidate a session. It takes an optional parameter |
354 | which will be saved in C<session_delete_reason> if provided. |
355 | |
356 | =item initialize_session_data |
357 | |
358 | This method will initialize the internal structure of the session, and is |
359 | called by the C<session> method if appropriate. |
360 | |
229a5b53 |
361 | =item generate_session_id |
362 | |
363 | This method will return a string that can be used as a session ID. It is |
364 | supposed to be a reasonably random string with enough bits to prevent |
365 | collision. It basically takes C<session_hash_seed> and hashes it using SHA-1, |
366 | MD5 or SHA-256, depending on the availibility of these modules. |
367 | |
368 | =item session_hash_seed |
369 | |
370 | This method is actually rather internal to generate_session_id, but should be |
371 | overridable in case you want to provide more random data. |
372 | |
373 | Currently it returns a concatenated string which contains: |
374 | |
375 | =over 4 |
376 | |
377 | =item * |
378 | |
379 | A counter |
380 | |
381 | =item * |
382 | |
383 | The current time |
384 | |
385 | =item * |
386 | |
387 | One value from C<rand>. |
388 | |
389 | =item * |
390 | |
391 | The stringified value of a newly allocated hash reference |
392 | |
393 | =item * |
394 | |
395 | The stringified value of the Catalyst context object |
396 | |
397 | =back |
398 | |
399 | In the hopes that those combined values are entropic enough for most uses. If |
400 | this is not the case you can replace C<session_hash_seed> with e.g. |
401 | |
402 | sub session_hash_seed { |
403 | open my $fh, "<", "/dev/random"; |
404 | read $fh, my $bytes, 20; |
405 | close $fh; |
406 | return $bytes; |
407 | } |
408 | |
409 | Or even more directly, replace C<generate_session_id>: |
410 | |
411 | sub generate_session_id { |
412 | open my $fh, "<", "/dev/random"; |
413 | read $fh, my $bytes, 20; |
414 | close $fh; |
415 | return unpack("H*", $bytes); |
416 | } |
417 | |
418 | Also have a look at L<Crypt::Random> and the various openssl bindings - these |
419 | modules provide APIs for cryptographically secure random data. |
420 | |
99b2191e |
421 | =item dump_these |
422 | |
423 | See L<Catalyst/dump_these> - ammends the session data structure to the list of |
424 | dumped objects if session ID is defined. |
425 | |
9e447f9d |
426 | =back |
427 | |
a92c8aeb |
428 | =head1 USING SESSIONS DURING PREPARE |
429 | |
430 | The earliest point in time at which you may use the session data is after |
431 | L<Catalyst::Plugin::Session>'s C<prepare_action> has finished. |
432 | |
433 | State plugins must set $c->session ID before C<prepare_action>, and during |
434 | C<prepare_action> L<Catalyst::Plugin::Session> will actually load the data from |
435 | the store. |
436 | |
437 | sub prepare_action { |
438 | my $c = shift; |
439 | |
440 | # don't touch $c->session yet! |
b1cd7d77 |
441 | |
a92c8aeb |
442 | $c->NEXT::prepare_action( @_ ); |
443 | |
444 | $c->session; # this is OK |
445 | $c->sessionid; # this is also OK |
446 | } |
447 | |
9e447f9d |
448 | =head1 CONFIGURATION |
449 | |
229a5b53 |
450 | $c->config->{session} = { |
451 | expires => 1234, |
452 | }; |
9e447f9d |
453 | |
454 | All configuation parameters are provided in a hash reference under the |
455 | C<session> key in the configuration hash. |
456 | |
457 | =over 4 |
458 | |
459 | =item expires |
460 | |
461 | The time-to-live of each session, expressed in seconds. Defaults to 7200 (two |
462 | hours). |
463 | |
464 | =item verify_address |
465 | |
8c7e922c |
466 | When true, C<<$c->request->address>> will be checked at prepare time. If it is |
467 | not the same as the address that initiated the session, the session is deleted. |
9e447f9d |
468 | |
469 | =back |
470 | |
471 | =head1 SPECIAL KEYS |
472 | |
473 | The hash reference returned by C<< $c->session >> contains several keys which |
474 | are automatically set: |
475 | |
476 | =over 4 |
477 | |
478 | =item __expires |
479 | |
480 | A timestamp whose value is the last second when the session is still valid. If |
481 | a session is restored, and __expires is less than the current time, the session |
482 | is deleted. |
483 | |
484 | =item __updated |
485 | |
486 | The last time a session was saved. This is the value of |
487 | C<< $c->{session}{__expires} - $c->config->{session}{expires} >>. |
488 | |
489 | =item __created |
490 | |
491 | The time when the session was first created. |
492 | |
493 | =item __address |
494 | |
495 | The value of C<< $c->request->address >> at the time the session was created. |
8c7e922c |
496 | This value is only populated if C<verify_address> is true in the configuration. |
9e447f9d |
497 | |
498 | =back |
499 | |
c80e9f04 |
500 | =head1 CAVEATS |
501 | |
502 | C<verify_address> could make your site inaccessible to users who are behind |
503 | load balanced proxies. Some ISPs may give a different IP to each request by the |
504 | same client due to this type of proxying. If addresses are verified these |
505 | users' sessions cannot persist. |
506 | |
507 | To let these users access your site you can either disable address verification |
508 | as a whole, or provide a checkbox in the login dialog that tells the server |
509 | that it's OK for the address of the client to change. When the server sees that |
510 | this box is checked it should delete the C<__address> sepcial key from the |
511 | session hash when the hash is first created. |
512 | |
d45028d6 |
513 | =head1 AUTHORS |
514 | |
36316211 |
515 | Andy Grundman |
516 | Christian Hansen |
517 | Yuval Kogman, C<nothingmuch@woobling.org> |
518 | Sebastian Riedel |
d45028d6 |
519 | |
cc40ae4b |
520 | =head1 COPYRIGHT & LICENSE |
d45028d6 |
521 | |
522 | Copyright (c) 2005 the aforementioned authors. All rights |
523 | reserved. This program is free software; you can redistribute |
524 | it and/or modify it under the same terms as Perl itself. |
525 | |
9e447f9d |
526 | =cut |
527 | |
528 | |