view release on metacpan or  search on metacpan

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

#
# Returns true if ID is OK for use, false if it's not available.
#
sub is_available {
	DFEATURE my $f_;
	my $self = shift;
	my ($id) = @_;

	#
	# Check that no session bearing the same ID is still recorded within
	# the filesystem.
	#

	my $path    = $self->_id_to_path($id);
	my $lockmgr = $self->lockmgr;

	#
	# Create all the missing directories that lead to the session path,
	# before attempting to lock the file.
	#

	my $dir  = dirname $path;
	mkpath($dir) unless -d $dir;
	my $lock = $lockmgr->lock($path);

	if (-f $path) {
		$lock->release if defined $lock;
		logtrc 'info', "$path already exists for session $id";
		return DVAL undef;
	}

	#
	# Create empty file to reserve the entry.
	#

	local *FILE;
	open(FILE, ">$path") || logerr "can't create $path: $!";
	close FILE;

	$lock->release if defined $lock;

	return DVAL 1;			# Session ID reserved, and OK to use
}

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

	DREQUIRE defined $self->serializer, "already called set_serializer()";

	my $path       = $self->_id_to_path($id);
	my $lockmgr    = $self->{lockmgr};
	my $lock       = $lockmgr->lock($path);

	my $array = $self->_retrieve_locked($path);
	$lock->release if defined $lock;

	return DVAL undef unless defined $array;

	my $token = CGI::param(MX_TOKEN);
	CGI::delete(MX_TOKEN);				# Invisible to end-user

	if ($array->[0] ne $token) {
		logerr "context token mismatch";
		return DVAL undef;
	}

	return DVAL $array->[1];
}

#
# ->_retrieve_locked
#
# retrieve context from (locked) file.
#
sub _retrieve_locked {
	DFEATURE my $f_;
	my $self = shift;
	my ($path) = @_;

	my $serializer = $self->serializer;

	local *FILE;
	unless (sysopen(FILE, $path, O_RDONLY)) {
		logerr "can't open session file $path: $!";
		return DVAL undef;
	}
	my $frozen;
	binmode FILE;
	unless (sysread(FILE, $frozen, -s(FILE))) {
		logerr "can't read session file $path: $!";
		close FILE;
		return DVAL undef;
	}
	close FILE;
	unless (length $frozen) {
		logwarn "no data in session file $path, session expired";
		return undef;
	}

	return DVAL $serializer->deserialize($frozen);
}

#
# ->store		-- defined
#
# Store context by session ID.
#
# 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 defined $self->serializer, "already called set_serializer()";

	my $path       = $self->_id_to_path($id);
	my $lockmgr    = $self->{lockmgr};
	my $lock       = $lockmgr->lock($path);

	#
	# We're storing the context, with a random key pre-pended to validate
	# the tupple session-ID/random-key at retrieve time.  This prevents
	# forging a session ID.
	#
	# We use the _generate_session_id feature from our parent to get
	# a random token.
	#

	my $store = [$self->_generate_session_id, $context];

	$self->_store_locked($path, $store);
	$lock->release if defined $lock;

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

	my $ret = {
		&MX_SESSION_ID	=> $id,
		&MX_TOKEN		=> $store->[0],
	};

	return DVAL $ret;
}

#
# ->_store_locked
#
# Store context into (locked) file.
#
sub _store_locked {
	DFEATURE my $f_;
	my $self = shift;
	my ($path, $context) = @_;

	my $serializer = $self->serializer;

	local *FILE;
	unless (sysopen(FILE, $path, O_WRONLY|O_CREAT|O_TRUNC)) {
		logerr "can't create session file $path: $!";
		return DVOID;
	}
	my $frozen = $serializer->serialize($context);
	binmode FILE;
	unless (syswrite(FILE, $frozen)) {
		logerr "can't write to session file $path: $!";
		close FILE;
		return DVOID;
	}
	unless (close FILE) {
		logerr "can't flush session file $path: $!";
		return DVOID;
	}

	return DVOID;
}

1;

=head1 NAME

CGI::MxScreen::Session::Medium::File - File session medium

=head1 SYNOPSIS

 # Not meant to be used directly

=head1 DESCRIPTION

This saves the session within a file on the server side.  Session
files are created under a set of directories, to avoid having directories
with two many files in them, which is inefficient on most filesystems
(reiserfs excepted).  An MD5 hash of the session ID is taken to compute two
sub directories, resulting in session files being stored as:

    W/N/192.168.0.3-987001261-28947
    k/5/192.168.0.3-987177890-16666

You can see the pattern used for session ids: the IP address of the client
making the request, a timestamp indicating the start of the session, and
the PID of the process.  However, this is used only when the targetted
session ID is free, otherwise, a random cryptic session ID is generated.

Because sessions will use disk space, you need an expiration policy.
If someone attempts to continue a session that has been removed,
C<CGI::MxScreen> will return an error, and that someone will have to
restart the whole session, thereby potentially loosing all the work
already done.

On my web server, I use the following command to expire sessions after
a week of inactivity: