2016-03-30 21:51:12 +02:00
|
|
|
##@class Lemonldap::NG::Portal::Main::Run
|
|
|
|
# Serve request part of Lemonldap::NG portal
|
|
|
|
#
|
2016-04-03 08:33:50 +02:00
|
|
|
# Parts of this file:
|
|
|
|
# - response handler
|
|
|
|
# - main entry points
|
|
|
|
# - running methods
|
|
|
|
# - utilities
|
2016-03-31 07:27:59 +02:00
|
|
|
#
|
2016-03-29 23:09:55 +02:00
|
|
|
package Lemonldap::NG::Portal::Main::Run;
|
|
|
|
|
2016-04-07 23:31:56 +02:00
|
|
|
our $VERSION = '2.0.0';
|
2016-03-29 23:09:55 +02:00
|
|
|
|
2016-04-07 23:31:56 +02:00
|
|
|
package Lemonldap::NG::Portal::Main;
|
2016-04-03 18:27:13 +02:00
|
|
|
|
2016-04-07 23:31:56 +02:00
|
|
|
use strict;
|
2016-03-30 21:51:12 +02:00
|
|
|
|
2016-04-03 08:33:50 +02:00
|
|
|
# List constants
|
|
|
|
sub authProcess { qw(extractFormInfo getUser authenticate) }
|
|
|
|
|
|
|
|
sub sessionDatas {
|
2016-12-01 23:25:05 +01:00
|
|
|
qw(setAuthSessionInfo setSessionInfo setMacros setGroups setPersistentSessionInfo
|
2016-04-03 08:33:50 +02:00
|
|
|
setLocalGroups store buildCookie);
|
|
|
|
}
|
|
|
|
|
|
|
|
# RESPONSE HANDLER
|
|
|
|
# ----------------
|
|
|
|
#
|
|
|
|
# - replace Lemonldap::NG::Common::PSGI::Request request by
|
|
|
|
# Lemonldap::NG::Portal::Main::Request
|
|
|
|
# - launch Lemonldap::NG::Common::PSGI::Request::handler()
|
2016-03-30 21:51:12 +02:00
|
|
|
sub handler {
|
2016-04-03 18:51:23 +02:00
|
|
|
my ( $self, $req ) = @_;
|
2016-03-30 21:51:15 +02:00
|
|
|
bless $req, 'Lemonldap::NG::Portal::Main::Request';
|
2016-05-31 13:47:10 +02:00
|
|
|
$req->init();
|
2016-04-03 18:51:23 +02:00
|
|
|
return $self->Lemonldap::NG::Common::PSGI::Router::handler($req);
|
2016-03-30 21:51:12 +02:00
|
|
|
}
|
|
|
|
|
2016-04-03 08:33:50 +02:00
|
|
|
# MAIN ENTRY POINTS (declared in Lemonldap::NG::Portal::Main::Init)
|
|
|
|
# -----------------
|
|
|
|
#
|
|
|
|
# Entry points:
|
|
|
|
# - "/test": - authenticated() for already authenticated users
|
|
|
|
# - pleaseAuth() for others
|
|
|
|
# - "/": - login() ~first access
|
|
|
|
# - postLogin(), same for POST requests
|
|
|
|
# - authenticatedRequest() for authenticated users
|
2016-03-31 07:27:59 +02:00
|
|
|
|
|
|
|
sub authenticated {
|
|
|
|
my ( $self, $req ) = @_;
|
|
|
|
return $self->sendJSONresponse( $req, { status => 1 } );
|
|
|
|
}
|
|
|
|
|
|
|
|
sub pleaseAuth {
|
|
|
|
my ( $self, $req ) = @_;
|
|
|
|
return $self->sendJSONresponse( $req, { status => 0 } );
|
|
|
|
}
|
|
|
|
|
|
|
|
sub login {
|
|
|
|
my ( $self, $req ) = @_;
|
2016-04-03 18:27:22 +02:00
|
|
|
return $self->do(
|
2016-04-01 07:24:27 +02:00
|
|
|
$req,
|
2016-03-31 22:08:43 +02:00
|
|
|
[
|
2016-07-14 10:25:05 +02:00
|
|
|
'controlUrl', @{ $self->beforeAuth },
|
|
|
|
$self->authProcess, @{ $self->betweenAuthAndDatas },
|
|
|
|
$self->sessionDatas, @{ $self->afterDatas },
|
2016-03-31 22:08:43 +02:00
|
|
|
]
|
2016-03-31 07:27:59 +02:00
|
|
|
);
|
|
|
|
}
|
|
|
|
|
|
|
|
sub postLogin {
|
|
|
|
my ( $self, $req ) = @_;
|
2016-04-03 18:27:22 +02:00
|
|
|
return $self->do(
|
2016-04-01 07:24:27 +02:00
|
|
|
$req,
|
2016-03-31 22:08:43 +02:00
|
|
|
[
|
2016-04-03 08:33:50 +02:00
|
|
|
'restoreArgs', 'controlUrl',
|
2016-07-14 10:25:05 +02:00
|
|
|
@{ $self->beforeAuth }, $self->authProcess,
|
|
|
|
@{ $self->betweenAuthAndDatas }, $self->sessionDatas,
|
2016-04-04 07:08:26 +02:00
|
|
|
@{ $self->afterDatas },
|
2016-03-31 22:08:43 +02:00
|
|
|
]
|
2016-03-31 07:27:59 +02:00
|
|
|
);
|
|
|
|
}
|
|
|
|
|
|
|
|
sub authenticatedRequest {
|
2016-03-31 22:08:43 +02:00
|
|
|
my ( $self, $req ) = @_;
|
2016-04-14 21:49:27 +02:00
|
|
|
return $self->do(
|
|
|
|
$req,
|
|
|
|
[
|
2016-05-23 18:55:23 +02:00
|
|
|
'importHandlerDatas', 'controlUrl',
|
|
|
|
'checkLogout', @{ $self->forAuthUser }
|
2016-04-14 21:49:27 +02:00
|
|
|
]
|
|
|
|
);
|
2016-03-31 22:08:43 +02:00
|
|
|
}
|
|
|
|
|
2016-04-13 07:32:10 +02:00
|
|
|
sub postAuthenticatedRequest {
|
|
|
|
my ( $self, $req ) = @_;
|
2016-04-14 20:42:59 +02:00
|
|
|
return $self->do(
|
|
|
|
$req,
|
|
|
|
[
|
2016-05-23 18:55:23 +02:00
|
|
|
'importHandlerDatas', 'restoreArgs',
|
|
|
|
'controlUrl', 'checkLogout',
|
2016-04-14 21:49:27 +02:00
|
|
|
@{ $self->forAuthUser }
|
2016-04-14 20:42:59 +02:00
|
|
|
]
|
|
|
|
);
|
2016-04-13 07:32:10 +02:00
|
|
|
}
|
|
|
|
|
2016-04-18 22:23:40 +02:00
|
|
|
sub logout {
|
|
|
|
my ( $self, $req ) = @_;
|
2016-05-23 18:55:23 +02:00
|
|
|
return $self->do(
|
|
|
|
$req,
|
|
|
|
[
|
|
|
|
'controlUrl', @{ $self->beforeLogout },
|
|
|
|
'authLogout', 'deleteSession'
|
|
|
|
]
|
|
|
|
);
|
2016-04-18 22:23:40 +02:00
|
|
|
}
|
|
|
|
|
2016-04-03 08:33:50 +02:00
|
|
|
# RUNNING METHODS
|
|
|
|
# ---------------
|
|
|
|
|
2016-03-31 22:08:43 +02:00
|
|
|
sub do {
|
2016-04-01 07:24:27 +02:00
|
|
|
my ( $self, $req, $steps ) = @_;
|
2016-03-31 22:08:43 +02:00
|
|
|
$req->steps($steps);
|
2016-04-11 07:00:34 +02:00
|
|
|
my $err = $req->error( $self->process($req) );
|
2016-04-01 07:24:27 +02:00
|
|
|
|
2016-03-31 22:08:43 +02:00
|
|
|
# TODO: updateStatus
|
2016-12-18 09:07:48 +01:00
|
|
|
if ( $err == PE_SENDRESPONSE ) {
|
|
|
|
return $req->response;
|
|
|
|
}
|
2016-04-01 07:24:27 +02:00
|
|
|
if ( !$self->conf->{noAjaxHook} and $req->wantJSON ) {
|
2016-07-11 23:02:32 +02:00
|
|
|
if ( $err > 0 and !%{ $req->sessionInfo } ) {
|
2016-04-01 07:24:27 +02:00
|
|
|
return [
|
|
|
|
401,
|
|
|
|
[
|
|
|
|
'WWW-Authenticate' => "SSO " . $self->conf->{portal},
|
|
|
|
'Access-Control-Allow-Origin' => '*'
|
|
|
|
],
|
|
|
|
[]
|
|
|
|
];
|
2016-03-31 22:08:43 +02:00
|
|
|
}
|
2016-07-11 23:02:32 +02:00
|
|
|
elsif ( $err > 0 ) {
|
|
|
|
return $self->sendJSONresponse(
|
|
|
|
$req,
|
|
|
|
{ result => 0, error => $err },
|
|
|
|
code => 400
|
|
|
|
);
|
|
|
|
}
|
2016-03-31 22:08:43 +02:00
|
|
|
else {
|
2016-07-11 23:02:32 +02:00
|
|
|
return $self->sendJSONresponse(
|
|
|
|
$req,
|
|
|
|
{
|
|
|
|
result => 1,
|
|
|
|
code => $err
|
|
|
|
}
|
|
|
|
);
|
2016-03-31 22:08:43 +02:00
|
|
|
}
|
|
|
|
}
|
|
|
|
else {
|
2016-11-22 21:55:10 +01:00
|
|
|
if (
|
|
|
|
$err
|
|
|
|
and $err != PE_LOGOUT_OK
|
|
|
|
and (
|
|
|
|
$err != PE_REDIRECT
|
|
|
|
or ( $err == PE_REDIRECT
|
2016-12-02 06:47:38 +01:00
|
|
|
and $req->datas->{redirectFormMethod}
|
2016-11-22 21:55:10 +01:00
|
|
|
and $req->datas->{redirectFormMethod} eq 'post' )
|
2016-12-22 09:40:50 +01:00
|
|
|
or ( $err == PE_REDIRECT and $req->info )
|
2016-11-22 21:55:10 +01:00
|
|
|
)
|
|
|
|
)
|
|
|
|
{
|
2016-04-11 07:12:39 +02:00
|
|
|
my ( $tpl, $prms ) = $self->display($req);
|
|
|
|
return $self->sendHtml( $req, $tpl, params => $prms );
|
2016-03-31 22:08:43 +02:00
|
|
|
}
|
|
|
|
else {
|
|
|
|
return $self->autoRedirect($req);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2016-04-03 08:33:50 +02:00
|
|
|
# Utilities
|
|
|
|
# ---------
|
|
|
|
|
|
|
|
sub getModule {
|
|
|
|
my ( $self, $req, $type ) = @_;
|
|
|
|
if (
|
|
|
|
my $mod = {
|
|
|
|
auth => '_authentication',
|
|
|
|
user => '_userDB',
|
|
|
|
password => '_passwordDB'
|
|
|
|
}->{$type}
|
|
|
|
)
|
|
|
|
{
|
2016-07-02 10:51:00 +02:00
|
|
|
if ( my $sub = $self->$mod->can('name') ) {
|
|
|
|
return $sub->( $self->$mod, $req, $type );
|
2016-04-03 08:33:50 +02:00
|
|
|
}
|
|
|
|
else {
|
2016-05-24 07:05:51 +02:00
|
|
|
my $s = ref( $self->$mod );
|
2016-07-13 07:10:57 +02:00
|
|
|
$s =~
|
|
|
|
s/^Lemonldap::NG::Portal::(?:(?:Issuer|UserDB|Auth|Password)::)?//;
|
2016-05-24 07:05:51 +02:00
|
|
|
return $s;
|
2016-04-03 08:33:50 +02:00
|
|
|
}
|
|
|
|
}
|
|
|
|
elsif ( $type eq 'issuer' ) {
|
|
|
|
return $req->{_activeIssuerDB};
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
die "Unknown type $type";
|
2016-03-31 22:08:43 +02:00
|
|
|
}
|
2016-03-31 07:27:59 +02:00
|
|
|
}
|
|
|
|
|
2016-04-03 10:44:58 +02:00
|
|
|
sub autoRedirect {
|
|
|
|
my ( $self, $req ) = @_;
|
|
|
|
|
|
|
|
# Set redirection URL if needed
|
2016-05-23 18:55:18 +02:00
|
|
|
$req->{urldc} ||= $self->conf->{portal} if ( $req->mustRedirect );
|
2016-04-03 10:44:58 +02:00
|
|
|
|
|
|
|
# Redirection should be made if urldc defined
|
2016-05-26 23:26:47 +02:00
|
|
|
if ( $req->{urldc} and not $req->param('lmError') ) {
|
|
|
|
if ( $self->_jsRedirect->() ) {
|
|
|
|
$req->error(PE_REDIRECT);
|
|
|
|
$req->datas->{redirectFormMethod} = "get";
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
return [ 302, [ Location => $req->{urldc}, @{ $req->respHeaders } ],
|
|
|
|
[] ];
|
|
|
|
}
|
2016-04-03 10:44:58 +02:00
|
|
|
}
|
2016-05-26 23:26:47 +02:00
|
|
|
my ( $tpl, $prms ) = $self->display($req);
|
|
|
|
return $self->sendHtml( $req, $tpl, params => $prms );
|
2016-04-03 10:44:58 +02:00
|
|
|
}
|
|
|
|
|
2016-04-04 22:39:22 +02:00
|
|
|
# Try to recover the session corresponding to id and return session datas.
|
|
|
|
# If $id is set to undef or if $force is true, return a new session.
|
|
|
|
# @param id session reference
|
|
|
|
# @param noInfo do not set Apache REMOTE_USER
|
|
|
|
# @param force Force session creation if it does not exist
|
2016-11-15 14:33:39 +01:00
|
|
|
# @param kind Session kind
|
2016-04-04 22:39:22 +02:00
|
|
|
# return Lemonldap::NG::Common::Session object
|
|
|
|
sub getApacheSession {
|
2016-11-15 14:33:39 +01:00
|
|
|
my ( $self, $id, $noInfo, $force, $kind ) = @_;
|
|
|
|
$kind ||= "SSO";
|
2016-04-04 22:39:22 +02:00
|
|
|
|
2016-06-09 13:45:10 +02:00
|
|
|
if ($id) {
|
2016-11-15 14:33:39 +01:00
|
|
|
$self->lmLog( "Try to get $kind session $id", 'debug' );
|
2016-06-09 13:45:10 +02:00
|
|
|
}
|
|
|
|
else {
|
2016-11-15 14:33:39 +01:00
|
|
|
$self->lmLog( "Try to get a new $kind session", 'debug' );
|
2016-06-09 13:45:10 +02:00
|
|
|
}
|
|
|
|
|
2016-04-04 22:39:22 +02:00
|
|
|
my $as = Lemonldap::NG::Common::Session->new(
|
|
|
|
{
|
|
|
|
storageModule => $self->conf->{globalStorage},
|
|
|
|
storageModuleOptions => $self->conf->{globalStorageOptions},
|
|
|
|
cacheModule => $self->conf->{localSessionStorage},
|
|
|
|
cacheModuleOptions => $self->conf->{localSessionStorageOptions},
|
|
|
|
id => $id,
|
|
|
|
force => $force,
|
2016-11-15 14:33:39 +01:00
|
|
|
kind => $kind,
|
2016-04-04 22:39:22 +02:00
|
|
|
}
|
|
|
|
);
|
|
|
|
|
|
|
|
if ( $as->error ) {
|
2016-06-09 13:45:10 +02:00
|
|
|
$self->lmLog( $as->error, 'error' );
|
2016-04-04 22:39:22 +02:00
|
|
|
return;
|
|
|
|
}
|
|
|
|
|
|
|
|
if ( $id and !$force and !$as->data ) {
|
2016-11-15 14:33:39 +01:00
|
|
|
$self->lmLog( "Session $kind $id not found", 'debug' );
|
2016-04-04 22:39:22 +02:00
|
|
|
return;
|
|
|
|
}
|
|
|
|
|
2016-06-09 13:45:10 +02:00
|
|
|
my $now = time;
|
|
|
|
if (
|
2016-07-22 11:47:50 +02:00
|
|
|
$id
|
|
|
|
and defined $as->data->{_utime}
|
2016-06-09 13:45:10 +02:00
|
|
|
and (
|
|
|
|
$now - $as->data->{_utime} > $self->conf->{timeout}
|
|
|
|
or ( $self->conf->{timeoutActivity}
|
|
|
|
and $as->data->{_lastSeen}
|
|
|
|
and $now - $as->data->{_lastSeen} >
|
|
|
|
$self->conf->{timeoutActivity} )
|
|
|
|
)
|
|
|
|
)
|
|
|
|
{
|
2016-11-15 14:33:39 +01:00
|
|
|
$self->lmLog( "Session $kind $id expired", 'debug' );
|
2016-06-09 13:45:10 +02:00
|
|
|
return;
|
|
|
|
}
|
|
|
|
|
2016-04-04 22:39:22 +02:00
|
|
|
unless ($noInfo) {
|
|
|
|
$self->{id} = $as->id;
|
|
|
|
}
|
2016-06-09 13:45:10 +02:00
|
|
|
|
2016-11-15 14:33:39 +01:00
|
|
|
$self->lmLog( "Return $kind session " . $as->id, 'debug' );
|
2016-06-09 13:45:10 +02:00
|
|
|
|
2016-04-04 22:39:22 +02:00
|
|
|
return $as;
|
|
|
|
}
|
|
|
|
|
|
|
|
# Try to recover the persistent session corresponding to uid and return session datas.
|
|
|
|
sub getPersistentSession {
|
|
|
|
my ( $self, $uid ) = @_;
|
|
|
|
|
|
|
|
return unless defined $uid;
|
|
|
|
|
|
|
|
# Compute persistent identifier
|
|
|
|
my $pid = $self->_md5hash($uid);
|
|
|
|
|
|
|
|
my $ps = Lemonldap::NG::Common::Session->new(
|
|
|
|
{
|
2016-04-05 22:46:11 +02:00
|
|
|
storageModule => $self->conf->{persistentStorage},
|
|
|
|
storageModuleOptions => $self->conf->{persistentStorageOptions},
|
2016-04-04 22:39:22 +02:00
|
|
|
id => $pid,
|
|
|
|
force => 1,
|
|
|
|
kind => "Persistent",
|
|
|
|
}
|
|
|
|
);
|
|
|
|
|
|
|
|
if ( $ps->error ) {
|
|
|
|
$self->lmLog( $ps->error, 'debug' );
|
|
|
|
}
|
|
|
|
|
|
|
|
# Set _session_uid if not already present
|
|
|
|
unless ( defined $ps->data->{_session_uid} ) {
|
|
|
|
$ps->update( { '_session_uid' => $uid } );
|
|
|
|
}
|
|
|
|
|
|
|
|
# Set _utime if not already present
|
|
|
|
unless ( defined $ps->data->{_utime} ) {
|
|
|
|
$ps->update( { '_utime' => time } );
|
|
|
|
}
|
|
|
|
|
|
|
|
return $ps;
|
|
|
|
}
|
|
|
|
|
2016-06-01 19:36:51 +02:00
|
|
|
# Update persistent session.
|
|
|
|
# Call updateSession() and store %$infos in a persistent session.
|
|
|
|
# Note that if the session does not exists, it will be created.
|
|
|
|
# @param infos hash reference of information to update
|
|
|
|
# @param uid optional Unhashed persistent session ID
|
|
|
|
# @param id optional SSO session ID
|
|
|
|
# @return nothing
|
|
|
|
sub updatePersistentSession {
|
|
|
|
my ( $self, $req, $infos, $uid, $id ) = @_;
|
|
|
|
|
|
|
|
# Return if no infos to update
|
|
|
|
return () unless ( ref $infos eq 'HASH' and %$infos );
|
|
|
|
|
|
|
|
# Update current session
|
|
|
|
$self->updateSession( $req, $infos, $id );
|
|
|
|
|
2016-06-01 21:19:53 +02:00
|
|
|
$uid ||= $req->{sessionInfo}->{ $self->conf->{whatToTrace} };
|
2016-06-01 19:36:51 +02:00
|
|
|
return () unless ($uid);
|
|
|
|
|
|
|
|
my $persistentSession = $self->getPersistentSession($uid);
|
|
|
|
|
|
|
|
$persistentSession->update($infos);
|
|
|
|
|
|
|
|
if ( $persistentSession->error ) {
|
|
|
|
$self->lmLog(
|
|
|
|
"Cannot update persistent session " . $self->_md5hash($uid),
|
|
|
|
'error' );
|
|
|
|
$self->lmLog( $persistentSession->error, 'error' );
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
# Update session stored.
|
|
|
|
# If no id is given, try to get it from cookie.
|
|
|
|
# If the session is available, update datas with $info.
|
|
|
|
# Note that outdated session data may remain some time on
|
|
|
|
# server local cache, if there are several LL::NG servers.
|
|
|
|
# @param infos hash reference of information to update
|
|
|
|
# @param id Session ID
|
|
|
|
# @return nothing
|
|
|
|
sub updateSession {
|
|
|
|
my ( $self, $req, $infos, $id ) = @_;
|
|
|
|
|
|
|
|
# Return if no infos to update
|
|
|
|
return () unless ( ref $infos eq 'HASH' and %$infos );
|
|
|
|
|
|
|
|
# Recover session ID unless given
|
|
|
|
$id ||= $req->{id};
|
|
|
|
|
|
|
|
if ($id) {
|
|
|
|
|
|
|
|
# Update sessionInfo data
|
|
|
|
## sessionInfo updated if $id defined : quite strange !!
|
|
|
|
## See http://jira.ow2.org/browse/LEMONLDAP-430
|
|
|
|
foreach ( keys %$infos ) {
|
|
|
|
$self->lmLog( "Update sessionInfo $_ with " . $infos->{$_},
|
|
|
|
'debug' );
|
|
|
|
$req->{sessionInfo}->{$_} = $infos->{$_};
|
|
|
|
}
|
|
|
|
|
|
|
|
# Update session in global storage
|
|
|
|
if ( my $apacheSession = $self->getApacheSession( $id, 1 ) ) {
|
|
|
|
|
|
|
|
# Store updateTime
|
|
|
|
$infos->{updateTime} = strftime( "%Y%m%d%H%M%S", localtime() );
|
|
|
|
|
|
|
|
# Store/update session values
|
|
|
|
$apacheSession->update($infos);
|
|
|
|
|
|
|
|
if ( $apacheSession->error ) {
|
|
|
|
$self->lmLog( "Cannot update session $id", 'error' );
|
|
|
|
$self->lmLog( $apacheSession->error, 'error' );
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2016-04-14 21:49:27 +02:00
|
|
|
# Delete an existing session. If "securedCookie" is set to 2, the http session
|
|
|
|
# will also be removed.
|
|
|
|
# @param h tied Apache::Session object
|
|
|
|
# @param preserveCookie do not delete cookie
|
|
|
|
# @return True if session has been deleted
|
|
|
|
sub _deleteSession {
|
|
|
|
my ( $self, $req, $session, $preserveCookie ) = @_;
|
|
|
|
|
|
|
|
# Invalidate http cookie and session, if set
|
2016-07-12 20:58:33 +02:00
|
|
|
if ( $self->conf->{securedCookie} >= 2 ) {
|
2016-04-14 21:49:27 +02:00
|
|
|
|
|
|
|
# Try to find a linked http session (securedCookie == 2)
|
2016-07-12 20:58:33 +02:00
|
|
|
if ( $self->conf->{securedCookie} == 2
|
2016-07-12 18:33:20 +02:00
|
|
|
and my $id2 = $session->data->{_httpSession} )
|
|
|
|
{
|
2016-04-14 21:49:27 +02:00
|
|
|
if ( my $session2 = $self->getApacheSession( $id2, 1 ) ) {
|
|
|
|
$session2->remove;
|
|
|
|
if ( $session2->error ) {
|
|
|
|
$self->lmLog( "Unable to remove linked session $id2",
|
|
|
|
'debug' );
|
|
|
|
$self->lmLog( $session2->error, 'debug' );
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
# Create an obsolete cookie to remove it
|
|
|
|
push @{ $req->respHeaders },
|
|
|
|
'Set-Cookie' => $self->cookie(
|
|
|
|
name => $self->conf->{cookieName} . 'http',
|
|
|
|
value => 0,
|
|
|
|
domain => $self->conf->{domain},
|
|
|
|
path => "/",
|
|
|
|
secure => 0,
|
|
|
|
expires => '-1d',
|
|
|
|
) unless ($preserveCookie);
|
|
|
|
}
|
|
|
|
|
2016-12-22 21:18:58 +01:00
|
|
|
HANDLER->unlog($session->id);
|
2016-04-14 21:49:27 +02:00
|
|
|
$session->remove;
|
|
|
|
|
|
|
|
# Create an obsolete cookie to remove it
|
|
|
|
push @{ $req->respHeaders },
|
|
|
|
'Set-Cookie' => $self->cookie(
|
|
|
|
name => $self->conf->{cookieName},
|
|
|
|
value => 0,
|
|
|
|
domain => $self->conf->{domain},
|
|
|
|
path => "/",
|
|
|
|
secure => 0,
|
|
|
|
expires => '-1d',
|
|
|
|
) unless ($preserveCookie);
|
|
|
|
|
|
|
|
# Log
|
|
|
|
my $user = $req->{sessionInfo}->{ $self->conf->{whatToTrace} };
|
|
|
|
$self->userNotice("User $user has been disconnected") if $user;
|
|
|
|
|
|
|
|
return $session->error ? 0 : 1;
|
|
|
|
}
|
|
|
|
|
2016-04-04 22:39:22 +02:00
|
|
|
# Return md5(s)
|
|
|
|
sub _md5hash {
|
|
|
|
my ( $self, $s ) = @_;
|
|
|
|
return substr( Digest::MD5::md5_hex($s), 0, 32 );
|
|
|
|
}
|
|
|
|
|
2016-04-03 10:44:58 +02:00
|
|
|
# Check if an URL's domain name is declared in LL::NG config or is declared as
|
|
|
|
# trusted domain
|
|
|
|
sub isTrustedUrl {
|
|
|
|
my ( $self, $url ) = @_;
|
2016-05-23 13:53:09 +02:00
|
|
|
return $url =~ $self->trustedDomainsRe ? 1 : 0;
|
2016-04-03 10:44:58 +02:00
|
|
|
}
|
|
|
|
|
2016-11-16 16:27:01 +01:00
|
|
|
sub stamp {
|
|
|
|
my $self = shift;
|
|
|
|
return $self->conf->{cipher} ? $self->conf->{cipher}->encrypt( time() ) : 1;
|
|
|
|
}
|
|
|
|
|
2016-11-22 13:34:09 +01:00
|
|
|
# Transfer POST data with auto submit
|
|
|
|
# @return void
|
|
|
|
sub autoPost {
|
|
|
|
my ( $self, $req ) = @_;
|
|
|
|
|
|
|
|
# Get URL and Form fields
|
|
|
|
$req->{urldc} = $req->postUrl;
|
|
|
|
my $formFields = $req->postFields;
|
|
|
|
|
|
|
|
$self->clearHiddenFormValue($req);
|
|
|
|
foreach ( keys %$formFields ) {
|
|
|
|
$self->setHiddenFormValue( $req, $_, $formFields->{$_}, "", 0 );
|
|
|
|
}
|
|
|
|
|
|
|
|
# Display info before redirecting
|
|
|
|
if ( $req->info() ) {
|
|
|
|
$req->{infoFormMethod} = $req->param('method') || "post";
|
|
|
|
return PE_INFO;
|
|
|
|
}
|
|
|
|
|
2016-11-22 21:55:10 +01:00
|
|
|
$req->datas->{redirectFormMethod} = "post";
|
2016-11-22 13:34:09 +01:00
|
|
|
return PE_REDIRECT;
|
|
|
|
}
|
|
|
|
|
|
|
|
# Add element into $self->{portalHiddenFormValues}, those values could be
|
|
|
|
# used to hide values into HTML form.
|
|
|
|
# @param fieldname The field name which will contain the correponding value
|
|
|
|
# @param value The associated value
|
|
|
|
# @param prefix Prefix of the field key
|
|
|
|
# @param base64 Encode value in base64
|
|
|
|
# @return nothing
|
|
|
|
sub setHiddenFormValue {
|
|
|
|
my ( $self, $req, $key, $val, $prefix, $base64 ) = @_;
|
|
|
|
|
|
|
|
# Default values
|
|
|
|
$prefix = "lmhidden_" unless defined $prefix;
|
|
|
|
$base64 = 1 unless defined $base64;
|
|
|
|
|
|
|
|
# Store value
|
|
|
|
if ($val) {
|
2016-12-02 06:47:38 +01:00
|
|
|
$key = $prefix . $key;
|
|
|
|
$val = encode_base64( $val, '' ) if $base64;
|
2016-11-22 13:34:09 +01:00
|
|
|
$req->{portalHiddenFormValues}->{$key} = $val;
|
|
|
|
$self->lmLog( "Store $val in hidden key $key", 'debug' );
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
## @method public void getHiddenFormValue(string fieldname, string prefix, boolean base64)
|
|
|
|
# Get value into $self->{portalHiddenFormValues}.
|
|
|
|
# @param fieldname The existing field name which contains a value
|
|
|
|
# @param prefix Prefix of the field key
|
|
|
|
# @param base64 Decode value from base64
|
|
|
|
# @return string The associated value
|
|
|
|
sub getHiddenFormValue {
|
|
|
|
my ( $self, $req, $key, $prefix, $base64 ) = @_;
|
|
|
|
|
|
|
|
# Default values
|
|
|
|
$prefix = "lmhidden_" unless defined $prefix;
|
|
|
|
$base64 = 1 unless defined $base64;
|
|
|
|
|
|
|
|
$key = $prefix . $key;
|
|
|
|
|
|
|
|
# Get value
|
|
|
|
if ( my $val = $req->param($key) ) {
|
|
|
|
$val = decode_base64($val) if $base64;
|
|
|
|
return $val;
|
|
|
|
$self->lmLog( "Hidden value $val found for key $key", 'debug' );
|
|
|
|
}
|
|
|
|
|
|
|
|
# No value found
|
|
|
|
return undef;
|
|
|
|
}
|
|
|
|
|
|
|
|
## @method protected void clearHiddenFormValue(arrayref keys)
|
|
|
|
# Clear values form stored hidden fields
|
|
|
|
# Delete all keys if no keys provided
|
|
|
|
# @param keys Array reference of keys
|
|
|
|
# @return nothing
|
|
|
|
sub clearHiddenFormValue {
|
|
|
|
my ( $self, $req, $keys ) = @_;
|
|
|
|
|
|
|
|
unless ( defined $keys ) {
|
|
|
|
delete $req->{portalHiddenFormValues};
|
|
|
|
$self->lmLog( "Delete all hidden values", 'debug' );
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
foreach (@$keys) {
|
|
|
|
delete $req->{portalHiddenFormValues}->{$_};
|
|
|
|
$self->lmLog( "Delete hidden value for key $_", 'debug' );
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
return;
|
|
|
|
}
|
|
|
|
|
2016-11-28 22:15:57 +01:00
|
|
|
# Get the first value of a multivaluated session value
|
|
|
|
sub getFirstValue {
|
|
|
|
my ( $self, $value ) = @_;
|
|
|
|
|
|
|
|
my @values = split /$self->{conf}->{multiValuesSeparator}/, $value;
|
|
|
|
|
|
|
|
return $values[0];
|
|
|
|
}
|
|
|
|
|
2016-12-15 22:22:15 +01:00
|
|
|
sub info {
|
2016-12-17 08:58:53 +01:00
|
|
|
my ( $self, $req, $info ) = @_;
|
|
|
|
return $req->info($info);
|
2016-12-15 22:22:15 +01:00
|
|
|
}
|
|
|
|
|
2016-12-22 09:40:50 +01:00
|
|
|
sub fullUrl {
|
|
|
|
my ( $self, $req ) = @_;
|
|
|
|
my $pHost = $self->conf->{portal};
|
|
|
|
$pHost =~ s#^(https?://[^/]+)(?:/.*)?$#$1#;
|
|
|
|
return $pHost . $req->uri;
|
|
|
|
}
|
|
|
|
|
2016-03-29 23:09:55 +02:00
|
|
|
1;
|