"Fossies" - the Fresh Open Source Software Archive

Member "Apache-Session-1.93/lib/Apache/Session.pm" (12 Apr 2014, 18321 Bytes) of package /linux/www/Apache-Session-1.93.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "Session.pm" see the Fossies "Dox" file reference documentation.

    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 use strict;
  326 use vars qw($VERSION);
  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 sub is_new          { $_[0]->{status} & NEW }
  356 sub is_modified     { $_[0]->{status} & MODIFIED }
  357 sub is_deleted      { $_[0]->{status} & DELETED }
  358 sub is_synced       { $_[0]->{status} & SYNCED }
  359 
  360 sub make_new        { $_[0]->{status} |= NEW }
  361 sub make_modified   { $_[0]->{status} |= MODIFIED }
  362 sub make_deleted    { $_[0]->{status} |= DELETED }
  363 sub make_synced     { $_[0]->{status} |= SYNCED }
  364 
  365 sub make_old        { $_[0]->{status} &= ($_[0]->{status} ^ NEW) }
  366 sub make_unmodified { $_[0]->{status} &= ($_[0]->{status} ^ MODIFIED) }
  367 sub make_undeleted  { $_[0]->{status} &= ($_[0]->{status} ^ DELETED) }
  368 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     my $class = shift;
  381     
  382     my $session_id = shift;
  383     my $args       = shift || {};
  384 
  385     #Set-up the data structure and make it an object
  386     #of our class
  387     
  388     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     bless $self, $class;
  402 
  403     $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     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         &{$self->{validate}}($self);
  415         
  416         if (exists $args->{Transaction} && $args->{Transaction}) {
  417             $self->acquire_write_lock;
  418         }
  419         
  420         $self->{status} &= ($self->{status} ^ NEW);
  421         $self->restore;
  422     }
  423     else {
  424         $self->{status} |= NEW;
  425         &{$self->{generate}}($self);
  426         $self->save;
  427     }
  428     
  429     return $self;
  430 }
  431 
  432 sub FETCH {
  433     my $self = shift;
  434     my $key  = shift;
  435         
  436     return $self->{data}->{$key};
  437 }
  438 
  439 sub STORE {
  440     my $self  = shift;
  441     my $key   = shift;
  442     my $value = shift;
  443     
  444     $self->{data}->{$key} = $value;
  445     
  446     $self->{status} |= MODIFIED;
  447     
  448     return $self->{data}->{$key};
  449 }
  450 
  451 sub DELETE {
  452     my $self = shift;
  453     my $key  = shift;
  454     
  455     $self->{status} |= MODIFIED;
  456     
  457     delete $self->{data}->{$key};
  458 }
  459 
  460 sub CLEAR {
  461     my $self = shift;
  462 
  463     $self->{status} |= MODIFIED;
  464     
  465     $self->{data} = {};
  466 }
  467 
  468 sub EXISTS {
  469     my $self = shift;
  470     my $key  = shift;
  471     
  472     return exists $self->{data}->{$key};
  473 }
  474 
  475 sub FIRSTKEY {
  476     my $self = shift;
  477     
  478     my $reset = keys %{$self->{data}};
  479     return each %{$self->{data}};
  480 }
  481 
  482 sub NEXTKEY {
  483     my $self = shift;
  484     
  485     return each %{$self->{data}};
  486 }
  487 
  488 sub DESTROY {
  489     my $self = shift;
  490     
  491     $self->save;
  492     $self->release_all_locks;
  493 }
  494 
  495 
  496 
  497 #
  498 #Persistence methods
  499 #
  500 
  501 
  502 sub restore {
  503     my $self = shift;
  504     
  505     return if ($self->{status} & SYNCED);
  506     return if ($self->{status} & NEW);
  507     
  508     $self->acquire_read_lock;
  509 
  510     $self->{object_store}->materialize($self);
  511     &{$self->{unserialize}}($self);
  512     
  513     $self->{status} &= ($self->{status} ^ MODIFIED);
  514     $self->{status} |= SYNCED;
  515 }
  516 
  517 sub save {
  518     my $self = shift;
  519     
  520     return unless (
  521         $self->{status} & MODIFIED || 
  522         $self->{status} & NEW      || 
  523         $self->{status} & DELETED
  524     );
  525     
  526     $self->acquire_write_lock;
  527 
  528     if ($self->{status} & DELETED) {
  529         $self->{object_store}->remove($self);
  530         $self->{status} |= SYNCED;
  531         $self->{status} &= ($self->{status} ^ MODIFIED);
  532         $self->{status} &= ($self->{status} ^ DELETED);
  533         return;
  534     }
  535     if ($self->{status} & MODIFIED) {
  536         &{$self->{serialize}}($self);
  537         $self->{object_store}->update($self);
  538         $self->{status} &= ($self->{status} ^ MODIFIED);
  539         $self->{status} |= SYNCED;
  540         return;
  541     }
  542     if ($self->{status} & NEW) {
  543         &{$self->{serialize}}($self);
  544         $self->{object_store}->insert($self);
  545         $self->{status} &= ($self->{status} ^ NEW);
  546         $self->{status} |= SYNCED;
  547         $self->{status} &= ($self->{status} ^ MODIFIED);
  548         return;
  549     }
  550 }
  551 
  552 sub delete {
  553     my $self = shift;
  554     
  555     return if ($self->{status} & NEW);
  556     
  557     $self->{status} |= DELETED;
  558     $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 sub has_read_lock    { $_[0]->{lock} & READ_LOCK }
  575 sub has_write_lock   { $_[0]->{lock} & WRITE_LOCK }
  576 
  577 sub set_read_lock    { $_[0]->{lock} |= READ_LOCK }
  578 sub set_write_lock   { $_[0]->{lock} |= WRITE_LOCK }
  579 
  580 sub unset_read_lock  { $_[0]->{lock} &= ($_[0]->{lock} ^ READ_LOCK) }
  581 sub unset_write_lock { $_[0]->{lock} &= ($_[0]->{lock} ^ WRITE_LOCK) }
  582 
  583 sub acquire_read_lock  {
  584     my $self = shift;
  585 
  586     return if ($self->{lock} & READ_LOCK);
  587 
  588     $self->{lock_manager}->acquire_read_lock($self);
  589 
  590     $self->{lock} |= READ_LOCK;
  591 }
  592 
  593 sub acquire_write_lock {
  594     my $self = shift;
  595 
  596     return if ($self->{lock} & WRITE_LOCK);
  597 
  598     $self->{lock_manager}->acquire_write_lock($self);
  599 
  600     $self->{lock} |= WRITE_LOCK;
  601 }
  602 
  603 sub release_read_lock {
  604     my $self = shift;
  605 
  606     return unless ($self->{lock} & READ_LOCK);
  607 
  608     $self->{lock_manager}->release_read_lock($self);
  609 
  610     $self->{lock} &= ($self->{lock} ^ READ_LOCK);
  611 }
  612 
  613 sub release_write_lock {
  614     my $self = shift;
  615 
  616     return unless ($self->{lock} & WRITE_LOCK);
  617 
  618     $self->{lock_manager}->release_write_lock($self);
  619     
  620     $self->{lock} &= ($self->{lock} ^ WRITE_LOCK);
  621 }
  622 
  623 sub release_all_locks {
  624     my $self = shift;
  625     
  626     return unless ($self->{lock} & READ_LOCK || $self->{lock} & WRITE_LOCK);
  627     
  628     $self->{lock_manager}->release_all_locks($self);
  629 
  630     $self->{lock} &= ($self->{lock} ^ READ_LOCK);
  631     $self->{lock} &= ($self->{lock} ^ WRITE_LOCK);
  632 }        
  633 
  634 1;