The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
## @file
# SAML Service Provider - Authentication

## @class
# SAML Service Provider - Authentication
package Lemonldap::NG::Portal::AuthSAML;

use strict;
use MIME::Base64;
use Lemonldap::NG::Portal::Simple;
use Lemonldap::NG::Portal::_SAML;    #inherits
use Lemonldap::NG::Common::Conf::SAML::Metadata;

our $VERSION = '1.0.0';
our @ISA     = qw(Lemonldap::NG::Portal::_SAML);

## @apmethod int authInit()
# Load Lasso and metadata
# @return Lemonldap::NG::Portal error code
sub authInit {
    my $self = shift;

    # Load SAML service
    return PE_SAML_LOAD_SERVICE_ERROR unless $self->loadService();

    # Load SAML identity providers
    return PE_SAML_LOAD_IDP_ERROR unless $self->loadIDPs();

    PE_OK;
}

## @apmethod int extractFormInfo()
# Check authentication statement or create authentication request
# @return Lemonldap::NG::Portal error code
sub extractFormInfo {
    my $self   = shift;
    my $server = $self->{_lassoServer};

    # 1. Get HTTP request informations to know
    # if we are receving SAML request or response
    my $url            = $self->url();
    my $request_method = $self->request_method();
    my $content_type   = $self->content_type();

    my $saml_acs_art_url = $self->getMetaDataURL(
        "samlSPSSODescriptorAssertionConsumerServiceHTTPArtifact");
    my $saml_acs_post_url = $self->getMetaDataURL(
        "samlSPSSODescriptorAssertionConsumerServiceHTTPPost");
    my $saml_acs_get_url = $self->getMetaDataURL(
        "samlSPSSODescriptorAssertionConsumerServiceHTTPRedirect");
    my $saml_slo_soap_url =
      $self->getMetaDataURL( "samlSPSSODescriptorSingleLogoutServiceSOAP", 1 );
    my $saml_slo_soap_url_ret =
      $self->getMetaDataURL( "samlSPSSODescriptorSingleLogoutServiceSOAP", 2 );
    my $saml_slo_get_url = $self->getMetaDataURL(
        "samlSPSSODescriptorSingleLogoutServiceHTTPRedirect", 1 );
    my $saml_slo_get_url_ret = $self->getMetaDataURL(
        "samlSPSSODescriptorSingleLogoutServiceHTTPRedirect", 2 );
    my $saml_slo_post_url =
      $self->getMetaDataURL( "samlSPSSODescriptorSingleLogoutServiceHTTPPost",
        1 );
    my $saml_slo_post_url_ret =
      $self->getMetaDataURL( "samlSPSSODescriptorSingleLogoutServiceHTTPPost",
        2 );
    my $saml_ars_url = $self->getMetaDataURL(
        "samlSPSSODescriptorArtifactResolutionServiceArtifact");

    # 1.1 SSO assertion consumer
    if ( $url =~
/^(\Q$saml_acs_art_url\E|\Q$saml_acs_post_url\E|\Q$saml_acs_get_url\E)$/io
      )
    {
        $self->lmLog( "URL $url detected as an SSO assertion consumer URL",
            'debug' );

        # Check SAML Message
        my ( $request, $response, $method, $relaystate, $artifact ) =
          $self->checkMessage( $url, $request_method, $content_type, "login" );

        # Create Login object
        my $login = $self->createLogin($server);

        # Ignore signature verification
        $self->disableSignatureVerification($login);

        if ($response) {

            # Process authentication response
            my $result;
            if ($artifact) {
                $result = $self->processArtResponseMsg( $login, $response );
            }
            else {
                $result = $self->processAuthnResponseMsg( $login, $response );
            }

            unless ($result) {
                $self->lmLog( "SSO: Fail to process authentication response",
                    'error' );
                return PE_SAML_SSO_ERROR;
            }

            $self->lmLog( "SSO: authentication response is valid", 'debug' );

            # Get IDP entityID
            my $idp = $login->remote_providerID();

            $self->lmLog( "Found entityID $idp in SAML message", 'debug' );

            # IDP conf key
            my $idpConfKey = $self->{_idpList}->{$idp}->{confKey};

            unless ($idpConfKey) {
                $self->lmLog( "$idp do not match any IDP in configuration",
                    'error' );
                return PE_SAML_UNKNOWN_ENTITY;
            }

            $self->lmLog( "$idp match $idpConfKey IDP in configuration",
                'debug' );

            # Do we check signature?
            my $checkSSOMessageSignature =
              $self->{samlIDPMetaDataOptions}->{$idpConfKey}
              ->{samlIDPMetaDataOptionsCheckSSOMessageSignature};

            if ($checkSSOMessageSignature) {
                unless ( $self->checkSignatureStatus($login) ) {
                    $self->lmLog( "Signature is not valid", 'error' );
                    return PE_SAML_SIGNATURE_ERROR;
                }
                else {
                    $self->lmLog( "Signature is valid", 'debug' );
                }
            }
            else {
                $self->lmLog( "Message signature will not be checked",
                    'debug' );
            }

            # Get SAML response
            my $saml_response = $login->response();
            unless ($saml_response) {
                $self->lmLog( "No SAML response found", 'error' );
                return PE_SAML_SSO_ERROR;
            }

            # Check Destination
            return PE_SAML_DESTINATION_ERROR
              unless ( $self->checkDestination( $saml_response, $url ) );

            # Replay protection if this is a response to a created authn request
            my $assertion_responded = $saml_response->InResponseTo;
            if ($assertion_responded) {
                unless ( $self->replayProtection($assertion_responded) ) {

                    # Assertion was already consumed or is expired
                    # Force authentication replay
                    $self->lmLog(
"Message $assertion_responded already used or expired, replay authentication",
                        'error'
                    );
                    delete $self->{urldc};
                    $self->{mustRedirect} = 1;
                    $self->{error} = $self->_subProcess(qw(autoRedirect));
                    return $self->{error};
                }
            }
            else {
                $self->lmLog(
"Assertion is not a response to a created authentication request, do not control replay",
                    'debug'
                );
            }

            # Get SAML assertion
            my $assertion = $self->getAssertion($login);

            unless ($assertion) {
                $self->lmLog( "No assertion found", 'error' );
                return PE_SAML_SSO_ERROR;
            }

            # Do we check conditions?
            my $checkConditions =
              $self->{samlIDPMetaDataOptions}->{$idpConfKey}
              ->{samlIDPMetaDataOptionsCheckConditions};

            # Check conditions - time and audience
            if (
                $checkConditions
                and !$self->validateConditions(
                    $assertion, $self->getMetaDataURL( "samlEntityID", 0 )
                )
              )
            {
                $self->lmLog( "Conditions not validated", 'error' );
                return PE_SAML_CONDITIONS_ERROR;
            }

            #  Extract RelayState information
            if ( $self->extractRelayState($relaystate) ) {
                $self->lmLog( "RelayState $relaystate extracted", 'debug' );
            }

            # Check if we accept direct login from IDP
            my $allowLoginFromIDP =
              $self->{samlIDPMetaDataOptions}->{$idpConfKey}
              ->{samlIDPMetaDataOptionsAllowLoginFromIDP};
            if ( !$assertion_responded and !$allowLoginFromIDP ) {
                $self->lmLog(
                    "Direct login from IDP $idpConfKey is not allowed",
                    'error' );
                return PE_SAML_IDPSSOINITIATED_NOTALLOWED;
            }

            # Check authentication context
            my $responseAuthnContext;
            eval {
                $responseAuthnContext =
                  $assertion->AuthnStatement()->AuthnContext()
                  ->AuthnContextClassRef();
            };
            if ($@) {
                $self->lmLog(
                    "Unable to get authentication context from $idpConfKey",
                    'debug' );
                $responseAuthnContext = $self->getAuthnContext("unspecified");
            }
            else {
                $self->lmLog(
                    "Found authentication context: $responseAuthnContext",
                    'debug' );
            }

            # Map authentication context to authentication level
            $self->{sessionInfo}->{authenticationLevel} =
              $self->authnContext2authnLevel($responseAuthnContext);

            # Force redirection to portal if no urldc found
            # (avoid displaying the whole SAML URL in user browser URL field)
            $self->{mustRedirect} = 1 unless ( $self->{urldc} );

            # Get SessionIndex
            my $session_index;

            eval {
                $session_index = $assertion->AuthnStatement()->SessionIndex();
            };
            if ( $@ or !defined($session_index) ) {
                $self->lmLog( "No SessionIndex found", 'debug' );
            }
            else {
                $self->lmLog( "Found SessionIndex $session_index", 'debug' );
            }

            # Get NameID
            my $nameid = $login->nameIdentifier;

            # Set user
            my $user = $nameid->content;

            unless ($user) {
                $self->lmLog( "No NameID value found", 'error' );
                return PE_SAML_SSO_ERROR;
            }

            $self->lmLog( "Found NameID: $user", 'debug' );
            $self->{user} = $user;

            # Store Lasso objects
            $self->{_lassoLogin}   = $login;
            $self->{_idp}          = $idp;
            $self->{_idpConfKey}   = $idpConfKey;
            $self->{_nameID}       = $nameid;
            $self->{_sessionIndex} = $session_index;

            # Store Token
            my $saml_token = $assertion->export_to_xml;

            $self->lmLog( "SAML Token: $saml_token", 'debug' );

            $self->{_samlToken} = $saml_token;

            # Restore initial SAML request in case of proxying
            my $saml_sessions =
              $self->{samlStorage}->searchOn( $self->{samlStorageOptions},
                "ProxyID", $assertion_responded );

            if ( my @saml_sessions_keys = keys %$saml_sessions ) {

                # Warning if more than one session found
                if ( $#saml_sessions_keys > 0 ) {
                    $self->lmLog(
"More than one SAML proxy session found for ID $assertion_responded",
                        'warn'
                    );
                }

                # Take the first session
                my $saml_session = shift @saml_sessions_keys;

                # Get session
                $self->lmLog(
"Retrieve SAML proxy session $saml_session for ID $assertion_responded",
                    'debug'
                );

                my $samlSessionInfo = $self->getSamlSession($saml_session);

                $self->{_proxiedRequest}    = $samlSessionInfo->{Request};
                $self->{_proxiedMethod}     = $samlSessionInfo->{Method};
                $self->{_proxiedRelayState} = $samlSessionInfo->{RelayState};
                $self->{_proxiedArtifact}   = $samlSessionInfo->{Artifact};

               # Save values in hidden fields in case of other user interactions
                $self->setHiddenFormValue( 'SAMLRequest',
                    $self->{_proxiedRequest} );
                $self->setHiddenFormValue( 'Method', $self->{_proxiedMethod} );
                $self->setHiddenFormValue( 'RelayState',
                    $self->{_proxiedRelayState} );
                $self->setHiddenFormValue( 'SAMLart',
                    $self->{_proxiedArtifact} );

                # Delete session
                eval { tied(%$samlSessionInfo)->delete(); };
            }

            return PE_OK;
        }
        elsif ($request) {

            # Do nothing
            $self->lmLog(
                "This module do not manage SSO request, see IssuerDBSAML",
                'debug' );

            return PE_OK;
        }
        else {

            # This should not happen
            $self->lmLog( "SSO request or response was not found", 'error' );

            # Redirect user
            $self->{mustRedirect} = 1;
            $self->{error}        = $self->_subProcess(qw(autoRedirect));
            return $self->{error};
        }

    }

    # 1.2 SLO
    elsif ( $url =~
/^(\Q$saml_slo_soap_url\E|\Q$saml_slo_soap_url_ret\E|\Q$saml_slo_get_url\E|\Q$saml_slo_get_url_ret\E|Q$saml_slo_post_url\E|\Q$saml_slo_post_url_ret\E)$/io
      )
    {
        $self->lmLog( "URL $url detected as an SLO URL", 'debug' );

        # Check SAML Message
        my ( $request, $response, $method, $relaystate, $artifact ) =
          $self->checkMessage( $url, $request_method, $content_type, "logout" );

        # Create Logout object
        my $logout = $self->createLogout($server);

        # Ignore signature verification
        $self->disableSignatureVerification($logout);

        if ($response) {

            # Process logout response
            my $result = $self->processLogoutResponseMsg( $logout, $response );

            unless ($result) {
                $self->lmLog( "Fail to process logout response", 'error' );
                return PE_SAML_SLO_ERROR;
            }

            $self->lmLog( "Logout response is valid", 'debug' );

            # Check Destination
            return PE_SAML_DESTINATION_ERROR
              unless ( $self->checkDestination( $logout->response, $url ) );

            # Get IDP entityID
            my $idp = $logout->remote_providerID();

            $self->lmLog( "Found entityID $idp in SAML message", 'debug' );

            # IDP conf key
            my $idpConfKey = $self->{_idpList}->{$idp}->{confKey};

            unless ($idpConfKey) {
                $self->lmLog( "$idp do not match any IDP in configuration",
                    'error' );
                return PE_SAML_UNKNOWN_ENTITY;
            }

            $self->lmLog( "$idp match $idpConfKey IDP in configuration",
                'debug' );

            # Do we check signature?
            my $checkSLOMessageSignature =
              $self->{samlIDPMetaDataOptions}->{$idpConfKey}
              ->{samlIDPMetaDataOptionsCheckSLOMessageSignature};

            if ($checkSLOMessageSignature) {
                unless ( $self->checkSignatureStatus($logout) ) {
                    $self->lmLog( "Signature is not valid", 'error' );
                    return PE_SAML_SIGNATURE_ERROR;
                }
                else {
                    $self->lmLog( "Signature is valid", 'debug' );
                }
            }
            else {
                $self->lmLog( "Message signature will not be checked",
                    'debug' );
            }

            # Replay protection
            my $samlID = $logout->response()->InResponseTo;

            unless ( $self->replayProtection($samlID) ) {

                # Logout request was already consumed or is expired
                $self->lmLog( "Message $samlID already used or expired",
                    'error' );
                return PE_SAML_SLO_ERROR;
            }

            # If URL in RelayState, different from portal, redirect user
            if ( $self->extractRelayState($relaystate) ) {
                $self->lmLog( "RelayState $relaystate extracted", 'debug' );
                $self->lmLog( "URL " . $self->{urldc} . " found in RelayState",
                    'debug' );
            }

            $self->_subProcess(qw(autoRedirect))
              if (  $self->{urldc}
                and $self->{portal} !~ /\Q$self->{urldc}\E\/?/ );

            # Else, inform user that logout is OK
            return PE_LOGOUT_OK;
        }

        elsif ($request) {

            # Logout error
            my $logout_error = 0;

            # Lasso::Session dump
            my $session_dump;

            # Process logout request
            unless ( $self->processLogoutRequestMsg( $logout, $request ) ) {
                $self->lmLog( "Fail to process logout request", 'error' );
                $logout_error = 1;
            }

            $self->lmLog( "Logout request is valid", 'debug' );

            # Check Destination
            return PE_SAML_DESTINATION_ERROR
              unless ( $self->checkDestination( $logout->request, $url ) );

            # Get IDP entityID
            my $idp = $logout->remote_providerID();

            $self->lmLog( "Found entityID $idp in SAML message", 'debug' );

            # IDP conf key
            my $idpConfKey = $self->{_idpList}->{$idp}->{confKey};

            unless ($idpConfKey) {
                $self->lmLog( "$idp do not match any IDP in configuration",
                    'error' );
                return PE_SAML_UNKNOWN_ENTITY;
            }

            $self->lmLog( "$idp match $idpConfKey IDP in configuration",
                'debug' );

            # Do we check signature?
            my $checkSLOMessageSignature =
              $self->{samlIDPMetaDataOptions}->{$idpConfKey}
              ->{samlIDPMetaDataOptionsCheckSLOMessageSignature};

            if ($checkSLOMessageSignature) {
                unless ( $self->checkSignatureStatus($logout) ) {
                    $self->lmLog( "Signature is not valid", 'error' );
                    return PE_SAML_SIGNATURE_ERROR;
                }
                else {
                    $self->lmLog( "Signature is valid", 'debug' );
                }
            }
            else {
                $self->lmLog( "Message signature will not be checked",
                    'debug' );
            }

            # Get NameID and SessionIndex
            my $name_id       = $logout->request()->NameID;
            my $session_index = $logout->request()->SessionIndex;
            my $user          = $name_id->content;

            unless ($name_id) {
                $self->lmLog( "Fail to get NameID from logout request",
                    'error' );
                $logout_error = 1;
            }

            $self->lmLog( "Logout request NameID content: $user", 'debug' );

            # Get SAML sessions with the same NameID
            my $local_sessions =
              $self->{samlStorage}->searchOn( $self->{samlStorageOptions},
                "_nameID", $name_id->dump );

            if ( my @local_sessions_keys = keys %$local_sessions ) {

                # At least one session was found
                foreach (@local_sessions_keys) {

                    my $local_session = $_;

                    # Get session
                    $self->lmLog(
                        "Retrieve SAML session $local_session for user $user",
                        'debug' );

                    my $sessionInfo = $self->getSamlSession($local_session);

              # If session index is defined and not equal to SAML session index,
              # jump to next session
                    if ( defined $session_index
                        and $session_index ne $sessionInfo->{_sessionIndex} )
                    {
                        $self->lmLog(
"Session $local_session has not the good session index, skipping",
                            'debug'
                        );
                        next;
                    }

                    # Delete session
                    else {

                        # Open real session
                        my $real_session = $sessionInfo->{_saml_id};

                        my $realSessionInfo =
                          $self->getApacheSession( $sessionInfo->{_saml_id},
                            1 );

                  # Get Lasso::Session dump
                  # This value is erased if a next session match the SLO request
                        if (   $realSessionInfo
                            && $realSessionInfo->{_lassoSessionDump} )
                        {
                            $self->lmLog(
"Get Lasso::Session dump from session $real_session",
                                'debug'
                            );
                            $session_dump =
                              $realSessionInfo->{_lassoSessionDump};
                        }

                        # Delete real session
                        my $del_real_result =
                          $self->_deleteSession($realSessionInfo);

                        $self->lmLog(
"Delete real session $real_session result: $del_real_result",
                            'debug'
                        );

                        $logout_error = 1 unless $del_real_result;

                        # Delete SAML session
                        my $del_saml_result =
                          $self->_deleteSession($sessionInfo);

                        $self->lmLog(
"Delete SAML session $local_session result: $del_saml_result",
                            'debug'
                        );

                        $logout_error = 1 unless $del_saml_result;
                    }
                }

                # Set session from dump
                unless ( $self->setSessionFromDump( $logout, $session_dump ) ) {
                    $self->lmLog( "Cannot set session from dump in logout",
                        'error' );
                    $logout_error = 1;
                }

            }
            else {

                # No corresponding session found
                $self->lmLog( "No SAML session found for user $user", 'debug' );

                $logout_error = 1;

            }

            # Validate request if no previous error
            unless ($logout_error) {
                unless ( $self->validateLogoutRequest($logout) ) {
                    $self->lmLog( "SLO request is not valid", 'error' );
                }
            }

            # Set RelayState
            if ($relaystate) {
                $logout->msg_relayState($relaystate);
                $self->lmLog( "Set $relaystate in RelayState", 'debug' );
            }

            # Do we set signature?
            my $signSLOMessage =
              $self->{samlIDPMetaDataOptions}->{$idpConfKey}
              ->{samlIDPMetaDataOptionsSignSLOMessage};

            if ( $signSLOMessage == 0 ) {
                $self->lmLog(
                    "SLO message to IDP $idpConfKey will not be signed",
                    'debug' );
                $self->disableSignature($logout);
            }
            elsif ( $signSLOMessage == 1 ) {
                $self->lmLog( "SLO message to IDP $idpConfKey will be signed",
                    'debug' );
                $self->forceSignature($logout);
            }
            else {
                $self->lmLog(
"SLO message to IDP $idpConfKey signature according to metadata",
                    'debug'
                );
            }

            # Logout response
            unless ( $self->buildLogoutResponseMsg($logout) ) {
                $self->lmLog( "Unable to build SLO response", 'error' );
                return PE_SAML_SLO_ERROR;
            }

            # Send response depending on request method
            # HTTP-REDIRECT
            if ( $method == Lasso::Constants::HTTP_METHOD_REDIRECT ) {

                # Redirect user to response URL
                my $slo_url = $logout->msg_url;
                $self->lmLog( "Redirect user to $slo_url", 'debug' );

                $self->{urldc} = $slo_url;

                $self->_subProcess(qw(autoRedirect));

                # If we are here, there was a problem with GET request
                $self->lmLog( "Logout response was not sent trough GET",
                    'error' );
                return PE_SAML_SLO_ERROR;
            }

            # HTTP-POST
            elsif ( $method == Lasso::Constants::HTTP_METHOD_POST ) {

                # Use autosubmit form
                my $slo_url  = $logout->msg_url;
                my $slo_body = $logout->msg_body;

                $self->{postUrl} = $slo_url;
                $self->{postFields} = { 'SAMLResponse' => $slo_body };

                # RelayState
                $self->{postFields}->{'RelayState'} = $relaystate
                  if ($relaystate);

                $self->_subProcess(qw(autoPost));

                # If we are here, there was a problem with POST response
                $self->lmLog( "Logout response was not sent trough POST",
                    'error' );
                return PE_SAML_SLO_ERROR;
            }

            # HTTP-SOAP
            elsif ( $method == Lasso::Constants::HTTP_METHOD_SOAP ) {

                my $slo_body = $logout->msg_body;

                $self->lmLog( "SOAP response $slo_body", 'debug' );

                $self->{SOAPMessage} = $slo_body;

                $self->_subProcess(qw(returnSOAPMessage));

                # If we are here, there was a problem with SOAP response
                $self->lmLog( "Logout response was not sent trough SOAP",
                    'error' );
                return PE_SAML_SLO_ERROR;
            }

        }
        else {

            # This should not happen
            $self->lmLog( "SLO request or response was not found", 'error' );

            # Redirect user
            $self->{mustRedirect} = 1;
            $self->{error}        = $self->_subProcess(qw(autoRedirect));
            return $self->{error};
        }
    }

    # 1.3 Artifact
    elsif ( $url =~ /^(\Q$saml_ars_url\E)$/io ) {

        $self->lmLog( "URL $url detected as an artifact resolution service URL",
            'debug' );

        # Artifact request are sent with SOAP trough POST
        my $art_request = $self->param('POSTDATA');
        my $art_response;

        # Create Login object
        my $login = $self->createLogin($server);

        # Process request message
        unless ( $self->processArtRequestMsg( $login, $art_request ) ) {
            $self->lmLog( "Unable to process artifact request message",
                'error' );
            return PE_SAML_ART_ERROR;
        }

        # Check Destination
        return PE_SAML_DESTINATION_ERROR
          unless ( $self->checkDestination( $login->request, $url ) );

        # Create artifact response
        unless ( $art_response = $self->createArtifactResponse($login) ) {
            $self->lmLog( "Unable to create artifact response message",
                'error' );
            return PE_SAML_ART_ERROR;
        }

        $self->{SOAPMessage} = $art_response;

        $self->lmLog( "Send SOAP Message: " . $self->{SOAPMessage}, 'debug' );

        # Return SOAP message
        $self->returnSOAPMessage();

        # If we are here, there was a problem with SOAP request
        $self->lmLog( "Artifact response was not sent trough SOAP", 'error' );
        return PE_SAML_ART_ERROR;

    }

    # 2. IDP resolution

    # Search a selected IdP
    my ( $idp, $idp_cookie ) = $self->_sub('getIDP');

    # Get confirmation flag
    my $confirm_flag = $self->param("confirm");

    # If confirmation is -1 from IDP list,
    # return error to get next authentication method
    # with AuthMulti
    if ( $confirm_flag == -1 and $self->param("idplist") ) {
        $self->lmLog( "SAML authentication refused by user", 'error' );
        return PE_ERROR;
    }

    # If confirmation is -1 from resolved IDP screen,
    # or IDP was not resolve, let the user choose its IDP
    if ( $confirm_flag == -1 or !$idp ) {
        $self->lmLog( "Redirecting user to IDP list", 'debug' );

        # Control url parameter
        my $urlcheck = $self->controlUrlOrigin();
        return $urlcheck unless ( $urlcheck == PE_OK );

        # IDP list
        my $html = "<h3>"
          . &Lemonldap::NG::Portal::_i18n::msg( PM_SAML_IDPSELECT,
            $ENV{HTTP_ACCEPT_LANGUAGE} )
          . "</h3>\n<table>\n";

        foreach ( keys %{ $self->{_idpList} } ) {
            $html .=
                '<tr><td><input type="radio" name="idp" value="' 
              . $_
              . '" /></td><td>'
              . $self->{_idpList}->{$_}->{name}
              . '</td></tr>';
        }

        $html .=
'<tr><td><input type="checkbox" name="cookie_type" value="1"></td><td>'
          . &Lemonldap::NG::Portal::_i18n::msg( PM_REMEMBERCHOICE,
            $ENV{HTTP_ACCEPT_LANGUAGE} )
          . "</td></tr></table>\n"

          # URL
          . '<input type="hidden" name="url" value="'
          . $self->param("url") . '" />'

          # IDP list flag
          . '<input type="hidden" name="idplist" value="1" />'

          # Script to autoselect first choice
          . '<script>$("[type=radio]:first").attr("checked","checked");</script>';

        $self->info($html);

        # Timer not active on IDP list
        $self->{activeTimer} = 0;

        # Delete existing IDP resolution cookie
        push @{ $self->{cookie} },
          $self->cookie(
            -name    => $self->{samlIdPResolveCookie},
            -value   => 0,
            -domain  => $self->{domain},
            -path    => "/",
            -secure  => 0,
            -expires => '-1d',
          );

        return PE_CONFIRM;
    }

    # If IDP is found but not confirmed, let the user confirm it
    elsif ( $confirm_flag != 1 ) {
        $self->lmLog( "IDP $idp selected, need user confirmation", 'debug' );

        # Control url parameter
        my $urlcheck = $self->controlUrlOrigin();
        return $urlcheck unless ( $urlcheck == PE_OK );

        # Choosen IDP
        my $html = '<h3>'
          . &Lemonldap::NG::Portal::_i18n::msg( PM_SAML_IDPCHOOSEN,
            $ENV{HTTP_ACCEPT_LANGUAGE} )
          . "</h3>\n" . "<h4>"
          . $self->{_idpList}->{$idp}->{name}
          . "</h4>\n"
          . "<p><i>"
          . $idp
          . "</i></p>\n"
          . "<input type=\"hidden\" name=\"url\" value=\""
          . $self->param("url") . "\" />"
          . "<input type=\"hidden\" name=\"idp\" value=\"$idp\" />\n";

        $self->info($html);

        return PE_CONFIRM;
    }

    # Here confirmation is OK (confirm_flag == 1), store choosen IDP in cookie
    unless ( $idp_cookie and $idp eq $idp_cookie ) {
        $self->lmLog( "Build cookie to remember $idp as IDP choice", 'debug' );

        # Control url parameter
        my $urlcheck = $self->controlUrlOrigin();
        return $urlcheck unless ( $urlcheck == PE_OK );

        # User can choose temporary (0) or persistent cookie (1)
        my $cookie_type = $self->param("cookie_type") || "0";

        push @{ $self->{cookie} },
          $self->cookie(
            -name     => $self->{samlIdPResolveCookie},
            -value    => $idp,
            -domain   => $self->{domain},
            -path     => "/",
            -secure   => $self->{securedCookie},
            -httponly => $self->{httpOnly},
            -expires  => $cookie_type ? "+365d" : "",
          );
    }

    # 3. Build authentication request

    # IDP conf key
    my $idpConfKey = $self->{_idpList}->{$idp}->{confKey};

    unless ($idpConfKey) {
        $self->lmLog( "$idp do not match any IDP in configuration", 'error' );
        return PE_SAML_UNKNOWN_ENTITY;
    }

    $self->lmLog( "$idp match $idpConfKey IDP in configuration", 'debug' );

    # IDP ForceAuthn
    my $forceAuthn =
      $self->{samlIDPMetaDataOptions}->{$idpConfKey}
      ->{samlIDPMetaDataOptionsForceAuthn};

    # IDP IsPassive
    my $isPassive =
      $self->{samlIDPMetaDataOptions}->{$idpConfKey}
      ->{samlIDPMetaDataOptionsIsPassive};

    # IDP NameIDFormat
    my $nameIDFormat =
      $self->{samlIDPMetaDataOptions}->{$idpConfKey}
      ->{samlIDPMetaDataOptionsNameIDFormat};
    $nameIDFormat = $self->getNameIDFormat($nameIDFormat) if $nameIDFormat;

    # IDP ProxyRestriction
    my $allowProxiedAuthn =
      $self->{samlIDPMetaDataOptions}->{$idpConfKey}
      ->{samlIDPMetaDataOptionsAllowProxiedAuthn};

    # IDP HTTP method
    my $method =
      $self->{samlIDPMetaDataOptions}->{$idpConfKey}
      ->{samlIDPMetaDataOptionsSSOBinding};
    $method = $self->getHttpMethod($method) if $method;

    # If no method defined, get first HTTP method
    unless ( defined $method ) {
        my $protocolType = Lasso::Constants::MD_PROTOCOL_TYPE_SINGLE_SIGN_ON;
        $method = $self->getFirstHttpMethod( $server, $idp, $protocolType );
    }

    # Failback to HTTP-REDIRECT
    unless ( defined $method and $method != -1 ) {
        $self->lmLog( "No method found with IDP $idpConfKey for SSO profile",
            'debug' );
        $method = $self->getHttpMethod("redirect");
    }

    $self->lmLog(
        "Use method "
          . $self->getHttpMethodString($method)
          . " with IDP $idpConfKey for SSO profile",
        'debug'
    );

    # Set signature
    my $signSSOMessage =
      $self->{samlIDPMetaDataOptions}->{$idpConfKey}
      ->{samlIDPMetaDataOptionsSignSSOMessage};

    # Authentication Context
    my $requestedAuthnContext =
      $self->{samlIDPMetaDataOptions}->{$idpConfKey}
      ->{samlIDPMetaDataOptionsRequestedAuthnContext};
    $requestedAuthnContext = $self->getAuthnContext($requestedAuthnContext)
      if $requestedAuthnContext;

    # Create SSO request
    my $login = $self->createAuthnRequest(
        $server,            $idp,            $method,
        $forceAuthn,        $isPassive,      $nameIDFormat,
        $allowProxiedAuthn, $signSSOMessage, $requestedAuthnContext
    );

    unless ($login) {
        $self->lmLog( "Could not create authentication request on $idpConfKey",
            'error' );
        return PE_SAML_SSO_ERROR;
    }

    $self->lmLog( "Authentication request created", 'debug' );

    # Keep assertion ID in memory to prevent replay
    my $samlID = $login->request()->ID;
    unless ( $self->storeReplayProtection($samlID) ) {
        $self->lmLog( "Unable to store assertion ID", 'error' );
        return PE_SAML_SSO_ERROR;
    }

    # Keep initial SAML request data in memory in case of proxing
    if ( $self->{_proxiedSamlRequest} ) {

        my $samlSessionInfo = $self->getSamlSession();

        return PE_SAML_SESSION_ERROR unless $samlSessionInfo;

        $samlSessionInfo->{type}       = 'proxy';
        $samlSessionInfo->{_utime}     = time;
        $samlSessionInfo->{Request}    = $self->{_proxiedRequest};
        $samlSessionInfo->{Method}     = $self->{_proxiedMethod};
        $samlSessionInfo->{RelayState} = $self->{_proxiedRelayState};
        $samlSessionInfo->{Artifact}   = $self->{_proxiedArtifact};
        $samlSessionInfo->{ProxyID}    = $samlID;

        untie %$samlSessionInfo;

        $self->lmLog( "Keep initial SAML request data in memory for ID $samlID",
            'debug' );
    }

    # Send SSO request depending on request method
    # HTTP-REDIRECT
    if (   $method == $self->getHttpMethod('redirect')
        or $method == $self->getHttpMethod('artifact-get') )
    {

        # Redirect user to response URL
        my $sso_url = $login->msg_url;
        $self->lmLog( "Redirect user to $sso_url", 'debug' );

        $self->{urldc} = $sso_url;

        $self->_subProcess(qw(autoRedirect));

        # If we are here, there was a problem with GET request
        $self->lmLog( "SSO request was not sent trough GET", 'error' );
        return PE_SAML_SSO_ERROR;
    }

    # HTTP-POST
    elsif ($method == $self->getHttpMethod('post')
        or $method == $self->getHttpMethod('artifact-post') )
    {

        # Use autosubmit form
        my $sso_url  = $login->msg_url;
        my $sso_body = $login->msg_body;

        $self->{postUrl} = $sso_url;

        if ( $method == $self->getHttpMethod("artifact-post") ) {
            $self->{postFields} = { 'SAMLart' => $sso_body };
        }
        else {
            $self->{postFields} = { 'SAMLRequest' => $sso_body };
        }

        # RelayState
        $self->{postFields}->{'RelayState'} = $login->msg_relayState
          if ( $login->msg_relayState );

        $self->_subProcess(qw(autoPost));

        # If we are here, there was a problem with POST request
        $self->lmLog( "SSO request was not sent trough POST", 'error' );
        return PE_SAML_SSO_ERROR;
    }

    # No SOAP transport for SSO request
}

