diff --git a/modules/lemonldap-config/Changes b/modules/lemonldap-config/Changes index 0943e9d47..fd17352a2 100644 --- a/modules/lemonldap-config/Changes +++ b/modules/lemonldap-config/Changes @@ -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. + diff --git a/modules/lemonldap-config/README b/modules/lemonldap-config/README index 84679d5b1..97e8365d1 100644 --- a/modules/lemonldap-config/README +++ b/modules/lemonldap-config/README @@ -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". diff --git a/modules/lemonldap-config/lib/Lemonldap/Config/Initparam.pm b/modules/lemonldap-config/lib/Lemonldap/Config/Initparam.pm index 0798ca8e7..93a309961 100755 --- a/modules/lemonldap-config/lib/Lemonldap/Config/Initparam.pm +++ b/modules/lemonldap-config/lib/Lemonldap/Config/Initparam.pm @@ -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; diff --git a/modules/lemonldap-config/lib/Lemonldap/Config/Parameters.pm b/modules/lemonldap-config/lib/Lemonldap/Config/Parameters.pm index 0ab4fc4b0..18364c8ac 100755 --- a/modules/lemonldap-config/lib/Lemonldap/Config/Parameters.pm +++ b/modules/lemonldap-config/lib/Lemonldap/Config/Parameters.pm @@ -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; +# +# +# - # - # - # + 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__ diff --git a/modules/lemonldap-config/scripts/dump_cache.pl b/modules/lemonldap-config/scripts/dump_cache.pl new file mode 100755 index 000000000..1a5c49fc8 --- /dev/null +++ b/modules/lemonldap-config/scripts/dump_cache.pl @@ -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); + diff --git a/modules/lemonldap-config/scripts/valid.pl b/modules/lemonldap-config/scripts/valid.pl new file mode 100755 index 000000000..e4d46da5e --- /dev/null +++ b/modules/lemonldap-config/scripts/valid.pl @@ -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"; + } diff --git a/modules/lemonldap-config/t/1.t b/modules/lemonldap-config/t/1.t new file mode 100755 index 000000000..fc1548ee4 --- /dev/null +++ b/modules/lemonldap-config/t/1.t @@ -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. + diff --git a/modules/lemonldap-config/t/config-parameters.t b/modules/lemonldap-config/t/config-parameters.t new file mode 100644 index 000000000..45127a60b --- /dev/null +++ b/modules/lemonldap-config/t/config-parameters.t @@ -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)" ); + + diff --git a/modules/lemonldap-config/t/test.xml b/modules/lemonldap-config/t/test.xml new file mode 100644 index 000000000..7f36ae994 --- /dev/null +++ b/modules/lemonldap-config/t/test.xml @@ -0,0 +1,34 @@ + + + + + + + + + + + + + + +