File Coverage

blib/lib/Apache/SessionX.pm
Criterion Covered Total %
statement 51 228 22.3
branch 7 92 7.6
condition 2 41 4.8
subroutine 11 31 35.4
pod 5 14 35.7
total 76 406 18.7


line stmt bran cond sub pod time code
1             ###################################################################################
2             #
3             # Apache::SessionX - Copyright (c) 1999-2001 Gerald Richter / ecos gmbh
4             # Copyright(c) 1998, 1999 Jeffrey William Baker (jeffrey@kathyandjeffrey.net)
5             #
6             # You may distribute under the terms of either the GNU General Public
7             # License or the Artistic License, as specified in the Perl README file.
8             #
9             # THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
10             # IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
11             # WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
12             #
13             # $Id: SessionX.pm,v 1.4 2001/12/04 13:33:39 richter Exp $
14             #
15             ###################################################################################
16              
17              
18             package Apache::SessionX ;
19              
20 1     1   659 use strict;
  1         2  
  1         51  
21 1     1   5 use vars qw(@ISA $VERSION);
  1         3  
  1         92  
22              
23             $VERSION = '2.01';
24             @ISA = qw(Apache::Session);
25              
26 1     1   880 use Apache::Session;
  1         1835  
  1         31  
27 1     1   767 use Apache::SessionX::Config ;
  1         4  
  1         43  
28              
29 1     1   6 use constant NEW => Apache::Session::NEW () ;
  1         2  
  1         95  
30 1     1   5 use constant MODIFIED => Apache::Session::MODIFIED () ;
  1         1  
  1         45  
31 1     1   4 use constant DELETED => Apache::Session::DELETED () ;
  1         1  
  1         35  
32 1     1   5 use constant SYNCED => Apache::Session::SYNCED () ;
  1         3  
  1         2913  