## @apmethod int setAuthSessionInfo()
# Extract attributes sent in authentication statement
# @return Lemonldap::NG::Portal error code
sub setAuthSessionInfo {
    my $self       = shift;
    my $server     = $self->{_lassoServer};
    my $login      = $self->{_lassoLogin};
    my $idp        = $self->{_idp};
    my $idpConfKey = $self->{_idpConfKey};

    # Get SAML assertion
    my $assertion = $self->getAssertion($login);

    unless ($assertion) {
        $self->lmLog( "No assertion found", 'error' );
        return PE_SAML_SSO_ERROR;
    }

    # Force UTF-8
    my $force_utf8 =
      $self->{samlIDPMetaDataOptions}->{$idpConfKey}
      ->{samlIDPMetaDataOptionsForceUTF8};

    # Try to get attributes if attribute statement is present in assertion
    my $attr_statement = $assertion->AttributeStatement();
    if ($attr_statement) {

        # Get attributes
        my @attributes = $attr_statement->Attribute();

        # Wanted attributes are defined in IDP configuration
        foreach (
            keys %{ $self->{samlIDPMetaDataExportedAttributes}->{$idpConfKey} }
          )
        {

            # Extract fields from exportedAttr value
            my ( $mandatory, $name, $format, $friendly_name ) =
              split( /;/,
                $self->{samlIDPMetaDataExportedAttributes}->{$idpConfKey}
                  ->{$_} );

            # Try to get value
            my $value =
              $self->getAttributeValue( $name, $format, $friendly_name,
                \@attributes, $force_utf8 );

            # Store value in sessionInfo
            $self->{sessionInfo}->{$_} = $value if defined $value;
        }
    }

    # Store other informations in session
    $self->{sessionInfo}->{_user}       = $self->{user};
    $self->{sessionInfo}->{_idp}        = $idp;
    $self->{sessionInfo}->{_idpConfKey} = $idpConfKey;

    # Adapt _utime with SessionNotOnOrAfter
    my $sessionNotOnOrAfter;
    eval {
        $sessionNotOnOrAfter =
          $assertion->AuthnStatement()->SessionNotOnOrAfter();
    };

    if ( $@ or !$sessionNotOnOrAfter ) {
        $self->lmLog( "No SessionNotOnOrAfter value found", 'debug' );
    }
    else {

        my $samltime = $self->samldate2timestamp($sessionNotOnOrAfter);
        my $utime    = time();
        my $timeout  = $self->{timeout};
        my $adaptSessionUtime =
          $self->{samlIDPMetaDataOptions}->{$idpConfKey}
          ->{samlIDPMetaDataOptionsAdaptSessionUtime};

        if ( ( $utime + $timeout > $samltime ) and $adaptSessionUtime ) {

            # Use SAML time to determine the start of the session
            my $new_utime = $samltime - $timeout;
            $self->{sessionInfo}->{_utime} = $new_utime;
            $self->lmLog(
"Adapt _utime with SessionNotOnOrAfter value, new _utime: $new_utime",
                'debug'
            );
        }

    }

    # Establish federation (required for attribute request in UserDBSAML)
    unless ( $self->acceptSSO($login) ) {
        $self->lmLog( "Error while accepting SSO from IDP $idpConfKey",
            'error' );
        return PE_SAML_SSO_ERROR;
    }

    # Get created Lasso::Session and Lasso::Identity
    my $session  = $login->get_session;
    my $identity = $login->get_identity;

    # Dump Lasso objects in session
    $self->{sessionInfo}->{_lassoSessionDump}  = $session->dump()  if $session;
    $self->{sessionInfo}->{_lassoIdentityDump} = $identity->dump() if $identity;
    $self->{sessionInfo}->{_samlToken} = $self->{_samlToken};

    $self->{_lassoLogin} = $login;

    PE_OK;
}

