Apache-SessionX-2.01/0000755000000000000000000000000010336267110013063 5ustar rootrootApache-SessionX-2.01/README0000755000000000000000000000651107336125410013753 0ustar rootroot Apache::SessionX - An extented persistence framework for session data ---------------------------------------------------------------------- Copyright (c) 1997-2001 Gerald Richter / ecos gmbh You may distribute under the terms of either the GNU General Public License or the Artistic License, as specified in the Perl README file. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. $Id: README,v 1.2 2001/08/14 04:37:28 richter Exp $ OVERVIEW ======== Apache::SessionX extents Apache::Session. It was initialy written to use Apache::Session from inside of HTML::Embperl, but is seems to be usefull outside of Embperl as well, so here is it as standalone module. Apache::Session is a persistence framework which is particularly useful for tracking session data between httpd requests. Apache::Session is designed to work with Apache and mod_perl, but it should work under CGI and other web servers, and it also works outside of a web server altogether. Addtionaly to Apache::Session, Apache::SessionX provides the following possibilites: - Configuration: Makefile.PL checks which componemnts are installed on the system and interactivly builds a set of configuration, including a default one. This configurations are saved and can be used by name later on. The default configuration is used, if no parameters are given to Apache::SessionX. This simplifies the configuration and usage. - Lazy operation: Apache::SessionX supports lazy operation, that means that the actual data access only takes place if the session data is needed, so you are able to setup the session object, without worrying about performance in case you don't access the session data. - Specifing the ID: Apache::SessionX can use a given ID instead of creating it's own one. You can also give an string which is used to generate the ID - Genrate unique ID: Apache::SessionX is able to save the session with an new ID every time data is modified. This make it possible to keep an history. - Addtionaly methods are provided to get the ID, the inital ID, the modified status and to close a session, without destroying the session object itself. DOCUMENTATION ============= After Installation the documentaion could be viewed via perldoc Apache::SessionX You should addtionaly read the perldoc Apache::SessionX perldoc Apache::SessionX::Generate::MD5 perldoc Apache::Session::Store::* perldoc Apache::Session::Lock::* perldoc Apache::Session::Serialize::* INSTALLATION ============ perl Makefile.PL make make test make install Makefile.PL will ask you what configuration you want to use and saves them for later use with the config parameter. This configuration are tested when you run make test, so it's really a good idea to run make test, to make sure everything works as expected. Even better is to run make test as the user, that your webserver is running as, so you are able to detected permission problems early. SUPPORT ======= You can get support for this module via the mod_perl or Embperl mailing list. Please use the lists for any questions and don't contact me directly. Details about the list can be found at http://perl.apache.org/ AUTHOR ====== G. Richter (richter@dev.ecos.de) Apache-SessionX-2.01/testcount.pl0000644000000000000000000000126307336125403015456 0ustar rootroot use Apache::SessionX ; use strict ; use vars qw(@tests %stdargs $timeout $errors) ; @tests = @Apache::SessionX::Config::confs ; %stdargs = ( SemaphoreKey => 0x7654, ) ; $timeout = defined (&DB::DB)?0:2 ; $errors = 0 ; my $cfg = shift ; my $x = shift ; my %sess ; my $obj = tie (%sess, 'Apache::SessionX', undef, { %stdargs, 'config' => $cfg, lazy => 1, create_unknown => 1, Transaction => 1}) or die ("Cannot tie to Apache::SessionX") ; $| = 1 ; my $i ; while ($i < 10) { $obj -> setidfrom ('counter') ; my $n = $sess{count} ; #print "<[$$] $cfg = $n> " ; print "$x$n " ; $sess{count} = $n + 1 ; $obj -> cleanup ; $i++ ; } Apache-SessionX-2.01/test.pl0000755000000000000000000002765607630410747014433 0ustar rootroot use Apache::SessionX ; use Apache::SessionX::Config ; use Apache::SessionX::Manager ; use Config ; BEGIN { eval "use Time::HiRes qw(gettimeofday tv_interval) ;" ; } use strict ; use vars qw(@tests %stdargs $timeout $errors $numprocs $win32) ; $win32 = ($Config{osname} =~ /win32/i) ; if (@ARGV) { @tests = @ARGV ; } else { @tests = @Apache::SessionX::Config::confs ; } %stdargs = ( SemaphoreKey => 0x7654, ) ; $timeout = defined (&DB::DB)?0:5 ; $numprocs = 5 ; $errors = 0 ; sub Check { my ($sess, $key, $val) = @_ ; if ($sess -> {$key} eq $val) { #print "ok\n" ; } else { print "\n\tERROR: $key should be $val but is $sess->{$key}\n" ; $errors++ ; } } sub Error { my ($msg) = @_ ; print "ERROR: $msg\n" ; #push @errors, $msg ; $errors++ ; } sub dosimpletest { my ($num, $msg, $cfg, $args, $args2, $id) = @_ ; my $sid ; my $init ; my $mod ; printf ('#%02d %-30s', $num, "$msg...") ; { my %sess ; my $obj = tie (%sess, 'Apache::SessionX', undef, { %stdargs, 'config' => $cfg, %$args}) or Error ("Cannot tie to Apache::SessionX") ; if ($args -> {lazy} && $obj -> getid) { Error ("is not lazy, id is not undef before access") ; return ; } elsif (!$args -> {lazy} && !$obj -> getid) { Error ("id is missing") ; return ; } $sess{'A' . $num} = 1 + $num * 2; $sess{'B' . $num} = 2 + $num * 2; ($init, $sid, $mod) = $obj -> getids ; if (($args -> {newid} || $args -> {recreate_id}) && $id && $id eq $sid) { Error ("id should have changed, but didn't (id=$id, session id=$sid") ; return ; } elsif (!($args -> {newid} || $args -> {recreate_id}) && $id && $id ne $sid) { Error ("id has changed, but should be the same (id=$id, session id=$sid") ; return ; } #print $sid, ' ' ; untie %sess ; %sess = () ; } { my %sess ; my $obj = tie (%sess, 'Apache::SessionX', $args2 && $args->{idfrom}?undef:$sid, {%stdargs, 'config' => $cfg, $args2?%$args:()}) or Error ("Cannot tie to Apache::SessionX") ; my $e = $errors ; Check (\%sess, 'A' . $num, 1 + $num * 2) ; Check (\%sess, 'B' . $num, 2 + $num * 2) ; my $nid ; ($init, $nid, $mod) = $obj -> getids ; if ($args -> {newid} && $nid eq $sid) { Error ("is not a newid, id didn't change (old id=$sid, init id=$init") ; return ; } print "ok\n" if ($e == $errors) ; untie %sess ; } } sub simpletest { local $SIG{ALRM} = sub { Error ("Time out. Locking not working properly") } ; alarm $timeout if (!$win32) ; dosimpletest (@_) ; alarm 0 if (!$win32) ; } sub dopersisttest { my ($num, $msg, $cfg, $args, $args2, $id) = @_ ; my $sid ; my $init ; my $mod ; printf ('#%02d %-30s', $num, "$msg...") ; { my %sess ; my $obj = tie (%sess, 'Apache::SessionX', undef, { %stdargs, 'config' => $cfg, %$args}) or Error ("Cannot tie to Apache::SessionX") ; if ($args -> {lazy} && $obj -> getid) { Error ("is not lazy, id is not undef before access") ; return ; } elsif (!$args -> {lazy} && !$obj -> getid) { Error ("id is missing") ; return ; } $sess{'A' . $num} = 1 + $num * 2; $sess{'B' . $num} = 2 + $num * 2; $sid = $obj -> getid ; if (($args -> {newid} || $args -> {recreate_id}) && $id && $id eq $sid) { Error ("id should have changed, but didn't (id=$id, session id=$sid") ; return ; } elsif (!($args -> {newid} || $args -> {recreate_id}) && $id && $id ne $sid) { Error ("id has changed, but should be the same (id=$id, session id=$sid") ; return ; } $obj -> cleanup ; if ($obj -> getid) { Error ("id should be empty after cleanup") ; return ; } if ($args -> {idfrom}) { $obj -> setidfrom ($args -> {idfrom}) ; } else { $obj -> setid ($sid) ; } my $e = $errors ; Check (\%sess, 'A' . $num, 1 + $num * 2) ; Check (\%sess, 'B' . $num, 2 + $num * 2) ; $sess{'C' . $num} = 2 + $num * 2; my $nid = $obj -> getid ; if ($nid ne $sid) { Error ("id has changed, but should be the same 2 (new id=$nid, session id=$sid") ; return ; } ($init, $nid, $mod) = $obj -> getids ; if ($args -> {newid} && $nid eq $sid) { Error ("is not a newid, id didn't change (old id=$sid, init id=$init") ; return ; } $sid = $nid ; $nid = undef ; $obj -> cleanup ; if ($obj -> getid) { Error ("id should be empty after cleanup 2") ; return ; } if ($args -> {idfrom}) { $obj -> setidfrom ($args -> {idfrom}) ; } else { $obj -> setid ($sid) ; } Check (\%sess, 'A' . $num, 1 + $num * 2) ; Check (\%sess, 'B' . $num, 2 + $num * 2) ; Check (\%sess, 'C' . $num, 2 + $num * 2) ; ($init, $nid, $mod) = $obj -> getids ; if ($args -> {newid} && (!$nid || $nid eq $sid)) { Error ("is not a newid, id didn't change 2 (old id=$sid, init id=$init, new id = $nid ") ; return ; } print "ok\n" if ($e == $errors) ; untie %sess ; } } sub persisttest { local $SIG{ALRM} = sub { Error ("Time out. Locking not working properly") } ; alarm $timeout if (!$win32) ; dopersisttest (@_) ; alarm 0 if (!$win32) ; } sub dofailtest { my ($num, $msg, $cfg, $args, $id) = @_ ; printf ('#%02d %-30s', $num, "$msg...") ; { my %sess ; eval { tie (%sess, 'Apache::SessionX', $id, { %stdargs, 'config' => $cfg, %$args}) or Error ("Cannot tie to Apache::SessionX") ; } ; if ($@) { print "ok\n" ; } else { Error ("should fail") ; } } } sub failtest { local $SIG{ALRM} = sub { Error ("Time out. Locking not working properly") ; } ; alarm $timeout if (!$win32) ; dofailtest (@_) ; alarm 0 if (!$win32) ; } sub preopen { my ($num, $msg, $cfg, $args, $id) = @_ ; printf ('#%02d %-30s', $num, "$msg...") ; { my %sess ; eval { tie (%sess, 'Apache::SessionX', $id, { %stdargs, 'config' => $cfg, %$args}) or Error ("Cannot tie to Apache::SessionX") ; } ; if (!$@) { print "ok\n" ; } else { Error ("failed $@") ; } } } sub concurrent { my ($num, $msg, $cfg, $args, $id) = @_ ; my $cnt ; printf ('#%02d %-30s', $num, "$msg...\n") ; my %sess ; my $obj ; eval { $obj = tie (%sess, 'Apache::SessionX', undef, { %stdargs, 'config' => $cfg, lazy => 1, create_unknown => 1, Transaction => 1}) or die ("Cannot tie to Apache::SessionX") ; } ; if ($@) { Error ("failed $@") ; return ; } $obj -> setidfrom ('counter') ; $sess{count} = 0 ; $obj -> cleanup ; for (my $n = 0; $n < $numprocs; $n++) { system ("$Config{perlpath} -MExtUtils::testlib testcount.pl '$cfg' " . chr($n + 65) . ' &') ; } my $lastcnt = -1 ; my $wait = 0 ; while (1) { $obj -> setidfrom ('counter') ; if (($cnt = $sess{count}) == $numprocs * 10) { print "\n... ok\n" ; return ; } $obj -> cleanup ; $wait = 0 if ($cnt != $lastcnt) ; $wait++ if ($cnt == $lastcnt) ; last if ($wait == 4) ; sleep 1 ; } print "\n" ; Error ("Count is $cnt should be " . ($numprocs * 10) . ". Looks like locking doesn't work correct") ; } my $time = localtime ; my $cfg ; my %time ; foreach $cfg (@tests) { my $osuser = $Apache::SessionX::Config::param{$cfg}{osuser} ; local $< ; local $> ; if ($osuser) { my $uid = getpwnam($osuser) ; $< = $uid ; $> = $uid ; } print "\n** Testing configuration '$cfg': $Apache::SessionX::Config::param{$cfg}{Info}...\n" ; my $n = 0 ; preopen ($n++, "o Open", $cfg, {}) ; my $t0 = eval { [gettimeofday()] } || [0] ; simpletest ($n++, "s No Args", $cfg, {}) ; simpletest ($n++, "s Lazy", $cfg, {lazy => 1}) ; failtest ($n++, "f unknown id", $cfg, {}, 'aa') ; failtest ($n++, "f unknown id", $cfg, {}, 'aa') ; failtest ($n++, "f unknown idfrom", $cfg, {idfrom => 'blabla' . $cfg . $time}) ; failtest ($n++, "f unknown idfrom", $cfg, {idfrom => 'blabla' . $cfg . $time}) ; simpletest ($n++, "s create_unknown", $cfg, {create_unknown => 1}, 'aabb') ; simpletest ($n++, "s Idfrom, create_unknown, id", $cfg, {idfrom => 'blabla1' . $cfg . $time, create_unknown => 1}) ; simpletest ($n++, "s Idfrom, create_unknown", $cfg, {idfrom => 'blabla2' . $cfg . $time, create_unknown => 1}, 1) ; simpletest ($n++, "s create_unknown, recreate", $cfg, {recreate_id => 1, create_unknown => 1}, undef, 'aabbcc') ; simpletest ($n++, "s newid", $cfg, {newid => 1}, 1) ; simpletest ($n++, "s newid, lazy", $cfg, {newid => 1, lazy => 1}, 1) ; simpletest ($n++, "s newid 2", $cfg, {newid => 1, create_unknown => 1}, 1, 'aabbcc') ; persisttest ($n++, "p Lazy", $cfg, {lazy => 1}) ; persisttest ($n++, "p create_unknown", $cfg, {lazy => 1, create_unknown => 1}, 'aabb') ; persisttest ($n++, "p Idfrom, create_unknown, id", $cfg, {lazy => 1, idfrom => 'blabla3' . $cfg . $time, create_unknown => 1}) ; persisttest ($n++, "p Idfrom, create_unknown", $cfg, {lazy => 1, idfrom => 'blabla4' . $cfg . $time, create_unknown => 1}, 1) ; persisttest ($n++, "p create_unknown, recreate", $cfg, {lazy => 1, recreate_id => 1, create_unknown => 1}, undef, 'aabbcc') ; persisttest ($n++, "p newid", $cfg, {lazy => 1, newid => 1}, 1) ; persisttest ($n++, "p newid, lazy", $cfg, {lazy => 1, newid => 1}, 1) ; persisttest ($n++, "p newid 2", $cfg, {lazy => 1, newid => 1, create_unknown => 1}, 1, 'aabbcc') ; my $t1 = eval { [gettimeofday()] } || [0] ; concurrent ($n++, "c concurrent access", $cfg) ; print "** ", $time{$cfg} = eval { tv_interval ($t0, $t1) } || 0 , "s\n" ; my $mgr = Apache::SessionX::Manager -> new ({config => $cfg}) ; my $id ; my $cnt = eval { $mgr -> count_sessions ; } ; if (!$@) { print "Found $cnt sessions\n" ; my $cnt2 = 0 ; while ($id = $mgr -> next_session_id) { #print $id, "\n" ; $cnt2++ ; } Error ("count_sessions ($cnt) and next_session_id ($cnt2) counts differs") if ($cnt != $cnt2) ; } else { print "SessionManager not supported by $cfg\n" ; } } if ($errors) { print "Found $errors ERRORS\n" ; } else { print "All tests successfull\n" ; } Apache-SessionX-2.01/SessionX.pm0000755000000000000000000004155210334554207015212 0ustar rootroot################################################################################### # # Apache::SessionX - Copyright (c) 1999-2001 Gerald Richter / ecos gmbh # Copyright(c) 1998, 1999 Jeffrey William Baker (jeffrey@kathyandjeffrey.net) # # You may distribute under the terms of either the GNU General Public # License or the Artistic License, as specified in the Perl README file. # # THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED # WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. # # $Id: SessionX.pm,v 1.4 2001/12/04 13:33:39 richter Exp $ # ################################################################################### package Apache::SessionX ; use strict; use vars qw(@ISA $VERSION); $VERSION = '2.01'; @ISA = qw(Apache::Session); use Apache::Session; use Apache::SessionX::Config ; use constant NEW => Apache::Session::NEW () ; use constant MODIFIED => Apache::Session::MODIFIED () ; use constant DELETED => Apache::Session::DELETED () ; use constant SYNCED => Apache::Session::SYNCED () ; sub TIEHASH { my $class = shift; my $session_id = shift; my $args = shift || {}; if(ref $args ne "HASH") { die "Additional arguments should be in the form of a hash reference"; } my $config = $args -> {config} || $Apache::SessionX::Config::default; foreach my $cfg (keys (%{$Apache::SessionX::Config::param{$config}})) { $args -> {$cfg} = $Apache::SessionX::Config::param{$config} -> {$cfg} if (!exists $args -> {$cfg}) ; } my $self = { args => $args, data => { _session_id => $session_id }, initial_session_id => $session_id, lock => 0, lock_manager => undef, object_store => undef, status => 0, serialized => undef, idfrom => $args -> {idfrom}, newid => $args -> {newid}, }; bless $self, $class; $self -> require_modules ($args) ; $self -> init if (!$args -> {'lazy'}) ; return $self ; } sub require_modules { my $self = shift ; my $args = shift ; # check object_store and lock_manager classes (Apache::Session 1.00) foreach my $mod ('Store', 'Lock', 'Generate', 'Serialize') { if ($args -> {$mod}) { if (!($args -> {$mod} =~ /::/)) { my $modname = "Apache::SessionX::$mod\:\:$args->{$mod}" ; eval "require $modname" ; if ($@) { $@ = '' ; $modname = "Apache::Session::$mod\:\:$args->{$mod}" ; eval "require $modname" ; } die "Cannot require $modname ($@)" if ($@) ; $args->{$mod} = $modname ; } else { my $modname = $args->{$mod} ; eval "require $modname" ; die "Cannot require $modname" if ($@) ; } } } } sub init { my $self = shift ; #If a session ID was passed in, this is an old hash. #If not, it is a fresh one. $self->populate; my $session_id = $self->{data}->{_session_id} ; if (!$session_id && $self -> {idfrom}) { $session_id = $self->{data}->{_session_id} = &{$self->{generate}}($self, $self -> {idfrom}) ; } $self->{initial_session_id} ||= $session_id ; if (defined $session_id && $session_id) { #check the session ID for remote exploitation attempts #this will die() on suspicious session IDs. #eval { &{$self->{validate}}($self); } ; &{$self->{validate}}($self); #if (!$@) { # session id is ok $self->{status} &= ($self->{status} ^ NEW); if ($self -> {'args'}{'create_unknown'}) { eval { $self -> restore } ; #warn "Try to load session: $@" if ($@) ; $@ = "" ; $session_id = $self->{data}->{_session_id} ; } else { $self->restore; } } } $@ = '' ; if (!($self->{status} & SYNCED)) { $self->{status} |= NEW(); if (!$self->{data}->{_session_id} || $self -> {'args'}{'recreate_id'}) { if (exists ($self->{generate})) { # Apache::Session >= 1.50 $self->{data}->{_session_id} = &{$self->{generate}}($self) ; } else { $self->{data}->{_session_id} = $self -> generate_id() ; } } $self->save; } else { $self -> {newidpending} = $self -> {newid} ; } #warn "Session INIT $self->{initial_session_id};$self->{data}->{_session_id};" ; return $self; } sub FETCH { my $self = shift; my $key = shift; $self -> init if (!$self -> {'status'}) ; return $self->{data}->{$key}; } sub STORE { my $self = shift; my $key = shift; my $value = shift; $self -> init if (!$self -> {'status'}) ; $self->{data}->{$key} = $value; $self->{status} |= MODIFIED; return $self->{data}->{$key}; } sub DELETE { my $self = shift; my $key = shift; $self -> init if (!$self -> {'status'}) ; $self->{status} |= MODIFIED; delete $self->{data}->{$key}; } sub CLEAR { my $self = shift; $self -> init if (!$self -> {'status'}) ; $self->{status} |= MODIFIED; $self->{data} = {}; } sub EXISTS { my $self = shift; my $key = shift; $self -> init if (!$self -> {'status'}) ; return exists $self->{data}->{$key}; } sub FIRSTKEY { my $self = shift; $self -> init if (!$self -> {'status'}) ; my $reset = keys %{$self->{data}}; return each %{$self->{data}}; } sub NEXTKEY { my $self = shift; $self -> init if (!$self -> {'status'}) ; return each %{$self->{data}}; } sub DESTROY { my $self = shift; $self->save if ($self -> {'status'}) ; # destroy store object to make sure all data is written and everything # is closed before we release the locks $self->{object_store} = undef ; $self->release_all_locks; } sub cleanup { my $self = shift; $self->{initial_session_id} = undef ; if ($self -> {'status'}) { $self->save; } # { # local $SIG{__WARN__} = 'IGNORE' ; # local $SIG{__DIE__} = 'IGNORE' ; # eval { $self -> {object_store} -> close } ; # Try to close file storage # $@ = "" ; # } # destroy store object to make sure all data is written and everything # is closed before we release the locks $self->{object_store} = undef ; $self->release_all_locks; $self->{'status'} = 0 ; $self->{data} = {} ; $self->{serialized} = undef ; # destroy lock object to make sure all locks are really released $self->{lock_manager} = undef ; } sub setid { my $self = shift; $self->{'status'} = 0 ; $self->{data}->{_session_id} = $self->{initial_session_id} = shift ; } sub setidfrom { my $self = shift; $self->{'status'} = 0 ; $self->{data}->{_session_id} = $self->{initial_session_id} = undef ; $self->{idfrom} = shift ; } sub getid { my $self = shift; return $self->{data}->{_session_id} ; } sub getids { my $self = shift; my $init = shift; $self -> init if ($init && !$self -> {'status'}) ; if ($self -> {newidpending} && $self->{status}) { $self->{data}->{_session_id} = &{$self->{generate}}($self) ; $self -> {newidpending} = 0 ; $self->{status} |= NEW ; } return ($self->{initial_session_id}, $self->{data}->{_session_id}, $self->{status} & MODIFIED) ; } sub delete { my $self = shift; return if ($self->{status} & NEW); $self->{initial_session_id} = "!DELETE" ; $self -> init if (!$self -> {'status'}) ; $self->{status} |= DELETED; $self->save; $self->{data} = {} ; # Throw away the data } sub restore { my $self = shift; return if ($self->{status} & SYNCED); return if ($self->{status} & NEW); if (exists $self -> {'args'}->{Transaction} && $self -> {'args'}->{Transaction}) { $self->acquire_write_lock; } else { $self->acquire_read_lock; } $self->{object_store}->materialize($self); &{$self->{unserialize}}($self); $self->{status} &= ($self->{status} ^ MODIFIED); $self->{status} |= SYNCED } sub save { my $self = shift; return unless ( $self->{status} & MODIFIED || $self->{status} & NEW || $self->{status} & DELETED ); if ($self -> {newidpending}) { $self->{data}->{_session_id} = &{$self->{generate}}($self) ; $self -> {newidpending} = 0 ; $self->{status} |= NEW ; } $self->acquire_write_lock; if ($self->{status} & DELETED) { $self->{object_store}->remove($self); $self->{status} |= SYNCED; $self->{status} &= ($self->{status} ^ MODIFIED); $self->{status} &= ($self->{status} ^ DELETED); return; } if ($self->{status} & NEW) { &{$self->{serialize}}($self); $self->{object_store}->insert($self); $self->{status} &= ($self->{status} ^ NEW); $self->{status} |= SYNCED; $self->{status} &= ($self->{status} ^ MODIFIED); return; } if ($self->{status} & MODIFIED) { &{$self->{serialize}}($self); $self->{object_store}->update($self); $self->{status} &= ($self->{status} ^ MODIFIED); $self->{status} |= SYNCED; return; } } # # For Apache::Session 1.00 # sub get_object_store { my $self = shift; return new {$self -> {'args'}{'object_store'}} $self; } sub get_lock_manager { my $self = shift; return new {$self -> {'args'}{'lock_manager'}} $self; } # # Default validate for Apache::Session < 1.53 # sub validate { #This routine checks to ensure that the session ID is in the form #we expect. This must be called before we start diddling around #in the database or the disk. my $session = shift; if ($session->{data}->{_session_id} !~ /^[a-fA-F0-9]+$/) { die 'Invalid session id' ; } } # # For Apache::Session >= 1.50 # sub populate { my $self = shift; my $store = $self->{args}->{Store}; my $lock = $self->{args}->{Lock}; if (!$self->{populated}) { my $gen = $self->{args}->{Generate}; my $ser = $self->{args}->{Serialize}; $self->{object_store} = new $store $self if ($store) ; $self->{lock_manager} = new $lock $self if ($lock); $self->{generate} = \&{$gen . '::generate'} if ($gen); $self->{'validate'} = \&{$gen . '::validate'} if ($gen && defined (&{$gen . '::validate'})); $self->{serialize} = \&{$ser . '::serialize'} if ($ser); $self->{unserialize} = \&{$ser . '::unserialize'} if ($ser) ; if (!defined ($self->{'validate'})) { $self->{'validate'} = \&validate ; } $self->{populated} = 1 ; } else { # recreate only store & lock classes as far as necessary $self->{object_store} ||= new $store $self if ($store) ; $self->{lock_manager} ||= new $lock $self if ($lock); } return $self; } 1 ; __END__ =head1 NAME Apache::SessionX - An extented persistence framework for session data =head1 SYNOPSIS =head1 DESCRIPTION Apache::SessionX extents Apache::Session. It was initialy written to use Apache::Session from inside of HTML::Embperl, but is seems to be usefull outside of Embperl as well, so here is it as standalone module. Apache::Session is a persistence framework which is particularly useful for tracking session data between httpd requests. Apache::Session is designed to work with Apache and mod_perl, but it should work under CGI and other web servers, and it also works outside of a web server altogether. Apache::Session consists of five components: the interface, the object store, the lock manager, the ID generator, and the serializer. The interface is defined in SessionX.pm, which is meant to be easily subclassed. The object store can be the filesystem, a Berkeley DB, a MySQL DB, an Oracle DB, or a Postgres DB. Locking is done by lock files, semaphores, or the locking capabilities of MySQL and Postgres. Serialization is done via Storable, and optionally ASCII-fied via MIME or pack(). ID numbers are generated via MD5. The reader is encouraged to extend these capabilities to meet his own requirements. =head1 INTERFACE The interface to Apache::SessionX is very simple: tie a hash to the desired class and use the hash as normal. The constructor takes two optional arguments. The first argument is the desired session ID number, or undef for a new session. The second argument is a hash of options that will be passed to the object store and locker classes. =head2 Addtional Attributes for TIE =over 4 =item lazy By Specifing this attribute, you tell Apache::Session to not do any access to the object store, until the first read or write access to the tied hash. Otherwise the B function will make sure the hash exist or creates a new one. =item create_unknown Setting this to one causes Apache::Session to create a new session with the given id (or a new id, depending on C) when the specified session id does not exists. Otherwise it will die. =item recreate_id Setting this to one causes Apache::Session to create a new session id when the specified session id does not exists. =item idfrom instead of passing in a session id, you can pass in a string, from which Apache::SessionX generates the id in case it needs one. The main advantage from generating the id by yourself is, that in 'lazy' mode the id is only generated when the session is accessed. =item newid Setting this to one will cause Apache::SessionX to generate a new id every time the session is saved. If you call C or C it will return the new id that will be used to save the data. =item config Use predefiend config from Apache::SessionX::Config, which is defined by Makefile.PL =item object_store Specify the class for the object store. (The Apache::Session:: prefix is optional) Only for Apache::Session 1.00. =item lock_manager Specify the class for the lock manager. (The Apache::Session:: prefix is optional) Only for Apache::Session 1.00. =item Store Specify the class for the object store. (The Apache::Session::Store prefix is optional) Only for Apache::Session 1.5x. =item Lock Specify the class for the lock manager. (The Apache::Session::Lock prefix is optional) Only for Apache::Session 1.5x. =item Generate Specify the class for the id generator. (The Apache::Session::Generate prefix is optional) Only for Apache::Session 1.5x. =item Serialize Specify the class for the data serializer. (The Apache::Session::Serialize prefix is optional) Only for Apache::Session 1.5x. =back Example using attrubtes to specfiy store and object classes instead of a derived class: use Apache::SessionX tie %session, 'Apache::SessionX', undef, { object_store => 'DBIStore', lock_manager => 'SysVSemaphoreLocker', DataSource => 'dbi:Oracle:db' }; NOTE: Apache::SessionX will C the nessecary additional perl modules for you. =head2 Addtional Methods =over 4 =item setid ($id) Set the session id for futher accesses. =item setidfrom ($string) Set the string that is passed to the generate function to compute the id. =item getid Get the session id. The difference to using $session{_session_id} is, that in lazy mode, getid will B create a new session id, if it doesn't exists. =item getids ($init) return the an array where the first element is the initial id, the second element is the current id and the third element is set to true, when the session data was modified. If the session was deleted, the initial id (first array value) will be set to '!DELETE'. If the optional parameter $init is set to true, getids will initialize the session (i.e. read from the store) when not already done. =item cleanup Writes any pending data, releases all locks and deletes all data from memory. =back =head1 SEE ALSO =over 4 =item See documentation of Apache::Session for more informations about it's internals =item Apache::SessionX::Generate::MD5 =item Apache::Session::Store::* =item Apache::Session::Lock::* =item Apache::Session::Serialize::* =back =head1 AUTHORS Gerald Richter is the current maintainer. This class was written by Jeffrey Baker (jeffrey@kathyandjeffrey.net) but it is taken wholesale from a patch that Gerald Richter (richter@ecos.de) sent me against Apache::Session. Apache-SessionX-2.01/SessionX/0000755000000000000000000000000010336267110014636 5ustar rootrootApache-SessionX-2.01/SessionX/Manager.pm0000644000000000000000000000456307443340530016561 0ustar rootroot################################################################################### # # Apache::SessionX - Copyright (c) 1999-2001 Gerald Richter / ecos gmbh # Copyright(c) 1998, 1999 Jeffrey William Baker (jeffrey@kathyandjeffrey.net) # # You may distribute under the terms of either the GNU General Public # License or the Artistic License, as specified in the Perl README file. # # THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED # WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. # # $Id: Manager.pm,v 1.1 2002/03/12 08:50:32 richter Exp $ # ################################################################################### package Apache::SessionX::Manager ; use strict; use vars qw(@ISA $VERSION); $VERSION = '2.00b5'; use Apache::Session; use Apache::SessionX::Config ; sub new { my $class = shift; my $args = shift || {}; if(ref $args ne "HASH") { die "Additional arguments should be in the form of a hash reference"; } my $config = $args -> {config} || $Apache::SessionX::Config::default; foreach my $cfg (keys (%{$Apache::SessionX::Config::param{$config}})) { $args -> {$cfg} = $Apache::SessionX::Config::param{$config} -> {$cfg} if (!exists $args -> {$cfg}) ; } my $self = { args => $args, }; bless $self, $class; Apache::SessionX -> require_modules ($args) ; Apache::SessionX::populate ($self) ; return $self ; } sub count_sessions { my $self = shift; return $self->{object_store}->count_sessions($self); } sub first_session_id { my $self = shift; return $self->{object_store}->first_session_id($self); } sub next_session_id { my $self = shift; return $self->{object_store}->next_session_id($self); } sub first_session { my $self = shift; my %session ; my $id = $self -> first_session_id ; return undef if (!$id) ; tie %session, 'Apache::SessionX', $id, $self -> {args} ; return \%session ; } sub next_session { my $self = shift; my $id = $self -> next_session_id ; my %session ; return undef if (!$id) ; tie %session, 'Apache::SessionX', $id, $self -> {args} ; return \%session ; } Apache-SessionX-2.01/SessionX/Generate/0000755000000000000000000000000010336267110016370 5ustar rootrootApache-SessionX-2.01/SessionX/Generate/MD5.pm0000644000000000000000000000525310334554125017323 0ustar rootroot############################################################################# # # Apache::SessionX::Generate::MD5; # Generates session identifier tokens using MD5 # Copyright (c) 2001 Gerald Richter / ecos gmbh # Copyright (c) 2000 Jeffrey William Baker (jwbaker@acm.org) # Distribute under the Artistic License # ############################################################################ package Apache::SessionX::Generate::MD5; use strict; use vars qw($VERSION); use Digest::MD5 () ; $VERSION = '2.2'; sub generate { my $session = shift; my $arg = shift; my $length = 32; if (exists $session->{args}->{IDLength}) { $length = $session->{args}->{IDLength}; } $session->{data}->{_session_id} = substr(Digest::MD5::md5_hex(Digest::MD5::md5_hex($arg || (time(). {}. rand(). $$))), 0, $length); } sub validate { #This routine checks to ensure that the session ID is in the form #we expect. This must be called before we start diddling around #in the database or the disk. my $session = shift; if ($session->{data}->{_session_id} !~ /^[a-fA-F0-9]+$/) { die 'Invalid session id' ; } } 1; =pod =head1 NAME Apache::Session::Generate::MD5 - Use MD5 to create random object IDs =head1 SYNOPSIS use Apache::SessionX::Generate::MD5; $id = Apache::SessionX::Generate::MD5::generate($string); =head1 DESCRIPTION This module fulfills the ID generation interface of Apache::SessionX. If you don't give the argument C<$string>, the IDs are generated using a two-round MD5 of a random number, the time since the epoch, the process ID, and the address of an anonymous hash. The resultant ID number is highly entropic on Linux and other platforms that have good random number generators. You are encouraged to investigate the quality of your system's random number generator if you are using the generated ID numbers in a secure environment. If you give C<$string> the ID is the MD5 hash of that string. This module can also examine session IDs to ensure that they are, indeed, session ID numbers and not evil attacks. The reader is encouraged to consider the effect of bogus session ID numbers in a system which uses these ID numbers to access disks and databases. This modules takes one argument in the usual Apache::Session style. The argument is IDLength, and the value, between 0 and 32, tells this module where to truncate the session ID. Without this argument, the session ID will be 32 hexadecimal characters long, equivalent to a 128-bit key. =head1 AUTHOR This module was written by Jeffrey William Baker and modified by Gerald Richter . =head1 SEE ALSO L Apache-SessionX-2.01/SessionX/Store/0000755000000000000000000000000010336267110015732 5ustar rootrootApache-SessionX-2.01/SessionX/Store/File.pm0000644000000000000000000000275207630410553017161 0ustar rootrootpackage Apache::SessionX::Store::File; use strict; use Symbol; use vars qw($VERSION @ISA); $VERSION = '2.00b5'; @ISA = ('Apache::Session::Store::File') ; use Apache::Session::Store::File; sub count_sessions { my $self = shift; my $session = shift; my $directory = $session->{args}->{Directory} || die 'Directory param missing!'; opendir(DIR,$directory); my $count = grep { /^[0-9a-fA-F]+$/ } readdir(DIR); closedir(DIR); return $count; # print STDERR "Apache::SessionX::Store::File ($tmp)--- we are here\n"; } sub first_session_id { my $self = shift; my $session = shift; my $file; my $directory = $session->{args}->{Directory} || die 'Directory param missing!'; $self->{dir} = Symbol::gensym(); opendir $self->{dir}, $directory; $file = readdir $self->{dir}; while ($file && ($file !~ /^[0-9a-fA-F]+$/)) { #print STDERR "\tfile: $file\n"; $file = readdir $self->{dir}; #print STDERR "\tfile/first: $file\n"; } return $file; } sub next_session_id { my $self = shift; my $session = shift; my $file; return $self -> first_session_id ($session) if (!$self->{dir}) ; $file = readdir $self->{dir}; while ($file && ($file !~ /^[0-9a-fA-F]+$/)) { #print STDERR "\tfile: $file\n"; $file = readdir $self->{dir}; #print STDERR "\tfile/next: $file\n"; } closedir $self->{dir} if (!$file) ; return $file; } 1; Apache-SessionX-2.01/Makefile.PL0000755000000000000000000002131607352033400015040 0ustar rootroot################################################################################### # # Apache::SessionX - Copyright (c) 2001 Gerald Richter / ecos gmbh # # You may distribute under the terms of either the GNU General Public # License or the Artistic License, as specified in the Perl README file. # # THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED # WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. # # $Id: Makefile.PL,v 1.3 2001/09/19 06:11:01 richter Exp $ # ################################################################################### use ExtUtils::MakeMaker; %Store = ( 'File' => { param => { 'Store' => 'File', 'Lock' => 'Semaphore', 'Serialize' => 'Storable', 'Directory' => '?', 'Info' => 'File, use semaphore for locking', }, 'require' => [ 'IPC::SysV', ], }, 'FileFile' => { param => { 'Store' => 'File', 'Lock' => 'File', 'Serialize' => 'Storable', 'Directory' => '?', 'LockDirectory' => '?', 'Info' => 'File, use lockfiles', }, }, 'DB_File' => { param => { 'Lock' => 'File', 'Serialize' => 'Storable', 'FileName' => '?', 'LockDirectory' => '?', }, }, 'Mysql' => { param => { 'Store' => 'MySQL', 'Lock' => 'Semaphore', 'Serialize' => 'Storable', 'DataSource' => '?', 'UserName' => '?', 'Password' => '?', 'Info' => 'MySQL, use semaphore for locking', }, 'require' => [ 'DBD::mysql', 'IPC::SysV', ], }, 'MysqlMysql' => { param => { 'Store' => 'MySQL', 'Lock' => 'MySQL', 'Serialize' => 'Storable', 'DataSource' => '?', 'UserName' => '?', 'Password' => '?', 'LockDataSource' => '?', 'LockUserName' => '?', 'LockPassword' => '?', 'Info' => 'MySQL, use MySQL for locking', }, 'require' => [ 'DBD::mysql', ], }, 'Oracle' => { param => { 'Lock' => 'Null', 'Serialize' => 'Base64', 'Commit' => 1, 'DataSource' => '?', 'UserName' => '?', 'Password' => '?', }, 'require' => [ 'DBD::Oracle', ], }, 'Sybase' => { param => { 'Lock' => 'Null', 'Serialize' => 'Sybase', 'Commit' => 1, 'DataSource' => '?', 'UserName' => '?', 'Password' => '?', }, 'require' => [ 'DBD::Sybase', ], }, 'Postgres' => { param => { 'Lock' => 'Null', 'Serialize' => 'Base64', 'Commit' => 1, 'DataSource' => '?', 'UserName' => '?', 'Password' => '?', }, 'require' => [ 'DBD::Pg', ], }, ) ; ## ---------------------------------------------------------------------------- sub GetString { my ($prompt, $default) = @_ ; printf ("%s [%s]", $prompt, $default) ; chop ($_ = ) ; #$_ = prompt ($prompt, $default) ; if (!/^\s*$/) {return $_ ;} else { if ($_ eq "") {return $default ;} else { return "" ; } } } ## ---------------------------------------------------------------------------- sub GetYesNo { my ($prompt, $default) = @_ ; my ($value) ; do { $value = lc (GetString ($prompt . "(y/n)", ($default?"y":"n"))) ; } until (($value cmp "j") == 0 || ($value cmp "y") == 0 || ($value cmp "n" ) == 0) ; return ($value cmp "n") != 0 ; } # --------------------------------------------------------------------------- print "\nChecking configuration...\n" ; store: foreach $store (sort keys %Store) { $data = $Store{$store} ; $info = $data -> {param}{Info} ||= $store ; if ($data -> {'require'}) { foreach $require (@{$data -> {'require'}}) { eval "require $require" ; if ($@) { print "Storage '$info' is unavailable because $require is not installed on your system\n" ; next store ; } } } push @avail, $store ; } print "\nThe following ways to store session are available on your system:\n" ; foreach $store (@avail) { $data = $Store{$store} ; $info = $data -> {param}{Info} ; printf (" - %-20s: %s\n", $store, $info) ; } eval { require 'SessionX/Config.pm' ; } ; if (!keys %Apache::SessionX::Config::param) { eval { require Apache::SessionX::Config ; } ; } if (keys %Apache::SessionX::Config::param) { %param = %Apache::SessionX::Config::param ; @conf = @Apache::SessionX::Config::confs ; $input = GetYesNo ("Found previous configuration. Modify it", 0) ; } else { %param = map { $_ => {} } @avail ; $input = 1 ; } if ($input) { @conf = () ; print "\n" ; print "You can now specify the configuration parameters for every storage.\n" ; print "Apache::SessionX uses this for testing your system and stores it for later\n" ; print "use in your application. You can override these default parameters anytime\n" ; print "at runtime. You can change them by rerunning Makefile.PL.\n" ; print "\nIf you don't plan to use different storages for session, \nonly say Yes to the one storage you want to use.\n" ; foreach $store (@avail) { print "\n" ; $data = $Store{$store} ; $info = $data -> {param}{Info} ; if (GetYesNo("Would you like to configure $info ($store)", $param{$store}?1:0)) { push @conf, $store ; $param{$store} = { %{$data->{param}} } if (!keys %{$param{$store}}) ; while (($param, $value) = each (%{$data->{param}})) { if ($value eq '?') { $value = GetString ($param, $param{$store}{$param} eq '?'?'':$param{$store}{$param}) ; $param{$store}{$param} = $value ; } } $param{$store}{'Store'} ||= $store ; $param{$store}{'Serialize'} ||= 'Storeable' ; $param{$store}{'Lock'} ||= 'Semaphore' ; $param{$store}{'Generate'} ||= 'MD5' ; } } print "\n" ; $i = 1 ; foreach $store (@conf) { $data = $Store{$store} ; $info = $data -> {param}{Info} ; print " $i: $info ($store)\n" ; $def = $i if ($Apache::SessionX::Config::default eq $store) ; $i++ ; } $i-- ; if ($i == 1) { $default = 0 ; } else { $default = GetString ("Which of the above should be your default store (1-$i)", $def || '') ; $default-- ; } } print "Using $conf[$default] as default\n" ; open FH, ">SessionX/Config.pm" or die "Cannot open SessionX/Config.pm for writing ($!)" ; print FH qq{ # # Apache::SessionX configuration # # Autogenerated by Makefile.PL, do not edit! # package Apache::SessionX::Config ; \$default = '$conf[$default]' ; \@confs = ('} ; print FH join ("','", @conf) ; print FH qq{') ; \%param = ( } ; foreach $store (@conf) { $p = $param{$store} ; print FH " '$store' => \n" ; print FH " {\n" ; while (($param, $value) = each (%$p)) { print FH " '$param' => '$value',\n" ; } print FH " },\n" ; } print FH qq{ ) ; \$defaultparam = \$param{'$conf[$default]'} ; 1 ; } ; close FH ; # --------------------------------------------------------------------------- WriteMakefile ( 'NAME' => 'Apache::SessionX', 'VERSION_FROM' => 'SessionX.pm', # finds $VERSION 'PREREQ_PM' => { 'Apache::Session' => 1.53 }, 'ABSTRACT' => 'Web Session Management - based on Apache::Session', 'AUTHOR' => 'Gerald Richter ', ); Apache-SessionX-2.01/META.yml0000644000000000000000000000052710336267110014340 0ustar rootroot# http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: Apache-SessionX version: 2.01 version_from: SessionX.pm installdirs: site requires: Apache::Session: 1.53 distribution_type: module generated_by: ExtUtils::MakeMaker version 6.17 Apache-SessionX-2.01/CHANGES0000644000000000000000000000021210336267045014060 0ustar rootroot 2.01 15. Nov. 2005 - fixes security problem in session_id validation, which allows createtion of session with invalid id's. Apache-SessionX-2.01/MANIFEST0000644000000000000000000000033710336267063014226 0ustar rootrootMANIFEST Makefile.PL SessionX.pm README SessionX/Generate/MD5.pm SessionX/Store/File.pm SessionX/Manager.pm test.pl testcount.pl README META.yml Module meta-data (added by MakeMaker) CHANGES