# 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():
# - 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 ) = @_;

    $class->jailInit          ( $conf, $tsv );
    $class->defaultValuesInit ( $conf, $tsv );
    $class->portalInit        ( $conf, $tsv );
    $class->locationRulesInit ( $conf, $tsv );
    $class->sessionStorageInit( $conf, $tsv );
    $class->headersInit       ( $conf, $tsv );
#    $class->postUrlInit       ( $conf, $tsv );
    $class->aliasInit         ( $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(
        'safe'            => undef,
        'useSafeJail'     => $conf->{useSafeJail},
        'customFunctions' => $conf->{customFunctions}
    );
    $tsv->{jail}->build_safe();
}

## @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} },
                  /^\(\?#(.*?)\)/ ? $1 : /^(.*?)##(.+)$/ ? $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 ( $self, $transform, $args ) = splice @_;

    # Do nothing if no POST configured
    return unless ( $args->{post} );

    # Load required modules
    eval 'use Apache2::Filter;use URI';

    # Prepare transform sub
    $transform = {};

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

        foreach
          my $alias ( @{ $self->getAliases( $vhost, $args->{vhostOptions} ) } )
        {

            my $mypost = $args->{post}->{$vhost};

            #  Browse all POST URI
            while ( my ( $url, $d ) = each( %{ $args->{post}->{$vhost} } ) ) {

                # Where to POST
                $d->{postUrl} ||= $url;

                # Register POST form for POST URL
                $transform->{$alias}->{$url} = sub {
                    my $r = shift;
                    Lemonldap::NG::Handler::Main::PostForm->buildPostForm(
                        $r, $d->{postUrl} );
                  }
                  if ( $url ne $d->{postUrl} );

                # Get datas to POST
                my $expr = $d->{expr};
                my %postdata;

                # Manage old and new configuration format
                # OLD: expr => 'param1 => value1, param2 => value2',
                # NEW : expr => { param1 => value1, param2 => value2 },
                if ( ref $expr eq 'HASH' ) {
                    %postdata = %$expr;
                }
                else {
                    %postdata = split /(?:\s*=>\s*|\s*,\s*)/, $expr;
                }

                # Build string for URI::query_form
                my $tmp;
                foreach ( keys %postdata ) {
                    $postdata{$_} =~ s/\$(\w+)/\$datas->{$1}/g;
                    $postdata{$_} = "'$postdata{$_}'"
                      if ( $postdata{$_} =~ /^\w+$/ );
                    $tmp .= "'$_'=>$postdata{$_},";
                }

                Lemonldap::NG::Handler::Main::Logger->lmLog(
                    "Compiling POST request for $url", 'debug' );
                $transform->{$alias}->{ $d->{postUrl} } = sub {
                    my $r = shift;
                    return
                      Lemonldap::NG::Handler::Main::PostForm->buildPostForm(
                        $r, $d->{postUrl} )
                      if ( $r->method ne 'POST' );
                    $r->add_input_filter(
                        sub {
                            Lemonldap::NG::Handler::Main::PostForm->postFilter(
                                $tmp, @_ );
                        }
                    );
                    OK;
                };
            }
        }
    }
    return $transform;
}

## @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 fake env vars
    # is /e necessary at end of sub ?
    $expr =~ s/\$ENV{TIME}/time/g;
    $expr =~ s/\$ENV{DATE}/&POSIX::strftime("%Y%m%d%H%M%S",localtime)/g;
    $expr =~ s/\$ENV{SERVER_NAME}/Lemonldap::NG::Handler::API->hostname/g;
    $expr =~ s/\$ENV{(IP|REMOTE_ADDR)}/Lemonldap::NG::Handler::API->remote_addr/g;
    $expr =~ s/\$ENV{REQUEST_URI}/Lemonldap::NG::Handler::API->uri/g;
    $expr =~ s/\$ENV{QUERY_STRING}/Lemonldap::NG::Handler::API->args/g;
    $expr =~ s/\$ENV{REQUEST_METHOD}/Lemonldap::NG::Handler::API->request_method/g;
    #TODO: substitute $ENV{HTTP_*} with corresponding header

    # substitute fake env vars - kept for retro-compatibility
    $expr =~ s/\$date/&POSIX::strftime("%Y%m%d%H%M%S",localtime)/g;
    $expr =~ s/\$vhost/Lemonldap::NG::Handler::API->hostname/g;
    $expr =~ s/\$ip/Lemonldap::NG::Handler::API->remote_addr/g;

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

    return $expr;
}

1;