## @apmethod int authenticate()
# Do nothing
# @return PE_OK
sub authenticate {
    PE_OK;
}

## @method protected *string getIDP()
# Try to find an IdP using :
# * HTTP parameter
# * "samlIdPResolveCookie" cookie
# * Rules
# * Common Domain Cookie
#
# @return Array containing :
# * IdP found (or undef)
# * Cookie value if exists
sub getIDP {
    my $self = shift;
    my $idp;

    my %cookies    = fetch CGI::Cookie;
    my $idp_cookie = $cookies{ $self->{samlIdPResolveCookie} };
    $idp_cookie &&= $idp_cookie->value;

    # Case 1: Recover IDP from args
    unless ( $idp = $self->param("idp") ) {

        # Case 2: Recover IDP from cookie
        if ( $idp = $idp_cookie ) {
            $self->lmLog( "IDP $idp found in IDP resolution cookie", 'debug' );
        }

        # Case 3: check all IDP resolution rules
        # The first match win
        else {
            foreach ( keys %{ $self->{_idpList} } ) {
                my $idpConfKey = $self->{_idpList}->{$_}->{confKey};
                my $cond =
                  $self->{samlIDPMetaDataOptions}->{$idpConfKey}
                  ->{samlIDPMetaDataOptionsResolutionRule};
                next unless defined $cond;
                if ( $self->safe->reval($cond) ) {
                    $self->lmLog( "IDP $idpConfKey resolution rule match",
                        'debug' );
                    $idp = $_;
                    last;
                }
            }
        }

        # Case 4: use Common Domain Cookie
        if (   !$idp
            and $self->{samlCommonDomainCookieActivation}
            and $self->{samlCommonDomainCookieReader} )
        {

            $self->lmLog(
                "Will try to use Common Domain Cookie for IDP resolution",
                'debug' );

            # Add current URL to CDC Reader URL
            my $return_url = encode_base64( $self->self_url(), '' );

            my $cdc_reader_url = $self->{samlCommonDomainCookieReader};

            $cdc_reader_url .= (
                $self->{samlCommonDomainCookieReader} =~ /\?/
                ? '&url=' . $return_url
                : '?url=' . $return_url
            );

            $self->lmLog( "Redirect user to $cdc_reader_url", 'debug' );

            $self->{urldc} = $cdc_reader_url;

            return $self->_sub('autoRedirect');

        }

        $self->lmLog( 'No IDP found', 'debug' ) unless ($idp);
    }

    # Alert when selected IDP is unknown
    if ( $idp and !exists $self->{_idpList}->{$idp} ) {
        $self->_sub( 'userError', "Required IDP $idp does not exists" );
        $idp = undef;
    }

    return ( $idp, $idp_cookie );
}

