We're using a cookie to hold a session ID. However, we need to be able to hold the session ID even if the user rejects our cookie. Presumably the way to do this is to store the session ID in the URL.
We've figured out how to do this, but in order to ensure that we don't attempt to set a cookie again (after it was rejected), we also have to alter the URL on our first attempt, when we're trying to set the cookie. The result is that, if the cookie IS accepted, we're left with an ugly "cookiecheck" flag in our URL. To remove that (just 'cuz it's ugly), we do yet another redirect.
Here's our code.
package DP::Session;
use base CGI::Application;
$DP::Session::VERSION = '$Id: Session.pm,v 1.5 2005/02/17 22:51:49 wal
+lyh Exp $';
use strict;
use warnings;
=head1 NAME
DP::Session - CGI session management web module
=head1 SYNOPSIS
use base DP::Session;
=head1 DESCRIPTION
C<DP::Session> provides standard handling for session management in ou
+r
CGI programs. A program that uses a module based on DP::Session will
automatically attempt to retrieve or create a cookie that contains
the ID of the current session. If the cookie cannot be created, it
will store the ID of the session in the URL.
=cut
use CGI::Session;
use DBI;
use CGI::Carp;
=head1 METHODS
=cut
#---------------------------------------------------------------------
+-
=head2 cgiapp_init
C<cgiapp_init> will connect to the session database, initialize the
session, and store the session ID in a cookie or in the URL.
=cut
sub cgiapp_init {
my ($self) = @_;
my $cgi = $self->query;
my $dbh = DBI->connect("DBI:mysql:dp-session;host=localhost",
"xxxx", "xxxx", { RaiseError => 1 }
) or confess "Can't open session database: $DBI::errstr\n";
$self->param(dbh => $dbh);
$self->save_session_id($self->initialize_session);
return;
}
#---------------------------------------------------------------------
+-
=head2 initialize_session
C<initialize_session> will try to retrieve the session ID from the
cookie or from the URL. Otherwise it will create a new session.
=cut
sub initialize_session {
my ($self) = @_;
my $cgi = $self->query;
my $dbh = $self->param("dbh");
# If the user rejects our cookie,
# we pass the session ID in the URL.
my $sid = $cgi->cookie("CGISESSID");
$sid = $cgi->url_param("CGISESSID")
unless ($sid and $sid ne "");
$sid = undef
unless ($sid and $sid ne "");
my $session = CGI::Session->new(
"driver:MySQL", $sid, {Handle => $dbh, LockHandle => $dbh}
) or confess "Can't create session: $CGI::Session::errstr\n";
$session->expire("+1h");
$self->param(session => $session);
return $sid;
}
#---------------------------------------------------------------------
+-
=head2 save_session_id
C<save_session_id> will ensure that the session ID is saved, either in
a cookie or in the URL.
=cut
sub save_session_id {
my ($self, $sid) = @_;
my $cgi = $self->query;
my $session = $self->param("session");
if ($sid and $sid eq $session->id) {
if ($cgi->url_param("_cookiecheck")) {
$self->remove_flag_from_url;
$self->exit_early;
}
else {
return;
}
}
elsif ($cgi->url_param("_cookiecheck")) {
$self->save_session_id_in_url;
$self->exit_early;
}
else {
$self->save_session_id_in_cookie;
$self->exit_early;
}
}
#---------------------------------------------------------------------
+-
=head2 remove_flag_from_url
C<remove_flag_from_url> will clean the URL to remove the parameter tha
+t
we used to ensure that we did not attempt to set a cookie multiple
times. We will only do this if the cookie was accepted.
=cut
sub remove_flag_from_url {
my ($self) = @_;
my $cgi = $self->query;
$cgi->delete("_cookiecheck");
$self->send_redirect_headers;
}
#---------------------------------------------------------------------
+-
=head2 save_session_id_in_url
C<save_session_id_in_url> will alter the URL to add a parameter that
contains the session ID, so that we can retrieve the session later.
We will only do this if the cookie that we tried to send was rejected.
=cut
sub save_session_id_in_url {
my ($self) = @_;
my $cgi = $self->query;
my $session = $self->param("session");
$cgi->delete("_cookiecheck");
$cgi->param(CGISESSID => $session->id);
$self->send_redirect_headers;
}
#---------------------------------------------------------------------
+-
=head2 save_session_id_in_cookie
C<save_session_id_in_cookie> will attempt to send a cookie containing
the session ID, so that we can retrieve the session later.
=cut
sub save_session_id_in_cookie {
my ($self) = @_;
my $cgi = $self->query;
my $session = $self->param("session");
my $cookie = $cgi->cookie (
-name => "CGISESSID",
-value => $session->id,
-path => $cgi->url(-absolute => 1),
);
# If the cookie is rejected, we won't try again to send a cookie.
$cgi->param(_cookiecheck => 1);
$self->header_props(-cookie => $cookie);
$self->send_redirect_headers;
}
#---------------------------------------------------------------------
+-
=head2 send_redirect_headers
C<send_redirect_headers> will send the headers needed to perform the
redirect that will either send a cookie or alter the URL to contain
the session ID.
=cut
sub send_redirect_headers {
my ($self) = @_;
my $cgi = $self->query;
my $session = $self->param("session");
$self->header_type("redirect");
$self->header_add(-uri => $cgi->self_url);
$self->teardown;
print $self->_send_headers;
}
#---------------------------------------------------------------------
+-
=head2 exit_early
C<exit_early> will exit the program. This is needed so that the
redirect headers can be sent. However, this routine can also be
overridden by the unit test program, so that the tests don't exit
early.
=cut
sub exit_early {
exit;
}
1;
Is there a better way to do this? Or better yet, are we busily reinventing the wheel while overlooking some nifty CPAN module?
