lemonldap-ng/lemonldap-ng-portal/lib/Lemonldap/NG/Portal/Main/Process.pm
2016-11-22 12:34:09 +00:00

446 lines
12 KiB
Perl

package Lemonldap::NG::Portal::Main::Process;
our $VERSION = '2.0.0';
package Lemonldap::NG::Portal::Main;
use strict;
use MIME::Base64;
use POSIX qw(strftime);
# Main method
# -----------
# Launch all methods declared in request "steps" array. Methods can be
# declared by their name (in Lemonldap::NG::Portal::Main namespace) or point
# to a subroutine (see Lemonldap::NG::Portal::Main::Run.pm)
sub process {
my ( $self, $req ) = @_;
#$req->error(PE_OK);
my $err = PE_OK;
while ( my $sub = shift @{ $req->steps } ) {
if ( ref $sub ) {
$self->lmLog( "Processing code ref", 'debug' );
last if ( $err = $sub->($req) );
}
else {
$self->lmLog( "Processing $sub", 'debug' );
last if ( $err = $self->$sub($req) );
}
}
$self->lmLog( "Returned error: $err", 'debug' ) if ($err);
return $err;
}
# First process block: check args
# -------------------------------
# For post requests, parse datas
sub restoreArgs {
my ( $self, $req ) = @_;
$req->parseBody;
$req->mustRedirect(1);
return ( %{ $req->params } ? PE_OK : PE_FORMEMPTY );
}
sub importHandlerDatas {
my ( $self, $req ) = @_;
$req->{sessionInfo} = $req->userData;
$req->id( $req->sessionInfo->{_session_id} );
$req->user( $req->sessionInfo->{ $self->conf->{whatToTrace} } );
PE_OK;
}
# Verify url parameter
sub controlUrl {
my ( $self, $req ) = @_;
$req->{datas}->{_url} ||= '';
if ( my $url = $req->param('url') ) {
# REJECT NON BASE64 URL
if ( $req->urlNotBase64 ) {
$req->{urldc} = $url;
}
else {
if ( $url =~ m#[^A-Za-z0-9\+/=]# ) {
$self->lmLog(
"Value must be in BASE64 (param: url | value: $url)",
"warn" );
return PE_BADURL;
}
$req->{urldc} = decode_base64($url);
$req->{urldc} =~ s/[\r\n]//sg;
}
# For logout request, test if Referer comes from an authorizated site
my $tmp = (
$req->param('logout')
? $req->referer
: $req->{urldc}
);
# XSS attack
if (
$self->checkXSSAttack(
$req->param('logout') ? 'HTTP Referer' : 'urldc',
$req->{urldc}
)
)
{
delete $req->{urldc};
return PE_BADURL;
}
# Non protected hosts
if ( $tmp and !$self->isTrustedUrl($tmp) ) {
$self->lmLog(
"URL contains a non protected host (param: "
. ( $req->param('logout') ? 'HTTP Referer' : 'urldc' )
. " | value: $tmp)",
"warn"
);
delete $req->{urldc};
return PE_BADURL;
}
$req->datas->{_url} = $url;
}
PE_OK;
}
sub checkLogout {
my ( $self, $req ) = @_;
if ( $req->param('logout') ) {
$req->steps(
[ @{ $self->beforeLogout }, 'authLogout', 'deleteSession' ] );
}
PE_OK;
}
sub authLogout {
my ( $self, $req ) = @_;
return $self->_authentication->authLogout($req);
}
sub deleteSession {
my ( $self, $req ) = @_;
my $apacheSession = $self->getApacheSession( $req->id );
unless ( $self->_deleteSession( $req, $apacheSession ) ) {
$self->lmLog( "Unable to delete session " . $req->id, 'error' );
$self->lmLog( $apacheSession->error, 'error' );
return PE_ERROR;
}
else {
HANDLER->localUnlog( $req->id );
$self->lmLog( "Session $req->{id} deleted from global storage",
'debug' );
}
# TODO
# Collect logout services and build hidden iFrames
#if ( $self->{logoutServices} and %{ $self->{logoutServices} } ) {
# $self->lmLog( "Create iFrames to forward logout to services",
# 'debug' );
# $self->info( "<h3>" . $self->msg(PM_LOGOUT) . "</h3>" );
# foreach ( keys %{ $self->{logoutServices} } ) {
# my $logoutServiceName = $_;
# my $logoutServiceUrl =
# $self->{logoutServices}->{$logoutServiceName};
# $self->lmLog(
#"Find lo#gout service $logoutServiceName ($logoutServiceUrl)",
# 'debug'
# );
# my $iframe =
# "<iframe src=\"$logoutServiceUrl\""
# . " alt=\"$logoutServiceName\" marginwidth=\"0\""
# . " marginheight=\"0\" scrolling=\"no\" style=\"border: none;display: hidden;margin: 0\""
# . " width=\"0\" height=\"0\" frameborder=\"0\">"
# . "</iframe>";
# $self->info($iframe);
# }
# # Redirect on logout page if no other target defined
# if ( !$self->{urldc} and !$self->{postUrl} ) {
# $self->{urldc} = $ENV{SCRIPT_NAME} . "?logout=1";
# }
#}
# Redirect or Post if asked by authLogout
#return $self->_subProcess(qw(autoRedirect))
# if ( $self->{urldc}
# and $self->{urldc} ne $self->{portal} );
#return $self->_subProcess(qw(autoPost))
# if ( $self->{postUrl} );
# If logout redirects to another URL, just remove next steps for the
# request so autoRedirect will be called
if ( $req->{urldc} and $req->{urldc} ne $self->conf->{portal} ) {
$req->steps( [] );
return PE_OK;
}
# Else display "error"
return PE_LOGOUT_OK;
}
# Check value to detect XSS attack
# @param name Parameter name
# @param value Parameter value
# @return 1 if attack detected, 0 else
sub checkXSSAttack {
my ( $self, $name, $value ) = @_;
# Empty values are not bad
return 0 unless $value;
# Test value
$value =~ s/\%25/\%/g;
if ( $value =~ m/(?:\0|<|'|"|`|\%(?:00|3C|22|27|2C))/ ) {
$self->lmLog( "XSS attack detected (param: $name | value: $value)",
"warn" );
return $self->conf->{checkXSS};
}
return 0;
}
# Second block: auth process (call auth or userDB object)
# -------------------------------------------------------
sub extractFormInfo {
my ( $self, $req ) = @_;
my $ret = $self->_authentication->extractFormInfo($req);
if ( $ret == PE_OK and not ($req->user or $req->continue) ) {
$self->lmLog(
'Authentication module succeed but has not set $req->user',
'error' );
return PE_ERROR;
}
return $ret;
}
sub getUser {
my ( $self, $req ) = @_;
return $self->_userDB->getUser($req);
}
sub authenticate {
my ( $self, $req ) = @_;
return $self->_authentication->authenticate($req);
}
# Third block: Session data providing
# -----------------------------------
sub setSessionInfo {
my ( $self, $req ) = @_;
# Set _user
$req->{sessionInfo}->{_user} = $req->{user};
# Get the current user module
$req->{sessionInfo}->{_auth} = $self->getModule( $req, "auth" );
$req->{sessionInfo}->{_userDB} = $self->getModule( $req, "user" );
# Store IP address from remote address or X-FORWARDED-FOR header
$req->{sessionInfo}->{ipAddr} = $req->remote_ip;
# Date and time
if ( $self->conf->{updateSession} ) {
$req->{sessionInfo}->{updateTime} =
strftime( "%Y%m%d%H%M%S", localtime() );
}
else {
$req->{sessionInfo}->{_utime} ||= time();
$req->{sessionInfo}->{startTime} =
strftime( "%Y%m%d%H%M%S", localtime() );
$req->{sessionInfo}->{_lastSeen} = time()
if $self->conf->{timeoutActivity};
}
# Get environment variables matching exportedVars (works only with HTTP_*
# and SSL_*: see Main/Request.pm)
foreach ( keys %{ $self->conf->{exportedVars} } ) {
if ( my $tmp = $req->{ $self->conf->{exportedVars}->{$_} } ) {
$tmp =~ s/[\r\n]/ /gs;
$req->{sessionInfo}->{$_} = $tmp;
}
}
# Store URL origin in session
$req->{sessionInfo}->{_url} = $req->{urldc};
# Share sessionInfo with underlying handler (needed for safe jail)
$req->userData( $req->sessionInfo );
# Call UserDB setSessionInfo
return $self->_userDB->setSessionInfo($req);
PE_OK;
}
sub setMacros {
my ( $self, $req ) = @_;
foreach ( sort keys %{ $self->_macros } ) {
$req->{sessionInfo}->{$_} = $self->_macros->{$_}->( $req->sessionInfo );
}
PE_OK;
}
sub setGroups {
my ( $self, $req ) = @_;
return $self->_userDB->setGroups($req);
}
sub setPersistentSessionInfo {
my ( $self, $req ) = @_;
# Do not restore infos if session already opened
unless ( $req->{id} ) {
my $key = $req->{sessionInfo}->{ $self->conf->{whatToTrace} };
return PE_OK unless ( $key and length($key) );
my $persistentSession = $self->getPersistentSession($key);
if ($persistentSession) {
$self->lmLog( "Persistent session found for $key", 'debug' );
foreach my $k ( keys %{ $persistentSession->data } ) {
# Do not restore some parameters
next if $k =~ /^_(?:utime|session_(?:u?id|kind))$/;
$self->lmLog( "Restore persistent parameter $k", 'debug' );
$req->{sessionInfo}->{$k} = $persistentSession->data->{$k};
}
}
}
PE_OK;
}
sub setLocalGroups {
my ( $self, $req ) = @_;
foreach ( sort keys %{ $self->_groups } ) {
if ( $self->_groups->{$_}->( $req->sessionInfo ) ) {
$req->{sessionInfo}->{groups} .=
$self->conf->{multiValuesSeparator} . $_;
$req->{sessionInfo}->{hGroups}->{$_}->{name} = $_;
}
}
# Clear values separator at the beginning
if ( $req->{sessionInfo}->{groups} ) {
$req->{sessionInfo}->{groups} =~
s/^\Q$self->conf->{multiValuesSeparator}\E//o;
}
PE_OK;
}
sub store {
my ( $self, $req ) = @_;
# Now, user is authenticated => inform handler
$req->userData( $req->sessionInfo );
# Create second session for unsecure cookie
if ( $self->conf->{securedCookie} == 2 ) {
my $session2 = $self->getApacheSession( undef, 1 );
my %infos = %{ $req->{sessionInfo} };
$infos{_httpSessionType} = 1;
$session2->update( \%infos );
$req->{sessionInfo}->{_httpSession} = $session2->id;
}
# Main session
my $session = $self->getApacheSession( $req->{id}, 0, $self->{force} );
return PE_APACHESESSIONERROR unless ($session);
$req->id( $session->{id} );
# Compute unsecure cookie value if needed
if ( $self->conf->{securedCookie} == 3 ) {
$req->{sessionInfo}->{_httpSession} =
$self->conf->{cipher}->encryptHex( $self->{id}, "http" );
}
# Fill session
my $infos = {};
foreach my $k ( keys %{ $req->{sessionInfo} } ) {
next unless defined $req->{sessionInfo}->{$k};
my $displayValue = $req->{sessionInfo}->{$k};
if ( $self->conf->{hiddenAttributes}
and $self->conf->{hiddenAttributes} =~ /\b$k\b/ )
{
$displayValue = '****';
}
$self->lmLog( "Store $displayValue in session key $k", 'debug' );
$self->_dump($displayValue) if ref($displayValue);
$infos->{$k} = $req->{sessionInfo}->{$k};
}
$session->update($infos);
PE_OK;
}
sub buildCookie {
my ( $self, $req ) = @_;
push @{ $req->respHeaders },
'Set-Cookie' => $self->cookie(
name => $self->conf->{cookieName},
value => $req->{id},
domain => $self->conf->{domain},
path => "/",
secure => $self->conf->{securedCookie},
HttpOnly => $self->conf->{httpOnly},
expires => $self->conf->{cookieExpiration},
);
if ( $self->conf->{securedCookie} >= 2 ) {
push @{ $req->respHeaders },
'Set-Cookie' => $self->cookie(
name => $self->conf->{cookieName} . "http",
value => $req->{sessionInfo}->{_httpSession},
domain => $self->conf->{domain},
path => "/",
secure => 0,
HttpOnly => $self->conf->{httpOnly},
expires => $self->conf->{cookieExpiration},
);
}
PE_OK;
}
sub cookie {
my ( $self, %h ) = @_;
my @res;
$res[0] = "$h{name}" or die("name required");
$res[0] .= "=$h{value}";
foreach (qw(domain path expires max_age)) {
my $f = $_;
$f =~ s/_/-/g;
push @res, "$f=$h{$_}" if ( $h{$_} );
}
return join( '; ', @res );
}
sub _dump {
my ( $self, $variable ) = @_;
require Data::Dumper;
$Data::Dumper::Indent = 0;
$self->lmLog( "Dump: " . Data::Dumper::Dumper($variable), 'debug' );
return;
}
1;