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 12Apache::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 43Apache::Session is a persistence framework which is particularly useful 44for tracking session data between httpd requests. Apache::Session is 45designed to work with Apache and mod_perl, but it should work under 46CGI and other web servers, and it also works outside of a web server 47altogether. 48 49Apache::Session consists of five components: the interface, the object store, 50the lock manager, the ID generator, and the serializer. The interface is 51defined in Session.pm, which is meant to be easily subclassed. The object 52store can be the filesystem, a Berkeley DB, a MySQL DB, an Oracle DB, a 53Postgres DB, Sybase, or Informix. Locking is done by lock files, semaphores, or 54the locking capabilities of the various databases. Serialization is done via 55Storable, and optionally ASCII-fied via MIME or pack(). ID numbers are 56generated via MD5. The reader is encouraged to extend these capabilities to 57meet his own requirements. 58 59A derived class of Apache::Session is used to tie together the three following 60components. The derived class inherits the interface from Apache::Session, and 61specifies which store and locker classes to use. Apache::Session::MySQL, for 62instance, uses the MySQL storage class and also the MySQL locking class. You 63can easily plug in your own object store or locker class. 64 65=head1 INTERFACE 66 67The interface to Apache::Session is very simple: tie a hash to the 68desired class and use the hash as normal. The constructor takes two 69optional arguments. The first argument is the desired session ID 70number, or undef for a new session. The second argument is a hash 71of options that will be passed to the object store and locker classes. 72 73=head2 tieing the session 74 75Get a new session using DBI: 76 77 tie %session, 'Apache::Session::MySQL', undef, 78 { DataSource => 'dbi:mysql:sessions' }; 79 80Restore 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 88Hey, 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 96The session ID is the only magic entry in the session object, 97but anything beginning with an "_" is considered reserved for 98future 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 108Apache::Session tries to behave the way the author believes that 109you would expect. When you create a new session, Session immediately 110saves the session to the data store, or calls die() if it cannot. It 111also obtains an exclusive lock on the session object. If you retrieve 112an existing session, Session immediately restores the object from storage, 113or calls die() in case of an error. Session also obtains a non-exclusive 114lock on the session. 115 116As you put data into the session hash, Session squirrels it away for 117later use. When you untie() the session hash, or it passes out of 118scope, Session checks to see if anything has changed. If so, Session 119gains an exclusive lock and writes the session to the data store. 120It then releases any locks it has acquired. 121 122Note that Apache::Session does only a shallow check to see if anything has 123changed. If nothing changes in the top level tied hash, the data will not be 124updated in the backing store. You are encouraged to timestamp the session hash 125so that it is sure to be updated. 126 127When you call the delete() method on the session object, the 128object is immediately removed from the object store, if possible. 129 130When Session encounters an error, it calls die(). You will probably 131want to wrap your session logic in an eval block to trap these errors. 132 133=head1 LOCKING AND TRANSACTIONS 134 135By default, most Apache::Session implementations only do locking to prevent 136data corruption. The locking scheme does not provide transactional 137consistency, such as you might get from a relational database. If you desire 138transactional consistency, you must provide the Transaction argument with a 139true 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 147Note that the Transaction argument has no practical effect on the MySQL and 148Postgres implementations. The MySQL implementation only supports exclusive 149locking, and the Postgres implementation uses the transaction features of that 150database. 151 152=head1 IMPLEMENTATION 153 154The way you implement Apache::Session depends on what you are 155trying to accomplish. Here are some hints on which classes to 156use in what situations 157 158=head1 STRATEGIES 159 160Apache::Session is mainly designed to track user session between 161http requests. However, it can also be used for any situation 162where data persistence is desirable. For example, it could be 163used to share global data between your httpd processes. The 164following examples are short mod_perl programs which demonstrate 165some session handling basics. 166 167=head2 Sharing data between Apache processes 168 169When you share data between Apache processes, you need to decide on a 170session ID number ahead of time and make sure that an object with that 171ID number is in your object store before starting your Apache. How you 172accomplish that is your own business. I use the session ID "1". Here 173is a short program in which we use Apache::Session to store out 174database 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 199As shown in this example, you should undef or untie your session hash 200as soon as you are done with it. This will free up any locks associated 201with your process. 202 203=head2 Tracking users with cookies 204 205The choice of whether to use cookies or path info to track user IDs 206is a rather religious topic among Apache users. This example uses cookies. 207The implementation of a path info system is left as an exercise for the 208reader. 209 210Note that Apache::Session::Generate::ModUsertrack uses Apache's mod_usertrack 211cookies 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 246Apache::Session::MySQL, Apache::Session::Postgres, Apache::Session::File, 247Apache::Session::DB_File, Apache::Session::Oracle, Apache::Session::Sybase 248 249The O Reilly book "Apache Modules in Perl and C", by Doug MacEachern and 250Lincoln Stein, has a chapter on keeping state. 251 252CGI::Session uses OO interface to do same thing. It is better maintained, 253but less possibilies. 254 255Catalyst::Plugin::Session - support of sessions in Catalyst 256 257Session - OO interface to Apache::Session 258 259=head1 LICENSE 260 261Under the same terms as Perl itself. 262 263=head1 AUTHORS 264 265Alexandr Ciornii, L<http://chorny.net> - current maintainer 266 267Jeffrey Baker <jwbaker@acm.org> is the author of 268Apache::Session. 269 270Tatsuhiko Miyagawa <miyagawa@bulknews.net> is the author of 271Generate::ModUniqueID and Generate::ModUsertrack 272 273Erik Rantapaa <rantapaa@fanbuzz.com> found errors in both Lock::File 274and Store::File 275 276Bart Schaefer <schaefer@zanshin.com> notified me of a bug in 277Lock::File. 278 279Chris Winters <cwinters@intes.net> contributed the Sybase code. 280 281Michael Schout <mschout@gkg.net> fixed a commit policy bug in 1.51. 282 283Andreas J. Koenig <andreas.koenig@anima.de> contributed valuable CPAN 284advice and also Apache::Session::Tree and Apache::Session::Counted. 285 286Gerald Richter <richter@ecos.de> had the idea for a tied hash interface 287and provided the initial code for it. He also uses Apache::Session in 288his Embperl module and is the author of Apache::Session::Embperl 289 290Jochen Wiedmann <joe@ipsoft.de> contributed patches for bugs and 291improved performance. 292 293Steve Shreeve <shreeve@uci.edu> squashed a bug in 0.99.0 whereby 294a cleared hash or deleted key failed to set the modified bit. 295 296Peter Kaas <Peter.Kaas@lunatech.com> sent quite a bit of feedback 297with ideas for interface improvements. 298 299Randy Harmon <rjharmon@uptimecomputers.com> contributed the original 300storage-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 306Jamie LeTaul <jletual@kmtechnologies.com> fixed file locking on Windows. 307 308Scott McWhirter <scott@surreytech.co.uk> contributed verbose error messages for 309file locking. 310 311Corris Randall <corris@line6.net> gave us the option to use any table name in 312the MySQL store. 313 314Oliver Maul <oliver.maul@ixos.de> updated the Sybase modules 315 316Innumerable users sent a patch for the reversed file age test in the file 317locking module. 318 319Langen Mike <mike.langen@tamedia.ch> contributed Informix modules. 320 321=cut 322 323package Apache::Session; 324 325use strict; 326use vars qw($VERSION); 327 328$VERSION = '1.94'; 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 341sub NEW () {1}; 342sub MODIFIED () {2}; 343sub DELETED () {4}; 344sub 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 355sub is_new { $_[0]->{status} & NEW } 356sub is_modified { $_[0]->{status} & MODIFIED } 357sub is_deleted { $_[0]->{status} & DELETED } 358sub is_synced { $_[0]->{status} & SYNCED } 359 360sub make_new { $_[0]->{status} |= NEW } 361sub make_modified { $_[0]->{status} |= MODIFIED } 362sub make_deleted { $_[0]->{status} |= DELETED } 363sub make_synced { $_[0]->{status} |= SYNCED } 364 365sub make_old { $_[0]->{status} &= ($_[0]->{status} ^ NEW) } 366sub make_unmodified { $_[0]->{status} &= ($_[0]->{status} ^ MODIFIED) } 367sub make_undeleted { $_[0]->{status} &= ($_[0]->{status} ^ DELETED) } 368sub 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 379sub 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 432sub FETCH { 433 my $self = shift; 434 my $key = shift; 435 436 return $self->{data}->{$key}; 437} 438 439sub 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 451sub DELETE { 452 my $self = shift; 453 my $key = shift; 454 455 $self->{status} |= MODIFIED; 456 457 delete $self->{data}->{$key}; 458} 459 460sub CLEAR { 461 my $self = shift; 462 463 $self->{status} |= MODIFIED; 464 465 $self->{data} = {}; 466} 467 468sub EXISTS { 469 my $self = shift; 470 my $key = shift; 471 472 return exists $self->{data}->{$key}; 473} 474 475sub FIRSTKEY { 476 my $self = shift; 477 478 my $reset = keys %{$self->{data}}; 479 return each %{$self->{data}}; 480} 481 482sub NEXTKEY { 483 my $self = shift; 484 485 return each %{$self->{data}}; 486} 487 488sub 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 502sub 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 517sub 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 552sub 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 567sub READ_LOCK () {1}; 568sub WRITE_LOCK () {2}; 569 570 571#These methods aren't used anymore for performance reasons. I'll keep them 572#around for reference. 573 574sub has_read_lock { $_[0]->{lock} & READ_LOCK } 575sub has_write_lock { $_[0]->{lock} & WRITE_LOCK } 576 577sub set_read_lock { $_[0]->{lock} |= READ_LOCK } 578sub set_write_lock { $_[0]->{lock} |= WRITE_LOCK } 579 580sub unset_read_lock { $_[0]->{lock} &= ($_[0]->{lock} ^ READ_LOCK) } 581sub unset_write_lock { $_[0]->{lock} &= ($_[0]->{lock} ^ WRITE_LOCK) } 582 583sub 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 593sub 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 603sub 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 613sub 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 623sub 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 6341; 635