e028088f88
This commit adds a new "Default" option for the global HTTPS setting. In this mode, the handler will refer to the HTTPS env variable to know if it's being accessed over HTTPS or not. An administrator is of course still free to force HTTPS by setting it either globally or per-VHost
573 lines
18 KiB
Perl
573 lines
18 KiB
Perl
package Lemonldap::NG::Handler::Main::Reload;
|
|
|
|
our $VERSION = '2.0.1';
|
|
|
|
package Lemonldap::NG::Handler::Main;
|
|
|
|
use strict;
|
|
use Lemonldap::NG::Common::Conf::Constants; #inherits
|
|
use Lemonldap::NG::Common::Crypto;
|
|
use Lemonldap::NG::Common::Safelib; #link protected safe Safe object
|
|
use Lemonldap::NG::Handler::Main::Jail;
|
|
use Scalar::Util qw(weaken);
|
|
|
|
use constant UNPROTECT => 1;
|
|
use constant SKIP => 2;
|
|
|
|
our @_onReload;
|
|
|
|
sub onReload {
|
|
my ( $class, $obj, $sub ) = @_;
|
|
weaken($obj);
|
|
push @_onReload, [ $obj, $sub ];
|
|
}
|
|
|
|
# CONFIGURATION UPDATE
|
|
|
|
## @rmethod protected int checkConf(boolean force)
|
|
# Check if configuration is up to date, and reload it if needed.
|
|
# If the optional boolean $force is set to true,
|
|
# * cached configuration is ignored
|
|
# * and checkConf returns false if it fails to load remote config
|
|
# @param $force boolean
|
|
# @return true if config is up to date or if reload config succeeded
|
|
sub checkConf {
|
|
my ( $class, $force ) = @_;
|
|
$class->logger->debug("Check configuration for $class");
|
|
my $prm = { local => !$force, localPrm => $class->localConfig };
|
|
my $conf = $class->confAcc->getConf($prm);
|
|
chomp $Lemonldap::NG::Common::Conf::msg;
|
|
|
|
unless ( ref($conf) ) {
|
|
$class->logger->error(
|
|
"$class: Unable to load configuration: $Lemonldap::NG::Common::Conf::msg"
|
|
);
|
|
return $force ? 0 : $class->cfgNum ? 1 : 0;
|
|
}
|
|
|
|
if ($Lemonldap::NG::Common::Conf::msg) {
|
|
if ( $Lemonldap::NG::Common::Conf::msg =~ /Error:/ ) {
|
|
$class->logger->error($Lemonldap::NG::Common::Conf::msg);
|
|
}
|
|
elsif ( $Lemonldap::NG::Common::Conf::msg =~ /Warn:/ ) {
|
|
$class->logger->warn($Lemonldap::NG::Common::Conf::msg);
|
|
}
|
|
else {
|
|
$class->logger->debug($Lemonldap::NG::Common::Conf::msg);
|
|
}
|
|
}
|
|
if ( $force or !$class->cfgNum or $class->cfgNum != $conf->{cfgNum} ) {
|
|
$class->logger->debug("Get configuration $conf->{cfgNum}");
|
|
unless ( $class->cfgNum( $conf->{cfgNum} ) ) {
|
|
$class->logger->error('No configuration available');
|
|
return 0;
|
|
}
|
|
$class->configReload($conf);
|
|
foreach (@_onReload) {
|
|
my ( $obj, $sub ) = @$_;
|
|
if ($obj) {
|
|
$class->logger->debug(
|
|
'Launching ' . ref($obj) . "->$sub(conf)" );
|
|
unless ( $obj->$sub($conf) ) {
|
|
$class->logger->error( "Underlying object can't load conf ("
|
|
. ref($obj)
|
|
. "->$sub)" );
|
|
}
|
|
}
|
|
}
|
|
}
|
|
$class->tsv->{checkTime} = $conf->{checkTime} if ( $conf->{checkTime} );
|
|
$class->lastCheck( time() );
|
|
$class->logger->debug("$class: configuration is up to date");
|
|
return 1;
|
|
}
|
|
|
|
# RELOAD SYSTEM
|
|
|
|
## @rmethod int reload
|
|
# Launch checkConf() with $local=0, so remote configuration is tested.
|
|
# Then build a simple HTTP response that just returns "200 OK" or
|
|
# "500 Server Error".
|
|
# @return Apache constant ($class->OK or $class->SERVER_ERROR)
|
|
sub reload {
|
|
my $class = shift;
|
|
$class->logger->notice("Request for configuration reload");
|
|
return $class->checkConf(1) ? $class->DONE : $class->SERVER_ERROR;
|
|
}
|
|
|
|
*refresh = *reload;
|
|
|
|
# INTERNAL METHODS
|
|
|
|
## @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)
|
|
# - cookieExpiration # warning: absent from default Conf
|
|
# - cookieName
|
|
# - securedCookie,
|
|
# - httpOnly
|
|
# - whatToTrace
|
|
# - customFunctions
|
|
# - timeoutActivity
|
|
# - timeoutActivityInterval
|
|
# - 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 ) = @_;
|
|
$class->logger->info(
|
|
"Loading configuration $conf->{cfgNum} for process $$");
|
|
|
|
foreach my $sub (
|
|
qw( defaultValuesInit jailInit portalInit locationRulesInit
|
|
sessionStorageInit headersInit postUrlInit aliasInit )
|
|
)
|
|
{
|
|
$class->logger->debug("Process $$ calls $sub");
|
|
$class->$sub($conf);
|
|
}
|
|
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 ) = @_;
|
|
|
|
$class->tsv->{jail} = Lemonldap::NG::Handler::Main::Jail->new(
|
|
{
|
|
useSafeJail => $conf->{useSafeJail},
|
|
customFunctions => $conf->{customFunctions},
|
|
}
|
|
);
|
|
$class->tsv->{jail}->build_jail( $class, $conf->{require} );
|
|
}
|
|
|
|
## @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 ) = @_;
|
|
|
|
$class->tsv->{$_} = $conf->{$_} foreach (
|
|
qw(
|
|
cookieExpiration cookieName customFunctions httpOnly
|
|
securedCookie timeout timeoutActivity
|
|
timeoutActivityInterval useRedirectOnError useRedirectOnForbidden
|
|
useSafeJail whatToTrace handlerInternalCache
|
|
)
|
|
);
|
|
|
|
$class->tsv->{cipher} = Lemonldap::NG::Common::Crypto->new( $conf->{key} );
|
|
|
|
foreach my $opt (qw(https port maintenance)) {
|
|
|
|
# Record default value in key '_'
|
|
$class->tsv->{$opt} = { _ => $conf->{$opt} };
|
|
|
|
# Override with vhost options
|
|
if ( $conf->{vhostOptions} ) {
|
|
my $name = 'vhost' . ucfirst($opt);
|
|
foreach my $vhost ( keys %{ $conf->{vhostOptions} } ) {
|
|
$conf->{vhostOptions}->{$vhost} ||= {};
|
|
my $val = $conf->{vhostOptions}->{$vhost}->{$name};
|
|
|
|
# Keep global value if $val is negative
|
|
if ( defined $val and $val >= 0 ) {
|
|
$class->logger->debug(
|
|
"Options $opt for vhost $vhost: $val");
|
|
$class->tsv->{$opt}->{$vhost} = $val;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
if ( $conf->{vhostOptions} ) {
|
|
foreach my $vhost ( keys %{ $conf->{vhostOptions} } ) {
|
|
$class->tsv->{type}->{$vhost} =
|
|
$conf->{vhostOptions}->{$vhost}->{vhostType};
|
|
$class->tsv->{authnLevel}->{$vhost} =
|
|
$conf->{vhostOptions}->{$vhost}->{vhostAuthnLevel};
|
|
}
|
|
}
|
|
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 ) = @_;
|
|
unless ( $conf->{portal} ) {
|
|
$class->logger->error("portal parameter required");
|
|
return 0;
|
|
}
|
|
if ( $conf->{portal} =~ /[\$\(&\|"']/ ) {
|
|
( $class->tsv->{portal} ) =
|
|
$class->conditionSub( $conf->{portal} );
|
|
}
|
|
else {
|
|
$class->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, $orules ) = @_;
|
|
|
|
$orules ||= $conf->{locationRules};
|
|
|
|
foreach my $vhost ( keys %$orules ) {
|
|
my $rules = $orules->{$vhost};
|
|
$class->tsv->{locationCount}->{$vhost} = 0;
|
|
foreach my $url ( sort keys %{$rules} ) {
|
|
my ( $cond, $prot ) = $class->conditionSub( $rules->{$url} );
|
|
unless ($cond) {
|
|
$class->tsv->{maintenance}->{$vhost} = 1;
|
|
$class->logger->error(
|
|
"Unable to build rule '$rules->{$url}': "
|
|
. $class->tsv->{jail}->error );
|
|
next;
|
|
}
|
|
|
|
if ( $url eq 'default' ) {
|
|
$class->tsv->{defaultCondition}->{$vhost} = $cond;
|
|
$class->tsv->{defaultProtection}->{$vhost} = $prot;
|
|
}
|
|
else {
|
|
push @{ $class->tsv->{locationCondition}->{$vhost} }, $cond;
|
|
push @{ $class->tsv->{locationProtection}->{$vhost} }, $prot;
|
|
push @{ $class->tsv->{locationRegexp}->{$vhost} }, qr/$url/;
|
|
push @{ $class->tsv->{locationConditionText}->{$vhost} },
|
|
$cond =~ /^\(\?#(.*?)\)/ ? $1
|
|
: $cond =~ /^(.*?)##(.+)$/ ? $2
|
|
: $url;
|
|
$class->tsv->{locationCount}->{$vhost}++;
|
|
}
|
|
}
|
|
|
|
# Default policy set to 'accept'
|
|
unless ( $class->tsv->{defaultCondition}->{$vhost} ) {
|
|
$class->tsv->{defaultCondition}->{$vhost} = sub { 1 };
|
|
$class->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 ) = @_;
|
|
unless ( $class->tsv->{sessionStorageModule} = $conf->{globalStorage} ) {
|
|
$class->logger->error("globalStorage required");
|
|
return 0;
|
|
}
|
|
eval "use " . $class->tsv->{sessionStorageModule};
|
|
die($@) if ($@);
|
|
$class->tsv->{sessionStorageOptions} = $conf->{globalStorageOptions};
|
|
|
|
if ( $conf->{localSessionStorage} ) {
|
|
$class->tsv->{sessionCacheModule} = $conf->{localSessionStorage};
|
|
$class->tsv->{sessionCacheOptions} =
|
|
$conf->{localSessionStorageOptions};
|
|
$class->tsv->{sessionCacheOptions}->{default_expires_in} ||= 600;
|
|
|
|
if ( $conf->{status} ) {
|
|
my $params = "";
|
|
if ( $class->tsv->{sessionCacheModule} ) {
|
|
require Data::Dumper;
|
|
$params = ' '
|
|
. $class->tsv->{sessionCacheModule} . ','
|
|
. Data::Dumper->new( [ $class->tsv->{sessionCacheOptions} ] )
|
|
->Terse(1)->Indent(0)->Dump; # To send params on one line
|
|
}
|
|
$class->tsv->{statusPipe}->print("RELOADCACHE $params\n");
|
|
}
|
|
}
|
|
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, $headers ) = @_;
|
|
$headers ||= $conf->{exportedHeaders};
|
|
|
|
# Creation of the subroutine which will generate headers
|
|
foreach my $vhost ( keys %{$headers} ) {
|
|
unless ($vhost) {
|
|
$class->logger->warn('Empty vhost in headers, skipping');
|
|
next;
|
|
}
|
|
$headers->{$vhost} ||= {};
|
|
my %headers = %{ $headers->{$vhost} };
|
|
$class->tsv->{headerList}->{$vhost} = [ keys %headers ];
|
|
my $sub = '';
|
|
foreach ( keys %headers ) {
|
|
my $val = $class->substitute( $headers{$_} );
|
|
$sub .= "('$_' => $val),";
|
|
}
|
|
|
|
unless ( $class->tsv->{forgeHeaders}->{$vhost} =
|
|
$class->buildSub($sub) )
|
|
{
|
|
$class->tsv->{maintenance}->{$vhost} = 1;
|
|
$class->logger->error( "$class Unable to forge headers: "
|
|
. $class->tsv->{jail}->error );
|
|
}
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
## @imethod protected void postUrlInit()
|
|
# Prepare methods to post form attributes
|
|
sub postUrlInit {
|
|
my ( $class, $conf ) = @_;
|
|
return unless ( $conf->{post} );
|
|
|
|
# Browse all vhost
|
|
foreach my $vhost ( keys %{ $conf->{post} } ) {
|
|
|
|
# Browse all POST URI
|
|
foreach my $url ( keys %{ $conf->{post}->{$vhost} || {} } ) {
|
|
my $d = $conf->{post}->{$vhost}->{$url};
|
|
$class->logger->debug("Compiling POST data for $url");
|
|
|
|
# Where to POST
|
|
$d->{target} ||= $url;
|
|
my $sub;
|
|
$d->{vars} ||= [];
|
|
foreach my $input ( @{ delete $d->{vars} } ) {
|
|
$sub .=
|
|
"'$input->[0]' => " . $class->substitute( $input->[1] ) . ",";
|
|
}
|
|
unless (
|
|
$class->tsv->{inputPostData}->{$vhost}->{ delete $d->{target} }
|
|
= $class->tsv->{outputPostData}->{$vhost}->{$url} =
|
|
$class->buildSub($sub) )
|
|
{
|
|
$class->tsv->{maintenance}->{$vhost} = 1;
|
|
$class->logger->error( "$class: Unable to build post data: "
|
|
. $class->tsv->{jail}->error );
|
|
}
|
|
|
|
$class->tsv->{postFormParams}->{$vhost}->{$url} = $d;
|
|
}
|
|
}
|
|
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 ) = @_;
|
|
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 {
|
|
$_[1]->{_logout} = $url;
|
|
return 0;
|
|
},
|
|
0
|
|
)
|
|
: (
|
|
sub {
|
|
$_[1]->{_logout} = $class->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 not $class->isa('Lemonldap::NG::Handler::ApacheMP2::Main') )
|
|
{
|
|
$class->logger->info(
|
|
"Rules logout_app and logout_app_sso require Apache>=2");
|
|
return ( sub { 1 }, 0 );
|
|
}
|
|
|
|
# logout_app
|
|
if ( $cond =~ /^logout_app(?:\s+(.*))?$/i ) {
|
|
my $u = $1 || $class->tsv->{portal}->();
|
|
eval 'use Apache2::Filter' unless ( $INC{"Apache2/Filter.pm"} );
|
|
return (
|
|
sub {
|
|
$_[0]->{env}->{'psgi.r'}->add_output_filter(
|
|
sub {
|
|
return $class->redirectFilter( $u, @_ );
|
|
}
|
|
);
|
|
1;
|
|
},
|
|
0
|
|
);
|
|
}
|
|
elsif ( $cond =~ /^logout_app_sso(?:\s+(.*))?$/i ) {
|
|
my $u = $1 || $class->tsv->{portal}->();
|
|
eval 'use Apache2::Filter' unless ( $INC{"Apache2/Filter.pm"} );
|
|
return (
|
|
sub {
|
|
|
|
my ($req) = @_;
|
|
$class->localUnlog;
|
|
$req->{env}->{'psgi.r'}->add_output_filter(
|
|
sub {
|
|
my $r = $_[0]->r;
|
|
return $class->redirectFilter(
|
|
&{ $class->tsv->{portal} }() . "?url="
|
|
. $class->encodeUrl( $req, $u )
|
|
. "&logout=1",
|
|
@_
|
|
);
|
|
}
|
|
);
|
|
1;
|
|
},
|
|
0
|
|
);
|
|
}
|
|
|
|
# Replace some strings in condition
|
|
$cond = $class->substitute($cond);
|
|
my $sub;
|
|
unless ( $sub = $class->buildSub($cond) ) {
|
|
$class->logger->error( "$class: Unable to build condition ($cond): "
|
|
. $class->tsv->{jail}->error );
|
|
}
|
|
|
|
# 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 ) = @_;
|
|
|
|
foreach my $vhost ( keys %{ $conf->{vhostOptions} || {} } ) {
|
|
if ( my $aliases = $conf->{vhostOptions}->{$vhost}->{vhostAliases} ) {
|
|
foreach ( split /\s+/, $aliases ) {
|
|
$class->tsv->{vhostAlias}->{$_} = $vhost;
|
|
$class->logger->debug("Registering $_ as alias of $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/sg;
|
|
$expr =~ s/\$vhost\b/\$ENV{HTTP_HOST}/sg;
|
|
$expr =~ s/\$ip\b/\$ENV{REMOTE_ADDR}/sg;
|
|
|
|
# substitute vars with session data, excepts special vars $_ and $\d+
|
|
$expr =~ s/\$(?!(?:ENV|env)\b)([_a-zA-Z]\w*)/\$s->{$1}/sg;
|
|
$expr =~ s/\$ENV\{/\$r->{env}->\{/g;
|
|
$expr =~ s/\$env->\{/\$r->{env}->\{/g;
|
|
|
|
return $expr;
|
|
}
|
|
|
|
sub buildSub {
|
|
my ( $class, $val ) = @_;
|
|
my $res =
|
|
$class->tsv->{jail}->jail_reval("sub{my (\$r,\$s)=\@_;return($val)}");
|
|
unless ($res) {
|
|
$class->logger->error( $class->tsv->{jail}->error );
|
|
}
|
|
return $res;
|
|
}
|
|
|
|
1;
|