LEMONLDAP::NG : * Handler/SharedConf.pm is more simple now since it use the new Conf.pm capabilities

* CGIs now use abort() instead of die
                * debug system in COnf.pm (set "LogLevel debug" in Apache)
This commit is contained in:
Xavier Guimard 2008-11-21 17:51:52 +00:00
parent 63f196078b
commit 2725f06fd3
12 changed files with 152 additions and 158 deletions

View File

@ -7,6 +7,7 @@ use Lemonldap::NG::Common::Conf::Constants;
our $VERSION = 0.51;
our @ISA;
our $msg;
sub new {
my $class = shift;
@ -21,20 +22,24 @@ sub new {
}
unless ( $self->{mdone} ) {
unless ( $self->{type} ) {
print STDERR "configStorage: type is not defined\n";
$msg = "configStorage: type is not defined\n";
return 0;
}
$self->{type} = "Lemonldap::NG::Common::Conf::$self->{type}"
unless $self->{type} =~ /^Lemonldap/;
eval "require $self->{type}";
die($@) if ($@);
if ($@) {
$msg = "Unknown package $self->{type}";
return 0;
}
return 0 unless $self->prereq;
$self->{mdone}++;
}
$msg = "$self->{type} loaded";
if ( $self->{localStorage} and not defined( $self->{refLocalStorage} ) ) {
eval "use $self->{localStorage};";
if ($@) {
print STDERR "Unable to load $self->{localStorage}: $@" if ($@);
$msg = "Unable to load $self->{localStorage}: $@";
}
else {
$self->{refLocalStorage} =
@ -74,6 +79,7 @@ sub saveConf {
}
}
$fields->{cfgNum} = $self->lastCfg + 1;
$msg = "Configuration $fields->{cfgNum} stored";
return $self->store($fields);
}
@ -83,15 +89,20 @@ sub getConf {
and ref( $self->{refLocalStorage} )
and my $res = $self->{refLocalStorage}->get('conf') )
{
$msg = "get configuration from cache without verification";
return $res;
}
else {
$args->{cfgNum} ||= $self->lastCfg;
unless ( ref( $self->{refLocalStorage} ) ) {
$msg = "get remote configuration (localStorage unavailable)";
return $self->getDBConf($args);
}
my $r = $self->{refLocalStorage}->get('conf');
return $r if ($r->{cfgNum} == $args->{cfgNum});
if ($r->{cfgNum} == $args->{cfgNum}) {
$msg = "configuration unchanged, get configuration from cache";
return $r;
}
return $self->getDBConf($args);
}
}
@ -123,7 +134,10 @@ sub getDBConf {
print STDERR
"Lemonldap::NG : Warning: configuration is in old format, you've to migrate !\n";
eval 'require Storable;require MIME::Base64;';
die($@) if ($@);
if ($@) {
$msg = "Error : $@";
return 0;
}
$conf->{$k} = Storable::thaw( MIME::Base64::decode_base64($v) );
}
else {
@ -141,6 +155,7 @@ sub getDBConf {
$conf->{$k} = $v;
}
}
$msg = "Get configuration $conf->{cfgNum}";
$self->setLocalConf($conf) if ( $self->{refLocalStorage} );
return $conf;
}

View File

