completion of initial depot
This commit is contained in:
Eric German
parent
24d75a9acb
commit
d59e850519
|
|
@ -5,4 +5,8 @@ Revision history for Perl extension Lemonldap::Config::Parameters.
|
|||
-XAn Lemonldap::Config::Parameters
|
||||
3.0.0 Thu Jun 29 15:08:00 2006
|
||||
- bigbang in parameters
|
||||
3.1.0 Wed Oct 25 15:08:00 2006
|
||||
- add new parameters
|
||||
- giving up compatibility with old modperl API.
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
NAME
|
||||
Lemonldap::Config::Parameters - Backend of configuration for lemonldap
|
||||
web-SSO system
|
||||
Lemonldap::Config::Parameters - Backend of configuration for lemonldap
|
||||
web SSO system
|
||||
|
||||
SYNOPSIS
|
||||
#!/usr/bin/perl
|
||||
|
|
@ -34,7 +34,7 @@ INSTALLATION
|
|||
make install
|
||||
|
||||
DESCRIPTION
|
||||
Lemonldap is a WEBSSO framework system under GPL.
|
||||
Lemonldap is a WEB SSO framework system under GPL.
|
||||
|
||||
Login page , handlers must retrieve their configs in an unique file eg
|
||||
:"applications.xml".
|
||||
|
|
|
|||
|
|
@ -1,130 +1,129 @@
|
|||
package Lemonldap::Config::Initparam;
|
||||
use Apache::Table;
|
||||
use APR::Table;
|
||||
use Lemonldap::Config::Parameters;
|
||||
use Data::Dumper;
|
||||
our $VERSION = '3.0.0';
|
||||
our $VERSION = '3.1.0';
|
||||
|
||||
##########################
|
||||
##########################
|
||||
sub init_param_httpd {
|
||||
##########################
|
||||
# parameter input
|
||||
# parameter input
|
||||
my $log = shift;
|
||||
my ($__c) = @_;
|
||||
my ($__c) =@_;
|
||||
|
||||
#declaration
|
||||
#declaration
|
||||
my %__config;
|
||||
my $__param = {
|
||||
'portal' => 'PORTAL',
|
||||
'basepub' => 'BASEPUB',
|
||||
'loginpage' => 'LOGINPAGE',
|
||||
'sslerrorpage' => 'SSLERRORPAGE',
|
||||
'basepriv' => 'BASEPRIV',
|
||||
'domain' => 'DOMAIN',
|
||||
'handlerid' => 'HANDLERID',
|
||||
'configfile' => 'CONFIGFILE',
|
||||
'configttl' => 'CONFIGTTL',
|
||||
'configdbpath' => 'CONFIGDBPATH',
|
||||
'enablelwp' => 'ENABLELWP',
|
||||
'cachedbpath' => 'CACHEDBPATH',
|
||||
'organization' => 'ORGANIZATION',
|
||||
'applcode' => 'APPLCODE',
|
||||
'disableaccesscontrol' => 'DISABLEACCESSCONTROL',
|
||||
'sessionstore' => 'SESSIONSTORE',
|
||||
'stopcookie' => 'STOPCOOKIE',
|
||||
'chaseredirect' => 'CHASEREDIRECT',
|
||||
'applproxy' => 'APPLPROXY',
|
||||
'fastpatterns' => 'FASTPATTERNS',
|
||||
'multihoming' => 'MULTIHOMING',
|
||||
'lwptimeout' => 'LWPTIMEOUT',
|
||||
'softcontrol' => 'SOFTCONTROL',
|
||||
'sendheader' => 'SENDHEADER',
|
||||
'allow' => 'ALLOW',
|
||||
'pluginpolicy' => 'PLUGINPOLICY',
|
||||
'regexpmatrixpolicy' => 'REGEXPMATRIXPOLICY',
|
||||
'rewritehtmlplugin' => 'REWRITEHTMLPLUGIN',
|
||||
'headerplugin' => 'HEADERPLUGIN',
|
||||
'sessionstoreplugin' => 'SESSIONSTOREPLUGIN',
|
||||
'ldapuserattributes' => 'LDAPUSERATTRIBUTES',
|
||||
'https' => 'HTTPS',
|
||||
'auth' => 'AUTH',
|
||||
'pkcs12' => 'PKCS12',
|
||||
'pkcs12_pwd' => 'PKCS12_PWD',
|
||||
'cert_file' => 'CERT_FILE',
|
||||
'key_file' => 'KEY_FILE',
|
||||
'cookie' => 'COOKIE',
|
||||
'accesspolicy' => 'ACCESSPOLICY',
|
||||
'inactivitytimeout' => 'INACTIVITYTIMEOUT',
|
||||
'encryptionkey' => 'ENCRYPTIONKEY',
|
||||
'clientipcheck' => 'CLIENTIPCHECK',
|
||||
'sesscacherefreshperiod' => 'SESSCACHEREFRESHPERIOD',
|
||||
'motifin' => 'MOTIFIN',
|
||||
'motifout' => 'MOTIFOUT',
|
||||
'ldap_server' => 'LDAP_SERVER',
|
||||
'ldap_port' => 'LDAP_PORT',
|
||||
'ldapfilterattribute' => 'LDAPFILTERATTRIBUTE',
|
||||
'dnmanager' => 'DNMANAGER',
|
||||
'passwordmanager' => 'PASSWORDMANAGER',
|
||||
'ldap_branch_people' => 'LDAP_BRANCH_PEOPLE',
|
||||
'sessionparams' => 'SESSIONPARAMS',
|
||||
'commandopenssl' => 'COMMANDOPENSSL',
|
||||
'doverify' => 'DOVERIFY',
|
||||
'doocsp' => 'DOOCSP',
|
||||
'doldap' => 'DOLDAP',
|
||||
'verifycapath' => 'VERIFYCAPATH',
|
||||
'verifyoptions' => 'VERIFYOPTIONS',
|
||||
'ocspurl' => 'OCSPURL',
|
||||
'ocspoptions' => 'OCSPOPTIONS',
|
||||
'sslerrorcode' => 'SSLERRORCODE'
|
||||
my $__param = {
|
||||
'portal' => 'PORTAL',
|
||||
'basepub' => 'BASEPUB',
|
||||
'loginpage' => 'LOGINPAGE',
|
||||
'sslerrorpage' => 'SSLERRORPAGE',
|
||||
'basepriv' => 'BASEPRIV',
|
||||
'domain' => 'DOMAIN',
|
||||
'handlerid' => 'HANDLERID' ,
|
||||
'configfile' => 'CONFIGFILE',
|
||||
'configttl' => 'CONFIGTTL',
|
||||
'configdbpath' => 'CONFIGDBPATH',
|
||||
'enablelwp' => 'ENABLELWP',
|
||||
'cachedbpath' => 'CACHEDBPATH',
|
||||
'organization' => 'ORGANIZATION',
|
||||
'applcode' => 'APPLCODE',
|
||||
'disableaccesscontrol' => 'DISABLEACCESSCONTROL',
|
||||
'sessionstore' => 'SESSIONSTORE',
|
||||
'stopcookie' => 'STOPCOOKIE',
|
||||
'chaseredirect' => 'CHASEREDIRECT',
|
||||
'applproxy' => 'APPLPROXY',
|
||||
'fastpatterns' => 'FASTPATTERNS',
|
||||
'multihoming' => 'MULTIHOMING',
|
||||
'lwptimeout' => 'LWPTIMEOUT',
|
||||
'softcontrol' =>'SOFTCONTROL',
|
||||
'sendheader' =>'SENDHEADER',
|
||||
'allow' =>'ALLOW',
|
||||
'pluginpolicy' =>'PLUGINPOLICY',
|
||||
'regexpmatrixpolicy' =>'REGEXPMATRIXPOLICY',
|
||||
'rewritehtmlplugin' =>'REWRITEHTMLPLUGIN',
|
||||
'headerplugin' =>'HEADERPLUGIN',
|
||||
'sessionstoreplugin' =>'SESSIONSTOREPLUGIN',
|
||||
'ldapuserattributes' => 'LDAPUSERATTRIBUTES',
|
||||
'https' =>'HTTPS' ,
|
||||
'auth' => 'AUTH',
|
||||
'pkcs12' => 'PKCS12',
|
||||
'pkcs12_pwd' => 'PKCS12_PWD',
|
||||
'cert_file' => 'CERT_FILE' ,
|
||||
'key_file' => 'KEY_FILE',
|
||||
'cookie' => 'COOKIE' ,
|
||||
'accesspolicy' => 'ACCESSPOLICY',
|
||||
'inactivitytimeout' => 'INACTIVITYTIMEOUT',
|
||||
'encryptionkey' => 'ENCRYPTIONKEY',
|
||||
'clientipcheck' => 'CLIENTIPCHECK',
|
||||
'sesscacherefreshperiod' => 'SESSCACHEREFRESHPERIOD',
|
||||
'motifin' =>'MOTIFIN',
|
||||
'motifout' => 'MOTIFOUT',
|
||||
'ldap_server' => 'LDAP_SERVER',
|
||||
'ldap_port' => 'LDAP_PORT',
|
||||
'ldapfilterattribute' => 'LDAPFILTERATTRIBUTE',
|
||||
'dnmanager' => 'DNMANAGER',
|
||||
'passwordmanager' => 'PASSWORDMANAGER',
|
||||
'ldap_branch_people' => 'LDAP_BRANCH_PEOPLE',
|
||||
'sessionparams' => 'SESSIONPARAMS',
|
||||
'commandopenssl' => 'COMMANDOPENSSL',
|
||||
'doverify' => 'DOVERIFY',
|
||||
'doocsp' => 'DOOCSP',
|
||||
'doldap' => 'DOLDAP',
|
||||
'verifycapath' => 'VERIFYCAPATH',
|
||||
'verifyoptions' => 'VERIFYOPTIONS',
|
||||
'ocspurl' => 'OCSPURL',
|
||||
'ocspoptions' => 'OCSPOPTIONS',
|
||||
'sslerrorcode' => 'SSLERRORCODE',
|
||||
'postlogouturl' => 'POSTLOGOUTURL',
|
||||
'directorytype' => 'DIRECTORYTYPE',
|
||||
'excluderegex' => 'EXCLUDEREGEX',
|
||||
|
||||
};
|
||||
};
|
||||
# input
|
||||
foreach (keys %$__c)
|
||||
{
|
||||
my $lkey =lc($_);
|
||||
my $val = $__c->get($_);
|
||||
#modif
|
||||
if($lkey eq 'basepriv'){
|
||||
if ($val=~/\/$/){
|
||||
chop($val);
|
||||
|
||||
# input
|
||||
foreach ( keys %$__c ) {
|
||||
my $lkey = lc($_);
|
||||
my $val = $__c->get($_);
|
||||
}
|
||||
}
|
||||
|
||||
#modif
|
||||
if ( $lkey eq 'basepriv' ) {
|
||||
if ( $val =~ /\/$/ ) {
|
||||
chop($val);
|
||||
#modif
|
||||
|
||||
}
|
||||
}
|
||||
my $mkey = $__param->{$lkey};
|
||||
if ($mkey)
|
||||
{
|
||||
$__config{$mkey} = $val;
|
||||
}else
|
||||
{
|
||||
$log->error("lemonldap Initparam $_ : not valid parameter name");
|
||||
}
|
||||
}
|
||||
|
||||
#modif
|
||||
|
||||
my $mkey = $__param->{$lkey};
|
||||
if ($mkey) {
|
||||
$__config{$mkey} = $val;
|
||||
}
|
||||
else {
|
||||
$log->error("lemonldap Initparam $_ : not valid parameter name");
|
||||
}
|
||||
}
|
||||
|
||||
## work is done tel this
|
||||
## work is done tel this
|
||||
## load session info
|
||||
my $CONF = Lemonldap::Config::Parameters->new(
|
||||
file => $__config{CONFIGFILE},
|
||||
cache => $__config{CONFIGDBPATH}
|
||||
);
|
||||
if ( defined( $__config{SESSIONPARAMS} ) ) {
|
||||
my $sessionparams = $__config{SESSIONPARAMS};
|
||||
$__config{STR_SERVERS} = $sessionparams;
|
||||
$__config{SERVERS} = $CONF->formateLineHash($sessionparams);
|
||||
}
|
||||
elsif ( defined( $__config{SESSIONSTORE} ) ) {
|
||||
my $xmlsession =
|
||||
$CONF->findParagraph( 'session', $__config{SESSIONSTORE} );
|
||||
$__config{STR_SERVERS} = $xmlsession->{SessionParams};
|
||||
$__config{SERVERS} =
|
||||
$CONF->formateLineHash( $xmlsession->{SessionParams} );
|
||||
}
|
||||
my $CONF= Lemonldap::Config::Parameters->new ( file => $__config{CONFIGFILE},cache => $__config{CONFIGDBPATH} );
|
||||
if( defined ($__config{SESSIONPARAMS}) ){
|
||||
my $sessionparams= $__config{SESSIONPARAMS};
|
||||
$__config{STR_SERVERS}= $sessionparams;
|
||||
$__config{SERVERS} = $CONF->formateLineHash ($sessionparams);
|
||||
}
|
||||
elsif( defined ($__config{SESSIONSTORE}) ){
|
||||
my $xmlsession= $CONF->findParagraph('session',$__config{SESSIONSTORE});
|
||||
$__config{STR_SERVERS}= $xmlsession->{SessionParams};
|
||||
$__config{SERVERS} = $CONF->formateLineHash ($xmlsession->{SessionParams});
|
||||
}
|
||||
|
||||
$__config{'HTTPD'} = 1;
|
||||
$__config{'HTTPD'} =1;
|
||||
|
||||
return (\%__config );
|
||||
|
||||
return ( \%__config );
|
||||
|
||||
}
|
||||
|
||||
|
|
@ -132,185 +131,177 @@ sub init_param_httpd {
|
|||
##########################
|
||||
sub init_param_xml {
|
||||
##########################
|
||||
my ($cn) = @_;
|
||||
my $__config;
|
||||
my %CONFIG = %$cn;
|
||||
my $GENERAL;
|
||||
my $tmpconf;
|
||||
my $message;
|
||||
my $__param = {
|
||||
'inactivitytimeout' => 'INACTIVITYTIMEOUT',
|
||||
'encryptionkey' => 'ENCRYPTIONKEY',
|
||||
'clientipcheck' => 'CLIENTIPCHECK',
|
||||
'cookie' => 'COOKIE',
|
||||
'portal' => 'PORTAL',
|
||||
'sessionstore' => 'SESSIONSTORE',
|
||||
'softcontrol' => 'SOFTCONTROL',
|
||||
'sesscacherefreshperiod' => 'SESSCACHEREFRESHPERIOD',
|
||||
'lwptimeout' => 'LWPTIMEOUT',
|
||||
'sendheader' => 'SENDHEADER',
|
||||
'allow' => 'ALLOW',
|
||||
'pluginpolicy' => 'PLUGINPOLICY',
|
||||
'rewritehtmlplugin' => 'REWRITEHTMLPLUGIN',
|
||||
'sessionstoreplugin' => 'SESSIONSTOREPLUGIN',
|
||||
'headerplugin' => 'HEADERPLUGIN',
|
||||
'https' => 'HTTPS',
|
||||
'auth' => 'AUTH',
|
||||
'pkcs12' => 'PKCS12',
|
||||
'pkcs12_pwd' => 'PKCS12_PWD',
|
||||
'cert_file' => 'cert_file',
|
||||
'key_file' => 'key_file',
|
||||
'ldap_server' => 'LDAP_SERVER',
|
||||
'ldap_port' => 'LDAP_PORT',
|
||||
'dnmanager' => 'DNMANAGER',
|
||||
'passwordmanager' => 'PASSWORDMANAGER',
|
||||
'ldap_branch_people' => 'LDAP_BRANCH_PEOPLE'
|
||||
};
|
||||
my $__param_loc = {
|
||||
'enablelwp' => 'ENABLELWP',
|
||||
'organization' => 'ORGANIZATION',
|
||||
'applcode' => 'APPLCODE',
|
||||
'disableaccessControl' => 'DISABLEACCESSCONTROL',
|
||||
'basepub' => 'BASEPUB',
|
||||
'basepriv' => 'BASEPRIV',
|
||||
'stopcookie' => 'STOPCOOKIE',
|
||||
'chaseredirect' => 'CHASEREDIRECT',
|
||||
'portal' => 'PORTAL',
|
||||
'fastpatterns' => 'FASTPATTERNS',
|
||||
'multihoming' => 'MULTIHOMING',
|
||||
'motifin' => 'MOTIFIN',
|
||||
'motifout' => 'MOTIFOUT',
|
||||
'lwptimeout' => 'LWPTIMEOUT',
|
||||
'softcontrol' => 'SOFTCONTROL',
|
||||
'sendheader' => 'SENDHEADER',
|
||||
'allow' => 'ALLOW',
|
||||
'pluginpolicy' => 'PLUGINPOLICY',
|
||||
'rewritehtmlplugin' => 'REWRITEHTMLPLUGIN',
|
||||
'sessionstoreplugin' => 'SESSIONSTOREPLUGIN',
|
||||
'headerplugin' => 'HEADERPLUGIN',
|
||||
'https' => 'HTTPS',
|
||||
'auth' => 'AUTH',
|
||||
'pkcs12' => 'PKCS12',
|
||||
'pkcs12_PWD' => 'PKCS12_PWD',
|
||||
'cert_file' => 'CERT_FILE',
|
||||
'key_file' => 'KEY_FILE',
|
||||
};
|
||||
my $CONF = Lemonldap::Config::Parameters->new(
|
||||
file => $CONFIG{CONFIGFILE},
|
||||
cache => $CONFIG{CONFIGDBPATH}
|
||||
);
|
||||
|
||||
my ($cn ) = @_;
|
||||
my $__config;
|
||||
my %CONFIG=%$cn;
|
||||
my $GENERAL;
|
||||
my $tmpconf;
|
||||
my $message;
|
||||
my $__param = {
|
||||
'inactivitytimeout' => 'INACTIVITYTIMEOUT',
|
||||
'encryptionkey' => 'ENCRYPTIONKEY',
|
||||
'clientipcheck' => 'CLIENTIPCHECK',
|
||||
'cookie' => 'COOKIE' ,
|
||||
'portal' => 'PORTAL',
|
||||
'sessionstore' => 'SESSIONSTORE',
|
||||
'softcontrol' =>'SOFTCONTROL',
|
||||
'sesscacherefreshperiod' => 'SESSCACHEREFRESHPERIOD',
|
||||
'lwptimeout' =>'LWPTIMEOUT',
|
||||
'sendheader' => 'SENDHEADER' ,
|
||||
'allow' =>'ALLOW',
|
||||
'pluginpolicy' =>'PLUGINPOLICY',
|
||||
'rewritehtmlplugin' =>'REWRITEHTMLPLUGIN',
|
||||
'sessionstoreplugin' =>'SESSIONSTOREPLUGIN',
|
||||
'headerplugin' =>'HEADERPLUGIN',
|
||||
'https' =>'HTTPS' ,
|
||||
'auth' => 'AUTH',
|
||||
'pkcs12' => 'PKCS12',
|
||||
'pkcs12_pwd' => 'PKCS12_PWD',
|
||||
'cert_file' => 'cert_file' ,
|
||||
'key_file' => 'key_file',
|
||||
'ldap_server' => 'LDAP_SERVER',
|
||||
'ldap_port' => 'LDAP_PORT',
|
||||
'dnmanager' => 'DNMANAGER',
|
||||
'passwordmanager' => 'PASSWORDMANAGER',
|
||||
'ldap_branch_people' => 'LDAP_BRANCH_PEOPLE'
|
||||
};
|
||||
my $__param_loc = {
|
||||
'enablelwp' => 'ENABLELWP' ,
|
||||
'organization' =>'ORGANIZATION',
|
||||
'applcode' => 'APPLCODE',
|
||||
'disableaccessControl' => 'DISABLEACCESSCONTROL' ,
|
||||
'basepub' => 'BASEPUB' ,
|
||||
'basepriv' => 'BASEPRIV',
|
||||
'stopcookie' => 'STOPCOOKIE' ,
|
||||
'chaseredirect' => 'CHASEREDIRECT' ,
|
||||
'portal' => 'PORTAL',
|
||||
'fastpatterns' => 'FASTPATTERNS',
|
||||
'multihoming' => 'MULTIHOMING',
|
||||
'motifin' =>'MOTIFIN',
|
||||
'motifout' => 'MOTIFOUT',
|
||||
'lwptimeout' => 'LWPTIMEOUT',
|
||||
'softcontrol' =>'SOFTCONTROL',
|
||||
'sendheader' => 'SENDHEADER',
|
||||
'allow' =>'ALLOW',
|
||||
'pluginpolicy' =>'PLUGINPOLICY',
|
||||
'rewritehtmlplugin' =>'REWRITEHTMLPLUGIN',
|
||||
'sessionstoreplugin' =>'SESSIONSTOREPLUGIN',
|
||||
'headerplugin' =>'HEADERPLUGIN',
|
||||
'https' =>'HTTPS' ,
|
||||
'auth' => 'AUTH',
|
||||
'pkcs12' => 'PKCS12',
|
||||
'pkcs12_PWD' => 'PKCS12_PWD',
|
||||
'cert_file' => 'CERT_FILE' ,
|
||||
'key_file' => 'KEY_FILE',
|
||||
};
|
||||
my $CONF= Lemonldap::Config::Parameters->new (
|
||||
file => $CONFIG{CONFIGFILE} ,
|
||||
cache => $CONFIG{CONFIGDBPATH} );
|
||||
if ($CONF) {
|
||||
$message =
|
||||
"$CONFIG{HANDLERID}: Phase : handler initialization LOAD XML conf :succeded";
|
||||
}
|
||||
else {
|
||||
$message =
|
||||
"$CONFIG{HANDLERID}: Phase : handler initialization LOAD XML conf : failed";
|
||||
}
|
||||
if ( $CONFIG{DOMAIN} ) {
|
||||
$GENERAL = $CONF->getDomain( $CONFIG{DOMAIN} );
|
||||
$tmpconf = $GENERAL->{handler}->{ $CONFIG{HANDLERID} };
|
||||
foreach ( keys %$__param ) {
|
||||
my $key = $__param->{$_};
|
||||
$__config{$key} = $GENERAL->{ lc($_) }
|
||||
if defined( $GENERAL->{ lc($_) } );
|
||||
}
|
||||
|
||||
}
|
||||
else {
|
||||
$tmpconf = $CONF->{ $CONFIG{HANDLERID} };
|
||||
}
|
||||
## load session info
|
||||
my $xmlsession = $CONF->findParagraph( 'session', $__config{SESSIONSTORE} );
|
||||
$__config{STR_SERVERS} = $xmlsession->{SessionParams};
|
||||
$__config{SERVERS} = $CONF->formateLineHash( $xmlsession->{SessionParams} );
|
||||
$message="$CONFIG{HANDLERID}: Phase : handler initialization LOAD XML conf :succeded"; }
|
||||
else {
|
||||
$message="$CONFIG{HANDLERID}: Phase : handler initialization LOAD XML conf : failed";
|
||||
}
|
||||
if ($CONFIG{DOMAIN}) {
|
||||
$GENERAL = $CONF->getDomain($CONFIG{DOMAIN}) ;
|
||||
$tmpconf = $GENERAL->{handler}->{$CONFIG{HANDLERID}};
|
||||
foreach (keys %$__param ) {
|
||||
my $key = $__param->{$_};
|
||||
$__config{$key} = $GENERAL->{lc($_)} if defined ($GENERAL->{lc($_)}) ;
|
||||
}
|
||||
|
||||
} else {
|
||||
$tmpconf= $CONF->{$CONFIG{HANDLERID}} ;
|
||||
}
|
||||
## load session info
|
||||
my $xmlsession= $CONF->findParagraph('session',$__config{SESSIONSTORE});
|
||||
$__config{STR_SERVERS}= $xmlsession->{SessionParams};
|
||||
$__config{SERVERS} = $CONF->formateLineHash ($xmlsession->{SessionParams});
|
||||
|
||||
|
||||
### parse local conf #####
|
||||
|
||||
foreach ( keys %$__param_loc ) {
|
||||
my $key = $__param_loc->{$_};
|
||||
foreach (keys %$__param_loc ) {
|
||||
my $key = $__param_loc->{$_};
|
||||
# $__config{$key} = lc($tmpconf->{$_}) if defined ($tmpconf->{$_}) ;
|
||||
$__config{$key} = $tmpconf->{lc($_)} if defined ($tmpconf->{lc($_)}) ;
|
||||
|
||||
# $__config{$key} = lc($tmpconf->{$_}) if defined ($tmpconf->{$_}) ;
|
||||
$__config{$key} = $tmpconf->{ lc($_) }
|
||||
if defined( $tmpconf->{ lc($_) } );
|
||||
}
|
||||
$__config{'OK'} =1;
|
||||
$__config{'message '} =$message;
|
||||
## addon multihoming
|
||||
my $lig;
|
||||
$lig= $CONFIG{MULTIHOMING} || $__config{MULTIHOMING} ;
|
||||
if ($lig ) {
|
||||
my @lmh= split "," ,$lig;
|
||||
my @__TABLEMH=();
|
||||
my %__HASHMH =();
|
||||
foreach (@lmh) {
|
||||
my $clmh = $GENERAL->{handler}->{$_};
|
||||
my %__tmp;
|
||||
foreach (keys %$__param_loc ) {
|
||||
|
||||
}
|
||||
$__config{'OK'} = 1;
|
||||
$__config{'message '} = $message;
|
||||
## addon multihoming
|
||||
my $lig;
|
||||
$lig = $CONFIG{MULTIHOMING} || $__config{MULTIHOMING};
|
||||
if ($lig) {
|
||||
my @lmh = split ",", $lig;
|
||||
my @__TABLEMH = ();
|
||||
my %__HASHMH = ();
|
||||
foreach (@lmh) {
|
||||
my $clmh = $GENERAL->{handler}->{$_};
|
||||
my %__tmp;
|
||||
foreach ( keys %$__param_loc ) {
|
||||
|
||||
my $key = $__param_loc->{$_};
|
||||
|
||||
# $__tmp{$key} = $clmh->{$_} if defined ($clmh->{$_}) ;
|
||||
$__tmp{$key} = $clmh->{ lc($_) }
|
||||
if defined( $clmh->{ lc($_) } );
|
||||
|
||||
}
|
||||
$__tmp{HANDLER} = $_;
|
||||
$__HASHMH{$_} = \%__tmp;
|
||||
my $key = $__param_loc->{$_};
|
||||
# $__tmp{$key} = $clmh->{$_} if defined ($clmh->{$_}) ;
|
||||
$__tmp{$key} = $clmh->{lc($_)} if defined ($clmh->{lc($_)}) ;
|
||||
|
||||
}
|
||||
$__tmp{HANDLER} =$_;
|
||||
$__HASHMH{$_} = \%__tmp;
|
||||
## call function builer
|
||||
my $sub = built_function( \%__HASHMH );
|
||||
## add key in config
|
||||
$__config{SUB} = $sub;
|
||||
$__config{MH} = \%__HASHMH;
|
||||
}
|
||||
my $sub = built_function(\%__HASHMH);
|
||||
## add key in config
|
||||
$__config{SUB} =$sub;
|
||||
$__config{MH} =\%__HASHMH;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
$__config{XML} = 1;
|
||||
return ( \%__config );
|
||||
}
|
||||
|
||||
|
||||
$__config{XML}=1;
|
||||
return (\%__config);
|
||||
}
|
||||
|
||||
##########################
|
||||
##########################
|
||||
sub built_function {
|
||||
sub built_function {
|
||||
##########################
|
||||
|
||||
my $tablemh = shift;
|
||||
my $tablemh= shift;
|
||||
|
||||
my @key = keys %$tablemh;
|
||||
my @key = keys %$tablemh ;
|
||||
my $def;
|
||||
my $code = "sub {local \$_ = shift;\n";
|
||||
my $code = "sub {local \$_ = shift;\n";
|
||||
|
||||
foreach (@key) {
|
||||
my $tmp = $tablemh->{$_};
|
||||
if ( $tmp->{HANDLER} =~ /DEFAULT/i ) {
|
||||
$def = 'DEFAULT';
|
||||
next;
|
||||
}
|
||||
foreach (@key) {
|
||||
my $tmp = $tablemh->{$_};
|
||||
if ($tmp->{HANDLER} =~ /DEFAULT/i) {
|
||||
$def= 'DEFAULT';
|
||||
next ;
|
||||
}
|
||||
|
||||
$code .= "return \"$tmp->{HANDLER}\" if /^\\$tmp->{MOTIFIN}/i;\n";
|
||||
}
|
||||
$code .= "return \"DEFAULT\";\n" if $def;
|
||||
$code .= "return \"$tmp->{HANDLER}\" if /^\\$tmp->{MOTIFIN}/i;\n";
|
||||
}
|
||||
$code.= "return \"DEFAULT\";\n" if $def;
|
||||
|
||||
$code .= "1;}\n";
|
||||
return $code;
|
||||
$code.= "1;}\n";
|
||||
return $code;
|
||||
}
|
||||
|
||||
##########################
|
||||
##########################
|
||||
sub built_functionics {
|
||||
##########################
|
||||
my $tablemh = shift;
|
||||
my @lmh = split ",", $tablemh;
|
||||
my $tablemh= shift;
|
||||
my @lmh= split "," ,$tablemh;
|
||||
|
||||
my $code = "sub {local \$_ = shift;\n";
|
||||
foreach (@lmh) {
|
||||
$code .= "return \"OK\" if /\\.$_\$/i;\n";
|
||||
}
|
||||
$code .= "1;}\n";
|
||||
return $code;
|
||||
my $code = "sub {local \$_ = shift;\n";
|
||||
foreach (@lmh) {
|
||||
$code .= "return \"OK\" if /\\.$_\$/i;\n";
|
||||
}
|
||||
$code.= "1;}\n";
|
||||
return $code;
|
||||
}
|
||||
|
||||
##########################
|
||||
|
|
@ -318,16 +309,16 @@ sub built_functionics {
|
|||
sub merge {
|
||||
##########################
|
||||
|
||||
my ( $ht, $xm ) = @_;
|
||||
my %__config;
|
||||
foreach ( keys %$xm ) {
|
||||
$__config{$_} = $xm->{$_};
|
||||
}
|
||||
foreach ( keys %$ht ) {
|
||||
$__config{$_} = $ht->{$_} if defined( $ht->{$_} );
|
||||
}
|
||||
delete $__config{message};
|
||||
return ( \%__config );
|
||||
my ($ht , $xm) =@_;
|
||||
my %__config;
|
||||
foreach (keys %$xm ){
|
||||
$__config{$_} = $xm->{$_} ;
|
||||
}
|
||||
foreach (keys %$ht ){
|
||||
$__config{$_} = $ht->{$_} if defined ($ht->{$_}) ;
|
||||
}
|
||||
delete $__config{message};
|
||||
return (\%__config);
|
||||
|
||||
}
|
||||
##########################
|
||||
|
|
@ -335,20 +326,21 @@ sub merge {
|
|||
sub mergeMH {
|
||||
##########################
|
||||
|
||||
my ( $ht, $mh ) = @_;
|
||||
my %__config;
|
||||
%__config = %$ht;
|
||||
my $_tmp = $__config{MH}->{$mh};
|
||||
my %tmp = %$_tmp;
|
||||
foreach ( keys %tmp ) {
|
||||
$__config{$_} = $tmp{$_};
|
||||
}
|
||||
my $id = $__config{HANDLERID} . "/" . $mh;
|
||||
$__config{HANDLERID} = $id;
|
||||
$__config{XML} = 1;
|
||||
return ( \%__config );
|
||||
my ($ht , $mh) =@_;
|
||||
my %__config;
|
||||
%__config=%$ht;
|
||||
my $_tmp = $__config{MH}->{$mh} ;
|
||||
my %tmp= %$_tmp;
|
||||
foreach (keys %tmp ){
|
||||
$__config{$_} = $tmp{$_} ;
|
||||
}
|
||||
my $id =$__config{HANDLERID}."/".$mh ;
|
||||
$__config{HANDLERID} = $id;
|
||||
$__config{XML}=1;
|
||||
return (\%__config);
|
||||
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,475 +1,466 @@
|
|||
package Lemonldap::Config::Parameters;
|
||||
use strict;
|
||||
|
||||
#use warnings;
|
||||
#use IPC::Shareable;
|
||||
use BerkeleyDB;
|
||||
use XML::Simple;
|
||||
use Data::Dumper;
|
||||
use Storable qw (thaw);
|
||||
use LWP::UserAgent();
|
||||
|
||||
our $VERSION = '3.0.0';
|
||||
our $VERSION = '3.1.0';
|
||||
our %IPC_CONFIG;
|
||||
|
||||
# Preloaded methods go here.
|
||||
sub Minus {
|
||||
## this function convert all key in caMel case into lowercase
|
||||
## it is a recursive function
|
||||
## it keeps all the old keys
|
||||
my $rh = shift;
|
||||
foreach ( keys %{$rh} ) {
|
||||
my $k = $_;
|
||||
return unless $k;
|
||||
if ( $k ne lc($k) ) {
|
||||
$rh->{ lc($k) } = $rh->{$k};
|
||||
}
|
||||
if ( ref $rh->{$k} ) {
|
||||
Minus( $rh->{$k} );
|
||||
}
|
||||
}
|
||||
return;
|
||||
## this function convert all key in caMel case into lowercase
|
||||
## it is a recursive function
|
||||
## it keeps all the old keys
|
||||
my $rh =shift;
|
||||
foreach (keys %{$rh}) {
|
||||
my $k =$_;
|
||||
return unless $k;
|
||||
if ($k ne lc ($k)) {
|
||||
$rh->{lc($k)} = $rh->{$k} ;
|
||||
}
|
||||
if (ref $rh->{$k}) {
|
||||
Minus ($rh->{$k});
|
||||
}
|
||||
}
|
||||
return ;
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub _getFromCache {
|
||||
|
||||
my $self = shift;
|
||||
my $cache = $self->{cache};
|
||||
my $cog;
|
||||
my $ttl;
|
||||
my $self = shift;
|
||||
my $cache = $self->{cache};
|
||||
my $cog;
|
||||
my $ttl;
|
||||
|
||||
tie %IPC_CONFIG, 'BerkeleyDB::Btree',
|
||||
-Filename => $cache,
|
||||
-Flags => DB_CREATE;
|
||||
unless ( keys(%IPC_CONFIG) ) {
|
||||
tie %IPC_CONFIG, 'BerkeleyDB::Btree',
|
||||
-Filename => $cache ,
|
||||
-Flags => DB_CREATE ;
|
||||
unless ( keys(%IPC_CONFIG) ) {
|
||||
|
||||
#first I read the xml file
|
||||
$self->_readFile;
|
||||
## write cache
|
||||
$self->_writeCache;
|
||||
$cog = $self->{config};
|
||||
}
|
||||
else {
|
||||
#first I read the xml file
|
||||
$self->_readFile;
|
||||
## write cache
|
||||
$self->_writeCache;
|
||||
$cog = $self->{config};
|
||||
}
|
||||
else {
|
||||
|
||||
$ttl = $IPC_CONFIG{TTL};
|
||||
$self->{ttl} = $ttl;
|
||||
$ttl = $IPC_CONFIG{TTL};
|
||||
$self->{ttl} = $ttl;
|
||||
#<modif ttl config lastmodified into ismodified>
|
||||
#
|
||||
#
|
||||
|
||||
#<modif ttl config lastmodified into ismodified>
|
||||
#
|
||||
#
|
||||
if ($ttl=~ /ifmodified/i )
|
||||
{
|
||||
$self->{ttl} =0;
|
||||
$ttl=0;
|
||||
}
|
||||
$self->{available} = $IPC_CONFIG{AVAILABLE};
|
||||
$self->{file} = $IPC_CONFIG{FILE};
|
||||
$self->{agent} = $IPC_CONFIG{SOAPAGENT};
|
||||
$self->{lastmodified} = $IPC_CONFIG{LASTMODIFIED};
|
||||
$self->{method} = $IPC_CONFIG{METHOD};
|
||||
if ( $self->{method} ) {
|
||||
unless ( $self->{i_am_soap_server} ) {
|
||||
$self->{on_same} = $IPC_CONFIG{ON_SAME};
|
||||
}
|
||||
|
||||
if ( $ttl =~ /ifmodified/i ) {
|
||||
$self->{ttl} = 0;
|
||||
$ttl = 0;
|
||||
}
|
||||
$self->{available} = $IPC_CONFIG{AVAILABLE};
|
||||
$self->{file} = $IPC_CONFIG{FILE};
|
||||
$self->{agent} = $IPC_CONFIG{SOAPAGENT};
|
||||
$self->{lastmodified} = $IPC_CONFIG{LASTMODIFIED};
|
||||
$self->{method} = $IPC_CONFIG{METHOD};
|
||||
if ( $self->{method} ) {
|
||||
unless ( $self->{i_am_soap_server} ) {
|
||||
$self->{on_same} = $IPC_CONFIG{ON_SAME};
|
||||
}
|
||||
$self->{uri} = $IPC_CONFIG{SOAPURI};
|
||||
$self->{proxy} = $IPC_CONFIG{SOAPPROXY};
|
||||
}
|
||||
my %tmp = %IPC_CONFIG;
|
||||
my $tmpvar = $tmp{config};
|
||||
my $it;
|
||||
$it = eval $tmpvar if $tmpvar;
|
||||
$self->{config} = $it;
|
||||
my $__modif__ = ( stat $self->{file} )[9];
|
||||
if ( $__modif__ ne $self->{lastmodified} )
|
||||
{ # the modified timestamp is different i'll force the reload
|
||||
$IPC_CONFIG{AVAILABLE} = 'RELOAD';
|
||||
$self->{lastmodified} = $__modif__;
|
||||
}
|
||||
|
||||
$self->{uri} = $IPC_CONFIG{SOAPURI};
|
||||
$self->{proxy} = $IPC_CONFIG{SOAPPROXY};
|
||||
}
|
||||
my %tmp = %IPC_CONFIG;
|
||||
my $tmpvar = $tmp{config};
|
||||
my $it;
|
||||
$it = eval $tmpvar if $tmpvar;
|
||||
$self->{config} = $it;
|
||||
my $__modif__ = ( stat $self->{file} )[9];
|
||||
if ( $__modif__ ne $self->{lastmodified} )
|
||||
{ # the modified timestamp is different i'll force the reload
|
||||
$IPC_CONFIG{AVAILABLE} = 'RELOAD';
|
||||
$self->{lastmodified} = $__modif__;
|
||||
}
|
||||
if ( $IPC_CONFIG{AVAILABLE} eq 'RELOAD' ) {
|
||||
$self->_readFile;
|
||||
$self->_writeCache;
|
||||
$cog = $self->{config};
|
||||
return ($cog);
|
||||
}
|
||||
if ( $IPC_CONFIG{AVAILABLE} eq 'DESTROY' ) {
|
||||
$self->_readFile;
|
||||
$self->_deleteCache;
|
||||
delete $self->{cache};
|
||||
$cog = $self->{config};
|
||||
return ($cog);
|
||||
}
|
||||
$cog = $self->{config};
|
||||
|
||||
if ( $IPC_CONFIG{AVAILABLE} eq 'RELOAD' ) {
|
||||
$self->_readFile;
|
||||
$self->_writeCache;
|
||||
$cog = $self->{config};
|
||||
return ($cog);
|
||||
}
|
||||
if ( $IPC_CONFIG{AVAILABLE} eq 'DESTROY' ) {
|
||||
$self->_readFile;
|
||||
$self->_deleteCache;
|
||||
delete $self->{cache};
|
||||
$cog = $self->{config};
|
||||
return ($cog);
|
||||
}
|
||||
$cog = $self->{config};
|
||||
# all is good we must compare time and ttl
|
||||
return ($cog) if ( $self->{ttl} == 0 );
|
||||
my $timenow = time;
|
||||
my $timecalc = $self->{available} + $self->{ttl};
|
||||
if ( $timenow > $timecalc ) { # the cache is too old
|
||||
$self->_readFile;
|
||||
$self->_writeCache;
|
||||
|
||||
# all is good we must compare time and ttl
|
||||
return ($cog) if ( $self->{ttl} == 0 );
|
||||
my $timenow = time;
|
||||
my $timecalc = $self->{available} + $self->{ttl};
|
||||
if ( $timenow > $timecalc ) { # the cache is too old
|
||||
$self->_readFile;
|
||||
$self->_writeCache;
|
||||
}
|
||||
$cog = $self->{config};
|
||||
return ($cog);
|
||||
|
||||
}
|
||||
$cog = $self->{config};
|
||||
return ($cog);
|
||||
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub destroy {
|
||||
my $self = shift;
|
||||
$self->_deleteCache;
|
||||
delete $self->{cache};
|
||||
my $self = shift;
|
||||
$self->_deleteCache;
|
||||
delete $self->{cache};
|
||||
}
|
||||
|
||||
# function used to manage cache conf from command line
|
||||
sub f_delete {
|
||||
my $arg = shift;
|
||||
unlink($arg);
|
||||
return (0);
|
||||
my $arg = shift;
|
||||
unlink ($arg);
|
||||
return (0);
|
||||
}
|
||||
|
||||
sub f_reload {
|
||||
my $arg = shift;
|
||||
my $arg = shift;
|
||||
|
||||
tie %IPC_CONFIG, 'BerkeleyDB::Btree',
|
||||
-Filename => $arg,
|
||||
-Flags => DB_CREATE;
|
||||
-Filename => $arg ,
|
||||
-Flags => DB_CREATE ;
|
||||
|
||||
$IPC_CONFIG{ttl} = '1';
|
||||
|
||||
$IPC_CONFIG{ttl} = '1';
|
||||
$IPC_CONFIG{AVAILABLE} = 'RELOAD';
|
||||
|
||||
$IPC_CONFIG{AVAILABLE} = 'RELOAD';
|
||||
|
||||
untie %IPC_CONFIG;
|
||||
return (0);
|
||||
untie %IPC_CONFIG ;
|
||||
return (0);
|
||||
}
|
||||
|
||||
sub f_dump {
|
||||
my $arg = shift;
|
||||
tie %IPC_CONFIG, 'BerkeleyDB::Btree',
|
||||
-Filename => $arg,
|
||||
-Flags => DB_CREATE;
|
||||
my $arg = shift;
|
||||
tie %IPC_CONFIG, 'BerkeleyDB::Btree',
|
||||
-Filename => $arg ,
|
||||
-Flags => DB_CREATE ;
|
||||
|
||||
$Data::Dumper::Indent = 1;
|
||||
$Data::Dumper::Terse = 1;
|
||||
if ( $IPC_CONFIG{'QUEUE'} ) { #it's ipc segment for handler cache level 2
|
||||
my $tmpvar = $IPC_CONFIG{'QUEUE'};
|
||||
my @tmp;
|
||||
if ($tmpvar) {
|
||||
@tmp = split /#/, $tmpvar;
|
||||
}
|
||||
print "Queue : $#tmp\n";
|
||||
foreach (@tmp) {
|
||||
print "=> $_\n";
|
||||
}
|
||||
print "\n";
|
||||
$Data::Dumper::Indent = 1;
|
||||
$Data::Dumper::Terse = 1;
|
||||
if ($IPC_CONFIG{'QUEUE'}) { #it's ipc segment for handler cache level 2
|
||||
my $tmpvar = $IPC_CONFIG{'QUEUE'};
|
||||
my @tmp ;
|
||||
if ($tmpvar) {
|
||||
@tmp= split /#/,$tmpvar ;
|
||||
}
|
||||
print "Queue : $#tmp\n";
|
||||
foreach (@tmp) {
|
||||
print "=> $_\n";
|
||||
}
|
||||
print "\n";
|
||||
|
||||
}
|
||||
my $ligne = Dumper( \%IPC_CONFIG );
|
||||
print "$ligne\n";
|
||||
}
|
||||
my $ligne = Dumper( \%IPC_CONFIG );
|
||||
print "$ligne\n";
|
||||
|
||||
untie %IPC_CONFIG;
|
||||
return "OK\n";
|
||||
untie %IPC_CONFIG;
|
||||
return "OK\n";
|
||||
}
|
||||
|
||||
sub _retrieve_on_soap {
|
||||
my $self = shift;
|
||||
my $uri = shift;
|
||||
my $proxy = shift;
|
||||
my $file = $self->{file};
|
||||
my $glue = $self->{cache};
|
||||
require SOAP::Lite;
|
||||
my $s = SOAP::Lite->uri($uri)->proxy($proxy);
|
||||
my $hl = $s->SOAP::new(
|
||||
file => $file,
|
||||
cache => $glue,
|
||||
);
|
||||
my $self = shift;
|
||||
my $uri = shift;
|
||||
my $proxy = shift;
|
||||
my $file = $self->{file};
|
||||
my $glue = $self->{cache};
|
||||
require SOAP::Lite;
|
||||
my $s = SOAP::Lite->uri($uri)->proxy($proxy);
|
||||
my $hl = $s->SOAP::new(
|
||||
file => $file,
|
||||
cache => $glue,
|
||||
);
|
||||
|
||||
#my $res=$hl->SOAP::retrieve ;
|
||||
print STDERR
|
||||
"Config::Parameters WARNING : SOAP server :$proxy don't answer\n"
|
||||
unless $hl->{config};
|
||||
return $hl->{config};
|
||||
#my $res=$hl->SOAP::retrieve ;
|
||||
return $hl->{config};
|
||||
}
|
||||
|
||||
sub _readFile {
|
||||
my $self = shift;
|
||||
my ( $uri, $proxy, $obj );
|
||||
my ( $lastmodified, $par, $config );
|
||||
my $file = $self->{file};
|
||||
my $cache = $self->{cache};
|
||||
$cache = uc $cache if ( $self->{i_am_soap_server} );
|
||||
my $method = $self->{method} || 'NONE';
|
||||
unless ( $self->{i_am_soap_server} ) {
|
||||
my $self = shift;
|
||||
my ( $uri, $proxy, $obj );
|
||||
my ( $lastmodified, $par, $config );
|
||||
my $file = $self->{file};
|
||||
my $cache = $self->{cache};
|
||||
$cache = uc $cache if ($self->{i_am_soap_server});
|
||||
my $method = $self->{method}||'NONE';
|
||||
unless ( $self->{i_am_soap_server} ) {
|
||||
|
||||
if ( $method eq 'SOAP' ) {
|
||||
$uri = $self->{uri};
|
||||
$proxy = $self->{proxy};
|
||||
if ( $method eq 'SOAP' ) {
|
||||
$uri = $self->{uri};
|
||||
$proxy = $self->{proxy};
|
||||
|
||||
#unless ($self->{i_am_soap_server}) #the server soap objet must not make soap request on itself
|
||||
my $conf_enc = $self->_retrieve_on_soap( $uri, $proxy );
|
||||
my $conf_decode = thaw($conf_enc);
|
||||
$self->{config} = $conf_decode;
|
||||
$self->_writeCache;
|
||||
my $conf_enc = $self->_retrieve_on_soap( $uri, $proxy );
|
||||
my $conf_decode = thaw($conf_enc);
|
||||
$self->{config} = $conf_decode;
|
||||
$self->_writeCache;
|
||||
### now a rewrite or write my file on disk
|
||||
### the soap agent on server must not write file too
|
||||
return 1 if ( $self->{i_am_soap_server} );
|
||||
return 1 if ( $self->{i_am_soap_server} );
|
||||
### the agent config in soap server must not write file
|
||||
return 1 if ( $self->{on_same} );
|
||||
return 1 if ( $self->{on_same} );
|
||||
## last precaution
|
||||
my $filelock = "$self->{file}.lock";
|
||||
return 1 if ( -e $filelock );
|
||||
my $filelock = "$self->{file}.lock";
|
||||
return 1 if ( -e $filelock );
|
||||
|
||||
my $xml = XMLout($conf_decode);
|
||||
open CONFIG, ">$file" || die "@! $file \n";
|
||||
flock( CONFIG, 2 ); # I lock file
|
||||
print CONFIG $xml;
|
||||
close(CONFIG); # make the unlock
|
||||
return 1;
|
||||
my $xml = XMLout($conf_decode);
|
||||
open CONFIG, ">$file" || die "@! $file \n";
|
||||
flock( CONFIG, 2 ); # I lock file
|
||||
print CONFIG $xml;
|
||||
close(CONFIG); # make the unlock
|
||||
return 1;
|
||||
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
$config = XMLin( $file, ForceArray => 1, );
|
||||
$config = XMLin( $file, ForceArray => 1, );
|
||||
|
||||
# I extract info about the cache ttl
|
||||
# I extract info about the cache ttl
|
||||
|
||||
my $cache_param = $config->{cache};
|
||||
my $cache_param = $config->{cache};
|
||||
|
||||
# there are sereval cache descriptors or one alone
|
||||
#
|
||||
my $__cache__;
|
||||
foreach my $tmp ( keys %{$cache_param} )
|
||||
# there are sereval cache descriptors or one alone
|
||||
#
|
||||
my $__cache__;
|
||||
foreach my $tmp ( keys %{$cache_param} )
|
||||
|
||||
{
|
||||
if ( $cache_param->{$tmp}{'ConfigIpcKey'} eq $cache ) {
|
||||
$__cache__ = $cache_param->{$tmp};
|
||||
}
|
||||
{
|
||||
if ( $cache_param->{$tmp}{'ConfigIpcKey'} eq $cache ) {
|
||||
$__cache__ = $cache_param->{$tmp};
|
||||
}
|
||||
|
||||
}
|
||||
$par = $__cache__->{ConfigTtl};
|
||||
if ( $par =~ /ismodified/i ) {
|
||||
$par = 0;
|
||||
$lastmodified = 1;
|
||||
}
|
||||
}
|
||||
$par = $__cache__->{ConfigTtl};
|
||||
if ($par =~ /ismodified/i ) {
|
||||
$par =0;
|
||||
$lastmodified = 1;
|
||||
}
|
||||
|
||||
$self->{ttl} = $par || '0';
|
||||
$self->{method} = $__cache__->{Method} || 'NONE';
|
||||
if ( $self->{method} eq 'SOAP' ) {
|
||||
$self->{uri} = $__cache__->{SoapUri};
|
||||
$self->{proxy} = $__cache__->{SoapProxy};
|
||||
$self->{agent} = $__cache__->{SoapAgent};
|
||||
$self->{ttl} = $par || '0';
|
||||
$self->{method} = $__cache__->{Method}||'NONE';
|
||||
if ( $self->{method} eq 'SOAP' ) {
|
||||
$self->{uri} = $__cache__->{SoapUri};
|
||||
$self->{proxy} = $__cache__->{SoapProxy};
|
||||
$self->{agent} = $__cache__->{SoapAgent};
|
||||
|
||||
}
|
||||
if ( ( $self->{lastmodified} ) and not($lastmodified) ) {
|
||||
$self->{lasmodified} = 0;
|
||||
}
|
||||
else {
|
||||
$self->{lastmodified} = 1 unless $self->{lastmodified};
|
||||
}
|
||||
## call Minus function for lowering case
|
||||
Minus($config);
|
||||
|
||||
$self->{config} = $config;
|
||||
1;
|
||||
}
|
||||
if ( ( $self->{lastmodified} ) and not($lastmodified) ) {
|
||||
$self->{lasmodified} = 0;
|
||||
}
|
||||
else {
|
||||
$self->{lastmodified} = 1 unless $self->{lastmodified};
|
||||
}
|
||||
## call Minus function for lowering case
|
||||
Minus($config) ;
|
||||
|
||||
|
||||
$self->{config} = $config;
|
||||
1;
|
||||
}
|
||||
|
||||
sub _deleteCache {
|
||||
my $self = shift;
|
||||
my $cache = $self->{cache};
|
||||
|
||||
tie %IPC_CONFIG, 'BerkeleyDB::Btree',
|
||||
-Filename => $cache,
|
||||
-Flags => DB_CREATE;
|
||||
%IPC_CONFIG = '';
|
||||
untie %IPC_CONFIG;
|
||||
my $self = shift;
|
||||
my $cache = $self->{cache};
|
||||
|
||||
tie %IPC_CONFIG, 'BerkeleyDB::Btree',
|
||||
-Filename => $cache ,
|
||||
-Flags => DB_CREATE ;
|
||||
%IPC_CONFIG ='';
|
||||
untie %IPC_CONFIG;
|
||||
}
|
||||
|
||||
sub _writeCache {
|
||||
my $self = shift;
|
||||
my $self = shift;
|
||||
|
||||
# unless ( $self->{i_am_soap_server} ) {
|
||||
# return 1
|
||||
# if ( $self->{on_same} )
|
||||
# ; ## the agent config in the soap server must not
|
||||
# ## write in cache , there soap agent does this
|
||||
# return 1
|
||||
# if ( $IPC_CONFIG{ON_SAME} )
|
||||
# ; ## the soap agent may be already write in IPC
|
||||
# #with me it's belt and straps of trousers
|
||||
# my $filelock = "$self->{file}.lock";
|
||||
# return 1 if ( -e $filelock );
|
||||
# }
|
||||
# unless ( $self->{i_am_soap_server} ) {
|
||||
# return 1
|
||||
# if ( $self->{on_same} )
|
||||
# ; ## the agent config in the soap server must not
|
||||
# ## write in cache , there soap agent does this
|
||||
# return 1
|
||||
# if ( $IPC_CONFIG{ON_SAME} )
|
||||
# ; ## the soap agent may be already write in IPC
|
||||
# #with me it's belt and straps of trousers
|
||||
# my $filelock = "$self->{file}.lock";
|
||||
# return 1 if ( -e $filelock );
|
||||
# }
|
||||
|
||||
my $time = time;
|
||||
my $cache = $self->{cache};
|
||||
my $config = $self->{config};
|
||||
$Data::Dumper::Purity = 1;
|
||||
$Data::Dumper::Terse = 1;
|
||||
$Data::Dumper::Deepcopy = 1;
|
||||
my $configs = Dumper($config);
|
||||
my $ttl = $self->{ttl};
|
||||
my $lastmodified = $self->{lastmodified};
|
||||
my $file = $self->{file};
|
||||
delete $IPC_CONFIG{config};
|
||||
|
||||
# %IPC_CONFIG = '';
|
||||
untie %IPC_CONFIG;
|
||||
unlink( $self->{cache} );
|
||||
my $time = time;
|
||||
my $cache = $self->{cache};
|
||||
my $config = $self->{config};
|
||||
$Data::Dumper::Purity = 1;
|
||||
$Data::Dumper::Terse = 1;
|
||||
$Data::Dumper::Deepcopy = 1;
|
||||
my $configs = Dumper($config);
|
||||
my $ttl = $self->{ttl};
|
||||
my $lastmodified = $self->{lastmodified};
|
||||
my $file = $self->{file};
|
||||
delete $IPC_CONFIG{config};
|
||||
# %IPC_CONFIG = '';
|
||||
untie %IPC_CONFIG;
|
||||
unlink ($self->{cache});
|
||||
tie %IPC_CONFIG, 'BerkeleyDB::Btree',
|
||||
-Filename => $cache,
|
||||
-Flags => DB_CREATE;
|
||||
$IPC_CONFIG{config} = $configs;
|
||||
$IPC_CONFIG{TTL} = $ttl;
|
||||
$IPC_CONFIG{AVAILABLE} = $time;
|
||||
$IPC_CONFIG{FILE} = $file;
|
||||
$IPC_CONFIG{SOAPAGENT} = $self->{agent} if $self->{agent};
|
||||
$IPC_CONFIG{LASTMODIFIED} = $lastmodified if $lastmodified;
|
||||
$IPC_CONFIG{METHOD} = $self->{method} if $self->{method};
|
||||
$IPC_CONFIG{SOAPURI} = $self->{uri} if $self->{uri};
|
||||
$IPC_CONFIG{SOAPPROXY} = $self->{proxy} if $self->{proxy};
|
||||
if ( $self->{method} ) {
|
||||
-Filename => $cache ,
|
||||
-Flags => DB_CREATE ;
|
||||
$IPC_CONFIG{config} = $configs;
|
||||
$IPC_CONFIG{TTL} = $ttl;
|
||||
$IPC_CONFIG{AVAILABLE} = $time;
|
||||
$IPC_CONFIG{FILE} = $file;
|
||||
$IPC_CONFIG{SOAPAGENT} = $self->{agent} if $self->{agent};
|
||||
$IPC_CONFIG{LASTMODIFIED} = $lastmodified if $lastmodified;
|
||||
$IPC_CONFIG{METHOD} = $self->{method} if $self->{method};
|
||||
$IPC_CONFIG{SOAPURI} = $self->{uri} if $self->{uri};
|
||||
$IPC_CONFIG{SOAPPROXY} = $self->{proxy} if $self->{proxy};
|
||||
if ( $self->{method} ) {
|
||||
|
||||
if ( $self->{i_am_soap_server} )
|
||||
{ # the soap server tell that is it for an eventual
|
||||
# agent config in the same machine
|
||||
# I will create a empty lock file for
|
||||
# avoid recursive call between
|
||||
# soap server and agent config
|
||||
if ( $self->{i_am_soap_server} )
|
||||
{ # the soap server tell that is it for an eventual
|
||||
# agent config in the same machine
|
||||
# I will create a empty lock file for
|
||||
# avoid recursive call between
|
||||
# soap server and agent config
|
||||
|
||||
$file = "$self->{file}.lock";
|
||||
$file = "$self->{file}.lock";
|
||||
|
||||
open LOCK, ">$file";
|
||||
close LOCK;
|
||||
$IPC_CONFIG{ON_SAME} = 1;
|
||||
open LOCK, ">$file";
|
||||
close LOCK;
|
||||
$IPC_CONFIG{ON_SAME} = 1;
|
||||
|
||||
#now i 'll notice at all agents the modification
|
||||
my @soapagent;
|
||||
my $sp;
|
||||
my $tt = $self->{agent};
|
||||
$sp = eval $tt;
|
||||
@soapagent = @{$sp};
|
||||
my $glue = uc( $self->{cache} );
|
||||
my $ua = LWP::UserAgent->new( timeout => 30 );
|
||||
#now i 'll notice at all agents the modification
|
||||
my @soapagent;
|
||||
my $sp ;
|
||||
my $tt = $self->{agent};
|
||||
$sp =eval $tt;
|
||||
@soapagent = @{$sp};
|
||||
my $glue =uc ($self->{cache});
|
||||
my $ua = LWP::UserAgent->new (timeout => 30);
|
||||
for my $l (@soapagent) {
|
||||
my $res =$ua->get ("$l?glue=$glue");
|
||||
|
||||
# my $req =HTTP::Request->new (GET => "$l?glue=$glue");
|
||||
# print STDERR $req->as_string;
|
||||
my $res = $ua->get("$l?glue=$glue");
|
||||
if ( $res->is_error ) {
|
||||
print STDERR
|
||||
"WARNING Config::Parameters : error on $l for SOAP service\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
untie %IPC_CONFIG;
|
||||
|
||||
}
|
||||
untie %IPC_CONFIG;
|
||||
|
||||
return 1;
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my %conf = @_;
|
||||
my $class = shift;
|
||||
my %conf = @_;
|
||||
|
||||
my $self = bless {
|
||||
my $self = bless {
|
||||
|
||||
},
|
||||
ref($class) || $class;
|
||||
$self->{file} = $conf{file} if $conf{file};
|
||||
$self->{cache} = $conf{cache} if $conf{cache};
|
||||
$self->{i_am_soap_server} = $conf{server} if $conf{server};
|
||||
$self->{cache} = lc $self->{cache} if ( $self->{i_am_soap_server} );
|
||||
return $self;
|
||||
},
|
||||
ref($class) || $class;
|
||||
$self->{file} = $conf{file} if $conf{file};
|
||||
$self->{cache} = $conf{cache} if $conf{cache};
|
||||
$self->{i_am_soap_server} = $conf{server} if $conf{server};
|
||||
$self->{cache} = lc $self->{cache} if ($self->{i_am_soap_server});
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub getDomain {
|
||||
my $self = shift;
|
||||
my $domain = shift;
|
||||
my $config = $self->getAllConfig;
|
||||
unless ($domain) {
|
||||
my $d = ( keys %{ $config->{domain} } );
|
||||
die "Ambigious domain\n" if ( $d != 1 );
|
||||
($domain) = ( keys %{ $config->{domain} } );
|
||||
}
|
||||
my $self = shift;
|
||||
my $domain = shift;
|
||||
my $config = $self->getAllConfig;
|
||||
unless ($domain) {
|
||||
my $d = ( keys %{ $config->{domain} } );
|
||||
die "Ambigious domain\n" if ( $d != 1 );
|
||||
($domain) = ( keys %{ $config->{domain} } );
|
||||
}
|
||||
|
||||
my $cdomain = $config->{domain}{$domain};
|
||||
return ($cdomain);
|
||||
my $cdomain = $config->{domain}{$domain};
|
||||
return ($cdomain);
|
||||
|
||||
}
|
||||
|
||||
sub findParagraph {
|
||||
my ( $self, $chapitre, $motif ) = @_;
|
||||
my $config = $self->getAllConfig;
|
||||
my $parag;
|
||||
if ( $chapitre && $motif ) {
|
||||
$parag = $config->{$chapitre}->{$motif};
|
||||
}
|
||||
else {
|
||||
$parag = $config->{$chapitre};
|
||||
}
|
||||
return ($parag);
|
||||
my ( $self, $chapitre, $motif ) = @_;
|
||||
my $config = $self->getAllConfig;
|
||||
my $parag;
|
||||
if ( $chapitre && $motif ) {
|
||||
$parag = $config->{$chapitre}->{$motif};
|
||||
}
|
||||
else {
|
||||
$parag = $config->{$chapitre};
|
||||
}
|
||||
return ($parag);
|
||||
}
|
||||
|
||||
sub formateLineHash {
|
||||
my ( $self, $line, $motif, $replace ) = @_;
|
||||
my %cf;
|
||||
my $t;
|
||||
if ( $line =~ /^\(/ ) {
|
||||
$t = $line;
|
||||
}
|
||||
else {
|
||||
$t = "($line );";
|
||||
}
|
||||
my ( $self, $line, $motif, $replace ) = @_;
|
||||
my %cf;
|
||||
my $t;
|
||||
if ( $line =~ /^\(/ ) {
|
||||
$t = $line;
|
||||
}
|
||||
else {
|
||||
$t = "($line );";
|
||||
}
|
||||
|
||||
%cf = eval $t;
|
||||
if ($motif) {
|
||||
for ( values %cf ) {
|
||||
s/$motif/$replace/;
|
||||
}
|
||||
}
|
||||
return ( \%cf );
|
||||
%cf = eval $t;
|
||||
if ($motif) {
|
||||
for ( values %cf ) {
|
||||
s/$motif/$replace/;
|
||||
}
|
||||
}
|
||||
return ( \%cf );
|
||||
}
|
||||
|
||||
sub formateLineArray {
|
||||
my ( $self, $line, $motif, $replace ) = @_;
|
||||
my @cf;
|
||||
my $t;
|
||||
if ( $line =~ /^\[/ ) { $t = $line; }
|
||||
else {
|
||||
$t = "[$line ];";
|
||||
}
|
||||
@cf = eval $t;
|
||||
if ($motif) {
|
||||
for (@cf) {
|
||||
s/$motif/$replace/;
|
||||
}
|
||||
}
|
||||
return ( \@cf );
|
||||
my ( $self, $line, $motif, $replace ) = @_;
|
||||
my @cf;
|
||||
my $t;
|
||||
if ( $line =~ /^\[/ ) { $t = $line; }
|
||||
else {
|
||||
$t = "[$line ];";
|
||||
}
|
||||
@cf = eval $t;
|
||||
if ($motif) {
|
||||
for (@cf) {
|
||||
s/$motif/$replace/;
|
||||
}
|
||||
}
|
||||
return ( \@cf );
|
||||
}
|
||||
|
||||
sub getAllConfig {
|
||||
my $self = shift;
|
||||
my $config;
|
||||
my $file = $self->{file};
|
||||
if ( $self->{cache} ) { # cache is available
|
||||
$config = $self->_getFromCache;
|
||||
my $self = shift;
|
||||
my $config;
|
||||
my $file = $self->{file};
|
||||
if ( $self->{cache} ) { # cache is available
|
||||
$config = $self->_getFromCache;
|
||||
|
||||
}
|
||||
else { # cache forbidden
|
||||
}
|
||||
else { # cache forbidden
|
||||
|
||||
$config = XMLin( $file, ForceArray => 1, );
|
||||
|
||||
$config = XMLin( $file, ForceArray => 1, );
|
||||
Minus($config) ;
|
||||
}
|
||||
unless ($config) { #at the first time
|
||||
$config = XMLin( $file, ForceArray => 1, );
|
||||
|
||||
Minus($config);
|
||||
}
|
||||
unless ($config) { #at the first time
|
||||
$config = XMLin( $file, ForceArray => 1, );
|
||||
|
||||
Minus($config);
|
||||
}
|
||||
return $config;
|
||||
Minus($config) ;
|
||||
}
|
||||
return $config;
|
||||
}
|
||||
1;
|
||||
__END__
|
||||
|
|
|
|||
|
|
@ -0,0 +1,6 @@
|
|||
#!/usr/bin/perl -w
|
||||
use strict;
|
||||
use Lemonldap::Config::Parameters;
|
||||
my $key=shift||'/tmp/CONF';
|
||||
Lemonldap::Config::Parameters::f_dump($key);
|
||||
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
#!/usr/bin/perl -w
|
||||
use strict;
|
||||
use XML::Simple;
|
||||
my $file = shift;
|
||||
my $test;
|
||||
eval {
|
||||
$test = XMLin( $file,
|
||||
);
|
||||
|
||||
} ;
|
||||
|
||||
if ($@) { print "ERREUR SUR $file\n";
|
||||
} else {
|
||||
print "$file:Correct\n";
|
||||
}
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
# Before `make install' is performed this script should be runnable with
|
||||
# `make test'. After `make install' it should work as `perl 1.t'
|
||||
|
||||
#########################
|
||||
|
||||
# change 'tests => 1' to 'tests => last_test_to_print';
|
||||
|
||||
use Test::More tests => 1;
|
||||
BEGIN { use_ok('Lemonldap::Config::Parameters') };
|
||||
|
||||
#########################
|
||||
|
||||
# Insert your test code below, the Test::More module is use()ed here so read
|
||||
# its man page ( perldoc Test::More ) for help writing this test script.
|
||||
|
||||
|
|
@ -0,0 +1,74 @@
|
|||
#====================================================================
|
||||
# Test script for Lemonldap::Config::Parameters
|
||||
#
|
||||
# 2005 (c) Clement OUDOT (LINAGORA)
|
||||
#====================================================================
|
||||
|
||||
#====================================================================
|
||||
# Perl test modules
|
||||
#====================================================================
|
||||
use Test::More tests => 12;
|
||||
|
||||
#====================================================================
|
||||
# Module loading
|
||||
#====================================================================
|
||||
BEGIN{ use_ok( Lemonldap::Config::Parameters ); }
|
||||
BEGIN{ print "--> Version : ".$Lemonldap::Config::Parameters::VERSION."\n"; }
|
||||
|
||||
#====================================================================
|
||||
# Object creation
|
||||
#====================================================================
|
||||
my $file = "t/test.xml";
|
||||
my $config = Lemonldap::Config::Parameters->new( file => $file, cache => '/tmp/TEST' );
|
||||
my $config_nocache = Lemonldap::Config::Parameters->new( file => $file );
|
||||
|
||||
isa_ok( $config, Lemonldap::Config::Parameters );
|
||||
isa_ok( $config_nocache, Lemonldap::Config::Parameters );
|
||||
|
||||
#====================================================================
|
||||
# Methods
|
||||
#====================================================================
|
||||
my @methods = (
|
||||
'_getFromCache',
|
||||
'destroy',
|
||||
'f_delete',
|
||||
'f_reload',
|
||||
'f_dump',
|
||||
'_readFile',
|
||||
'_deleteCache',
|
||||
'_writeCache',
|
||||
'getDomain',
|
||||
'findParagraph',
|
||||
'formateLineHash',
|
||||
'formateLineArray',
|
||||
'getAllConfig',
|
||||
);
|
||||
|
||||
can_ok( $config, @methods );
|
||||
can_ok( $config_nocache, @methods );
|
||||
|
||||
#====================================================================
|
||||
# Domain
|
||||
#====================================================================
|
||||
my $domain = "foo.com";
|
||||
my $domain_cache = $config->getDomain( $domain );
|
||||
my $domain_nocache = $config_nocache->getDomain( $domain );
|
||||
|
||||
ok( $domain_cache, "getDomain on $domain with cache" );
|
||||
ok( $domain_nocache, "getDomain on $domain without cache" );
|
||||
is_deeply( $domain_cache, $domain_nocache, "Equality of the domain (with an without cache)" );
|
||||
|
||||
#====================================================================
|
||||
# Session
|
||||
#====================================================================
|
||||
my $session = $domain_cache->{'Session'};
|
||||
ok( $session, "Read session value in domain paragraph" );
|
||||
|
||||
my $session_cache = $config->findParagraph( 'session', $session );
|
||||
my $session_nocache = $config_nocache->findParagraph( 'session', $session );
|
||||
|
||||
ok( $session_cache, "findParagraph session on $session with cache" );
|
||||
ok( $session_nocache, "findParagraph session on $session without cache" );
|
||||
is_deeply( $session_cache, $session_nocache, "Equality of the session (with an without cache)" );
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,34 @@
|
|||
<lemonconfig>
|
||||
|
||||
<domain
|
||||
id="foo.com"
|
||||
Cookie="Brownie"
|
||||
Portal="https://www.foo.com/portail/accueil.pl"
|
||||
Menu="https://www.foo.com/portail/menu.pl"
|
||||
Session="memcached"
|
||||
ldap_server="ldap.foo.com"
|
||||
ldap_branch_people="ou=people,dc=foo,dc=com"
|
||||
DnManager="uid=root,dc=foo,dc=com"
|
||||
PasswordManager="secret"
|
||||
>
|
||||
<handler
|
||||
id="LINAGORA"
|
||||
AttrLdap="LINUX"
|
||||
CodeAppli="TUX"
|
||||
BasePub="http://public.foo.com"
|
||||
BasePriv="http://private.foo.com"
|
||||
IpcNb="5"
|
||||
Enabledproxy="1"
|
||||
ProxyExt="http://10.75.5.12:3132"
|
||||
>
|
||||
</handler>
|
||||
</domain>
|
||||
|
||||
<cache id="/tmp/TEST">
|
||||
</cache>
|
||||
|
||||
<session id="memcached" SessionParams="(servers => ['127.0.0.1:11211'])">
|
||||
</session>
|
||||
|
||||
</lemonconfig>
|
||||
|
||||
Loading…
Reference in New Issue