# Methods run at configuration reload
package Lemonldap::NG::Handler::Reload;

#use Lemonldap::NG::Handler::Main qw(:all);
use Lemonldap::NG::Common::Safelib;    #link protected safe Safe object
use constant UNPROTECT => 1;
use constant SKIP      => 2;

use Lemonldap::NG::Handler::Main::Jail;
use Lemonldap::NG::Handler::Main::Logger;
use Lemonldap::NG::Handler::API qw(:httpCodes);
use Lemonldap::NG::Common::Crypto;

our $VERSION = '1.4.0';

## @imethod void configReload(hashRef conf, hashRef tsv)
# Given a Lemonldap::NG configuration $conf, computes values used to
# handle requests and store them in a thread shared object called $tsv
#
# methods called by configReload, and thread shared values computed, are:
# - jailInit():
#      - jail
# - defaultValuesInit():
#      (scalars for global options)
#      - cda
#      - cookieExpiration  # warning: absent from default Conf
#      - cookieName
#      - securedCookie,
#      - httpOnly
#      - whatToTrace
#      - customFunctions
#      - timeoutActivity
#      - useRedirectOnError
#      - useRedirectOnForbidden
#      - useSafeJail
#      (objects)
#      - cipher  # Lemonldap::NG::Common::Crypto object
#      (hashrefs for vhost options)
#      - https
#      - port
#      - maintenance
# - portalInit():
#      - portal (functions that returns portal URL)
# - locationRulesInit():
#      - locationCount
#      - defaultCondition
#      - defaultProtection
#      - locationCondition
#      - locationProtection
#      - locationRegexp
#      - locationConditionText
# - sessionStorageInit():
#      - sessionStorageModule
#      - sessionStorageOptions
#      - sessionCacheModule
#      - sessionCacheOptions
# - headersInit():
#      - headerList
#      - forgeHeaders
# - postUrlInit():
#      - inputPostData
#      - outputPostData
# - aliasInit():
#      - vhostAlias
#
# The *Init() methods can be run in any order,
# but jailInit must be run first because $tsv->{jail}
# is used by locationRulesInit, headersInit and postUrlInit.

# @param $conf reference to the configuration hash
# @param $tsv reference to the thread-shared parameters conf
sub configReload {
    my ( $class, $conf, $tsv ) = @_;
    Lemonldap::NG::Handler::Main::Logger->lmLog(
        "Loading configuration $conf->{cfgNum} for process $$", "info" );

    foreach my $sub (
        qw( jailInit defaultValuesInit portalInit locationRulesInit
        sessionStorageInit headersInit postUrlInit aliasInit )
      )
    {
        Lemonldap::NG::Handler::Main::Logger->lmLog( "Process $$ calls $sub",
            "debug" );
        $class->$sub( $conf, $tsv );
    }
    return 1;
}

## @imethod protected void jailInit(hashRef args)
# Set default values for non-customized variables
# @param $args reference to the configuration hash
sub jailInit {
    my ( $class, $conf, $tsv ) = @_;

    $tsv->{jail} = Lemonldap::NG::Handler::Main::Jail->new(
        'jail'            => $tsv->{jail},
        'useSafeJail'     => $conf->{useSafeJail},
        'customFunctions' => $conf->{customFunctions}
    );
    $tsv->{jail}->build_jail();
}

## @imethod protected void defaultValuesInit(hashRef args)
# Set default values for non-customized variables
# @param $args reference to the configuration hash
sub defaultValuesInit {
    my ( $class, $conf, $tsv ) = @_;

    $tsv->{$_} = $conf->{$_} foreach (
        qw(
        cda              cookieExpiration    cookieName
        customFunctions  httpOnly            securedCookie
        timeoutActivity  useRedirectOnError  useRedirectOnForbidden
        useSafeJail      whatToTrace
        )
    );

    $tsv->{cipher} = Lemonldap::NG::Common::Crypto->new( $conf->{key} );

    foreach my $opt (qw(https port maintenance)) {
        next unless defined $conf->{$opt};

        # Record default value in key '_'
        $tsv->{$opt} = { _ => $conf->{$opt} };

        # Override with vhost options
        if ( $conf->{vhostOptions} ) {
            my $name = 'vhost' . ucfirst($opt);
            foreach my $vhost ( keys %{ $conf->{vhostOptions} } ) {
                my $val = $conf->{vhostOptions}->{$vhost}->{$name};
                Lemonldap::NG::Handler::Main::Logger->lmLog(
                    "Options $opt for vhost $vhost: $val", 'debug' );
                $tsv->{$opt}->{$vhost} = $val
                  if ( $val >= 0 );    # Keep default value if $val is negative
            }
        }
    }
    return 1;
}