## @apmethod void authLogout()
# Logout SP
# @return Lemonldap::NG::Portal error code
sub authLogout {
    my $self       = shift;
    my $idp        = $self->{sessionInfo}->{_idp};
    my $idpConfKey = $self->{sessionInfo}->{_idpConfKey};
    my $session_id = $self->{sessionInfo}->{_session_id};
    my $method;

    # Real session was previously deleted,
    # remove corresponding SAML sessions
    $self->deleteSAMLSecondarySessions($session_id);

    # Get Lasso Server
    unless ( $self->{_lassoServer} ) {
        $self->_sub('Lemonldap::NG::Portal::AuthSAML::authInit');
    }

    my $server = $self->{_lassoServer};

    # Recover Lasso::Session dump
    my $session_dump = $self->{sessionInfo}->{_lassoSessionDump};

    unless ($session_dump) {
        $self->lmLog( "Could not get session dump from session", 'error' );
        return PE_SAML_SLO_ERROR;
    }

    # IDP HTTP method
    $method =
      $self->{samlIDPMetaDataOptions}->{$idpConfKey}
      ->{samlIDPMetaDataOptionsSLOBinding};
    $method = $self->getHttpMethod($method) if $method;

    # If no method defined, get first HTTP method
    unless ( defined $method ) {
        my $protocolType = Lasso::Constants::MD_PROTOCOL_TYPE_SINGLE_LOGOUT;
        $method = $self->getFirstHttpMethod( $server, $idp, $protocolType );
    }

    # Failback to SOAP
    unless ( defined $method and $method != -1 ) {
        $self->lmLog( "No method found with IDP $idpConfKey for SLO profile",
            'debug' );
        $method = $self->getHttpMethod("soap");
    }

    $self->lmLog(
        "Use method "
          . $self->getHttpMethodString($method)
          . " with IDP $idpConfKey for SLO profile",
        'debug'
    );

    # Set signature
    my $signSLOMessage =
      $self->{samlIDPMetaDataOptions}->{$idpConfKey}
      ->{samlIDPMetaDataOptionsSignSLOMessage};

    # Build Logout Request
    my $logout =
      $self->createLogoutRequest( $server, $session_dump, $method,
        $signSLOMessage );
    unless ($logout) {
        $self->lmLog( "Could not create logout request", 'error' );
        return PE_SAML_SLO_ERROR;
    }

    $self->lmLog( "Logout request created", 'debug' );

    # Keep request ID in memory to prevent replay
    unless ( $self->storeReplayProtection( $logout->request()->ID ) ) {
        $self->lmLog( "Unable to store Logout request ID", 'error' );
        return PE_SAML_SLO_ERROR;
    }

    # Send request depending on request method
    # HTTP-REDIRECT
    if ( $method == Lasso::Constants::HTTP_METHOD_REDIRECT ) {

        # Redirect user to response URL
        my $slo_url = $logout->msg_url;
        $self->lmLog( "Redirect user to $slo_url", 'debug' );

        $self->{urldc} = $slo_url;

        # Redirect done in Portal/Simple.pm
        return PE_OK;
    }

    # HTTP-POST
    elsif ( $method == Lasso::Constants::HTTP_METHOD_POST ) {

        # Use autosubmit form
        my $slo_url  = $logout->msg_url;
        my $slo_body = $logout->msg_body;

        $self->{postUrl} = $slo_url;
        $self->{postFields} = { 'SAMLRequest' => $slo_body };

        # Post done in Portal/Simple.pm
        return PE_OK;
    }

    # HTTP-SOAP
    elsif ( $method == Lasso::Constants::HTTP_METHOD_SOAP ) {

        my $slo_url  = $logout->msg_url;
        my $slo_body = $logout->msg_body;

        # Send SOAP request and manage response
        my $response = $self->sendSOAPMessage( $slo_url, $slo_body );

        unless ($response) {
            $self->lmLog( "No logout response to SOAP request", 'error' );
            return PE_SAML_SLO_ERROR;
        }

        # Create Logout object
        $logout = $self->createLogout($server);

        # Process logout response
        my $result = $self->processLogoutResponseMsg( $logout, $response );

        unless ($result) {
            $self->lmLog( "Fail to process logout response", 'error' );
            return PE_SAML_SLO_ERROR;
        }

        $self->lmLog( "Logout response is valid", 'debug' );

        # Replay protection
        my $samlID = $logout->response()->InResponseTo;

        unless ( $self->replayProtection($samlID) ) {

            # Logout request was already consumed or is expired
            $self->lmLog( "Message $samlID already used or expired", 'error' );
            return PE_SAML_SLO_ERROR;
        }

        return PE_OK;
    }

}

