view release on metacpan or  search on metacpan

lib/Apache/ASP/StateManager.pm  view on Meta::CPAN

package Apache::ASP;

# quickly decomped out of Apache::ASP so we could load the routines only
# when we are managing State objects

use Apache::ASP::State;

use strict;
use vars qw(
  $CleanupGroups
 $SessionIDLength $SessionTimeout $StateManager
  $DefaultStateDB $DefaultStateSerializer
);

$SessionTimeout = 20;
$StateManager   = 10;

# Some OS's have hashed directory lookups up to 16 bytes, so we leave room
# for .lock extension ... nevermind, security is more important, back to 32
# $SessionIDLength = 11;
$SessionIDLength = 32;
$DefaultStateDB = 'SDBM_File';
$DefaultStateSerializer = 'Data::Dumper';

sub InitState {
    my $self = shift;
    my $r = $self->{r};
    my $global_asa = $self->{GlobalASA};

    ## STATE INITS
    # what percent of the session_timeout's time do we garbage collect
    # state files and run programs like Session_OnEnd and Application_OnEnd
    $self->{state_manager} = &config($self, 'StateManager', undef, $Apache::ASP::StateManager);

    # state is the path where state files are stored, like $Session, $Application, etc.
    $self->{state_dir}       = &config($self, 'StateDir', undef, $self->{global}.'/.state');
    $self->{state_dir}       =~ tr///; # untaint
    $self->{session_state}   = &config($self, 'AllowSessionState', undef, 1);
    $self->{state_serialize} = &config($self, 'ApplicationSerialize');

    if($self->{state_db} = &config($self, 'StateDB')) {
	# StateDB - Check StateDB module support 
	$Apache::ASP::State::DB{$self->{state_db}} ||
	  $self->Error("$self->{state_db} is not supported for StateDB, try: " . 
		       join(", ", keys %Apache::ASP::State::DB));
	$self->{state_db} =~ /^(.*)$/; # untaint
	$self->{state_db} = $1; # untaint
	# load the state database module && serializer
	$self->LoadModule('StateDB', $self->{state_db});
    }
    if($self->{state_serializer} = &config($self, 'StateSerializer')) {
	$self->{state_serializer} =~ tr///; # untaint
	$self->LoadModule('StateSerializer', $self->{state_serializer});
    }

    # INTERNAL tie to the application internal info
    my %Internal;
    tie(%Internal, 'Apache::ASP::State', $self, 'internal', 'server')
      || $self->Error("can't tie to internal state");
    my $internal = $self->{Internal} = bless \%Internal, 'Apache::ASP::State';
    $self->{state_serialize} && $internal->LOCK;

    # APPLICATION create application object
    $self->{app_state} = &config($self, 'AllowApplicationState', undef, 1);
    if($self->{app_state}) {
	# load at runtime for CGI environments, preloaded for mod_perl
	require Apache::ASP::Application;

	($self->{Application} = &Apache::ASP::Application::new($self)) 
	  || $self->Error("can't get application state");
	$self->{state_serialize} && $self->{Application}->Lock;

    } else {
	$self->{dbg} && $self->Debug("no application allowed config");
    }

    # SESSION if we are tracking state, set up the appropriate objects
    my $session;
    if($self->{session_state}) {
	## SESSION INITS
	$self->{cookie_path}       = &config($self, 'CookiePath', undef, '/');
	$self->{cookie_domain}     = &config($self, 'CookieDomain');
	$self->{paranoid_session}  = &config($self, 'ParanoidSession');

	$self->{remote_ip}         = eval { $r->connection()->remote_ip() };   # may not exist in Apache 2.4
	$self->{remote_ip}         ||= eval { $r->useragent_ip() };            # should exist in Apache 2.4, best for end user agent IP address
	$self->{remote_ip}         ||= eval { $r->connection()->client_ip() }; # if useragent_ip not defined for Apache 2.4, try this one

	$self->{session_count}     = &config($self, 'SessionCount');
	
	# cookieless session support, cascading values
	$self->{session_url_parse_match} = &config($self, 'SessionQueryParseMatch');
	$self->{session_url_parse} = $self->{session_url_parse_match} || &config($self, 'SessionQueryParse');
	$self->{session_url_match} = $self->{session_url_parse_match} || &config($self, 'SessionQueryMatch');
	$self->{session_url} = $self->{session_url_parse} || $self->{session_url_match} || &config($self, 'SessionQuery');
	$self->{session_url_force} = &config($self, 'SessionQueryForce');
	
	$self->{session_serialize} = &config($self, 'SessionSerialize');
	$self->{secure_session}    = &config($self, 'SecureSession');
	$self->{http_only_session} = &config($self, 'HTTPOnlySession');
	# session timeout in seconds since that is what we work with internally
	$self->{session_timeout}   = &config($self, 'SessionTimeout', undef, $SessionTimeout) * 60;
	$self->{'ua'}              = $self->{headers_in}->get('User-Agent') || 'UNKNOWN UA';
	# refresh group by some increment smaller than session timeout
	# to withstand DoS, bruteforce guessing attacks
	# defaults to checking the group once every 2 minutes
	$self->{group_refresh}     = int($self->{session_timeout} / $self->{state_manager});
	
	# Session state is dependent on internal state

	# load at runtime for CGI environments, preloaded for mod_perl
	require Apache::ASP::Session;

	$session = $self->{Session} = &Apache::ASP::Session::new($self)
	  || $self->Die("can't create session");
	$self->{state_serialize} && $session->Lock();
	
    } else {
	$self->{dbg} && $self->Debug("no sessions allowed config");
    }

    # update after long state init, possible with SessionSerialize config
    $self->{Response}->IsClientConnected();

    # POSTPOSE STATE EVENTS, so we can delay the Response object creation
    # until after the state objects are created
    if($session) {
	my $last_session_timeout;
	if($session->Started()) {
	    # we only want one process purging at a time
	    if($self->{app_state}) {
		$internal->LOCK();
		if(($last_session_timeout = $internal->{LastSessionTimeout} || 0) < time()) {
		    $internal->{'LastSessionTimeout'} = $self->{session_timeout} + time;
		    $internal->UNLOCK();
		    $self->{Application}->Lock;
		    my $obj = tied(%{$self->{Application}});
		    if($self->CleanupGroups('PURGE')) {
			$last_session_timeout && $global_asa->ApplicationOnEnd();
			$global_asa->ApplicationOnStart();
		    }
		    $self->{Application}->UnLock;
		} 
		$internal->UNLOCK();
	    }
	    $global_asa->SessionOnStart();
	}

	if($self->{app_state}) {
	    # The last session timeout should only be updated every group_refresh period
	    # another optimization, rand() so not all at once either
	    $internal->LOCK();
	    $last_session_timeout ||= $internal->{'LastSessionTimeout'};
	    if($last_session_timeout < $self->{session_timeout} + time + 
	       (rand() * $self->{group_refresh} / 2)) 
	      {
		  $self->{dbg} && $self->Debug("updating LastSessionTimeout from $last_session_timeout");
		  $internal->{'LastSessionTimeout'} = 
		    $self->{session_timeout} + time() + $self->{group_refresh};
	      }
	    $internal->UNLOCK();
	}
    }

    $self;
}

