Perl Session Handling

Overview

This document shows how to use Perl for managing state using two cookies.

Example Perl

################################################################################
# Code excerpts showing the use of two types of cookies to maintain an
# authentication session that lasts for a specified time period or until the
# browser is terminated, whichever comes first.
#
# User authentication is based on the presence of both cookies.  Only if
# neither cookie exists is CAS consulted for ticket validation (or issuance).
#
# The uid is contained in the 'persistent' cookie (the one with an expiry),
# which is encrypted in a symmetric key (to prevent user tampering).
#
# Mike Friedman
################################################################################
$CAS_keyfile = "...";
$CAS_cookie_expiry = "+10m";
$CAS_cookie_secure = "1";
chomp($thisprog = `basename $0`);
my $query = new CGI;
$thishost = $query->virtual_host();
# Define the cookie domain as our full hostname:
$CAS_thisDomain = $query->virtual_host();
# Define the cookie path:
$CAS_thisPath = "/cgi-bin/" "$thisprog";
# Create cookie name by removing file extension from App program name:
($CAS_cookieNamePersistent) = split(/\./,$thisprog);
$CAS_cookieNameNonPersistent = "$CAS_cookieNamePersistent" "N";
# Get the cookie encryption key:
open(KEYFILE,"<$CAS_keyfile");
chomp($CAS_key = );
close(KEYFILE);
# Get the user's UID, either from an existing valid cookie, or else from CAS:
$uid = &GetUIDFromCookie($CAS_cookieNamePersistent,"$CAS_key")
if ( $query->cookie(-name=>$CAS_cookieNameNonPersistent) );
# If successful (i.e., both cookies were found), we won't send a new cookie:
if ($uid =~ /^\d+$/) {
$CAS_cookie_persistent = "";
$CAS_cookie_non_persistent = "";
}
# Otherwise, check with CAS:
else {
$uid = &GetUIDFromCAS($action,$casService);
# If successful, set a new cookie:
if ($uid =~ /^\d+$/) {
# Construct persistent cookie containing UID:
$CAS_cookie_persistent =
&ConstructSessionCookie($CAS_cookieNamePersistent,$uid,$CAS_key,
$CAS_cookie_expiry,$CAS_thisDomain,$CAS_thisPath,$CAS_cookie_secure);
# Construct non-persistent cookie:
$CAS_cookie_non_persistent = $query->cookie(
-name     =>  "$CAS_cookieNameNonPersistent" ,
-value    =>  "1" ,
-domain   =>  "$CAS_thisDomain" ,
-path     =>  "$CAS_thisPath" ,
-secure   =>  "$CAS_cookie_secure" ,
);
# Set up cookie array:
@CAS_cookies = ($CAS_cookie_persistent,$CAS_cookie_non_persistent);
}
}
----------------------------------------------------------------
# Both cookies are included in the cgi header when the page is displayed, e.g.,
print $query->header(-cookie=>[@CAS_cookies]);
################################################################################
sub ConstructSessionCookie {
# Build the contents of a cookie to send to the browser
my ($name,$uid,$key,$expires,$domain,$path,$secure) = @_;
my $query = new CGI;
my $SessionID;
my $cookie;
# Make session ID out of encrypted UID:
$SessionID = &EncryptString("$key$uid",$key);
# Construct the cookie:
$cookie = $query->cookie(
-name     =>  "$name" ,
-value    =>  "$SessionID" ,
-expires  =>  "$expires" ,
-domain   =>  "$domain" ,
-path     =>  "$path" ,
-secure   =>  "$secure" ,
);
return "$cookie";
}
################################################################################
sub GetUIDFromCookie {
# Retrieve the UID contained in a cookie originally sent from here
my ($name,$key) = @_;
my $query = new CGI;
my $s;    # SessionID in cookie
my $u;    # UID obtained from cookie
my $qkey; # Meta-quoted $key for use in regexp
# Retrieve the value of the 'sessionID' cookie:
$s = $query->cookie(-name=>$name);
return "" unless ($s);
$s = &DecryptString("$s",$key);
# If the session ID is valid, then the UID immediately follows the key,
# which is the first part of the value:
$qkey = quotemeta $key;
$u = "$1" if ($s =~ /^$qkey(.+)$/);
return "$u";
}
################################################################################
sub GetUIDFromCAS {
# Return the UID as obtained from CAS, either by validating an existing
# ticket, or by referring the user to CAS for a new ticket.  In the latter
# case, the UID will be obtained by validating the ticket that is returned
# here by CAS.
use strict;
use LWP::UserAgent;
use CGI;
my ($thisService,$casService) = @_;
my $query = new CGI;
my $ua = LWP::UserAgent->new;
my $casGet;
my $casTicket;
my $response;
my $uid;
# Retrieve the CAS ticket, if any, from the incoming URI:
$casTicket = $query->url_param('ticket');
# If there is a ticket, validate it with CAS, returning the user's UID:
if ($casTicket) {
# Construct the full URL of the CAS validation service:
$casGet =
"$casService\/serviceValidate?ticket=$casTicket&service=$thisService";
# Retrieve the validation output from CAS:
$response = $ua->get($casGet);
# Peel off the UID from the response:
if ($response->content =~ /(\d+)<\/cas:user>/) {
$uid = "$1";
}
# If there's no uid, then retrieve the entire response (which should
# include an error message) and return that to the caller instead of
# a uid.
else {
$uid = "casTicket:  $casTicket; " . $response->content;
}
}
# If a valid ticket was not part of the query string, redirect the user's
# browser to CAS to get a fresh ticket:
else {
print
$query->redirect(-location=>"$casService/login?service=$thisService");
}
# Return the UID (or else the error response) obtained from CAS:
return $uid;
}
################################################################################
sub EncryptString {
# Encrypt plaintext and return the Base64 encoding of the cyphertext
use Crypt::CBC;
use MIME::Base64;
my ($plaintext,$key) = @_;
my $CBCAlgorithm = "Blowfish";
my $ciphertext;
my $cipher;
$cipher = Crypt::CBC->new(
-key      => $key ,
-cipher   => $CBCAlgorithm ,
-salt     => 1 ,
);
$ciphertext = encode_base64($cipher->encrypt($plaintext),"");
return($ciphertext);
}
################################################################################
sub DecryptString {
# Decode Base64 cyphertext and then decrypt it, returning the plaintext
use Crypt::CBC;
use MIME::Base64;
my ($ciphertext,$key) = @_;
my $CBCAlgorithm = "Blowfish";
my $plaintext;
my $cipher;
$cipher = Crypt::CBC->new(
-key      => $key ,
-cipher   => $CBCAlgorithm ,
-salt     => 1 ,
);
$plaintext = $cipher->decrypt(decode_base64($ciphertext));
return($plaintext);
}