## @apmethod boolean authForce()
# Check if authentication should be forced
# @return nothing
sub authForce {
    my $self = shift;

    my $url = $self->url();

    my $saml_acs_art_url = $self->getMetaDataURL(
        "samlSPSSODescriptorAssertionConsumerServiceHTTPArtifact");
    my $saml_acs_post_url = $self->getMetaDataURL(
        "samlSPSSODescriptorAssertionConsumerServiceHTTPPost");
    my $saml_acs_get_url = $self->getMetaDataURL(
        "samlSPSSODescriptorAssertionConsumerServiceHTTPRedirect");
    my $saml_slo_soap_url =
      $self->getMetaDataURL( "samlSPSSODescriptorSingleLogoutServiceSOAP", 1 );
    my $saml_slo_soap_url_ret =
      $self->getMetaDataURL( "samlSPSSODescriptorSingleLogoutServiceSOAP", 2 );
    my $saml_slo_get_url = $self->getMetaDataURL(
        "samlSPSSODescriptorSingleLogoutServiceHTTPRedirect", 1 );
    my $saml_slo_get_url_ret = $self->getMetaDataURL(
        "samlSPSSODescriptorSingleLogoutServiceHTTPRedirect", 2 );
    my $saml_slo_post_url =
      $self->getMetaDataURL( "samlSPSSODescriptorSingleLogoutServiceHTTPPost",
        1 );
    my $saml_slo_post_url_ret =
      $self->getMetaDataURL( "samlSPSSODescriptorSingleLogoutServiceHTTPPost",
        2 );
    my $saml_ars_url = $self->getMetaDataURL(
        "samlSPSSODescriptorArtifactResolutionServiceArtifact");

    return 1
      if ( $url =~
/^(\Q$saml_acs_art_url\E|\Q$saml_acs_post_url\E|\Q$saml_acs_get_url\E|\Q$saml_slo_soap_url\E|\Q$saml_slo_soap_url_ret\E|\Q$saml_slo_get_url\E|\Q$saml_slo_get_url_ret\E|\Q$saml_slo_post_url\E|\Q$saml_slo_post_url_ret\E|\Q$saml_ars_url\E)$/io
      );

    return 0;
}

