msparser/help/security_session_8pl-example.html

#!/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_3_0_0-2024-09-24-0-g93ebaeb4f4 $ #

# $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;

}