File Coverage

blib/lib/Apache/Session.pm
Criterion Covered Total %
statement 88 130 67.6
branch 18 28 64.2
condition 13 17 76.4
subroutine 13 37 35.1
pod 0 26 0.0
total 132 238 55.4


line stmt bran cond sub pod time code
1             #############################################################################
2             #
3             # Apache::Session
4             # Apache persistent user sessions
5             # Copyright(c) 1998, 1999, 2000, 2001, 2004 Jeffrey William Baker (jwbaker@acm.org)
6             # Distribute under the Perl License
7             #
8             #############################################################################
9              
10             =head1 NAME
11              
12             Apache::Session - A persistence framework for session data
13              
14             =head1 SYNOPSIS
15              
16             use Apache::Session::MySQL;
17              
18             my %session;
19              
20             #make a fresh session for a first-time visitor
21             tie %session, 'Apache::Session::MySQL';
22              
23             #stick some stuff in it
24             $session{visa_number} = "1234 5678 9876 5432";
25              
26             #get the session id for later use
27             my $id = $session{_session_id};
28              
29             #...time passes...
30              
31             #get the session data back out again during some other request
32             my %session;
33             tie %session, 'Apache::Session::MySQL', $id;
34              
35             validate($session{visa_number});
36              
37             #delete a session from the object store permanently
38             tied(%session)->delete;
39              
40              
41             =head1 DESCRIPTION
42              
43             Apache::Session is a persistence framework which is particularly useful
44             for tracking session data between httpd requests. Apache::Session is
45             designed to work with Apache and mod_perl, but it should work under
46             CGI and other web servers, and it also works outside of a web server
47             altogether.
48              
49             Apache::Session consists of five components: the interface, the object store,
50             the lock manager, the ID generator, and the serializer. The interface is
51             defined in Session.pm, which is meant to be easily subclassed. The object
52             store can be the filesystem, a Berkeley DB, a MySQL DB, an Oracle DB, a
53             Postgres DB, Sybase, or Informix. Locking is done by lock files, semaphores, or
54             the locking capabilities of the various databases. Serialization is done via
55             Storable, and optionally ASCII-fied via MIME or pack(). ID numbers are
56             generated via MD5. The reader is encouraged to extend these capabilities to
57             meet his own requirements.
58              
59             A derived class of Apache::Session is used to tie together the three following
60             components. The derived class inherits the interface from Apache::Session, and
61             specifies which store and locker classes to use. Apache::Session::MySQL, for
62             instance, uses the MySQL storage class and also the MySQL locking class. You
63             can easily plug in your own object store or locker class.
64              
65             =head1 INTERFACE
66              
67             The interface to Apache::Session is very simple: tie a hash to the
68             desired class and use the hash as normal. The constructor takes two
69             optional arguments. The first argument is the desired session ID
70             number, or undef for a new session. The second argument is a hash
71             of options that will be passed to the object store and locker classes.
72              
73             =head2 tieing the session
74              
75             Get a new session using DBI:
76              
77             tie %session, 'Apache::Session::MySQL', undef,
78             { DataSource => 'dbi:mysql:sessions' };
79              
80             Restore an old session from the database:
81              
82             tie %session, 'Apache::Session::MySQL', $session_id,
83             { DataSource => 'dbi:mysql:sessions' };
84              
85              
86             =head2 Storing and retrieving data to and from the session
87              
88             Hey, how much easier could it get?
89              
90             $session{first_name} = "Chuck";
91             $session{an_array_ref} = [ $one, $two, $three ];
92             $session{an_object} = Some::Class->new;
93              
94             =head2 Reading the session ID
95              
96             The session ID is the only magic entry in the session object,
97             but anything beginning with an "_" is considered reserved for
98             future use.
99              
100             my $id = $session{_session_id};
101              
102             =head2 Permanently removing the session from storage
103              
104             tied(%session)->delete;
105              
106             =head1 BEHAVIOR
107              
108             Apache::Session tries to behave the way the author believes that
109             you would expect. When you create a new session, Session immediately
110             saves the session to the data store, or calls die() if it cannot. It
111             also obtains an exclusive lock on the session object. If you retrieve
112             an existing session, Session immediately restores the object from storage,
113             or calls die() in case of an error. Session also obtains a non-exclusive
114             lock on the session.
115              
116             As you put data into the session hash, Session squirrels it away for
117             later use. When you untie() the session hash, or it passes out of
118             scope, Session checks to see if anything has changed. If so, Session
119             gains an exclusive lock and writes the session to the data store.
120             It then releases any locks it has acquired.
121              
122             Note that Apache::Session does only a shallow check to see if anything has
123             changed. If nothing changes in the top level tied hash, the data will not be
124             updated in the backing store. You are encouraged to timestamp the session hash
125             so that it is sure to be updated.
126              
127             When you call the delete() method on the session object, the
128             object is immediately removed from the object store, if possible.
129              
130             When Session encounters an error, it calls die(). You will probably
131             want to wrap your session logic in an eval block to trap these errors.
132              
133             =head1 LOCKING AND TRANSACTIONS
134              
135             By default, most Apache::Session implementations only do locking to prevent
136             data corruption. The locking scheme does not provide transactional
137             consistency, such as you might get from a relational database. If you desire
138             transactional consistency, you must provide the Transaction argument with a
139             true value when you tie the session hash. For example:
140              
141             tie %s, 'Apache::Session::File', $id {
142             Directory => '/tmp/sessions',
143             LockDirectory => '/var/lock/sessions',
144             Transaction => 1
145             };
146              
147             Note that the Transaction argument has no practical effect on the MySQL and
148             Postgres implementations. The MySQL implementation only supports exclusive
149             locking, and the Postgres implementation uses the transaction features of that
150             database.
151              
152             =head1 IMPLEMENTATION
153              
154             The way you implement Apache::Session depends on what you are
155             trying to accomplish. Here are some hints on which classes to
156             use in what situations
157              
158             =head1 STRATEGIES
159              
160             Apache::Session is mainly designed to track user session between
161             http requests. However, it can also be used for any situation
162             where data persistence is desirable. For example, it could be
163             used to share global data between your httpd processes. The
164             following examples are short mod_perl programs which demonstrate
165             some session handling basics.
166              
167             =head2 Sharing data between Apache processes
168              
169             When you share data between Apache processes, you need to decide on a
170             session ID number ahead of time and make sure that an object with that
171             ID number is in your object store before starting your Apache. How you
172             accomplish that is your own business. I use the session ID "1". Here
173             is a short program in which we use Apache::Session to store out
174             database access information.
175              
176             use Apache;
177             use Apache::Session::File;
178             use DBI;
179              
180             use strict;
181              
182             my %global_data;
183              
184             eval {
185             tie %global_data, 'Apache::Session::File', 1,
186             {Directory => '/tmp/sessiondata'};
187             };
188             if ($@) {
189             die "Global data is not accessible: $@";
190             }
191              
192             my $dbh = DBI->connect($global_data{datasource},
193             $global_data{username}, $global_data{password}) || die $DBI::errstr;
194              
195             undef %global_data;
196              
197             #program continues...
198              
199             As shown in this example, you should undef or untie your session hash
200             as soon as you are done with it. This will free up any locks associated
201             with your process.
202              
203             =head2 Tracking users with cookies
204              
205             The choice of whether to use cookies or path info to track user IDs
206             is a rather religious topic among Apache users. This example uses cookies.
207             The implementation of a path info system is left as an exercise for the
208             reader.
209              
210             Note that Apache::Session::Generate::ModUsertrack uses Apache's mod_usertrack
211             cookies to generate and maintain session IDs.
212              
213             use Apache::Session::MySQL;
214             use Apache;
215              
216             use strict;
217              
218             #read in the cookie if this is an old session
219              
220             my $r = Apache->request;
221             my $cookie = $r->header_in('Cookie');
222             $cookie =~ s/SESSION_ID=(\w*)/$1/;
223              
224             #create a session object based on the cookie we got from the browser,
225             #or a new session if we got no cookie
226              
227             my %session;
228             tie %session, 'Apache::Session::MySQL', $cookie, {
229             DataSource => 'dbi:mysql:sessions', #these arguments are
230             UserName => 'mySQL_user', #required when using
231             Password => 'password', #MySQL.pm
232             LockDataSource => 'dbi:mysql:sessions',
233             LockUserName => 'mySQL_user',
234             LockPassword => 'password'
235             };
236              
237             #Might be a new session, so lets give them their cookie back
238              
239             my $session_cookie = "SESSION_ID=$session{_session_id};";
240             $r->header_out("Set-Cookie" => $session_cookie);
241              
242             #program continues...
243              
244             =head1 SEE ALSO
245              
246             Apache::Session::MySQL, Apache::Session::Postgres, Apache::Session::File,
247             Apache::Session::DB_File, Apache::Session::Oracle, Apache::Session::Sybase
248              
249             The O Reilly book "Apache Modules in Perl and C", by Doug MacEachern and
250             Lincoln Stein, has a chapter on keeping state.
251              
252             CGI::Session uses OO interface to do same thing. It is better maintained,
253             but less possibilies.
254              
255             Catalyst::Plugin::Session - support of sessions in Catalyst
256              
257             Session - OO interface to Apache::Session
258              
259             =head1 LICENSE
260              
261             Under the same terms as Perl itself.
262              
263             =head1 AUTHORS
264              
265             Alexandr Ciornii, L<http://chorny.net> - current maintainer
266              
267             Jeffrey Baker <jwbaker@acm.org> is the author of
268             Apache::Session.
269              
270             Tatsuhiko Miyagawa <miyagawa@bulknews.net> is the author of
271             Generate::ModUniqueID and Generate::ModUsertrack
272              
273             Erik Rantapaa <rantapaa@fanbuzz.com> found errors in both Lock::File
274             and Store::File
275              
276             Bart Schaefer <schaefer@zanshin.com> notified me of a bug in
277             Lock::File.
278              
279             Chris Winters <cwinters@intes.net> contributed the Sybase code.
280              
281             Michael Schout <mschout@gkg.net> fixed a commit policy bug in 1.51.
282              
283             Andreas J. Koenig <andreas.koenig@anima.de> contributed valuable CPAN
284             advice and also Apache::Session::Tree and Apache::Session::Counted.
285              
286             Gerald Richter <richter@ecos.de> had the idea for a tied hash interface
287             and provided the initial code for it. He also uses Apache::Session in
288             his Embperl module and is the author of Apache::Session::Embperl
289              
290             Jochen Wiedmann <joe@ipsoft.de> contributed patches for bugs and
291             improved performance.
292              
293             Steve Shreeve <shreeve@uci.edu> squashed a bug in 0.99.0 whereby
294             a cleared hash or deleted key failed to set the modified bit.
295              
296             Peter Kaas <Peter.Kaas@lunatech.com> sent quite a bit of feedback
297             with ideas for interface improvements.
298              
299             Randy Harmon <rjharmon@uptimecomputers.com> contributed the original
300             storage-independent object interface with input from:
301              
302             Bavo De Ridder <bavo@ace.ulyssis.student.kuleuven.ac.be>
303             Jules Bean <jmlb2@hermes.cam.ac.uk>
304             Lincoln Stein <lstein@cshl.org>
305              
306             Jamie LeTaul <jletual@kmtechnologies.com> fixed file locking on Windows.
307              
308             Scott McWhirter <scott@surreytech.co.uk> contributed verbose error messages for
309             file locking.
310              
311             Corris Randall <corris@line6.net> gave us the option to use any table name in
312             the MySQL store.
313              
314             Oliver Maul <oliver.maul@ixos.de> updated the Sybase modules
315              
316             Innumerable users sent a patch for the reversed file age test in the file
317             locking module.
318              
319             Langen Mike <mike.langen@tamedia.ch> contributed Informix modules.
320              
321             =cut
322              
323             package Apache::Session;
324              
325 2     2   15 use strict;
  2         60  
  2         119  
