CGI-AppBuilder-MapSecus
view release on metacpan or search on metacpan
MapSecus.pm view on Meta::CPAN
|| $tsk =~ /^disp_(client|project|study|list|job|link|frd)/i
|| $tsk =~ /^(sel_stat)/i
|| (exists $ar->{logout} && $ar->{logout}) );
my $ctm = strftime "%Y%m%d.%H%M%S", localtime;
# we return OK if the tmo has more than 10 minutes remaining
return (1, 'OK') if ($usr_tmo && ($usr_tmo>$ctm)
&& (($usr_tmo-$ctm) > 0.0010));
# 1. check session id
my ($id_OK, $usr_gid) = $s->set_guid($ar);
$usr_gid = ($usr_gid) ? $usr_gid : '' ;
if (! $id_OK) {
print $q->header("text/html");
print $q->start_html(%{$ar->{html_header}});
print "$usr_gid<br>\n";
print "Please $s1b<br>\n";
print $q->end_html;
exit;
}
if (!$usr_gid) {
# $msg = "No user credential.<br>";
print $q->header("text/html");
print $q->start_html(%{$ar->{html_header}});
print "Please $s1b<br>\n";
print $q->end_html;
exit;
} else {
my @ss = split /:/, $usr_gid;
$usr_sid = $ss[0] if !$usr_sid;
$usr_uid = $ss[1] if !$usr_uid;
$usr_tmo = $ss[2] if !$usr_tmo;
}
$ar->{app_user} = $usr_uid if !$usr_app && $usr_uid;
$ar->{guid} = $usr_gid if !$guid && $usr_gid;
# 2. check timeout
$msg = "OK: ";
$msg .= "got user $usr_uid " if $usr_uid;
$msg .= "and its password " if $usr_pwd;
$msg .= "and GID = $usr_gid " if $usr_gid;
$msg .= "for task $tsk";
$msg .= ($ntsk) ? "->$ntsk.<br>\n" : ".<br>\n";
if ($usr_tmo && $usr_tmo > $ctm) {
$msg .= "This session will be expired at $usr_tmo.<br>";
} else {
$msg .= "This session has expired at <b>$usr_tmo</b>.<br>" if $usr_tmo;
}
return (1,$msg) if ( ($tsk =~ /(login)$/i && $usr_uid && $usr_pwd)
|| ($usr_tmo && $usr_tmo > $ctm) || $tsk =~ /(setanypwd)$/i);
# 3. check if we need to start the login page
$u1b .= "&guid=$usr_gid";
if (!$usr_gid || $usr_tmo && $usr_tmo < $ctm ) {
print $q->header("text/html");
print $q->start_html(%{$ar->{html_header}});
print "$msg\nPlease $s1b<br>\n";
print $q->end_html;
exit;
}
# 4. check required inputs
return (0, "ERR: missing task name.") if !$tsk;
return (0, "ERR: missing server/DB name.") if !$sn;
MapSecus.pm view on Meta::CPAN
my $vr = ['cln_id','prj_id','study_id','list_id','job_id','stg_schema'];
# $ar->{var_arf} = $vr;
my $rr = $s->parse_records($rst, $vr, '==', ',');
# 3. set ids
my $r = {};
foreach my $k (split /,/, $vs) {
$r->{$k} = $rr->[0]{$k};
$ar->{$k} = $rr->[0]{$k} if !exists $ar->{$k} || $ar->{$k} !~ /^\d+$/;
}
my $usr_gid = (exists $ar->{guid}) ? $ar->{guid} : "";
my $aa = ($usr_gid) ? [split /:/, $usr_gid] : [];
$ar->{user_sid} = $aa->[0] if !exists $ar->{user_sid} && exists $aa->[0];
$ar->{user_uid} = $aa->[1] if !exists $ar->{user_uid} && exists $aa->[1];
$ar->{user_tmo} = $aa->[2] if !exists $ar->{user_tmo} && exists $aa->[2];
wantarray ? %$r : $r;
}
1;
=head1 HISTORY
( run in 0.737 second using v1.01-cache-2.11-cpan-5735350b133 )