## @imethod protected void portalInit(hashRef args)
# Verify that portal variable exists. Die unless
# @param $args reference to the configuration hash
sub portalInit {
    my ( $class, $conf, $tsv ) = @_;
    die("portal parameter required") unless ( $conf->{portal} );
    if ( $conf->{portal} =~ /[\$\(&\|"']/ ) {
        ( $tsv->{portal} ) = $class->conditionSub( $conf->{portal}, $tsv );
    }
    else {
        $tsv->{portal} = sub { return $conf->{portal} };
    }
    return 1;
}

## @imethod void locationRulesInit(hashRef args)
# Compile rules.
# Rules are stored in $args->{locationRules}->{<virtualhost>} that contains
# regexp=>test expressions where :
# - regexp is used to test URIs
# - test contains an expression used to grant the user
#
# This function creates 2 hashRef containing :
# - one list of the compiled regular expressions for each virtual host
# - one list of the compiled functions (compiled with conditionSub()) for each
# virtual host
# @param $args reference to the configuration hash
sub locationRulesInit {
    my ( $class, $conf, $tsv ) = @_;

    while ( my ( $vhost, $rules ) = each( %{ $conf->{locationRules} } ) ) {
        foreach my $url ( sort keys %{$rules} ) {
            my ( $cond, $prot ) = $class->conditionSub( $rules->{$url}, $tsv );

            if ( $url eq 'default' ) {
                $tsv->{defaultCondition}->{$vhost}  = $cond;
                $tsv->{defaultProtection}->{$vhost} = $prot;
            }
            else {
                push @{ $tsv->{locationCondition}->{$vhost} },  $cond;
                push @{ $tsv->{locationProtection}->{$vhost} }, $prot;
                push @{ $tsv->{locationRegexp}->{$vhost} },     qr/$url/;
                push @{ $tsv->{locationConditionText}->{$vhost} },
                    $cond =~ /^\(\?#(.*?)\)/ ? $1
                  : $cond =~ /^(.*?)##(.+)$/ ? $2
                  :                            $url;
                $tsv->{locationCount}->{$vhost}++;
            }
        }

        # Default policy set to 'accept'
        unless ( $tsv->{defaultCondition}->{$vhost} ) {
            $tsv->{defaultCondition}->{$vhost} = sub { 1 };
            $tsv->{defaultProtection}->{$vhost} = 0;
        }
    }
    return 1;
}

## @imethod protected void sessionStorageInit(hashRef args)
# Initialize the Apache::Session::* module choosed to share user's variables
# and the Cache::Cache module choosed to cache sessions
# @param $args reference to the configuration hash
sub sessionStorageInit {
    my ( $class, $conf, $tsv ) = @_;
    $tsv->{sessionStorageModule} = $conf->{globalStorage}
      or die("globalStorage required");
    eval "use $tsv->{sessionStorageModule}";
    die($@) if ($@);
    $tsv->{sessionStorageOptions} = $conf->{globalStorageOptions};

    if ( $conf->{localSessionStorage} ) {
        $tsv->{sessionCacheModule}  = $conf->{localSessionStorage};
        $tsv->{sessionCacheOptions} = $conf->{localSessionStorageOptions};
        $tsv->{sessionCacheOptions}->{default_expires_in} ||= 600;

        if ( $conf->{status} ) {
            my $params = "";
            if ( $tsv->{sessionCacheModule} ) {
                require Data::Dumper;
                $params =
                  " $tsv->{sessionCacheModule},"
                  . Data::Dumper->new( [ $tsv->{sessionCacheOptions} ] )
                  ->Terse(1)->Indent(0)->Dump;    # To send params on one line
            }
            print { $tsv->{statusPipe} } "RELOADCACHE$params";
        }
    }
    return 1;
}

## @imethod void headersInit(hashRef args)
# Create the subroutines used to insert headers into the HTTP request.
# @param $args reference to the configuration hash
sub headersInit {
    my ( $class, $conf, $tsv ) = @_;

    # Creation of the subroutine which will generate headers
    foreach my $vhost ( keys %{ $conf->{exportedHeaders} } ) {
        my %headers = %{ $conf->{exportedHeaders}->{$vhost} };
        $tsv->{headerList}->{$vhost} = [ keys %headers ];
        my $sub;
        foreach ( keys %headers ) {
            my $val = $class->substitute( $headers{$_} );
            $sub .= "'$_' => $val,";
        }

        $tsv->{forgeHeaders}->{$vhost} = $tsv->{jail}->jail_reval("sub{$sub}");

        Lemonldap::NG::Handler::Main::Logger->lmLog(
            "$self: Unable to forge headers: $@: sub {$sub}", 'error' )
          if ($@);
    }
    return 1;
}

## @imethod protected void postUrlInit()
# Prepare methods to post form attributes
sub postUrlInit {
    my ( $class, $conf, $tsv ) = @_;
    return unless ( $conf->{post} );

    # Browse all vhost
    foreach my $vhost ( keys %{ $conf->{post} } ) {

        #  Browse all POST URI
        while ( my ( $url, $d ) = each( %{ $conf->{post}->{$vhost} } ) ) {
            Lemonldap::NG::Handler::Main::Logger->lmLog(
                "Compiling POST data for $url", 'debug' );

            # Where to POST
            my ( $postUrl, $jqueryUrl, $formSelector, $buttonSelector ) =
              split( /\|/, $d->{postUrl} );
            $postUrl ||= $url;

            my $sub;
            while ( my ( $input, $value ) = each( %{ $d->{expr} } ) ) {
                my $val = $class->substitute($value);
                $sub .= "'$input' => $val,";
            }
            $tsv->{inputPostData}->{$vhost}->{$postUrl} =
              $tsv->{outputPostData}->{$vhost}->{$url} =
              $tsv->{jail}->jail_reval("sub{$sub}");

            $tsv->{postFormParams}->{$vhost}->{$url} = {
                jqueryUrl      => $jqueryUrl,
                formSelector   => $formSelector,
                buttonSelector => $buttonSelector
            };
        }
    }
    return 1;
}

## @imethod protected codeRef conditionSub(string cond)
# Returns a compiled function used to grant users (used by
# locationRulesInit(). The second value returned is a non null
# constant if URL is not protected (by "unprotect" or "skip"), 0 else.
# @param $cond The boolean expression to use
# @param $mainClass  optional
# @return array (ref(sub), int)
sub conditionSub {
    my ( $class, $cond, $tsv ) = @_;
    my ( $OK, $NOK ) = ( sub { 1 }, sub { 0 } );

    # Simple cases : accept and deny
    return ( $OK, 0 )
      if ( $cond =~ /^accept$/i );
    return ( $NOK, 0 )
      if ( $cond =~ /^deny$/i );

    # Cases unprotect and skip : 2nd value is 1 or 2
    return ( $OK, UNPROTECT )
      if ( $cond =~ /^unprotect$/i );
    return ( $OK, SKIP )
      if ( $cond =~ /^skip$/i );

    # Case logout
    if ( $cond =~ /^logout(?:_sso)?(?:\s+(.*))?$/i ) {
        my $url = $1;
        return (
            $url
            ? (
                sub {
                    $Lemonldap::NG::Handler::Main::datas->{_logout} = $url;
                    return 0;
                },
                0
              )
            : (
                sub {
                    $Lemonldap::NG::Handler::Main::datas->{_logout} =
                      &{ $tsv->{portal} }();
                    return 0;
                },
                0
            )
        );
    }

    # Since filter exists only with Apache>=2, logout_app and logout_app_sso
    # targets are available only for it.
    # This error can also appear with Manager configured as CGI script
    if ( $cond =~ /^logout_app/i and MP() < 2 ) {
        Lemonldap::NG::Handler::Main::Logger->lmLog(
            "Rules logout_app and logout_app_sso require Apache>=2", 'warn' );
        return ( sub { 1 }, 0 );
    }

    # logout_app
    if ( $cond =~ /^logout_app(?:\s+(.*))?$/i ) {
        my $u = $1 || &{ $tsv->{portal} }();
        eval 'use Apache2::Filter' unless ( $INC{"Apache2/Filter.pm"} );
        return (
            sub {
                my $r = shift;
                $r->add_output_filter(
                    sub {
                        return Lemonldap::NG::Handler::Main->redirectFilter( $u,
                            @_ );
                    }
                );
                1;
            },
            0
        );
    }
    elsif ( $cond =~ /^logout_app_sso(?:\s+(.*))?$/i ) {
        eval 'use Apache2::Filter' unless ( $INC{"Apache2/Filter.pm"} );
        my $u = $1 || &{ $tsv->{portal} }();
        return (
            sub {
                my $r = shift;
                Lemonldap::NG::Handler::Main->localUnlog;
                $r->add_output_filter(
                    sub {
                        my $r = shift->r;
                        return Lemonldap::NG::Handler::Main->redirectFilter(
                            &{ $tsv->{portal} }() . "?url="
                              . Lemonldap::NG::Handler::Main->encodeUrl( $r,
                                $u )
                              . "&logout=1",
                            @_
                        );
                    }
                );
                1;
            },
            0
        );
    }

    # Replace some strings in condition
    $cond = $class->substitute($cond);
    my $sub = $tsv->{jail}->jail_reval("sub{return($cond)}");

    # Return sub and protected flag
    return ( $sub, 0 );
}

## @method arrayref aliasInit
# @param options vhostOptions configuration item
# @return arrayref of vhost and aliases
sub aliasInit {
    my ( $class, $conf, $tsv ) = @_;

    foreach my $vhost ( keys %{ $conf->{options} } ) {
        if ( my $aliases = $conf->{options}->{$vhost}->{vhostAliases} ) {
            foreach ( split /\s+/, $aliases ) {
                $tsv->{vhostAlias}->{$_} = $vhost;
            }
        }
    }
    return 1;
}

# TODO: support wildcards in aliases

sub substitute {
    my ( $class, $expr ) = @_;

    # substitute special vars, just for retro-compatibility
    $expr =~ s/\$date\b/&date/g;
    $expr =~ s/\$vhost\b/&hostname/g;
    $expr =~ s/\$ip\b/&remote_ip/g;

    # substitute vars with session datas, excepts special vars $_ and $\d+
    $expr =~ s/\$((?!_|\d+)\w+)/\$datas->{$1}/g;

    return $expr;
}

1;