33              
34              
35             sub TIEHASH {
36 2     2   552 my $class = shift;
37            
38 2         4 my $session_id = shift;
39 2   50     6 my $args = shift || {};
40              
41 2 50       9 if(ref $args ne "HASH")
42             {
43 0         0 die "Additional arguments should be in the form of a hash reference";
44             }
45              
46 2   33     6 my $config = $args -> {config} || $Apache::SessionX::Config::default;
47 2         14 foreach my $cfg (keys (%{$Apache::SessionX::Config::param{$config}}))
  2         10  
48             {
49 14 50       42 $args -> {$cfg} = $Apache::SessionX::Config::param{$config} -> {$cfg} if (!exists $args -> {$cfg}) ;
50             }
51            
52 2         26 my $self =
53             {
54             args => $args,
55             data => { _session_id => $session_id },
56             initial_session_id => $session_id,
57             lock => 0,
58             lock_manager => undef,
59             object_store => undef,
60             status => 0,
61             serialized => undef,
62             idfrom => $args -> {idfrom},
63             newid => $args -> {newid},
64             };
65            
66 2         6 bless $self, $class;
67              
68 2         7 $self -> require_modules ($args) ;
69              
70 0 0       0 $self -> init if (!$args -> {'lazy'}) ;
71              
72              
73 0         0 return $self ;
74             }
75              
76              
77             sub require_modules
78             {
79 2     2 0 5 my $self = shift ;
80 2         3 my $args = shift ;
81              
82             # check object_store and lock_manager classes (Apache::Session 1.00)
83            
84 2         3 foreach my $mod ('Store', 'Lock', 'Generate', 'Serialize')
85             {
86 2 50       10 if ($args -> {$mod})
87             {
88 2 50       20 if (!($args -> {$mod} =~ /::/))
89             {
90 2         7 my $modname = "Apache::SessionX::$mod\:\:$args->{$mod}" ;
91 2         183 eval "require $modname" ;
92 2 50       12 if ($@)
93             {
94 2         3 $@ = '' ;
95 2         5 $modname = "Apache::Session::$mod\:\:$args->{$mod}" ;
96 2         100 eval "require $modname" ;
97             }
98              
99 2 50       1093 die "Cannot require $modname ($@)" if ($@) ;
100 0         0 $args->{$mod} = $modname ;
101             }
102             else
103             {
104 0         0 my $modname = $args->{$mod} ;
105 0         0 eval "require $modname" ;
106 0 0       0 die "Cannot require $modname" if ($@) ;
107             }
108             }
109             }
110             }
111              
112              
113              
114              
115              
116             sub init
117             {
118 0     0 0 0 my $self = shift ;
119              
120             #If a session ID was passed in, this is an old hash.
121             #If not, it is a fresh one.
122              
123 0         0 $self->populate;
124              
125 0         0 my $session_id = $self->{data}->{_session_id} ;
126              
127 0 0 0     0 if (!$session_id && $self -> {idfrom})
128             {
129 0         0 $session_id = $self->{data}->{_session_id} = &{$self->{generate}}($self, $self -> {idfrom}) ;
  0         0  
130             }
131              
132 0   0     0 $self->{initial_session_id} ||= $session_id ;
133              
134              
135 0 0 0     0 if (defined $session_id && $session_id)
136             {
137             #check the session ID for remote exploitation attempts
138             #this will die() on suspicious session IDs.
139              
140             #eval { &{$self->{validate}}($self); } ;
141 0         0 &{$self->{validate}}($self);
  0         0  
142             #if (!$@)
143             { # session id is ok
144              
145 0         0 $self->{status} &= ($self->{status} ^ NEW);
  0         0  
146              
147 0 0       0 if ($self -> {'args'}{'create_unknown'})
148             {
149 0         0 eval { $self -> restore } ;
  0         0  
150             #warn "Try to load session: $@" if ($@) ;
151 0         0 $@ = "" ;
152 0         0 $session_id = $self->{data}->{_session_id} ;
153             }
154             else
155             {
156 0         0 $self->restore;
157             }
158             }
159             }
160              
161 0         0 $@ = '' ;
162              
163 0 0       0 if (!($self->{status} & SYNCED))
164             {
165 0         0 $self->{status} |= NEW();
166 0 0 0     0 if (!$self->{data}->{_session_id} || $self -> {'args'}{'recreate_id'})
167             {
168 0 0       0 if (exists ($self->{generate}))
169             { # Apache::Session >= 1.50
170 0         0 $self->{data}->{_session_id} = &{$self->{generate}}($self) ;
  0         0  
171             }
172             else
173             {
174 0         0 $self->{data}->{_session_id} = $self -> generate_id() ;
175             }
176             }
177 0         0 $self->save;
178             }
179             else
180             {
181 0         0 $self -> {newidpending} = $self -> {newid} ;
182             }
183              
184            
185             #warn "Session INIT $self->{initial_session_id};$self->{data}->{_session_id};" ;
186              
187 0         0 return $self;
188             }
189              
190              
191              
192              
193              
194             sub FETCH {
195 0     0   0 my $self = shift;
196 0         0 my $key = shift;
197              
198 0 0       0 $self -> init if (!$self -> {'status'}) ;
199              
200 0         0 return $self->{data}->{$key};
201             }
202              
203             sub STORE {
204 0     0   0 my $self = shift;
205 0         0 my $key = shift;
206 0         0 my $value = shift;
207            
208 0 0       0 $self -> init if (!$self -> {'status'}) ;
209              
210 0         0 $self->{data}->{$key} = $value;
211            
212 0         0 $self->{status} |= MODIFIED;
213            
214 0         0 return $self->{data}->{$key};
215             }
216              
217             sub DELETE {
218 0     0   0 my $self = shift;
219 0         0 my $key = shift;
220            
221 0 0       0 $self -> init if (!$self -> {'status'}) ;
222              
223 0         0 $self->{status} |= MODIFIED;
224            
225 0         0 delete $self->{data}->{$key};
226             }
227              
228             sub CLEAR {
229 0     0   0 my $self = shift;
230              
231 0 0       0 $self -> init if (!$self -> {'status'}) ;
232              
233 0         0 $self->{status} |= MODIFIED;
234            
235 0         0 $self->{data} = {};
236             }
237              
238             sub EXISTS {
239 0     0   0 my $self = shift;
240 0         0 my $key = shift;
241            
242 0 0       0 $self -> init if (!$self -> {'status'}) ;
243              
244 0         0 return exists $self->{data}->{$key};
245             }
246              
247             sub FIRSTKEY {
248 0     0   0 my $self = shift;
249            
250 0 0       0 $self -> init if (!$self -> {'status'}) ;
251              
252 0         0 my $reset = keys %{$self->{data}};
  0         0  
253 0         0 return each %{$self->{data}};
  0         0  
254             }
255              
256             sub NEXTKEY {
257 0     0   0 my $self = shift;
258            
259 0 0       0 $self -> init if (!$self -> {'status'}) ;
260              
261 0         0 return each %{$self->{data}};
  0         0  
262             }
263              
264             sub DESTROY {
265 2     2   25 my $self = shift;
266            
267 2 50       17 $self->save if ($self -> {'status'}) ;
268             # destroy store object to make sure all data is written and everything
269             # is closed before we release the locks
270 2         6 $self->{object_store} = undef ;
271 2         13 $self->release_all_locks;
272             }
273              
274             sub cleanup
275             {
276 0     0 1   my $self = shift;
277            
278 0           $self->{initial_session_id} = undef ;
279 0 0         if ($self -> {'status'})
280             {
281 0           $self->save;
282             }
283             # {
284             # local $SIG{__WARN__} = 'IGNORE' ;
285             # local $SIG{__DIE__} = 'IGNORE' ;
286             # eval { $self -> {object_store} -> close } ; # Try to close file storage
287             # $@ = "" ;
288             # }
289              
290             # destroy store object to make sure all data is written and everything
291             # is closed before we release the locks
292 0           $self->{object_store} = undef ;
293 0           $self->release_all_locks;
294              
295 0           $self->{'status'} = 0 ;
296 0           $self->{data} = {} ;
297 0           $self->{serialized} = undef ;
298             # destroy lock object to make sure all locks are really released
299 0           $self->{lock_manager} = undef ;
300             }
301              
302              
303             sub setid {
304 0     0 1   my $self = shift;
305              
306 0           $self->{'status'} = 0 ;
307 0           $self->{data}->{_session_id} = $self->{initial_session_id} = shift ;
308             }
309              
310             sub setidfrom {
311 0     0 1   my $self = shift;
312              
313 0           $self->{'status'} = 0 ;
314 0           $self->{data}->{_session_id} = $self->{initial_session_id} = undef ;
315 0           $self->{idfrom} = shift ;
316              
317             }
318             sub getid {
319 0     0 1   my $self = shift;
320              
321 0           return $self->{data}->{_session_id} ;
322             }
323              
324             sub getids {
325 0     0 1   my $self = shift;
326 0           my $init = shift;
327              
328 0 0 0       $self -> init if ($init && !$self -> {'status'}) ;
329              
330 0 0 0       if ($self -> {newidpending} && $self->{status})
331             {
332 0           $self->{data}->{_session_id} = &{$self->{generate}}($self) ;
  0            
333 0           $self -> {newidpending} = 0 ;
334 0           $self->{status} |= NEW ;
335             }
336              
337 0           return ($self->{initial_session_id}, $self->{data}->{_session_id}, $self->{status} & MODIFIED) ;
338             }
339              
340             sub delete {
341 0     0 0   my $self = shift;
342            
343 0 0         return if ($self->{status} & NEW);
344            
345 0           $self->{initial_session_id} = "!DELETE" ;
346              
347 0 0         $self -> init if (!$self -> {'status'}) ;
348              
349 0           $self->{status} |= DELETED;
350 0           $self->save;
351 0           $self->{data} = {} ; # Throw away the data
352             }
353              
354              
355              
356             sub restore {
357 0     0 0   my $self = shift;
358            
359 0 0         return if ($self->{status} & SYNCED);
360 0 0         return if ($self->{status} & NEW);
361            
362 0 0 0       if (exists $self -> {'args'}->{Transaction} && $self -> {'args'}->{Transaction})
363             {
364 0           $self->acquire_write_lock;
365             }
366             else
367             {
368 0           $self->acquire_read_lock;
369             }
370              
371 0           $self->{object_store}->materialize($self);
372 0           &{$self->{unserialize}}($self);
  0            
373            
374 0           $self->{status} &= ($self->{status} ^ MODIFIED);
375 0           $self->{status} |= SYNCED
376             }
377              
378              
379             sub save {
380 0     0 0   my $self = shift;
381            
382             return unless (
383 0 0 0       $self->{status} & MODIFIED ||
      0        
384             $self->{status} & NEW ||
385             $self->{status} & DELETED
386             );
387            
388 0 0         if ($self -> {newidpending})
389             {
390 0           $self->{data}->{_session_id} = &{$self->{generate}}($self) ;
  0            
391 0           $self -> {newidpending} = 0 ;
392 0           $self->{status} |= NEW ;
393             }
394              
395 0           $self->acquire_write_lock;
396              
397 0 0         if ($self->{status} & DELETED) {
398 0           $self->{object_store}->remove($self);
399 0           $self->{status} |= SYNCED;
400 0           $self->{status} &= ($self->{status} ^ MODIFIED);
401 0           $self->{status} &= ($self->{status} ^ DELETED);
402 0           return;
403             }
404 0 0         if ($self->{status} & NEW) {
405 0           &{$self->{serialize}}($self);
  0            
406 0           $self->{object_store}->insert($self);
407 0           $self->{status} &= ($self->{status} ^ NEW);
408 0           $self->{status} |= SYNCED;
409 0           $self->{status} &= ($self->{status} ^ MODIFIED);
410 0           return;
411             }
412              
413 0 0         if ($self->{status} & MODIFIED) {
414 0           &{$self->{serialize}}($self);
  0            
415 0           $self->{object_store}->update($self);
416 0           $self->{status} &= ($self->{status} ^ MODIFIED);
417 0           $self->{status} |= SYNCED;
418 0           return;
419             }
420             }
421              
422              
423             #
424              
425             # For Apache::Session 1.00
426             #
427              
428             sub get_object_store {
429 0     0 0   my $self = shift;
430              
431 0           return new {$self -> {'args'}{'object_store'}} $self;
  0            
432             }
433              
434             sub get_lock_manager {
435 0     0 0   my $self = shift;
436            
437 0           return new {$self -> {'args'}{'lock_manager'}} $self;
  0            
438             }
439              
440             #
441             # Default validate for Apache::Session < 1.53
442             #
443              
444             sub validate {
445             #This routine checks to ensure that the session ID is in the form
446             #we expect. This must be called before we start diddling around
447             #in the database or the disk.
448              
449 0     0 0   my $session = shift;
450            
451 0 0         if ($session->{data}->{_session_id} !~ /^[a-fA-F0-9]+$/) {
452 0           die 'Invalid session id' ;
453             }
454             }
455              
456             #
457             # For Apache::Session >= 1.50
458             #
459              
460             sub populate
461             {
462 0     0 0   my $self = shift;
463              
464 0           my $store = $self->{args}->{Store};
465 0           my $lock = $self->{args}->{Lock};
466 0 0         if (!$self->{populated})
467             {
468 0           my $gen = $self->{args}->{Generate};
469 0           my $ser = $self->{args}->{Serialize};
470              
471              
472 0 0         $self->{object_store} = new $store $self if ($store) ;
473 0 0         $self->{lock_manager} = new $lock $self if ($lock);
474 0 0         $self->{generate} = \&{$gen . '::generate'} if ($gen);
  0            
475 0 0 0       $self->{'validate'} = \&{$gen . '::validate'} if ($gen && defined (&{$gen . '::validate'}));
  0            
  0            
476 0 0         $self->{serialize} = \&{$ser . '::serialize'} if ($ser);
  0            
477 0 0         $self->{unserialize} = \&{$ser . '::unserialize'} if ($ser) ;
  0            
478              
479 0 0         if (!defined ($self->{'validate'}))
480             {
481 0           $self->{'validate'} = \&validate ;
482             }
483 0           $self->{populated} = 1 ;
484             }
485             else
486             { # recreate only store & lock classes as far as necessary
487 0 0 0       $self->{object_store} ||= new $store $self if ($store) ;
488 0 0 0       $self->{lock_manager} ||= new $lock $self if ($lock);
489             }
490              
491 0           return $self;
492             }
493              
494              
495              
496             1 ;
497              
498              
499             __END__