Simple.pm

##@file
# Base package for Lemonldap::NG portal

##@class Lemonldap::NG::Portal::Simple
# Base class for Lemonldap::NG portal
package Lemonldap::NG::Portal::Simple;

use strict;
use warnings;

use Exporter 'import';

use warnings;
use MIME::Base64;
use Lemonldap::NG::Common::CGI;
use CGI::Cookie;
require POSIX;
use Lemonldap::NG::Portal::_i18n;      #inherits
use Lemonldap::NG::Common::Safelib;    #link protected safe Safe object
use Lemonldap::NG::Common::Apache::Session
  ;    #link protected session Apache::Session object
use Safe;

# Special comments for doxygen
#inherits Lemonldap::NG::Portal::_SOAP
#inherits Lemonldap::NG::Portal::AuthApache
#inherits Lemonldap::NG::Portal::AuthDBI
#inherits Lemonldap::NG::Portal::AuthCAS
#inherits Lemonldap::NG::Portal::AuthLDAP
#inherits Lemonldap::NG::Portal::AuthRemote
#inherits Lemonldap::NG::Portal::AuthSSL
#inherits Lemonldap::NG::Portal::Menu
#link Lemonldap::NG::Portal::Notification protected notification
#inherits Lemonldap::NG::Portal::UserDBDBI
#inherits Lemonldap::NG::Portal::UserDBEnv
#inherits Lemonldap::NG::Portal::UserDBLDAP
#inherits Lemonldap::NG::Portal::UserDBRemote
#inherits Lemonldap::NG::Portal::PasswordDBDBI
#inherits Lemonldap::NG::Portal::PasswordDBLDAP
#inherits Apache::Session
#link Lemonldap::NG::Common::Apache::Session::SOAP protected globalStorage

our $VERSION = '0.91';

use base qw(Lemonldap::NG::Common::CGI Exporter);
our @ISA;

# Constants
use constant {

    # Portal errors
    # Developers warning, do not use PE_INFO, it's reserved to autoRedirect.
    # If you want to send an information, use $self->info('text').
    PE_INFO                             => -3,
    PE_REDIRECT                         => -2,
    PE_DONE                             => -1,
    PE_OK                               => 0,
    PE_SESSIONEXPIRED                   => 1,
    PE_FORMEMPTY                        => 2,
    PE_WRONGMANAGERACCOUNT              => 3,
    PE_USERNOTFOUND                     => 4,
    PE_BADCREDENTIALS                   => 5,
    PE_LDAPCONNECTFAILED                => 6,
    PE_LDAPERROR                        => 7,
    PE_APACHESESSIONERROR               => 8,
    PE_FIRSTACCESS                      => 9,
    PE_BADCERTIFICATE                   => 10,
    PE_PP_ACCOUNT_LOCKED                => 21,
    PE_PP_PASSWORD_EXPIRED              => 22,
    PE_CERTIFICATEREQUIRED              => 23,
    PE_ERROR                            => 24,
    PE_PP_CHANGE_AFTER_RESET            => 25,
    PE_PP_PASSWORD_MOD_NOT_ALLOWED      => 26,
    PE_PP_MUST_SUPPLY_OLD_PASSWORD      => 27,
    PE_PP_INSUFFICIENT_PASSWORD_QUALITY => 28,
    PE_PP_PASSWORD_TOO_SHORT            => 29,
    PE_PP_PASSWORD_TOO_YOUNG            => 30,
    PE_PP_PASSWORD_IN_HISTORY           => 31,
    PE_PP_GRACE                         => 32,
    PE_PP_EXP_WARNING                   => 33,
    PE_PASSWORD_MISMATCH                => 34,
    PE_PASSWORD_OK                      => 35,
    PE_NOTIFICATION                     => 36,
    PE_BADURL                           => 37,
    PE_NOSCHEME                         => 38,
    PE_BADOLDPASSWORD                   => 39,
    PE_MALFORMEDUSER                    => 40,
    PE_SESSIONNOTGRANTED                => 41,
    PE_CONFIRM                          => 42,
    PE_MAILFORMEMPTY                    => 43,
    PE_BADMAILTOKEN                     => 44,
    PE_MAILERROR                        => 45,
    PE_MAILOK                           => 46,
    PE_LOGOUT_OK                        => 47,

    # Portal messages
    PM_USER                  => 0,
    PM_DATE                  => 1,
    PM_IP                    => 2,
    PM_SESSIONS_DELETED      => 3,
    PM_OTHER_SESSIONS        => 4,
    PM_REMOVE_OTHER_SESSIONS => 5,
    PM_PP_GRACE              => 6,
    PM_PP_EXP_WARNING        => 7,
    PM_SAML_IDPSELECT        => 8,
    PM_SAML_IDPCHOOSEN       => 9,
    PM_REMEMBERCHOICE         => 10,
};

