| 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 |