#!/usr/bin/perl

#  keymaster.pl
##::: Author        stradust, wheakory
##::: Hostname        ux5.isu.edu (development), ux7.isu.edu (producti
+on)
##::: Language        Perl
##::: Libs/Deps        perl libraries => DBI, CGI, Time::Local, CGI::S
+ession
##:::                in-house config library => PHQConf.pm
##:::
##::: Path/Filename    /cwis/apache/cgi-bin/keymaster.pl
##::: Path/Exe        
##:::
##::: Project        PH Web Throttling
##::: SubProject     
##::: Keywords        queuing, PHWeb Throttling
##:::
##::: DateCreated    03/15/2003
##:::
##::: ExeByWho        HTTP as a cgi script
##::: ExeByWhat        
##::: 
##::: Description:  This script handles the "client side" of the PHWeb
+ queuing process.  When the user 
##:::                requests a web portal via a link, they are first 
+directed through hp-redirect.pl 
##:::                which tests the current status of HP1.  If HP1 is
+ up, the request is then passed to
##:::                this script, keymaster.pl
##:::
##:::                Keymaster.pl handles session management and datab
+ase record insertion for a new
##:::                request being added to the queue, and reports the
+ current queue position for requests
##:::                still passing through the queue.
##:::
##:::                Refer to its partner script, gatekeeper.pl, for t
+he "server side" of this process.
##:::               
##:::
##:::
##:::
##::: ModDate   WhoBy     Tag  Description
##::: ========  ========  ==== =======================================
+========
##::: 00/00/02  NameAcct  NA01 template
##:::
##::: END   

use DBI;    
use CGI;                        # Enables perl database abstraction la
+yer - interface to MySQL database
use Time::Local;                # Enables date and time manipulation f
+unctions
use CGI::Session qw/-api3/;        # Use sessions    
use PHQConf;                    # Configuration parameters stored here
#use Env qw(HTTP_REFERER CONTENT_LENGTH QUERY_STRING);
$CGI::POST_MAX=1024 * 100;        # max 100K posts - Set to avoid Deni
+al of Service attacks
$CGI::DISABLE_UPLOADS = 1;        # no uploads - Set to avoid Denial o
+f Service attacks
$CGI::Session::IP_MATCH=1;        # IP address must match to access se
+ssion
#use strict;

use vars qw(%PHQConf $targetApp $tableName $AR_FLAG);    # Declaring g
+lobal variables
do "$PHQConf{AR_FILE}";            # Populate $AR_FLAG with the curren
+t available resource state

#print "Content-type: text/html\n\n";
#foreach $var (keys(%ENV)) {
#    print "$var = ".$ENV{$var}."<BR>\n";
#}

#print $ENV{'HTTP_REFERER'}.":".$ENV{'CONTENT_LENGTH'}.":".$ENV{'QUERY
+_STRING'}."\n";
#exit;

$debug = "";
%custData = ();                    # Initializing container for custom
+er database info.

($targetApp, $referrer) = &getParms;            # Retrieve current tar
+getApp

print "$targetApp, $referrer<BR>\n";
exit;

# Determine that the page is being called either from hp-redirect or a
+s a refresh of itself, otherwise die.
if (!($ENV{'HTTP_REFERER'} =~ /hp-redirect.pl/)) {
    if ($referrer ne "keymaster") {
        $error = "Keymaster was called from an unaccepted referring lo
+cation.";
        &generateError($error);
    }
}

if ($targetApp eq "myISU") {    # Set the working database table name.
    $tableName = "myISU_queue";
}
elsif ($targetApp eq "fsTools") {
    $tableName = "fsTools_queue";
}
else {
    &genLinkErrorPage($debug);
    exit;
}
$debug .= "My referring page is: ".$ENV{'HTTP_REFERER'}."<br>";

my $sessHandle = &getCookie();        # Retrieve cookie data from clie
+nt machine
$debug .= "Call to getCookie on line 47 returned: \$sessHandle = $sess
+Handle<BR>";
if ($sessHandle) {
    $debug .= "\$sessHandle name is ".$sessHandle->name.".  \$sessHand
+le id is ".$sessHandle->id."<BR>";
}


if (! $sessHandle) {
    $token = 0;
}
else {
    $token = $sessHandle->id;
}
$debug .= "\$token is set to $token<BR>";

$cID = &queConnect();                # Connect to database
if (! $cID) {
    $error = "Unable to establish a connection with the MySQL Database
+: ".$DBI::errstr."\n";
    PHQConf::generateError($error);
    exit;
}

