f6bc0bd81f
(references #630 and complements r3410)
505 lines
17 KiB
Perl
Executable File
505 lines
17 KiB
Perl
Executable File
package Lemonldap::NG::Handler::Initialization::GlobalInit;
|
|
|
|
#use Lemonldap::NG::Handler::Main qw(:all);
|
|
use Lemonldap::NG::Common::Safelib; #link protected safe Safe object
|
|
use Safe;
|
|
use constant UNPROTECT => 1;
|
|
use constant SKIP => 2;
|
|
|
|
use Mouse;
|
|
|
|
use Lemonldap::NG::Handler::Main::Jail;
|
|
use Lemonldap::NG::Handler::Main::Logger;
|
|
use Lemonldap::NG::Handler::API qw(:httpCodes);
|
|
|
|
our $VERSION = '1.4.0';
|
|
|
|
has customFunctions => ( is => 'rw', isa => 'Maybe[Str]' );
|
|
|
|
has useSafeJail => ( is => 'rw', isa => 'Maybe[Int]' );
|
|
|
|
has safe => ( is => 'rw' );
|
|
|
|
|
|
## @imethod protected void defaultValuesInit(hashRef args)
|
|
# Set default values for non-customized variables
|
|
# @param $args reference to the configuration hash
|
|
sub defaultValuesInit {
|
|
|
|
my (
|
|
$self, $cookieName, $securedCookie,
|
|
$whatToTrace, $https, $port,
|
|
$customFunctions, $timeoutActivity, $useRedirectOnError,
|
|
$useRedirectOnForbidden, $useSafeJail, $key,
|
|
$maintenance, $cda, $httpOnly,
|
|
$cookieExpiration, $cipher, $args,
|
|
) = splice @_;
|
|
foreach my $t (qw(https port maintenance)) {
|
|
|
|
# Skip Handler initialization (values not defined)
|
|
next unless defined $args->{$t};
|
|
|
|
# Record default value in key '_'
|
|
$args->{$t} = { _ => $args->{$t} } unless ( ref( $args->{$t} ) );
|
|
|
|
# Override with vhost options
|
|
if ( defined $args->{vhostOptions} ) {
|
|
my $n = 'vhost' . ucfirst($t);
|
|
foreach my $k ( keys %{ $args->{vhostOptions} } ) {
|
|
foreach my $alias (
|
|
@{ $self->getAliases( $k, $args->{vhostOptions} ) } )
|
|
{
|
|
my $v = $args->{vhostOptions}->{$k}->{$n};
|
|
Lemonldap::NG::Handler::Main::Logger->lmLog(
|
|
"Options $t for vhost $alias: $v", 'debug' );
|
|
$args->{$t}->{$alias} = $v
|
|
if ( $v >= 0 ); # Keep default value if $v is negative
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
# Default values are defined in Common::Conf::Attributes
|
|
# These values should be erased by global configuration
|
|
$cookieName = $args->{cookieName} || $cookieName;
|
|
$securedCookie =
|
|
defined( $args->{securedCookie} )
|
|
? $args->{securedCookie}
|
|
: $securedCookie;
|
|
$whatToTrace = $args->{whatToTrace} || $whatToTrace;
|
|
$https = defined($https) ? $https : $args->{https};
|
|
$port ||= $args->{port};
|
|
$customFunctions = $args->{customFunctions};
|
|
$self->customFunctions($customFunctions);
|
|
$cda = defined($cda) ? $cda : $args->{cda};
|
|
$httpOnly = defined($httpOnly) ? $httpOnly : $args->{httpOnly};
|
|
$cookieExpiration = $args->{cookieExpiration} || $cookieExpiration;
|
|
$timeoutActivity = $args->{timeoutActivity} || $timeoutActivity;
|
|
$useRedirectOnError =
|
|
defined($useRedirectOnError)
|
|
? $useRedirectOnError
|
|
: $args->{useRedirectOnError};
|
|
$useRedirectOnForbidden =
|
|
defined($useRedirectOnForbidden)
|
|
? $useRedirectOnForbidden
|
|
: $args->{useRedirectOnForbidden};
|
|
$useSafeJail =
|
|
defined($useSafeJail)
|
|
? $useSafeJail
|
|
: $args->{useSafeJail};
|
|
$self->useSafeJail($useSafeJail);
|
|
$key ||= 'lemonldap-ng-key';
|
|
$cipher ||= Lemonldap::NG::Common::Crypto->new($key);
|
|
|
|
if ( $args->{key} && ( $args->{key} ne $key ) ) {
|
|
$key = $args->{key};
|
|
$cipher = Lemonldap::NG::Common::Crypto->new($key);
|
|
}
|
|
|
|
$maintenance = defined($maintenance) ? $maintenance : $args->{maintenance};
|
|
|
|
return (
|
|
$cookieName, $securedCookie, $whatToTrace,
|
|
$https, $port, $customFunctions,
|
|
$timeoutActivity, $useRedirectOnError, $useRedirectOnForbidden,
|
|
$useSafeJail, $key, $maintenance,
|
|
$cda, $httpOnly, $cookieExpiration,
|
|
$cipher
|
|
);
|
|
1;
|
|
}
|
|
|
|
## @imethod protected void portalInit(hashRef args)
|
|
# Verify that portal variable exists. Die unless
|
|
# @param $args reference to the configuration hash
|
|
sub portalInit {
|
|
my ( $self, $mainClass, $args ) = splice @_;
|
|
die("portal parameter required") unless ( $args->{portal} );
|
|
if ( $args->{portal} =~ /[\$\(&\|"']/ ) {
|
|
my ($portal) = $self->conditionSub( $mainClass, $args->{portal} );
|
|
eval "sub portal {return &\$portal}";
|
|
}
|
|
else {
|
|
eval "sub portal {return '$args->{portal}'}";
|
|
}
|
|
die("Unable to read portal parameter ($@)") if ($@);
|
|
return ( \&portal, $self->{safe} );
|
|
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 (
|
|
$self, $mainClass, $locationCount,
|
|
$defaultCondition, $defaultProtection, $locationCondition,
|
|
$locationProtection, $locationRegexp, $locationConditionText,
|
|
$args
|
|
) = splice @_;
|
|
foreach my $vhost ( keys %{ $args->{locationRules} } ) {
|
|
foreach
|
|
my $alias ( @{ $self->getAliases( $vhost, $args->{vhostOptions} ) } )
|
|
{
|
|
$locationCount->{$alias} = 0;
|
|
foreach ( sort keys %{ $args->{locationRules}->{$vhost} } ) {
|
|
if ( $_ eq 'default' ) {
|
|
(
|
|
$defaultCondition->{$alias},
|
|
$defaultProtection->{$alias}
|
|
)
|
|
= $self->conditionSub( $mainClass,
|
|
$args->{locationRules}->{$vhost}->{$_} );
|
|
}
|
|
else {
|
|
(
|
|
$locationCondition->{$alias}
|
|
->[ $locationCount->{$alias} ],
|
|
$locationProtection->{$alias}
|
|
->[ $locationCount->{$alias} ]
|
|
)
|
|
= $self->conditionSub( $mainClass,
|
|
$args->{locationRules}->{$vhost}->{$_} );
|
|
$locationRegexp->{$alias}->[ $locationCount->{$alias} ] =
|
|
qr/$_/;
|
|
$locationConditionText->{$alias}
|
|
->[ $locationCount->{$alias} ] =
|
|
/^\(\?#(.*?)\)/ ? $1 : /^(.*?)##(.+)$/ ? $2 : $_;
|
|
$locationCount->{$alias}++;
|
|
}
|
|
}
|
|
|
|
# Default police
|
|
( $defaultCondition->{$alias}, $defaultProtection->{$alias} ) =
|
|
$self->conditionSub( $mainClass, 'accept' )
|
|
unless ( $defaultCondition->{$alias} );
|
|
}
|
|
|
|
}
|
|
|
|
return (
|
|
$locationCount, $defaultCondition, $defaultProtection,
|
|
$locationCondition, $locationProtection, $locationRegexp,
|
|
$locationConditionText, $self->{safe}
|
|
);
|
|
1;
|
|
}
|
|
|
|
## @imethod protected void globalStorageInit(hashRef args)
|
|
# Initialize the Apache::Session::* module choosed to share user's variables.
|
|
# @param $args reference to the configuration hash
|
|
sub globalStorageInit {
|
|
my ( $self, $globalStorage, $globalStorageOptions, $args ) = splice @_;
|
|
$globalStorage = $args->{globalStorage}
|
|
or die("globalStorage required");
|
|
eval "use $globalStorage;";
|
|
die($@) if ($@);
|
|
$globalStorageOptions = $args->{globalStorageOptions};
|
|
return ( $globalStorage, $globalStorageOptions );
|
|
}
|
|
|
|
## @imethod protected void localSessionStorageInit(hashRef args)
|
|
# Initialize the Cache::Cache module choosed to cache sessions.
|
|
# @param $args reference to the configuration hash
|
|
sub localSessionStorageInit {
|
|
my ( $self, $localSessionStorage, $localSessionStorageOptions, $args ) =
|
|
splice @_;
|
|
$localSessionStorage = $args->{localSessionStorage};
|
|
$localSessionStorageOptions = $args->{localSessionStorageOptions};
|
|
return ( $localSessionStorage, $localSessionStorageOptions );
|
|
}
|
|
|
|
## @imethod void headerListInit(hashRef args)
|
|
# Lists the exported HTTP headers into $headerList
|
|
# @param $args reference to the configuration hash
|
|
sub headerListInit {
|
|
my ( $self, $headerList, $args ) = splice @_;
|
|
|
|
foreach my $vhost ( keys %{ $args->{exportedHeaders} } ) {
|
|
foreach
|
|
my $alias ( @{ $self->getAliases( $vhost, $args->{vhostOptions} ) } )
|
|
{
|
|
my @tmp = keys %{ $args->{exportedHeaders}->{$vhost} };
|
|
$headerList->{$alias} = \@tmp;
|
|
}
|
|
}
|
|
return $headerList;
|
|
1;
|
|
}
|
|
|
|
## @imethod void forgeHeadersInit(hashRef args)
|
|
# Create the &$forgeHeaders->{<virtualhost>} subroutines used to insert
|
|
# headers into the HTTP request.
|
|
# @param $args reference to the configuration hash
|
|
sub forgeHeadersInit {
|
|
my ( $self, $forgeHeaders, $args ) = splice @_;
|
|
|
|
# Creation of the subroutine which will generate headers
|
|
foreach my $vhost ( keys %{ $args->{exportedHeaders} } ) {
|
|
foreach
|
|
my $alias ( @{ $self->getAliases( $vhost, $args->{vhostOptions} ) } )
|
|
{
|
|
my %tmp = %{ $args->{exportedHeaders}->{$vhost} };
|
|
foreach ( keys %tmp ) {
|
|
$tmp{$_} =~ s/\$(\w+)/\$datas->{$1}/g;
|
|
$tmp{$_} = $self->regRemoteIp( $tmp{$_} );
|
|
}
|
|
|
|
my $sub;
|
|
foreach ( keys %tmp ) {
|
|
$sub .= "'$_' => join('',split(/[\\r\\n]+/,$tmp{$_})),";
|
|
}
|
|
|
|
my $jail = Lemonldap::NG::Handler::Main::Jail->new(
|
|
'safe' => $self->safe,
|
|
'useSafeJail' => $self->useSafeJail,
|
|
'customFunctions' => $self->customFunctions
|
|
);
|
|
$self->safe( $jail->build_safe() );
|
|
$forgeHeaders->{$alias} = $jail->jail_reval("sub{$sub}");
|
|
|
|
Lemonldap::NG::Handler::Main::Logger->lmLog(
|
|
"$self: Unable to forge headers: $@: sub {$sub}", 'error' )
|
|
if ($@);
|
|
}
|
|
|
|
}
|
|
return $forgeHeaders;
|
|
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 $apacheRequest = shift;
|
|
Lemonldap::NG::Handler::Main::PostForm->buildPostForm(
|
|
$apacheRequest, $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 $apacheRequest = shift;
|
|
return
|
|
Lemonldap::NG::Handler::Main::PostForm->buildPostForm(
|
|
$apacheRequest, $d->{postUrl} )
|
|
if ( $apacheRequest->method ne 'POST' );
|
|
$apacheRequest->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
|
|
# @return array (ref(sub), int)
|
|
sub conditionSub {
|
|
my ( $self, $mainClass, $cond ) = splice @_;
|
|
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} =
|
|
$self->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 || $self->portal();
|
|
eval 'use Apache2::Filter' unless ( $INC{"Apache2/Filter.pm"} );
|
|
return (
|
|
sub {
|
|
my $apacheRequest = shift;
|
|
$apacheRequest->add_output_filter(
|
|
sub {
|
|
return $mainClass->redirectFilter( $u, @_ );
|
|
}
|
|
);
|
|
1;
|
|
},
|
|
0
|
|
);
|
|
}
|
|
elsif ( $cond =~ /^logout_app_sso(?:\s+(.*))?$/i ) {
|
|
eval 'use Apache2::Filter' unless ( $INC{"Apache2/Filter.pm"} );
|
|
my $u = $1 || $self->portal();
|
|
return (
|
|
sub {
|
|
my $apacheRequest = shift;
|
|
$mainClass->localUnlog;
|
|
$apacheRequest->add_output_filter(
|
|
sub {
|
|
my $apacheRequest = shift->r;
|
|
return $mainClass->redirectFilter(
|
|
$self->portal() . "?url="
|
|
. $mainClass->encodeUrl( $apacheRequest, $u )
|
|
. "&logout=1",
|
|
@_
|
|
);
|
|
}
|
|
);
|
|
1;
|
|
},
|
|
0
|
|
);
|
|
}
|
|
|
|
# Replace some strings in condition
|
|
$cond =~ s/\$date/&POSIX::strftime("%Y%m%d%H%M%S",localtime())/e;
|
|
$cond =~ s/\$(\w+)/\$datas->{$1}/g;
|
|
$cond =~ s/\$datas->{vhost}/Lemonldap::NG::Handler::API->hostname(\$apacheRequest)/g;
|
|
|
|
my $jail = Lemonldap::NG::Handler::Main::Jail->new(
|
|
'safe' => $self->safe,
|
|
'useSafeJail' => $self->useSafeJail,
|
|
'customFunctions' => $self->customFunctions
|
|
);
|
|
$self->safe( $jail->build_safe() );
|
|
my $sub = $jail->jail_reval("sub{return($cond)}");
|
|
|
|
# Return sub and protected flag
|
|
return ( $sub, 0 );
|
|
}
|
|
|
|
## @method arrayref getAliases(scalar vhost, hashref options)
|
|
# Check aliases of a vhost
|
|
# @param vhost vhost name
|
|
# @param options vhostOptions configuration item
|
|
# @return arrayref of vhost and aliases
|
|
sub getAliases {
|
|
my ( $self, $vhost, $options ) = splice @_;
|
|
my $aliases = [$vhost];
|
|
|
|
if ( $options->{$vhost}->{vhostAliases} ) {
|
|
foreach ( split /\s+/, $options->{$vhost}->{vhostAliases} ) {
|
|
push @$aliases, $_;
|
|
Lemonldap::NG::Handler::Main::Logger->lmLog(
|
|
"$_ is an alias for $vhost", 'debug' );
|
|
}
|
|
}
|
|
|
|
return $aliases;
|
|
}
|
|
|
|
## @ifn protected string protected regRemoteIp(string str)
|
|
# Replaces $ip by the client IP address in the string
|
|
# @param $str string
|
|
# @return string
|
|
sub regRemoteIp {
|
|
my ( $self, $str ) = splice @_;
|
|
$str =~ s/\$datas->\{ip\}/ip()/g;
|
|
return $str;
|
|
}
|
|
|
|
1;
|