326 2     2   13 use vars qw($VERSION);
  2         4  
  2         4306  
327              
328             $VERSION = '1.93';
329             $VERSION = eval $VERSION;
330              
331             #State constants
332             #
333             #These constants are used in a bitmask to store the
334             #object's status. New indicates that the object
335             #has not yet been inserted into the object store.
336             #Modified indicates that a member value has been
337             #changed. Deleted is set when delete() is called.
338             #Synced indicates that an object has been materialized
339             #from the datastore.
340              
341             sub NEW () {1};
342             sub MODIFIED () {2};
343             sub DELETED () {4};
344             sub SYNCED () {8};
345              
346              
347              
348             #State methods
349             #
350             #These methods aren't used anymore for performance reasons. I'll
351             #keep them around for reference
352              
353              
354              
355 0     0 0 0 sub is_new { $_[0]->{status} & NEW }
356 0     0 0 0 sub is_modified { $_[0]->{status} & MODIFIED }
357 0     0 0 0 sub is_deleted { $_[0]->{status} & DELETED }
358 0     0 0 0 sub is_synced { $_[0]->{status} & SYNCED }
359              
360 0     0 0 0 sub make_new { $_[0]->{status} |= NEW }
361 0     0 0 0 sub make_modified { $_[0]->{status} |= MODIFIED }
362 0     0 0 0 sub make_deleted { $_[0]->{status} |= DELETED }
363 0     0 0 0 sub make_synced { $_[0]->{status} |= SYNCED }
364              
365 0     0 0 0 sub make_old { $_[0]->{status} &= ($_[0]->{status} ^ NEW) }
366 0     0 0 0 sub make_unmodified { $_[0]->{status} &= ($_[0]->{status} ^ MODIFIED) }
367 0     0 0 0 sub make_undeleted { $_[0]->{status} &= ($_[0]->{status} ^ DELETED) }
368 0     0 0 0 sub make_unsynced { $_[0]->{status} &= ($_[0]->{status} ^ SYNCED) }
369              
370              
371              
372             #Tie methods
373             #
374             #Here we are hiding our complex data persistence framework behind
375             #a simple hash. See the perltie manpage.
376              
377              
378              
379             sub TIEHASH {
380 5     5   9244 my $class = shift;
381            
382 5         12 my $session_id = shift;
383 5   50     19 my $args = shift || {};
384              
385             #Set-up the data structure and make it an object
386             #of our class
387            
388 5         53 my $self = {
389             args => $args,
390             data => { _session_id => $session_id },
391             serialized => undef,
392             lock => 0,
393             status => 0,
394             lock_manager => undef, # These two are object refs ...
395             object_store => undef,
396             generate => undef, # but these three are subroutine refs
397             serialize => undef,
398             unserialize => undef,
399             };
400            
401 5         18 bless $self, $class;
402              
403 5         22 $self->populate;
404              
405              
406             #If a session ID was passed in, this is an old hash.
407             #If not, it is a fresh one.
408              
409 5 100 66     30 if (defined $session_id && $session_id) {
410            
411             #check the session ID for remote exploitation attempts
412             #this will die() on suspicious session IDs.
413              
414 2         3 &{$self->{validate}}($self);
  2         11  
415            
416 1 50 33     4 if (exists $args->{Transaction} && $args->{Transaction}) {
417 0         0 $self->acquire_write_lock;
418             }
419            
420 1         3 $self->{status} &= ($self->{status} ^ NEW);
421 1         13 $self->restore;
422             }
423             else {
424 3         8 $self->{status} |= NEW;
425 3         5 &{$self->{generate}}($self);
  3         19  
426 3         24 $self->save;
427             }
428            
429 4         20 return $self;
430             }
431              
432             sub FETCH {
433 5     5   1605 my $self = shift;
434 5         7 my $key = shift;
435            
436 5         24 return $self->{data}->{$key};
437             }
438              
439             sub STORE {
440 2     2   20 my $self = shift;
441 2         3 my $key = shift;
442 2         3 my $value = shift;
443            
444 2         5 $self->{data}->{$key} = $value;
445            
446 2         4 $self->{status} |= MODIFIED;
447            
448 2         8 return $self->{data}->{$key};
449             }
450              
451             sub DELETE {
452 0     0   0 my $self = shift;
453 0         0 my $key = shift;
454            
455 0         0 $self->{status} |= MODIFIED;
456            
457 0         0 delete $self->{data}->{$key};
458             }
459              
460             sub CLEAR {
461 0     0   0 my $self = shift;
462              
463 0         0 $self->{status} |= MODIFIED;
464            
465 0         0 $self->{data} = {};
466             }
467              
468             sub EXISTS {
469 1     1   756 my $self = shift;
470 1         3 my $key = shift;
471            
472 1         8 return exists $self->{data}->{$key};
473             }
474              
475             sub FIRSTKEY {
476 0     0   0 my $self = shift;
477            
478 0         0 my $reset = keys %{$self->{data}};
  0         0  
479 0         0 return each %{$self->{data}};
  0         0  
480             }
481              
482             sub NEXTKEY {
483 0     0   0 my $self = shift;
484            
485 0         0 return each %{$self->{data}};
  0         0  
486             }
487              
488             sub DESTROY {
489 2     2   39 my $self = shift;
490            
491 2         6 $self->save;
492 2         10 $self->release_all_locks;
493             }
494              
495              
496              
497             #
498             #Persistence methods
499             #
500              
501              
502             sub restore {
503 1     1 0 3 my $self = shift;
504            
505 1 50       4 return if ($self->{status} & SYNCED);
506 1 50       3 return if ($self->{status} & NEW);
507            
508 1         8 $self->acquire_read_lock;
509              
510 1         7 $self->{object_store}->materialize($self);
511 1         3 &{$self->{unserialize}}($self);
  1         6  
512            
513 1         3 $self->{status} &= ($self->{status} ^ MODIFIED);
514 1         3 $self->{status} |= SYNCED;
515             }
516              
517             sub save {
518 11     11 0 23 my $self = shift;
519            
520             return unless (
521 11 100 100     106 $self->{status} & MODIFIED ||
      100        
522             $self->{status} & NEW ||
523             $self->{status} & DELETED
524             );
525            
526 7         27 $self->acquire_write_lock;
527              
528 7 100       24 if ($self->{status} & DELETED) {
529 3         26 $self->{object_store}->remove($self);
530 3         8 $self->{status} |= SYNCED;
531 3         9 $self->{status} &= ($self->{status} ^ MODIFIED);
532 3         6 $self->{status} &= ($self->{status} ^ DELETED);
533 3         17 return;
534             }
535 4 100       19 if ($self->{status} & MODIFIED) {
536 1         1 &{$self->{serialize}}($self);
  1         5  
537 1         79 $self->{object_store}->update($self);
538 1         4 $self->{status} &= ($self->{status} ^ MODIFIED);
539 1         2 $self->{status} |= SYNCED;
540 1         3 return;
541             }
542 3 50       12 if ($self->{status} & NEW) {
543 3         5 &{$self->{serialize}}($self);
  3         14  
544 3         324 $self->{object_store}->insert($self);
545 3         10 $self->{status} &= ($self->{status} ^ NEW);
546 3         5 $self->{status} |= SYNCED;
547 3         6 $self->{status} &= ($self->{status} ^ MODIFIED);
548 3         10 return;
549             }
550             }
551              
552             sub delete {
553 3     3 0 19827 my $self = shift;
554            
555 3 50       18 return if ($self->{status} & NEW);
556            
557 3         6 $self->{status} |= DELETED;
558 3         11 $self->save;
559             }
560              
561              
562              
563             #
564             #Locking methods
565             #
566              
567             sub READ_LOCK () {1};
568             sub WRITE_LOCK () {2};
569              
570              
571             #These methods aren't used anymore for performance reasons. I'll keep them
572             #around for reference.
573              
574 0     0 0 0 sub has_read_lock { $_[0]->{lock} & READ_LOCK }
575 0     0 0 0 sub has_write_lock { $_[0]->{lock} & WRITE_LOCK }
576              
577 0     0 0 0 sub set_read_lock { $_[0]->{lock} |= READ_LOCK }
578 0     0 0 0 sub set_write_lock { $_[0]->{lock} |= WRITE_LOCK }
579              
580 0     0 0 0 sub unset_read_lock { $_[0]->{lock} &= ($_[0]->{lock} ^ READ_LOCK) }
581 0     0 0 0 sub unset_write_lock { $_[0]->{lock} &= ($_[0]->{lock} ^ WRITE_LOCK) }
582              
583             sub acquire_read_lock {
584 1     1 0 2 my $self = shift;
585              
586 1 50       5 return if ($self->{lock} & READ_LOCK);
587              
588 1         6 $self->{lock_manager}->acquire_read_lock($self);
589              
590 1         2 $self->{lock} |= READ_LOCK;
591             }
592              
593             sub acquire_write_lock {
594 7     7 0 14 my $self = shift;
595              
596 7 100       24 return if ($self->{lock} & WRITE_LOCK);
597              
598 4         32 $self->{lock_manager}->acquire_write_lock($self);
599              
600 4         9 $self->{lock} |= WRITE_LOCK;
601             }
602              
603             sub release_read_lock {
604 0     0 0 0 my $self = shift;
605              
606 0 0       0 return unless ($self->{lock} & READ_LOCK);
607              
608 0         0 $self->{lock_manager}->release_read_lock($self);
609              
610 0         0 $self->{lock} &= ($self->{lock} ^ READ_LOCK);
611             }
612              
613             sub release_write_lock {
614 0     0 0 0 my $self = shift;
615              
616 0 0       0 return unless ($self->{lock} & WRITE_LOCK);
617              
618 0         0 $self->{lock_manager}->release_write_lock($self);
619            
620 0         0 $self->{lock} &= ($self->{lock} ^ WRITE_LOCK);
621             }
622              
623             sub release_all_locks {
624 5     5 0 8 my $self = shift;
625            
626 5 100 100     41 return unless ($self->{lock} & READ_LOCK || $self->{lock} & WRITE_LOCK);
627            
628 4         28 $self->{lock_manager}->release_all_locks($self);
629              
630 4         10 $self->{lock} &= ($self->{lock} ^ READ_LOCK);
631 4         37 $self->{lock} &= ($self->{lock} ^ WRITE_LOCK);
632             }
633              
634             1;