code impacted: * lemonldap-ng-handler/*: handler code, * lemonldap-ng-handler/example/*.pm: handler aliases to libraries, * _example/etc/*.conf: virtual host templates (references #630, #LEMONLDAP-386) (second part of incomplete r3251 commit)environments/ppa-mbqj77/deployments/1
David COUTADEUR
12 years ago
parent
87b25795bd
commit
b3d05721a8
@ -0,0 +1,399 @@ |
||||
## @file |
||||
# Main handler. |
||||
|
||||
## @class |
||||
# Main handler. |
||||
# All methods in handler are class methods: in ModPerl environment, handlers |
||||
# are always launched without object created. |
||||
# |
||||
# The main method is run() who is called by Apache for each requests (using |
||||
# handler() wrapper). |
||||
# |
||||
# The initialization process is splitted in two parts : |
||||
# - init() is launched as Apache startup |
||||
# - globalInit() is launched at each first request received by an Apache child |
||||
# and each time a new configuration is detected |
||||
package Lemonldap::NG::Handler::DefaultHandler; |
||||
|
||||
#use strict; |
||||
|
||||
use Lemonldap::NG::Handler::Main qw(:all); |
||||
use Lemonldap::NG::Handler::Initialization::GlobalInit; |
||||
|
||||
#use Lemonldap::NG::Handler::Vhost; |
||||
use Lemonldap::NG::Common::Conf; #link protected lmConf |
||||
use Lemonldap::NG::Common::Conf::Constants; #inherits |
||||
use Cache::Cache qw($EXPIRES_NEVER); |
||||
use Lemonldap::NG::Handler::Main::Logger; |
||||
|
||||
use Mouse; |
||||
|
||||
extends qw(Lemonldap::NG::Handler::Main); # Lemonldap::NG::Handler::Vhost |
||||
|
||||
#use base qw(Lemonldap::NG::Handler::Vhost Lemonldap::NG::Handler::Main); |
||||
|
||||
#parameter reloadTime Time in second between 2 configuration check (600) |
||||
|
||||
our $VERSION = '1.1.1'; |
||||
our $cfgNum = 0; |
||||
our $lastReload = 0; |
||||
our $reloadTime; |
||||
our $lmConf; |
||||
our $localConfig; |
||||
|
||||
BEGIN { |
||||
if ( MP() == 2 ) { |
||||
eval { |
||||
require threads::shared; |
||||
Apache2::RequestUtil->import(); |
||||
threads::shared::share($cfgNum); |
||||
threads::shared::share($lastReload); |
||||
threads::shared::share($reloadTime); |
||||
threads::shared::share($lmConf); |
||||
threads::shared::share($localConfig); |
||||
}; |
||||
} |
||||
*EXPORT_TAGS = *Lemonldap::NG::Handler::Main::EXPORT_TAGS; |
||||
*EXPORT_OK = *Lemonldap::NG::Handler::Main::EXPORT_OK; |
||||
push( |
||||
@{ $EXPORT_TAGS{$_} }, |
||||
qw($cfgNum $lastReload $reloadTime $lmConf $localConfig) |
||||
) foreach (qw(variables localStorage)); |
||||
push @EXPORT_OK, qw($cfgNum $lastReload $reloadTime $lmConf $localConfig); |
||||
} |
||||
|
||||
# INIT PROCESS |
||||
|
||||
## @imethod void init(hashRef args) |
||||
# Constructor. |
||||
# init is overloaded to call only localInit. globalInit is called later. |
||||
# @param $args hash containing parameters |
||||
sub init($$) { |
||||
my ( $class, $args ) = splice @_; |
||||
|
||||
# TODO reloadTime in defaultValuesInit ? |
||||
$reloadTime = $args->{reloadTime} || 600; |
||||
$class->localInit($args); |
||||
} |
||||
|
||||
## @imethod protected void defaultValuesInit(hashRef args) |
||||
# Set default values for non-customized variables |
||||
# @param $args hash containing parameters |
||||
# @return boolean |
||||
sub defaultValuesInit { |
||||
my ( $class, $args ) = splice @_; |
||||
|
||||
# Local configuration overrides global configuration |
||||
my %h = ( %$args, %$localConfig ); |
||||
|
||||
#return $class->SUPER::defaultValuesInit( \%h ); |
||||
|
||||
my $globalinit = Lemonldap::NG::Handler::Initialization::GlobalInit->new( |
||||
customFunctions => $tsv->{customFunctions}, |
||||
useSafeJail => $tsv->{useSafeJail}, |
||||
); |
||||
|
||||
( |
||||
@$tsv{ |
||||
qw( cookieName securedCookie whatToTrace |
||||
https port customFunctions |
||||
timeoutActivity useRedirectOnError useRedirectOnForbidden |
||||
useSafeJail key maintenance ) |
||||
}, |
||||
@$ntsv{ |
||||
qw( cda httpOnly cookieExpiration |
||||
cipher |
||||
) |
||||
} |
||||
) |
||||
= $globalinit->defaultValuesInit( |
||||
@$tsv{ |
||||
qw( cookieName securedCookie whatToTrace |
||||
https port customFunctions |
||||
timeoutActivity useRedirectOnError useRedirectOnForbidden |
||||
useSafeJail key maintenance ) |
||||
}, |
||||
@$ntsv{ |
||||
qw( cda httpOnly cookieExpiration |
||||
cipher ) |
||||
}, |
||||
\%h |
||||
); |
||||
|
||||
} |
||||
|
||||
## @imethod void localInit(hashRef args) |
||||
# Load parameters and build the Lemonldap::NG::Common::Conf object. |
||||
# @return boolean |
||||
sub localInit { |
||||
my ( $class, $args ) = splice @_; |
||||
die( |
||||
"$class : unable to build configuration : $Lemonldap::NG::Common::Conf::msg" |
||||
) |
||||
unless ( $lmConf = |
||||
Lemonldap::NG::Common::Conf->new( $args->{configStorage} ) ); |
||||
|
||||
# Get local configuration parameters |
||||
my $localconf = $lmConf->getLocalConf(HANDLERSECTION); |
||||
if ($localconf) { |
||||
$args->{$_} ||= $localconf->{$_} foreach ( keys %$localconf ); |
||||
} |
||||
|
||||
# Store in localConfig global variable |
||||
$localConfig = $args; |
||||
|
||||
# localStorage can be declared in configStorage or at the root or both |
||||
foreach (qw(localStorage localStorageOptions)) { |
||||
$args->{$_} ||= $args->{configStorage}->{$_} || $lmConf->{$_}; |
||||
$args->{configStorage}->{$_} ||= $args->{$_}; |
||||
} |
||||
|
||||
$class->defaultValuesInit($args); |
||||
$class->SUPER::localInit($args); |
||||
} |
||||
|
||||
# MAIN |
||||
|
||||
## @rmethod int run(Apache2::RequestRec r) |
||||
# Check configuration and launch Lemonldap::NG::Handler::Main::run(). |
||||
# Each $reloadTime, the Apache child verify if its configuration is the same |
||||
# as the configuration stored in the local storage. |
||||
# @param $r Apache2::RequestRec object |
||||
# @return Apache constant |
||||
sub run($$) { |
||||
my ( $class, $r ) = splice @_; |
||||
if ( time() - $lastReload > $reloadTime ) { |
||||
die("$class: No configuration found") |
||||
unless ( $class->testConf(1) == OK ); |
||||
} |
||||
return $class->SUPER::run($r); |
||||
} |
||||
|
||||
# CONFIGURATION UPDATE |
||||
|
||||
## @rmethod protected int testConf(boolean local) |
||||
# Test if configuration has changed and launch setConf() if needed. |
||||
# If the optional boolean $local is true, remote configuration is not tested: |
||||
# only local cached configuration is tested if available. $local is given to |
||||
# Lemonldap::NG::Common::getConf() |
||||
# @param $local boolean |
||||
# @return Apache constant |
||||
sub testConf { |
||||
my ( $class, $local ) = splice @_; |
||||
my $conf = $lmConf->getConf( { local => $local } ); |
||||
unless ( ref($conf) ) { |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"$class: Unable to load configuration: $Lemonldap::NG::Common::Conf::msg", |
||||
'error' |
||||
); |
||||
return $cfgNum ? OK : SERVER_ERROR; |
||||
} |
||||
if ( !$cfgNum or $cfgNum != $conf->{cfgNum} ) { |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"$class: get configuration $conf->{cfgNum} ($Lemonldap::NG::Common::Conf::msg)", |
||||
'debug' |
||||
); |
||||
$lastReload = time(); |
||||
return $class->setConf($conf); |
||||
} |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"$class: configuration is up to date", 'debug' ); |
||||
OK; |
||||
} |
||||
|
||||
## @rmethod protected int setConf(hashRef conf) |
||||
# Launch globalInit(). |
||||
# Local parameters have best precedence on configuration parameters. |
||||
# @return Apache constant |
||||
sub setConf { |
||||
my ( $class, $conf ) = splice @_; |
||||
|
||||
# Local configuration overrides global configuration |
||||
$cfgNum = $conf->{cfgNum}; |
||||
$conf->{$_} = $localConfig->{$_} foreach ( keys %$localConfig ); |
||||
$class->globalInit($conf); |
||||
OK; |
||||
} |
||||
|
||||
# RELOAD SYSTEM |
||||
|
||||
*reload = *refresh; |
||||
|
||||
## @rmethod int refresh(Apache::RequestRec r) |
||||
# Launch testConf() with $local=0, so remote configuration is tested. |
||||
# Then build a simple HTTP response that just returns "200 OK" or |
||||
# "500 Server Error". |
||||
# @param $r current request |
||||
# @return Apache constant (OK or SERVER_ERROR) |
||||
sub refresh($$) { |
||||
my ( $class, $r ) = splice @_; |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"$class: request for configuration reload", 'notice' ); |
||||
$r->handler("perl-script"); |
||||
if ( $class->testConf(0) == OK ) { |
||||
if ( MP() == 2 ) { |
||||
$r->push_handlers( 'PerlResponseHandler' => |
||||
sub { my $r = shift; $r->content_type('text/plain'); OK } ); |
||||
} |
||||
elsif ( MP() == 1 ) { |
||||
$r->push_handlers( |
||||
'PerlHandler' => sub { my $r = shift; $r->send_http_header; OK } |
||||
); |
||||
} |
||||
else { |
||||
return 1; |
||||
} |
||||
} |
||||
else { |
||||
if ( MP() == 2 ) { |
||||
$r->push_handlers( 'PerlResponseHandler' => sub { SERVER_ERROR } ); |
||||
} |
||||
elsif ( MP() == 1 ) { |
||||
$r->push_handlers( 'PerlHandler' => sub { SERVER_ERROR } ); |
||||
} |
||||
else { |
||||
return 0; |
||||
} |
||||
} |
||||
return OK; |
||||
} |
||||
|
||||
__PACKAGE__->init( {} ); |
||||
|
||||
1; |
||||
__END__ |
||||
|
||||
=head1 NAME |
||||
|
||||
=encoding utf8 |
||||
|
||||
Lemonldap::NG::Handler::DefaultHandler - Perl extension to use dynamic |
||||
configuration provide by Lemonldap::NG::Manager. |
||||
|
||||
=head1 SYNOPSIS |
||||
|
||||
package My::Package; |
||||
use Lemonldap::NG::Handler::DefaultHandler; |
||||
@ISA = qw(Lemonldap::NG::Handler::DefaultHandler); |
||||
__PACKAGE__->init ( { |
||||
localStorage => "Cache::FileCache", |
||||
localStorageOptions => { |
||||
'namespace' => 'lemonldap-ng', |
||||
'default_expires_in' => 600, |
||||
}, |
||||
configStorage => { |
||||
type => "DBI" |
||||
dbiChain => "DBI:mysql:database=$database;host=$hostname;port=$port", |
||||
dbiUser => "lemonldap", |
||||
dbiPassword => "password", |
||||
}, |
||||
} ); |
||||
|
||||
Call your package in /apache-dir/conf/httpd.conf : |
||||
|
||||
PerlRequire MyFile |
||||
# TOTAL PROTECTION |
||||
PerlHeaderParserHandler My::Package |
||||
# OR SELECTED AREA |
||||
<Location /protected-area> |
||||
PerlHeaderParserHandler My::Package |
||||
</Location> |
||||
|
||||
The configuration is loaded only at Apache start. Create an URI to force |
||||
configuration reload, so you don't need to restart Apache at each change : |
||||
|
||||
# /apache-dir/conf/httpd.conf |
||||
<Location /location/that/I/ve/choosed> |
||||
Order deny,allow |
||||
Deny from all |
||||
Allow from my.manager.com |
||||
PerlHeaderParserHandler My::Package->refresh |
||||
</Location> |
||||
|
||||
=head1 DESCRIPTION |
||||
|
||||
This library inherit from L<Lemonldap::NG::Handler::Main> to build a |
||||
complete SSO Handler System: a central database contains the policy of your |
||||
domain. People that want to access to a protected applications are redirected |
||||
to the portal that run L<Lemonldap::NG::Portal::SharedConf>. After reading |
||||
configuration from the database and authenticating the user, it stores a key |
||||
word for each application the user is granted to access to. |
||||
Then the user is redirected to the application he wanted to access and the |
||||
Apache handler build with L<Lemonldap::NG::Handler::DefaultHandler::DBI> has just |
||||
to verify that the keyword corresponding to the protected area is stored in |
||||
the database. |
||||
|
||||
=head2 OVERLOADED SUBROUTINES |
||||
|
||||
=head3 init |
||||
|
||||
Like L<Lemonldap::NG::Handler::Main>::init() but read only localStorage |
||||
related options. You may change default time between two configuration checks |
||||
with the C<reloadTime> parameter (default 600s). |
||||
|
||||
=head1 OPERATION |
||||
|
||||
Each new Apache child checks if there's a configuration stored in the local |
||||
store. If not, it calls getConf to get one and store it in the local store by |
||||
calling setconf. |
||||
|
||||
Every 600 seconds, each Apache child checks if the local stored configuration |
||||
has changed and reload it if it has. |
||||
|
||||
When refresh subroutine is called (by http for example: see synopsis), getConf |
||||
is called to get the new configuration and setconf is called to store it in the |
||||
local store. |
||||
|
||||
=head1 SEE ALSO |
||||
|
||||
L<Lemonldap::NG::Handler>, L<Lemonldap::NG::Manager>, L<Lemonldap::NG::Portal>, |
||||
L<http://lemonldap-ng.org/> |
||||
|
||||
=head1 AUTHOR |
||||
|
||||
=over |
||||
|
||||
=item Clement Oudot, E<lt>clem.oudot@gmail.comE<gt> |
||||
|
||||
=item François-Xavier Deltombe, E<lt>fxdeltombe@gmail.com.E<gt> |
||||
|
||||
=item Xavier Guimard, E<lt>x.guimard@free.frE<gt> |
||||
|
||||
=back |
||||
|
||||
=head1 BUG REPORT |
||||
|
||||
Use OW2 system to report bug or ask for features: |
||||
L<http://jira.ow2.org> |
||||
|
||||
=head1 DOWNLOAD |
||||
|
||||
Lemonldap::NG is available at |
||||
L<http://forge.objectweb.org/project/showfiles.php?group_id=274> |
||||
|
||||
=head1 COPYRIGHT AND LICENSE |
||||
|
||||
=over |
||||
|
||||
=item Copyright (C) 2006, 2007, 2008, 2009, 2010, 2013 by Xavier Guimard, E<lt>x.guimard@free.frE<gt> |
||||
|
||||
=item Copyright (C) 2012 by François-Xavier Deltombe, E<lt>fxdeltombe@gmail.com.E<gt> |
||||
|
||||
=item Copyright (C) 2006, 2008, 2009, 2010, 2011, 2012 by Clement Oudot, E<lt>clem.oudot@gmail.comE<gt> |
||||
|
||||
=back |
||||
|
||||
This library is free software; you can redistribute it and/or modify |
||||
it under the terms of the GNU General Public License as published by |
||||
the Free Software Foundation; either version 2, or (at your option) |
||||
any later version. |
||||
|
||||
This program is distributed in the hope that it will be useful, |
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of |
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
||||
GNU General Public License for more details. |
||||
|
||||
You should have received a copy of the GNU General Public License |
||||
along with this program. If not, see L<http://www.gnu.org/licenses/>. |
||||
|
||||
=cut |
||||
@ -0,0 +1,515 @@ |
||||
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 SAFEWRAP => ( Safe->can("wrap_code_ref") ? 1 : 0 ); |
||||
use constant UNPROTECT => 1; |
||||
use constant SKIP => 2; |
||||
|
||||
use Mouse; |
||||
|
||||
use Lemonldap::NG::Handler::Main::Jail; |
||||
use Lemonldap::NG::Handler::Main::Logger; |
||||
|
||||
has customFunctions => ( is => 'rw', isa => 'Maybe[Str]' ); |
||||
|
||||
has useSafeJail => ( is => 'rw', isa => 'Maybe[Int]' ); |
||||
|
||||
has safe => ( is => 'rw' ); |
||||
|
||||
BEGIN { |
||||
if ( exists $ENV{MOD_PERL} ) { |
||||
if ( $ENV{MOD_PERL_API_VERSION} and $ENV{MOD_PERL_API_VERSION} >= 2 ) { |
||||
eval 'use constant MP => 2;'; |
||||
} |
||||
else { |
||||
eval 'use constant MP => 1;'; |
||||
} |
||||
} |
||||
else { |
||||
eval 'use constant MP => 0;'; |
||||
} |
||||
if ( MP() == 2 ) { |
||||
eval ' |
||||
use constant OK => Apache2::Const::OK; |
||||
'; |
||||
} |
||||
else { # For Test or CGI |
||||
eval ' |
||||
use constant OK => 1; |
||||
'; |
||||
} |
||||
} |
||||
|
||||
## @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 |
||||
} |
||||
} |
||||
} |
||||
} |
||||
|
||||
# Warning: first start of handler load values from MyHanlder.pm |
||||
# and lemonldap-ng.ini |
||||
# These values should be erased by global configuration! |
||||
$cookieName = $args->{cookieName} || $cookieName || 'lemonldap'; |
||||
$securedCookie = |
||||
defined( $args->{securedCookie} ) ? $args->{securedCookie} |
||||
: defined($securedCookie) ? $securedCookie |
||||
: 1; |
||||
$whatToTrace = $args->{whatToTrace} || $whatToTrace || 'uid'; |
||||
$whatToTrace =~ s/\$//g; |
||||
$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 || 0; |
||||
$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 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}", "sub{return($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 { |
||||
Lemonldap::NG::Handler::Main::PostForm->buildPostForm( |
||||
$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 { |
||||
return |
||||
Lemonldap::NG::Handler::Main::PostForm->buildPostForm( |
||||
$d->{postUrl} ) |
||||
if ( |
||||
$Lemonldap::NG::Handler::Main::apacheRequest->method ne |
||||
'POST' ); |
||||
$Lemonldap::NG::Handler::Main::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 { |
||||
$Lemonldap::NG::Handler::Main::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 { |
||||
$mainClass->localUnlog; |
||||
$Lemonldap::NG::Handler::Main::apacheRequest->add_output_filter( |
||||
sub { |
||||
return $mainClass->redirectFilter( |
||||
$self->portal() . "?url=" |
||||
. $mainClass->encodeUrl($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}/\$apacheRequest->hostname/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)}", "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; |
||||
@ -0,0 +1,240 @@ |
||||
## @file |
||||
# Base file for Lemonldap::NG handlers |
||||
|
||||
## @class |
||||
# Base class for Lemonldap::NG handlers. |
||||
# All methods in handler are class methods: in ModPerl environment, handlers |
||||
# are always launched without object created. |
||||
# |
||||
# The main method is run() who is called by Apache for each requests (using |
||||
# handler() wrapper). |
||||
# |
||||
# The main initialization subroutine is init() who launch localInit() and |
||||
# globalInit(). |
||||
package Lemonldap::NG::Handler::Initialization::LocalInit; |
||||
|
||||
use Mouse; |
||||
|
||||
use Lemonldap::NG::Handler::Main::Logger; |
||||
|
||||
our $VERSION = '1.3.0'; |
||||
|
||||
# Mouse attributes |
||||
################## |
||||
|
||||
# default attributes from constructor |
||||
has localStorage => ( is => 'rw', isa => 'Maybe[Str]', required => 1 ); |
||||
|
||||
has refLocalStorage => ( is => 'rw', required => 1 ); |
||||
|
||||
has localStorageOptions => |
||||
( is => 'rw', isa => 'Maybe[HashRef]', required => 1 ); |
||||
|
||||
has childInitDone => ( is => 'rw' ); |
||||
|
||||
# attributes built and returned |
||||
has [ 'statusPipe', 'statusOut' ] => ( is => 'rw' ); |
||||
|
||||
BEGIN { |
||||
if ( exists $ENV{MOD_PERL} ) { |
||||
if ( $ENV{MOD_PERL_API_VERSION} and $ENV{MOD_PERL_API_VERSION} >= 2 ) { |
||||
eval 'use constant MP => 2;'; |
||||
} |
||||
else { |
||||
eval 'use constant MP => 1;'; |
||||
} |
||||
} |
||||
else { |
||||
eval 'use constant MP => 0;'; |
||||
} |
||||
if ( MP() == 2 ) { |
||||
require Apache2::Log; |
||||
require Apache2::RequestUtil; |
||||
Apache2::RequestUtil->import(); |
||||
require Apache2::RequestRec; |
||||
Apache2::RequestRec->import(); |
||||
require Apache2::ServerUtil; |
||||
Apache2::ServerUtil->import(); |
||||
require Apache2::Connection; |
||||
Apache2::Connection->import(); |
||||
require Apache2::RequestIO; |
||||
Apache2::RequestIO->import(); |
||||
require APR::Table; |
||||
APR::Table->import(); |
||||
require Apache2::URI; |
||||
Apache2::URI->import(); |
||||
require Apache2::Const; |
||||
Apache2::Const->import( '-compile', qw(:common :log) ); |
||||
eval ' |
||||
use constant FORBIDDEN => Apache2::Const::FORBIDDEN; |
||||
use constant REDIRECT => Apache2::Const::REDIRECT; |
||||
use constant OK => Apache2::Const::OK; |
||||
use constant DECLINED => Apache2::Const::DECLINED; |
||||
use constant DONE => Apache2::Const::DONE; |
||||
use constant SERVER_ERROR => Apache2::Const::SERVER_ERROR; |
||||
'; |
||||
} |
||||
elsif ( MP() == 1 ) { |
||||
require Apache; |
||||
require Apache::Log; |
||||
require Apache::Constants; |
||||
Apache::Constants->import(':common'); |
||||
Apache::Constants->import(':response'); |
||||
} |
||||
else { # For Test or CGI |
||||
eval ' |
||||
use constant FORBIDDEN => 1; |
||||
use constant REDIRECT => 1; |
||||
use constant OK => 1; |
||||
use constant DECLINED => 1; |
||||
use constant DONE => 1; |
||||
use constant SERVER_ERROR => 1; |
||||
'; |
||||
} |
||||
} |
||||
|
||||
# Mouse methods |
||||
############### |
||||
|
||||
## @imethod void localInit(hashRef args) |
||||
# Call purgeCache() to purge the local cache, launch the status process |
||||
# (statusProcess()) in wanted and launch childInit(). |
||||
# @param $args reference to the initialization hash |
||||
sub localInit($$) { |
||||
my ( $self, $args ) = splice @_; |
||||
if ( $self->{localStorage} = $args->{localStorage} ) { |
||||
$self->{localStorageOptions} = $args->{localStorageOptions}; |
||||
$self->{localStorageOptions}->{default_expires_in} ||= 600; |
||||
$self->purgeCache(); |
||||
} |
||||
if ( $args->{status} ) { |
||||
if ( defined $self->{localStorage} ) { |
||||
$self->statusProcess(); |
||||
} |
||||
else { |
||||
|
||||
# localStorage is mandatory for status module |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"Status module can not be loaded without localStorage parameter", |
||||
'warn' |
||||
); |
||||
} |
||||
} |
||||
$self->childInit($args); |
||||
return ( |
||||
$self->{localStorage}, $self->{refLocalStorage}, |
||||
$self->{localStorageOptions}, $self->{statusPipe}, |
||||
$self->{statusOut}, $self->{childInitDone} |
||||
); |
||||
} |
||||
|
||||
## @imethod protected void purgeCache() |
||||
# Purge the local cache. |
||||
# Launched at Apache startup. |
||||
sub purgeCache { |
||||
my $self = shift; |
||||
eval "use $self->{localStorage};"; |
||||
die("Unable to load $self->{localStorage}: $@") if ($@); |
||||
|
||||
# At each Apache (re)start, we've to clear the cache to avoid living |
||||
# with old datas |
||||
eval '$self->{refLocalStorage} = new ' |
||||
. $self->{localStorage} |
||||
. '($self->{localStorageOptions});'; |
||||
if ( defined $self->{refLocalStorage} ) { |
||||
$self->{refLocalStorage}->clear(); |
||||
} |
||||
else { |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"Unable to clear local cache: $@", 'error' ); |
||||
} |
||||
} |
||||
|
||||
# Status daemon creation |
||||
|
||||
## @ifn protected void statusProcess() |
||||
# Launch the status processus. |
||||
sub statusProcess { |
||||
my $self = shift; |
||||
require IO::Pipe; |
||||
$self->{statusPipe} = IO::Pipe->new; |
||||
$self->{statusOut} = IO::Pipe->new; |
||||
if ( my $pid = fork() ) { |
||||
$self->{statusPipe}->writer(); |
||||
$self->{statusOut}->reader(); |
||||
$self->{statusPipe}->autoflush(1); |
||||
} |
||||
else { |
||||
require Data::Dumper; |
||||
$self->{statusPipe}->reader(); |
||||
$self->{statusOut}->writer(); |
||||
my $fdin = $self->{statusPipe}->fileno; |
||||
my $fdout = $self->{statusOut}->fileno; |
||||
open STDIN, "<&$fdin"; |
||||
open STDOUT, ">&$fdout"; |
||||
my @tmp = (); |
||||
push @tmp, "-I$_" foreach (@INC); |
||||
exec 'perl', '-MLemonldap::NG::Handler::Status', |
||||
@tmp, |
||||
'-e', |
||||
'&Lemonldap::NG::Handler::Status::run(' |
||||
. $self->{localStorage} . ',' |
||||
. Data::Dumper->new( [ $self->{localStorageOptions} ] )->Terse(1) |
||||
->Dump . ');'; |
||||
} |
||||
} |
||||
|
||||
## @imethod protected boolean childInit() |
||||
# Indicates to Apache that it has to launch: |
||||
# - initLocalStorage() for each child process (after fork and uid change) |
||||
# - cleanLocalStorage() after each requests |
||||
# @return True |
||||
sub childInit { |
||||
my ( $self, $args ) = splice @_; |
||||
return 1 if ( $self->{childInitDone} ); |
||||
|
||||
# We don't initialise local storage in the "init" subroutine because it can |
||||
# be used at the starting of Apache and so with the "root" privileges. Local |
||||
# Storage is also initialized just after Apache's fork and privilege lost. |
||||
|
||||
# Local storage is cleaned after giving the content of the page to increase |
||||
# performances. |
||||
no strict; |
||||
if ( MP() == 2 ) { |
||||
$s = Apache2::ServerUtil->server; |
||||
$s->push_handlers( PerlChildInitHandler => |
||||
sub { return $self->initLocalStorage( $_[1], $_[0] ); } ); |
||||
$s->push_handlers( |
||||
PerlPostConfigHandler => sub { |
||||
my ( $c, $l, $t, $s ) = splice @_; |
||||
$s->add_version_component( |
||||
'Lemonldap::NG::Handler/' . $VERSION ); |
||||
} |
||||
) unless ( $args->{hideSignature} ); |
||||
} |
||||
elsif ( MP() == 1 ) { |
||||
Apache->push_handlers( |
||||
PerlChildInitHandler => sub { return $self->initLocalStorage(@_); } |
||||
); |
||||
} |
||||
$self->{childInitDone}++; |
||||
1; |
||||
} |
||||
|
||||
## @imethod protected int initLocalStorage() |
||||
# Prepare local cache (if not done before by Lemonldap::NG::Common::Conf) |
||||
# @return Apache2::Const::DECLINED |
||||
sub initLocalStorage { |
||||
my ( $self, $r ) = splice @_; |
||||
if ( $self->{localStorage} and not $self->{refLocalStorage} ) { |
||||
eval |
||||
"use $self->{localStorage};\$self->{refLocalStorage} = new $self->{localStorage}(\$self->{localStorageOptions});"; |
||||
|
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"Local cache initialization failed: $@", 'error' ) |
||||
unless ( defined $self->{refLocalStorage} ); |
||||
} |
||||
return DECLINED; |
||||
} |
||||
|
||||
1; |
||||
@ -0,0 +1,905 @@ |
||||
## @file |
||||
# Base file for Lemonldap::NG handlers |
||||
|
||||
## @class |
||||
# Base class for Lemonldap::NG handlers. |
||||
# All methods in handler are class methods: in ModPerl environment, handlers |
||||
# are always launched without object created. |
||||
# |
||||
# The main method is run() who is called by Apache for each requests (using |
||||
# handler() wrapper). |
||||
# |
||||
# The main initialization subroutine is init() who launch localInit() and |
||||
# globalInit(). |
||||
package Lemonldap::NG::Handler::Main; |
||||
|
||||
#use strict; |
||||
|
||||
use MIME::Base64; |
||||
use Exporter 'import'; |
||||
|
||||
#use AutoLoader 'AUTOLOAD'; |
||||
use Lemonldap::NG::Common::Crypto; |
||||
require POSIX; |
||||
use CGI::Util 'expires'; |
||||
use constant UNPROTECT => 1; |
||||
use constant SKIP => 2; |
||||
use constant MAINTENANCE_CODE => 503; |
||||
|
||||
#inherits Cache::Cache |
||||
#inherits Apache::Session |
||||
#link Lemonldap::NG::Common::Apache::Session::SOAP protected globalStorage |
||||
|
||||
our $VERSION = '1.3.0'; |
||||
|
||||
our %EXPORT_TAGS; |
||||
|
||||
our @EXPORT_OK; |
||||
|
||||
our @EXPORT; |
||||
|
||||
# my @tSharedVar = qw( |
||||
# cookieName customFunctions defaultCondition |
||||
# defaultProtection forgeHeaders globalStorage |
||||
# globalStorageOptions headerList https |
||||
# key localStorage localStorageOptions |
||||
# locationCondition locationConditionText locationCount |
||||
# locationProtection locationRegexp maintenance |
||||
# port refLocalStorage securedCookie |
||||
# statusOut statusPipe timeoutActivity |
||||
# useRedirectOnError useRedirectOnForbidden useSafeJail |
||||
# whatToTrace |
||||
# ); |
||||
# |
||||
# my @nontSharedVar = qw( |
||||
# safe |
||||
# cipher datasUpdate transform |
||||
# cda childInitDone httpOnly |
||||
# cookieExpiration |
||||
# ); |
||||
# |
||||
# non threaded shared vars non being part of $ntsv hashref |
||||
# (because of share_from in Jail.pm): |
||||
# $apacheRequest |
||||
# $datas |
||||
|
||||
# Shared variables |
||||
our ( $apacheRequest, $datas, $tsv, $ntsv, ); |
||||
|
||||
########################################## |
||||
# COMPATIBILITY WITH APACHE AND APACHE 2 # |
||||
########################################## |
||||
|
||||
BEGIN { |
||||
|
||||
# globalStorage and locationRules are set for Manager compatibility only |
||||
%EXPORT_TAGS = ( |
||||
globalStorage => [qw( )], |
||||
locationRules => [qw( )], |
||||
jailSharedVars => [qw( $apacheRequest $datas )], |
||||
tsv => [qw( $tsv )], |
||||
ntsv => [qw( $ntsv )], |
||||
import => [qw( import @EXPORT_OK @EXPORT %EXPORT_TAGS )], |
||||
headers => [ |
||||
qw( |
||||
lmHeaderIn lmSetHeaderIn lmHeaderOut |
||||
lmSetHeaderOut lmSetErrHeaderOut |
||||
) |
||||
], |
||||
apache => [ |
||||
qw( MP OK REDIRECT FORBIDDEN DONE DECLINED SERVER_ERROR |
||||
) |
||||
], |
||||
post => [qw(postFilter)], |
||||
); |
||||
push( @EXPORT_OK, @{ $EXPORT_TAGS{$_} } ) foreach ( keys %EXPORT_TAGS ); |
||||
$EXPORT_TAGS{all} = \@EXPORT_OK; |
||||
if ( exists $ENV{MOD_PERL} ) { |
||||
if ( $ENV{MOD_PERL_API_VERSION} and $ENV{MOD_PERL_API_VERSION} >= 2 ) { |
||||
eval 'use constant MP => 2;'; |
||||
} |
||||
else { |
||||
eval 'use constant MP => 1;'; |
||||
} |
||||
} |
||||
else { |
||||
eval 'use constant MP => 0;'; |
||||
} |
||||
if ( MP() == 2 ) { |
||||
require Apache2::Log; |
||||
require Apache2::RequestUtil; |
||||
Apache2::RequestUtil->import(); |
||||
require Apache2::RequestRec; |
||||
Apache2::RequestRec->import(); |
||||
require Apache2::ServerUtil; |
||||
Apache2::ServerUtil->import(); |
||||
require Apache2::Connection; |
||||
Apache2::Connection->import(); |
||||
require Apache2::RequestIO; |
||||
Apache2::RequestIO->import(); |
||||
require APR::Table; |
||||
APR::Table->import(); |
||||
require Apache2::URI; |
||||
Apache2::URI->import(); |
||||
require Apache2::Const; |
||||
Apache2::Const->import( '-compile', qw(:common :log) ); |
||||
eval ' |
||||
use constant FORBIDDEN => Apache2::Const::FORBIDDEN; |
||||
use constant REDIRECT => Apache2::Const::REDIRECT; |
||||
use constant OK => Apache2::Const::OK; |
||||
use constant DECLINED => Apache2::Const::DECLINED; |
||||
use constant DONE => Apache2::Const::DONE; |
||||
use constant SERVER_ERROR => Apache2::Const::SERVER_ERROR; |
||||
'; |
||||
eval { |
||||
require threads::shared; |
||||
threads::shared::share($tsv); |
||||
}; |
||||
print "eval error: $@" if ($@); |
||||
} |
||||
elsif ( MP() == 1 ) { |
||||
require Apache; |
||||
require Apache::Log; |
||||
require Apache::Constants; |
||||
Apache::Constants->import(':common'); |
||||
Apache::Constants->import(':response'); |
||||
} |
||||
else { # For Test or CGI |
||||
eval ' |
||||
use constant FORBIDDEN => 1; |
||||
use constant REDIRECT => 1; |
||||
use constant OK => 1; |
||||
use constant DECLINED => 1; |
||||
use constant DONE => 1; |
||||
use constant SERVER_ERROR => 1; |
||||
'; |
||||
} |
||||
*handler = ( MP() == 2 ) ? \&handler_mp2 : \&handler_mp1; |
||||
*logout = ( MP() == 2 ) ? \&logout_mp2 : \&logout_mp1; |
||||
} |
||||
|
||||
use Lemonldap::NG::Handler::Initialization::LocalInit; |
||||
use Lemonldap::NG::Handler::Initialization::GlobalInit; |
||||
use Lemonldap::NG::Handler::Main::Jail; |
||||
use Lemonldap::NG::Handler::Main::Headers; |
||||
use Lemonldap::NG::Handler::Main::PostForm; |
||||
use Lemonldap::NG::Handler::Main::Logger; |
||||
|
||||
## @rmethod protected int handler_mp2() |
||||
# Launch run() when used under mod_perl version 2 |
||||
# @return Apache constant |
||||
sub handler_mp2 : method { |
||||
shift->run(@_); |
||||
} |
||||
|
||||
## @rmethod protected int logout_mp2() |
||||
# Launch unlog() when used under mod_perl version 2 |
||||
# @return Apache constant |
||||
sub logout_mp2 : method { |
||||
shift->unlog(@_); |
||||
} |
||||
|
||||
## @rmethod protected void lmSetApacheUser(Apache2::RequestRec r,string s) |
||||
# Inform Apache for the data to use as user for logs |
||||
# @param $r current request |
||||
# @param $s string to use |
||||
sub lmSetApacheUser { |
||||
my ( $class, $r, $s ) = splice @_; |
||||
return unless ($s); |
||||
if ( MP() == 2 ) { |
||||
$r->user($s); |
||||
} |
||||
else { |
||||
$r->connection->user($s); |
||||
} |
||||
} |
||||
|
||||
## @rmethod protected void updateStatus(string user,string url,string action) |
||||
# Inform the status process of the result of the request if it is available. |
||||
sub updateStatus { |
||||
my ( $class, $user, $url, $action ) = splice @_; |
||||
eval { |
||||
print { $tsv->{statusPipe} } "$user => " |
||||
. $apacheRequest->hostname |
||||
. "$url $action\n" |
||||
if ( $tsv->{statusPipe} ); |
||||
}; |
||||
} |
||||
|
||||
## @rmethod protected int forbidden(string uri) |
||||
# Used to reject non authorized requests. |
||||
# Inform the status processus and call logForbidden(). |
||||
# @param uri URI requested |
||||
# @return Apache2::Const::REDIRECT or Apache2::Const::FORBIDDEN |
||||
sub forbidden { |
||||
my ( $class, $uri ) = splice @_; |
||||
if ( $datas->{_logout} ) { |
||||
$class->updateStatus( $datas->{ $tsv->{whatToTrace} }, $_[0], |
||||
'LOGOUT' ); |
||||
my $u = $datas->{_logout}; |
||||
$class->localUnlog; |
||||
return $class->goToPortal( $u, 'logout=1' ); |
||||
} |
||||
$class->updateStatus( $datas->{ $tsv->{whatToTrace} }, $_[0], 'REJECT' ); |
||||
$apacheRequest->push_handlers( |
||||
PerlLogHandler => sub { |
||||
$_[0]->status(FORBIDDEN); |
||||
$class->logForbidden( $uri, $datas ); |
||||
DECLINED; |
||||
} |
||||
); |
||||
|
||||
# Redirect or Forbidden? |
||||
if ( $tsv->{useRedirectOnForbidden} ) { |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"Use redirect for forbidden access", 'debug' ); |
||||
return $class->goToPortal( $uri, 'lmError=403' ); |
||||
} |
||||
else { |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( "Return forbidden access", |
||||
'debug' ); |
||||
return FORBIDDEN; |
||||
} |
||||
} |
||||
|
||||
## @rmethod protected void logForbidden(string uri,hashref datas) |
||||
# Insert a log in Apache errors log system to inform that the user was rejected. |
||||
# This method has to be overloaded to use different logs systems |
||||
# @param $uri uri asked |
||||
# @param $datas hash re to user's datas |
||||
sub logForbidden { |
||||
my ( $class, $uri, $datas ) = splice @_; |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
'User "' |
||||
. $datas->{ $tsv->{whatToTrace} } |
||||
. '" was reject when he tried to access to ' |
||||
. $uri, |
||||
'notice' |
||||
); |
||||
} |
||||
|
||||
## @rmethod protected void logGranted(string uri) |
||||
# Insert a log in Apache errors log system to inform that the user was |
||||
# authorizated. This method has to be overloaded to use different logs systems |
||||
# @param $uri uri asked |
||||
sub logGranted { |
||||
my ( $class, $uri, $datas ) = splice @_; |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
'User "' |
||||
. $datas->{ $tsv->{whatToTrace} } |
||||
. '" was granted to access to ' |
||||
. $uri, |
||||
'debug' |
||||
); |
||||
} |
||||
|
||||
## @rmethod protected void hideCookie() |
||||
# Hide Lemonldap::NG cookie to the protected application. |
||||
sub hideCookie { |
||||
my $class = shift; |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( "removing cookie", 'debug' ); |
||||
my $tmp = Lemonldap::NG::Handler::Main::Headers->lmHeaderIn( $apacheRequest, |
||||
'Cookie' ); |
||||
$tmp =~ s/$tsv->{cookieName}(http)?=[^,;]*[,;\s]*//og; |
||||
if ($tmp) { |
||||
Lemonldap::NG::Handler::Main::Headers->lmSetHeaderIn( $apacheRequest, |
||||
'Cookie' => $tmp ); |
||||
} |
||||
else { |
||||
Lemonldap::NG::Handler::Main::Headers->lmUnsetHeaderIn( $apacheRequest, |
||||
'Cookie' ); |
||||
} |
||||
} |
||||
|
||||
## @rmethod protected string encodeUrl(string url) |
||||
# Encode URl in the format used by Lemonldap::NG::Portal for redirections. |
||||
# @return Base64 encoded string |
||||
sub encodeUrl { |
||||
my ( $class, $url ) = splice @_; |
||||
$url = $class->_buildUrl($url) if ( $url !~ m#^https?://# ); |
||||
return encode_base64( $url, '' ); |
||||
} |
||||
|
||||
## @rmethod protected int goToPortal(string url, string arg) |
||||
# Redirect non-authenticated users to the portal by setting "Location:" header. |
||||
# @param $url Url requested |
||||
# @param $arg optionnal GET parameters |
||||
# @return Apache2::Const::REDIRECT |
||||
sub goToPortal { |
||||
my ( $class, $url, $arg ) = splice @_; |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"Redirect " . $class->ip() . " to portal (url was $url)", 'debug' ); |
||||
my $urlc_init = $class->encodeUrl($url); |
||||
Lemonldap::NG::Handler::Main::Headers->lmSetHeaderOut( $apacheRequest, |
||||
'Location' => $class->portal() |
||||
. "?url=$urlc_init" |
||||
. ( $arg ? "&$arg" : "" ) ); |
||||
return REDIRECT; |
||||
} |
||||
|
||||
## @rmethod protected $ fetchId() |
||||
# Get user cookies and search for Lemonldap::NG cookie. |
||||
# @return Value of the cookie if found, 0 else |
||||
sub fetchId { |
||||
my $t = Lemonldap::NG::Handler::Main::Headers->lmHeaderIn( $apacheRequest, |
||||
'Cookie' ); |
||||
my $vhost = $apacheRequest->hostname; |
||||
my $lookForHttpCookie = $tsv->{securedCookie} =~ /^(2|3)$/ |
||||
&& !( |
||||
defined( $tsv->{https}->{$vhost} ) |
||||
? $$tsv->{https}->{$vhost} |
||||
: $tsv->{https}->{_} |
||||
); |
||||
my $value = |
||||
$lookForHttpCookie |
||||
? ( $t =~ /$tsv->{cookieName}http=([^,; ]+)/o ? $1 : 0 ) |
||||
: ( $t =~ /$tsv->{cookieName}=([^,; ]+)/o ? $1 : 0 ); |
||||
|
||||
$value = $ntsv->{cipher}->decryptHex( $value, "http" ) |
||||
if ( $value && $lookForHttpCookie && $tsv->{securedCookie} == 3 ); |
||||
return $value; |
||||
} |
||||
|
||||
## @rmethod protected boolean retrieveSession(id) |
||||
# Tries to retrieve the session whose index is id |
||||
# @return true if the session was found, false else |
||||
sub retrieveSession { |
||||
my ( $class, $id ) = @_; |
||||
|
||||
# 1. search if the user was the same as previous (very efficient in |
||||
# persistent connection). |
||||
return 1 |
||||
if ( defined $datas->{_session_id} |
||||
and $id eq $datas->{_session_id} |
||||
and ( time() - $ntsv->{datasUpdate} < 60 ) ); |
||||
|
||||
# 2. search in the local cache if exists |
||||
return 1 |
||||
if ( $tsv->{refLocalStorage} |
||||
and $datas = $tsv->{refLocalStorage}->get($id) ); |
||||
|
||||
# 3. search in the central cache |
||||
my %h; |
||||
eval { tie %h, $tsv->{globalStorage}, $id, $tsv->{globalStorageOptions}; }; |
||||
if ($@) { |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"Session $id can't be retrieved: $@", 'info' ); |
||||
return 0; |
||||
} |
||||
|
||||
# Update the session to notify activity, if necessary |
||||
$h{_lastSeen} = time() if ( $tsv->{timeoutActivity} ); |
||||
|
||||
# Set _session_id key |
||||
$h{_session_id} = $id; |
||||
|
||||
# Store data in current shared variables |
||||
$datas->{$_} = $h{$_} foreach ( keys %h ); |
||||
|
||||
# Store the session in local storage |
||||
$tsv->{refLocalStorage}->set( $id, $datas, "10 minutes" ) |
||||
if ( $tsv->{refLocalStorage} ); |
||||
|
||||
untie %h; |
||||
$ntsv->{datasUpdate} = time(); |
||||
return 1; |
||||
} |
||||
|
||||
sub ip { |
||||
my $ip = 'unknownIP'; |
||||
eval { |
||||
$ip = |
||||
( MP() == 2 ) |
||||
? $apacheRequest->connection->remote_ip |
||||
: $apacheRequest->remote_ip; |
||||
}; |
||||
return $ip; |
||||
} |
||||
|
||||
# MAIN SUBROUTINE called by Apache (using PerlHeaderParserHandler option) |
||||
|
||||
## @rmethod int run(Apache2::RequestRec apacheRequest) |
||||
# Main method used to control access. |
||||
# Calls : |
||||
# - fetchId() |
||||
# - retrieveSession() |
||||
# - lmSetApacheUser() |
||||
# - grant() |
||||
# - forbidden() if user is rejected |
||||
# - sendHeaders() if user is granted |
||||
# - hideCookie() |
||||
# - updateStatus() |
||||
# @param $apacheRequest Current request |
||||
# @return Apache2::Const value (OK, FORBIDDEN, REDIRECT or SERVER_ERROR) |
||||
sub run ($$) { |
||||
my $class; |
||||
( $class, $apacheRequest ) = splice @_; |
||||
return DECLINED unless ( $apacheRequest->is_initial_req ); |
||||
my $args = $apacheRequest->args; |
||||
|
||||
# Direct return if maintenance mode is active |
||||
if ( $class->checkMaintenanceMode() ) { |
||||
|
||||
if ( $tsv->{useRedirectOnError} ) { |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"Got to portal with maintenance error code", 'debug' ); |
||||
return $class->goToPortal( '/', 'lmError=' . MAINTENANCE_CODE ); |
||||
} |
||||
else { |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"Return maintenance error code", 'debug' ); |
||||
return MAINTENANCE_CODE; |
||||
} |
||||
} |
||||
|
||||
# Cross domain authentication |
||||
if ( $ntsv->{cda} |
||||
and $args =~ s/[\?&]?($tsv->{cookieName}(http)?=\w+)$//oi ) |
||||
{ |
||||
my $str = $1; |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( 'CDA request', 'debug' ); |
||||
$apacheRequest->args($args); |
||||
my $redirectUrl = $class->_buildUrl( $apacheRequest->uri ); |
||||
my $redirectHttps = ( $redirectUrl =~ m/^https/ ); |
||||
Lemonldap::NG::Handler::Main::Headers->lmSetErrHeaderOut( |
||||
$apacheRequest, |
||||
'Location' => $redirectUrl . ( $args ? "?" . $args : "" ) ); |
||||
Lemonldap::NG::Handler::Main::Headers->lmSetErrHeaderOut( |
||||
$apacheRequest, |
||||
'Set-Cookie' => "$str; path=/" |
||||
. ( $redirectHttps ? "; secure" : "" ) |
||||
. ( $ntsv->{httpOnly} ? "; HttpOnly" : "" ) |
||||
. ( |
||||
$ntsv->{cookieExpiration} |
||||
? "; expires=" . expires( $ntsv->{cookieExpiration}, 'cookie' ) |
||||
: "" |
||||
) |
||||
); |
||||
return REDIRECT; |
||||
} |
||||
my $uri = $apacheRequest->unparsed_uri(); |
||||
my $uri_orig = $uri; |
||||
Apache2::URI::unescape_url($uri); |
||||
|
||||
my $protection = $class->isUnprotected($uri); |
||||
|
||||
if ( $protection == SKIP ) { |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( "Access control skipped", |
||||
"debug" ); |
||||
$class->updateStatus( $class->ip(), $apacheRequest->uri, 'SKIP' ); |
||||
$class->hideCookie; |
||||
Lemonldap::NG::Handler::Main::Headers->cleanHeaders( $apacheRequest, |
||||
$tsv->{forgeHeaders}, $tsv->{headerList} ); |
||||
return OK; |
||||
} |
||||
|
||||
my $id; |
||||
|
||||
# Try to recover cookie and user session |
||||
if ( $id = $class->fetchId and $class->retrieveSession($id) ) { |
||||
|
||||
# AUTHENTICATION done |
||||
|
||||
my $kc = keys %$datas; # in order to detect new local macro |
||||
|
||||
# ACCOUNTING (1. Inform Apache) |
||||
$class->lmSetApacheUser( $apacheRequest, |
||||
$datas->{ $tsv->{whatToTrace} } ); |
||||
|
||||
# AUTHORIZATION |
||||
return $class->forbidden($uri) |
||||
unless ( $class->grant($uri) ); |
||||
$class->updateStatus( $datas->{ $tsv->{whatToTrace} }, |
||||
$apacheRequest->uri, 'OK' ); |
||||
|
||||
# ACCOUNTING (2. Inform remote application) |
||||
Lemonldap::NG::Handler::Main::Headers->sendHeaders( $apacheRequest, |
||||
$tsv->{forgeHeaders} ); |
||||
|
||||
# Store local macros |
||||
if ( keys %$datas > $kc and $tsv->{refLocalStorage} ) { |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( "Update local cache", |
||||
"debug" ); |
||||
$tsv->{refLocalStorage}->set( $id, $datas, "10 minutes" ); |
||||
} |
||||
|
||||
# Hide Lemonldap::NG cookie |
||||
$class->hideCookie; |
||||
|
||||
# Log |
||||
$apacheRequest->push_handlers( PerlLogHandler => |
||||
sub { $class->logGranted( $uri, $datas ); DECLINED }, ); |
||||
|
||||
# Catch POST rules |
||||
Lemonldap::NG::Handler::Main::PostForm->transformUri($uri); |
||||
|
||||
return OK; |
||||
} |
||||
|
||||
elsif ( $protection == UNPROTECT ) { |
||||
|
||||
# Ignore unprotected URIs |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"No valid session but unprotected access", "debug" ); |
||||
$class->updateStatus( $class->ip(), $apacheRequest->uri, 'UNPROTECT' ); |
||||
$class->hideCookie; |
||||
Lemonldap::NG::Handler::Main::Headers->cleanHeaders( $apacheRequest, |
||||
$tsv->{forgeHeaders}, $tsv->{headerList} ); |
||||
return OK; |
||||
} |
||||
|
||||
else { |
||||
|
||||
# Redirect user to the portal |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( "$class: No cookie found", |
||||
'info' ) |
||||
unless ($id); |
||||
|
||||
# if the cookie was fetched, a log is sent by retrieveSession() |
||||
$class->updateStatus( $class->ip(), $apacheRequest->uri, |
||||
$id ? 'EXPIRED' : 'REDIRECT' ); |
||||
return $class->goToPortal($uri_orig); |
||||
} |
||||
} |
||||
|
||||
## @rmethod protected boolean checkMaintenanceMode |
||||
# Check if we are in maintenance mode |
||||
# @return true if maintenance mode |
||||
sub checkMaintenanceMode { |
||||
my ($class) = splice @_; |
||||
my $vhost = $apacheRequest->hostname; |
||||
my $_maintenance = |
||||
( defined $tsv->{maintenance}->{$vhost} ) |
||||
? $tsv->{maintenance}->{$vhost} |
||||
: $tsv->{maintenance}->{_}; |
||||
|
||||
if ($_maintenance) { |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"Maintenance mode activated", 'debug' ); |
||||
return 1; |
||||
} |
||||
|
||||
return 0; |
||||
} |
||||
|
||||
## @rmethod int abort(string mess) |
||||
# Logs message and exit or redirect to the portal if "useRedirectOnError" is |
||||
# set to true. |
||||
# @param $mess Message to log |
||||
# @return Apache2::Const::REDIRECT or Apache2::Const::SERVER_ERROR |
||||
sub abort { |
||||
my ( $class, $mess ) = splice @_; |
||||
|
||||
# If abort is called without a valid request, fall to die |
||||
eval { |
||||
my $args = $apacheRequest->args; |
||||
my $uri = $apacheRequest->unparsed_uri(); |
||||
|
||||
# Set error 500 in logs even if "useRedirectOnError" is set |
||||
$apacheRequest->push_handlers( |
||||
PerlLogHandler => sub { $_[0]->status(SERVER_ERROR); DECLINED; } ); |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( $mess, 'error' ); |
||||
|
||||
# Redirect or die |
||||
if ( $tsv->{useRedirectOnError} ) { |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"Use redirect for error", 'debug' ); |
||||
return $class->goToPortal( $uri, 'lmError=500' ); |
||||
} |
||||
else { |
||||
return SERVER_ERROR; |
||||
} |
||||
}; |
||||
die $mess if ($@); |
||||
} |
||||
|
||||
## @rmethod protected int handler_mp1() |
||||
# Launch run() when used under mod_perl version 1 |
||||
# @return Apache constant |
||||
sub handler_mp1 ($$) { shift->run(@_); } |
||||
|
||||
## @rmethod protected int logout_mp1() |
||||
# Launch unlog() when used under mod_perl version 1 |
||||
# @return Apache constant |
||||
sub logout_mp1 ($$) { shift->unlog(@_); } |
||||
|
||||
## @imethod void localInit(hashRef args) |
||||
# instanciate a LocalInit object with variables: |
||||
# localStorage, localStorageOptions, refLocalStorage, childInitDone |
||||
# launch localInit method: |
||||
# - calls purgeCache() to purge the local cache, |
||||
# - launch the status processus, |
||||
# - launch childInit (to init / clean local storage) |
||||
# @param $args reference to the initialization hash |
||||
sub localInit($$) { |
||||
my ( $class, $args ) = splice @_; |
||||
|
||||
my $localinit = Lemonldap::NG::Handler::Initialization::LocalInit->new( |
||||
localStorage => $tsv->{localStorage}, |
||||
refLocalStorage => $tsv->{refLocalStorage}, |
||||
localStorageOptions => $tsv->{localStorageOptions}, |
||||
childInitDone => $tsv->{childInitDone}, |
||||
); |
||||
( |
||||
@$tsv{ |
||||
qw( localStorage refLocalStorage localStorageOptions statusPipe statusOut ) |
||||
}, |
||||
$ntsv->{childInitDone} |
||||
) = $localinit->localInit($args); |
||||
|
||||
} |
||||
|
||||
## @imethod void globalInit(hashRef args) |
||||
# instanciate a GlobalInit object with variables: |
||||
# customFunctions, useSafeJail, and safe |
||||
# Global initialization process launches : |
||||
# - defaultValuesInit() |
||||
# - portalInit() |
||||
# - locationRulesInit() |
||||
# - globalStorageInit() |
||||
# - headerListInit() |
||||
# - forgeHeadersInit() |
||||
# - postUrlInit() |
||||
# @param $args reference to the configuration hash |
||||
sub globalInit { |
||||
my $class = shift; |
||||
|
||||
my $globalinit = Lemonldap::NG::Handler::Initialization::GlobalInit->new( |
||||
customFunctions => $tsv->{customFunctions}, |
||||
useSafeJail => $tsv->{useSafeJail}, |
||||
safe => $ntsv->{safe}, |
||||
); |
||||
|
||||
( |
||||
@$tsv{ |
||||
qw( cookieName securedCookie whatToTrace |
||||
https port customFunctions |
||||
timeoutActivity useRedirectOnError useRedirectOnForbidden |
||||
useSafeJail key maintenance ) |
||||
}, |
||||
@$ntsv{ |
||||
qw( cda httpOnly cookieExpiration |
||||
cipher |
||||
) |
||||
} |
||||
) |
||||
= $globalinit->defaultValuesInit( |
||||
@$tsv{ |
||||
qw( cookieName securedCookie whatToTrace |
||||
https port customFunctions |
||||
timeoutActivity useRedirectOnError useRedirectOnForbidden |
||||
useSafeJail key maintenance ) |
||||
}, |
||||
@$ntsv{ |
||||
qw( cda httpOnly cookieExpiration |
||||
cipher ) |
||||
}, |
||||
@_ |
||||
); |
||||
|
||||
( *portal, $ntsv->{safe} ) = $globalinit->portalInit( $class, @_ ); |
||||
|
||||
( |
||||
@$tsv{ |
||||
qw( locationCount defaultCondition |
||||
defaultProtection locationCondition |
||||
locationProtection locationRegexp |
||||
locationConditionText ) |
||||
}, |
||||
$ntsv->{safe} |
||||
) |
||||
= $globalinit->locationRulesInit( |
||||
$class, |
||||
@$tsv{ |
||||
qw( locationCount defaultCondition |
||||
defaultProtection locationCondition |
||||
locationProtection locationRegexp |
||||
locationConditionText ) |
||||
}, |
||||
@_ |
||||
); |
||||
|
||||
@$tsv{qw( globalStorage globalStorageOptions )} = |
||||
$globalinit->globalStorageInit( |
||||
@$tsv{qw( globalStorage globalStorageOptions )}, @_ ); |
||||
|
||||
$tsv->{headerList} = $globalinit->headerListInit( $tsv->{headerList}, @_ ); |
||||
|
||||
$tsv->{forgeHeaders} = |
||||
$globalinit->forgeHeadersInit( $tsv->{forgeHeaders}, @_ ); |
||||
|
||||
$ntsv->{transform} = $globalinit->postUrlInit( $ntsv->{transform}, @_ ); |
||||
|
||||
} |
||||
|
||||
## @rmethod boolean grant() |
||||
# Grant or refuse client using compiled regexp and functions |
||||
# @return True if the user is granted to access to the current URL |
||||
sub grant { |
||||
my ( $class, $uri ) = splice @_; |
||||
my $vhost = $apacheRequest->hostname; |
||||
for ( my $i = 0 ; $i < $tsv->{locationCount}->{$vhost} ; $i++ ) { |
||||
if ( $uri =~ $tsv->{locationRegexp}->{$vhost}->[$i] ) { |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
'Regexp "' |
||||
. $tsv->{locationConditionText}->{$vhost}->[$i] |
||||
. '" match', |
||||
'debug' |
||||
); |
||||
return &{ $tsv->{locationCondition}->{$vhost}->[$i] }($datas); |
||||
} |
||||
} |
||||
unless ( $tsv->{defaultCondition}->{$vhost} ) { |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"User rejected because VirtualHost \"$vhost\" has no configuration", |
||||
'warn' |
||||
); |
||||
return 0; |
||||
} |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( "$vhost: Apply default rule", |
||||
'debug' ); |
||||
return &{ $tsv->{defaultCondition}->{$vhost} }($datas); |
||||
} |
||||
|
||||
## @cmethod private string _buildUrl(string s) |
||||
# Transform /<s> into http(s?)://<host>:<port>/s |
||||
# @param $s path |
||||
# @return URL |
||||
sub _buildUrl { |
||||
my ( $class, $s ) = splice @_; |
||||
my $vhost = $apacheRequest->hostname; |
||||
my $portString = |
||||
$tsv->{port}->{$vhost} |
||||
|| $tsv->{port}->{_} |
||||
|| $apacheRequest->get_server_port(); |
||||
my $_https = ( |
||||
defined( $tsv->{https}->{$vhost} ) |
||||
? $tsv->{https}->{$vhost} |
||||
: $tsv->{https}->{_} |
||||
); |
||||
$portString = |
||||
( $_https && $portString == 443 ) ? '' |
||||
: ( !$_https && $portString == 80 ) ? '' |
||||
: ':' . $portString; |
||||
my $url = "http" |
||||
. ( $_https ? "s" : "" ) . "://" |
||||
. $apacheRequest->get_server_name() |
||||
. $portString |
||||
. $s; |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( "Build URL $url", 'debug' ); |
||||
return $url; |
||||
} |
||||
|
||||
## @rmethod int unprotect() |
||||
# Used to unprotect an area. |
||||
# To use it, set "PerlHeaderParserHandler My::Package->unprotect" Apache |
||||
# configuration file. |
||||
# It replace run() by doing nothing. |
||||
# @return Apache2::Const::OK |
||||
sub unprotect { |
||||
OK; |
||||
} |
||||
|
||||
## @rmethod protected void localUnlog() |
||||
# Delete current user from local cache entry. |
||||
sub localUnlog { |
||||
my $class = shift; |
||||
if ( my $id = $class->fetchId ) { |
||||
|
||||
# Delete Apache thread datas |
||||
if ( $id eq $datas->{_session_id} ) { |
||||
$datas = {}; |
||||
} |
||||
|
||||
# Delete Apache local cache |
||||
if ( $tsv->{refLocalStorage} and $tsv->{refLocalStorage}->get($id) ) { |
||||
$tsv->{refLocalStorage}->remove($id); |
||||
} |
||||
} |
||||
} |
||||
|
||||
## @rmethod protected int unlog(Apache::RequestRec apacheRequest) |
||||
# Call localUnlog() then goToPortal() to unlog the current user. |
||||
# @return Apache2::Const value returned by goToPortal() |
||||
sub unlog ($$) { |
||||
my $class; |
||||
( $class, $apacheRequest ) = splice @_; |
||||
$class->localUnlog; |
||||
$class->updateStatus( $class->ip(), $apacheRequest->uri, 'LOGOUT' ); |
||||
return $class->goToPortal( '/', 'logout=1' ); |
||||
} |
||||
|
||||
## @rmethod int status(Apache2::RequestRec $r) |
||||
# Get the result from the status process and launch a PerlResponseHandler to |
||||
# display it. |
||||
# @param $r Current request |
||||
# @return Apache2::Const::OK |
||||
sub status($$) { |
||||
my ( $class, $r ) = splice @_; |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( "$class: request for status", |
||||
'debug' ); |
||||
return $class->abort("$class: status page can not be displayed") |
||||
unless ( $tsv->{statusPipe} and $tsv->{statusOut} ); |
||||
$r->handler("perl-script"); |
||||
print { $tsv->{statusPipe} } "STATUS" |
||||
. ( $r->args ? " " . $r->args : '' ) . "\n"; |
||||
my $buf; |
||||
my $statusOut = $tsv->{statusOut}; |
||||
while ($statusOut) { |
||||
last if (/^END$/); |
||||
$buf .= $_; |
||||
} |
||||
if ( MP() == 2 ) { |
||||
$r->push_handlers( |
||||
'PerlResponseHandler' => sub { |
||||
my $r = shift; |
||||
$r->content_type('text/html; charset=UTF-8'); |
||||
$r->print($buf); |
||||
OK; |
||||
} |
||||
); |
||||
} |
||||
else { |
||||
$r->push_handlers( |
||||
'PerlHandler' => sub { |
||||
my $r = shift; |
||||
$r->content_type('text/html; charset=UTF-8'); |
||||
$r->send_http_header; |
||||
$r->print($buf); |
||||
OK; |
||||
} |
||||
); |
||||
} |
||||
return OK; |
||||
} |
||||
|
||||
## @rmethod protected int redirectFilter(string url, Apache2::Filter f) |
||||
# Launch the current HTTP request then redirects the user to $url. |
||||
# Used by logout_app and logout_app_sso targets |
||||
# @param $url URL to redirect the user |
||||
# @param $f Current Apache2::Filter object |
||||
# @return Apache2::Const::OK |
||||
sub redirectFilter { |
||||
my $class = shift; |
||||
my $url = shift; |
||||
my $f = shift; |
||||
unless ( $f->ctx ) { |
||||
|
||||
# Here, we can use Apache2 functions instead of lmSetHeaderOut because |
||||
# this function is used only with Apache2. |
||||
$f->r->status(REDIRECT); |
||||
$f->r->status_line("303 See Other"); |
||||
$f->r->headers_out->unset('Location'); |
||||
$f->r->err_headers_out->set( 'Location' => $url ); |
||||
$f->ctx(1); |
||||
} |
||||
while ( $f->read( my $buffer, 1024 ) ) { |
||||
} |
||||
$class->updateStatus( |
||||
( |
||||
$datas->{ $tsv->{whatToTrace} } |
||||
? $datas->{ $tsv->{whatToTrace} } |
||||
: $f->r->connection->remote_ip |
||||
), |
||||
'filter', |
||||
'REDIRECT' |
||||
); |
||||
return OK; |
||||
} |
||||
|
||||
## @rmethod protected int isUnprotected() |
||||
# @return 0 if URI is protected, |
||||
# UNPROTECT if it is unprotected by "unprotect", |
||||
# SKIP if is is unprotected by "skip" |
||||
sub isUnprotected { |
||||
my ( $class, $uri ) = splice @_; |
||||
my $vhost = $apacheRequest->hostname; |
||||
for ( my $i = 0 ; $i < $tsv->{locationCount}->{$vhost} ; $i++ ) { |
||||
if ( $uri =~ $tsv->{locationRegexp}->{$vhost}->[$i] ) { |
||||
return $tsv->{locationProtection}->{$vhost}->[$i]; |
||||
} |
||||
} |
||||
return $tsv->{defaultProtection}->{$vhost}; |
||||
} |
||||
|
||||
1; |
||||
@ -0,0 +1,159 @@ |
||||
package Lemonldap::NG::Handler::Main::Headers; |
||||
|
||||
use strict; |
||||
|
||||
use Lemonldap::NG::Handler::Main qw( :apache ); # for importing MP function |
||||
use Lemonldap::NG::Handler::Main::Logger; |
||||
|
||||
our $VERSION = '1.3.1'; |
||||
|
||||
BEGIN { |
||||
|
||||
if ( MP() == 2 ) { |
||||
require Apache2::Log; |
||||
require Apache2::RequestUtil; |
||||
Apache2::RequestUtil->import(); |
||||
require Apache2::RequestRec; |
||||
Apache2::RequestRec->import(); |
||||
require Apache2::ServerUtil; |
||||
Apache2::ServerUtil->import(); |
||||
require Apache2::Connection; |
||||
Apache2::Connection->import(); |
||||
require Apache2::RequestIO; |
||||
Apache2::RequestIO->import(); |
||||
require APR::Table; |
||||
APR::Table->import(); |
||||
require Apache2::URI; |
||||
Apache2::URI->import(); |
||||
require Apache2::Const; |
||||
Apache2::Const->import( '-compile', qw(:common :log) ); |
||||
} |
||||
elsif ( MP() == 1 ) { |
||||
require Apache; |
||||
require Apache::Log; |
||||
require Apache::Constants; |
||||
Apache::Constants->import(':common'); |
||||
Apache::Constants->import(':response'); |
||||
} |
||||
|
||||
} |
||||
|
||||
## @rmethod void lmSetHeaderIn(Apache2::RequestRec r, hash headers) |
||||
# Set HTTP headers in the HTTP request. |
||||
# @param $r Current request |
||||
# @param %headers Hash of header names and values |
||||
sub lmSetHeaderIn { |
||||
my ( $self, $r, %headers ) = splice @_; |
||||
while ( my ( $h, $v ) = each %headers ) { |
||||
if ( MP() == 2 ) { |
||||
$r->headers_in->set( $h => $v ); |
||||
} |
||||
elsif ( MP() == 1 ) { |
||||
$r->header_in( $h => $v ); |
||||
} |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"Send header $h with value $v", 'debug' ); |
||||
} |
||||
} |
||||
|
||||
## @rmethod void lmUnsetHeaderIn(Apache2::RequestRec r, array headers) |
||||
# Unset HTTP headers in the HTTP request. |
||||
# @param $r Current request |
||||
# @param @headers Name of the headers |
||||
sub lmUnsetHeaderIn { |
||||
my ( $self, $r, @headers ) = splice @_; |
||||
foreach my $h (@headers) { |
||||
if ( MP() == 2 ) { |
||||
$r->headers_in->unset($h); |
||||
} |
||||
elsif ( MP() == 1 ) { |
||||
$r->header_in( $h => "" ) |
||||
if ( $r->header_in($h) ); |
||||
} |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( "Unset header $h", |
||||
'debug' ); |
||||
} |
||||
} |
||||
|
||||
## @rfn string lmHeaderIn(Apache2::RequestRec r, string h) |
||||
# Return an HTTP header value from the HTTP request. |
||||
# @param $r Current request |
||||
# @param $h Name of the header |
||||
# @return Value of the header |
||||
sub lmHeaderIn { |
||||
my ( $self, $r, $h ) = splice @_; |
||||
use Data::Dumper; |
||||
if ( MP() == 2 ) { |
||||
return $r->headers_in->{$h}; |
||||
} |
||||
elsif ( MP() == 1 ) { |
||||
return $r->header_in($h); |
||||
} |
||||
} |
||||
|
||||
## @rfn void lmSetErrHeaderOut(Apache2::RequestRec r, string h, string v) |
||||
# Set an HTTP header in the HTTP response in error context |
||||
# @param $r Current request |
||||
# @param $h Name of the header |
||||
# @param $v Value of the header |
||||
sub lmSetErrHeaderOut { |
||||
my ( $self, $r, $h, $v ) = splice @_; |
||||
if ( MP() == 2 ) { |
||||
return $r->err_headers_out->set( $h => $v ); |
||||
} |
||||
elsif ( MP() == 1 ) { |
||||
return $r->err_header_out( $h => $v ); |
||||
} |
||||
} |
||||
|
||||
## @rfn void lmSetHeaderOut(Apache2::RequestRec r, string h, string v) |
||||
# Set an HTTP header in the HTTP response in normal context |
||||
# @param $r Current request |
||||
# @param $h Name of the header |
||||
# @param $v Value of the header |
||||
sub lmSetHeaderOut { |
||||
my ( $self, $r, $h, $v ) = splice @_; |
||||
if ( MP() == 2 ) { |
||||
return $r->headers_out->set( $h => $v ); |
||||
} |
||||
elsif ( MP() == 1 ) { |
||||
return $r->header_out( $h => $v ); |
||||
} |
||||
} |
||||
|
||||
## @rfn string lmHeaderOut(Apache2::RequestRec r, string h) |
||||
# Return an HTTP header value from the HTTP response. |
||||
# @param $r Current request |
||||
# @param $h Name of the header |
||||
# @return Value of the header |
||||
sub lmHeaderOut { |
||||
my ( $self, $r, $h, $v ) = splice @_; |
||||
if ( MP() == 2 ) { |
||||
return $r->headers_out->{$h}; |
||||
} |
||||
elsif ( MP() == 1 ) { |
||||
return $r->header_out($h); |
||||
} |
||||
} |
||||
|
||||
## @rmethod void sendHeaders() |
||||
# Launch function compiled by forgeHeadersInit() for the current virtual host |
||||
sub sendHeaders { |
||||
my ( $self, $apacheRequest, $forgeHeaders ) = splice @_; |
||||
my $vhost = $apacheRequest->hostname; |
||||
if ( defined( $forgeHeaders->{$vhost} ) ) { |
||||
lmSetHeaderIn( $self, $apacheRequest, &{ $forgeHeaders->{$vhost} } ); |
||||
} |
||||
} |
||||
|
||||
## @rmethod void cleanHeaders() |
||||
# Unset HTTP headers for the current virtual host, when sendHeaders is skipped |
||||
sub cleanHeaders { |
||||
my ( $self, $apacheRequest, $forgeHeaders, $headerList ) = splice @_; |
||||
my $vhost = $apacheRequest->hostname; |
||||
if ( defined( $forgeHeaders->{$vhost} ) ) { |
||||
lmUnsetHeaderIn( $self, $apacheRequest, @{ $headerList->{$vhost} } ); |
||||
} |
||||
} |
||||
|
||||
1; |
||||
@ -0,0 +1,130 @@ |
||||
package Lemonldap::NG::Handler::Main::Jail; |
||||
|
||||
use strict; |
||||
|
||||
use Safe; |
||||
use Lemonldap::NG::Common::Safelib; #link protected safe Safe object |
||||
use constant SAFEWRAP => ( Safe->can("wrap_code_ref") ? 1 : 0 ); |
||||
use Mouse; |
||||
use Lemonldap::NG::Handler::Main::Logger; |
||||
|
||||
has customFunctions => ( is => 'rw', isa => 'Maybe[Str]' ); |
||||
|
||||
has useSafeJail => ( is => 'rw', isa => 'Maybe[Int]' ); |
||||
|
||||
has safe => ( is => 'rw' ); |
||||
|
||||
our $VERSION = '1.3.1'; |
||||
|
||||
# for accessing $datas and $apacheRequest |
||||
use Lemonldap::NG::Handler::Main ':jailSharedVars'; |
||||
|
||||
## @imethod protected build_safe() |
||||
# Build and return the security jail used to compile rules and headers. |
||||
# @return Safe object |
||||
sub build_safe { |
||||
my $self = shift; |
||||
|
||||
return $self->safe if ( $self->safe ); |
||||
|
||||
$self->useSafeJail(1) unless defined $self->useSafeJail; |
||||
|
||||
my @t = |
||||
$self->customFunctions ? split( /\s+/, $self->customFunctions ) : (); |
||||
foreach (@t) { |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( "Custom function : $_", |
||||
'debug' ); |
||||
my $sub = $_; |
||||
unless (/::/) { |
||||
$sub = "$self\::$_"; |
||||
} |
||||
else { |
||||
s/^.*:://; |
||||
} |
||||
next if ( $self->can($_) ); |
||||
eval "sub $_ { |
||||
my \$uri = \$Lemonldap::NG::Handler::Main::apacheRequest->unparsed_uri(); |
||||
Apache2::URI::unescape_url(\$uri); |
||||
return $sub(\$uri, \@_) |
||||
}"; |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( $@, 'error' ) if ($@); |
||||
} |
||||
|
||||
if ( $self->useSafeJail ) { |
||||
$self->safe( Safe->new ); |
||||
$self->safe->share_from( 'main', ['%ENV'] ); |
||||
} |
||||
else { |
||||
$self->safe($self); |
||||
} |
||||
|
||||
# Share objects with Safe jail |
||||
$self->safe->share_from( 'Lemonldap::NG::Common::Safelib', |
||||
$Lemonldap::NG::Common::Safelib::functions ); |
||||
|
||||
$self->safe->share_from( 'Lemonldap::NG::Handler::Main', |
||||
[ '$datas', '$apacheRequest', '&ip', '&portal' ] ); |
||||
$self->safe->share(@t); |
||||
$self->safe->share_from( 'MIME::Base64', ['&encode_base64'] ); |
||||
|
||||
return $self->safe; |
||||
} |
||||
|
||||
## @method reval |
||||
# Fake reval method if useSafeJail is off |
||||
sub reval { |
||||
my ( $self, $e ) = splice @_; |
||||
return eval $e; |
||||
} |
||||
|
||||
## @method wrap_code_ref |
||||
# Fake wrap_code_ref method if useSafeJail is off |
||||
sub wrap_code_ref { |
||||
my ( $self, $e ) = splice @_; |
||||
return $e; |
||||
} |
||||
|
||||
## @method share |
||||
# Fake share method if useSafeJail is off |
||||
sub share { |
||||
my ( $self, @vars ) = splice @_; |
||||
$self->share_from( scalar(caller), \@vars ); |
||||
} |
||||
|
||||
## @method share_from |
||||
# Fake share_from method if useSafeJail is off |
||||
sub share_from { |
||||
my ( $self, $pkg, $vars ) = splice @_; |
||||
|
||||
no strict 'refs'; |
||||
foreach my $arg (@$vars) { |
||||
my ( $var, $type ); |
||||
$type = $1 if ( $var = $arg ) =~ s/^(\W)//; |
||||
for ( 1 .. 2 ) { # assign twice to avoid any 'used once' warnings |
||||
*{$var} = |
||||
( !$type ) ? \&{ $pkg . "::$var" } |
||||
: ( $type eq '&' ) ? \&{ $pkg . "::$var" } |
||||
: ( $type eq '$' ) ? \${ $pkg . "::$var" } |
||||
: ( $type eq '@' ) ? \@{ $pkg . "::$var" } |
||||
: ( $type eq '%' ) ? \%{ $pkg . "::$var" } |
||||
: ( $type eq '*' ) ? *{ $pkg . "::$var" } |
||||
: undef; |
||||
} |
||||
} |
||||
} |
||||
|
||||
## @imethod protected jail_reval() |
||||
# Build and return restricted eval command with SAFEWRAP, if activated |
||||
# @return evaluation of $reval or $reval2 |
||||
sub jail_reval { |
||||
my ( $self, $reval, $reval2 ) = splice @_; |
||||
|
||||
return ( |
||||
SAFEWRAP |
||||
? $self->safe->wrap_code_ref( $self->safe->reval($reval) ) |
||||
: $self->safe->reval($reval2) |
||||
); |
||||
|
||||
} |
||||
|
||||
1; |
||||
@ -0,0 +1,32 @@ |
||||
|
||||
package Lemonldap::NG::Handler::Main::Logger; |
||||
|
||||
use Lemonldap::NG::Handler::Main qw( :apache ); |
||||
|
||||
## @rmethod void lmLog(string mess, string level) |
||||
# Wrapper for Apache log system |
||||
# @param $mess message to log |
||||
# @param $level string (debug, info, warning or error) |
||||
sub lmLog { |
||||
my ( $class, $mess, $level ) = splice @_; |
||||
die("Level is required") unless ($level); |
||||
my $call; |
||||
my @tmp = caller(); |
||||
my $module = $tmp[0] =~ s/.+:://gr . "($tmp[2]): "; |
||||
unless ( $level eq 'debug' ) { |
||||
$call = "$tmp[1] $tmp[2]:"; |
||||
} |
||||
if ( MP() == 2 ) { |
||||
Apache2::ServerRec->log->debug($call) if ($call); |
||||
Apache2::ServerRec->log->$level( $module . $mess ); |
||||
} |
||||
elsif ( MP() == 1 ) { |
||||
Apache->server->log->debug($call) if ($call); |
||||
Apache->server->log->$level( $module . $mess ); |
||||
} |
||||
else { |
||||
print STDERR "[$level] $module $mess\n"; |
||||
} |
||||
} |
||||
|
||||
1; |
||||
@ -0,0 +1,118 @@ |
||||
package Lemonldap::NG::Handler::Main::PostForm; |
||||
|
||||
use strict; |
||||
|
||||
# For importing MP function, $ntsv->{transform}, $apacheRequest, |
||||
# $ntsv->{safe}, $tsv->{useSafeJail}, $tsv->{customFunctions} |
||||
use Lemonldap::NG::Handler::Main qw( :apache :ntsv :tsv $apacheRequest ); |
||||
use Lemonldap::NG::Handler::Main::Logger; |
||||
use Lemonldap::NG::Handler::Main::Jail; |
||||
|
||||
our $VERSION = '1.3.1'; |
||||
|
||||
BEGIN { |
||||
|
||||
if ( MP() == 2 ) { |
||||
require Apache2::URI; |
||||
Apache2::URI->import(); |
||||
} |
||||
elsif ( MP() == 1 ) { |
||||
require Apache; |
||||
require Apache::Log; |
||||
require Apache::Constants; |
||||
Apache::Constants->import(':common'); |
||||
Apache::Constants->import(':response'); |
||||
} |
||||
|
||||
} |
||||
|
||||
## @rmethod protected transformUri(string uri) |
||||
# Transform URI to replay POST forms |
||||
# @param uri URI to catch |
||||
# @return Apache2::Const |
||||
sub transformUri { |
||||
my ( $class, $uri ) = splice @_; |
||||
my $vhost = $apacheRequest->hostname; |
||||
|
||||
if ( defined( $ntsv->{transform}->{$vhost}->{$uri} ) ) { |
||||
return &{ $ntsv->{transform}->{$vhost}->{$uri} }; |
||||
} |
||||
|
||||
OK; |
||||
} |
||||
|
||||
## @imethod protected buildPostForm(string url, int count) |
||||
# Build form that will be posted by client |
||||
# Fill an input hidden with fake value to |
||||
# reach the size of initial request |
||||
# @param url Target of POST |
||||
# @param count Fake input size |
||||
# @return Apache2::Const::OK |
||||
sub buildPostForm { |
||||
my $class = shift; |
||||
my $url = shift; |
||||
my $count = shift || 1000; |
||||
$apacheRequest->handler("perl-script"); |
||||
$apacheRequest->add_config( ["SetHandler perl-script"] ); |
||||
$apacheRequest->set_handlers( |
||||
'PerlResponseHandler' => sub { |
||||
my $r = shift; |
||||
$r->content_type('text/html; charset=UTF-8'); |
||||
$r->print( |
||||
qq{<html><body onload="document.getElementById('f').submit()"><form id="f" method="post" action="$url" style="visibility:hidden"><input type=hidden name="a" value="} |
||||
. sprintf( "%0" . $count . "d", 1 ) |
||||
. qq{"/><input type="submit" value="Ok"/></form></body></html>} |
||||
); |
||||
OK; |
||||
} |
||||
); |
||||
OK; |
||||
} |
||||
|
||||
## @rmethod protected int postFilter(hashref data, Apache2::Filter f) |
||||
# POST data |
||||
# @param $data Data to POST |
||||
# @param $f Current Apache2::Filter object |
||||
# @return Apache2::Const::OK |
||||
sub postFilter { |
||||
my $class = shift; |
||||
my $data = shift; |
||||
my $f = shift; |
||||
my $l; |
||||
|
||||
unless ( $f->ctx ) { |
||||
$f->ctx(1); |
||||
|
||||
# Create the transformed form data |
||||
my $u = URI->new('http:'); |
||||
|
||||
my $jail = Lemonldap::NG::Handler::Main::Jail->new( |
||||
'safe' => $ntsv->{safe}, |
||||
'useSafeJail' => $tsv->{useSafeJail}, |
||||
'customFunctions' => $tsv->{customFunctions} |
||||
); |
||||
$ntsv->{safe} = $jail->build_safe(); |
||||
|
||||
$u->query_form( { $ntsv->{safe}->reval($data) } ); |
||||
my $s = $u->query(); |
||||
|
||||
# Eat all fake data sent by client |
||||
$l = $f->r->headers_in->{'Content-Length'}; |
||||
while ( $f->read( my $b, $l ) ) { } |
||||
|
||||
# Send to application real data |
||||
$f->r->headers_in->set( 'Content-Length' => length($s) ); |
||||
$f->r->headers_in->set( |
||||
'Content-Type' => 'application/x-www-form-urlencoded' ); |
||||
$f->print($s); |
||||
|
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( "Send POST data $s", |
||||
'debug' ); |
||||
|
||||
# Mark this filter as done |
||||
$f->seen_eos(1); |
||||
} |
||||
return OK; |
||||
} |
||||
|
||||
1; |
||||
@ -0,0 +1,281 @@ |
||||
##@file |
||||
# Auth-basic authentication with Lemonldap::NG rights management |
||||
|
||||
##@class |
||||
# Auth-basic authentication with Lemonldap::NG rights management |
||||
package Lemonldap::NG::Handler::SpecificHandlers::AuthBasic; |
||||
|
||||
use strict; |
||||
|
||||
use Lemonldap::NG::Handler::DefaultHandler qw(:all); |
||||
use Digest::MD5 qw(md5_base64); |
||||
use MIME::Base64; |
||||
use HTTP::Headers; |
||||
use SOAP::Lite; # link protected portalRequest |
||||
use Lemonldap::NG::Handler::Main::Headers; |
||||
use Lemonldap::NG::Handler::Main::Logger; |
||||
|
||||
use base qw(Lemonldap::NG::Handler::DefaultHandler); |
||||
use utf8; |
||||
no utf8; |
||||
|
||||
our $VERSION = '1.2.3'; |
||||
|
||||
# We need just this constant, that's why Portal is 'required' but not 'used' |
||||
*PE_OK = *Lemonldap::NG::Portal::SharedConf::PE_OK; |
||||
|
||||
# Apache constants |
||||
BEGIN { |
||||
if ( MP() == 2 ) { |
||||
*AUTH_REQUIRED = \&Apache2::Const::AUTH_REQUIRED; |
||||
require Apache2::Access; |
||||
} |
||||
elsif ( MP() == 0 ) { |
||||
eval 'sub AUTH_REQUIRED {1}'; |
||||
} |
||||
} |
||||
|
||||
## @rmethod int run(Apache2::RequestRec apacheRequest) |
||||
# overload run subroutine to implement Auth-Basic mechanism. |
||||
# @param $apacheRequest current request |
||||
# @return Apache constant |
||||
sub run ($$) { |
||||
my $class; |
||||
( $class, $apacheRequest ) = splice @_; |
||||
if ( time() - $lastReload > $reloadTime ) { |
||||
unless ( my $tmp = $class->testConf(1) == OK ) { |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"$class: No configuration found", 'error' ); |
||||
return $tmp; |
||||
} |
||||
} |
||||
return DECLINED unless ( $apacheRequest->is_initial_req ); |
||||
my $uri = $apacheRequest->uri |
||||
. ( $apacheRequest->args ? "?" . $apacheRequest->args : "" ); |
||||
|
||||
# AUTHENTICATION |
||||
# I - recover the WWW-Authentication header |
||||
my ( $id, $user, $pass ); |
||||
unless ( |
||||
$user = Lemonldap::NG::Handler::Main::Headers->lmHeaderIn( |
||||
$apacheRequest, 'Authorization' |
||||
) |
||||
) |
||||
{ |
||||
Lemonldap::NG::Handler::Main::Headers->lmSetErrHeaderOut( |
||||
$apacheRequest, |
||||
'WWW-Authenticate' => 'Basic realm="LemonLDAP::NG"' ); |
||||
return AUTH_REQUIRED; |
||||
} |
||||
$user =~ s/^Basic\s*//; |
||||
|
||||
# DEBUG |
||||
$id = md5_base64($user); |
||||
|
||||
# II - recover the user datas |
||||
# 2.1 search if the user was the same as previous (very efficient in |
||||
# persistent connection). |
||||
unless ( $id eq $datas->{_cache_id} ) { |
||||
|
||||
# 2.2 search in the local cache if exists |
||||
unless ($tsv->{refLocalStorage} |
||||
and $datas = $tsv->{refLocalStorage}->get($id) ) |
||||
{ |
||||
|
||||
# 2.3 Authentication by Lemonldap::NG::Portal using SOAP request |
||||
|
||||
# Add client IP as X-Forwarded-For IP in SOAP request |
||||
my $xheader = |
||||
Lemonldap::NG::Handler::Main::Headers->lmHeaderIn( $apacheRequest, |
||||
'X-Forwarded-For' ); |
||||
$xheader .= ", " if ($xheader); |
||||
$xheader .= $class->ip(); |
||||
my $soapHeaders = |
||||
HTTP::Headers->new( "X-Forwarded-For" => $xheader ); |
||||
|
||||
my $soap = |
||||
SOAP::Lite->proxy( $class->portal(), |
||||
default_headers => $soapHeaders ) |
||||
->uri('urn:Lemonldap::NG::Common::CGI::SOAPService'); |
||||
$user = decode_base64($user); |
||||
( $user, $pass ) = ( $user =~ /^(.*?):(.*)$/ ); |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"AuthBasic authentication for user: $user", 'debug' ); |
||||
my $r = $soap->getCookies( $user, $pass ); |
||||
my $cv; |
||||
|
||||
# Catch SOAP errors |
||||
if ( $r->fault ) { |
||||
return $class->abort( "SOAP request to the portal failed: " |
||||
. $r->fault->{faultstring} ); |
||||
} |
||||
else { |
||||
my $res = $r->result(); |
||||
|
||||
# If authentication failed, display error |
||||
if ( $res->{errorCode} ) { |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"Authentication failed for $user: " |
||||
. $soap->error( $res->{errorCode}, 'en' )->result(), |
||||
'notice' |
||||
); |
||||
Lemonldap::NG::Handler::Main::Headers->lmSetErrHeaderOut( |
||||
$apacheRequest, |
||||
'WWW-Authenticate' => 'Basic realm="LemonLDAP::NG"' ); |
||||
return AUTH_REQUIRED; |
||||
} |
||||
$cv = $res->{cookies}->{ $tsv->{cookieName} }; |
||||
} |
||||
|
||||
# Now, normal work to find session |
||||
my %h; |
||||
eval { |
||||
tie %h, $tsv->{globalStorage}, $cv, |
||||
$tsv->{globalStorageOptions}; |
||||
}; |
||||
if ($@) { |
||||
|
||||
# The cookie isn't yet available |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"The cookie $cv isn't yet available: $@", 'info' ); |
||||
$class->updateStatus( $class->ip(), $apacheRequest->uri, |
||||
'EXPIRED' ); |
||||
return $class->goToPortal($uri); |
||||
} |
||||
$datas->{$_} = $h{$_} foreach ( keys %h ); |
||||
$datas->{_cache_id} = $id; |
||||
|
||||
# Store now the user in the local storage |
||||
if ( $tsv->{refLocalStorage} ) { |
||||
$tsv->{refLocalStorage}->set( $id, $datas, "20 minutes" ); |
||||
} |
||||
untie %h; |
||||
} |
||||
} |
||||
|
||||
# ACCOUNTING |
||||
# 1 - Inform Apache |
||||
$class->lmSetApacheUser( $apacheRequest, $datas->{ $tsv->{whatToTrace} } ); |
||||
|
||||
# AUTHORIZATION |
||||
return $class->forbidden($uri) unless ( $class->grant($uri) ); |
||||
$class->updateStatus( $datas->{ $tsv->{whatToTrace} }, |
||||
$apacheRequest->uri, 'OK' ); |
||||
$class->logGranted( $uri, $datas ); |
||||
|
||||
# SECURITY |
||||
# Hide Lemonldap::NG cookie |
||||
$class->hideCookie; |
||||
|
||||
# Hide user password |
||||
Lemonldap::NG::Handler::Main::Headers->lmUnsetHeaderIn( $apacheRequest, |
||||
"Authorization" ); |
||||
|
||||
# ACCOUNTING |
||||
# 2 - Inform remote application |
||||
Lemonldap::NG::Handler::Main::Headers->sendHeaders; |
||||
OK; |
||||
} |
||||
|
||||
__PACKAGE__->init( {} ); |
||||
|
||||
1; |
||||
|
||||
__END__ |
||||
|
||||
=head1 NAME |
||||
|
||||
=encoding utf8 |
||||
|
||||
Lemonldap::NG::Handler::AuthBasic - Perl extension to be able to authenticate |
||||
users by basic web system but to use Lemonldap::NG to control authorizations. |
||||
|
||||
=head1 SYNOPSIS |
||||
|
||||
Create your own package: |
||||
|
||||
package My::Package; |
||||
use Lemonldap::NG::Handler::AuthBasic; |
||||
|
||||
# IMPORTANT ORDER |
||||
our @ISA = qw (Lemonldap::NG::Handler::AuthBasic); |
||||
|
||||
__PACKAGE__->init ( { |
||||
# Local storage used for sessions and configuration |
||||
localStorage => "Cache::DBFile", |
||||
localStorageOptions => {...}, |
||||
# How to get my configuration |
||||
configStorage => { |
||||
type => "DBI", |
||||
dbiChain => "DBI:mysql:database=lemondb;host=$hostname", |
||||
dbiUser => "lemonldap", |
||||
dbiPassword => "password", |
||||
} |
||||
# Uncomment this to activate status module |
||||
# status => 1, |
||||
} ); |
||||
|
||||
Call your package in <apache-directory>/conf/httpd.conf |
||||
|
||||
PerlRequire MyFile |
||||
PerlHeaderParserHandler My::Package |
||||
|
||||
=head1 DESCRIPTION |
||||
|
||||
This library provides a way to use Lemonldap::NG to manage authorizations |
||||
without using Lemonldap::NG for authentications. This can be used in conjunction |
||||
with a normal Lemonldap::NG installation but to manage non-browser clients. |
||||
|
||||
=head1 SEE ALSO |
||||
|
||||
L<Lemonldap::NG::Handler(3)>, |
||||
L<http://lemonldap-ng.org/> |
||||
|
||||
=head1 AUTHOR |
||||
|
||||
=over |
||||
|
||||
=item Clement Oudot, E<lt>clem.oudot@gmail.comE<gt> |
||||
|
||||
=item François-Xavier Deltombe, E<lt>fxdeltombe@gmail.com.E<gt> |
||||
|
||||
=item Xavier Guimard, E<lt>x.guimard@free.frE<gt> |
||||
|
||||
=back |
||||
|
||||
=head1 BUG REPORT |
||||
|
||||
Use OW2 system to report bug or ask for features: |
||||
L<http://jira.ow2.org> |
||||
|
||||
=head1 DOWNLOAD |
||||
|
||||
Lemonldap::NG is available at |
||||
L<http://forge.objectweb.org/project/showfiles.php?group_id=274> |
||||
|
||||
=head1 COPYRIGHT AND LICENSE |
||||
|
||||
=over |
||||
|
||||
=item Copyright (C) 2008, 2009, 2010 by Xavier Guimard, E<lt>x.guimard@free.frE<gt> |
||||
|
||||
=item Copyright (C) 2012, 2013 by François-Xavier Deltombe, E<lt>fxdeltombe@gmail.com.E<gt> |
||||
|
||||
=item Copyright (C) 2010, 2011, 2012 by Clement Oudot, E<lt>clem.oudot@gmail.comE<gt> |
||||
|
||||
=back |
||||
|
||||
This library is free software; you can redistribute it and/or modify |
||||
it under the terms of the GNU General Public License as published by |
||||
the Free Software Foundation; either version 2, or (at your option) |
||||
any later version. |
||||
|
||||
This program is distributed in the hope that it will be useful, |
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of |
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
||||
GNU General Public License for more details. |
||||
|
||||
You should have received a copy of the GNU General Public License |
||||
along with this program. If not, see L<http://www.gnu.org/licenses/>. |
||||
|
||||
=cut |
||||
@ -0,0 +1,381 @@ |
||||
##@file |
||||
# Secure Token |
||||
|
||||
##@class |
||||
# Secure Token |
||||
# |
||||
# Create a secure token used to resolve user identity by a protected application |
||||
package Lemonldap::NG::Handler::SpecificHandlers::SecureToken; |
||||
|
||||
use strict; |
||||
use Lemonldap::NG::Handler::DefaultHandler qw(:all); |
||||
use base qw(Lemonldap::NG::Handler::DefaultHandler); |
||||
use Cache::Memcached; |
||||
use Apache::Session::Generate::MD5; |
||||
use Lemonldap::NG::Handler::Main::Headers; |
||||
use Lemonldap::NG::Handler::Main::Logger; |
||||
|
||||
our $VERSION = '1.1.2'; |
||||
|
||||
# Shared variables |
||||
our ( |
||||
$secureTokenMemcachedServers, $secureTokenExpiration, |
||||
$secureTokenAttribute, $secureTokenUrls, |
||||
$secureTokenHeader, $datas, |
||||
$secureTokenMemcachedConnection, $secureTokenAllowOnError, |
||||
); |
||||
|
||||
BEGIN { |
||||
eval { |
||||
require threads::shared; |
||||
threads::share($secureTokenMemcachedConnection); |
||||
}; |
||||
} |
||||
|
||||
## @imethod protected void globalInit(hashRef args) |
||||
# Overload globalInit to launch this class defaultValuesInit |
||||
# @param $args reference to the configuration hash |
||||
sub globalInit { |
||||
my $class = shift; |
||||
__PACKAGE__->defaultValuesInit(@_); |
||||
$class->SUPER::globalInit(@_); |
||||
} |
||||
|
||||
## @imethod protected void defaultValuesInit(hashRef args) |
||||
# Overload defaultValuesInit |
||||
# @param $args reference to the configuration hash |
||||
sub defaultValuesInit { |
||||
my ( $class, $args ) = splice @_; |
||||
|
||||
# Catch Secure Token parameters |
||||
$secureTokenMemcachedServers = |
||||
$args->{'secureTokenMemcachedServers'} |
||||
|| $secureTokenMemcachedServers |
||||
|| ['127.0.0.1:11211']; |
||||
$secureTokenExpiration = |
||||
$args->{'secureTokenExpiration'} |
||||
|| $secureTokenExpiration |
||||
|| '60'; |
||||
$secureTokenAttribute = |
||||
$args->{'secureTokenAttribute'} |
||||
|| $secureTokenAttribute |
||||
|| 'uid'; |
||||
$secureTokenUrls = $args->{'secureTokenUrls'} || $secureTokenUrls || ['.*']; |
||||
$secureTokenHeader = |
||||
$args->{'secureTokenHeader'} |
||||
|| $secureTokenHeader |
||||
|| 'Auth-Token'; |
||||
$args->{'secureTokenAllowOnError'} = 1 |
||||
unless defined $args->{'secureTokenAllowOnError'}; |
||||
$secureTokenAllowOnError = |
||||
defined $secureTokenAllowOnError |
||||
? $secureTokenAllowOnError |
||||
: $args->{'secureTokenAllowOnError'}; |
||||
|
||||
# Force some parameters to be array references |
||||
foreach (qw/secureTokenMemcachedServers secureTokenUrls/) { |
||||
no strict 'refs'; |
||||
unless ( ref ${$_} eq "ARRAY" ) { |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"Transform $_ value into an array reference", 'debug' ); |
||||
my @array = split( /\s+/, ${$_} ); |
||||
${$_} = \@array; |
||||
} |
||||
} |
||||
|
||||
# Display found values in debug mode |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"secureTokenMemcachedServers: @$secureTokenMemcachedServers", 'debug' ); |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"secureTokenExpiration: $secureTokenExpiration", 'debug' ); |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"secureTokenAttribute: $secureTokenAttribute", 'debug' ); |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"secureTokenUrls: @$secureTokenUrls", 'debug' ); |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"secureTokenHeader: $secureTokenHeader", 'debug' ); |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"secureTokenAllowOnError: $secureTokenAllowOnError", 'debug' ); |
||||
|
||||
# Delete Secure Token parameters |
||||
delete $args->{'secureTokenMemcachedServers'}; |
||||
delete $args->{'secureTokenExpiration'}; |
||||
delete $args->{'secureTokenAttribute'}; |
||||
delete $args->{'secureTokenUrls'}; |
||||
delete $args->{'secureTokenHeader'}; |
||||
delete $args->{'secureTokenAllowOnError'}; |
||||
|
||||
# Call main subroutine |
||||
return $class->SUPER::defaultValuesInit($args); |
||||
} |
||||
|
||||
## @rmethod Apache2::Const run(Apache2::RequestRec r) |
||||
# Overload main run method |
||||
# @param r Current request |
||||
# @return Apache2::Const value (OK, FORBIDDEN, REDIRECT or SERVER_ERROR) |
||||
sub run { |
||||
my $class = shift; |
||||
my $r = $_[0]; |
||||
my $ret = $class->SUPER::run(@_); |
||||
|
||||
# Continue only if user is authorized |
||||
return $ret unless ( $ret == OK ); |
||||
|
||||
# Get current URI |
||||
my $args = $r->args; |
||||
my $uri = $r->uri . ( $args ? "?$args" : "" ); |
||||
|
||||
# Return if we are not on a secure token URL |
||||
my $checkurl = 0; |
||||
foreach (@$secureTokenUrls) { |
||||
if ( $uri =~ m#$_# ) { |
||||
$checkurl = 1; |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"URL $uri detected as an Secure Token URL (rule $_)", 'debug' ); |
||||
last; |
||||
} |
||||
} |
||||
return OK unless ($checkurl); |
||||
|
||||
# Test Memcached connection |
||||
unless ( $class->_isAlive() ) { |
||||
$secureTokenMemcachedConnection = $class->_createMemcachedConnection(); |
||||
} |
||||
|
||||
# Exit if no connection |
||||
return $class->_returnError() unless $class->_isAlive(); |
||||
|
||||
# Value to store |
||||
my $value = $datas->{$secureTokenAttribute}; |
||||
|
||||
# Set token |
||||
my $key = $class->_setToken($value); |
||||
return $class->_returnError() unless $key; |
||||
|
||||
# Header location |
||||
Lemonldap::NG::Handler::Main::Headers->lmSetHeaderIn( $r, |
||||
$secureTokenHeader => $key ); |
||||
|
||||
# Remove token |
||||
eval 'use Apache2::Filter' unless ( $INC{"Apache2/Filter.pm"} ); |
||||
|
||||
$r->add_output_filter( |
||||
sub { |
||||
my $f = shift; |
||||
while ( $f->read( my $buffer, 1024 ) ) { |
||||
$f->print($buffer); |
||||
} |
||||
if ( $f->seen_eos ) { |
||||
$class->_deleteToken($key); |
||||
} |
||||
return OK; |
||||
} |
||||
); |
||||
|
||||
# Return OK |
||||
return OK; |
||||
} |
||||
|
||||
## @method private Cache::Memcached _createMemcachedConnection |
||||
# Create Memcached connexion |
||||
# @return Cache::Memcached object |
||||
sub _createMemcachedConnection { |
||||
my ($class) = splice @_; |
||||
|
||||
# Open memcached connexion |
||||
my $memd = new Cache::Memcached { |
||||
'servers' => $secureTokenMemcachedServers, |
||||
'debug' => 0, |
||||
}; |
||||
|
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( "Memcached connection created", |
||||
'debug' ); |
||||
|
||||
return $memd; |
||||
} |
||||
|
||||
## @method private string _setToken(string value) |
||||
# Set token value |
||||
# @param value Value |
||||
# @return Token key |
||||
sub _setToken { |
||||
my ( $class, $value ) = splice @_; |
||||
|
||||
my $key = Apache::Session::Generate::MD5::generate(); |
||||
|
||||
my $res = |
||||
$secureTokenMemcachedConnection->set( $key, $value, |
||||
$secureTokenExpiration ); |
||||
|
||||
unless ($res) { |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"Unable to store secure token $key", 'error' ); |
||||
return; |
||||
} |
||||
|
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( "Set $value in token $key", |
||||
'info' ); |
||||
|
||||
return $key; |
||||
} |
||||
|
||||
## @method private boolean _deleteToken(string key) |
||||
# Delete token |
||||
# @param key Key |
||||
# @return result |
||||
sub _deleteToken { |
||||
my ( $class, $key ) = splice @_; |
||||
|
||||
my $res = $secureTokenMemcachedConnection->delete($key); |
||||
|
||||
unless ($res) { |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"Unable to delete secure token $key", 'error' ); |
||||
} |
||||
else { |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( "Token $key deleted", |
||||
'info' ); |
||||
} |
||||
|
||||
return $res; |
||||
} |
||||
|
||||
## @method private boolean _isAlive() |
||||
# Run a STATS command to see if Memcached connection is alive |
||||
# @param connection Cache::Memcached object |
||||
# @return result |
||||
sub _isAlive { |
||||
my ($class) = splice @_; |
||||
|
||||
return 0 unless defined $secureTokenMemcachedConnection; |
||||
|
||||
my $stats = $secureTokenMemcachedConnection->stats(); |
||||
|
||||
if ( $stats and defined $stats->{'total'} ) { |
||||
my $total_c = $stats->{'total'}->{'connection_structures'}; |
||||
my $total_i = $stats->{'total'}->{'total_items'}; |
||||
|
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"Memcached connection is alive ($total_c connections / $total_i items)", |
||||
'debug' |
||||
); |
||||
|
||||
return 1; |
||||
} |
||||
|
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"Memcached connection is not alive", 'error' ); |
||||
|
||||
return 0; |
||||
} |
||||
|
||||
## @method private int _returnError() |
||||
# Give hand back to Apache |
||||
# @return Apache2::Const value |
||||
sub _returnError { |
||||
my ($class) = splice @_; |
||||
|
||||
if ($secureTokenAllowOnError) { |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"Allow request without secure token", 'debug' ); |
||||
return OK; |
||||
} |
||||
|
||||
# Redirect or Forbidden? |
||||
if ( $tsv->{useRedirectOnError} ) { |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( "Use redirect for error", |
||||
'debug' ); |
||||
return $class->goToPortal( '/', 'lmError=500' ); |
||||
} |
||||
|
||||
else { |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( "Return error", 'debug' ); |
||||
return SERVER_ERROR; |
||||
} |
||||
} |
||||
|
||||
__PACKAGE__->init( {} ); |
||||
|
||||
1; |
||||
|
||||
__END__ |
||||
|
||||
=head1 NAME |
||||
|
||||
=encoding utf8 |
||||
|
||||
Lemonldap::NG::Handler::SecureToken - Perl extension to generate a secure token |
||||
|
||||
=head1 SYNOPSIS |
||||
|
||||
package My::SecureToken; |
||||
use Lemonldap::NG::Handler::SecureToken; |
||||
@ISA = qw(Lemonldap::NG::Handler::SecureToken); |
||||
|
||||
__PACKAGE__->init ( { |
||||
|
||||
# See Lemonldap::NG::Handler for more |
||||
|
||||
} ); |
||||
1; |
||||
|
||||
=head1 DESCRIPTION |
||||
|
||||
Edit your vhost configuration like this: |
||||
|
||||
<VirtualHost *> |
||||
ServerName secure.example.com |
||||
|
||||
# Load Secure Token Handler |
||||
PerlRequire __HANDLERDIR__/MyHandlerSecureToken.pm |
||||
PerlHeaderParserHandler My::SecureToken |
||||
|
||||
</VirtualHost> |
||||
|
||||
=head2 EXPORT |
||||
|
||||
See L<Lemonldap::NG::Handler> |
||||
|
||||
=head1 SEE ALSO |
||||
|
||||
L<Lemonldap::NG::Handler> |
||||
|
||||
=head1 AUTHOR |
||||
|
||||
=over |
||||
|
||||
=item Clement Oudot, E<lt>clem.oudot@gmail.comE<gt> |
||||
|
||||
=back |
||||
|
||||
=head1 BUG REPORT |
||||
|
||||
Use OW2 system to report bug or ask for features: |
||||
L<http://jira.ow2.org> |
||||
|
||||
=head1 DOWNLOAD |
||||
|
||||
Lemonldap::NG is available at |
||||
L<http://forge.objectweb.org/project/showfiles.php?group_id=274> |
||||
|
||||
=head1 COPYRIGHT AND LICENSE |
||||
|
||||
=over |
||||
|
||||
=item Copyright (C) 2011, 2012 by Clement Oudot, E<lt>clem.oudot@gmail.comE<gt> |
||||
|
||||
=back |
||||
|
||||
This library is free software; you can redistribute it and/or modify |
||||
it under the terms of the GNU General Public License as published by |
||||
the Free Software Foundation; either version 2, or (at your option) |
||||
any later version. |
||||
|
||||
This program is distributed in the hope that it will be useful, |
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of |
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
||||
GNU General Public License for more details. |
||||
|
||||
You should have received a copy of the GNU General Public License |
||||
along with this program. If not, see L<http://www.gnu.org/licenses/>. |
||||
|
||||
@ -0,0 +1,203 @@ |
||||
##@file |
||||
# Sympa autologin |
||||
|
||||
##@class |
||||
# Sympa autologin |
||||
# |
||||
# Build Sympa cookie and send it to Sympa |
||||
package Lemonldap::NG::Handler::SpecificHandlers::SympaAutoLogin; |
||||
|
||||
use strict; |
||||
use Lemonldap::NG::Handler::DefaultHandler qw(:all); |
||||
use base qw(Lemonldap::NG::Handler::DefaultHandler); |
||||
use Digest::MD5; |
||||
use Lemonldap::NG::Handler::Main::Headers; |
||||
use Lemonldap::NG::Handler::Main::Logger; |
||||
|
||||
our $VERSION = '1.1.2'; |
||||
|
||||
# Shared variables |
||||
our ( $sympaSecret, $sympaMailKey ); |
||||
|
||||
## @imethod protected void globalInit(hashRef args) |
||||
# Overload globalInit to launch this class defaultValuesInit |
||||
# @param $args reference to the configuration hash |
||||
sub globalInit { |
||||
my $class = shift; |
||||
__PACKAGE__->defaultValuesInit(@_); |
||||
$class->SUPER::globalInit(@_); |
||||
} |
||||
|
||||
## @imethod protected void defaultValuesInit(hashRef args) |
||||
# Overload defaultValuesInit |
||||
# @param $args reference to the configuration hash |
||||
sub defaultValuesInit { |
||||
my ( $class, $args ) = splice @_; |
||||
|
||||
# Sympa secret should be in configuration |
||||
$sympaSecret = $args->{'sympaSecret'} || $sympaSecret; |
||||
|
||||
# If not, try to read it from /etc/lemonldap-ng/sympa.secret |
||||
if ( !$sympaSecret and -r '/etc/lemonldap-ng/sympa.secret' ) { |
||||
open S, '/etc/lemonldap-ng/sympa.secret' |
||||
or die("Unable to open /etc/lemonldap-ng/sympa.secret"); |
||||
$sympaSecret = join( '', <S> ); |
||||
close S; |
||||
$sympaSecret =~ s/[\r\n]//g; |
||||
} |
||||
|
||||
# Sympa mail key |
||||
$sympaMailKey = $args->{'sympaMailKey'} || $sympaMailKey || "mail"; |
||||
|
||||
# Display found values in debug mode |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( "sympaSecret: $sympaSecret", |
||||
'debug' ); |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( "sympaMailKey: $sympaMailKey", |
||||
'debug' ); |
||||
|
||||
# Delete Sympa parameters |
||||
delete $args->{'sympaSecret'}; |
||||
delete $args->{'sympaMailKey'}; |
||||
|
||||
# Call main subroutine |
||||
return $class->SUPER::defaultValuesInit($args); |
||||
} |
||||
|
||||
## @rmethod Apache2::Const run(Apache2::RequestRec r) |
||||
# Overload main run method |
||||
# @param r Current request |
||||
# @return Apache2::Const value (OK, FORBIDDEN, REDIRECT or SERVER_ERROR) |
||||
sub run { |
||||
my $class = shift; |
||||
my $r = $_[0]; |
||||
my $ret = $class->SUPER::run(@_); |
||||
|
||||
# Continue only if user is authorized |
||||
return $ret unless ( $ret == OK ); |
||||
|
||||
# Fail if no sympaSecret |
||||
return $class->abort("No Sympa secret configured") |
||||
unless ($sympaSecret); |
||||
|
||||
# Mail value |
||||
my $mail = $datas->{$sympaMailKey}; |
||||
|
||||
# Building Sympa cookie |
||||
my $tmp = new Digest::MD5; |
||||
$tmp->reset; |
||||
$tmp->add( $mail . $sympaSecret ); |
||||
my $str = "sympauser=$mail:" . substr( unpack( "H*", $tmp->digest ), -8 ); |
||||
|
||||
# Get cookie header, removing Sympa cookie if exists (avoid security |
||||
# problems) and set the new value |
||||
$tmp = Lemonldap::NG::Handler::Main::Headers->lmHeaderIn( $r, 'Cookie' ); |
||||
$tmp =~ s/\bsympauser=[^,;]*[,;]?//; |
||||
$tmp .= $tmp ? ";$str" : $str; |
||||
Lemonldap::NG::Handler::Main::Headers->lmSetHeaderIn( $r, |
||||
'Cookie' => $tmp ); |
||||
|
||||
# Return SUPER::run() result |
||||
return $ret; |
||||
} |
||||
|
||||
__PACKAGE__->init( {} ); |
||||
|
||||
1; |
||||
|
||||
__END__ |
||||
|
||||
=head1 NAME |
||||
|
||||
=encoding utf8 |
||||
|
||||
Lemonldap::NG::Handler::SympaAutoLogin - Perl extension to generate Sympa cookie |
||||
for users authenticated by LemonLDAP::NG |
||||
|
||||
=head1 SYNOPSIS |
||||
|
||||
package My::Sympa; |
||||
use Lemonldap::NG::Handler::SympaAutoLogin; |
||||
@ISA = qw(Lemonldap::NG::Handler::SympaAutoLogin); |
||||
|
||||
__PACKAGE__->init ( { |
||||
|
||||
# Sympa parameters |
||||
sympaSecret => 'XXXX', |
||||
sympaMailKey => 'mail', |
||||
|
||||
# See Lemonldap::NG::Handler for more |
||||
} ); |
||||
1; |
||||
|
||||
=head1 DESCRIPTION |
||||
|
||||
Lemonldap::NG::Handler::SympaAutoLogin is a special Lemonldap::NG handler that |
||||
generates Sympa cookie for authenticated users. Use it instead of classic |
||||
Lemonldap::NG::Handler to protect your Sympa web server. You have to set the |
||||
configuration key containing user email (parameter sympaMailKey) and to |
||||
store Sympa secret (cookie parameter on Sympa configuration file) in the |
||||
corresponding configuration parameter (sympaSecret) |
||||
|
||||
Edit you Sympa vhost configuration like this: |
||||
|
||||
<VirtualHost *> |
||||
ServerName sympa.example.com |
||||
|
||||
# Load Sympa Handler |
||||
PerlRequire __HANDLERDIR__/MyHandlerSympa.pm |
||||
PerlHeaderParserHandler My::Sympa |
||||
|
||||
</VirtualHost> |
||||
|
||||
=head2 EXPORT |
||||
|
||||
See L<Lemonldap::NG::Handler> |
||||
|
||||
=head1 SEE ALSO |
||||
|
||||
L<Lemonldap::NG::Handler> |
||||
|
||||
=head1 AUTHOR |
||||
|
||||
=over |
||||
|
||||
=item Clement Oudot, E<lt>clem.oudot@gmail.comE<gt> |
||||
|
||||
=item Xavier Guimard, E<lt>x.guimard@free.frE<gt> |
||||
|
||||
=back |
||||
|
||||
=head1 BUG REPORT |
||||
|
||||
Use OW2 system to report bug or ask for features: |
||||
L<http://jira.ow2.org> |
||||
|
||||
=head1 DOWNLOAD |
||||
|
||||
Lemonldap::NG is available at |
||||
L<http://forge.objectweb.org/project/showfiles.php?group_id=274> |
||||
|
||||
=head1 COPYRIGHT AND LICENSE |
||||
|
||||
=over |
||||
|
||||
=item Copyright (C) 2009, 2010 by Xavier Guimard, E<lt>x.guimard@free.frE<gt> |
||||
|
||||
=item Copyright (C) 2010, 2011, 2012 by Clement Oudot, E<lt>clem.oudot@gmail.comE<gt> |
||||
|
||||
=back |
||||
|
||||
This library is free software; you can redistribute it and/or modify |
||||
it under the terms of the GNU General Public License as published by |
||||
the Free Software Foundation; either version 2, or (at your option) |
||||
any later version. |
||||
|
||||
This program is distributed in the hope that it will be useful, |
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of |
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
||||
GNU General Public License for more details. |
||||
|
||||
You should have received a copy of the GNU General Public License |
||||
along with this program. If not, see L<http://www.gnu.org/licenses/>. |
||||
|
||||
=cut |
||||
@ -0,0 +1,159 @@ |
||||
## @file |
||||
# Lemonldap::NG special handler |
||||
|
||||
## @class |
||||
# Lemonldap::NG special handler |
||||
package Lemonldap::NG::Handler::SpecificHandlers::UpdateCookie; |
||||
|
||||
use strict; |
||||
use Lemonldap::NG::Handler::DefaultHandler qw(:all); |
||||
use base qw(Lemonldap::NG::Handler::DefaultHandler); |
||||
use Lemonldap::NG::Handler::Main::Headers; |
||||
use Lemonldap::NG::Handler::Main::Logger; |
||||
|
||||
our $VERSION = '1.0.0'; |
||||
|
||||
## @rmethod int run(Apache2::RequestRec apacheRequest) |
||||
# Main method used to control access. |
||||
# Calls : |
||||
# - fetchId() |
||||
# - fetchUTime() |
||||
# - SUPER::run() |
||||
# @param $apacheRequest Current request |
||||
# @return Apache2::Const value (OK, FORBIDDEN, REDIRECT or SERVER_ERROR) |
||||
sub run { |
||||
my $class = shift; |
||||
$apacheRequest = $_[0]; |
||||
|
||||
# I - Recover the main cookie. |
||||
# If not present, then call parent. |
||||
my $id; |
||||
if ( $id = $class->SUPER::fetchId ) { |
||||
|
||||
# II - Found update cookie. |
||||
# If found, remove session from local cache when utime is recent. |
||||
my $utime; |
||||
if ( $utime = $class->fetchUTime ) { |
||||
my $clear = 0; |
||||
if ( $id eq $datas->{_session_id} and $datas->{_utime} lt $utime ) { |
||||
$datas->{_session_id} = 0; |
||||
$clear = 1; |
||||
} |
||||
elsif ( $tsv->{refLocalStorage} |
||||
and my $ldatas = $tsv->{refLocalStorage}->get($id) ) |
||||
{ |
||||
if ( $ldatas->{_utime} lt $utime ) { |
||||
$clear = 1; |
||||
} |
||||
} |
||||
if ($clear) { |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"$class: remove $id from local cache", 'debug' ); |
||||
$tsv->{refLocalStorage}->remove($id); |
||||
} |
||||
} |
||||
|
||||
} |
||||
|
||||
# III - Call parent process. |
||||
$class->SUPER::run(@_); |
||||
} |
||||
|
||||
## @rmethod protected $ fetchUTime() |
||||
# Get user cookies and search for Lemonldap::NG update cookie. |
||||
# @return Value of the cookie if found, 0 else |
||||
sub fetchUTime { |
||||
my $t = Lemonldap::NG::Handler::Main::Headers->lmHeaderIn( $apacheRequest, |
||||
'Cookie' ); |
||||
my $c = $tsv->{cookieName} . 'update'; |
||||
return ( $t =~ /$c=([^,; ]+)/o ) ? $1 : 0; |
||||
} |
||||
|
||||
__PACKAGE__->init( {} ); |
||||
|
||||
1; |
||||
__END__ |
||||
|
||||
=head1 NAME |
||||
|
||||
=encoding utf8 |
||||
|
||||
Lemonldap::NG::Handler::UpdateCookie - Perl extension to manage update |
||||
cookie sent by client, to reload session in local cache. |
||||
|
||||
=head1 SYNOPSIS |
||||
|
||||
package My::Package; |
||||
use Lemonldap::NG::Handler::UpdateCookie; |
||||
@ISA = qw(Lemonldap::NG::Handler::DefaultHandler); |
||||
|
||||
__PACKAGE__->init ( { |
||||
# See Lemonldap::NG::Handler for more |
||||
# Local storage used for sessions and configuration |
||||
} ); |
||||
|
||||
=head1 DESCRIPTION |
||||
|
||||
Lemonldap::NG::Handler::UpdateCookie is a special Lemonldap::NG:: handler that |
||||
allow a session to be removed from local cache of the current handler, if a |
||||
update cookie is sent by the user. |
||||
|
||||
The update cookie should be name "lemonldapupdate" and only contains a simple |
||||
timestamp. |
||||
|
||||
=head2 EXPORT |
||||
|
||||
See L<Lemonldap::NG::Handler> |
||||
|
||||
=head1 SEE ALSO |
||||
|
||||
L<Lemonldap::NG::Handler> |
||||
|
||||
=head1 AUTHOR |
||||
|
||||
=over |
||||
|
||||
=item Clement Oudot, E<lt>clem.oudot@gmail.comE<gt> |
||||
|
||||
=item Xavier Guimard, E<lt>x.guimard@free.frE<gt> |
||||
|
||||
=item Thomas Chemineau, E<lt>thomas.chemineau@gmail.comE<gt> |
||||
|
||||
=back |
||||
|
||||
=head1 BUG REPORT |
||||
|
||||
Use OW2 system to report bug or ask for features: |
||||
L<http://jira.ow2.org> |
||||
|
||||
=head1 DOWNLOAD |
||||
|
||||
Lemonldap::NG is available at |
||||
L<http://forge.objectweb.org/project/showfiles.php?group_id=274> |
||||
|
||||
=head1 COPYRIGHT AND LICENSE |
||||
|
||||
=over |
||||
|
||||
=item Copyright (C) 2010 by Xavier Guimard, E<lt>x.guimard@free.frE<gt> |
||||
|
||||
=item Copyright (C) 2010, 2012 by Clement Oudot, E<lt>clem.oudot@gmail.comE<gt> |
||||
|
||||
=item Copyright (C) 2010 by Thomas Chemineau, E<lt>thomas.chemineau@gmail.comE<gt> |
||||
|
||||
=back |
||||
|
||||
This library is free software; you can redistribute it and/or modify |
||||
it under the terms of the GNU General Public License as published by |
||||
the Free Software Foundation; either version 2, or (at your option) |
||||
any later version. |
||||
|
||||
This program is distributed in the hope that it will be useful, |
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of |
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
||||
GNU General Public License for more details. |
||||
|
||||
You should have received a copy of the GNU General Public License |
||||
along with this program. If not, see L<http://www.gnu.org/licenses/>. |
||||
|
||||
=cut |
||||
@ -0,0 +1,246 @@ |
||||
##@file |
||||
# Zimbra preauthentication |
||||
|
||||
##@class |
||||
# Zimbra preauthentication |
||||
# |
||||
# It will build Zimbra preauth URL |
||||
package Lemonldap::NG::Handler::SpecificHandlers::ZimbraPreAuth; |
||||
|
||||
use strict; |
||||
use Lemonldap::NG::Handler::DefaultHandler qw(:all); |
||||
use base qw(Lemonldap::NG::Handler::DefaultHandler); |
||||
use Digest::HMAC_SHA1 qw(hmac_sha1 hmac_sha1_hex); |
||||
use Lemonldap::NG::Handler::Main::Headers; |
||||
use Lemonldap::NG::Handler::Main::Logger; |
||||
|
||||
our $VERSION = '1.0.0'; |
||||
|
||||
# Shared variables |
||||
our ( $zimbraPreAuthKey, $zimbraAccountKey, $zimbraBy, $zimbraUrl, |
||||
$zimbraSsoUrl, $timeout ); |
||||
|
||||
## @imethod protected void globalInit(hashRef args) |
||||
# Overload globalInit to launch this class defaultValuesInit |
||||
# @param $args reference to the configuration hash |
||||
sub globalInit { |
||||
my $class = shift; |
||||
__PACKAGE__->defaultValuesInit(@_); |
||||
$class->SUPER::globalInit(@_); |
||||
} |
||||
|
||||
## @imethod protected void defaultValuesInit(hashRef args) |
||||
# Overload defaultValuesInit |
||||
# @param $args reference to the configuration hash |
||||
sub defaultValuesInit { |
||||
my ( $class, $args ) = splice @_; |
||||
|
||||
# Catch Zimbra parameters |
||||
$zimbraPreAuthKey = $args->{'zimbraPreAuthKey'} || $zimbraPreAuthKey; |
||||
$zimbraAccountKey = |
||||
$args->{'zimbraAccountKey'} |
||||
|| $zimbraAccountKey |
||||
|| 'uid'; |
||||
$zimbraBy = $args->{'zimbraBy'} || $zimbraBy || 'id'; |
||||
$zimbraUrl = $args->{'zimbraUrl'} || $zimbraUrl || '/service/preauth'; |
||||
$zimbraSsoUrl = $args->{'zimbraSsoUrl'} || $zimbraSsoUrl || '^/zimbrasso$'; |
||||
$timeout = $args->{'timeout'} || $timeout || '0'; |
||||
|
||||
# Display found values in debug mode |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"zimbraPreAuthKey: $zimbraPreAuthKey", 'debug' ); |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"zimbraAccountKey: $zimbraAccountKey", 'debug' ); |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( "zimbraBy: $zimbraBy", |
||||
'debug' ); |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( "zimbraUrl: $zimbraUrl", |
||||
'debug' ); |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( "zimbraSsoUrl: $zimbraSsoUrl", |
||||
'debug' ); |
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( "timeout: $timeout", 'debug' ); |
||||
|
||||
# Delete Zimbra parameters |
||||
delete $args->{'zimbraPreAuthKey'}; |
||||
delete $args->{'zimbraAccountKey'}; |
||||
delete $args->{'zimbraBy'}; |
||||
delete $args->{'zimbraUrl'}; |
||||
delete $args->{'zimbraSsoUrl'}; |
||||
delete $args->{'timeout'}; |
||||
|
||||
# Call main subroutine |
||||
return $class->SUPER::defaultValuesInit($args); |
||||
} |
||||
|
||||
## @rmethod Apache2::Const run(Apache2::RequestRec r) |
||||
# Overload main run method |
||||
# @param r Current request |
||||
# @return Apache2::Const value (OK, FORBIDDEN, REDIRECT or SERVER_ERROR) |
||||
sub run { |
||||
my $class = shift; |
||||
my $r = $_[0]; |
||||
my $ret = $class->SUPER::run(@_); |
||||
|
||||
# Continue only if user is authorized |
||||
return $ret unless ( $ret == OK ); |
||||
|
||||
# Get current URI |
||||
my $args = $r->args; |
||||
my $uri = $r->uri . ( $args ? "?$args" : "" ); |
||||
|
||||
# Return if we are not on a Zimbra SSO URI |
||||
return OK unless ( $uri =~ $zimbraSsoUrl ); |
||||
|
||||
# Check mandatory parameters |
||||
return $class->abort("No Zimbra preauth key configured") |
||||
unless ($zimbraPreAuthKey); |
||||
|
||||
# Build URL |
||||
my $zimbra_url = $class->_buildZimbraPreAuthUrl( |
||||
$zimbraPreAuthKey, $zimbraUrl, |
||||
$datas->{$zimbraAccountKey}, $zimbraBy |
||||
); |
||||
|
||||
# Header location |
||||
Lemonldap::NG::Handler::Main::Headers->lmSetHeaderOut( $r, |
||||
'Location' => $zimbra_url ); |
||||
|
||||
# Return REDIRECT |
||||
return REDIRECT; |
||||
} |
||||
|
||||
## @method private string _buildZimbraPreAuthUrl(string key, string url, string account, string by) |
||||
# Build Zimbra PreAuth URL |
||||
# @param key PreAuthKey |
||||
# @param url URL |
||||
# @param account User account |
||||
# @param by Account type |
||||
# @return Zimbra PreAuth URL |
||||
sub _buildZimbraPreAuthUrl { |
||||
my ( $class, $key, $url, $account, $by ) = splice @_; |
||||
|
||||
# Expiration time is calculated with _utime and timeout |
||||
my $expires = $timeout ? ( $datas->{_utime} + $timeout ) * 1000 : $timeout; |
||||
|
||||
# Timestamp |
||||
my $timestamp = time() * 1000; |
||||
|
||||
# Compute preauth value |
||||
my $computed_value = |
||||
hmac_sha1_hex( "$account|$by|$expires|$timestamp", $key ); |
||||
|
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"Compute value $account|$by|$expires|$timestamp into $computed_value", |
||||
'debug' ); |
||||
|
||||
# Build PreAuth URL |
||||
my $zimbra_url = |
||||
"$url?account=$account&by=$by×tamp=$timestamp&expires=$expires&preauth=$computed_value"; |
||||
|
||||
Lemonldap::NG::Handler::Main::Logger->lmLog( |
||||
"Build Zimbra URL: $zimbra_url", 'debug' ); |
||||
|
||||
return $zimbra_url; |
||||
} |
||||
|
||||
__PACKAGE__->init( {} ); |
||||
|
||||
1; |
||||
|
||||
__END__ |
||||
|
||||
=head1 NAME |
||||
|
||||
=encoding utf8 |
||||
|
||||
Lemonldap::NG::Handler::ZimbraPreAuth - Perl extension to generate Zimbra preauth URL |
||||
for users authenticated by Lemonldap::NG |
||||
|
||||
=head1 SYNOPSIS |
||||
|
||||
package My::Zimbra; |
||||
use Lemonldap::NG::Handler::ZimbraPreAuth; |
||||
@ISA = qw(Lemonldap::NG::Handler::ZimbraPreAuth); |
||||
|
||||
__PACKAGE__->init ( { |
||||
|
||||
# Zimbra parameters |
||||
zimbraPreAuthKey => 'XXXX', |
||||
zimbraAccountKey => 'uid', |
||||
zimbraBy => 'id', |
||||
zimbraUrl => '/service/preauth', |
||||
zimbraSsoUrl => '^/zimbrasso$', |
||||
|
||||
# Common parameters |
||||
timeout => '72000', |
||||
|
||||
# See Lemonldap::NG::Handler for more |
||||
|
||||
} ); |
||||
1; |
||||
|
||||
=head1 DESCRIPTION |
||||
|
||||
Edit you Zimbra vhost configuration like this: |
||||
|
||||
<VirtualHost *> |
||||
ServerName zimbra.example.com |
||||
|
||||
# Load Zimbra Handler |
||||
PerlRequire __HANDLERDIR__/MyHandlerZimbra.pm |
||||
PerlHeaderParserHandler My::Zimbra |
||||
|
||||
</VirtualHost> |
||||
|
||||
=head2 EXPORT |
||||
|
||||
See L<Lemonldap::NG::Handler> |
||||
|
||||
=head1 SEE ALSO |
||||
|
||||
L<http://wiki.zimbra.com/wiki/Preauth> |
||||
L<Lemonldap::NG::Handler> |
||||
|
||||
=head1 AUTHOR |
||||
|
||||
=over |
||||
|
||||
=item Clement Oudot, E<lt>clem.oudot@gmail.comE<gt> |
||||
|
||||
=item Xavier Guimard, E<lt>x.guimard@free.frE<gt> |
||||
|
||||
=back |
||||
|
||||
=head1 BUG REPORT |
||||
|
||||
Use OW2 system to report bug or ask for features: |
||||
L<http://jira.ow2.org> |
||||
|
||||
=head1 DOWNLOAD |
||||
|
||||
Lemonldap::NG is available at |
||||
L<http://forge.objectweb.org/project/showfiles.php?group_id=274> |
||||
|
||||
=head1 COPYRIGHT AND LICENSE |
||||
|
||||
=over |
||||
|
||||
=item Copyright (C) 2010 by Xavier Guimard, E<lt>x.guimard@free.frE<gt> |
||||
|
||||
=item Copyright (C) 2010, 2012 by Clement Oudot, E<lt>clem.oudot@gmail.comE<gt> |
||||
|
||||
=back |
||||
|
||||
This library is free software; you can redistribute it and/or modify |
||||
it under the terms of the GNU General Public License as published by |
||||
the Free Software Foundation; either version 2, or (at your option) |
||||
any later version. |
||||
|
||||
This program is distributed in the hope that it will be useful, |
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of |
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
||||
GNU General Public License for more details. |
||||
|
||||
You should have received a copy of the GNU General Public License |
||||
along with this program. If not, see L<http://www.gnu.org/licenses/>. |
||||
|
||||
=cut |
||||
Loading…
Reference in new issue