Checking the 'current' session using the security module.
#!/usr/local/bin/perl
##############################################################################
# file: security_session.pl                                                  #
# 'msparser' toolkit                                                         #
# Test harness / example code                                                #
##############################################################################
# COPYRIGHT NOTICE                                                           #
# Copyright 1998-2010 Matrix Science Limited  All Rights Reserved.           #
#                                                                            #
##############################################################################
#     $Source: parser/examples/test_perl/security_session.pl $ #
#     $Author: villek@matrixscience.com $ #
#       $Date: 2018-07-30 16:23:53 +0100 $ #
#   $Revision: 1b450440f9c97e1e41d0fc6016a27d68951d4532 | MSPARSER_REL_2_8_1-0-gea32989045 $ #
# $NoKeywords::                                                            $ #
##############################################################################
use strict;
##############################################################################

use lib "../bin";
use CGI qw(:standard);
use msparser;

my $thisScript = new CGI;
print $thisScript->header;

print <<STARTHTML;
<html>
<head>
<title>Security session</title>
</head>
<body>
<h1>Security session</h1>
<p>
This utility shows session information for when Mascot Security is enabled.
</p>
<p>
You may be asked to give this information to a support engineer if you have
security problems.
</p>
STARTHTML

my $session;

#$session = new msparser::ms_session("admin", "admin");

if (defined($thisScript->param('sessionID'))) {
  print "<p>Using passed sessionID: ", $thisScript->param('sessionID'), "</p>\n";
  $session = new msparser::ms_session($thisScript->param('sessionID'));
} else {
  $session = new msparser::ms_session;
}

if ($session->isValid) {
    if (!$session->isSecurityEnabled) {
        print "<p><strong>Mascot Security is not enabled</strong></p>\n";
        print "<p>To enable Mascot security, please run 'enable_security' in the <code>mascot/bin</code> directory.</p>\n";
    } else {
        if (defined($thisScript->cookie(-name=>'MASCOT_SESSION'))) {
            print "<p>Retrieved cookie value is: <code>";
            print $thisScript->cookie(-name=>'MASCOT_SESSION');
            print "</code></p>\n";
        }
    
        my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) 
            = gmtime ($session->getLastAccessed);

        $year += 1900;
        my $month = (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec))[$mon];
        my $lastAccessed = join(' ', $mday, $month, $year, $hour.":".$min.":".$sec);

        print '<table border="1" cellpadding="3" cellspacing="1">', "\n";

        my $fmt = "<tr><td>%s</td><td>%s</td></tr>\n";

        printf $fmt, 'ID', $session->getID;
        printf $fmt, 'Security enabled?', $session->isSecurityEnabled;
        printf $fmt, 'Last accessed', $lastAccessed;
        printf $fmt, 'IP address', $session->getIPAddress;
        printf $fmt, 'User', $session->getUserName;
        printf $fmt, 'User ID', $session->getUserID;
        printf $fmt, 'Full username', $session->getFullUserName;
        printf $fmt, 'Email address', $session->getEmailAddress;
        printf $fmt, 'Valid?', $session->isValid;

        if (defined($ENV{'REMOTE_USER'})) {
            printf $fmt, 'Web auth user', $ENV{'REMOTE_USER'};
        }

        print "</table>\n";

        showTasks($session);
    }
} else {
    print "<p>Session is <strong>invalid</strong>.</p>\n";
    displayWarningsAndErrors($session);
}

print <<ENDHTML;
</body>
</html>
ENDHTML



sub showTasks {
    my ($session) = @_;

    my @param_desc = (
        "None", 

        "Integer =", 
        "Integer &lt;=", 
        "Integer &gt;=", 
        "Integer: one of", 
                 
        "Float =", 
        "Float &lt;=", 
        "Float &gt;=", 
        "Float: one of", 
                 
        "String = ", 
        "String: one of",
                 
        "User list"
    );

    my $tasks = $session->getPermittedTasks;

    if ($tasks->getNumberOfTasks == 0) {
        print "<h2>Permitted tasks</h2>\n<p><em>None</em</p>\n";
    } else {
        print <<TABLESTART;
<h2>Permitted tasks</h2>
<table border="1" cellspacing="0" cellpadding="3">
<tr><th>Task</th><th nowrap>Param type</th><th>Parameter</th></tr>
TABLESTART

        for my $taskno (0 .. $tasks->getNumberOfTasks - 1) {
            my $task = $tasks->getTask($taskno);
            my $tt = $task->getType;

            print <<ROW;
<tr>
    <td>$task->getDescription()</td>
    <td nowrap>$param_desc[$tt]</td>
    <td nowrap>$task->getAllParamsAsString()</td>
</tr>
ROW
        }

        print "</table>\n";
    }
}


sub displayWarningsAndErrors {
    my ($obj) = @_;

    return if $obj->isValid;
    
    print <<STARTERRORS;
<p>There were one or more errors:</p>
<ul>
STARTERRORS

    my $err = $obj->getErrorHandler;
    my $numErrs = $err->getNumberOfErrors;

    for my $i (1 .. $numErrs) {
        print "<li>", $err->getErrorString($i), "</li>\n";
    }

    print "</ul>\n";

    $obj->clearAllErrors;
}