File Coverage

blib/lib/Apache2/Controller/Session/Cookie.pm
Criterion Covered Total %
statement 15 15 100.0
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 20 20 100.0


line stmt bran cond sub pod time code
1             package Apache2::Controller::Session::Cookie;
2              
3             =head1 NAME
4              
5             Apache2::Controller::Session::Cookie - track a sessionid with a cookie in A2C
6              
7             =head1 VERSION
8              
9             Version 1.001.001
10              
11             =cut
12              
13 1     1   2065 use version;
  1         3  
  1         8  
14             our $VERSION = version->new('1.001.001');
15              
16             =head1 SYNOPSIS
17              
18             See L for detailed setup example.
19              
20             package MyApp::Session;
21             use base qw( Apache2::Controller::Session::Cookie );
22             sub get_options {
23             # ...
24             }
25             1;
26              
27             =head1 DESCRIPTION
28              
29             This module implements C and C
30             to get and set the session id from
31             a cookie.
32              
33             =head1 DIRECTIVES
34              
35             =over 4
36              
37             =item A2C_Session_Cookie_Opts
38              
39             =back
40              
41             L
42              
43             L
44              
45             =head1 METHODS
46              
47             These methods must by implemented by any
48             L subclass.
49              
50             =cut
51              
52 1     1   95 use strict;
  1         3  
  1         36  
53 1     1   7 use warnings FATAL => 'all';
  1         2  
  1         58  
54 1     1   7 use English '-no_match_vars';
  1         1  
  1         8  
55              
56 1     1   586 use base qw( Apache2::Controller::Session );
  1         10  
  1         147  
57              
58             use Log::Log4perl qw(:easy);
59             use Readonly;
60             use YAML::Syck;
61              
62             use Apache2::Controller::X;
63              
64             Readonly my $DEFAULT_COOKIE_NAME => 'A2CSession';
65              
66             =head2 get_session_id
67              
68             my $sid = $self->get_session_id();
69              
70             Get the session id from the cookie and verifies it.
71              
72             Sets C<< $r->pnotes->{a2c}{session_id} >> to be the session id string.
73              
74             See L
75             and L.
76              
77             If the cookie is not present or invalid, returns undef.
78              
79             Warns the debug log if sig validation fails and returns undef.
80              
81             =cut
82              
83             sub get_session_id {
84             my ($self) = @_;
85              
86             my %copts = %{ $self->get_directive('A2C_Session_Cookie_Opts') || { } };
87             $copts{name} ||= $DEFAULT_COOKIE_NAME;
88             my $cookie_name = $copts{name};
89            
90             my $jar = $self->get_cookie_jar(); # result might be undef
91             my ($sid, $valid_sig, $cookie) = ();
92             my $sig = qq{};
93              
94             if (defined $jar) {
95             DEBUG "looking for cookie name '$cookie_name'";
96             $cookie = $jar->cookies($cookie_name);
97              
98             if ($cookie) {
99             DEBUG "found cookie named '$cookie_name'";
100             my ($read_sid, $read_sig) = $cookie->value();
101             $sid = $read_sid;
102             $sig = $read_sig if defined $read_sig;
103             }
104             else {
105             DEBUG "found no valid cookie named '$cookie_name'";
106             }
107             DEBUG sub { Dump({
108             sid_from_cookie => $sid,
109             sig_from_cookie => $sig,
110             }) };
111             }
112              
113             if (defined $sid) {
114             # if the session_id does not pass signature, return nothing
115             $valid_sig = $self->signature($sid);
116              
117             if ($valid_sig ne $sig) {
118             WARN "signature validation failed";
119             return;
120             }
121             }
122              
123             # save sig and Apache2::Cookie object for this handler stage
124             # (do not need to recompute the signature since we will use this one)
125             $self->{session_valid_sig} = $valid_sig;
126            
127             return $sid;
128             }
129              
130             =head2 set_session_id
131              
132             $self->set_session_id($sid);
133              
134             Set the session id in the cookie.
135              
136             =cut
137              
138             sub set_session_id {
139             my ($self, $session_id) = @_;
140             DEBUG("Setting session_id '$session_id'");
141             my $r = $self->{r};
142              
143             my $directives = $self->get_directives();
144              
145             my %opts = %{ $self->get_directive('A2C_Session_Cookie_Opts') || { } };
146             $opts{name} ||= $DEFAULT_COOKIE_NAME;
147              
148             DEBUG(sub {"Creating session cookie with opts:\n".Dump(\%opts)});
149             my $name = delete $opts{name};
150              
151             my $cookie = Apache2::Cookie->new( $r,
152             -name => $name,
153             -value => [
154             $session_id,
155             ( $self->{session_valid_sig} || $self->signature($session_id) )
156             ],
157             );
158              
159             $cookie->$_($opts{$_}) for keys %opts;
160              
161             DEBUG("baking cookie '$cookie'");
162             $cookie->bake($r);
163              
164             DEBUG('setting in pnotes');
165             $r->pnotes->{a2c}{session_id} = $session_id;
166              
167             DEBUG("done setting session_id");
168             return;
169             }
170              
171             =head1 SEE ALSO
172              
173             L
174              
175             L
176              
177             L
178              
179             L
180              
181             =head1 AUTHOR
182              
183             Mark Hedges, C<< >>
184              
185             =head1 COPYRIGHT & LICENSE
186              
187             Copyright 2008-2010 Mark Hedges, all rights reserved.
188              
189             This program is free software; you can redistribute it and/or modify it
190             under the same terms as Perl itself.
191              
192             This software is provided as-is, with no warranty
193             and no guarantee of fitness
194             for any particular purpose.
195              
196             =cut
197              
198              
199             1; # End of Apache2::Controller::Session::Cookie