# Cleanup a state group, by default the group of the current session
# We do this currently in DESTROY, which happens after the current
# script has been executed, so that cleanup doesn't happen until
# after output to user
#
# We always exit unless there is a $Session defined, since we only 
# cleanup groups of sessions if sessions are allowed for this script
sub CleanupGroup {
    my($self, $group_id, $force) = @_;
    return unless $self->{Session};

    my $asp = $self; # bad hack for some moved around code
    $force ||= 0;

    # GET GROUP_ID
    my $state;
    unless($group_id) {
	$state = $self->{Session}{_STATE};
	$group_id = $state->GroupId();
    }

    # we must have a group id to work with
    $asp->Error("no group id") unless $group_id;
    my $group_key = "GroupId" . $group_id;

    # cleanup timed out sessions, from current group
    my $internal = $asp->{Internal};
    $internal->LOCK();
    my $group_check = $internal->{$group_key} || 0;
    unless($force || ($group_check < time())) {
	$internal->UNLOCK();
	return;
    }
    
    # set the next group_check, randomize a bit to unclump the group checks,
    # for 20 minute session timeout, had rand() / 2 + .5, but it was still
    # too clumpy, going with pure rand() now, even if a bit less efficient

    my $next_check = int($asp->{group_refresh} * rand()) + 1;
    $internal->{$group_key} = time() + $next_check;
    $internal->UNLOCK();

    ## GET STATE for group
    $state ||= &Apache::ASP::State::new($asp, $group_id);
    my $ids = $state->GroupMembers() || [];

    # don't return so we can't delete the empty group later
#    return unless scalar(@$ids);

    $asp->{dbg} && $asp->Debug("group check $group_id, next in $next_check sec");
    my $id = $self->{Session}->SessionID();