view release on metacpan or  search on metacpan

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

		last;
	    }
	}

	$id && $asp->RefreshSessionId($id, {});
	$asp->{Internal}->UNLOCK();	

	$asp->Log("[security] secret algorithm is no good with $trys trys")
	    if ($trys > 3);
	$asp->Error("no unique secret generated")
	    unless $id;

	$asp->{dbg} && $asp->Debug("new session id $id");
	$asp->SessionId($id);

	$state = &Apache::ASP::State::new($asp, $id);
#	$state->Set() || $asp->Error("session state set failed");

	if($asp->{paranoid_session}) {
	    $asp->Debug("storing user-agent $asp->{'ua'}");
	    $state->STORE('_UA', $asp->{'ua'});
	}
	$started = 1;
    }

    if(! $state) {
	$asp->Error("can't get state for id $id");
	return;
    }

    $state->WriteLock() if $asp->{session_serialize};
    $asp->Debug("tieing session $id");
    tie %self, 'Apache::ASP::Session',
    {
	state=>$state, 
	asp=>$asp, 
	id=>$id,
	started=>$started,
    };

    if($started) {
	$asp->{dbg} && $asp->Debug("clearing starting session");
	if($state->Size > 0) {
	    $asp->{dbg} && $asp->Debug("clearing data in old session $id");
	    %self = ();
	}
    }

    bless \%self;
}	

sub TIEHASH { 
    my($package, $self) = @_;
    bless $self;
}       

# stub so we don't have to test for it in autoload
sub DESTROY {
    my $self = shift;

    # wrapped in eval to suppress odd global destruction error messages
    # in perl 5.6.0, --jc 5/28/2001
    return unless eval { $self->{state} };

    $self->{state}->DESTROY;
    undef $self->{state};
    %$self = ();
}

# don't need to skip DESTROY since we have it here
# return if ($AUTOLOAD =~ /DESTROY/);
sub AUTOLOAD {
    my $self = shift;
    my $AUTOLOAD = $Apache::ASP::Session::AUTOLOAD;
    $AUTOLOAD =~ s/^(.*)::(.*?)$/$2/o;
    $self->{state}->$AUTOLOAD(@_);
}

sub FETCH {
    my($self, $index) = @_;

    # putting these comparisons in a regexp was a little
    # slower than keeping them in these 'eq' statements
    if($index eq '_SELF') {
	$self;
    } elsif($index eq '_STATE') {
	$self->{state};
    } elsif($index eq 'SessionID') {
	$self->{id};
    } elsif($index eq 'Timeout') {
	$self->Timeout();
    } else {
	$self->{state}->FETCH($index);
    }
}

sub STORE {
    my($self, $index, $value) = @_;
    if($index eq 'Timeout') {
	$self->Timeout($value);
    } else {	
	$self->{state}->STORE($index, $value);
    }
}

# firstkey and nextkey skip the _UA key so the user 
# we need to keep the ua info in the session db itself,
# so we are not dependent on writes going through to Internal
# for this very critical informatioh. _UA is used for security
# validation / the user's user agent.
sub FIRSTKEY {
    my $self = shift;
    my $value = $self->{state}->FIRSTKEY();
    if(defined $value and $value eq '_UA') {
	$self->{state}->NEXTKEY($value);
    } else {
	$value;
    }
}

sub NEXTKEY {