# EXPORTER PARAMETERS
our @EXPORT = qw( PE_INFO PE_REDIRECT PE_DONE PE_OK PE_SESSIONEXPIRED
  PE_FORMEMPTY PE_WRONGMANAGERACCOUNT PE_USERNOTFOUND PE_BADCREDENTIALS
  PE_LDAPCONNECTFAILED PE_LDAPERROR PE_APACHESESSIONERROR PE_FIRSTACCESS
  PE_BADCERTIFICATE PE_PP_ACCOUNT_LOCKED PE_PP_PASSWORD_EXPIRED
  PE_CERTIFICATEREQUIRED PE_ERROR PE_PP_CHANGE_AFTER_RESET
  PE_PP_PASSWORD_MOD_NOT_ALLOWED PE_PP_MUST_SUPPLY_OLD_PASSWORD
  PE_PP_INSUFFICIENT_PASSWORD_QUALITY PE_PP_PASSWORD_TOO_SHORT
  PE_PP_PASSWORD_TOO_YOUNG PE_PP_PASSWORD_IN_HISTORY PE_PP_GRACE
  PE_PP_EXP_WARNING PE_PASSWORD_MISMATCH PE_PASSWORD_OK PE_NOTIFICATION
  PE_BADURL PE_NOSCHEME PE_BADOLDPASSWORD PE_MALFORMEDUSER PE_SESSIONNOTGRANTED
  PE_CONFIRM PE_MAILFORMEMPTY PE_BADMAILTOKEN PE_MAILERROR PE_MAILOK
  PE_LOGOUT_OK
  PM_USER PM_DATE PM_IP PM_SESSIONS_DELETED PM_OTHER_SESSIONS
  PM_REMOVE_OTHER_SESSIONS PM_PP_GRACE PM_PP_EXP_WARNING
  PM_SAML_IDPSELECT PM_SAML_IDPCHOOSEN PM_REMEMBERCHOICE
);
our %EXPORT_TAGS = ( 'all' => [ @EXPORT, 'import' ], );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

# Secure jail
our $safe;
our $self;    # Safe cannot share a variable declared with my

