File Coverage

blib/lib/Lemonldap/NG/Common/Conf.pm
Criterion Covered Total %
statement 66 181 36.4
branch 24 100 24.0
condition 7 48 14.5
subroutine 10 23 43.4
pod 2 16 12.5
total 109 368 29.6


line stmt bran cond sub pod time code
1             ##@file
2             # Base package for Lemonldap::NG configuration system
3              
4             ##@class
5             # Implements Lemonldap::NG shared configuration system.
6             # In case of error or warning, the message is stored in the global variable
7             # $Lemonldap::NG::Common::Conf::msg
8             package Lemonldap::NG::Common::Conf;
9              
10 6     6   212597 use strict;
  6         12  
  6         261  
11 6     6   28 no strict 'refs';
  6         10  
  6         188  
12 6     6   2276 use Lemonldap::NG::Common::Conf::Constants; #inherits
  6         9  
  6         514  
13 6     6   3000 use Lemonldap::NG::Common::Conf::Attributes; #inherits
  6         17  
  6         524  
14             use Lemonldap::NG::Common::Crypto
15 6     6   2861 ; #link protected cipher Object "cypher" in configuration hash
  6         12  
  6         172  
16 6     6   4236 use Config::IniFiles;
  6         163989  
  6         481  
17              
18             #inherits Lemonldap::NG::Common::Conf::File
19             #inherits Lemonldap::NG::Common::Conf::DBI
20             #inherits Lemonldap::NG::Common::Conf::SOAP
21             #inherits Lemonldap::NG::Common::Conf::LDAP
22              
23             our $VERSION = '1.4.1';
24             our $msg;
25             our $iniObj;
26              
27             BEGIN {
28 6     6   13 eval {
29 6         4403 require threads::shared;
30 6         5377 threads::shared::share($iniObj);
31             };
32             }
33              
34             ## @cmethod Lemonldap::NG::Common::Conf new(hashRef arg)
35             # Constructor.
36             # Succeed if it has found a way to access to Lemonldap::NG configuration with
37             # $arg (or default file). It can be :
38             # - Nothing: default configuration file is tested,
39             # - { confFile => "/path/to/storage.conf" },
40             # - { Type => "File", dirName => "/path/to/conf/dir/" },
41             # - { Type => "DBI", dbiChain => "DBI:mysql:database=lemonldap-ng;host=1.2.3.4",
42             # dbiUser => "user", dbiPassword => "password" },
43             # - { Type => "SOAP", proxy => "https://auth.example.com/index.pl/config" },
44             # - { Type => "LDAP", ldapServer => "ldap://localhost", ldapConfBranch => "ou=conf,ou=applications,dc=example,dc=com",
45             # ldapBindDN => "cn=manager,dc=example,dc=com", ldapBindPassword => "secret"},
46             #
47             # $self->{type} contains the type of configuration access system and the
48             # corresponding package is loaded.
49             # @param $arg hash reference or hash table
50             # @return New Lemonldap::NG::Common::Conf object
51             sub new {
52 6     6 1 767 my $class = shift;
53 6         21 my $self = bless {}, $class;
54 6 100       24 if ( ref( $_[0] ) ) {
55 5         9 %$self = %{ $_[0] };
  5         43  
56             }
57             else {
58 1 50 33     9 if ( (@_) && $#_ % 2 == 1 ) {
59 1         7 %$self = @_;
60             }
61             }
62 6 50       28 unless ( $self->{mdone} ) {
63 6 50       23 unless ( $self->{type} ) {
64              
65             # Use local conf to get configStorage and localStorage
66 0         0 my $localconf =
67             $self->getLocalConf( CONFSECTION, $self->{confFile}, 0 );
68 0 0       0 if ( defined $localconf ) {
69 0         0 %$self = ( %$self, %$localconf );
70             }
71             }
72 6 50       32 unless ( $self->{type} ) {
73 0         0 $msg .= "Error: configStorage: type is not defined.\n";
74 0         0 return 0;
75             }
76 6 50       49 unless ( $self->{type} =~ /^[\w:]+$/ ) {
77 0         0 $msg .= "Error: configStorage: type is not well formed.\n";
78             }
79 6 50       36 $self->{type} = "Lemonldap::NG::Common::Conf::$self->{type}"
80             unless $self->{type} =~ /^Lemonldap::/;
81 6         479 eval "require $self->{type}";
82 6 100       51 if ($@) {
83 1         6 $msg .= "Error: Unknown package $self->{type}.\n";
84 1         10 return 0;
85             }
86 5 50       25 return 0 unless $self->prereq;
87 5         17 $self->{mdone}++;
88 5         22 $msg = "$self->{type} loaded.\n";
89             }
90 5 50 33     29 if ( $self->{localStorage} and not defined( $self->{refLocalStorage} ) ) {
91 0         0 eval "use $self->{localStorage};";
92 0 0       0 if ($@) {
93 0         0 $msg .= "Unable to load $self->{localStorage}: $@.\n";
94             }
95             else {
96 0         0 $self->{refLocalStorage} =
97             $self->{localStorage}->new( $self->{localStorageOptions} );
98             }
99             }
100 5         39 return $self;
101             }
102              
103             ## @method int saveConf(hashRef conf)
104             # Serialize $conf and call store().
105             # @param $conf Lemonldap::NG configuration hashRef
106             # @return Number of the saved configuration, 0 if case of error.
107             sub saveConf {
108 0     0 0 0 my ( $self, $conf ) = @_;
109              
110 0         0 my $last = $self->lastCfg;
111              
112             # If configuration was modified, return an error
113 0 0       0 if ( not $self->{force} ) {
114 0 0       0 return CONFIG_WAS_CHANGED if ( $conf->{cfgNum} != $last );
115 0 0 0     0 return DATABASE_LOCKED if ( $self->isLocked() or not $self->lock() );
116             }
117 0 0       0 $conf->{cfgNum} = $last + 1 unless ( $self->{cfgNumFixed} );
118 0         0 delete $conf->{cipher};
119              
120             # Try to store configuration
121 0         0 my $tmp = $self->store($conf);
122              
123 0 0       0 unless ( $tmp > 0 ) {
124 0         0 $msg .= "Configuration $conf->{cfgNum} not stored.\n";
125 0         0 $self->unlock();
126 0 0       0 return ( $tmp ? $tmp : UNKNOWN_ERROR );
127             }
128              
129 0         0 $msg .= "Configuration $conf->{cfgNum} stored.\n";
130 0 0       0 return ( $self->unlock() ? $tmp : UNKNOWN_ERROR );
131             }
132              
133             ## @method hashRef getConf(hashRef args)
134             # Get configuration from remote configuration storage system or from local
135             # cache if configuration has not been changed. If $args->{local} is set and if
136             # a local configuration is available, remote configuration is not tested.
137             #
138             # Uses lastCfg to test and getDBConf() to get the remote configuration
139             # @param $args Optional, contains {local=>1} or nothing
140             # @return Lemonldap::NG configuration
141             sub getConf {
142 0     0 1 0 my ( $self, $args ) = @_;
143              
144             # Use only cache to get conf
145 0 0 0     0 if ( $args->{local}
      0        
146             and ref( $self->{refLocalStorage} )
147             and my $res = $self->{refLocalStorage}->get('conf') )
148             {
149 0         0 $msg .= "Get configuration from cache without verification.\n";
150 0         0 return $res;
151             }
152              
153             # Check cfgNum in conf backend
154             # Get conf in backend only if a newer configuration is available
155             else {
156 0   0     0 $args->{cfgNum} ||= $self->lastCfg;
157 0 0       0 unless ( $args->{cfgNum} ) {
158 0         0 $msg .= "No configuration available in backend.\n";
159             }
160 0         0 my $r;
161 0 0       0 unless ( ref( $self->{refLocalStorage} ) ) {
162 0         0 $msg .= "Get remote configuration (localStorage unavailable).\n";
163 0         0 $r = $self->getDBConf($args);
164             }
165             else {
166 0         0 eval { $r = $self->{refLocalStorage}->get('conf') };
  0         0  
167 0 0       0 $msg = "Warn: $@" if ($@);
168 0 0 0     0 if ( ref($r) and $r->{cfgNum} == $args->{cfgNum} ) {
169 0         0 $msg .=
170             "Configuration unchanged, get configuration from cache.\n";
171 0         0 $args->{noCache} = 1;
172             }
173             else {
174 0         0 $r = $self->getDBConf($args);
175             }
176             }
177              
178             # Get default values
179 0         0 my $confAttributes = Lemonldap::NG::Common::Conf::Attributes->new();
180              
181 0         0 my @attributes = $confAttributes->meta()->get_attribute_list();
182              
183 0         0 foreach my $name (@attributes) {
184 0 0       0 unless ( defined $r->{$name} ) {
185 0         0 $r->{$name} = $confAttributes->$name;
186             }
187             }
188              
189             # Create cipher object
190 0         0 eval { $r->{cipher} = Lemonldap::NG::Common::Crypto->new( $r->{key} ); };
  0         0  
191 0 0       0 if ($@) {
192 0         0 $msg .= "Bad key: $@. \n";
193 0         0 return $r;
194             }
195              
196             # Adapt some values
197              
198             # Convert old option useXForwardedForIP into trustedProxies
199 0 0 0     0 if ( defined $r->{useXForwardedForIP}
200             and $r->{useXForwardedForIP} == 1 )
201             {
202 0         0 $r->{trustedProxies} = '*';
203             }
204              
205             # Force Choice backend
206 0 0       0 if ( $r->{authentication} eq "Choice" ) {
207 0         0 $r->{userDB} = "Choice";
208 0         0 $r->{passwordDB} = "Choice";
209             }
210              
211             # Some parameters expect key name (example), not variable ($example)
212 0         0 foreach (qw/whatToTrace/) {
213 0 0       0 if ( defined $r->{$_} ) {
214 0         0 $r->{$_} =~ s/^\$//;
215             }
216             }
217              
218             # Store modified configuration in cache
219 0 0 0     0 $self->setLocalConf($r)
220             if ( $self->{refLocalStorage} and not( $args->{noCache} ) );
221              
222             # Return configuration hash
223 0         0 return $r;
224             }
225             }
226              
227             ## @method hashRef getLocalConf(string section, string file, int loaddefault)
228             # Get configuration from local file
229             #
230             # @param $section Optional section name (default DEFAULTSECTION)
231             # @param $file Optional file name (default DEFAULTCONFFILE)
232             # @param $loaddefault Optional load default section parameters (default 1)
233             # @return Lemonldap::NG configuration
234             sub getLocalConf {
235 1     1 0 351 my ( $self, $section, $file, $loaddefault ) = @_;
236 1         2 my $r = {};
237              
238 1   50     4 $section ||= DEFAULTSECTION;
239 1   0     2 $file ||=
      33        
240             $self->{confFile}
241             || $ENV{LLNG_DEFAULTCONFFILE}
242             || DEFAULTCONFFILE;
243 1 50       3 $loaddefault = 1 unless ( defined $loaddefault );
244 1         1 my $cfg;
245              
246             # First, search if this file has been parsed
247 1 50       15 unless ( $cfg = $iniObj->{$file} ) {
248              
249             # If default configuration cannot be read
250             # - Error if configuration section is requested
251             # - Silent exit for other section requests
252 1 50       16 unless ( -r $file ) {
253 0 0       0 if ( $section eq CONFSECTION ) {
254 0         0 $msg .=
255             "Cannot read $file to get configuration access parameters.\n";
256 0         0 return $r;
257             }
258 0         0 return $r;
259             }
260              
261             # Parse ini file
262 1         13 $cfg = Config::IniFiles->new( -file => $file, -allowcontinue => 1 );
263              
264 1 50       11045 unless ( defined $cfg ) {
265 0         0 $msg .= "Local config error: " . @Config::IniFiles::errors . "\n";
266 0         0 return $r;
267             }
268              
269             # Check if default section exists
270 1 50       5 unless ( $cfg->SectionExists(DEFAULTSECTION) ) {
271 0         0 $msg .= "Default section (" . DEFAULTSECTION . ") is missing. \n";
272 0         0 return $r;
273             }
274              
275             # Check if configuration section exists
276 1 50 33     22 if ( $section eq CONFSECTION and !$cfg->SectionExists(CONFSECTION) ) {
277 0         0 $msg .= "Configuration section (" . CONFSECTION . ") is missing.\n";
278 0         0 return $r;
279             }
280             }
281 1         17 $self->{_iniObj} = $cfg;
282              
283             # First load all default section parameters
284 1 50       3 if ($loaddefault) {
285 0         0 foreach ( $cfg->Parameters(DEFAULTSECTION) ) {
286 0         0 $r->{$_} = $cfg->val( DEFAULTSECTION, $_ );
287 0 0 0     0 if ( $r->{$_} =~ /^[{\[].*[}\]]$/ || $r->{$_} =~ /^sub\s*{.*}$/ ) {
288 0         0 eval "\$r->{$_} = $r->{$_}";
289 0 0       0 if ($@) {
290 0         0 $msg .= "Warning: error in file $file: $@.\n";
291 0         0 return $r;
292             }
293             }
294             }
295             }
296              
297             # Stop if the requested section is the default section
298 1 50       2 return $r if ( $section eq DEFAULTSECTION );
299              
300             # Check if requested section exists
301 1 50       4 return $r unless $cfg->SectionExists($section);
302              
303             # Load section parameters
304 1         16 foreach ( $cfg->Parameters($section) ) {
305 4         24 $r->{$_} = $cfg->val( $section, $_ );
306 4 100 66     73 if ( $r->{$_} =~ /^[{\[].*[}\]]$/ || $r->{$_} =~ /^sub\s*{.*}$/ ) {
307 1         81 eval "\$r->{$_} = $r->{$_}";
308 1 50       6 if ($@) {
309 0         0 $msg .= "Warning: error in file $file: $@.\n";
310 0         0 return $r;
311             }
312             }
313             }
314              
315 1         37 return $r;
316             }
317              
318             ## @method void setLocalConf(hashRef conf)
319             # Store $conf in the local cache.
320             # @param $conf Lemonldap::NG configuration hashRef
321             sub setLocalConf {
322 0     0 0 0 my ( $self, $conf ) = @_;
323 0         0 eval { $self->{refLocalStorage}->set( "conf", $conf ) };
  0         0  
324 0 0       0 $msg .= "Warn: $@\n" if ($@);
325             }
326              
327             ## @method hashRef getDBConf(hashRef args)
328             # Get configuration from remote storage system.
329             # @param $args hashRef that must contains a key "cfgNum" (number of the wanted
330             # configuration) and optionaly a key "fields" that points to an array of wanted
331             # configuration keys
332             # @return Lemonldap::NG configuration hashRef
333             sub getDBConf {
334 0     0 0 0 my ( $self, $args ) = @_;
335 0 0       0 return undef unless $args->{cfgNum};
336 0 0       0 if ( $args->{cfgNum} < 0 ) {
337 0         0 my @a = $self->available();
338 0 0       0 $args->{cfgNum} =
339             ( @a + $args->{cfgNum} > 0 )
340             ? ( $a[ $#a + $args->{cfgNum} ] )
341             : $a[0];
342             }
343 0         0 my $conf = $self->load( $args->{cfgNum} );
344 0         0 $msg .= "Get configuration $conf->{cfgNum}.\n";
345 0 0 0     0 $self->setLocalConf($conf)
346             if ( $self->{refLocalStorage} and not( $args->{noCache} ) );
347 0         0 return $conf;
348             }
349              
350             ## @method boolean prereq()
351             # Call prereq() from the $self->{type} package.
352             # @return True if succeed
353             sub prereq {
354 5     5 0 13 return &{ $_[0]->{type} . '::prereq' }(@_);
  5         61  
355             }
356              
357             ## @method @ available()
358             # Call available() from the $self->{type} package.
359             # @return list of available configuration numbers
360             sub available {
361 0     0 0   return &{ $_[0]->{type} . '::available' }(@_);
  0            
362             }
363              
364             ## @method int lastCfg()
365             # Call lastCfg() from the $self->{type} package.
366             # @return Number of the last configuration available
367             sub lastCfg {
368 0   0 0 0   my $result = &{ $_[0]->{type} . '::lastCfg' }(@_) || "0";
369 0           return $result;
370             }
371              
372             ## @method boolean lock()
373             # Call lock() from the $self->{type} package.
374             # @return True if succeed
375             sub lock {
376 0     0 0   return &{ $_[0]->{type} . '::lock' }(@_);
  0            
377             }
378              
379             ## @method boolean isLocked()
380             # Call isLocked() from the $self->{type} package.
381             # @return True if database is locked
382             sub isLocked {
383 0     0 0   return &{ $_[0]->{type} . '::isLocked' }(@_);
  0            
384             }
385              
386             ## @method boolean unlock()
387             # Call unlock() from the $self->{type} package.
388             # @return True if succeed
389             sub unlock {
390 0     0 0   return &{ $_[0]->{type} . '::unlock' }(@_);
  0            
391             }
392              
393             ## @method int store(hashRef conf)
394             # Call store() from the $self->{type} package.
395             # @param $conf Lemondlap configuration serialized
396             # @return Number of new configuration stored if succeed, 0 else.
397             sub store {
398 0     0 0   return &{ $_[0]->{type} . '::store' }(@_);
  0            
399             }
400              
401             ## @method load(int cfgNum, arrayRef fields)
402             # Call load() from the $self->{type} package.
403             # @return Lemonldap::NG Configuration hashRef if succeed, 0 else.
404             sub load {
405 0     0 0   return &{ $_[0]->{type} . '::load' }(@_);
  0            
406             }
407              
408             ## @method boolean delete(int cfgNum)
409             # Call delete() from the $self->{type} package.
410             # @param $cfgNum Number of configuration to delete
411             # @return True if succeed
412             sub delete {
413 0     0 0   my ( $self, $c ) = @_;
414 0           my @a = $self->available();
415 0 0         return 0 unless ( @a + $c > 0 );
416 0           return &{ $self->{type} . '::delete' }( $self, $a[ $#a + $c ] );
  0            
417             }
418              
419             sub logError {
420 0     0 0   return &{ $_[0]->{type} . '::logError' }(@_);
  0            
421             }
422              
423             1;
424             __END__