blib/lib/CGI/SecureState.pm | |||
---|---|---|---|
Criterion | Covered | Total | % |
statement | 251 | 320 | 78.4 |
branch | 85 | 180 | 47.2 |
condition | 26 | 67 | 38.8 |
subroutine | 32 | 38 | 84.2 |
pod | 16 | 27 | 59.2 |
total | 410 | 632 | 64.8 |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | #!/usr/bin/perl -wT | ||||||
2 | #This file is Copyright (C) 2000-2003 Peter Behroozi and is | ||||||
3 | #licensed for use under the same terms as Perl itself. | ||||||
4 | package CGI::SecureState; | ||||||
5 | |||||||
6 | 3 | 3 | 137244 | use strict; | |||
3 | 9 | ||||||
3 | 113 | ||||||
7 | 3 | 3 | 17 | use CGI; | |||
3 | 5 | ||||||
3 | 15 | ||||||
8 | 3 | 3 | 2586 | use Crypt::Blowfish; | |||
3 | 3540 | ||||||
3 | 155 | ||||||
9 | 3 | 3 | 2440 | use Digest::SHA1 qw(sha1 sha1_hex sha1_base64); | |||
3 | 2419 | ||||||
3 | 226 | ||||||
10 | 3 | 3 | 20 | use File::Spec; | |||
3 | 8 | ||||||
3 | 76 | ||||||
11 | 3 | 3 | 17 | use Fcntl qw(:flock :DEFAULT); | |||
3 | 7 | ||||||
3 | 1894 | ||||||
12 | 3 | 715 | use vars qw(@ISA $VERSION $Counter $NASTY_WARNINGS $AVOID_SYMLINKS | ||||
13 | 3 | 3 | 16 | $SEEK_SET $USE_FLOCK); | |||
3 | 6 | ||||||
14 | |||||||
15 | BEGIN { | ||||||
16 | 3 | 3 | 52 | @ISA=qw(CGI); | |||
17 | 3 | 6 | $VERSION = '0.36'; | ||||
18 | |||||||
19 | #Set this to 0 if you want warnings about deprecated behavior to be suppressed, | ||||||
20 | #especially if you are upgrading from CGI::SecureState 0.2x. However, heed the | ||||||
21 | #warnings issued when this is set to 1 because they will better your coding style | ||||||
22 | #and likely increase program security. | ||||||
23 | 3 | 5 | $NASTY_WARNINGS = 1; | ||||
24 | |||||||
25 | #Set this to 0 if you don't want CGI::SecureState to test for a symlink attack | ||||||
26 | #before writing to a state file. If this is set to 1 and CGI::SecureState sees a | ||||||
27 | #symlink in place of a real file, it will spit out a fatal error. | ||||||
28 | 3 | 3 | $AVOID_SYMLINKS = 1; | ||||
29 | |||||||
30 | #Set this to 0 if you do not want CGI::SecureState to use flock() to assure that | ||||||
31 | #only one instance of CGI::SecureState is accessing the state file at a time. | ||||||
32 | #Leave this at 1 unless you really have a good reason not to. | ||||||
33 | 3 | 6 | $USE_FLOCK = 1; | ||||
34 | |||||||
35 | #The operating systems below do not support flock, except for Windows NT systems, | ||||||
36 | #but it is impossible to distinguish WinNT systems from Win9x systems only based | ||||||
37 | #on $^O | ||||||
38 | 3 | 16 | local $_=$^O; | ||||
39 | 3 | 50 | 33 | 84 | $USE_FLOCK = 0 if (/MacOS/i || /V[MO]S/i || /MSWin32/i); | ||
33 | |||||||
40 | |||||||
41 | #Workaround for Perl v5.005_03 | ||||||
42 | 3 | 50 | 10110 | $SEEK_SET = ($]<5.006) ? 0 : &Fcntl::SEEK_SET; | |||
43 | } | ||||||
44 | |||||||
45 | sub import { | ||||||
46 | 3 | 3 | 46 | foreach (@_) { | |||
47 | 3 | 50 | 22 | $NASTY_WARNINGS=0, next if (/[:-]?no_nasty_warnings/); | |||
48 | 3 | 50 | 13 | $AVOID_SYMLINKS=0, next if (/[:-]?dont_avoid_symlinks/); | |||
49 | 3 | 50 | 32 | $USE_FLOCK=0, next if (/[:-]?no_flock/); | |||
50 | 3 | 50 | 16 | $USE_FLOCK=1, next if (/[:-]?use_flock/); | |||
51 | 3 | 50 | 9075 | if (/[:-]?(extra|paranoid|no)_secure/) { | |||
52 | 0 | 0 | $CGI::PRIVATE_TEMPFILES = ! /no_/; | ||||
53 | 0 | 0 | 0 | $CGI::POST_MAX = /no_/ ? -1 : 10240; | |||
54 | 0 | 0 | $CGI::DISABLE_UPLOADS = /paranoid_/; | ||||
55 | } | ||||||
56 | } | ||||||
57 | } | ||||||
58 | |||||||
59 | |||||||
60 | sub new | ||||||
61 | { | ||||||
62 | #Obtain the class (should be CGI::SecureState in most cases) | ||||||
63 | 3 | 3 | 1 | 1790 | my $class = shift; | ||
64 | |||||||
65 | #populate the argument array | ||||||
66 | 3 | 25 | my %args = args_to_hash([qw(-stateDir -mindSet -memory -temp -key)], @_); | ||||
67 | |||||||
68 | #Set up the CGI object to our liking | ||||||
69 | 3 | 34 | my $cgi=new CGI; | ||||
70 | |||||||
71 | #We don't want any nassssty tricksssy people playing with things that we | ||||||
72 | #should be setting ourselves | ||||||
73 | 3 | 14257 | $cgi->delete($_) foreach (qw(.statefile .cipher .isforgetful .memory | ||||
74 | .recent_memory .age .errormsg)); | ||||||
75 | |||||||
76 | #if the user has an error message subroutine, we should use it: | ||||||
77 | 3 | 50 | 2452 | $cgi->{'.errormsg'} = $args{'-errorSub'} || $args{'-errorsub'} || undef; | |||
78 | |||||||
79 | #set the forgetfulness; By default, this is "forgetful" because it encourages | ||||||
80 | #cleaner programming, but if the user is upgrading from 0.2x series, this will be | ||||||
81 | #undef; if so, be backwards-compatible but give them a few nasty warning messages. | ||||||
82 | 3 | 50 | 15 | $args{'-mindSet'} = $args{'-mindset'} unless (defined $args{'-mindSet'}); | |||
83 | 3 | 14 | $cgi->{'.isforgetful'} = $args{'-mindSet'}; | ||||
84 | |||||||
85 | 3 | 50 | 14 | if (defined $args{'-mindSet'}) { | |||
0 | |||||||
86 | 3 | 50 | 17 | $cgi->{'.isforgetful'} = 0 if ($args{'-mindSet'} =~ /unforgetful/i); | |||
87 | } elsif ($NASTY_WARNINGS) { | ||||||
88 | 0 | 0 | warn "Programmer did not set mindset when declaring new CGI::SecureState object at ", | ||||
89 | (caller)[1], " line ", (caller)[2], ". Please tell him/her to read the new CGI::SecureState ", | ||||||
90 | "documentation.\n"; | ||||||
91 | } | ||||||
92 | |||||||
93 | #Set up long-term memory | ||||||
94 | 3 | 50 | 57 | $args{'-memory'} ||= $args{'-longTerm'} || $args{'-longterm'} || []; | |||
33 | |||||||
95 | 3 | 8 | $cgi->{'.memory'} = {map {$_ => 1} @{$args{'-memory'}}}; | ||||
0 | 0 | ||||||
3 | 10 | ||||||
96 | |||||||
97 | #Set up short-term memory | ||||||
98 | 3 | 50 | 25 | $args{'-temp'} ||= $args{'-shortTerm'} || $args{'-shortterm'} || []; | |||
66 | |||||||
99 | 3 | 6 | $cgi->{'.recent_memory'} = {map {$_ => undef} @{$args{'-temp'}}}; | ||||
3 | 24 | ||||||
3 | 67 | ||||||
100 | |||||||
101 | #Check for ID tag in url if it is not in the normal parameters list | ||||||
102 | 3 | 50 | 33 | 13 | if (!defined($cgi->param('.id')) && $cgi->request_method() eq 'POST') { | ||
103 | 0 | 0 | $cgi->param('.id', $cgi->url_param('.id')); | ||||
104 | } | ||||||
105 | |||||||
106 | #Set up the encryption part | ||||||
107 | 3 | 33 | 466 | my $id = $cgi->param('.id') || sha1_hex($args{'-key'} or generate_id()); | |||
108 | 3 | 34 | my $remote_addr = $cgi->remote_addr(); | ||||
109 | 3 | 364 | my $remoteip = pack("CCCC", split (/\./, $remote_addr)); | ||||
110 | 3 | 22 | my $key = pack("H*",$id) . $remoteip; | ||||
111 | 3 | 33 | 35 | $cgi->{'.cipher'} = new Crypt::Blowfish($key) || errormsg($cgi, 'invalid state file'); | |||
112 | |||||||
113 | #set the directory where we will store saved information | ||||||
114 | 3 | 50 | 300 | my $statedir = $args{'-stateDir'} || $args{'-statedir'} || "."; | |||
115 | |||||||
116 | #Set up (and untaint) the name of the location to store data | ||||||
117 | 3 | 25 | my $statefile = sha1_base64($id.$remote_addr); | ||||
118 | 3 | 11 | $statefile =~ tr|+/|_-|; | ||||
119 | 3 | 15 | $statefile =~ /([\w-]{27})/; | ||||
120 | 3 | 86 | $cgi->{'.statefile'} = File::Spec->catfile($statedir,$1); | ||||
121 | |||||||
122 | #convert $cgi into a CGI::SecureState object | ||||||
123 | 3 | 12 | bless $cgi, $class; | ||||
124 | |||||||
125 | #if this is not a new session, attempt to read from the state file | ||||||
126 | 3 | 50 | 17 | $cgi->param('.id') ? $cgi->recover_memory : $cgi->param('.id' => $id); | |||
127 | |||||||
128 | #save any changes to the state file; if there are none, then update only the timestamp | ||||||
129 | 3 | 50 | 255 | my $newmemory = (@{$args{'-memory'}}) ? 1 : 0; | |||
3 | 14 | ||||||
130 | 3 | 100 | 66 | 121 | ($newmemory || !$cgi->{'.isforgetful'}) ? $cgi->save_memory : $cgi->encipher; | ||
131 | |||||||
132 | #finish | ||||||
133 | 3 | 17 | return $cgi; | ||||
134 | } | ||||||
135 | |||||||
136 | sub add { | ||||||
137 | 6 | 6 | 1 | 978 | my $self = shift; | ||
138 | 6 | 100 | 42 | my %params = (ref($_[1]) eq 'ARRAY') ? @_ : (shift, \@_); | |||
139 | 6 | 25 | $self->param($_, @{$params{$_}}) foreach (keys %params); | ||||
9 | 215 | ||||||
140 | 6 | 376 | $self->remember(keys %params); | ||||
141 | } | ||||||
142 | |||||||
143 | sub remember { | ||||||
144 | 8 | 8 | 1 | 604 | my $self = shift; | ||
145 | 8 | 21 | my ($isforgetful,$memory) = @$self{'.isforgetful','.memory'}; | ||||
146 | 8 | 100 | 44 | $isforgetful ? $memory->{$_}=1 : delete($memory->{$_}) foreach (@_); | |||
147 | 8 | 228 | $self->save_memory; | ||||
148 | } | ||||||
149 | |||||||
150 | sub delete { | ||||||
151 | 8 | 8 | 1 | 1848 | my $self = shift; | ||
152 | 8 | 20 | my ($isforgetful,$memory) = @$self{'.isforgetful','.memory'}; | ||||
153 | 8 | 19 | foreach (@_) { | ||||
154 | 20 | 100 | 1483 | delete $memory->{$_} if ($isforgetful); | |||
155 | 20 | 442 | $self->SUPER::delete($_); | ||||
156 | } | ||||||
157 | 8 | 1029 | $self->save_memory; | ||||
158 | } | ||||||
159 | |||||||
160 | sub delete_all | ||||||
161 | { | ||||||
162 | 2 | 2 | 1 | 435 | my $self = shift; | ||
163 | 2 | 12 | my (@state) = @$self{qw(.statefile .cipher .isforgetful .memory .age .errormsg)}; | ||||
164 | 2 | 9 | my $id=$self->param('.id'); | ||||
165 | 2 | 69 | $self->SUPER::delete_all(); | ||||
166 | 2 | 9 | $self->param('.id' => $id); | ||||
167 | 2 | 111 | @$self{qw(.statefile .cipher .isforgetful .memory .age .errormsg)} = @state; | ||||
168 | 2 | 100 | 10 | $self->{'.memory'}={} if ($self->{'.isforgetful'}); | |||
169 | 2 | 6 | $self->{'.recent_memory'} = {}; | ||||
170 | 2 | 56 | $self->save_memory; | ||||
171 | } | ||||||
172 | |||||||
173 | sub delete_session { | ||||||
174 | 3 | 3 | 1 | 521 | my $self = shift; | ||
175 | 3 | 50 | 319 | unlink $self->{'.statefile'} or $self->errormsg('failed to delete the state file'); | |||
176 | 3 | 115 | $self->SUPER::delete_all; | ||||
177 | } | ||||||
178 | |||||||
179 | sub params { | ||||||
180 | 6 | 6 | 1 | 143 | my $self = shift; | ||
181 | 6 | 50 | 18 | return $self->param unless (@_); | |||
182 | 6 | 12 | return map { scalar $self->param($_) } @_; | ||||
12 | 121 | ||||||
183 | } | ||||||
184 | |||||||
185 | sub user_param | ||||||
186 | { | ||||||
187 | 3 | 3 | 1 | 9 | my $self = shift; | ||
188 | 3 | 50 | 10 | return $self->param unless (@_); | |||
189 | 3 | 50 | 8 | if (@_ == 1) { | |||
190 | 3 | 6 | my $param = shift; | ||||
191 | 3 | 7 | my $value = $self->{'.recent_memory'}->{$param}; | ||||
192 | 3 | 50 | 11 | return $self->param($param) if (!defined $value); | |||
193 | 3 | 100 | 15 | return wantarray ? @$value : $value->[0]; | |||
194 | } else { | ||||||
195 | 0 | 0 | 0 | my %params = (ref($_[1]) eq 'ARRAY') ? @_ : (shift, \@_); | |||
196 | 0 | 0 | $self->{'.recent_memory'}->{$_}=[@{$params{$_}}] foreach (keys %params); | ||||
0 | 0 | ||||||
197 | } | ||||||
198 | } | ||||||
199 | |||||||
200 | sub user_params { | ||||||
201 | 1 | 1 | 1 | 6 | my $self = shift; | ||
202 | 1 | 50 | 3 | return $self->param unless (@_); | |||
203 | 1 | 2 | return map { scalar $self->user_param($_) } @_; | ||||
2 | 5 | ||||||
204 | } | ||||||
205 | |||||||
206 | sub user_delete { | ||||||
207 | 0 | 0 | 1 | 0 | my $self = shift; | ||
208 | 0 | 0 | delete @{$self->{'.recent_memory'}}{@_}; | ||||
0 | 0 | ||||||
209 | } | ||||||
210 | |||||||
211 | sub age { | ||||||
212 | 2 | 2 | 1 | 398 | my $self = shift; | ||
213 | 2 | 50 | 10 | if (defined $self->{'.age'}) { | |||
214 | 2 | 8 | my $current_time=unpack("N",pack("N",time())); | ||||
215 | 2 | 13 | return (($current_time-$self->{'.age'})/24/3600); | ||||
216 | } | ||||||
217 | 0 | 0 | return 0; | ||||
218 | } | ||||||
219 | |||||||
220 | sub state_url { | ||||||
221 | 1 | 1 | 1 | 1 | my $self = shift; | ||
222 | 1 | 11 | return $self->script_name()."?.id=".$self->param('.id'); | ||||
223 | } | ||||||
224 | |||||||
225 | sub state_param { | ||||||
226 | 0 | 0 | 1 | 0 | my $self = shift; | ||
227 | 0 | 0 | return ".id=" . $self->param('.id'); | ||||
228 | } | ||||||
229 | |||||||
230 | sub state_field { | ||||||
231 | 0 | 0 | 1 | 0 | my $self = shift; | ||
232 | 0 | 0 | return $self->hidden('.id' => $self->param('.id')); | ||||
233 | } | ||||||
234 | |||||||
235 | sub memory_as { | ||||||
236 | 1 | 1 | 1 | 313 | my ($self, $type) = @_; | ||
237 | 1 | 0 | 8 | return (($type eq 'url') ? $self->state_url . $self->stringify_recent_memory('url') : | |||
0 | |||||||
50 | |||||||
238 | ($type eq 'param') ? $self->state_param . $self->stringify_recent_memory('url') : | ||||||
239 | ($type eq 'field') ? $self->state_field . $self->stringify_recent_memory('form') : undef); | ||||||
240 | } | ||||||
241 | |||||||
242 | sub start_html { | ||||||
243 | 0 | 0 | 0 | 0 | my $self=shift; | ||
244 | 0 | 0 | my $isforgetful=$self->{'.isforgetful'}; | ||||
245 | 0 | 0 | 0 | 0 | if ($NASTY_WARNINGS && ! defined $isforgetful) { | ||
246 | 0 | 0 | return $self->SUPER::start_html(@_) . 'The author of this dynamic web-enabled application did not set the '. | ||||
247 | 'mandatory \'-mindSet\' attribute when creating a CGI::SecureState object. Please contact him/her and '. | ||||||
248 | 'tell him/her to read the updated CGI::SecureState documentation.'; | ||||||
249 | } | ||||||
250 | 0 | 0 | return $self->SUPER::start_html(@_); | ||||
251 | } | ||||||
252 | |||||||
253 | |||||||
254 | sub clean_statedir | ||||||
255 | { | ||||||
256 | 0 | 0 | 1 | 0 | my $self = shift; | ||
257 | 0 | 0 | my %args = args_to_hash([qw(-age -directory)], @_); | ||||
258 | 0 | 0 | my @states; | ||||
259 | |||||||
260 | 0 | 0 | 0 | if (!defined $args{'-directory'}) { | |||
261 | 0 | 0 | 0 | return unless $self->{'.statefile'}; | |||
262 | 0 | 0 | my ($volume, $directory) = File::Spec->splitpath($self->{'.statefile'}); | ||||
263 | 0 | 0 | 0 | $args{'-directory'} = ($volume or '') . $directory; | |||
264 | } | ||||||
265 | 0 | 0 | 0 | $args{'-age'} ||= 1/24; | |||
266 | |||||||
267 | 0 | 0 | 0 | opendir STATEDIR, $args{'-directory'} or return; | |||
268 | 0 | 0 | foreach (readdir STATEDIR) { | ||||
269 | 0 | 0 | 0 | next unless /^([0-9A-Za-z_-]{27})$/; | |||
270 | 0 | 0 | push @states, File::Spec->catfile($args{'-directory'}, $1); | ||||
271 | } | ||||||
272 | 0 | 0 | closedir STATEDIR; | ||||
273 | |||||||
274 | 0 | 0 | my $removed = 0; | ||||
275 | 0 | 0 | my @old_states = grep { -M $_ > $args{'-age'} } @states; | ||||
0 | 0 | ||||||
276 | 0 | 0 | foreach (@old_states) { | ||||
277 | 0 | 0 | 0 | 0 | warn "Symlink encountered at $_\n" if ($AVOID_SYMLINKS && -l); | ||
278 | 0 | 0 | 0 | (unlink $_) ? $removed++ : warn "Could not remove old state file $_: $!\n"; | |||
279 | } | ||||||
280 | 0 | 0 | 0 | return @old_states ? $removed/@old_states : 1; | |||
281 | } | ||||||
282 | |||||||
283 | sub errormsg | ||||||
284 | { | ||||||
285 | 0 | 0 | 0 | 0 | my $self=shift; | ||
286 | 0 | 0 | 0 | if (ref($self->{'.errormsg'}) eq 'CODE') { | |||
287 | 0 | 0 | 0 | $self->{'.errormsg'}->(@_) && exit; | |||
288 | } | ||||||
289 | 0 | 0 | my $error = shift; | ||||
290 | 0 | 0 | print $self->header; | ||||
291 | 0 | 0 | print $self->start_html(-title => "Server Error: \u$error.", -bgcolor => "white"); | ||||
292 | 0 | 0 | print " \n", $self->h1("The following error was encountered:"); |
||||
293 | 0 | 0 | 0 | if ($error =~ /^failed/) { | |||
0 | |||||||
0 | |||||||
0 | |||||||
294 | 0 | 0 | print(" The server $error, which is a file manipulation error. This is most likely due to a bug in ", |
||||
295 | "the referring script or a permissions problem on the server."); | ||||||
296 | } elsif ($error eq "symlink encountered") { | ||||||
297 | 0 | 0 | print(" The server encountered a symlink in the state file directory. This is usually the sign of an ", |
||||
298 | "attempted security breach and has been logged in the server log files. It is unlikely that you are ", | ||||||
299 | "responsible for this error, but it is nonetheless fatal."); | ||||||
300 | 0 | 0 | warn("CGI::SecureState FATAL error: Symlink encountered while trying to access $self->{'.statefile'}"); | ||||
301 | } elsif ($error eq "invalid state file") { | ||||||
302 | 0 | 0 | print("The file that stores information about your session has been corrupted on the server. ", | ||||
303 | "This is usually the sign of an attemped security breach and has been logged in the server ", | ||||||
304 | " log files. It is unlikely that you are responsible for this error, but it is nonetheless fatal."); | ||||||
305 | 0 | 0 | warn("CGI::SecureState FATAL error: The state file $self->{'.statefile'} became corrupted."); | ||||
306 | } elsif ($error eq "statefile inconsistent with mindset") { | ||||||
307 | 0 | 0 | print("The mindset of the statefile is different from that specified in the referring script. This is", | ||||
308 | " most likely a bug in the referring script, but could also be due to a file permissions problem."); | ||||||
309 | } else { | ||||||
310 | 0 | 0 | print " $error. "; |
||||
311 | 0 | 0 | warn("CGI::SecureState FATAL error: $error."); | ||||
312 | } | ||||||
313 | 0 | 0 | print $self->end_html; | ||||
314 | 0 | 0 | exit; | ||||
315 | } | ||||||
316 | |||||||
317 | |||||||
318 | #### Subroutines below this line are for private use only #### | ||||||
319 | sub generate_id { | ||||||
320 | 3 | 3 | 0 | 293 | return join("", map { sprintf("%.32f", $_) } | ||
12 | 174 | ||||||
321 | (rand(), rand(), time()^rand(), $CGI::SecureState::Counter+=rand())); | ||||||
322 | } | ||||||
323 | |||||||
324 | |||||||
325 | sub args_to_hash { | ||||||
326 | 3 | 3 | 0 | 9 | my $list = shift; | ||
327 | 3 | 50 | 14 | return unless @_; | |||
328 | 3 | 50 | 38 | return ($_[0] =~ /^-/) ? @_ : map { shift @$list => $_ } @_; | |||
0 | 0 | ||||||
329 | } | ||||||
330 | |||||||
331 | |||||||
332 | |||||||
333 | sub stringify_recent_memory | ||||||
334 | { | ||||||
335 | 1 | 1 | 0 | 647 | my ($self, $format) = @_; | ||
336 | 1 | 2 | my $recent_memory = $self->{'.recent_memory'}; | ||||
337 | 1 | 2 | my ($leading, $separating, $closing, $result); | ||||
338 | |||||||
339 | 1 | 50 | 3 | if ($format eq 'url') { | |||
0 | |||||||
340 | 1 | 50 | 3 | $leading = $CGI::USE_PARAM_SEMICOLONS ? ';' : '&'; | |||
341 | 1 | 2 | ($separating, $closing) = ('=', ''); | ||||
342 | } elsif ($format eq 'form') { | ||||||
343 | 0 | 0 | ($leading, $separating, $closing) = ("\n'); | ||||
344 | } | ||||||
345 | |||||||
346 | 1 | 3 | foreach (keys %$recent_memory) { | ||||
347 | 2 | 50 | 33 | 14 | next if ($_ eq '.id' or substr($_,0,4) eq '.tmp'); | ||
348 | 2 | 3 | my $param = $_; | ||||
349 | 2 | 50 | 50 | escape_url($param) if ($format eq 'url'); #Do URL-encoding | |||
350 | 2 | 50 | 6 | $param = $self->escapeHTML($param) if ($format eq 'form'); | |||
351 | 2 | 15 | foreach (@{$recent_memory->{$param}}) { | ||||
2 | 7 | ||||||
352 | 2 | 2 | my $value = $_; | ||||
353 | 2 | 50 | 50 | escape_url($value) if ($format eq 'url'); #Do URL-encoding | |||
354 | 2 | 50 | 7 | $value = $self->escapeHTML($value) if ($format eq 'form'); | |||
355 | 2 | 12 | $result .= $leading . ".tmp$param" . $separating . $value . $closing; | ||||
356 | } | ||||||
357 | } | ||||||
358 | 1 | 4 | return $result; | ||||
359 | } | ||||||
360 | |||||||
361 | sub recover_recent_memory { | ||||||
362 | 12 | 12 | 0 | 16 | my $self = shift; | ||
363 | 12 | 23 | my $recent_memory = $self->{'.recent_memory'}; | ||||
364 | 12 | 189 | foreach my $param (keys %$recent_memory) { | ||||
365 | 11 | 156 | my @values = $self->param($param); | ||||
366 | 11 | 50 | 193 | $recent_memory->{$param} = @values ? \@values : [ $self->param(".tmp$param") ]; | |||
367 | 11 | 422 | $self->SUPER::delete(".tmp$param"); | ||||
368 | 11 | 50 | 1119 | $self->param($param => undef) unless @values; | |||
369 | } | ||||||
370 | } | ||||||
371 | |||||||
372 | |||||||
373 | #Workaround for Perl v5.005_03 so that Unicode is encrypted | ||||||
374 | #and decrypted properly. | ||||||
375 | BEGIN { | ||||||
376 | 3 | 3 | 8 | my $subs = <<'END_OF_FUNCTIONS' | |||
377 | |||||||
378 | #Derived from the escape funtion of CGI::Util | ||||||
379 | sub escape_url { | ||||||
380 | $_[0]=~s/([^a-zA-Z0-9_.-])/sprintf("%%%02X",ord($1))/eg; | ||||||
381 | } | ||||||
382 | |||||||
383 | sub save_memory | ||||||
384 | { | ||||||
385 | my $self=shift; | ||||||
386 | my (@data,@values,$entity); | ||||||
387 | my ($isforgetful,$memory)=@$self{'.isforgetful','.memory'}; | ||||||
388 | |||||||
389 | #If we are forgetful, then we need to save the contents of our memory | ||||||
390 | #If we remember stuff, then we need to save everything but the contents of our memory | ||||||
391 | foreach ($self->param) { | ||||||
392 | next if ($isforgetful xor (exists $memory->{$_})); | ||||||
393 | next if ($_ eq '.id' or substr($_,0,4) eq '.tmp'); | ||||||
394 | if (@values=$self->param($_)) { | ||||||
395 | foreach $entity ($_, @values) { $entity =~ s/([ \n\\])/\\$1/go } #escape meta-characters | ||||||
396 | push @data, join(" ",@values), $_; | ||||||
397 | } | ||||||
398 | } | ||||||
399 | |||||||
400 | push @data, $isforgetful ? "Forgetful" : "Remembering"; | ||||||
401 | $self->encipher(join("\n\n", @data, "Saved-Values")); | ||||||
402 | } | ||||||
403 | |||||||
404 | sub recover_memory | ||||||
405 | { | ||||||
406 | my $self=shift; | ||||||
407 | my (@data,$param,@values, $value); | ||||||
408 | my ($isforgetful,$memory)=@$self{'.isforgetful','.memory'}; | ||||||
409 | |||||||
410 | #recover short-term "recent" memory | ||||||
411 | $self->recover_recent_memory(); | ||||||
412 | |||||||
413 | @data = split(/(?decipher); | ||||||
414 | |||||||
415 | if (@data) { | ||||||
416 | #skip over fields until we get to the Saved-Values section | ||||||
417 | #to retain compatibility with later versions of CGI::SecureState | ||||||
418 | do { $param=pop(@data) } while ($param ne "Saved-Values" && @data); | ||||||
419 | |||||||
420 | #check to make sure that our mindset is the same as the statefile's | ||||||
421 | $param=pop @data; | ||||||
422 | if ($param ne ($isforgetful ? "Forgetful" : "Remembering")) { | ||||||
423 | $self->errormsg('statefile inconsistent with mindset') } | ||||||
424 | |||||||
425 | while (@data) { | ||||||
426 | ($param = pop @data) =~ s/\\(.)/$1/go; #unescape meta-characters | ||||||
427 | @values=split(/(? | ||||||
428 | next if (!$isforgetful && (exists($memory->{$param}) || defined $self->param($param))); | ||||||
429 | foreach $value (@values) { $value =~ s/\\(.)/$1/go } #unescape meta-characters | ||||||
430 | $self->param($param,@values); | ||||||
431 | $self->{'.memory'}->{$param}=1 if ($isforgetful); | ||||||
432 | } | ||||||
433 | } | ||||||
434 | } | ||||||
435 | |||||||
436 | |||||||
437 | #The encipher subroutine accepts a list of values to encrypt and writes them to | ||||||
438 | #the state file. If the list of values is empty, it merely updates the timestamp | ||||||
439 | #of the state file. | ||||||
440 | sub encipher | ||||||
441 | { | ||||||
442 | my ($self, $buffer) = @_; | ||||||
443 | my ($cipher, $statefile) = @$self{'.cipher','.statefile'}; | ||||||
444 | my ($length, $time, $block); | ||||||
445 | $time=pack("N",time()); | ||||||
446 | |||||||
447 | # Open the target file and die with warnings if necessary | ||||||
448 | my $open_flags = $buffer ? (O_WRONLY | O_TRUNC | O_CREAT) : (O_RDWR | O_CREAT); | ||||||
449 | if ($AVOID_SYMLINKS && -l $statefile) { $self->errormsg('symlink encountered') } | ||||||
450 | sysopen(STATEFILE, $statefile, $open_flags, 0600 ) or $self->errormsg('failed to open the state file'); | ||||||
451 | if ($USE_FLOCK && !flock(STATEFILE, LOCK_EX)) { $self->errormsg('failed to lock the state file') } | ||||||
452 | binmode STATEFILE; | ||||||
453 | |||||||
454 | #if we've got nothing to write, only update the timestamp | ||||||
455 | unless ($buffer) { | ||||||
456 | if (sysread(STATEFILE,$buffer,16)==16) { | ||||||
457 | #the length of the encrypted data is stored in the first four bytes of the state file | ||||||
458 | $length=substr($cipher->decrypt(substr($buffer,0,8)),0,4); | ||||||
459 | $buffer=$length.($time^substr($buffer,12,4)); | ||||||
460 | } else { | ||||||
461 | $length=pack("N",0); | ||||||
462 | $buffer=$length.$time; | ||||||
463 | } | ||||||
464 | sysseek(STATEFILE,0,$SEEK_SET); | ||||||
465 | syswrite(STATEFILE,$cipher->encrypt($buffer)); | ||||||
466 | } | ||||||
467 | else { | ||||||
468 | #add metadata to the beginning of the plaintext | ||||||
469 | $length=length($buffer); | ||||||
470 | $buffer=pack("N",$length).$time.$buffer; | ||||||
471 | |||||||
472 | #pad the buffer to have a length that is divisible by 8 | ||||||
473 | if ($length%=8) { | ||||||
474 | $length=8-$length; | ||||||
475 | $buffer.=chr(int(rand(256))) while ($length--); | ||||||
476 | } | ||||||
477 | |||||||
478 | #encrypt in reverse-CBC mode | ||||||
479 | $block=$cipher->encrypt(substr($buffer,-8,8)); | ||||||
480 | substr($buffer,-8,8,$block); | ||||||
481 | |||||||
482 | $length=length($buffer) - 8; | ||||||
483 | while(($length-=8)>-8) { | ||||||
484 | $block^=substr($buffer,$length,8); | ||||||
485 | $block=$cipher->encrypt($block); | ||||||
486 | substr($buffer,$length,8,$block); | ||||||
487 | } | ||||||
488 | |||||||
489 | #blast it to the file | ||||||
490 | syswrite(STATEFILE,$buffer); | ||||||
491 | } | ||||||
492 | if ($USE_FLOCK) { flock(STATEFILE, LOCK_UN) || $self->errormsg('failed to unlock the state file') } | ||||||
493 | close(STATEFILE) || $self->errormsg('failed to close the state file'); | ||||||
494 | } | ||||||
495 | |||||||
496 | |||||||
497 | sub decipher | ||||||
498 | { | ||||||
499 | my $self = shift; | ||||||
500 | my ($cipher,$statefile) = @$self{'.cipher','.statefile'}; | ||||||
501 | my ($length,$extra,$decoded,$buffer,$block); | ||||||
502 | |||||||
503 | if ($AVOID_SYMLINKS) { -l $statefile and $self->errormsg('symlink encountered')} | ||||||
504 | sysopen(STATEFILE,$statefile, O_RDONLY) || $self->errormsg('failed to open the state file'); | ||||||
505 | if ($USE_FLOCK) { flock(STATEFILE, LOCK_SH) || $self->errormsg('failed to lock the state file') } | ||||||
506 | binmode STATEFILE; | ||||||
507 | |||||||
508 | #read metadata | ||||||
509 | sysread(STATEFILE,$block,8); | ||||||
510 | $block = $cipher->decrypt($block); | ||||||
511 | |||||||
512 | #if there is nothing in the file, only set the age; otherwise read the contents | ||||||
513 | unless (sysread(STATEFILE,$buffer,8)==8) { | ||||||
514 | $self->{'.age'} = unpack("N",substr($block,4,4)); | ||||||
515 | $buffer = ""; | ||||||
516 | } else { | ||||||
517 | #parse metadata | ||||||
518 | $block^=$buffer; | ||||||
519 | $self->{'.age'} = unpack("N",substr($block,4,4)); | ||||||
520 | $length = unpack("N",substr($block,0,4)); | ||||||
521 | $extra = ($length % 8) ? (8-($length % 8)) : 0; | ||||||
522 | $decoded=-8; | ||||||
523 | |||||||
524 | #sanity check | ||||||
525 | if ((stat(STATEFILE))[7] != ($length+$extra+8)) | ||||||
526 | { $self->errormsg('invalid state file') } | ||||||
527 | |||||||
528 | #read the rest of the file | ||||||
529 | sysseek(STATEFILE, 8, $SEEK_SET); | ||||||
530 | unless (sysread(STATEFILE,$buffer,$length+$extra) == ($length+$extra)) | ||||||
531 | { $self->errormsg('invalid state file') } | ||||||
532 | |||||||
533 | my $next_block; | ||||||
534 | $block = $cipher->decrypt(substr($buffer,0,8)); | ||||||
535 | #decrypt it | ||||||
536 | while (($decoded+=8)<$length-8) { | ||||||
537 | $next_block = substr($buffer,$decoded+8,8); | ||||||
538 | $block^=$next_block; | ||||||
539 | substr($buffer, $decoded, 8, $block); | ||||||
540 | $block=$cipher->decrypt($next_block); | ||||||
541 | } | ||||||
542 | substr($buffer, $decoded, 8, $block); | ||||||
543 | substr($buffer, -$extra, $extra, ""); | ||||||
544 | |||||||
545 | } | ||||||
546 | if ($USE_FLOCK) { flock(STATEFILE, LOCK_UN) || $self->errormsg('failed to unlock the state file') } | ||||||
547 | close(STATEFILE) || $self->errormsg('failed to close the state file'); | ||||||
548 | |||||||
549 | return($buffer); | ||||||
550 | } | ||||||
551 | END_OF_FUNCTIONS | ||||||
552 | ; | ||||||
553 | 3 | 50 | 33 | 3 | 0 | 321 | eval(($]<5.006) ? $subs : "use bytes; $subs"); |
3 | 50 | 33 | 12 | 0 | 3803 | ||
3 | 50 | 33 | 21 | 0 | 112 | ||
3 | 50 | 33 | 4 | 0 | 153 | ||
12 | 50 | 66 | 12 | 0 | 21 | ||
12 | 50 | 75 | 19 | 26 | |||
12 | 50 | 66 | 17 | ||||
12 | 50 | 27 | |||||
12 | 50 | 176 | |||||
12 | 100 | 338 | |||||
12 | 50 | 32 | |||||
12 | 50 | 83 | |||||
12 | 50 | 20 | |||||
12 | 100 | 75 | |||||
12 | 50 | 42 | |||||
12 | 50 | 451 | |||||
2 | 50 | 14 | |||||
2 | 50 | 5 | |||||
10 | 50 | 21 | |||||
10 | 100 | 41 | |||||
10 | 50 | 23 | |||||
10 | 50 | 31 | |||||
10 | 50 | 15 | |||||
10 | 100 | 124 | |||||
0 | 50 | 0 | |||||
10 | 50 | 45 | |||||
10 | 100 | 69 | |||||
0 | 100 | 0 | |||||
10 | 100 | 13 | |||||
10 | 100 | 38 | |||||
10 | 50 | 335 | |||||
76 | 100 | 2267 | |||||
76 | 93 | ||||||
76 | 94 | ||||||
76 | 199 | ||||||
10 | 293 | ||||||
10 | 26 | ||||||
12 | 28 | ||||||
12 | 92 | ||||||
12 | 126 | ||||||
12 | 106 | ||||||
21 | 36 | ||||||
21 | 45 | ||||||
21 | 27 | ||||||
21 | 56 | ||||||
21 | 46 | ||||||
21 | 459 | ||||||
0 | 0 | ||||||
21 | 1585 | ||||||
21 | 471 | ||||||
0 | 0 | ||||||
21 | 45 | ||||||
21 | 46 | ||||||
2 | 57 | ||||||
0 | 0 | ||||||
0 | 0 | ||||||
2 | 8 | ||||||
2 | 5 | ||||||
2 | 10 | ||||||
2 | 11 | ||||||
19 | 23 | ||||||
19 | 55 | ||||||
19 | 77 | ||||||
19 | 30 | ||||||
19 | 148 | ||||||
19 | 95 | ||||||
19 | 675 | ||||||
19 | 31 | ||||||
19 | 46 | ||||||
134 | 204 | ||||||
134 | 329 | ||||||
134 | 3942 | ||||||
19 | 630 | ||||||
21 | 219 | ||||||
21 | 150 | ||||||
21 | 351 | ||||||
4 | 15 | ||||||
7 | 26 | ||||||
12 | 2897 | ||||||
12 | 17 | ||||||
12 | 32 | ||||||
12 | 43 | ||||||
12 | 446 | ||||||
12 | 40 | ||||||
10 | 46 | ||||||
10 | 45 | ||||||
10 | 16 | ||||||
10 | 34 | ||||||
0 | 0 | ||||||
10 | 34 | ||||||
15 | 48 | ||||||
15 | 53 | ||||||
15 | 60 | ||||||
15 | 231 | ||||||
21 | 64 | ||||||
15 | 45 | ||||||
15 | 1181 | ||||||
19 | 32 | ||||||
19 | 24 | ||||||
19 | 45 | ||||||
19 | 48 | ||||||
35 | 700 | ||||||
27 | 123 | ||||||
21 | 60 | ||||||
21 | 931 | ||||||
51 | 152 | ||||||
21 | 73 | ||||||
19 | 228 | ||||||
19 | 75 | ||||||
554 | } | ||||||
555 | |||||||
556 | "True Value"; | ||||||
557 | |||||||
558 | =head1 NAME | ||||||
559 | |||||||
560 | CGI::SecureState -- Transparent, secure statefulness for CGI programs | ||||||
561 | |||||||
562 | =head1 SYNOPSIS | ||||||
563 | |||||||
564 | use CGI::SecureState; | ||||||
565 | |||||||
566 | my @memory = qw(param1 param2 other_params_to_remember); | ||||||
567 | my $cgi = new CGI::SecureState(-stateDir => "states", | ||||||
568 | -mindSet => 'forgetful', | ||||||
569 | -memory => \@memory); | ||||||
570 | |||||||
571 | print $cgi->header(), $cgi->start_html; | ||||||
572 | my $url = $cgi->state_url(); | ||||||
573 | my $param = $cgi->state_param(); | ||||||
574 | print "I am a stateful CGI session."; | ||||||
575 | print "I am a different ", | ||||||
576 | "script that also has access to this session."; | ||||||
577 | |||||||
578 | |||||||
579 | =head2 Very Important Note for Users of CGI::SecureState 0.2x | ||||||
580 | |||||||
581 | For those still using the 0.2x series, CGI::SecureState changed enormously between | ||||||
582 | 0.26 and 0.30. Specifically, the addition of mindsets is so important that if you | ||||||
583 | run your old scripts unchanged under CGI::SecureState 0.3x, you will receive nasty | ||||||
584 | warnings (likely both in output web pages and your log files) that will tell you not | ||||||
585 | to do so. Please do yourself a favor by re-reading this documentation, as this | ||||||
586 | mysterious mindset business (as well as all the scrumptious new features) will be | ||||||
587 | made clear. | ||||||
588 | |||||||
589 | Of course, any and all comments on the changes are welcome. If you are interested, | ||||||
590 | send mail to behroozi@cpan.org with the subject "CGI::SecureState Comment". | ||||||
591 | |||||||
592 | |||||||
593 | =head1 DESCRIPTION | ||||||
594 | |||||||
595 | A Better Solution to the stateless problem. | ||||||
596 | |||||||
597 | HTTP is by nature a stateless protocol; as soon as the requested object is | ||||||
598 | delivered, HTTP severs the object's connection to the client. HTTP retains no | ||||||
599 | memory of the request details and does not relate subsequent requests with what | ||||||
600 | it has already served. | ||||||
601 | |||||||
602 | There are a few methods available to deal with this problem, including forms | ||||||
603 | and cookies, but most have problems themselves, including security issues | ||||||
604 | (cookie stealing), browser support (cookie blocking), and painful | ||||||
605 | implementations (forms). | ||||||
606 | |||||||
607 | CGI::SecureState solves this problem by storing session data in an encrypted | ||||||
608 | state file on the server. CGI::SecureState is similar in purpose to CGI::Persistent | ||||||
609 | (and retains much of the same user interface) but has a completely different | ||||||
610 | implementation. For those of you who have worked with CGI::Persistent before, | ||||||
611 | you will be pleased to learn that CGI::SecureState was designed to work with Perl's | ||||||
612 | taint mode and has worked flawlessly with mod_perl and Apache::Registry for over | ||||||
613 | two years. CGI::SecureState was also designed from the ground up for security, a | ||||||
614 | fact which may rear its ugly head if anybody tries to do something tricksy. | ||||||
615 | |||||||
616 | |||||||
617 | =head1 MINDSETS | ||||||
618 | |||||||
619 | If you were curious about the mindset business mentioned earlier, this section | ||||||
620 | is for you. In the past, CGI::SecureState had only one behavior (which I like | ||||||
621 | to call a mindset), which was to store all the CGI parameters that the client | ||||||
622 | sent to it. Besides bloating session files, this mindset encouraged all sorts of | ||||||
623 | insidious bugs where parameters saved by one script would lurk in the state file | ||||||
624 | and cause problems for scripts down the line. | ||||||
625 | |||||||
626 | If you could tell CGI::SecureState exactly which parameters to save, then life | ||||||
627 | would get much better. This is exactly what the shiny new "forgetful" mindset | ||||||
628 | does, as it will only store parameters that are I |
||||||
629 | old behavior remains, slightly modified, in the form of the "unforgetful" mindset, | ||||||
630 | which will cause CGI::SecureState to save (and recall) all parameters passed to | ||||||
631 | the script I |
||||||
632 | |||||||
633 | You may wonder why "memory" is in quotes. The answer is simple: you pass | ||||||
634 | the "memory" to the CGI::SecureState object when it is initialized. So, to | ||||||
635 | have a script that remembers everything except the parameters "foo" and "bar", | ||||||
636 | do | ||||||
637 | |||||||
638 | my $cgi = new CGI::SecureState(-mindSet => 'unforgetful', | ||||||
639 | -memory => [qw(foo bar)]); | ||||||
640 | |||||||
641 | but to have a script that forgets everything except the parameters "user" and | ||||||
642 | "pass", you would do instead | ||||||
643 | |||||||
644 | my $cgi = new CGI::SecureState(-mindSet => 'forgetful', | ||||||
645 | -memory => [qw(user pass)]); | ||||||
646 | |||||||
647 | Simple, really. In accord with the mindset of Perl, which is that methods should | ||||||
648 | Do the Right Thing, the "forgetful" mindset will remember parameters when you | ||||||
649 | tell it to, and not forget them until you force it to do so. This means | ||||||
650 | that if you have a script to handle logins, like | ||||||
651 | |||||||
652 | my $cgi = new CGI::SecureState(-mindSet => 'forgetful', | ||||||
653 | -memory => [qw(user pass)]); | ||||||
654 | |||||||
655 | then other scripts do not have to re-memorize the "user" and "pass" parameters; | ||||||
656 | a mere | ||||||
657 | |||||||
658 | my $cgi = new CGI::SecureState(-mindSet => 'forgetful'); | ||||||
659 | my ($user,$pass) = ($cgi->param('user'),$cgi->param('pass')); | ||||||
660 | |||||||
661 | would suffice. However, had you read the rest of the documentation, that last line | ||||||
662 | could even have been | ||||||
663 | |||||||
664 | my ($user,$pass) = $cgi->params('user','pass'); | ||||||
665 | |||||||
666 | Once you all see how more intuitive this new mindset is, I am sure that you | ||||||
667 | will make the switch, but, in the meantime, the "unforgetful" mindset remains. | ||||||
668 | |||||||
669 | One more note about mindsets. In order to retain compatibility with older | ||||||
670 | scripts, the "unforgetful" mindset will allow CGI parameters received from | ||||||
671 | a client to overwrite previously saved parameters on disk. The new | ||||||
672 | "forgetful" mindset discards parameters from clients if they already exist | ||||||
673 | on disk. If you want to instead look at what the client sent you, then | ||||||
674 | look at the section entitled "Recent Memory". | ||||||
675 | |||||||
676 | |||||||
677 | |||||||
678 | =head1 RECENT MEMORY | ||||||
679 | |||||||
680 | Most of you know that we as humans have two types of memory: short term | ||||||
681 | and long term. Short term memory is useful if you only need the information | ||||||
682 | for a short while and can then forget it (as in studying before a final exam). | ||||||
683 | Long term memory is useful for things that stick around, like knowing how to | ||||||
684 | ride a bicycle. | ||||||
685 | |||||||
686 | There are also two types of persistent data that a CGI application needs to store. | ||||||
687 | The first type covers data that is used a few times and then forgotten, such as | ||||||
688 | parameters passed to a search engine that displays its results over multiple pages | ||||||
689 | (known as page-state). The second type covers data that is mostly static throughout | ||||||
690 | the application, like a username and password (known as application-state). | ||||||
691 | Coincidence? Perhaps. | ||||||
692 | |||||||
693 | Fortunately, CGI::SecureState now supports both. For purely short term data, | ||||||
694 | you can use the user_* functions to replace the ones you would normally use. | ||||||
695 | The user_* functions are so named to remind you that parameters that the user | ||||||
696 | passes will override corresponding parameters already in short term memory. An | ||||||
697 | extra feature is that they will fall back to the normal functions (param(), etc.) | ||||||
698 | if you are requesting a parameter that is not in short term memory. | ||||||
699 | |||||||
700 | This means that you can now say: | ||||||
701 | |||||||
702 | my $cgi = new CGI::SecureState(-mindSet => 'forgetful', | ||||||
703 | -shortTerm => [qw(query type)]); | ||||||
704 | |||||||
705 | my ($query, $type) = $cgi->user_params(qw(query type)); | ||||||
706 | my $next_page_url = $cgi->memory_as('url').";page=2"; | ||||||
707 | |||||||
708 | and things will work out nicely. Now, you could have used long term memory | ||||||
709 | to do the same thing, but you would be in for a nasty shock when the back button | ||||||
710 | failed to work properly. For example, returning to the search engine, suppose | ||||||
711 | a user searched for "marzipan" and then for "eggs". Realizing that marzipan | ||||||
712 | is the more essential ingredient, the user backs up until he gets to the marzipan | ||||||
713 | results and presses the "Next Page" link. Since the state file would store only | ||||||
714 | the most recent search, the user recoils in horror as the "Next Page" is not filled | ||||||
715 | with succulent almond pastries but instead white quasi-elliptical spheroids. | ||||||
716 | Temporary memory does not have this problem, as it is not stored in the state file | ||||||
717 | but tacked on as a special parameter list or a special sequence of hidden input fields | ||||||
718 | when you use the memory_as() function. The only downside is, of course, that the | ||||||
719 | temporary memory is not encrypted. This may be fixed in a future release of | ||||||
720 | CGI::SecureState, but for now you will have to restrict sensitive information to | ||||||
721 | long term memory only. | ||||||
722 | |||||||
723 | |||||||
724 | =head1 METHODS | ||||||
725 | |||||||
726 | After that lecture on script design, I am sure that you are hungering to know how | ||||||
727 | to actually use this module. You will not be disappointed. CGI::SecureState inherits | ||||||
728 | its methods from CGI.pm, overriding them as necessary: | ||||||
729 | |||||||
730 | =over 4 | ||||||
731 | |||||||
732 | =item B |
||||||
733 | |||||||
734 | Creates a new CGI object and creates an associated encrypted state file if | ||||||
735 | one does not already exist. new() has exactly one required argument (the mindset, | ||||||
736 | of course!), and takes four optional arguments: | ||||||
737 | |||||||
738 | =over 2 | ||||||
739 | |||||||
740 | =item -mindSet | ||||||
741 | |||||||
742 | If the mindset is not specified, then CGI::SecureState will spit out nasty warnings until you | ||||||
743 | change your scripts or set $CGI::SecureState::NASTY_WARNINGS to 0. | ||||||
744 | |||||||
745 | The mindset may be specified in a few different ways, the most common being | ||||||
746 | to spell out 'forgetful' or 'unforgetful'. If it pleases you, you may also | ||||||
747 | use '1' to specify forgetfulness, and '0' to specify unforgetfulness. | ||||||
748 | |||||||
749 | =item -memory | ||||||
750 | |||||||
751 | These are the parameters that you either want to persist between sessions | ||||||
752 | (if you have a forgetful mindset), or those that you do not want to do so | ||||||
753 | (if you have an unforgetful mindset). You may pass these parameters as a | ||||||
754 | reference to an array. If you prefer the aliases "-longTerm" or "-longterm", | ||||||
755 | you may use one of those instead. | ||||||
756 | |||||||
757 | =item -shortTerm | ||||||
758 | |||||||
759 | Also taking an array reference, this argument specifies the parameters that | ||||||
760 | are not permanent enough for the state file but that you still want to keep | ||||||
761 | around for a few requests. If you prefer the alias "-temp", you may use that | ||||||
762 | instead. | ||||||
763 | |||||||
764 | =item -key | ||||||
765 | |||||||
766 | If you are concerned about the quality of the random data generated by | ||||||
767 | multiple calls to rand(), then you can pass some better data along with | ||||||
768 | this argument. | ||||||
769 | |||||||
770 | =item -errorSub | ||||||
771 | |||||||
772 | If you do not like the default error pages, then you may pass a reference to | ||||||
773 | a subroutine that prints them out how you like them. The subroutine should | ||||||
774 | print out a complete web page and include the "Content-Type" header. | ||||||
775 | The possible errors that can be caught by the subroutine are: | ||||||
776 | |||||||
777 | failed to open the state file | ||||||
778 | failed to lock the state file | ||||||
779 | failed to unlock the state file | ||||||
780 | failed to close the state file | ||||||
781 | failed to delete the state file | ||||||
782 | invalid state file | ||||||
783 | statefile inconsistent with mindset | ||||||
784 | symlink encountered | ||||||
785 | |||||||
786 | If the subroutine can handle the error, it should return a true value, | ||||||
787 | otherwise it should return false. | ||||||
788 | |||||||
789 | =back | ||||||
790 | |||||||
791 | |||||||
792 | Examples: | ||||||
793 | |||||||
794 | #forget everything but the "user" and "pass" params. | ||||||
795 | $cgi = new CGI::SecureState(-mindSet => 'forgetful', | ||||||
796 | -memory => [qw(user pass)]); | ||||||
797 | |||||||
798 | |||||||
799 | #invoke the old behavior of CGI::SecureState | ||||||
800 | $cgi = new CGI::SecureState(-mindSet => 'unforgetful'); | ||||||
801 | $cgi = new CGI::SecureState(-mindSet => 0); #same thing | ||||||
802 | |||||||
803 | #full listing | ||||||
804 | $cgi = new CGI::SecureState(-stateDir => $statedir, | ||||||
805 | -mindSet => $mindset, | ||||||
806 | -memory => \@memory, | ||||||
807 | -shortTerm => \@temp_memory, | ||||||
808 | -errorSub => \&errorSub, | ||||||
809 | -key => $key); | ||||||
810 | |||||||
811 | #if you don't like my capitalizations, then try | ||||||
812 | $cgi = new CGI::SecureState(-statedir => $statedir, | ||||||
813 | -mindset => $mindset, | ||||||
814 | -memory => \@memory, | ||||||
815 | -shortterm => \@temp_memory, | ||||||
816 | -errorsub => \&errorSub, | ||||||
817 | -key => $key); | ||||||
818 | |||||||
819 | #if you prefer the straight argument style (note absence of | ||||||
820 | #errorSub -- it is only supported with the new argument style) | ||||||
821 | $cgi = new CGI::SecureState($statedir, $mindset, \@memory, | ||||||
822 | \@temp_memory, $key); | ||||||
823 | |||||||
824 | #cause nasty warnings by not specifying the mindset | ||||||
825 | $cgi = new CGI::SecureState($statedir); | ||||||
826 | |||||||
827 | |||||||
828 | =item B |
||||||
829 | |||||||
830 | Returns the URL of the current script with the state identification string. | ||||||
831 | This URL should be used for referring to the stateful session associated with | ||||||
832 | the query. Do NOT use this as the action of a form; see the state_field() function | ||||||
833 | instead. Note that this does not include the short term memory; see the memory_as() | ||||||
834 | function to do that. | ||||||
835 | |||||||
836 | =item B |
||||||
837 | |||||||
838 | Returns a key-value pair that you can use to retain the session when linking | ||||||
839 | to other scripts. If, for example, you want the script "other.pl" to be able | ||||||
840 | to see your current script's session, you would use | ||||||
841 | |||||||
842 | print "state_param, | ||||||
843 | "\">Click Here!"; | ||||||
844 | |||||||
845 | to do so. Note that this does not include the short term memory; see the memory_as() | ||||||
846 | function to do that. | ||||||
847 | |||||||
848 | =item B |
||||||
849 | |||||||
850 | Returns a hidden INPUT type for inclusion in HTML forms. Like state_url(), | ||||||
851 | this element is used in forms to refer to the stateful session associated | ||||||
852 | with the query. Note that this does not include the short term memory; see the memory_as() | ||||||
853 | function to do that. | ||||||
854 | |||||||
855 | =item B |
||||||
856 | |||||||
857 | This allows you to get a state url/parameter/field with the short term memory | ||||||
858 | attached. So, for example, if you wanted to retain short term memory between | ||||||
859 | invocations of your script, you would write C<< $cgi->memory_as('url') >> instead of | ||||||
860 | C<< $cgi->state_url >>. You can also write C<< $cgi->memory_as('param') >> and | ||||||
861 | C<< $cgi->memory_as('field') >> instead of C<< $cgi->state_param >> and C<< $cgi->state_field >>. | ||||||
862 | |||||||
863 | =item B |
||||||
864 | |||||||
865 | Allows you to get the scalar values of multiple parameters at once. | ||||||
866 | |||||||
867 | my ($user,$pass) = $cgi->params(qw(user pass)); | ||||||
868 | |||||||
869 | is equivalent to | ||||||
870 | |||||||
871 | my ($user,$pass) = (scalar $cgi->param('user'), | ||||||
872 | scalar $cgi->param('pass')); | ||||||
873 | |||||||
874 | |||||||
875 | =item B |
||||||
876 | |||||||
877 | Allows you to get (and set) a parameter in short term memory. If it cannot | ||||||
878 | find the parameter you want to retrieve in short term memory, it will fall | ||||||
879 | back to the normal param() call to get it for you. Setting parameters via | ||||||
880 | this function will automatically add them to short term memory if they do | ||||||
881 | not already exist. The interface is exactly the same as that of the ordinary | ||||||
882 | param() call, except you can set more than one parameter at a time by passing | ||||||
883 | names of parameters followed by array references, as you can with add(). | ||||||
884 | |||||||
885 | |||||||
886 | =item B |
||||||
887 | |||||||
888 | This function is analogous to params() except that it uses user_param() instead | ||||||
889 | of param() to fetch multiple values for you. | ||||||
890 | |||||||
891 | |||||||
892 | =item B |
||||||
893 | |||||||
894 | This command adds a new parameter to the CGI object and stores it to disk. | ||||||
895 | Use this command if you want something to be saved, since the param() method | ||||||
896 | will only temporarily set a parameter. add() uses the same syntax as param(), | ||||||
897 | but you may also add more than one parameter at once if the values are in a | ||||||
898 | reference to an array: | ||||||
899 | |||||||
900 | $cgi->add(param_a => ['value'], param_b => ['value1', 'value2']); | ||||||
901 | |||||||
902 | |||||||
903 | |||||||
904 | =item B |
||||||
905 | |||||||
906 | This command is similar to add(), but saves current parameters to disk instead | ||||||
907 | of new ones. For example, if "foo" and "bar" were passed in by the user and | ||||||
908 | were not previously stored on disk, | ||||||
909 | |||||||
910 | $cgi->remember('foo','bar'); | ||||||
911 | |||||||
912 | will save their values to the state file. Use the add() method instead if you | ||||||
913 | also want to set a new value for the parameter. | ||||||
914 | |||||||
915 | |||||||
916 | |||||||
917 | =item B |
||||||
918 | |||||||
919 | delete() is an overridden method that deletes named attributes from the | ||||||
920 | query. The state file on disk is updated to reflect the removal of | ||||||
921 | the parameter. Note that this has changed to accept a list of params to | ||||||
922 | delete because otherwise the state file would be separately rewritten for | ||||||
923 | each delete(). | ||||||
924 | |||||||
925 | Important note: Attributes that are NOT explicitly delete()ed will lurk | ||||||
926 | about and come back to haunt you unless you use the 'forgetful' mindset! | ||||||
927 | |||||||
928 | |||||||
929 | =item B |
||||||
930 | |||||||
931 | This function deletes values only from the short term memory, and has the | ||||||
932 | same syntax as the overridden delete(). | ||||||
933 | |||||||
934 | |||||||
935 | =item B |
||||||
936 | |||||||
937 | This command toasts all the current cgi parameters, but it merely clears | ||||||
938 | the state file instead of deleting it. For that, use delete_session() instead. | ||||||
939 | |||||||
940 | |||||||
941 | =item B |
||||||
942 | |||||||
943 | This command not only deletes all the cgi parameters, but kills the | ||||||
944 | disk image of the session as well. This method should be used when you | ||||||
945 | want to irrevocably destroy a session. | ||||||
946 | |||||||
947 | |||||||
948 | =item B |
||||||
949 | |||||||
950 | This returns the time in days since the session was last accessed. | ||||||
951 | |||||||
952 | |||||||
953 | =item B |
||||||
954 | |||||||
955 | Over time, if you are not careful, a buildup of stale state files may occur. | ||||||
956 | You should use this call to clean them up, especially in logout scripts or cron | ||||||
957 | jobs, where performance is not the most critical issue. This function optionally | ||||||
958 | takes two arguments: a maximum idle time (in days) beyond which state files are deleted, | ||||||
959 | and a directory to clean. The default behavior is to clean the current state directory | ||||||
960 | of any state files that have been idle for more than an hour. You may also name the | ||||||
961 | arguments using the '-age' and '-directory' attributes if you want to specify things | ||||||
962 | out-of-order (like C<$cgi->clean_statedir(-directory => "foo", -age => 1/2);>). | ||||||
963 | |||||||
964 | =back | ||||||
965 | |||||||
966 | |||||||
967 | =head1 GLOBALS | ||||||
968 | |||||||
969 | You may set these options to globally affect the behavior of CGI::SecureState. | ||||||
970 | |||||||
971 | =over 4 | ||||||
972 | |||||||
973 | =item B |
||||||
974 | |||||||
975 | Set this to 0 if you want warnings about deprecated behavior to be suppressed. | ||||||
976 | This is especially true if you want to be left in peace while updating scripts based | ||||||
977 | on older versions of CGI::SecureState. However, the warnings issued should be heeded | ||||||
978 | because they generally result in better coding style and program security. | ||||||
979 | |||||||
980 | You may either do | ||||||
981 | use CGI::SecureState qw(:no_nasty_warnings); #or | ||||||
982 | $CGI::SecureState::NASTY_WARNINGS = 0; | ||||||
983 | |||||||
984 | |||||||
985 | =item B |
||||||
986 | |||||||
987 | Set this to 0 if you don't want CGI::SecureState to test for the presence of a symlink | ||||||
988 | before writing to a state file. If this is set to 1 and CGI::SecureState sees a | ||||||
989 | symlink in place of a real file, it will spit out a fatal error. It is generally | ||||||
990 | a good idea to keep this in place, but if you have a good reason to, then do | ||||||
991 | use CGI::SecureState qw(:dont_avoid_symlinks); #or | ||||||
992 | $CGI::SecureState::AVOID_SYMLINKS = 1; | ||||||
993 | |||||||
994 | |||||||
995 | =item B |
||||||
996 | |||||||
997 | Set this to 0 if you do not want CGI::SecureState to use "flock" to assure that | ||||||
998 | only one instance of CGI::SecureState is accessing the state file at a time. | ||||||
999 | Leave this at 1 unless you really have a good reason not to. | ||||||
1000 | |||||||
1001 | For users running a version of Windows NT (including 2000 and XP), you should set | ||||||
1002 | this variable to 1 because $^O will always report "MSWin32", regardless of whether | ||||||
1003 | your system is Win9x (which does not support flock) or WinNT (which does). | ||||||
1004 | |||||||
1005 | To set to 0, do | ||||||
1006 | use CGI::SecureState qw(:no_flock); #or | ||||||
1007 | $CGI::SecureState::USE_FLOCK = 0; | ||||||
1008 | |||||||
1009 | To set to 1, do | ||||||
1010 | use CGI::SecureState qw(:use_flock); #or | ||||||
1011 | $CGI::SecureState::USE_FLOCK = 1; | ||||||
1012 | |||||||
1013 | |||||||
1014 | =item B |
||||||
1015 | |||||||
1016 | If the standard security is not enough, CGI::SecureState provides extra security | ||||||
1017 | by setting the appropriate options in CGI.pm. The ":extra_security" option | ||||||
1018 | enables private file uploads and sets the maximum size for a CGI POST to be | ||||||
1019 | 10 kilobytes. The ":paranoid_security" option disables file uploads entirely. | ||||||
1020 | To use them, do | ||||||
1021 | use CGI::SecureState qw(:extra_security); #or | ||||||
1022 | use CGI::SecureState qw(:paranoid_security); | ||||||
1023 | |||||||
1024 | To disable them, do | ||||||
1025 | use CGI::SecureState qw(:no_security); | ||||||
1026 | =back | ||||||
1027 | |||||||
1028 | |||||||
1029 | =head1 EXAMPLES | ||||||
1030 | |||||||
1031 | There is now an official example of how to use CGI::SecureState in a large | ||||||
1032 | project. If that is what you are looking for, check out the Anthill | ||||||
1033 | Bug Manager at Sourceforge (L |
||||||
1034 | |||||||
1035 | |||||||
1036 | This example is a simple log-in script. It should have a directory called "states" | ||||||
1037 | that it can write to. | ||||||
1038 | |||||||
1039 | #!/usr/bin/perl -wT | ||||||
1040 | use CGI::SecureState qw(:paranoid_security); | ||||||
1041 | |||||||
1042 | my $cgi = new CGI::SecureState(-stateDir => 'states', | ||||||
1043 | -mindSet => 'forgetful'); | ||||||
1044 | |||||||
1045 | my ($user,$pass,$lo)=$cgi->params(qw(user pass logout)); | ||||||
1046 | my $failtime = $cgi->param('failtime') || 0; | ||||||
1047 | |||||||
1048 | print $cgi->header(); | ||||||
1049 | $cgi->start_html(-title => "CGI::SecureState Example"); | ||||||
1050 | |||||||
1051 | if ($user ne 'Cottleston' || $pass ne 'Pie') { | ||||||
1052 | if (defined $user) { | ||||||
1053 | $failtime+=$cgi->age()*86400; | ||||||
1054 | print "Incorrect Username/Password. It took you only ", | ||||||
1055 | $cgi->age*86400, " seconds to fail this time."; | ||||||
1056 | print " It has been $failtime seconds since you started."; | ||||||
1057 | $cgi->add(failtime => $failtime); | ||||||
1058 | } | ||||||
1059 | print $cgi->start_form(-action => $cgi->url()); | ||||||
1060 | print $cgi->state_field(); | ||||||
1061 | print "\nUsername: ", $cgi->textfield("user"); | ||||||
1062 | print "\n Password: ", $cgi->password_field("pass"); |
||||||
1063 | print " ",$cgi->submit("Login"),$cgi->reset; |
||||||
1064 | print $cgi->end_form; | ||||||
1065 | } elsif (! defined $lo) { | ||||||
1066 | print "You logged in!\n "; |
||||||
1067 | print "Click url,"?",$cgi->state_param; | ||||||
1068 | print ";logout=true\">here to logout."; | ||||||
1069 | $cgi->remember('user','pass'); | ||||||
1070 | } else { | ||||||
1071 | print "You have logged out."; | ||||||
1072 | $cgi->delete_session; | ||||||
1073 | } | ||||||
1074 | print $cgi->end_html; | ||||||
1075 | |||||||
1076 | This example will show a form that will tell you what what previously | ||||||
1077 | entered. It should have a directory called "states" that it can write to. | ||||||
1078 | |||||||
1079 | |||||||
1080 | #!/usr/bin/perl -wT | ||||||
1081 | use CGI::SecureState qw(:paranoid_security); | ||||||
1082 | |||||||
1083 | my $cgi = new CGI::SecureState(-stateDir => 'states', | ||||||
1084 | -mindSet => 'unforgetful'); | ||||||
1085 | print $cgi->header(); | ||||||
1086 | $cgi->start_html(-title => "CGI::SecureState test", | ||||||
1087 | -bgcolor => "white"); | ||||||
1088 | print $cgi->start_form(-action => $cgi->url()); | ||||||
1089 | print $cgi->state_field(); | ||||||
1090 | print "\nEnter some text: "; | ||||||
1091 | print $cgi->textfield("input",""); | ||||||
1092 | print " ",$cgi->submit,$cgi->reset; |
||||||
1093 | print $cgi->end_form; | ||||||
1094 | print "\n "; |
||||||
1095 | |||||||
1096 | unless (defined $cgi->param('num_inputs')) { | ||||||
1097 | $cgi->add('num_inputs' => '1'); | ||||||
1098 | } | ||||||
1099 | else { | ||||||
1100 | $cgi->add('num_inputs' => ($cgi->param('num_inputs')+1)); | ||||||
1101 | } | ||||||
1102 | $cgi->add('input'.$cgi->param('num_inputs') => | ||||||
1103 | $cgi->param('input')); | ||||||
1104 | $cgi->delete('input'); | ||||||
1105 | |||||||
1106 | foreach ($cgi->param()) { | ||||||
1107 | print "\n $_ -> ",$cgi->param($_) if (/input/); |
||||||
1108 | } | ||||||
1109 | print $cgi->end_html; | ||||||
1110 | |||||||
1111 | |||||||
1112 | This example is a cron job that cleans up old state files in the directories | ||||||
1113 | F and F: | ||||||
1114 | |||||||
1115 | #!/usr/bin/perl -w | ||||||
1116 | use CGI::SecureState; | ||||||
1117 | |||||||
1118 | $cgi = new CGI::SecureState(-mindSet => 'forgetful', | ||||||
1119 | -stateDir => '/var/www/perl/states'); | ||||||
1120 | $cgi->cleanup_states; | ||||||
1121 | $cgi->cleanup_states(-directory => '/var/www/cgi-bin/states'); | ||||||
1122 | $cgi->delete_session; | ||||||
1123 | |||||||
1124 | |||||||
1125 | =head1 BUGS | ||||||
1126 | |||||||
1127 | There are B |
||||||
1128 | of the limitations section. | ||||||
1129 | |||||||
1130 | If you do find a bug, you should send it immediately to | ||||||
1131 | behroozi@cpan.org with the subject "CGI::SecureState Bug". | ||||||
1132 | I am I |
||||||
1133 | that an example actually works before sending it. It is merely acceptable | ||||||
1134 | if you send me a bug report, it is better if you send a small | ||||||
1135 | chunk of code that points it out, and it is best if you send a patch--if | ||||||
1136 | the patch is good, you might see a release the next day on CPAN. | ||||||
1137 | Otherwise, it could take weeks . . . | ||||||
1138 | |||||||
1139 | |||||||
1140 | |||||||
1141 | =head1 LIMITATIONS | ||||||
1142 | |||||||
1143 | Crypt::Blowfish is the only cipher that CGI::SecureState is using | ||||||
1144 | at the moment. Change at your own risk. | ||||||
1145 | |||||||
1146 | CGI.pm has a tendency to set default values for form input fields | ||||||
1147 | that CGI::SecureState does NOT override. If this becomes problematic, | ||||||
1148 | use the -override setting when calling things like hidden(). | ||||||
1149 | |||||||
1150 | Changes have been made so that saving/recovering Unicode now appears | ||||||
1151 | to work (with Perl 5.8.0). This is still not guaranteed to work; if | ||||||
1152 | you have reports of problems or solutions, please let me know. | ||||||
1153 | |||||||
1154 | As far as threading is concerned, CGI::SecureState (the actual module) | ||||||
1155 | is thread-safe as long as you provide it with an absolute path to the | ||||||
1156 | state file directory or if you do not change working directories in | ||||||
1157 | mid-stream. This does not mean that it is necessarily safe to use | ||||||
1158 | CGI::SecureState in an application with threads, as thread-safety may | ||||||
1159 | be compromised by either Crypt::Blowfish or Digest::SHA1. Check these | ||||||
1160 | modules to make sure that they are thread-safe before proceeding to | ||||||
1161 | use CGI::SecureState in an application with threads. | ||||||
1162 | |||||||
1163 | Until I can do more tests, assume that there is precisely zero | ||||||
1164 | support for either threading or unicode. If you would like to | ||||||
1165 | report your own results, send me a note and I will see what I | ||||||
1166 | can do about them. | ||||||
1167 | |||||||
1168 | Many previous limitations of CGI::SecureState have been | ||||||
1169 | removed in the 0.3x series. | ||||||
1170 | |||||||
1171 | |||||||
1172 | CGI::SecureState requires: | ||||||
1173 | |||||||
1174 | |||||||
1175 | Long file names (at least 27 chars): needed to ensure session | ||||||
1176 | authenticity. | ||||||
1177 | |||||||
1178 | |||||||
1179 | Crypt::Blowfish: it couldn't be called "Secure" without. At some point in | ||||||
1180 | the future, this requirement will be changed. Tested with versions 2.06, 2.09. | ||||||
1181 | |||||||
1182 | |||||||
1183 | Digest::SHA1: for super-strong (160 bit) hashing of data. It is used in | ||||||
1184 | key generation and filename generation. Tested with versions 1.03, 2.01. | ||||||
1185 | |||||||
1186 | |||||||
1187 | CGI.pm: it couldn't be called "CGI" without. Should not be a problem as it | ||||||
1188 | comes standard with Perl 5.004 and above. Tested with versions | ||||||
1189 | 2.56, 2.74, 2.79, 2.89. | ||||||
1190 | |||||||
1191 | Fcntl: for file flags that are portable (like LOCK_SH and LOCK_EX). Comes | ||||||
1192 | with Perl. Tested with version 1.03. | ||||||
1193 | |||||||
1194 | File::Spec: for concatenating directories and filenames in a portable way. | ||||||
1195 | Comes with Perl. Tested with version 0.82. | ||||||
1196 | |||||||
1197 | Perl: Hmmm. Tested with stable releases from v5.005_03 to v5.8.0. | ||||||
1198 | There may be several bugs induced by lower versions of Perl, | ||||||
1199 | which are not limited to the failure to compile, the failure to | ||||||
1200 | behave properly, or the mysterious absence of your favorite pair of | ||||||
1201 | lemming slippers. The author is exempt from wrongdoing and liability, | ||||||
1202 | especially if you decide to use CGI::SecureState with a version of Perl | ||||||
1203 | less than 5.005_03. | ||||||
1204 | |||||||
1205 | |||||||
1206 | =head1 SEE ALSO | ||||||
1207 | |||||||
1208 | CGI(3), CGI::Persistent(3) | ||||||
1209 | |||||||
1210 | =head1 AUTHORS | ||||||
1211 | |||||||
1212 | Peter Behroozi, behroozi@cpan.org | ||||||
1213 | |||||||
1214 | =cut |