@ -14,7 +14,7 @@ BEGIN {
sub prereq {
my $self = shift;
unless ( $self->{dbiChain} ) {
print STDERR 'No dbiChain found';
$Lemonldap::NG::Common::Conf::msg = '"dbiChain" is required in DBI configuration type';
return 0;
}
print STDERR __PACKAGE__ . 'Warning: "dbiUser" parameter is not set'
@ -117,7 +117,7 @@ sub delete {
sub logError {
my $self = shift;
print STDERR "Database error: " . $self->dbh->errstr . "\n";
$Lemonldap::NG::Common::Conf::msg = "Database error: " . $self->dbh->errstr . "\n";
}
1;

View File

@ -8,11 +8,11 @@ our $VERSION = 0.22;
sub prereq {
my $self = shift;
unless ( $self->{dirName} ) {
print STDERR "No directory specified (dirName) !";
$Lemonldap::NG::Common::Conf::msg = '"dirName" is required in "File" configuration type !';
return 0;
}
unless ( -d $self->{dirName} ) {
print STDERR "Directory \"$self->{dirName}\" does not exist !";
$Lemonldap::NG::Common::Conf::msg = "Directory \"$self->{dirName}\" does not exist !";
return 0;
}
1;
@ -40,7 +40,7 @@ sub lock {
return 0 if( $self->isLocked );
}
unless( open F, ">".$self->{dirName} . "/lmConf.lock" ) {
print STDERR "Unable to lock (".$self->{dirName}."/lmConf.lock)\n";
$Lemonldap::NG::Common::Conf::msg = "Unable to lock (".$self->{dirName}."/lmConf.lock)\n";
return 0;
}
print F $$;
@ -63,7 +63,7 @@ sub store {
my $mask = umask;
umask ( oct ( '0027' ) );
unless( open FILE, '>' . $self->{dirName} . "/lmConf-" . $fields->{cfgNum} ) {
print STDERR "Open file failed: $!";
$Lemonldap::NG::Common::Conf::msg = "Open file failed: $!";
$self->unlock;
return UNKNOWN_ERROR;
}

View File

@ -18,7 +18,7 @@ our ( $username, $password ) = ( '', '' );
sub prereq {
my $self = shift;
unless ( $self->{proxy} ) {
print STDERR 'No SOAP parameters found (proxy)';
$Lemonldap::NG::Common::Conf::msg = '"proxy" parameter is required in "SOAP" configuration type';
return 0;
}
1;

View File

@ -19,7 +19,7 @@ sub new {
$self->_handler->init(@_);
$self->_handler->initLocalStorage();
$class->abort("Unable to get configuration")
unless $self->_handler->localConfUpdate() == OK;
unless $self->_handler->testConf() == OK;
# Arguments
my @args = @_;
if(ref($args[0])) {
@ -128,16 +128,9 @@ use Lemonldap::NG::Handler::SharedConf qw(:locationRules :localStorage);
our @ISA = qw(Lemonldap::NG::Handler::SharedConf);
sub localInit {
my($class, $args) = @_;
if($localStorage = $args->{localStorage}) {
$localStorageOptions = $args->{localStorageOptions};
$localStorageOptions->{namespace} ||= "lemonldap";
$localStorageOptions->{default_expires_in} ||= 600;
}
$lmConf = Lemonldap::NG::Common::Conf->new( $args->{configStorage} );
$class->defaultValuesInit($args);
}
sub childInit {1}
sub purgeCache {1}
sub lmLog {
my ( $self, $mess, $level ) = @_;

View File

@ -13,7 +13,6 @@ our $VERSION = '0.62';
our $cfgNum = 0;
our $lastReload = 0;
our $reloadTime;
our $childLock = 0;
our $lmConf;
our $localConfig;
@ -25,7 +24,6 @@ BEGIN {
threads::shared::share($cfgNum);
threads::shared::share($lastReload);
threads::shared::share($reloadTime);
threads::shared::share($childLock);
threads::shared::share($lmConf);
threads::shared::share($localConfig);
};
@ -34,10 +32,9 @@ BEGIN {
*EXPORT_OK = *Lemonldap::NG::Handler::Simple::EXPORT_OK;
push(
@{ $EXPORT_TAGS{$_} },
qw($cfgNum $lastReload $reloadTime $childLock $lmConf $localConfig)
qw($cfgNum $lastReload $reloadTime $lmConf $localConfig)
) foreach (qw(variables localStorage));
push @EXPORT_OK,
qw($cfgNum $lastReload $reloadTime $childLock $lmConf $localConfig);
push @EXPORT_OK, qw($cfgNum $lastReload $reloadTime $lmConf $localConfig);
}
# INIT PROCESS
@ -46,6 +43,12 @@ BEGIN {
sub init($$) {
my ( $class, $args ) = @_;
$reloadTime = $args->{reloadTime} || 600;
# localStorage can be declared in configStorage or at the root or both
foreach (qw(localStorage localStorageOptions)) {
$args->{$_} ||= $args->{configStorage}->{$_};
$args->{configStorage}->{$_} ||= $args->{$_};
}
$localConfig = $args;
$class->localInit($args);
}
@ -55,135 +58,94 @@ sub defaultValuesInit {
my ( $class, $args ) = @_;
# Local configuration overrides global configuration
my %h = (%$args,%$localConfig);
return $class->SUPER::defaultValuesInit(\%h);
my %h = ( %$args, %$localConfig );
return $class->SUPER::defaultValuesInit( \%h );
}
sub localInit {
my ( $class, $args ) = @_;
$lmConf = Lemonldap::NG::Common::Conf->new( $args->{configStorage} );
die("$class : unable to build configuration : $Lemonldap::NG::Common::Conf::msg")
unless($lmConf = Lemonldap::NG::Common::Conf->new( $args->{configStorage} ));
$class->defaultValuesInit($args);
$class->SUPER::localInit($args);
}
# MAIN
# Each $reloadTime, the Apache child verify if its configuration is the same
# as the configuration stored in the local storage.
sub run($$) {
my ( $class, $r ) = @_;
if ( time() - $lastReload > $reloadTime ) {
unless ( $class->localConfUpdate($r) == OK ) {
unless ( my $tmp = $class->testConf(1) == OK ) {
$class->lmLog( "$class: No configuration found", 'error' );
return SERVER_ERROR;
return $tmp;
}
}
return $class->SUPER::run($r);
}
sub logout($$) {
my ( $class, $r ) = @_;
if ( time() - $lastReload > $reloadTime ) {
unless ( $class->localConfUpdate($r) == OK ) {
$class->lmLog( "$class: No configuration found", 'error' );
return SERVER_ERROR;
}
}
return $class->SUPER::logout($r);
}
# CONFIGURATION UPDATE
sub confTest($$) {
my ( $class, $args ) = @_;
if ( $args->{_n_conf} ) {
return 1 if ( $args->{_n_conf} == $cfgNum );
if ($childLock) {
$class->lmLog(
"$class: child $$ detects configuration but local "
. 'storage is locked, continues to work with the old one',
'debug'
);
return 1;
}
$childLock = 1;
$class->globalInit($args);
$childLock = 0;
return 1;
}
return 0;
}
sub localConfUpdate($$) {
my ( $class, $r ) = @_;
my $args;
return SERVER_ERROR unless ($refLocalStorage);
unless ( $args = $refLocalStorage->get("conf") and $class->confTest($args) )
{
# TODO: LOCK
#unless ( $class->confTest($args) ) {
$class->globalConfUpdate($r);
#}
# TODO: UNLOCK;
sub testConf {
my ( $class, $local ) = @_;
my $conf = $lmConf->getConf( { local => $local } );
unless ( ref($conf) ) {
$class->lmLog( "$class: Unable to load configuration : $Lemonldap::NG::Common::Conf::msg", 'error' );
return $cfgNum ? OK : SERVER_ERROR;
}
if ( $cfgNum != $conf->{cfgNum} ) {
$class->lmLog( "$class: get configuration ($Lemonldap::NG::Common::Conf::msg)",
'debug' );
$lastReload = time();
OK;
}
sub globalConfUpdate {
my $class = shift;
my $tmp = $class->getConf;
# getConf can return an Apache constant in case of error
return $tmp unless ( ref($tmp) );
# Local arguments have a best precedence
foreach ( keys %$tmp ) {
$tmp->{$_} = $localConfig->{$_} if ( $localConfig->{$_} );
return $class->setConf($conf);
}
$class->setConf($tmp);
$class->lmLog( "$class: configuration is up to date", 'debug' );
OK;
}
sub setConf {
my ( $class, $args ) = @_;
$cfgNum++;
$args->{_n_conf} = $cfgNum;
$refLocalStorage->set( "conf", $args, $EXPIRES_NEVER );
$class->lmLog( "$class: store configuration " . $args->{cfgNum}, 'debug' );
$class->globalInit($args);
my ( $class, $conf ) = @_;
# Local configuration overrides global configuration
$cfgNum = $conf->{cfgNum};
$conf->{$_} = $localConfig->{$_} foreach ( keys %$localConfig );
$class->globalInit($conf);
OK;
}
sub getConf {
my $class = shift;
my $tmp = $lmConf->getConf;
unless ( ref($tmp) ) {
$class->lmLog( "$class: Unable to load configuration", 'error' );
return SERVER_ERROR;
}
$class->lmLog( "$class: get configuration " . $tmp->{cfgNum}, 'debug' );
return $tmp;
}
# RELOAD SYSTEM
*reload = *refresh;
sub refresh($$) {
my ( $class, $r ) = @_;
$class->lmLog( "$class: request for configuration reload", 'notice' );
$r->handler("perl-script");
if ( $class->testConf(0) == OK ) {
if ( MP() == 2 ) {
if ( $class->globalConfUpdate($r) == OK ) {
$r->push_handlers( 'PerlResponseHandler' =>
sub { my $r = shift; $r->content_type('text/plain'); OK } );
}
else {
$r->push_handlers( 'PerlResponseHandler' => sub { SERVER_ERROR } );
}
}
else {
if ( $class->globalConfUpdate($r) == 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;
}
@ -257,10 +219,6 @@ Like L<Lemonldap::NG::Handler::Simple>::init() but read only localStorage
related options. You may change default time between two configuration checks
with the C<reloadTime> parameter (default 600s).
=head3 getConf
Call Lemonldap::NG::Common::Conf with the configStorage parameter.
=head1 OPERATION
Each new Apache child checks if there's a configuration stored in the local

View File

@ -52,7 +52,7 @@ BEGIN {
$https $port
)
],
log => [qw( lmSetApacheUser lmLog )],
log => [qw(lmSetApacheUser)],
traces => [qw( $whatToTrace $statusPipe $statusOut )],
apache => [qw( MP OK REDIRECT FORBIDDEN DONE DECLINED SERVER_ERROR )],
);
@ -305,25 +305,16 @@ sub localInit($$) {
$localStorageOptions = $args->{localStorageOptions};
$localStorageOptions->{namespace} ||= "lemonldap";
$localStorageOptions->{default_expires_in} ||= 600;
eval "use $localStorage;";
die("Unable to load $localStorage: $@") if ($@);
# At each Apache (re)start, we've to clear the cache to avoid living
# with old datas
eval '$refLocalStorage = new '
. $localStorage
. '($localStorageOptions);';
if ( defined $refLocalStorage ) {
$refLocalStorage->clear();
}
else {
$class->lmLog( "Unable to clear local cache: $@", 'error' );
}
$class->purgeCache();
}
if ( $args->{status} ) {
statusProcess();
}
$class->childInit();
}
sub childInit {
my $class = shift;
# 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
@ -350,6 +341,24 @@ sub localInit($$) {
1;
}
sub purgeCache {
my $class = shift;
eval "use $localStorage;";
die("Unable to load $localStorage: $@") if ($@);
# At each Apache (re)start, we've to clear the cache to avoid living
# with old datas
eval '$refLocalStorage = new '
. $localStorage
. '($localStorageOptions);';
if ( defined $refLocalStorage ) {
$refLocalStorage->clear();
}
else {
$class->lmLog( "Unable to clear local cache: $@", 'error' );
}
}
# Global initialization process :
sub globalInit {
my $class = shift;

View File

@ -33,10 +33,11 @@ sub extractFormInfo {
sub setAuthSessionInfo {
my $self = shift;
# Store submitted password if set in configuration
# WARNING: it can be a security hole
if ( $self->{storePassword} ) {
$self->{sessionInfo}->{'_password'} = $self->{'password'} ;
$self->{sessionInfo}->{'_password'} = $self->{'password'};
}
PE_OK;
}
@ -105,8 +106,9 @@ sub authenticate {
}
}
else {
my $mesg = $self->ldap->bind( $self->{dn}, password => $self->{password} );
return PE_BADCREDENTIALS if ( $mesg->code != 0 ) ;
my $mesg =
$self->ldap->bind( $self->{dn}, password => $self->{password} );
return PE_BADCREDENTIALS if ( $mesg->code != 0 );
}
$self->{sessionInfo}->{authenticationLevel} = 2;
PE_OK;

View File

@ -19,24 +19,25 @@ our ( $defaultCondition, $locationCondition, $locationRegexp, $cfgNum, $path ) =
sub _safe {
my $self = shift;
return $self->{_safe} if($self->{_safe});
return $self->{_safe} if ( $self->{_safe} );
$self->{_safe} = new Safe;
my @t = $self->{customFunctions} ? split( /\s+/, $self->{customFunctions} ) : ();
foreach(@t) {
my @t =
$self->{customFunctions} ? split( /\s+/, $self->{customFunctions} ) : ();
foreach (@t) {
my $sub = $_;
unless(/::/) {
unless (/::/) {
$sub = "$self->{caller}::$_";
}
else {
s/^.*:://;
}
next if(__PACKAGE__->can($_));
next if ( __PACKAGE__->can($_) );
eval "sub $_ {
return $sub(\$path,\@_);
}";
print STDERR "$@\n" if($@);
print STDERR "$@\n" if ($@);
}
$self->{_safe}->share('&encode_base64', @t);
$self->{_safe}->share( '&encode_base64', @t );
return $self->{_safe};
}
@ -386,7 +387,7 @@ sub _changePassword {
return PE_WRONGMANAGERACCOUNT
if ( $mesg->code == 50 || $mesg->code == 8 );
return PE_LDAPERROR unless ( $mesg->code == 0 );
$self->_storePassword( $newpassword );
$self->_storePassword($newpassword);
return PE_PASSWORD_OK;
}
else {
@ -416,7 +417,8 @@ sub _changePassword {
return PE_WRONGMANAGERACCOUNT
if ( $mesg->code == 50 || $mesg->code == 8 );
$self->_storePassword( $newpassword ) && return PE_PASSWORD_OK if ( $mesg->code == 0 );
$self->_storePassword($newpassword) && return PE_PASSWORD_OK
if ( $mesg->code == 0 );
if ( defined $resp ) {
my $pp_error = $resp->pp_error;
@ -444,11 +446,13 @@ sub _changePassword {
# Store new password in session if storePassword parameter is set
sub _storePassword {
my $self = shift;
my ( $password ) = @_;
my ($password) = @_;
if ( $self->{portalObject}->{storePassword} ) {
$self->{portalObject}->{sessionInfo}->{_password} = $password;
# Update session
&Lemonldap::NG::Portal::Simple::updateSession( $self->{portalObject}, { _password => $password } );
&Lemonldap::NG::Portal::Simple::updateSession( $self->{portalObject},
{ _password => $password } );
}
return 1;
}
@ -489,6 +493,7 @@ sub _grant {
$path ||= '/';
$self->_compileRules() if ( $cfgNum != $self->{portalObject}->{cfgNum} );
return -1 unless ( defined( $defaultCondition->{$vhost} ) );
if ( defined $locationRegexp->{$vhost} ) { # Not just a default rule
for ( my $i = 0 ; $i < @{ $locationRegexp->{$vhost} } ; $i++ ) {
if ( $path =~ $locationRegexp->{$vhost}->[$i] ) {

View File

@ -3,7 +3,6 @@ package Lemonldap::NG::Portal::SharedConf;
use strict;
use Lemonldap::NG::Portal::Simple qw(:all);
use Lemonldap::NG::Common::Conf;
use Safe;
*EXPORT_OK = *Lemonldap::NG::Portal::Simple::EXPORT_OK;
*EXPORT_TAGS = *Lemonldap::NG::Portal::Simple::EXPORT_TAGS;

View File

@ -7,14 +7,15 @@ use Exporter 'import';
use warnings;
use MIME::Base64;
use CGI;
use Lemonldap::NG::Common::CGI;
use CGI::Cookie;
require POSIX;
use Lemonldap::NG::Portal::_i18n;
use Safe;
our $VERSION = '0.86';
our @ISA = qw(CGI Exporter);
our @ISA = qw(Lemonldap::NG::Common::CGI Exporter);
# Constants
use constant {
@ -71,12 +72,19 @@ our $self; # Safe cannot share a variable declared with my
sub new {
my $class = shift;
my $self = $class->SUPER::new();
$self->getConf(@_) or $self->abort("Unable to get configuration");
$self->abort("You've to indicate a an Apache::Session storage module !")
$self->getConf(@_)
or $self->abort( "Configuration error",
"Unable to get configuration: $Lemonldap::NG::Common::Conf::msg" );
$self->abort( "Configuration error",
"You've to indicate a an Apache::Session storage module !" )
unless ( $self->{globalStorage} );
eval "require " . $self->{globalStorage};
$self->abort( "Module " . $self->{globalStorage} . " not found in \@INC" ) if ($@);
$self->abort("You've to indicate a domain for cookies") unless ( $self->{domain} );
$self->abort( "Configuration error",
"Module " . $self->{globalStorage} . " not found in \@INC" )
if ($@);
$self->abort( "Configuration error",
"You've to indicate a domain for cookies" )
unless ( $self->{domain} );
$self->{domain} =~ s/^([^\.])/.$1/;
$self->{securedCookie} ||= 0;
$self->{cookieName} ||= "lemonldap";
@ -92,7 +100,7 @@ sub new {
. $self->{$_};
$tmp =~ s/\s.*$//;
eval "require $tmp";
$self->abort($@) if ($@);
$self->abort( "Configuration error", $@ ) if ($@);
push @ISA, $tmp;
# $self->{authentication} and $self->{userDB} can contains arguments
@ -244,7 +252,7 @@ sub getSessionInfo {
# TODO: update all caches
sub updateSession {
my $self = shift;
my ( $infos ) = @_;
my ($infos) = @_;
my %cookies = fetch CGI::Cookie;
# Test if Lemonldap::NG cookie is available
@ -346,6 +354,7 @@ sub controlExistingSession {
# Store IP address
$self->{sessionInfo}->{ipAddr} = $ENV{REMOTE_ADDR};
# Test if Lemonldap::NG cookie is available
if ( $cookies{ $self->{cookieName} }
and my $id = $cookies{ $self->{cookieName} }->value )
@ -408,6 +417,7 @@ sub controlExistingSession {
}
sub existingSession {
#my ( $self, $id, $datas ) = @_;
PE_OK;
}
@ -449,12 +459,14 @@ sub setMacros {
sub setGroups {
local $self = shift;
my $groups;
#foreach ( keys %{ $self->{groups} } ) {
while ( my ( $group, $expr ) = each %{ $self->{groups} } ) {
$expr =~ s/\$(\w+)/\$self->{sessionInfo}->{$1}/g;
# TODO : custom Functions
$safe->share( '$self', '&encode_base64' );
$groups .= "$group " if( $safe->reval($expr) );
$groups .= "$group " if ( $safe->reval($expr) );
}
if ( $self->{ldapGroupBase} ) {
my $mesg = $self->{ldap}->search(

View File

@ -58,8 +58,9 @@ sub bind {
$args{password} ||= $self->{portal}->{managerPassword};
if ( $dn && $args{password} ) {
$mesg = $self->SUPER::bind( $dn, %args );
} else {
$mesg = $self->SUPER::bind( );
}
else {
$mesg = $self->SUPER::bind();
}
return $mesg;
}