package TWiki::Plugins::SessionPlugin::Session;

use strict;

sub initializeSessionDirectory
{
	my $sessionDirectory = __getSessionDirectory ();
	if (! -e $sessionDirectory)
		{
			umask (0);
			mkdir ($sessionDirectory, 0777);
		}
}  # initializeSessionDirectory

sub new
{
	my $proto = shift;
	my $class = ref ($proto) || $proto;
	my $self = {};

	bless ($self, $class);

	$self->{attributes} = {};

	my $sessionID = shift;
	if ($sessionID)
		{
			$self->{sessionID} = $sessionID;
			$self->__loadSession ($self->{sessionID});
		}
	else
		{
			$self->{sessionID} = $self->__makeSessionID ();
		}

	__debug ("Created new session " . $self->{sessionID});

	return $self;
}  # new

sub __getSessionDirectory
{
	return &TWiki::Func::getDataDir () . "/.session";
}  # __getSessionDirectory

sub __debug
{
	goto &TWiki::Plugins::SessionPlugin::debug;
}  # __debug

sub setAttribute
{
	my ($self, $key, $value) = @_;

	return if (($key =~ /\|/) || ($value =~ /\n/s));

	__debug ("Session " . $self->getSessionID () . " setting $key=$value");

	$self->{attributes}->{$key} = $value;
}  # setAttribute

sub getAttribute
{
	my ($self, $key) = @_;

	return $self->{attributes}->{$key};
}  # getAttribute

sub hasAttribute
{
	my ($self, $key) = @_;

	return exists ($self->{attributes}->{$key});
}  # hasAttribute

sub removeAttribute
{
	my ($self, $key) = @_;

	delete ($self->{attributes}->{$key}) if ($self->hasAttribute ($key));
}  # removeAttribute

sub getSessionID
{
	my ($self) = shift;

	return $self->{sessionID};
}  # getSessionID

sub saveSession
{
	my ($self) = shift;

	my $fileName = $self->__getFileForSessionID ($self->getSessionID ())
	   || return undef;

	my $text = '';
	foreach my $key (keys (%{ $self->{attributes} }))
		{
			my $value = $self->getAttribute ($key);
			__debug ("Saving key \"$key\" = \"$value\"");
			$text .= "$key|" . $self->getAttribute ($key) . "\n";
		}

	__debug ("SaveSession text follows until EOF:\n${text}EOF");

	TWiki::Func::saveFile ($fileName, $text);
	chmod (0777, $fileName);

	return 1;
}  # saveSession

sub __getFileForSessionID
{
	my ($self, $sessionID) = @_;

	$sessionID =~ /([0-9\-]+)/ || return undef;
	$sessionID = $1;

	return __getSessionDirectory () . "/$sessionID";
}  # __getFileForSessionID

sub __makeSessionID
{
	# FIXME would be nice to have something more definite e.g a seq number
	# darkness: Um.  I could be wrong, but I think we need something
	#           _more_ random not _less_ random ("more definite").  Plus,
	#           there is a race condition here WRT creating session files.

	my $self = shift;
	my $sessionDirectory = __getSessionDirectory ();

	__debug ("Entered __makeSessionID");

	my $sessionID;
	do
		{
			my $randNum = int (rand ("1000000"));
			$sessionID = time () . "-" . $randNum;
		}
	while (-e $self->__getFileForSessionID ($sessionID));

	__debug ("__makeSessionID returning $sessionID");

	return $sessionID;
}  # __makeSessionID

sub __loadSession
{
	my ($self, $sessionID) = @_;

	my $fileName = $self->__getFileForSessionID ($sessionID);
	return unless (-r $fileName);

	my $text = TWiki::Func::readFile ($fileName);
	__debug ("Begin calling setAttribute for __loadSession");
	foreach my $line (split (/\n/s, $text))
		{
			next unless ($line =~ /^\w[\w\d]*\|/);
			$self->setAttribute (split (/\|/, $line, 2));
		}
	__debug ("End calling setAttribute for __loadSession");
}  # __loadSession

1;

package TWiki::Plugins::SessionPlugin;

use strict;

use vars qw($SESSION_ID_COOKIE_NAME $DEBUG $initialized $currentSessionID);