##@cmethod Lemonldap::NG::Portal::Simple new(hashRef args)
# Class constructor.
#@param args hash reference
#@return Lemonldap::NG::Portal::Simple object
sub new {

    binmode( STDOUT, ":utf8" );
    my $class = shift;
    return $class if ( ref($class) );
    my $self = $class->SUPER::new();

    # Reinit _url
    $self->{_url} = '';

    # Get global configuration
    $self->getConf(@_)
      or $self->abort( "Configuration error",
        "Unable to get configuration: $Lemonldap::NG::Common::Conf::msg" );

    # Default values
    $self->setDefaultValues();

    # Test mandatory elements
    $self->abort( "Configuration error",
        "You've to indicate a an Apache::Session storage module !" )
      unless ( $self->{globalStorage} );
    eval "require " . $self->{globalStorage};
    $self->abort( "Configuration error",
        "Module " . $self->{globalStorage} . " not found in \@INC" )
      if ($@);
    $self->abort( "Configuration error",
        "You've to indicate a domain for cookies" )
      unless ( $self->{domain} );
    $self->{domain} =~ s/^([^\.])/.$1/;

    # Rules to allow redirection
    $self->{mustRedirect} = (
        ( $ENV{REQUEST_METHOD} eq 'POST' and not $self->param('newpassword') )
          or $self->param('logout')
    ) ? 1 : 0;

    # Push authentication/userDB/passwordDb/issuerDB modules in @ISA
    foreach (qw(authentication userDB passwordDB issuerDB)) {
        my $module_name = 'Lemonldap::NG::Portal::';
        my $db_type     = $_;
        my $db_name     = $self->{$db_type};

        # Adapt module type to real module name
        $db_type =~ s/authentication/Auth/;
        $db_type =~ s/userDB/UserDB/;
        $db_type =~ s/passwordDB/PasswordDB/;
        $db_type =~ s/issuerDB/IssuerDB/;

        # Full module name
        $module_name .= $db_type . $db_name;

        # Remove white spaces
        $module_name =~ s/\s.*$//;

        # Try to load module
        $self->abort( "Configuration error", "Unable to load $module_name" )
          unless $self->loadModule($module_name);

        # $self->{authentication} and $self->{userDB} can contains arguments
        # (key1 = scalar_value; key2 = ...)
        unless ( $db_name =~ /^Multi/ ) {
            $db_name =~ s/^\w+\s*//;
            my %h = split( /\s*[=;]\s*/, $db_name ) if ($db_name);
            %$self = ( %h, %$self );
        }
    }

    # Notifications
    if ( $self->{notification} ) {
        require Lemonldap::NG::Portal::Notification;
        my $tmp;
        if ( $self->{notificationStorage} ) {
            $tmp = $self->{notificationStorage};
        }
        else {
            (%$tmp) = ( %{ $self->{lmConf} } );
            $self->abort( "notificationStorage not defined",
                "This parameter is required to use notification system" )
              unless ( ref($tmp) );
            $tmp->{type} =~ s/.*:://;
            $tmp->{table} = 'notifications';
        }
        $tmp->{p}            = $self;
        $self->{notifObject} = Lemonldap::NG::Portal::Notification->new($tmp);
        $self->abort($Lemonldap::NG::Portal::Notification::msg)
          unless ( $self->{notifObject} );
    }

    # SOAP
    if ( $self->{Soap} or $self->{soap} ) {
        require Lemonldap::NG::Portal::_SOAP;
        push @ISA, 'Lemonldap::NG::Portal::_SOAP';
        if ( $self->{notification} ) {
            $self->{CustomSOAPServices}->{'/notification'} = 'newNotification';
        }
        $self->startSoapServices();
    }

    # Trusted domains
    unless ( defined( $self->{trustedDomains} ) ) {
        $self->{trustedDomains} = $self->{domain};
    }
    if ( $self->{trustedDomains} eq '*' ) {
        $self->{trustedDomains} = '|\w[\w\-\.]*\w';
    }
    elsif ( $self->{trustedDomains} ) {
        $self->{trustedDomains} = '|(?:[^/]*)?(?:'
          . join( '|',
            ( map { s/\./\\\./g; $_ } split /\s+/, $self->{trustedDomains} ) )
          . ')';
    }

    return $self;
}

##@method boolean loadModule(string module)
# Load a module into portal namespace
# @param module module name
# @return boolean
sub loadModule {
    my $self   = shift;
    my $module = shift;

    return 1 unless $module;

    # Load module test
    eval "require $module";
    if ($@) {
        $self->lmLog( "$module load error: $@", 'error' );
        return 0;
    }

    # Push module in @ISA
    push @ISA, $module;
    return 1;
}

##@method protected boolean getConf(hashRef args)
# Copy all parameters in caller object.
#@param args hash-ref
#@return True
sub getConf {
    my ($self) = shift;
    my %args;
    if ( ref( $_[0] ) ) {
        %args = %{ $_[0] };
    }
    else {
        %args = @_;
    }
    %$self = ( %$self, %args );
    1;
}

