Cookie Problem

[Kirsle]

I'm having a bit of an issue with one of my websites about (re)setting and deleting cookies.

I get these problems occasionally, and manually clearing my browser cookies will delete the cookies and then they can be set and deleted normally until the problem returns sometime later.

I programmed this content management system for my CGI sites, where the index.cgi file only handles cookies and checking for logged-in users, but it's up to the pages (external txt files) to run Perl codes and handle all the dynamic and visual aspects of the site.

Here's the code towards the end of index.cgi where it handles pages and runs the Perl codes within:

#---------------------#
# Prepare a page      #
#---------------------#

# See if the page exists.
my @content = ();
if (-e "$RB->{path}->{pages}/$query{display}.txt") {
	open (PAGE, "$RB->{path}->{pages}/$query{display}.txt");
	@content = <PAGE>;
	close (PAGE);
	chomp @content;
}
else {
	# 404 Error
	&sendStatusPage(404);
}

# Go through the content
$RB->{content} = '';
$RB->{perl}    = '';
my $inPerl     = 0;
foreach my $line (@content) {
	if ($line =~ /<perl>/i) {
		$inPerl = 1;
		next;
	}
	elsif ($line =~ /<\/perl>/i) {
		$inPerl = 0;
		next;
	}

	if ($inPerl) {
		$RB->{perl} .= "$line\n";
	}
	else {
		$RB->{content} .= "$line\n";
	}
}

# Execute Perl?
if (length $RB->{perl}) {
	my $eval = eval ($RB->{perl}) || $@;
	if ($eval =~ /\(eval (\d+?)\)/i && $query{display} ne 'admin') {
		croak $eval;
	}
}

# Apply it into the HTML Template.
open (TEMP, "$RB->{path}->{skin}/design.html");
my @temp = <TEMP>;
close (TEMP);
chomp @temp;

my $tempCode = join ("\n",@temp);

# Get the title.
my ($title) = $RB->{content} =~ m/<title>(.*?)<\/title>/i;
$RB->{content} =~ s/<title>(.*?)<\/title>//g;
if (!defined $title) {
	($title) = $RB->{content} =~ m/<b class=\"header\">:: (.*?)<\/b>/i;
}
$RB->{title} = "$title";

# Insert special variables.
$tempCode =~ s~<content>~$RB->{content}~ig;

# Run filters.
$tempCode = &filter($tempCode);

# Print the final page.
print "Content-Type: text/html\n\n" if $RB->{header} == 0;
print $tempCode;

exit;

