view release on metacpan or  search on metacpan

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

$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;

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

    $internal->LOCK;
    my $master = $internal->{CleanupMaster} || 
      {
       ServerID => '',
       PID => 0,
       Checked => 0,       
      };

    my $is_master = (($master->{ServerID} eq $ServerID) and ($master->{PID} eq $$)) ? 1 : 0;
    $self->{dbg} && $self->Debug(current_master => $master, is_master => $is_master );
    my $stale_time = $is_master ? $self->{group_refresh} / 4 : 
      $self->{group_refresh} / 2 + int($self->{group_refresh} * rand() / 2) + 1;
    $stale_time += $master->{Checked};
    
    if($stale_time < time()) {
	$internal->{CleanupMaster} =
	  {
	   ServerID => $ServerID,
	   PID => $$,
	   Checked => time()
	  };
	$internal->UNLOCK; # flush write
	$self->{dbg} && $self->Debug("$stale_time time is stale, is_master $is_master", $master);
	
	# we are only worried about multiprocess NFS here ... if running not
	# in mod_perl mode, probably just CGI mounted on local disk
	# Only do this while in DESTROY() mode too, so we avoid Application_OnStart
	# hang behavior.
	if($^O !~ /Win/ && $ENV{MOD_PERL} && $self->{DESTROY}) {
	    $self->Debug("sleep for acquire master check in case of shared state");
	    sleep(1);
	}
	
	my $master = $internal->{CleanupMaster}; # recheck after flush
	my $is_master = (($master->{ServerID} eq $ServerID) and ($master->{PID} eq $$)) ? 1 : 0;
	$self->{dbg} && $self->Debug("is_master $is_master after update $ServerID - $$");
	$is_master;
    } elsif($is_master) {
	$master->{Checked} = time();
	$internal->{CleanupMaster} = $master;
	$internal->UNLOCK;
	$self->{dbg} && $self->Debug("$stale_time time is fresh, is_master $is_master", $master);
	1; # is master
    } else {
	$internal->UNLOCK;
	$self->{dbg} && $self->Debug("$stale_time time is fresh, is_master $is_master", $master);
	0; # not master
    }
}

# combo get / set
sub SessionId {
    my($self, $id) = @_;

    if(defined $id) {
	unless($self->{session_url_force}) {
	    # don't set the cookie when we are just using SessionQuery* configs
	    my $secure = $self->{secure_session} ? '; secure' : '';
	    my $httponly = $self->{http_only_session} ? '; HttpOnly' : '';
	    my $domain = $self->{cookie_domain}  ? '; domain='.$self->{cookie_domain} : '';
	    $self->{r}->err_headers_out->add('Set-Cookie', "$SessionCookieName=$id; path=$self->{cookie_path}".$domain.$secure.$httponly);
	}
	$self->{session_id} = $id;
    } else {
	# if we have already parsed it out, return now
	# quick session_id caching, mostly for use with 
	# cookie less url building
	$self->{session_id} && return $self->{session_id};

	my $session_cookie = 0;

	unless($self->{session_url_force}) {
	    # don't read the cookie when we are just using SessionQuery* configs
	    my $cookie = $self->{r}->headers_in->{"Cookie"} || '';
	    my(@parts) = split(/\;\s*/, $cookie);
	    for(@parts) {	
		my($name, $value) = split(/\=/, $_, 2);
		if($name eq $SessionCookieName) {
		    $id = $value;
		    $session_cookie = 1;
		    $self->{dbg} && $self->Debug("session id from cookie: $id");
		    last;
		}
	    }
	}

	my $session_from_url;
	if(! defined($id) && $self->{session_url}) {
	    $id = delete $self->{Request}{QueryString}{$SessionCookieName};	    
	    # if there was more than one session id in the query string, then just
	    # take the first one
	    ref($id) =~ /ARRAY/ and ($id) = @$id;
	    $id && $self->{dbg} && $self->Debug("session id from query string: $id");
	    $session_from_url = 1;
	}

	# SANTIZE the id against hacking
	if(defined $id) {
	    if($id =~ /^[0-9a-z]{8,32}$/s) {
		# at least 8 bytes, but less than 32 bytes
		$self->{session_id} = $id;
	    } else {
		$self->Log("passed in session id $id failed checks sanity checks");
		$id = undef;		
	    }
	}

	if ($session_from_url && defined $id) {
	    $self->SessionId($id);
	}

	if(defined $id) {
	    $self->{session_id} = $id;
	    $self->{session_cookie} = $session_cookie;
	}
    }

    $id;
}

sub Secret {
    my $self = shift;
    # have enough data in here that even if srand() is seeded for the purpose
    # of debugging an external program, should have decent behavior.
    my $data = $self . $self->{remote_ip} . rand() . time() . 
      $self->{global} . $self->{'r'} . $self->{'filename'}.
	$$ . $ServerID;
    my $secret = substr(md5_hex($data), 0, $SessionIDLength);
    # by having [0-1][0-f] as the first 2 chars, only 32 groups now, which remains
    # efficient for inactive sites, even with empty groups
    $secret =~ s/^(.)/0/;
    $secret;
}

sub RefreshSessionId {
    my($self, $id, $reset) = @_;
    $id || $self->Error("no id for refreshing");
    my $internal = $self->{Internal};

    $internal->LOCK;
    my $idata = $internal->{$id};    
    my $refresh_timeout = $reset ? 
      $self->{session_timeout} : $idata->{refresh_timeout} || $self->{session_timeout};
    $idata->{'timeout'} = time() + $refresh_timeout;
    $internal->{$id} = $idata;	
    $internal->UNLOCK;
    $self->{dbg} && $self->Debug("refreshing $id with timeout $idata->{timeout}");

    1;