##@method protected void setDefaultValues()
# Set default values.
sub setDefaultValues {
    my $self = shift;
    $self->{portal} ||=
      "http" . ( $ENV{HTTPS} ? 's' : '' ) . '://' . $self->server_name();
    $self->{whatToTrace} ||= 'uid';
    $self->{whatToTrace} =~ s/^\$//;
    $self->{httpOnly} = 1 unless ( defined( $self->{httpOnly} ) );
    $self->{portalSkin} ||= 'pastel';
    $self->{portalDisplayLogout} = 1
      unless ( defined( $self->{portalDisplayLogout} ) );
    $self->{portalDisplayResetPassword} = 1
      unless ( defined( $self->{portalDisplayResetPassword} ) );
    $self->{portalDisplayChangePassword} = 1
      unless ( defined( $self->{portalDisplayChangePassword} ) );
    $self->{portalDisplayAppslist} = 1
      unless ( defined( $self->{portalDisplayAppslist} ) );
    $self->{portalAutocomplete} ||= "off";
    $self->{portalRequireOldPassword} = 1
      unless ( defined( $self->{portalRequireOldPassword} ) );
    $self->{portalOpenLinkInNewWindow} = 0
      unless ( defined( $self->{portalOpenLinkInNewWindow} ) );
    $self->{portalForceAuthn} = 0
      unless ( defined( $self->{portalForceAuthn} ) );
    $self->{portalForceAuthnInterval} = 5
      unless ( defined( $self->{portalForceAuthnInterval} ) );
    $self->{portalUserAttr} ||= "_user";
    $self->{securedCookie}  ||= 0;
    $self->{cookieName}     ||= "lemonldap";
    $self->{authentication} ||= 'LDAP';
    $self->{authentication} =~ s/^ldap/LDAP/;
    $self->{SMTPServer}     ||= 'localhost';
    $self->{mailLDAPFilter} ||= '(&(mail=$mail)(objectClass=inetOrgPerson))';
    $self->{randomPasswordRegexp} ||= '[A-Z]{3}[a-z]{5}.\d{2}';
    $self->{mailFrom}             ||= "noreply@" . $self->{domain};
    $self->{mailSubject}          ||= "[LemonLDAP::NG] Your new password";
    $self->{mailConfirmSubject} ||=
      "[LemonLDAP::NG] Password reset confirmation";
    $self->{mailSessionKey} ||= 'mail';
    $self->{mailUrl}        ||= $self->{portal} . "/mail.pl";
    $self->{issuerDB}             ||= 'Null';

    # Set default userDB and passwordDB to DBI if authentication is DBI
    if ( $self->{authentication} =~ /DBI/i ) {
        $self->{userDB}     ||= "DBI";
        $self->{passwordDB} ||= "DBI";
    }

    # Set default userDB and passwordDB to Null if authentication is Null
    if ( $self->{authentication} =~ /Null/i ) {
        $self->{userDB}     ||= "Null";
        $self->{passwordDB} ||= "Null";
    }
    else {

        # Default to LDAP
        $self->{userDB}     ||= "LDAP";
        $self->{passwordDB} ||= "LDAP";
    }

    # LDAP
    $self->{ldapGroupObjectClass}         ||= "groupOfNames";
    $self->{ldapGroupAttributeName}       ||= "member";
    $self->{ldapGroupAttributeNameUser}   ||= "dn";
    $self->{ldapGroupAttributeNameGroup}  ||= "dn";
    $self->{ldapGroupAttributeNameSearch} ||= ["cn"];
    $self->{ldapGroupRecursive}           ||= 0;

    # SAML
    $self->{samlIdPResolveCookie} ||= "lemonldapidp";
}

=begin WSDL

_IN lang $string Language
_IN code $int Error code
_RETURN $string Error string

=end WSDL

=cut

##@method string error(string lang)
# error calls Portal/_i18n.pm to display error in the wanted language.
#@param $lang optional (browser language is used instead)
#@return error message
sub error {
    my $self = shift;
    my $lang = shift || $ENV{HTTP_ACCEPT_LANGUAGE};
    my $code = shift || $self->{error};
    my $tmp  = &Lemonldap::NG::Portal::_i18n::error( $code, $lang );
    return (
        $ENV{HTTP_SOAPACTION}
        ? SOAP::Data->name( result => $tmp )->type('string')
        : $tmp
    );
}

##@method string error_type(int code)
# error_type tells if error is positive, warning or negative
# @param $code Lemonldap::NG error code
# @return "positive", "warning" or "negative"
sub error_type {
    my $self = shift;
    my $code = shift || $self->{error};

    # Positive errors
    return "positive"
      if (
        scalar(
            grep { /^$code$/ } (
                PE_REDIRECT, PE_DONE, PE_OK, PE_PASSWORD_OK,
                PE_MAILOK,   PE_LOGOUT_OK,
            )
        )
      );

    # Warning errors
    return "warning"
      if (
        scalar(
            grep { /^$code$/ } (
                PE_INFO,         PE_SESSIONEXPIRED,
                PE_FORMEMPTY,    PE_FIRSTACCESS,
                PE_PP_GRACE,     PE_PP_EXP_WARNING,
                PE_NOTIFICATION, PE_BADURL,
                PE_CONFIRM,      PE_MAILFORMEMPTY,
            )
        )
      );

    # Negative errors (default)
    return "negative";
}

##@method void header()
# Overload CGI::header() to add Lemonldap::NG cookie.
sub header {
    my $self = shift;
    if ( $self->{cookie} ) {
        $self->SUPER::header( @_, -cookie => $self->{cookie} );
    }
    else {
        $self->SUPER::header(@_);
    }
}

##@method void redirect()
# Overload CGI::redirect() to add Lemonldap::NG cookie.
sub redirect {
    my $self = shift;
    if ( $self->{cookie} ) {
        $self->SUPER::redirect( @_, -cookie => $self->{cookie} );
    }
    else {
        $self->SUPER::redirect(@_);
    }
}