$check = &queueCheck($targetApp, $token, \%custData);
$debug .= "queueCheck() returned $check<BR>";

if ($check == -1) { # the queue is currently not empty or resources ar
+e unavailable and
                    # the customer is not in the queue.
    
    # Customer needs to be added to the queue.  Start by creating the 
+cookie.
    my $sessionObject = &bakeCookie();
    $debug .= "\$sessionObject is $sessionObject.  \$sessionObject's s
+ession id is $sessionObject->id<BR>";

    if ($sessionObject) {
        # Cookie was created correctly.  Proceed with updating the dat
+abase.
        my $rv = &addCust($tableName, $targetApp, $sessionObject, \%cu
+stData);
        if (! $rv) {
            $error = "Unable to add customer to queue database: ".$DBI
+::errstr."\n";
            PHQConf::generateError($error);

            # Something else should happen here. . . if the user isn't
+ added to the database
            # this whole process fails.  Determine what should happen 
+in the error state.
        }

        # Customer is added to the queue.  Populate the custData hash 
+for the queue position.
        #my $rc = &getCustData2($sessionObject->id, \%custData);      
+  
        #if (! $rc) {
        #    $error = "Unable to retrieve customer data: ".$DBI::errst
+r."\n";
        #    PHQConf::generateError($error);
        #}
        
        # Push out the refresh page.
        &genRefreshPage($sessionObject);
    }
    else {
        # Error setting cookie
        $error = "Unable to create cookie on client machine: $!\n";
        PHQConf::generateError($error);
    }
}
elsif ($check == 0) {
    # Send customer to login page
    if ($targetApp eq "myISU") {
        $target = $PHQConf{MYISU};
    }
    elsif ($targetApp eq "fsTools") {
        $target = $PHQConf{FSTOOLS};
    }

    if ($sessHandle) {
        my $cookieHandle = &eatCookie($sessHandle);
        if (! $cookieHandle) {
            PHQConf::generateError($DBI::errstr);
        }
    }
    
    my $cgi = new CGI();
    print $cgi->redirect(-uri=>$target, -cookie=>$cookieHandle); 
}
elsif ($check == 1) {
    # Customer is in queue.  
    
    if (! $sessHandle) {
        $error = "No session exists <BR>";
        PHQConf::generateError($error);
    }
    
    # Calculate last refresh and generate errors if refresh is happeni
+ng before specified period
    if (time - $custData{'lastRefresh'} < $PHQConf{REFRESH_PERIOD}) {
        $refreshWarning = "This page will automatically refresh.  Forc
+ing a refresh will not affect your";
        $refreshWarning .= " place in the queue.  Please do not refres
+h this page.";
    }

    # Update expire times on cookie & session
#    $sessHandle->param("expires", $PHQConf{EXPIRE_TIME});
    $sessHandle->expires($PHQConf{EXPIRE_TIME});
    my $cgi = new CGI();
    $cookieHandle = $cgi->cookie(-name=>$PHQConf{COOKIE_NAME}, -value=
+>$sessHandle->id, -expires=>$PHQConf{EXPIRE_TIME});
    print $cgi->header(-cookie=>$cookieHandle);

    # Update last refresh time in database table
    my $query = "UPDATE ".$tableName." SET lastRefresh=NOW() WHERE cus
+tID=".$custData{'custID'};
    my $sth = $cID->prepare($query);
    my $rv = $sth->execute;
    if (! $rv) {
        PHQConf::generateError("Failed to update the last refresh time
+ in the MySQL databases: ".$DBI::errstr.":<BR>".$debug);
    }

    # Generate refresh page
    &genRefreshPage($sessHandle,$refreshWarning);
}

exit;



#************************************ SUBROUTINE DEFINITIONS *********
+****************************
sub getParms() {
    # This subroutine gathers the parameter data - the application the
+ customer is tring to access,
    # specified as targetApp.  The targetApp will be passed from hp-re
+direct.pl or as POST data from the
    # refresh form.

    my %form = ();
    
    # No arguments were passed, so check for POST data
    if ($ENV{'REQUEST_METHOD'} eq "GET") {
        return $ENV{'QUERY_STRING'};
    }
    else {
        read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
    }

    # Split out the name-value pairs by & seperator, and load into arr
+ay
    my @pairs = split(/&/, $buffer);
    $debug .= "\$buffer is $buffer<BR>";

    foreach $pair (@pairs)
    {
        # split name-value pairs by = sign
        my ($name, $value) = split(/=/, $pair);

        # Un-Webify plus signs and %-encoding
        $value =~ tr/+/ /;
        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
        $name =~ tr/+/ /;
        $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

        # load name-value pairs into associative arrays, indexed by na
+me
        $form{$name} = $value;
    }
    return $form{'targetApp'},$form{'referrer'};

} # end getParms()

sub queConnect() {
    # This subroutine defines the login parameters for the queue datab
+ase and establishes a connection

    my $db = "queue";
    my $dbUsername = "keymaster";
    my $dbPasswd = "k3yzplz";

    my $connectionID = &mysqlConnect($db, $dbUsername, $dbPasswd);
    return $connectionID;
} # end queConnect()

sub mysqlConnect($$$) {
    # This subroutine establishes a connection to a mysql database
    
    my ($database_name, $database_user, $database_passwd) = @_;

    my $dbh = DBI->connect("DBI:mysql:database=$database_name", $datab
+ase_user, $database_passwd, { RaiseError => 0, AutoCommit => 0 });
    return $dbh;
} # End dbconnect

sub getCookie() {
# This subroutine determines if a queue cookie is set in the client's 
+browser
    
    my $cgi = new CGI();
    my $cookieHandle = $cgi->cookie($PHQConf{COOKIE_NAME}) || "undef";

    $debug .= "getCookie checked for a cookie.  \$cookieHandle is $coo
+kieHandle<BR>";

    if ($cookieHandle eq "undef") {
        return 0;
    }
    else {
        my $session = new CGI::Session(undef, $cookieHandle, {Director
+y=>$PHQConf{SESSIONDIR}});
        # Return the session handle
        return $session;
    }
} # End checkCookie()

sub bakeCookie() {

    # Create a new session and cookie
    my $cgi = new CGI();
    my $session = new CGI::Session(undef, $cgi, {Directory=>$PHQConf{S
+ESSIONDIR}});
    $session->expire($PHQConf{EXPIRE_TIME});
    #$session->param(expire,$STALE_PERIOD);
    my $cookieHandle = $cgi->cookie(-name=>$PHQConf{COOKIE_NAME}, -val
+ue=>$session->id, -expires=>$PHQConf{EXPIRE_TIME});
    print $cgi->header(-cookie=>$cookieHandle);

    $debug .= "bakeCookie() set cookie $cookieHandle<BR>";
    return $session;
} # End bakeCookie()

sub queueCheck($$$) {
    # Accepts the targetApp, client cookie token, and an array referen
+ce for hash to store customer data in

    # This subroutine checks the current state of the queue.  It retur
+ns -1 if the queue is currently 
    # not empty or resources are unavailable but the customer is not i
+n the queue.  It returns 0 if the 
    # queue is empty and resources are available (indicating the clien
+t should be sent straight to the
    # login page).  And last it returns 1 if the customer was found in
+ the database.  In this case, it
    # stores the customer's data in the hash indicated by the passed a
+rray reference

    my ($targetApp, $clientCookieTok, $custData_ref) = @_;
        
    # Check the current queue state for the targetApp
    my $query = "SELECT COUNT(*) FROM ".$tableName;
    my $sth = $cID->prepare($query);
    $sth->execute;
    my $queueCount = "";
    my $row = "";
    $row = $sth->fetchrow_array;
    $queueCount = $row;
    $debug .= "\$queueCount is $queueCount.<BR>";
    if (! $queueCount) {
        # The queue table is empty.  Check for available resources.
          
        $debug .= "Resource status is set to ".$PHQConf{AR_FLAG}."<br>
+";
        if ($AR_FLAG) {
            # Resources are available - Direct user to login page
            return 0;
        }
        else {
            # Resources are not available - Add user to queue
            return -1;
        }
    }
    else {
        # The queue table is not empty.  
        if ($clientCookieTok) {
            # Check to see if this customer is already in the queue.
            my $rc = &getCustData2($clientCookieTok, $custData_ref);
            $debug .= "getCustData2 returned $rc<BR>";
            if ($rc) {
            # Determine the user's current accessState.  If access has
+ been granted and resources are available,
            # send the user to the portal login page
                if ($$custData_ref{'accessState'} eq "Y") {
                    return 0;
                }
                else {
                    return 1;
                }
            }
            else {
                # Customer data was not found in the queue.
                return -1;
            }
        }
        else {
            # This client doesn't have a cookie set. Add them to the q
+ueue.
            return -1;
        }
    }
} # End queueCheck()

sub addCust($$$$) {
    # Adds a customer entry to the database.
    # Accepts the targetApp and tableName and treats %cookieData as a 
+global variable
    my ($tableName, $targetApp, $sessionHandle, $custData_ref) = @_;

    # Get the next available customer ID.
    my $query = "SELECT MAX(custID) FROM ".$tableName;
    my $sth = $cID->prepare($query);
    $sth->execute;
    my @row    = $sth->fetchrow_array;
    my $maxID = $row[0];

    $query = "INSERT INTO ".$tableName." VALUES('".++$maxID."','".$ses
+sionHandle->param("_SESSION_REMOTE_ADDR")."','";
    $query .= $sessionHandle->id."','N',NOW(),NOW(),NULL)";
    $sth = $cID->prepare($query);
    my $rv = $sth->execute;
    if (! $rv) {
        PHQConf::generateError("Failed to return a \"true\" return cod
+e: ".$DBI::errstr);
        return 0;
    }
    else {
        #### Testing
        $query = "INSERT INTO ".$tableName."_order VALUES(NULL,'".$max
+ID."')";
        $sth = $cID->prepare($query);
        $rv = $sth->execute;
        
        if ($rv) {
            # Add data to custData hash
            $$custData_ref{'custID'} = $maxID;
            $$custData_ref{'IP'} = $sessionHandle->param("_SESSION_REM
+OTE_ADDR");
            $$custData_ref{'token'} = $sessionHandle->id;
            $$custData_ref{'accessState'} = "N";
            $$custData_ref{'quePos'} = $cID->{'mysql_insertid'} || und
+ef;
        }
        return $rv;
    }
} # end addCust()

sub genRefreshPage($$) {
    # This subroutine generates the refresh page the customer sees whi
+le in the queue.  It accepts any error
    # messages that have been generated when the script checks refresh
+ times.  It builds a page that informs
    # the customer of their current position in the queue.
    
    my ($session, $refreshErrors) = @_;
    my $refTime = $PHQConf{REFRESH_PERIOD} * 1000;
    
    #print "Content-type: text/html\n\n";
    
    print "<!doctype html public \"-//w3c//dtd html 4.0 transitional//
+en\">\n";
    print "<html>\n";
    print "<head><title>ISU Portal Applications - Queue Refresh Page</
+title>\n";
    #print "<meta http-equiv=\"refresh\" CONTENT=\"".$PHQConf{REFRESH_
+PERIOD}.";URL=".$PHQConf{KEYMASTER}."?".$targetApp."\">\n";
    print "<link rel=\"stylesheet\" type=\"text/css\" href=\"".$PHQCon
+f{STYLESHEET}."\">\n";

    print "<script language=\"javascript\">\n";
    print "timerID = setTimeout(\"document.refresher.submit()\",".$ref
+Time.");\n";
    print "</script>\n";    
    
    print "</head>\n";

    print "<body>\n";
    my $banner = &includeFile($PHQConf{ISU_BANNER});
    print $banner."\n";

    print "<form name=\"refresher\" method=\"POST\" action=\"".$PHQCon
+f{KEYMASTER}."\">\n";
    print "<input type=\"hidden\" name=\"referrer\" value=\"keymaster\
+">\n";
    print "<input type=\"hidden\" name=\"targetApp\" value=\"$targetAp
+p\">\n";

    print "<table width=\"100%\" cellspacing=0 cellpadding=0 border=0>
+\n";
    print "<tr><td width=\"".$PHQConf{LEFT_CELL_SIZE}."\" valign=top><
+table width=\"100%\" cellspacing=0 cellpadding=0 border=0>\n";
    print "<tr><td>";
    require ($PHQConf{REFRESH_LEFT_CELL});
    print "</td></tr></table></td>\n";
    print "<td>";
    
    if ($refreshErrors) {
        print "<div align=\"center\" style=\"margin-top: 5em; font-wei
+ght: bold; color: red;\">".$refreshErrors."</div>\n";
    }
    #print "<div align=\"center\" style=\"margin-top: 15em; font-weigh
+t: bold;\">Your session name is ".$session->name.".</div><BR>\n";
    print "<div align=\"center\" style=\"margin-top: 15em; font-weight
+: bold;\">Your current queue position is: ".$custData{'quePos'}."</di
+v><BR>\n";
    #print "Your session id is ".$session->id."<BR>";
    print "<p>$debug\n";

    print "</td>\n";
    print "<td><table width=\"100%\" cellspacing=0 cellpadding=0 borde
+r=0>\n";
    print "<tr><td width=\"".$PHQConf{RIGHT_CELL_SIZE}."\" valign=top>
+".&includeFile($PHQConf{REFRESH_RIGHT_CELL})."</td></tr></table></td>
+\n";
    print "</tr></table>\n";
    print "</body>\n";
    print "</html>\n";
}

sub genLinkErrorPage() {
    print "Content-type: text/html\n\n";

    print "<!doctype html public \"-//w3c//dtd html 4.0 transitional//
+en\">\n";
    print "<html>\n";
    print "<head><title>ISU Portal Applications - Unspecified Target A
+pplication</title>\n";
    ##print "<meta http-equiv=\"Content-Type\" content=\"text/html; ch
+arset=iso-8859-1\">\n";
    print "</head>\n";

    print "<body>\n";
    print "<div align=center>The link you followed seems broken.  Plea
+se select the portal application you wish to use:";
    print "<p><ul>\n";
    print "<li><a href=\"".$PHQConf{KEYMASTER}."?myISU\">MyISU Student
+ Portal</a></li>\n";
    print "<li><a href=\"".$PHQConf{FSTOOLS}."?fsTools\">Faculty/Staff
+ Tools</a></li>\n";
    print "</ul></div>\n";
    print "</body></html>\n";
} # End genLinkErrorPage

sub getCustData($$) {
    my ($clientCookieTok, $custData_ref) = @_;

    my $query = "SELECT custID, IP, token, enteredQue, UNIX_TIMESTAMP(
+lastRefresh), accessState";
    $query .= " FROM ".$tableName." ORDER BY enteredQue";
    my $sth = $cID->prepare($query);
    $sth->execute;
    my $quePos = 0;
    while (my($custID,$IP,$token,$enteredQue,$lastRefresh,$accessState
+) = $sth->fetchrow_array) {
        $quePos++;
        if ($token eq $clientCookieTok) {
            
            # Update custData hash with values from $row and return 1
            $$custData_ref{'custID'} = $custID;
            $$custData_ref{'IP'} = $IP;
            $$custData_ref{'token'} = $token;
            $$custData_ref{'enteredQue'} = $enteredQue;
            $$custData_ref{'lastRefresh'} = $lastRefresh;
            $$custData_ref{'accessState'} = $accessState;
            $$custData_ref{'quePos'} = $quePos;
            return 1;
        }
    }
    return 0;
} # end getCustData()

sub getCustData2($$) {
    my ($clientCookieTok, $custData_ref) = @_;

    my $query = "SELECT $tableName.custID, $tableName.IP, $tableName.t
+oken, UNIX_TIMESTAMP($tableName.enteredQue),";
    $query .= " UNIX_TIMESTAMP($tableName.lastRefresh), $tableName.acc
+essState, ".$tableName."_order.row_num";
    $query .= " FROM $tableName LEFT JOIN ".$tableName."_order ON $tab
+leName.custID=".$tableName."_order.custID";
    $query .= " WHERE $tableName.token='".$clientCookieTok."'";
    $debug .= $query."<BR>";
    my $sth = $cID->prepare($query);
    my $rc = $sth->execute;
    if (! $rc) {
        return 0;
    }

    my($custID,$IP,$token,$enteredQue,$lastRefresh,$accessState,$quePo
+s) = $sth->fetchrow_array;
    if ($quePos eq "NULL") {
        $quePos = "";
    }
            
    # Update custData hash with values from $row and return 1
    $$custData_ref{'custID'} = $custID;
    $$custData_ref{'IP'} = $IP;
    $$custData_ref{'token'} = $token;
    $$custData_ref{'enteredQue'} = $enteredQue;
    $$custData_ref{'lastRefresh'} = $lastRefresh;
    $$custData_ref{'accessState'} = $accessState;
    $$custData_ref{'quePos'} = $quePos;

    return 1;
} # end getCustData()

sub eatCookie($) {
    my ($sessionObj) = @_;

    my $sql = "DELETE FROM ".$tableName." WHERE token='".$sessionObj->
+id."'";
    my $sth = $cID->prepare($sql);
    my $rv = $sth->execute;
    if (! $rv) {
        return 0;
    }
    
    my $cgi = new CGI();
    my $cookieHandle = $cgi->cookie(-name=>$PHQConf{COOKIE_NAME}, -val
+ue=>$sessionObj->id, -expires=>$PHQConf{DELETE_COOKIE});
    $sessionObj->delete();
    return $cookieHandle;
}

sub includeFile($) {
    my ($filePath) = @_;
    
    if (! $filePath) {
        return undef;
    }
    
    open (FILEHANDLE, "< $filePath") || return "Unable to open file $f
+ilePath.<BR>\n";
    my $text = "";
    while (<FILEHANDLE>) {
        $text .= $_;
    }
    close (FILEHANDLE);

    return $text;
} # end includeFile
[download]

Edit: Added <code> tags, READMORE and some formatting. larsen