$SESSION_ID_COOKIE_NAME = "TWikiSessionID";
$DEBUG = TWiki::Func::getPreferencesFlag ("SESSIONPLUGIN_DEBUG");

$currentSessionID = undef;

sub debug
{
	if ($DEBUG)
		{
			my $message = "- TWiki::Plugins::SessionPlugin: " . join ('', @_);
			&TWiki::Func::writeDebug ($message);
		}
}  # debug

sub initPlugin
{
	my ($topic, $web, $user, $installWeb) = @_;

	my $query = _getQuery ();

	return 0 if ($initialized);
	$initialized = 1;

	debug ("entered");

	# check for Plugins.pm versions
	if($TWiki::Plugins::VERSION < 1)
		{
			&TWiki::Func::writeWarning ("Version mismatch between DefaultPlugin"
			                            . " and Plugins.pm");
			return 0;
		}

	TWiki::Plugins::SessionPlugin::Session::initializeSessionDirectory ();

	# Plugin correctly initialized
	debug ("($web.$topic) is OK");

	return 1;
}  # initPlugin

sub writeHeaderHandler
{
	my $query = shift;

	my $cookie = _getCookieToBeSet ($query) || return '';
	return "Set-Cookie: " . _getCookieToBeSet ($query);
}  # writeHeaderHandler

sub redirectCgiQueryHandler
{
	my ($query, $url) = @_;

	my $cookie = _getCookieToBeSet ($query);
	if ($cookie)
		{
			print $query->redirect (-uri => $url, -cookie => $cookie);
			return 1;
		}

	return 0;
}  # redirectCgiQueryHandler

sub initializeUserHandler
{
	my $user = shift;

	my $session = _getSession ();

	if ($user && ($user ne TWiki::Func::getDefaultUserName ()))
		{
			unless ($session->hasAttribute ("user")
			        && ($user eq $session->getAttribute ("user")))
				{
					debug ("Calling setAttribute from initializeUserHandler");
					$session->setAttribute ("user", $user);
					$session->saveSession ();
				}
		}
	elsif ($session->hasAttribute ("user"))
		{
			$user = $session->getAttribute ("user");
		}

	debug ("User = " . ($user || "<no user>"));

	return $user;
}  # initializeUserHandler

sub getSessionValueHandler
{
	return _getSession ()->getAttribute (shift) || "";
}  # getSessionValueHandler

sub setSessionValueHandler
{
	my $session = _getSession ();
	debug ("Calling setAttribute from setSessionValueHandler");
	$session->setAttribute (@_);
	$session->saveSession ();
}  # setSessionValueHandler

sub _getSession
{
	my $query = shift || _getQuery ();
	my $sessionIDCookie = $query->cookie ($SESSION_ID_COOKIE_NAME);
	my $sessionID = $sessionIDCookie || $currentSessionID;

	my $session = new TWiki::Plugins::SessionPlugin::Session ($sessionID);

	unless ($sessionID)
		{
			$currentSessionID = $session->getSessionID ();
			$session->saveSession ();
		}

	return $session;
}  # _getSession

sub _getQuery
{
	return &TWiki::Func::getCgiQuery ();
}  # _getQuery

sub _makeCookieForSession
{
	my $session = shift;
	my $query = shift || _getQuery ();

	my $cookie = $query->cookie (-name => $SESSION_ID_COOKIE_NAME,
	                             -value => $session->getSessionID (),
	                             -expires => '',
	                             -secure => 0);
	debug ("Made cookie: \"$cookie\"");

	return $cookie;
}  # _makeCookieForSession

sub _getCookieToBeSet
{
	my $query = shift;
	my $session = _getSession ($query);

	debug ("getCookieToBeSet query is " . ref ($query));

	my $readSessionID = $query->cookie ($SESSION_ID_COOKIE_NAME);

	debug ("Read session ID = \"" . ($readSessionID || '')
	       . "\", actual session ID = " . $session->getSessionID ());

	if (!$readSessionID || ($readSessionID ne $session->getSessionID ()))
		{
			return _makeCookieForSession ($session, $query);
		}

	debug ("No cookie needed");
	return undef;
}  # _getCookieToBeSet

1;