## @method protected hashref getApacheSession(string id)
# Try to recover the session corresponding to id and return session datas.
# If $id is set to undef, return a new session.
# @param $id session reference
sub getApacheSession {
    my ( $self, $id, $noInfo ) = @_;
    my %h;

    # Trying to recover session from global session storage
    eval { tie %h, $self->{globalStorage}, $id, $self->{globalStorageOptions}; };
    if ( $@ or not tied(%h) ) {

        # Session not available (expired ?)
        if ($id) {
            $self->lmLog( "Session $id isn't yet available ($ENV{REMOTE_ADDR})",
                'info' );
        }
        else {
            $self->lmLog( "Unable to create new session: $@", 'error' );
        }
        return 0;
    }
    $self->setApacheUser( $h{ $self->{whatToTrace} } )
      if ( $id and not $noInfo );
    $self->{id} = $h{_session_id};
    return \%h;
}

##@method void updateSession(hashRef infos)
# Update session stored.
# If lemonldap cookie exists, reads it and search session. If the session is
# available, update datas with $info.
#@param $infos hash
sub updateSession {

    # TODO: update all caches
    my $self    = shift;
    my ($infos) = @_;
    my %cookies = fetch CGI::Cookie;

    # Test if Lemonldap::NG cookie is available
    if ( $cookies{ $self->{cookieName} }
        and my $id = $cookies{ $self->{cookieName} }->value )
    {
        my $h = $self->getApacheSession($id) or return undef;

        # Store/update session values
        foreach ( keys %$infos ) {
            $h->{$_} = $infos->{$_};
        }

        # Store updateTime
        $h->{updateTime} = &POSIX::strftime( "%Y%m%d%H%M%S", localtime() );

        untie %$h;
    }

}

##@method protected int _subProcess(array @subs)
# Execute methods until an error is returned.
# If $self->{$sub} exists, launch it, else launch $self->$sub
#@param @subs array list of subroutines
#@return Lemonldap::NG::Portal error
sub _subProcess {
    my $self = shift;
    my @subs = @_;
    my $err  = undef;

    foreach my $sub (@subs) {
        last if ( $err = $self->_sub($sub) );
    }
    return $err;
}

##@method protected void updateStatus()
# Inform status mechanism module.
# If an handler is launched on the same server with "status=>1", inform the
# status module with the result (portal error).
sub updateStatus {
    my $self = shift;
    print $Lemonldap::NG::Handler::Simple::statusPipe (
        $self->{user} ? $self->{user} : $ENV{REMOTE_ADDR} )
      . " => $ENV{SERVER_NAME}$ENV{SCRIPT_NAME} "
      . $self->{error} . "\n"
      if ($Lemonldap::NG::Handler::Simple::statusPipe);
}

##@method protected string notification()
#@return Notification stored by checkNotification()
sub notification {
    my $self = shift;
    return $self->{_notification};
}

##@method protected string get_url()
# Return url parameter
# @return url parameter if good, nothing else.
sub get_url {
    my $self = shift;
    return $self->{_url};
}

##@method protected string get_user()
# Return user parameter
# @return user parameter if good, nothing else.
sub get_user {
    my $self = shift;
    return "" unless $self->{user};
    return $self->{user}
      unless ( $self->{user} =~ m/(?:\0|<|'|"|`|\%(?:00|25|3C|22|27|2C))/ );
    $self->lmLog(
        "XSS attack detected (param: user | value: " . $self->{user} . ")",
        "warn" );
    return "";
}

##@method private Safe safe()
# Provide the security jail.
#@return Safe object
sub safe {
    my $self = shift;
    return $safe if ($safe);
    $safe = new Safe;
    my @t =
      $self->{customFunctions} ? split( /\s+/, $self->{customFunctions} ) : ();
    foreach (@t) {
        my $sub = $_;
        unless (/::/) {
            $sub = ref($self) . "::$_";
        }
        else {
            s/^.*:://;
        }
        next if ( $self->can($_) );
        eval "sub $_ {
                return $sub( '$self->{portal}', \@_ );
            }";
        $self->lmLog( $@, 'error' ) if ($@);
    }
    $safe->share_from( 'main', ['%ENV'] );
    $safe->share_from( 'Lemonldap::NG::Common::Safelib',
        $Lemonldap::NG::Common::Safelib::functions );
    $safe->share( '&encode_base64', @t );
    return $safe;
}

##@method private boolean _deleteSession(Apache::Session* h, boolean preserveCookie)
# 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, $h, $preserveCookie ) = @_;
    my $result = 1;

    # Try to find a linked http session (securedCookie=>2)
    if ( my $id2 = $h->{_httpSession} ) {
        if ( my $h2 = $self->getApacheSession($id2) ) {

            # Try to purge local cache
            # (if an handler is running on the same server)
            eval { $self->{lmConf}->{refLocalStorage}->remove($id2); };
            eval { tied(%$h2)->delete() };
            $self->lmLog( $@, 'error' ) if ($@);

            # Create an obsolete cookie to remove it
            push @{ $self->{cookie} },
              $self->cookie(
                -name    => $self->{cookieName} . 'http',
                -value   => 0,
                -domain  => $self->{domain},
                -path    => "/",
                -secure  => 0,
                -expires => '-1d',
                @_,
              );
        }
    }

    my $logged_user = $h->{ $self->{whatToTrace} };

    # Try to purge local cache
    # (if an handler is running on the same server)
    eval { $self->{lmConf}->{refLocalStorage}->remove( $h->{_session_id} ); };
    eval { tied(%$h)->delete() };
    if ($@) {
        $self->lmLog( $@, 'error' );
        $result = 0;
    }

    # Create an obsolete cookie to remove it
    push @{ $self->{cookie} },
      $self->cookie(
        -name    => $self->{cookieName},
        -value   => 0,
        -domain  => $self->{domain},
        -path    => "/",
        -secure  => 0,
        -expires => '-1d',
        @_,
      ) unless ($preserveCookie);

    # Log
    $self->_sub( 'userNotice', "User $logged_user has been disconnected" );

    # Return the result of tied(%$h)->delete()
    return $result;
}