## @apmethod boolean authFinish()
# Associate NameID and SessionIndex to a local session
# @return Lemonldap::NG::Portal error code
sub authFinish {
    my $self = shift;
    my %h;

    # Real session was stored, get id and utime
    my $id    = $self->{id};
    my $utime = $self->{sessionInfo}->{_utime};

    # Get saved Lasso objects
    my $nameid        = $self->{_nameID};
    my $session_index = $self->{_sessionIndex};

    $self->lmLog(
        "Store NameID "
          . $nameid->dump
          . " and SessionIndex $session_index for session $id",
        'debug'
    );

    # Save SAML session
    my $samlSessionInfo = $self->getSamlSession();

    return PE_SAML_SESSION_ERROR unless $samlSessionInfo;

    $samlSessionInfo->{type}          = 'saml';            # Session type
    $samlSessionInfo->{_utime}        = $utime;            # Creation time
    $samlSessionInfo->{_saml_id}      = $id;               # SSO session id
    $samlSessionInfo->{_nameID}       = $nameid->dump;     # SAML NameID
    $samlSessionInfo->{_sessionIndex} = $session_index;    # SAML SessionIndex

    my $session_id = $samlSessionInfo->{_session_id};

    untie %$samlSessionInfo;

    $self->lmLog( "Link session $id to SAML session $session_id", 'debug' );

    return PE_OK;
}

1;

__END__

=head1 NAME

=encoding utf8

Lemonldap::NG::Portal::AuthSAML - SAML Authentication backend

=head1 SYNOPSIS

  use Lemonldap::NG::Portal::AuthSAML;

=head1 DESCRIPTION

Use SAML to authenticate users

=head1 SEE ALSO

L<Lemonldap::NG::Portal>, L<Lemonldap::NG::Portal::UserDBSAML>, L<Lemonldap::NG::Portal::_SAML>

=head1 AUTHOR

Xavier Guimard, E<lt>x.guimard@free.frE<gt>, Clement Oudot, E<lt>coudot@linagora.comE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2009, 2010 by Xavier Guimard

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.10.0 or,
at your option, any later version of Perl 5 you may have available.

=cut