File Coverage

blib/lib/CGI/Application/Plugin/Authentication/Store/Cookie.pm
Criterion Covered Total %
statement 80 80 100.0
branch 14 14 100.0
condition 5 5 100.0
subroutine 16 16 100.0
pod 5 5 100.0
total 120 120 100.0


line stmt bran cond sub pod time code
1             package CGI::Application::Plugin::Authentication::Store::Cookie;
2             $CGI::Application::Plugin::Authentication::Store::Cookie::VERSION = '0.23';
3 11     11   3815 use strict;
  11         34  
  11         296  
4 11     11   49 use warnings;
  11         18  
  11         259  
5              
6 11     11   66 use base qw(CGI::Application::Plugin::Authentication::Store);
  11         26  
  11         4110  
7 11     11   2843 use MIME::Base64 ();
  11         5789  
  11         215  
8 11     11   3608 use Digest::SHA ();
  11         24960  
  11         264  
9 11     11   3556 use CGI::Cookie ();
  11         21312  
  11         8196  
10              
11             # CONFIGURABLE OPTIONS
12             #
13             # - SECRET
14             #
15             # If this value is defined, it will be used to protect
16             # the Cookie values from tampering. To generate a good
17             # secret, run the following perl script and cut and paste
18             # the value it generates into this variable.
19             #
20             # perl -MDigest::MD5=md5_base64 -l -e 'print md5_base64($$,time(),rand(9999))'
21             #
22             our $SECRET = '';
23              
24              
25             =head1 NAME
26              
27             CGI::Application::Plugin::Authentication::Store::Cookie - Cookie based Store
28              
29             =head1 SYNOPSIS
30              
31             use base qw(CGI::Application);
32             use CGI::Application::Plugin::Session;
33             use CGI::Application::Plugin::Authentication;
34              
35             __PACKAGE__->authen->config(
36             STORE => ['Cookie', SECRET => "Shhh, don't tell anyone", NAME => 'CAPAUTH_DATA', EXPIRY => '+1y'],
37             );
38              
39             =head1 DESCRIPTION
40              
41             This module uses a cookie to store authentication information across multiple requests.
42             It works by creating a cookie that contains the information we would like to store (like
43             the name of the user that is currently authenticated), and then base64 encoding
44             the data. In order to ensure that the information is not manipulated by the end-user, we include
45             a CRC checksum that is generated along with our secret. Since the user does not know the value
46             of the secret, they will not be able to recreate the checksum if they change some of the values, so we
47             will be able to tell if the information in the cookie has been manipulated.
48              
49             =head1 THE SECRET
50              
51             =head2 Choosing a good secret
52              
53             An easy way to generate a relatively good secret is to run the following perl snippet:
54              
55             perl -MDigest::MD5=md5_base64 -l -e 'print md5_base64($$,time(),rand(9999))'
56              
57             Just use the resulting string as your secret.
58              
59             =head2 Configuring the secret
60              
61             There are three ways that you can provide a secret to the module:
62              
63             =over 4
64              
65             =item Hardcode the secret
66              
67             You can hardcode a secret right in the CGI::Application::Plugin::Authentication::Store::Cookie module,
68             so that you don't have to remember to provide one every time you use the module. Just open the
69             source in a text editor and look at the top of the file where it defines 'our $SECRET' and follow
70             the instruction listed there.
71              
72             =item Provide the SECRET option when using the module
73              
74             You can also just provide the secret as an option when using the module using the SECRET
75             parameter.
76              
77             __PACKAGE__->authen->config(
78             STORE => ['Cookie', SECRET => "Shhh, don't tell anyone"],
79             );
80              
81             =item Let the module choose a secret for you
82              
83             And lastly, if you forget to do either of these, the module will use the name of your application
84             as the secret, but that is not a very good value to use, so a warning will be spit out everytime
85             it uses this. This is the least desirable choice, and is only included as a last resort.
86              
87             =back
88              
89             =head1 DEPENDENCIES
90              
91             This module requires the following modules to be available.
92              
93             =over 4
94              
95             =item MIME::Base64
96              
97             =item Digest::SHA
98              
99             =item CGI::Cookie
100              
101             =back
102              
103             =head1 METHODS
104              
105             =head2 fetch
106              
107             This method accepts a list of parameters and fetches them from the cookie data.
108              
109             =cut
110              
111             sub fetch {
112 233     233 1 386 my $self = shift;
113 233         453 my @items = map { $self->{cookie}->{data}->{$_} } @_;
  233         719  
114 233         773 return @items[0..$#items];
115             }
116              
117             =head2 save
118              
119             This method accepts a hash of parameters and values and stores them in the cookie data.
120              
121             =cut
122              
123             sub save {
124 25     25 1 42 my $self = shift;
125 25         85 my %items = @_;
126 25         106 while (my ($param, $value) = each %items) {
127 55         192 $self->{cookie}->{data}->{$param} = $value;
128             }
129 25         81 $self->_register_postrun_callback;
130 25         67 return 1;
131             }
132              
133             =head2 delete
134              
135             This method accepts a list of parameters and deletes them from the cookie data.
136              
137             =cut
138              
139             sub delete {
140 1     1 1 2 my $self = shift;
141 1         3 foreach my $param (@_) {
142 4         9 delete $self->{cookie}->{data}->{$param};
143             }
144 1         3 $self->_register_postrun_callback;
145 1         3 return 1;
146             }
147              
148             =head2 initialize
149              
150             This method will check for an existing cookie, and decode the contents for later retrieval.
151              
152             =cut
153              
154             sub initialize {
155 51     51 1 83 my $self = shift;
156              
157 51         155 my @options = $self->options;
158 51 100       219 die "Invalid Store Configuration for the Cookie store - options section must contain a hash of values" if @options % 2;
159 50         165 my %options = @options;
160 50         139 $self->{cookie}->{options} = \%options;
161              
162 50         253 my %cookies = CGI::Cookie->fetch;
163 50 100       1719 if ($cookies{$self->cookie_name}) {
164 6         894 my $rawdata = $cookies{$self->cookie_name}->value;
165 6         38 $self->{cookie}->{data} = $self->_decode($rawdata);
166             }
167             # $self->_register_postrun_callback;
168              
169 50         155 return;
170             }
171              
172             =head2 cookie_name
173              
174             This method will return the name of the cookie
175              
176             =cut
177              
178             sub cookie_name {
179 81     81 1 126 my $self = shift;
180 81   100     364 return $self->{cookie}->{options}->{NAME} || 'CAPAUTH_DATA';
181             }
182              
183             ###
184             ### Helper methods
185             ###
186              
187             # _register_postrun_callback
188             #
189             # We only register the postrun callback once a change has been made to the data
190             # so that we don't unecesarily send out a cookie.
191             sub _register_postrun_callback {
192 26     26   48 my $self = shift;
193 26 100       91 return if $self->{cookie}->{postrun_registered}++;
194              
195 25         101 $self->authen->_cgiapp->add_callback('postrun', \&_postrun_callback);
196 25         391 return;
197             }
198              
199             # _postrun_callback
200             #
201             # This callback will add a cookie to the outgoing headers at the postrun stage
202             sub _postrun_callback {
203 25     25   937 my $self = shift;
204              
205 25         76 my $store = $self->authen->store;
206 25         90 my $rawdata = $store->_encode($store->{cookie}->{data});
207              
208 25         81 my %cookie_params = (
209             -name => $store->cookie_name,
210             -value => $rawdata,
211             );
212 25 100       91 $cookie_params{'-expires'} = $store->{cookie}->{options}->{EXPIRY} if $store->{cookie}->{options}->{EXPIRY};
213 25         133 my $cookie = new CGI::Cookie(%cookie_params);
214 25         5128 $self->header_add(-cookie => [$cookie]);
215 25         1670 return;
216             }
217              
218             # _decode
219             #
220             # Take a raw cookie value, and decode and verify the data
221             sub _decode {
222 18     18   27 my $self = shift;
223 18         57 my $rawdata = MIME::Base64::decode(shift);
224 18 100       40 return if not $rawdata;
225              
226 17         48 my %hash = map { split /\=/, $_, 2 } split /\0/, $rawdata;
  43         109  
227              
228 17         51 my $checksum = delete $hash{c};
229             # verify checksum
230 17 100       40 if ($checksum eq Digest::SHA::sha1_base64(join("\0", $self->_secret, sort values %hash))) {
231             # Checksum verifies so the data is clean
232 15         56 return \%hash;
233             } else {
234             # The data could not be verified, so we trash it all
235 2         8 return;
236             }
237             }
238              
239             # _encode
240             #
241             # Take the data we want to store and encode the data into a cookie
242             sub _encode {
243 25     25   43 my $self = shift;
244 25         42 my $hash = shift;
245 25         99 my %hash = %$hash;
246              
247 25         76 my $checksum = Digest::SHA::sha1_base64(join("\0", $self->_secret, sort values %hash));
248 25         74 $hash{c} = $checksum;
249 25         76 my $rawdata = join("\0", map { join('=', $_, $hash{$_}) } keys %hash);
  76         213  
250 25         147 return MIME::Base64::encode($rawdata, "");
251             }
252              
253             # _secret
254             #
255             # A unique value for this application that is used to secure the Cookies
256             sub _secret {
257 42     42   69 my $self = shift;
258 42   100     140 my $secret = $self->{cookie}->{options}->{SECRET} || $SECRET;
259 42 100       100 unless ($secret) {
260 17         41 $secret = Digest::SHA::sha1_base64( ref $self->authen->_cgiapp );
261 17         171 warn "using default SECRET! Please provide a proper SECRET when using the Cookie store (See CGI::Application::Plugin::Authentication::Store::Cookie for details)";
262             }
263 42         1157 return $secret;
264             }
265              
266             =head1 SEE ALSO
267              
268             L, L, perl(1)
269              
270              
271             =head1 AUTHOR
272              
273             Cees Hek
274              
275              
276             =head1 LICENCE AND COPYRIGHT
277              
278             Copyright (c) 2005, SiteSuite. All rights reserved.
279              
280             This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
281              
282              
283             =head1 DISCLAIMER OF WARRANTY
284              
285             BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION.
286              
287             IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
288              
289             =cut
290              
291             1;