##@method private void _dump( variable )
# Dump variable in debug mode
# @param $variable
# @return void
sub _dump {
	my $self = shift;
	my $variable = shift;

	use Data::Dumper;
    $self->lmLog( "Dump: " . Dumper($variable), 'debug' );

	return;
}

##@method protected string info(string t)
# Get or set info to display to the user.
# @param $t optional text to store
# @return HTML text to display
sub info {
    my ( $self, $t ) = @_;
    $self->{_info} .= $t if ( defined $t );
    return $self->{_info};
}

###############################################################
# MAIN subroutine: call all steps until one returns something #
#                  different than PE_OK                       #
###############################################################

##@method boolean process()
# Main method calling functions issued from:
#  - itself:
#    - controlUrlOrigin
#    - checkNotifBack
#    - controlExistingSession
#    - setMacros
#    - setLocalGroups
#    - removeOther
#    - grantSession
#    - store
#    - buildCookie
#    - checkNotification
#    - autoRedirect
#    - updateStatus
#  - authentication module:
#    - authInit
#    - extractFormInfo
#    - setAuthSessionInfo
#    - authenticate
#  - userDB module:
#    - userDBInit
#    - getUser
#    - setSessionInfo
#    - setGroups
#  - passwordDB module:
#    - passwordDBInit
#    - modifyPassword
#  - issuerDB module:
#    - issuerDBInit
#    - issuerForUnAuthUser
#    - issuerForAuthUser
#
#@return 1 if all is OK, 0 if session isn't created or a notification has to be done
sub process {
    my ($self) = @_;
    $self->{error} = PE_OK;
    $self->{error} = $self->_subProcess(
        qw(controlUrlOrigin checkNotifBack controlExistingSession issuerDBInit
          issuerForUnAuthUser authInit extractFormInfo userDBInit getUser
          setAuthSessionInfo passwordDBInit modifyPassword setSessionInfo
          setMacros setLocalGroups setGroups authenticate removeOther
          grantSession store buildCookie checkNotification issuerForAuthUser
          autoRedirect)
    );
    $self->updateStatus;
    return ( ( $self->{error} > 0 ) ? 0 : 1 );
}