$RB->{content} is the page's unique content as obtained from the page's txt file itself (and/or reset through the page's <perl> tags), and $RB->{header} is whether or not the page printed its own headers.

Here's the source of the page "user.dologin.txt" for logging in:

<perl>
	# See if their name exists.
	my $name = lc($query{sn});
	if (-e "$RB->{path}->{users}/$name\.txt") {
		# Get the profile.
		&profileLoad ($name);

		# See if the password is correct.
		my $pass = md5_hex ($query{pw});
		if ($pass eq $RB->{users}->{$name}->{password}) {
			# Create their Session ID.
			my $ses = &genSession($name);

			# Create the cookies.
			my $cookieSN = $cgi->cookie (
				-name    => $RB->{config}->{cookies}->{username},
				-value   => $name,
				-domain  => $RB->{config}->{cookies}->{domain},
				-expires => 'Fri, 1-Jan-2038 00:00:00 GMT',
			);
			my $cookieSS = $cgi->cookie (
				-name    => $RB->{config}->{cookies}->{session},
				-value   => $ses,
				-domain  => $RB->{config}->{cookies}->{domain},
				-expires => 'Fri, 1-Jan-2038 00:00:00 GMT',
			);
			print $cgi->header (-cookie => [ $cookieSN, $cookieSS ]);
			$RB->{header} = 1;

			$RB->{content} = "<title>Signing In...</title>\n"
				. "<b class=\"header\">:: Signing In</b><br>\n"
				. "You are now signed in. Please wait or click "
				. "<a href=\"$self?display=index\">here</a> to continue.\n\n"
				. "<script language=\"JavaScript\" type=\"text/javascript\">\n"
				. "setTimeout (\"self.location = '$self?display=index';\", 1000);\n"
				. "</script>";
		}
		else {
			$RB->{content} = "<title>Sign-in Error</title>\n"
				. "<b class=\"header\">:: Sign-In Error</b><br>\n"
				. "Your password is incorrect.";
		}
	}
	else {
		$RB->{content} = "<title>Sign-in Error</title>\n"
			. "<b class=\"header\">:: Sign-In Error</b><br>\n"
			. "The username <b>$name</b> does not exist.";
	}
</perl>

And here's the sign-out code from "user.logout.txt"

<perl>
	# Remove the activity status.
	unlink ("$RB->{path}->{online}/$sn\.txt");

	# Destroy the cookies.
	my $cookieSN = $cgi->cookie (
		-name    => $RB->{config}->{cookies}->{username},
		-value   => '',
		-domain  => $RB->{config}->{cookies}->{domain},
		-expires => '-1d',
	);
	my $cookieSS = $cgi->cookie (
		-name    => $RB->{config}->{cookies}->{session},
		-value   => '',
		-domain  => $RB->{config}->{cookies}->{domain},
		-expires => '-1d',
	);
	print $cgi->header (-cookie => [ $cookieSN, $cookieSS ]);
	$RB->{header} = 1;

	$RB->{content} = "<title>Signing Out...</title>\n"
		. "<b class=\"header\">:: Signing Out</b><br>\n"
		. "You are now signed out. Please wait or click "
		. "<a href=\"$self?display=index\">here</a> to continue.\n\n"
		. "<script language=\"JavaScript\" type=\"text/javascript\">\n"
		. "setTimeout (\"self.location = '$self?display=index';\", 1000);\n"
		. "</script>";
</perl>

Now, I have this code running on two different websites. On one website, I can log in and out just fine, but on the other one, it won't reset the cookies unless I manually clear out my browser's cookies and try it again.

Another bit of interest, I have an admin function on the site to enable me to sign in as any user, using only their MD5 password sum from their profile, bypassing the normal login procedure. This usually works when the cookies are able to be reset, but during these cases, not even this function works. So it doesn't seem to be a problem with setting blank values or by setting it to expire yesterday.

Any suggestions? Is there anything visibly wrong in my code or should I just write it off as a browser malfunction?

 

[mbrooks]

Is the login accessed via SSL?

M. Brooks

http://mbrooks.info

 

[Kirsle]

No, it's over normal HTTP protocol.

Here's the source of the "user.login" page which has the login form if that helps:

<title>Sign In</title>
<b class="header">:: Sign In</b><br>
<tab>To sign in to your account, enter your name and password below:<p>

<form name="login" action="$self" method="post">
<input type="hidden" name="display" value="user.dologin">
<fieldset>
<legend><b class="header">Sign In</b></legend>
<blockquote>
	<b>Username</b><br>
	<input type="text" size="20" name="sn" class="entry"><p>

	<b>Password</b><br>
	<input type="password" size="20" name="pw" class="entry"><p>

	<input type="submit" value="Sign In!" class="button">
	<input type="button" value="Join Now" class="button" onClick="self.location='$self?display=user.register'"><br>
	<i>(<a href="$self?display=user.password">Forgot your password?</a>)</i>
</blockquote>
</fieldset>

Also, <tab> is replaced with non-breaking spaces and $self is replaced with the location to the index.cgi, even when used in non-Perl-pages like this one.

 

[mbrooks]

Instead of doing the redirect with javascript. Do it using perl. That should correct the situation.

Example:

sub create_cookies {
	# perform cookie action

	redirect('[URL unfurl="true"]http://domain.com/next_page.html');[/URL]
}

sub delete_cookies {
	# perform cookie action

	redirect('[URL unfurl="true"]http://domain.com/next_page.html');[/URL]
}

sub redirect {
	my ($path) = @_;
	my $status = $ENV{SERVER_PROTOCOL} eq "HTTP/1.1" ? 303 : 302;
	print $cgi->redirect(
		-status => $status,
		-uri    => $path
	);
}

M. Brooks

http://mbrooks.info