view release on metacpan or  search on metacpan

MxScreen/Session/Medium/Browser.pm  view on Meta::CPAN

#
# Retrieve session ID from the CGI environment.
# This is unused for sessions stored within the browser.
#
sub session_id {
	DFEATURE my $f_;
	my $self = shift;

	return DVAL NO_SESSION_ID if length CGI::param(MX_MD5);
	return DVAL undef;		# no session yet
}

#
# ->allocate_id			-- redefined
#
# Always return NO_SESSION_ID.
#
sub allocate_id {
	DFEATURE my $f_;
	my $self = shift;
	return DVAL NO_SESSION_ID;
}

#
# ->is_available		-- defined
#
# Look whether ID is free to use as a session ID.
# If it is free, atomically reserve it.
#
# Always returns false, since we don't use session IDs.
#
sub is_available {
	DFEATURE my $f_;
	my $self = shift;
	my ($id) = @_;

	return DVAL 0;			# No session ID can be used
}

#
# ->retrieve		-- defined
#
# Retrieve context by session ID.
#
sub retrieve {
	DFEATURE my $f_;
	my $self = shift;
	my ($id) = @_;

	DREQUIRE $id == NO_SESSION_ID, "session ID unused";
	DREQUIRE defined $self->serializer, "already called set_serializer()";

	my $md5 = CGI::param(MX_MD5);
	DASSERT length $md5, "session MD5 checksum exists";
	CGI::delete(MX_MD5);

	require MIME::Base64;
	require Crypt::CBC;
	require Digest::MD5;

	my $decoded = MIME::Base64::decode(CGI::param(MX_CONTEXT));
	my $cipher = new Crypt::CBC($self->key, CRYPT_ALGO);
	my $decrypted = $cipher->decrypt($decoded);
	CGI::delete(MX_CONTEXT);

	#
	# Before attempting to de-serialize, check the MD5 certificate.
	# Deserialization would fail anyway if the context was "corrupted".
	#

	my $digest = Digest::MD5::md5_base64($decrypted);
	if ($digest ne $md5) {
		logerr "invalid MD5 certificate";
		return DVAL undef;
	}

	#
	# Deserialize context.
	#

	return DVAL $self->serializer->deserialize($decrypted);
}

#
# ->store		-- defined
#
# Store context within browser.
#
# Returns hash of (parameter => value) to be generated in the HTML
# to identify the session.
#
sub store {
	DFEATURE my $f_;
	my $self = shift;
	my ($id, $context) = @_;

	DREQUIRE $id == NO_SESSION_ID, "session ID unused";
	DREQUIRE defined $self->serializer, "already called set_serializer()";

	my $frozen = $self->serializer->serialize($context);

	require MIME::Base64;
	require Crypt::CBC;
	require Digest::MD5;

	#
	# Compute MD5 checksum and encrypt context.
	#
	# XXX add logging support, when we have a log object:
	# XXX
	# XXX $self->log->debug("context size: $ls -> $le ($rate%)");
	# XXX
	# XXX With:  my ($ls, $lc, $le) = (length $serialized, length $compressed,
	# XXX		length $encoded);
	#

	my $md5 = Digest::MD5::md5_base64($frozen);
	my $cipher = new Crypt::CBC($self->key, CRYPT_ALGO);
	my $crypted = $cipher->encrypt($frozen);
	my $encoded = MIME::Base64::encode($crypted);

	#
	# Return the hidden parameters to generate in the HTML output.