##@apmethod int controlUrlOrigin()
# If the user was redirected here, loads 'url' parameter.
#@return Lemonldap::NG::Portal constant
sub controlUrlOrigin {
    my $self = shift;
    $self->{_url} ||= '';
    if ( my $url = $self->param('url') ) {

        # REJECT NON BASE64 URL
        if ( $url =~ m#[^A-Za-z0-9\+/=]# ) {
            $self->lmLog( "XSS attack detected (param: url | value: $url)",
                "warn" );
            return PE_BADURL;
        }

        $self->{urldc} = decode_base64($url);
        $self->{urldc} =~ s/[\r\n]//sg;

        # REJECT [\0<'"`] in URL or encoded '%' and non protected hosts
        if (
            $self->{urldc} =~ /(?:\0|<|'|"|`|\%(?:00|25|3C|22|27|2C))/
            or ( $self->{urldc} !~
m#^https?://(?:$self->{reVHosts}$self->{trustedDomains})(?::\d+)?(?:/.*)?$#o
                and not $self->param('logout') )
          )
        {
            $self->lmLog(
                "XSS attack detected (param: urldc | value: "
                  . $self->{urldc} . ")",
                "warn"
            );
            delete $self->{urldc};
            return PE_BADURL;
        }
        $self->{_url} = $url;
    }
    PE_OK;
}

##@apmethod int checkNotifBack()
# Checks if a message has been notified to the connected user.
# Call Lemonldap::NG::Portal::Notification::checkNotification()
#@return Lemonldap::NG::Portal error code
sub checkNotifBack {
    my $self = shift;
    if ( $self->{notification} and grep( /^reference/, $self->param() ) ) {
        unless ( $self->{notifObject}->checkNotification($self) ) {
            $self->{_notification} =
              $self->{notifObject}->getNotification($self);
            return PE_NOTIFICATION;
        }
        else {
            $self->{error} = $self->_subProcess(
                qw(checkNotification issuerDBInit issuerForAuthUser autoRedirect)
            );
            return $self->{error} || PE_DONE;
        }
    }
    PE_OK;
}

##@apmethod int controlExistingSession(string id)
# Control existing sessions.
# To overload to control what to do with existing sessions.
# what to do with existing sessions ?
#       - nothing: user is authenticated and process returns true (default)
#       - delete and create a new session (not implemented)
#       - re-authentication (set portalForceAuthn to 1)
#@param $id optional value of the session-id else cookies are examinated.
#@return Lemonldap::NG::Portal constant
sub controlExistingSession {
    my ( $self, $id ) = @_;
    my %cookies;
    %cookies = fetch CGI::Cookie unless ($id);

    # Test if Lemonldap::NG cookie is available
    if (
        $id
        or (    $cookies{ $self->{cookieName} }
            and $id = $cookies{ $self->{cookieName} }->value )
      )
    {
        my $h = $self->getApacheSession($id) or return PE_OK;
        %{ $self->{sessionInfo} } = %$h;

        # Logout if required
        if ( $self->param('logout') ) {

            # Delete session in global storage
            unless ( $self->_deleteSession($h) ) {
                $self->lmLog( "Unable to delete session $id", 'error' );
                return PE_ERROR;
            }

            # Call issuerDB logout
            eval { $self->_sub('issuerLogout'); };
            if ($@) {
                $self->lmLog( "Error when calling issuerLogout: $@", 'debug' );
            }

            # Call authentication logout
            eval { $self->_sub('authLogout'); };
            if ($@) {
                $self->lmLog( "Error when calling authLogout: $@", 'debug' );
            }

            # Display logout message
            return PE_LOGOUT_OK;
        }

        # If the user wants to purge other sessions
        elsif ( $self->param('removeOther') ) {
            $self->{notifyDeleted} = 1;
            $self->{singleSession} = 1;
            $self->_sub( 'removeOther', $id );
        }
        untie %$h;
        $self->{id} = $id;

        # A session has been find => calling &existingSession
        my $r = $self->_sub( 'existingSession', $id, $self->{sessionInfo} );
        if ( $r == PE_DONE ) {
            $self->{error} = $self->_subProcess(
                qw(checkNotification issuerDBInit issuerForAuthUser autoRedirect)
            );
            return $self->{error} || PE_DONE;
        }
        else {
            return $r;
        }
    }
    PE_OK;
}

## @method int existingSession()
# Launched by controlExistingSession() to know what to do with existing
# sessions.
# Can return:
# - PE_DONE: session is unchanged and process() return true
# - PE_OK: process() return false to display the form
#@return Lemonldap::NG::Portal constant
sub existingSession {
    my $self = shift;

    # Check portalForceAuthn parameter
    if ( $self->{portalForceAuthn} ) {
        my $referer = $self->referer();
        my $id      = $self->{id};

        # Do not force authentication when password is modified
        return PE_DONE if $self->param('newpassword');

       # Do not force authentication if last successful authentication is recent
        my $last_authn_utime = $self->{sessionInfo}->{_lastAuthnUTime} || 0;
        if ( time() - $last_authn_utime < $self->{portalForceAuthnInterval} ) {
            $self->lmLog(
"Authentication is recent, so do not force authentication for session $id",
                'debug'
            );
            return PE_DONE;
        }

     # If coming from the portal follow the normal process to update the session
        if ( $referer ? ( $referer =~ m#$self->{portal}#i ) : 0 ) {
            $self->lmLog( "Portal referer detected for session $id", 'debug' );

            # Set flag to update session timestamp
            $self->{updateSession} = 1;

            # Process
            $self->{error} = $self->_subProcess(
                qw(issuerDBInit issuerForUnAuthUser authInit extractFormInfo
                  userDBInit getUser setAuthSessionInfo setSessionInfo
                  setMacros setLocalGroups setGroups authenticate
                  store)
            );
            return $self->{error} || PE_DONE;
        }
        else {
            $self->lmLog( "Force reauthentication for session $id", 'debug' );
            return PE_OK;
        }
    }

    # Else return PE_DONE
    PE_DONE;
}

## @apmethod int issuerDBInit()
# Set _issuerDB
# call issuerDBInit in issuerDB* module
# @return Lemonldap::NG::Portal constant
sub issuerDBInit {
    my $self = shift;
    my $issuerDB;

    # Get the current issuer module
        $issuerDB = $self->{issuerDB};

    $self->{sessionInfo}->{_issuerDB} = $issuerDB;

    return $self->SUPER::issuerDBInit();
}

# issuerForUnAuthUser(): must be implemented in IssuerDB* module

# authInit(): must be implemented in Auth* module

# extractFormInfo(): must be implemented in Auth* module
# * set $self->{user}
# * authenticate user if possible (or do it in authenticate())

# getUser(): must be implemented in UserDB* module

## @apmethod int setAuthSessionInfo()
# Set _auth
# call setAuthSessionInfo in Auth* module
#@return Lemonldap::NG::Portal constant
sub setAuthSessionInfo {
    my $self = shift;
    my $auth;

    # Get the current authentication module
    if ( defined $self->{_multi}->{stack}->[0] ) {
        $auth = $self->{_multi}->{stack}->[0]->[0]->{n};
    }
    else {
        $auth = $self->{authentication};
    }

    $self->{sessionInfo}->{_auth} = $auth;

    return $self->SUPER::setAuthSessionInfo();
}

## @apmethod int passwordDBInit()
# Set _passwordDB
# call passwordDBInit in passwordDB* module
# @return Lemonldap::NG::Portal constant
sub passwordDBInit {
    my $self = shift;
    my $passwordDB;

    # Get the current password module
        $passwordDB = $self->{passwordDB};

    $self->{sessionInfo}->{_passwordDB} = $passwordDB;

    return $self->SUPER::passwordDBInit();
}

# modifyPassword(): must be implemented in PasswordDB* module

##@apmethod int setSessionInfo()
# Set ipAddr, xForwardedForAddr, startTime, updateTime, _utime and _userDB
# Call setSessionInfo() in UserDB* module
#@return Lemonldap::NG::Portal constant
sub setSessionInfo {
    my $self = shift;
    my $userDB;

    # Get the current user module
    if ( defined $self->{_multi}->{stack}->[1] ) {
        $userDB = $self->{_multi}->{stack}->[1]->[0]->{n};
    }
    else {
        $userDB = $self->{userDB};
    }

    $self->{sessionInfo}->{_userDB} = $userDB;

    # Store IP address
    $self->{sessionInfo}->{ipAddr} = $ENV{REMOTE_ADDR};
    $self->lmLog(
        "Store ipAddr: " . $self->{sessionInfo}->{ipAddr} . " in session",
        'debug' );

    # Extract and store client IP from X-FORWARDED-FOR header
    my $xheader = $ENV{HTTP_X_FORWARDED_FOR};
    $xheader =~ s/(.*?)(\,)+.*/$1/ if $xheader;
    $self->{sessionInfo}->{xForwardedForAddr} = $xheader || $ENV{REMOTE_ADDR};
    $self->lmLog(
        "Store xForwardedForAddr: "
          . $self->{sessionInfo}->{xForwardedForAddr}
          . " in session",
        'debug'
    );

    if ( $self->{updateSession} ) {
        $self->{sessionInfo}->{updateTime} =
          &POSIX::strftime( "%Y%m%d%H%M%S", localtime() );
        $self->lmLog(
            "Store updateTime: "
              . $self->{sessionInfo}->{updateTime}
              . " in session",
            'debug'
        );
    }
    else {
    $self->{sessionInfo}->{_utime} = time();
    $self->{sessionInfo}->{startTime} =
      &POSIX::strftime( "%Y%m%d%H%M%S", localtime() );
    $self->lmLog(
            "Store startTime: "
              . $self->{sessionInfo}->{startTime}
              . " in session",
        'debug'
    );