Filename | /usr/local/libexec/sympa/Conf.pm |
Statements | Executed 55063 statements in 62.9ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
12042 | 8 | 3 | 33.9ms | 33.9ms | get_robot_conf | Conf::
2300 | 1 | 1 | 5.43ms | 5.43ms | valid_robot | Conf::
0 | 0 | 0 | 0s | 0s | BEGIN@32 | Conf::
0 | 0 | 0 | 0s | 0s | BEGIN@33 | Conf::
0 | 0 | 0 | 0s | 0s | BEGIN@34 | Conf::
0 | 0 | 0 | 0s | 0s | BEGIN@36 | Conf::
0 | 0 | 0 | 0s | 0s | BEGIN@37 | Conf::
0 | 0 | 0 | 0s | 0s | BEGIN@38 | Conf::
0 | 0 | 0 | 0s | 0s | BEGIN@39 | Conf::
0 | 0 | 0 | 0s | 0s | BEGIN@40 | Conf::
0 | 0 | 0 | 0s | 0s | BEGIN@41 | Conf::
0 | 0 | 0 | 0s | 0s | BEGIN@42 | Conf::
0 | 0 | 0 | 0s | 0s | BEGIN@43 | Conf::
0 | 0 | 0 | 0s | 0s | BEGIN@44 | Conf::
0 | 0 | 0 | 0s | 0s | BEGIN@45 | Conf::
0 | 0 | 0 | 0s | 0s | CORE:close (opcode) | Conf::
0 | 0 | 0 | 0s | 0s | CORE:closedir (opcode) | Conf::
0 | 0 | 0 | 0s | 0s | CORE:eof (opcode) | Conf::
0 | 0 | 0 | 0s | 0s | CORE:ftdir (opcode) | Conf::
0 | 0 | 0 | 0s | 0s | CORE:fteread (opcode) | Conf::
0 | 0 | 0 | 0s | 0s | CORE:ftfile (opcode) | Conf::
0 | 0 | 0 | 0s | 0s | CORE:match (opcode) | Conf::
0 | 0 | 0 | 0s | 0s | CORE:open (opcode) | Conf::
0 | 0 | 0 | 0s | 0s | CORE:open_dir (opcode) | Conf::
0 | 0 | 0 | 0s | 0s | CORE:readdir (opcode) | Conf::
0 | 0 | 0 | 0s | 0s | CORE:readline (opcode) | Conf::
0 | 0 | 0 | 0s | 0s | CORE:regcomp (opcode) | Conf::
0 | 0 | 0 | 0s | 0s | CORE:sort (opcode) | Conf::
0 | 0 | 0 | 0s | 0s | CORE:subst (opcode) | Conf::
0 | 0 | 0 | 0s | 0s | __ANON__ (xsub) | Conf::
0 | 0 | 0 | 0s | 0s | _check_cpan_modules_required_by_config | Conf::
0 | 0 | 0 | 0s | 0s | _create_robot_like_config_for_main_robot | Conf::
0 | 0 | 0 | 0s | 0s | _detect_missing_mandatory_parameters | Conf::
0 | 0 | 0 | 0s | 0s | _detect_unknown_parameters_in_config | Conf::
0 | 0 | 0 | 0s | 0s | _dump_non_robot_parameters | Conf::
0 | 0 | 0 | 0s | 0s | _get_parameters_names_by_category | Conf::
0 | 0 | 0 | 0s | 0s | _infer_robot_parameter_values | Conf::
0 | 0 | 0 | 0s | 0s | _infer_server_specific_parameter_values | Conf::
0 | 0 | 0 | 0s | 0s | _load_a_param | Conf::
0 | 0 | 0 | 0s | 0s | _load_auth | Conf::
0 | 0 | 0 | 0s | 0s | _load_config_file_to_hash | Conf::
0 | 0 | 0 | 0s | 0s | _load_mime_types | Conf::
0 | 0 | 0 | 0s | 0s | _load_robot_secondary_config_files | Conf::
0 | 0 | 0 | 0s | 0s | _load_server_specific_secondary_config_files | Conf::
0 | 0 | 0 | 0s | 0s | _load_single_robot_config | Conf::
0 | 0 | 0 | 0s | 0s | _load_wwsconf | Conf::
0 | 0 | 0 | 0s | 0s | _parse_custom_robot_parameters | Conf::
0 | 0 | 0 | 0s | 0s | _remove_unvalid_robot_entry | Conf::
0 | 0 | 0 | 0s | 0s | _replace_file_value_by_db_value | Conf::
0 | 0 | 0 | 0s | 0s | _set_listmasters_entry | Conf::
0 | 0 | 0 | 0s | 0s | _store_source_file_name | Conf::
0 | 0 | 0 | 0s | 0s | checkfiles | Conf::
0 | 0 | 0 | 0s | 0s | checkfiles_as_root | Conf::
0 | 0 | 0 | 0s | 0s | conf_2_db | Conf::
0 | 0 | 0 | 0s | 0s | data_structure_uptodate | Conf::
0 | 0 | 0 | 0s | 0s | get_db_conf | Conf::
0 | 0 | 0 | 0s | 0s | get_mime_type | Conf::
0 | 0 | 0 | 0s | 0s | get_parameters_group | Conf::
0 | 0 | 0 | 0s | 0s | get_robots_list | Conf::
0 | 0 | 0 | 0s | 0s | get_sso_by_id | Conf::
0 | 0 | 0 | 0s | 0s | get_sympa_conf | Conf::
0 | 0 | 0 | 0s | 0s | get_wwsympa_conf | Conf::
0 | 0 | 0 | 0s | 0s | lang2charset | Conf::
0 | 0 | 0 | 0s | 0s | load | Conf::
0 | 0 | 0 | 0s | 0s | load_automatic_lists_description | Conf::
0 | 0 | 0 | 0s | 0s | load_charset | Conf::
0 | 0 | 0 | 0s | 0s | load_crawlers_detection | Conf::
0 | 0 | 0 | 0s | 0s | load_generic_conf_file | Conf::
0 | 0 | 0 | 0s | 0s | load_nrcpt_by_domain | Conf::
0 | 0 | 0 | 0s | 0s | load_robots | Conf::
0 | 0 | 0 | 0s | 0s | load_sql_filter | Conf::
0 | 0 | 0 | 0s | 0s | load_trusted_application | Conf::
0 | 0 | 0 | 0s | 0s | set_robot_conf | Conf::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | # -*- indent-tabs-mode: nil; -*- | ||||
2 | # vim:ft=perl:et:sw=4 | ||||
3 | # $Id$ | ||||
4 | |||||
5 | # Sympa - SYsteme de Multi-Postage Automatique | ||||
6 | # | ||||
7 | # Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel | ||||
8 | # Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, | ||||
9 | # 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites | ||||
10 | # Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER | ||||
11 | # Copyright 2017, 2018, 2019, 2020 The Sympa Community. See the AUTHORS.md | ||||
12 | # file at the top-level directory of this distribution and at | ||||
13 | # <https://github.com/sympa-community/sympa.git>. | ||||
14 | # | ||||
15 | # This program is free software; you can redistribute it and/or modify | ||||
16 | # it under the terms of the GNU General Public License as published by | ||||
17 | # the Free Software Foundation; either version 2 of the License, or | ||||
18 | # (at your option) any later version. | ||||
19 | # | ||||
20 | # This program is distributed in the hope that it will be useful, | ||||
21 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | ||||
22 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||||
23 | # GNU General Public License for more details. | ||||
24 | # | ||||
25 | # You should have received a copy of the GNU General Public License | ||||
26 | # along with this program. If not, see <http://www.gnu.org/licenses/>. | ||||
27 | |||||
28 | ## This module handles the configuration file for Sympa. | ||||
29 | |||||
30 | package Conf; | ||||
31 | |||||
32 | use strict; | ||||
33 | use warnings; | ||||
34 | use English qw(-no_match_vars); | ||||
35 | |||||
36 | use Sympa; | ||||
37 | use Sympa::ConfDef; | ||||
38 | use Sympa::Constants; | ||||
39 | use Sympa::DatabaseManager; | ||||
40 | use Sympa::Language; | ||||
41 | use Sympa::Log; | ||||
42 | use Sympa::Regexps; | ||||
43 | use Sympa::Tools::Data; | ||||
44 | use Sympa::Tools::File; | ||||
45 | use Sympa::Tools::Text; | ||||
46 | |||||
47 | my $log = Sympa::Log->instance; | ||||
48 | |||||
49 | =encoding utf-8 | ||||
50 | |||||
51 | #=head1 NAME | ||||
52 | # | ||||
53 | #Conf - Sympa configuration | ||||
54 | |||||
55 | =head1 DESCRIPTION | ||||
56 | |||||
57 | =head2 CONSTANTS AND EXPORTED VARIABLES | ||||
58 | |||||
59 | =cut | ||||
60 | |||||
61 | ## Database and SQL statement handlers | ||||
62 | my $sth; | ||||
63 | # parameters hash, keyed by parameter name | ||||
64 | our %params = | ||||
65 | map { $_->{name} => $_ } | ||||
66 | grep { $_->{name} } @Sympa::ConfDef::params; | ||||
67 | |||||
68 | # valid virtual host parameters, keyed by parameter name | ||||
69 | my %valid_robot_key_words; | ||||
70 | my %db_storable_parameters; | ||||
71 | my %optional_key_words; | ||||
72 | foreach my $hash (@Sympa::ConfDef::params) { | ||||
73 | $valid_robot_key_words{$hash->{'name'}} = 1 if ($hash->{'vhost'}); | ||||
74 | $db_storable_parameters{$hash->{'name'}} = 1 | ||||
75 | if (defined($hash->{'db'}) and $hash->{'db'} ne 'none'); | ||||
76 | $optional_key_words{$hash->{'name'}} = 1 if ($hash->{'optional'}); | ||||
77 | } | ||||
78 | |||||
79 | our $params_by_categories = _get_parameters_names_by_category(); | ||||
80 | |||||
81 | my %old_params = ( | ||||
82 | trusted_ca_options => 'capath,cafile', | ||||
83 | 'msgcat' => '', | ||||
84 | queueexpire => '', | ||||
85 | clean_delay_queueother => '', | ||||
86 | web_recode_to => 'filesystem_encoding', # ??? - 5.2 | ||||
87 | 'localedir' => '', | ||||
88 | 'ldap_export_connection_timeout' => '', # 3.3b3 - 4.1? | ||||
89 | 'ldap_export_dnmanager' => '', # ,, | ||||
90 | 'ldap_export_host' => '', # ,, | ||||
91 | 'ldap_export_name' => '', # ,, | ||||
92 | 'ldap_export_password' => '', # ,, | ||||
93 | 'ldap_export_suffix' => '', # ,, | ||||
94 | 'tri' => 'sort', # ??? - 1.3.4-1 | ||||
95 | 'sort' => '', # 1.4.0 - ??? | ||||
96 | 'pidfile' => '', # ??? - 6.1.17 | ||||
97 | 'pidfile_distribute' => '', # ,, | ||||
98 | 'pidfile_creation' => '', # ,, | ||||
99 | 'pidfile_bulk' => '', # ,, | ||||
100 | 'archived_pidfile' => '', # ,, | ||||
101 | 'bounced_pidfile' => '', # ,, | ||||
102 | 'task_manager_pidfile' => '', # ,, | ||||
103 | 'email_gecos' => 'gecos', # 6.2a.?? - 6.2a.33 | ||||
104 | 'lock_method' => '', # 5.3b.3 - 6.2a.33 | ||||
105 | 'html_editor_file' => 'html_editor_url', # 6.2a | ||||
106 | 'openssl' => '', # ?? - 6.2a.40 | ||||
107 | 'distribution_mode' => '', # 5.0a.1 - 6.2a.40 | ||||
108 | 'queuedistribute' => '', # ,, | ||||
109 | |||||
110 | # These are not yet implemented | ||||
111 | 'crl_dir' => '', | ||||
112 | 'dkim_header_list' => '', | ||||
113 | ); | ||||
114 | |||||
115 | my %trusted_applications = ( | ||||
116 | 'trusted_application' => { | ||||
117 | 'occurrence' => '0-n', | ||||
118 | 'format' => { | ||||
119 | 'name' => { | ||||
120 | 'format' => '\S*', | ||||
121 | 'occurrence' => '1', | ||||
122 | 'case' => 'insensitive', | ||||
123 | }, | ||||
124 | 'ip' => { | ||||
125 | 'format' => '\d+\.\d+\.\d+\.\d+', | ||||
126 | 'occurrence' => '0-1' | ||||
127 | }, | ||||
128 | 'md5password' => { | ||||
129 | 'format' => '.*', | ||||
130 | 'occurrence' => '0-1' | ||||
131 | }, | ||||
132 | 'proxy_for_variables' => { | ||||
133 | 'format' => '.*', | ||||
134 | 'occurrence' => '0-n', | ||||
135 | 'split_char' => ',' | ||||
136 | }, | ||||
137 | 'set_variables' => { | ||||
138 | 'format' => '\S+=.*', | ||||
139 | 'occurrence' => '0-n', | ||||
140 | 'split_char' => ',', | ||||
141 | }, | ||||
142 | 'allow_commands' => { | ||||
143 | 'format' => '\S+', | ||||
144 | 'occurrence' => '0-n', | ||||
145 | 'split_char' => ',', | ||||
146 | }, | ||||
147 | } | ||||
148 | } | ||||
149 | ); | ||||
150 | #XXXmy $binary_file_extension = ".bin"; | ||||
151 | |||||
152 | our $wwsconf; | ||||
153 | our %Conf = (); | ||||
154 | |||||
155 | =head2 FUNCTIONS | ||||
156 | |||||
157 | =over 4 | ||||
158 | |||||
159 | =item load ( [ CONFIG_FILE ], [ NO_DB ], [ RETURN_RESULT ] ) | ||||
160 | |||||
161 | Loads and parses the configuration file. Reports errors if any. | ||||
162 | |||||
163 | do not try to load database values if NO_DB is set; | ||||
164 | do not change gloval hash %Conf if RETURN_RESULT is set; | ||||
165 | |||||
166 | ## we known that's dirty, this proc should be rewritten without this global | ||||
167 | ## var %Conf | ||||
168 | |||||
169 | =back | ||||
170 | |||||
171 | =cut | ||||
172 | |||||
173 | sub load { | ||||
174 | my $config_file = shift || get_sympa_conf(); | ||||
175 | my $no_db = shift; | ||||
176 | my $return_result = shift; | ||||
177 | my $force_reload; | ||||
178 | |||||
179 | my $config_err = 0; | ||||
180 | my %line_numbered_config; | ||||
181 | |||||
182 | $log->syslog('debug3', | ||||
183 | 'File %s has changed since the last cache. Loading file', | ||||
184 | $config_file); | ||||
185 | # Will force the robot.conf reloading, as sympa.conf is the default. | ||||
186 | $force_reload = 1; | ||||
187 | ## Loading the Sympa main config file. | ||||
188 | if (my $config_loading_result = | ||||
189 | _load_config_file_to_hash({'path_to_config_file' => $config_file})) { | ||||
190 | %line_numbered_config = | ||||
191 | %{$config_loading_result->{'numbered_config'}}; | ||||
192 | %Conf = %{$config_loading_result->{'config'}}; | ||||
193 | $config_err = $config_loading_result->{'errors'}; | ||||
194 | } else { | ||||
195 | return undef; | ||||
196 | } | ||||
197 | # Returning the config file content if this is what has been asked. | ||||
198 | return (\%line_numbered_config) if ($return_result); | ||||
199 | |||||
200 | # Users may define parameters with a typo or other errors. Check that | ||||
201 | # the parameters | ||||
202 | # we found in the config file are all well defined Sympa parameters. | ||||
203 | $config_err += _detect_unknown_parameters_in_config( | ||||
204 | { 'config_hash' => \%Conf, | ||||
205 | 'config_file_line_numbering_reference' => \%line_numbered_config, | ||||
206 | } | ||||
207 | ); | ||||
208 | |||||
209 | _set_listmasters_entry({'config_hash' => \%Conf, 'main_config' => 1}); | ||||
210 | |||||
211 | ## Some parameters must have a value specifically defined in the | ||||
212 | ## config. If not, it is an error. | ||||
213 | $config_err += _detect_missing_mandatory_parameters( | ||||
214 | {'config_hash' => \%Conf, 'file_to_check' => $config_file}); | ||||
215 | |||||
216 | # Some parameters need special treatments to get their final values. | ||||
217 | _infer_server_specific_parameter_values({'config_hash' => \%Conf,}); | ||||
218 | |||||
219 | _infer_robot_parameter_values({'config_hash' => \%Conf}); | ||||
220 | |||||
221 | if ($config_err) { | ||||
222 | $log->syslog('err', 'Errors while parsing main config file %s', | ||||
223 | $config_file); | ||||
224 | return undef; | ||||
225 | } | ||||
226 | |||||
227 | _store_source_file_name( | ||||
228 | {'config_hash' => \%Conf, 'config_file' => $config_file}); | ||||
229 | #XXX_save_config_hash_to_binary({'config_hash' => \%Conf,}); | ||||
230 | |||||
231 | if (my $missing_modules_count = | ||||
232 | _check_cpan_modules_required_by_config({'config_hash' => \%Conf,})) { | ||||
233 | $log->syslog('err', 'Warning: %d required modules are missing', | ||||
234 | $missing_modules_count); | ||||
235 | } | ||||
236 | |||||
237 | _replace_file_value_by_db_value({'config_hash' => \%Conf}) | ||||
238 | unless ($no_db); | ||||
239 | _load_server_specific_secondary_config_files({'config_hash' => \%Conf,}); | ||||
240 | _load_robot_secondary_config_files({'config_hash' => \%Conf}); | ||||
241 | |||||
242 | ## Load robot.conf files | ||||
243 | unless ( | ||||
244 | load_robots( | ||||
245 | { 'config_hash' => \%Conf, | ||||
246 | 'no_db' => $no_db, | ||||
247 | 'force_reload' => $force_reload | ||||
248 | } | ||||
249 | ) | ||||
250 | ) { | ||||
251 | return undef; | ||||
252 | } | ||||
253 | ##_create_robot_like_config_for_main_robot(); | ||||
254 | return 1; | ||||
255 | } | ||||
256 | |||||
257 | ## load each virtual robots configuration files | ||||
258 | sub load_robots { | ||||
259 | my $param = shift; | ||||
260 | my @robots; | ||||
261 | |||||
262 | my $robots_list_ref = get_robots_list(); | ||||
263 | unless (defined $robots_list_ref) { | ||||
264 | $log->syslog('err', 'Robots config loading failed'); | ||||
265 | return undef; | ||||
266 | } else { | ||||
267 | @robots = @{$robots_list_ref}; | ||||
268 | } | ||||
269 | unless ($#robots > -1) { | ||||
270 | return 1; | ||||
271 | } | ||||
272 | my $exiting = 0; | ||||
273 | foreach my $robot (@robots) { | ||||
274 | my $robot_config_file = "$Conf{'etc'}/$robot/robot.conf"; | ||||
275 | my $robot_conf = undef; | ||||
276 | unless ( | ||||
277 | $robot_conf = _load_single_robot_config( | ||||
278 | { 'robot' => $robot, | ||||
279 | 'no_db' => $param->{'no_db'}, | ||||
280 | 'force_reload' => $param->{'force_reload'} | ||||
281 | } | ||||
282 | ) | ||||
283 | ) { | ||||
284 | $log->syslog( | ||||
285 | 'err', | ||||
286 | 'The config for robot %s contain errors: it could not be correctly loaded', | ||||
287 | $robot | ||||
288 | ); | ||||
289 | $exiting = 1; | ||||
290 | } else { | ||||
291 | $param->{'config_hash'}{'robots'}{$robot} = $robot_conf; | ||||
292 | } | ||||
293 | #_check_double_url_usage( | ||||
294 | # {'config_hash' => $param->{'config_hash'}{'robots'}{$robot}}); | ||||
295 | } | ||||
296 | return undef if ($exiting); | ||||
297 | return 1; | ||||
298 | } | ||||
299 | |||||
300 | ## returns a robot conf parameter | ||||
301 | # spent 33.9ms within Conf::get_robot_conf which was called 12042 times, avg 3µs/call:
# 2300 times (7.22ms+0s) by Sympa::Spool::split_listname at line 333 of /usr/local/libexec/sympa/Sympa/Spool.pm, avg 3µs/call
# 2300 times (4.14ms+0s) by Sympa::Spool::unmarshal_metadata at line 431 of /usr/local/libexec/sympa/Sympa/Spool.pm, avg 2µs/call
# 2300 times (3.43ms+0s) by Sympa::Spool::split_listname at line 338 of /usr/local/libexec/sympa/Sympa/Spool.pm, avg 1µs/call
# 1507 times (6.63ms+0s) by Sympa::get_supported_languages at line 576 of /usr/local/libexec/sympa/Sympa.pm, avg 4µs/call
# 1494 times (6.39ms+0s) by Sympa::List::new at line 154 of /usr/local/libexec/sympa/Sympa/List.pm, avg 4µs/call
# 1494 times (4.21ms+0s) by Sympa::List::load at line 660 of /usr/local/libexec/sympa/Sympa/List.pm, avg 3µs/call
# 634 times (1.80ms+0s) by Sympa::List::_load_list_param at line 4894 of /usr/local/libexec/sympa/Sympa/List.pm, avg 3µs/call
# 13 times (55µs+0s) by Sympa::List::load at line 702 of /usr/local/libexec/sympa/Sympa/List.pm, avg 4µs/call | ||||
302 | 12042 | 4.68ms | my ($robot, $param) = @_; | ||
303 | |||||
304 | 12042 | 6.21ms | $param = $Sympa::Config::Schema::obsolete_robot_params{$param} // $param; | ||
305 | |||||
306 | 12042 | 8.87ms | if (defined $robot && $robot ne '*') { | ||
307 | if ( defined $Conf{'robots'}{$robot} | ||||
308 | && defined $Conf{'robots'}{$robot}{$param}) { | ||||
309 | return $Conf{'robots'}{$robot}{$param}; | ||||
310 | } | ||||
311 | } | ||||
312 | ## default | ||||
313 | 12037 | 31.7ms | return $Conf{$param}; | ||
314 | } | ||||
315 | |||||
316 | =over 4 | ||||
317 | |||||
318 | =item get_sympa_conf | ||||
319 | |||||
320 | Gets path name of main config file. | ||||
321 | Path name is taken from: | ||||
322 | |||||
323 | =over 4 | ||||
324 | |||||
325 | =item 1 | ||||
326 | |||||
327 | C<--config> command line option | ||||
328 | |||||
329 | =item 2 | ||||
330 | |||||
331 | C<SYMPA_CONFIG> environment variable | ||||
332 | |||||
333 | =item 3 | ||||
334 | |||||
335 | built-in default | ||||
336 | |||||
337 | =back | ||||
338 | |||||
339 | =back | ||||
340 | |||||
341 | =cut | ||||
342 | |||||
343 | our $sympa_config; | ||||
344 | |||||
345 | sub get_sympa_conf { | ||||
346 | return $sympa_config || $ENV{'SYMPA_CONFIG'} || Sympa::Constants::CONFIG; | ||||
347 | } | ||||
348 | |||||
349 | =over 4 | ||||
350 | |||||
351 | =item get_wwsympa_conf | ||||
352 | |||||
353 | Gets path name of wwsympa.conf file. | ||||
354 | Path name is taken from: | ||||
355 | |||||
356 | =over 4 | ||||
357 | |||||
358 | =item 1 | ||||
359 | |||||
360 | C<SYMPA_WWSCONFIG> environment variable | ||||
361 | |||||
362 | =item 2 | ||||
363 | |||||
364 | built-in default | ||||
365 | |||||
366 | =back | ||||
367 | |||||
368 | =back | ||||
369 | |||||
370 | =cut | ||||
371 | |||||
372 | sub get_wwsympa_conf { | ||||
373 | return $ENV{'SYMPA_WWSCONFIG'} || Sympa::Constants::WWSCONFIG; | ||||
374 | } | ||||
375 | |||||
376 | # deletes all the *.conf.bin files. | ||||
377 | # No longer used. | ||||
378 | #sub delete_binaries; | ||||
379 | |||||
380 | # Return a reference to an array containing the names of the robots on the | ||||
381 | # server. | ||||
382 | sub get_robots_list { | ||||
383 | $log->syslog('debug2', "Retrieving the list of robots on the server"); | ||||
384 | my @robots_list; | ||||
385 | unless (opendir DIR, $Conf{'etc'}) { | ||||
386 | $log->syslog('err', | ||||
387 | 'Unable to open directory %s for virtual robots config', | ||||
388 | $Conf{'etc'}); | ||||
389 | return undef; | ||||
390 | } | ||||
391 | foreach my $robot (readdir DIR) { | ||||
392 | my $robot_config_file = "$Conf{'etc'}/$robot/robot.conf"; | ||||
393 | next unless (-d "$Conf{'etc'}/$robot"); | ||||
394 | next unless (-f $robot_config_file); | ||||
395 | push @robots_list, $robot; | ||||
396 | } | ||||
397 | closedir(DIR); | ||||
398 | return \@robots_list; | ||||
399 | } | ||||
400 | |||||
401 | ## Returns a hash containing the values of all the parameters of the group | ||||
402 | ## (as defined in Sympa::ConfDef) whose name is given as argument, in the | ||||
403 | ## context of the robot given as argument. | ||||
404 | sub get_parameters_group { | ||||
405 | my ($robot, $group) = @_; | ||||
406 | $log->syslog('debug3', 'Getting parameters for group "%s"', $group); | ||||
407 | my $param_hash; | ||||
408 | foreach my $param_name (keys %{$params_by_categories->{$group}}) { | ||||
409 | $param_hash->{$param_name} = get_robot_conf($robot, $param_name); | ||||
410 | } | ||||
411 | return $param_hash; | ||||
412 | } | ||||
413 | |||||
414 | ## fetch the value from parameter $label of robot $robot from conf_table | ||||
415 | sub get_db_conf { | ||||
416 | my $robot = shift; | ||||
417 | my $label = shift; | ||||
418 | |||||
419 | # if the value is related to a robot that is not explicitly defined, apply | ||||
420 | # it to the default robot. | ||||
421 | $robot = '*' unless (-f $Conf{'etc'} . '/' . $robot . '/robot.conf'); | ||||
422 | unless ($robot) { $robot = '*' } | ||||
423 | |||||
424 | my $sdm = Sympa::DatabaseManager->instance; | ||||
425 | unless ( | ||||
426 | $sdm | ||||
427 | and $sth = $sdm->do_prepared_query( | ||||
428 | q{SELECT value_conf AS value | ||||
429 | FROM conf_table | ||||
430 | WHERE robot_conf = ? AND label_conf = ?}, | ||||
431 | $robot, $label | ||||
432 | ) | ||||
433 | ) { | ||||
434 | $log->syslog( | ||||
435 | 'err', | ||||
436 | 'Unable retrieve value of parameter %s for robot %s from the database', | ||||
437 | $label, | ||||
438 | $robot | ||||
439 | ); | ||||
440 | return undef; | ||||
441 | } | ||||
442 | |||||
443 | my $value = $sth->fetchrow; | ||||
444 | |||||
445 | $sth->finish(); | ||||
446 | return $value; | ||||
447 | } | ||||
448 | |||||
449 | ## store the value from parameter $label of robot $robot from conf_table | ||||
450 | sub set_robot_conf { | ||||
451 | my $robot = shift; | ||||
452 | my $label = shift; | ||||
453 | my $value = shift; | ||||
454 | |||||
455 | $log->syslog('info', 'Set config for robot %s, %s="%s"', | ||||
456 | $robot, $label, $value); | ||||
457 | |||||
458 | # set the current config before to update database. | ||||
459 | if (-f "$Conf{'etc'}/$robot/robot.conf") { | ||||
460 | $Conf{'robots'}{$robot}{$label} = $value; | ||||
461 | } else { | ||||
462 | $Conf{$label} = $value; | ||||
463 | $robot = '*'; | ||||
464 | } | ||||
465 | |||||
466 | my $sdm = Sympa::DatabaseManager->instance; | ||||
467 | unless ( | ||||
468 | $sdm | ||||
469 | and $sth = $sdm->do_prepared_query( | ||||
470 | q{SELECT COUNT(*) | ||||
471 | FROM conf_table | ||||
472 | WHERE robot_conf = ? AND label_conf = ?}, | ||||
473 | $robot, $label | ||||
474 | ) | ||||
475 | ) { | ||||
476 | $log->syslog( | ||||
477 | 'err', | ||||
478 | 'Unable to check presence of parameter %s for robot %s in database', | ||||
479 | $label, | ||||
480 | $robot | ||||
481 | ); | ||||
482 | return undef; | ||||
483 | } | ||||
484 | |||||
485 | my $count = $sth->fetchrow; | ||||
486 | $sth->finish(); | ||||
487 | |||||
488 | if ($count == 0) { | ||||
489 | unless ( | ||||
490 | $sth = $sdm->do_prepared_query( | ||||
491 | q{INSERT INTO conf_table | ||||
492 | (robot_conf, label_conf, value_conf) | ||||
493 | VALUES (?, ?, ?)}, | ||||
494 | $robot, $label, $value | ||||
495 | ) | ||||
496 | ) { | ||||
497 | $log->syslog( | ||||
498 | 'err', | ||||
499 | 'Unable add value %s for parameter %s in the robot %s DB conf', | ||||
500 | $value, | ||||
501 | $label, | ||||
502 | $robot | ||||
503 | ); | ||||
504 | return undef; | ||||
505 | } | ||||
506 | } else { | ||||
507 | unless ( | ||||
508 | $sth = $sdm->do_prepared_query( | ||||
509 | q{UPDATE conf_table | ||||
510 | SET robot_conf = ?, label_conf = ?, value_conf = ? | ||||
511 | WHERE robot_conf = ? AND label_conf = ?}, | ||||
512 | $robot, $label, $value, | ||||
513 | $robot, $label | ||||
514 | ) | ||||
515 | ) { | ||||
516 | $log->syslog( | ||||
517 | 'err', | ||||
518 | 'Unable set parameter %s value to %s in the robot %s DB conf', | ||||
519 | $label, | ||||
520 | $value, | ||||
521 | $robot | ||||
522 | ); | ||||
523 | return undef; | ||||
524 | } | ||||
525 | } | ||||
526 | } | ||||
527 | |||||
528 | # Store configs to database | ||||
529 | sub conf_2_db { | ||||
530 | $log->syslog('debug2', '(%s)', @_); | ||||
531 | |||||
532 | my @conf_parameters = @Sympa::ConfDef::params; | ||||
533 | |||||
534 | # store in database robots parameters. | ||||
535 | # load only parameters that are in a robot.conf file (do not apply | ||||
536 | # defaults). | ||||
537 | my $robots_conf = load_robots(); | ||||
538 | |||||
539 | unless (opendir DIR, $Conf{'etc'}) { | ||||
540 | $log->syslog('err', | ||||
541 | 'Unable to open directory %s for virtual robots config', | ||||
542 | $Conf{'etc'}); | ||||
543 | return undef; | ||||
544 | } | ||||
545 | |||||
546 | foreach my $robot (readdir(DIR)) { | ||||
547 | next unless (-d "$Conf{'etc'}/$robot"); | ||||
548 | next unless (-f "$Conf{'etc'}/$robot/robot.conf"); | ||||
549 | |||||
550 | my $config; | ||||
551 | if (my $result_of_config_loading = _load_config_file_to_hash( | ||||
552 | { 'path_to_config_file' => $Conf{'etc'} . '/' | ||||
553 | . $robot | ||||
554 | . '/robot.conf' | ||||
555 | } | ||||
556 | ) | ||||
557 | ) { | ||||
558 | $config = $result_of_config_loading->{'config'}; | ||||
559 | } | ||||
560 | _remove_unvalid_robot_entry($config); | ||||
561 | |||||
562 | for my $i (0 .. $#conf_parameters) { | ||||
563 | if ($conf_parameters[$i]->{'name'}) { | ||||
564 | # skip separators in conf_parameters structure | ||||
565 | if (($conf_parameters[$i]->{'vhost'} eq '1') | ||||
566 | && #skip parameters that can't be define by robot so not to be loaded in db at that stage | ||||
567 | ($config->{$conf_parameters[$i]->{'name'}}) | ||||
568 | ) { | ||||
569 | Conf::set_robot_conf( | ||||
570 | $robot, | ||||
571 | $conf_parameters[$i]->{'name'}, | ||||
572 | $config->{$conf_parameters[$i]->{'name'}} | ||||
573 | ); | ||||
574 | } | ||||
575 | } | ||||
576 | } | ||||
577 | } | ||||
578 | closedir(DIR); | ||||
579 | |||||
580 | # store in database sympa;conf and wwsympa.conf | ||||
581 | |||||
582 | ## Load configuration file. Ignoring database config and get result | ||||
583 | my $global_conf; | ||||
584 | unless ($global_conf = | ||||
585 | Conf::load(Conf::get_sympa_conf(), 1, 'return_result')) { | ||||
586 | $log->syslog('err', 'Configuration file %s has errors', | ||||
587 | Conf::get_sympa_conf()); | ||||
588 | return undef; | ||||
589 | } | ||||
590 | |||||
591 | for my $i (0 .. $#conf_parameters) { | ||||
592 | if (($conf_parameters[$i]->{'edit'} eq '1') | ||||
593 | && $global_conf->{$conf_parameters[$i]->{'name'}}) { | ||||
594 | Conf::set_robot_conf( | ||||
595 | "*", | ||||
596 | $conf_parameters[$i]->{'name'}, | ||||
597 | $global_conf->{$conf_parameters[$i]->{'name'}}[0] | ||||
598 | ); | ||||
599 | } | ||||
600 | } | ||||
601 | } | ||||
602 | |||||
603 | ## Check required files and create them if required | ||||
604 | sub checkfiles_as_root { | ||||
605 | |||||
606 | my $config_err = 0; | ||||
607 | |||||
608 | ## Check aliases file | ||||
609 | unless (-f $Conf{'sendmail_aliases'} | ||||
610 | || ($Conf{'sendmail_aliases'} =~ /^none$/i)) { | ||||
611 | unless (open ALIASES, ">$Conf{'sendmail_aliases'}") { | ||||
612 | $log->syslog( | ||||
613 | 'err', | ||||
614 | "Failed to create aliases file %s", | ||||
615 | $Conf{'sendmail_aliases'} | ||||
616 | ); | ||||
617 | return undef; | ||||
618 | } | ||||
619 | |||||
620 | print ALIASES | ||||
621 | "## This aliases file is dedicated to Sympa Mailing List Manager\n"; | ||||
622 | print ALIASES | ||||
623 | "## You should edit your sendmail.mc or sendmail.cf file to declare it\n"; | ||||
624 | close ALIASES; | ||||
625 | $log->syslog( | ||||
626 | 'notice', | ||||
627 | "Created missing file %s", | ||||
628 | $Conf{'sendmail_aliases'} | ||||
629 | ); | ||||
630 | unless ( | ||||
631 | Sympa::Tools::File::set_file_rights( | ||||
632 | file => $Conf{'sendmail_aliases'}, | ||||
633 | user => Sympa::Constants::USER, | ||||
634 | group => Sympa::Constants::GROUP, | ||||
635 | mode => 0644, | ||||
636 | ) | ||||
637 | ) { | ||||
638 | $log->syslog('err', 'Unable to set rights on %s', | ||||
639 | $Conf{'db_name'}); | ||||
640 | return undef; | ||||
641 | } | ||||
642 | } | ||||
643 | |||||
644 | foreach my $robot (keys %{$Conf{'robots'}}) { | ||||
645 | |||||
646 | # create static content directory | ||||
647 | my $dir = get_robot_conf($robot, 'static_content_path'); | ||||
648 | if ($dir ne '' && !-d $dir) { | ||||
649 | unless (mkdir($dir, 0775)) { | ||||
650 | $log->syslog('err', 'Unable to create directory %s: %m', | ||||
651 | $dir); | ||||
652 | $config_err++; | ||||
653 | } | ||||
654 | |||||
655 | unless ( | ||||
656 | Sympa::Tools::File::set_file_rights( | ||||
657 | file => $dir, | ||||
658 | user => Sympa::Constants::USER, | ||||
659 | group => Sympa::Constants::GROUP, | ||||
660 | ) | ||||
661 | ) { | ||||
662 | $log->syslog('err', 'Unable to set rights on %s', | ||||
663 | $Conf{'db_name'}); | ||||
664 | return undef; | ||||
665 | } | ||||
666 | } | ||||
667 | } | ||||
668 | |||||
669 | return 1; | ||||
670 | } | ||||
671 | |||||
672 | ## Check if data structures are uptodate | ||||
673 | ## If not, no operation should be performed before the upgrade process is run | ||||
674 | sub data_structure_uptodate { | ||||
675 | my $version_file = | ||||
676 | Conf::get_robot_conf('*', 'etc') . '/data_structure.version'; | ||||
677 | my $data_structure_version; | ||||
678 | |||||
679 | if (-f $version_file) { | ||||
680 | my $fh; | ||||
681 | unless (open $fh, '<', $version_file) { | ||||
682 | $log->syslog('err', 'Unable to open %s: %m', $version_file); | ||||
683 | return undef; | ||||
684 | } | ||||
685 | while (<$fh>) { | ||||
686 | next if /^\s*$/; | ||||
687 | next if /^\s*\#/; | ||||
688 | chomp; | ||||
689 | $data_structure_version = $_; | ||||
690 | last; | ||||
691 | } | ||||
692 | close $fh; | ||||
693 | } | ||||
694 | |||||
695 | if (defined $data_structure_version | ||||
696 | and $data_structure_version ne Sympa::Constants::VERSION) { | ||||
697 | $log->syslog('err', | ||||
698 | "Data structure (%s) is not uptodate for current release (%s)", | ||||
699 | $data_structure_version, Sympa::Constants::VERSION); | ||||
700 | return 0; | ||||
701 | } | ||||
702 | |||||
703 | return 1; | ||||
704 | } | ||||
705 | |||||
706 | # Check if cookie parameter was changed. | ||||
707 | # Old name: tools::cookie_changed(). | ||||
708 | # Deprecated: No longer used. | ||||
709 | #sub cookie_changed; | ||||
710 | |||||
711 | ## Check a few files | ||||
712 | sub checkfiles { | ||||
713 | my $config_err = 0; | ||||
714 | |||||
715 | foreach my $p (qw(sendmail antivirus_path)) { | ||||
716 | next unless $Conf{$p}; | ||||
717 | |||||
718 | unless (-x $Conf{$p}) { | ||||
719 | $log->syslog('err', "File %s does not exist or is not executable", | ||||
720 | $Conf{$p}); | ||||
721 | $config_err++; | ||||
722 | } | ||||
723 | } | ||||
724 | |||||
725 | foreach my $qdir (qw(spool queuetask tmpdir)) { | ||||
726 | unless (-d $Conf{$qdir}) { | ||||
727 | $log->syslog('info', 'Creating spool %s', $Conf{$qdir}); | ||||
728 | unless (mkdir($Conf{$qdir}, 0775)) { | ||||
729 | $log->syslog('err', 'Unable to create spool %s', | ||||
730 | $Conf{$qdir}); | ||||
731 | $config_err++; | ||||
732 | } | ||||
733 | unless ( | ||||
734 | Sympa::Tools::File::set_file_rights( | ||||
735 | file => $Conf{$qdir}, | ||||
736 | user => Sympa::Constants::USER, | ||||
737 | group => Sympa::Constants::GROUP, | ||||
738 | ) | ||||
739 | ) { | ||||
740 | $log->syslog('err', 'Unable to set rights on %s', | ||||
741 | $Conf{$qdir}); | ||||
742 | $config_err++; | ||||
743 | } | ||||
744 | } | ||||
745 | } | ||||
746 | |||||
747 | # Check if directory parameters point to the same directory. | ||||
748 | my @keys = qw(bounce_path etc home | ||||
749 | queue queueauth queuebounce queuebulk queuedigest | ||||
750 | queuemod queueoutgoing queuesubscribe queuetask | ||||
751 | queuetopic spool tmpdir viewmail_dir); | ||||
752 | push @keys, 'queueautomatic' | ||||
753 | if $Conf::Conf{'automatic_list_feature'} eq 'on'; | ||||
754 | my %dirs = (Sympa::Constants::PIDDIR() => 'PID directory'); | ||||
755 | |||||
756 | foreach my $key (@keys) { | ||||
757 | my $val = $Conf::Conf{$key}; | ||||
758 | next unless $val; | ||||
759 | |||||
760 | if ($dirs{$val}) { | ||||
761 | $log->syslog( | ||||
762 | 'err', | ||||
763 | 'Error in config: %s and %s parameters pointing to the same directory (%s)', | ||||
764 | $dirs{$val}, | ||||
765 | $key, | ||||
766 | $val | ||||
767 | ); | ||||
768 | $config_err++; | ||||
769 | } else { | ||||
770 | $dirs{$val} = $key; | ||||
771 | } | ||||
772 | } | ||||
773 | |||||
774 | # Create pictures directory. FIXME: Would be created on demand. | ||||
775 | my $pictures_dir = $Conf::Conf{'pictures_path'}; | ||||
776 | unless (-d $pictures_dir) { | ||||
777 | unless (mkdir $pictures_dir, 0775) { | ||||
778 | $log->syslog('err', 'Unable to create directory %s', | ||||
779 | $pictures_dir); | ||||
780 | $config_err++; | ||||
781 | } else { | ||||
782 | chmod 0775, $pictures_dir; # set masked bits. | ||||
783 | |||||
784 | my $index_path = $pictures_dir . '/index.html'; | ||||
785 | my $fh; | ||||
786 | unless (open $fh, '>', $index_path) { | ||||
787 | $log->syslog( | ||||
788 | 'err', | ||||
789 | 'Unable to create %s as an empty file to protect directory', | ||||
790 | $index_path | ||||
791 | ); | ||||
792 | } else { | ||||
793 | close $fh; | ||||
794 | } | ||||
795 | } | ||||
796 | } | ||||
797 | |||||
798 | #update_css(); | ||||
799 | |||||
800 | return undef if ($config_err); | ||||
801 | return 1; | ||||
802 | } | ||||
803 | |||||
804 | ## return 1 if the parameter is a known robot | ||||
805 | ## Valid options : | ||||
806 | ## 'just_try' : prevent error logs if robot is not valid | ||||
807 | # spent 5.43ms within Conf::valid_robot which was called 2300 times, avg 2µs/call:
# 2300 times (5.43ms+0s) by Sympa::Spool::unmarshal_metadata at line 416 of /usr/local/libexec/sympa/Sympa/Spool.pm, avg 2µs/call | ||||
808 | 2300 | 563µs | my $robot = shift; | ||
809 | 2300 | 419µs | my $options = shift; | ||
810 | |||||
811 | ## Main host | ||||
812 | 2300 | 10.5ms | return 1 if ($robot eq $Conf{'domain'}); | ||
813 | |||||
814 | ## Missing etc directory | ||||
815 | unless (-d $Conf{'etc'} . '/' . $robot) { | ||||
816 | $log->syslog( | ||||
817 | 'err', 'Robot %s undefined; no %s directory', | ||||
818 | $robot, $Conf{'etc'} . '/' . $robot | ||||
819 | ) unless ($options->{'just_try'}); | ||||
820 | return undef; | ||||
821 | } | ||||
822 | |||||
823 | ## Missing expl directory | ||||
824 | unless (-d $Conf{'home'} . '/' . $robot) { | ||||
825 | $log->syslog( | ||||
826 | 'err', 'Robot %s undefined; no %s directory', | ||||
827 | $robot, $Conf{'home'} . '/' . $robot | ||||
828 | ) unless ($options->{'just_try'}); | ||||
829 | return undef; | ||||
830 | } | ||||
831 | |||||
832 | ## Robot not loaded | ||||
833 | unless (defined $Conf{'robots'}{$robot}) { | ||||
834 | $log->syslog('err', 'Robot %s was not loaded by this Sympa process', | ||||
835 | $robot) | ||||
836 | unless ($options->{'just_try'}); | ||||
837 | return undef; | ||||
838 | } | ||||
839 | |||||
840 | return 1; | ||||
841 | } | ||||
842 | |||||
843 | ## Returns the SSO record correponding to the provided sso_id | ||||
844 | ## return undef if none was found | ||||
845 | sub get_sso_by_id { | ||||
846 | my %param = @_; | ||||
847 | |||||
848 | unless (defined $param{'service_id'} && defined $param{'robot'}) { | ||||
849 | return undef; | ||||
850 | } | ||||
851 | |||||
852 | foreach my $sso (@{$Conf{'auth_services'}{$param{'robot'}}}) { | ||||
853 | $log->syslog('notice', 'SSO: %s', $sso->{'service_id'}); | ||||
854 | next unless ($sso->{'service_id'} eq $param{'service_id'}); | ||||
855 | |||||
856 | return $sso; | ||||
857 | } | ||||
858 | |||||
859 | return undef; | ||||
860 | } | ||||
861 | |||||
862 | ########################################## | ||||
863 | ## Low level subs. Not supposed to be called from other modules. | ||||
864 | ########################################## | ||||
865 | |||||
866 | sub _load_auth { | ||||
867 | $log->syslog('debug3', '(%s, %s)', @_); | ||||
868 | my $that = shift || '*'; | ||||
869 | |||||
870 | my $config_file = Sympa::search_fullpath($that, 'auth.conf'); | ||||
871 | die sprintf 'No auth.conf for %s', $that | ||||
872 | unless $config_file and -r $config_file; | ||||
873 | |||||
874 | my $robot = ($that and $that ne '*') ? $that : $Conf{'domain'}; | ||||
875 | my $line_num = 0; | ||||
876 | my $config_err = 0; | ||||
877 | my @paragraphs; | ||||
878 | my %result; | ||||
879 | my $current_paragraph; | ||||
880 | |||||
881 | my %valid_keywords = ( | ||||
882 | 'ldap' => { | ||||
883 | 'regexp' => '.*', | ||||
884 | 'negative_regexp' => '.*', | ||||
885 | 'host' => '[\w\.\-]+(:\d+)?(\s*,\s*[\w\.\-]+(:\d+)?)*', | ||||
886 | 'timeout' => '\d+', | ||||
887 | 'suffix' => '.+', | ||||
888 | 'bind_dn' => '.+', | ||||
889 | 'bind_password' => '.+', | ||||
890 | 'get_dn_by_uid_filter' => '.+', | ||||
891 | 'get_dn_by_email_filter' => '.+', | ||||
892 | 'email_attribute' => Sympa::Regexps::ldap_attrdesc(), | ||||
893 | 'alternative_email_attribute' => '.*', # Obsoleted | ||||
894 | 'scope' => 'base|one|sub', | ||||
895 | 'authentication_info_url' => 'http(s)?:/.*', | ||||
896 | 'use_tls' => 'starttls|ldaps|none', | ||||
897 | 'use_ssl' => '1', # Obsoleted | ||||
898 | 'use_start_tls' => '1', # Obsoleted | ||||
899 | 'ssl_version' => 'sslv2/3|sslv2|sslv3|tlsv1|tlsv1_[123]', | ||||
900 | 'ssl_ciphers' => '[\w:]+', | ||||
901 | 'ssl_cert' => '.+', | ||||
902 | 'ssl_key' => '.+', | ||||
903 | 'ca_verify' => '\w+', | ||||
904 | 'ca_path' => '.+', | ||||
905 | 'ca_file' => '.+', | ||||
906 | }, | ||||
907 | |||||
908 | 'user_table' => { | ||||
909 | 'regexp' => '.*', | ||||
910 | 'negative_regexp' => '.*' | ||||
911 | }, | ||||
912 | |||||
913 | 'cas' => { | ||||
914 | 'base_url' => 'http(s)?:/.*', | ||||
915 | 'non_blocking_redirection' => 'on|off', | ||||
916 | 'login_path' => '.*', | ||||
917 | 'logout_path' => '.*', | ||||
918 | 'service_validate_path' => '.*', | ||||
919 | 'proxy_path' => '.*', | ||||
920 | 'proxy_validate_path' => '.*', | ||||
921 | 'auth_service_name' => '[\w\-\.]+', | ||||
922 | 'auth_service_friendly_name' => '.*', | ||||
923 | 'authentication_info_url' => 'http(s)?:/.*', | ||||
924 | 'host' => '[\w\.\-]+(:\d+)?(\s*,\s*[\w\.\-]+(:\d+)?)*', | ||||
925 | 'bind_dn' => '.+', | ||||
926 | 'bind_password' => '.+', | ||||
927 | 'timeout' => '\d+', | ||||
928 | 'suffix' => '.+', | ||||
929 | 'scope' => 'base|one|sub', | ||||
930 | 'get_email_by_uid_filter' => '.+', | ||||
931 | 'email_attribute' => Sympa::Regexps::ldap_attrdesc(), | ||||
932 | 'use_tls' => 'starttls|ldaps|none', | ||||
933 | 'use_ssl' => '1', # Obsoleted | ||||
934 | 'use_start_tls' => '1', # Obsoleted | ||||
935 | 'ssl_version' => 'sslv2/3|sslv2|sslv3|tlsv1|tlsv1_[123]', | ||||
936 | 'ssl_ciphers' => '[\w:]+', | ||||
937 | 'ssl_cert' => '.+', | ||||
938 | 'ssl_key' => '.+', | ||||
939 | 'ca_verify' => '\w+', | ||||
940 | 'ca_path' => '.+', | ||||
941 | 'ca_file' => '.+', | ||||
942 | }, | ||||
943 | 'generic_sso' => { | ||||
944 | 'service_name' => '.+', | ||||
945 | 'service_id' => '\S+', | ||||
946 | 'http_header_prefix' => '\w+', | ||||
947 | 'http_header_list' => '[\w\.\-\,]+', | ||||
948 | 'email_http_header' => '\w+', | ||||
949 | 'http_header_value_separator' => '.+', | ||||
950 | 'logout_url' => '.+', | ||||
951 | 'host' => '[\w\.\-]+(:\d+)?(\s*,\s*[\w\.\-]+(:\d+)?)*', | ||||
952 | 'bind_dn' => '.+', | ||||
953 | 'bind_password' => '.+', | ||||
954 | 'timeout' => '\d+', | ||||
955 | 'suffix' => '.+', | ||||
956 | 'scope' => 'base|one|sub', | ||||
957 | 'get_email_by_uid_filter' => '.+', | ||||
958 | 'email_attribute' => Sympa::Regexps::ldap_attrdesc(), | ||||
959 | 'use_tls' => 'starttls|ldaps|none', | ||||
960 | 'use_ssl' => '1', # Obsoleted | ||||
961 | 'use_start_tls' => '1', # Obsoleted | ||||
962 | 'ssl_version' => 'sslv2/3|sslv2|sslv3|tlsv1|tlsv1_[123]', | ||||
963 | 'ssl_ciphers' => '[\w:]+', | ||||
964 | 'ssl_cert' => '.+', | ||||
965 | 'ssl_key' => '.+', | ||||
966 | 'ca_verify' => '\w+', | ||||
967 | 'ca_path' => '.+', | ||||
968 | 'ca_file' => '.+', | ||||
969 | 'force_email_verify' => '1', | ||||
970 | 'internal_email_by_netid' => '1', | ||||
971 | 'netid_http_header' => '[\w\-\.]+', | ||||
972 | }, | ||||
973 | 'authentication_info_url' => 'http(s)?:/.*' | ||||
974 | ); | ||||
975 | |||||
976 | ## Open the configuration file or return and read the lines. | ||||
977 | unless (open(IN, $config_file)) { | ||||
978 | $log->syslog('notice', 'Unable to open %s: %m', $config_file); | ||||
979 | return undef; | ||||
980 | } | ||||
981 | |||||
982 | $Conf{'cas_number'}{$robot} = 0; | ||||
983 | $Conf{'generic_sso_number'}{$robot} = 0; | ||||
984 | $Conf{'ldap_number'}{$robot} = 0; | ||||
985 | $Conf{'use_passwd'}{$robot} = 0; | ||||
986 | |||||
987 | ## Parsing auth.conf | ||||
988 | while (<IN>) { | ||||
989 | |||||
990 | $line_num++; | ||||
991 | next if (/^\s*[\#\;]/o); | ||||
992 | |||||
993 | if (/^\s*authentication_info_url\s+(.*\S)\s*$/o) { | ||||
994 | $Conf{'authentication_info_url'}{$robot} = $1; | ||||
995 | next; | ||||
996 | } elsif (/^\s*(ldap|cas|user_table|generic_sso)\s*$/io) { | ||||
997 | $current_paragraph->{'auth_type'} = lc($1); | ||||
998 | } elsif (/^\s*(\S+)\s+(.*\S)\s*$/o) { | ||||
999 | my ($keyword, $value) = ($1, $2); | ||||
1000 | |||||
1001 | # Workaround: Some parameters required by cas and generic_sso auth | ||||
1002 | # types may be prefixed by "ldap_", but LDAP database driver | ||||
1003 | # requires those not prefixed. | ||||
1004 | $keyword =~ s/\Aldap_//; | ||||
1005 | |||||
1006 | unless ( | ||||
1007 | defined $valid_keywords{$current_paragraph->{'auth_type'}} | ||||
1008 | {$keyword}) { | ||||
1009 | $log->syslog('err', 'Unknown keyword "%s" in %s line %d', | ||||
1010 | $keyword, $config_file, $line_num); | ||||
1011 | next; | ||||
1012 | } | ||||
1013 | unless ($value =~ | ||||
1014 | /^$valid_keywords{$current_paragraph->{'auth_type'}}{$keyword}$/ | ||||
1015 | ) { | ||||
1016 | $log->syslog('err', | ||||
1017 | 'Unknown format "%s" for keyword "%s" in %s line %d', | ||||
1018 | $value, $keyword, $config_file, $line_num); | ||||
1019 | next; | ||||
1020 | } | ||||
1021 | |||||
1022 | ## Allow white spaces between hosts | ||||
1023 | if ($keyword =~ /host$/) { | ||||
1024 | $value =~ s/\s//g; | ||||
1025 | } | ||||
1026 | |||||
1027 | $current_paragraph->{$keyword} = $value; | ||||
1028 | } | ||||
1029 | |||||
1030 | ## process current paragraph | ||||
1031 | if (/^\s+$/o || eof(IN)) { | ||||
1032 | if (defined($current_paragraph)) { | ||||
1033 | # Parameters obsoleted as of 6.2.15. | ||||
1034 | if ($current_paragraph->{use_start_tls}) { | ||||
1035 | $current_paragraph->{use_tls} = 'starttls'; | ||||
1036 | } elsif ($current_paragraph->{use_ssl}) { | ||||
1037 | $current_paragraph->{use_tls} = 'ldaps'; | ||||
1038 | } | ||||
1039 | delete $current_paragraph->{use_start_tls}; | ||||
1040 | delete $current_paragraph->{use_ssl}; | ||||
1041 | |||||
1042 | if ($current_paragraph->{'auth_type'} eq 'cas') { | ||||
1043 | unless (defined $current_paragraph->{'base_url'}) { | ||||
1044 | $log->syslog('err', | ||||
1045 | 'Incorrect CAS paragraph in auth.conf'); | ||||
1046 | next; | ||||
1047 | } | ||||
1048 | $Conf{'cas_number'}{$robot}++; | ||||
1049 | |||||
1050 | eval "require AuthCAS"; | ||||
1051 | if ($EVAL_ERROR) { | ||||
1052 | $log->syslog('err', | ||||
1053 | 'Failed to load AuthCAS perl module'); | ||||
1054 | return undef; | ||||
1055 | } | ||||
1056 | |||||
1057 | my $cas_param = | ||||
1058 | {casUrl => $current_paragraph->{'base_url'}}; | ||||
1059 | |||||
1060 | ## Optional parameters | ||||
1061 | ## We should also cope with X509 CAs | ||||
1062 | $cas_param->{'loginPath'} = | ||||
1063 | $current_paragraph->{'login_path'} | ||||
1064 | if (defined $current_paragraph->{'login_path'}); | ||||
1065 | $cas_param->{'logoutPath'} = | ||||
1066 | $current_paragraph->{'logout_path'} | ||||
1067 | if (defined $current_paragraph->{'logout_path'}); | ||||
1068 | $cas_param->{'serviceValidatePath'} = | ||||
1069 | $current_paragraph->{'service_validate_path'} | ||||
1070 | if ( | ||||
1071 | defined $current_paragraph->{'service_validate_path'} | ||||
1072 | ); | ||||
1073 | $cas_param->{'proxyPath'} = | ||||
1074 | $current_paragraph->{'proxy_path'} | ||||
1075 | if (defined $current_paragraph->{'proxy_path'}); | ||||
1076 | $cas_param->{'proxyValidatePath'} = | ||||
1077 | $current_paragraph->{'proxy_validate_path'} | ||||
1078 | if ( | ||||
1079 | defined $current_paragraph->{'proxy_validate_path'}); | ||||
1080 | |||||
1081 | $current_paragraph->{'cas_server'} = | ||||
1082 | AuthCAS->new(%{$cas_param}); | ||||
1083 | unless (defined $current_paragraph->{'cas_server'}) { | ||||
1084 | $log->syslog( | ||||
1085 | 'err', | ||||
1086 | 'Failed to create CAS object for %s: %s', | ||||
1087 | $current_paragraph->{'base_url'}, | ||||
1088 | AuthCAS::get_errors() | ||||
1089 | ); | ||||
1090 | next; | ||||
1091 | } | ||||
1092 | |||||
1093 | $Conf{'cas_id'}{$robot} | ||||
1094 | {$current_paragraph->{'auth_service_name'}}{'casnum'} | ||||
1095 | = scalar @paragraphs; | ||||
1096 | |||||
1097 | ## Default value for auth_service_friendly_name IS | ||||
1098 | ## auth_service_name | ||||
1099 | $Conf{'cas_id'}{$robot} | ||||
1100 | {$current_paragraph->{'auth_service_name'}} | ||||
1101 | {'auth_service_friendly_name'} = | ||||
1102 | $current_paragraph->{'auth_service_friendly_name'} | ||||
1103 | || $current_paragraph->{'auth_service_name'}; | ||||
1104 | |||||
1105 | ## Force the default scope because '' is interpreted as | ||||
1106 | ## 'base' | ||||
1107 | $current_paragraph->{'scope'} ||= 'sub'; | ||||
1108 | } elsif ($current_paragraph->{'auth_type'} eq 'generic_sso') { | ||||
1109 | $Conf{'generic_sso_number'}{$robot}++; | ||||
1110 | $Conf{'generic_sso_id'}{$robot} | ||||
1111 | {$current_paragraph->{'service_id'}} = | ||||
1112 | $#paragraphs + 1; | ||||
1113 | ## Force the default scope because '' is interpreted as | ||||
1114 | ## 'base' | ||||
1115 | $current_paragraph->{'scope'} ||= 'sub'; | ||||
1116 | ## default value for http_header_value_separator is ';' | ||||
1117 | $current_paragraph->{'http_header_value_separator'} ||= | ||||
1118 | ';'; | ||||
1119 | |||||
1120 | ## CGI.pm changes environment variable names ('-' => '_') | ||||
1121 | ## declared environment variable names needs to be | ||||
1122 | ## transformed accordingly | ||||
1123 | foreach my $parameter ('http_header_list', | ||||
1124 | 'email_http_header', 'netid_http_header') { | ||||
1125 | $current_paragraph->{$parameter} =~ s/\-/\_/g | ||||
1126 | if (defined $current_paragraph->{$parameter}); | ||||
1127 | } | ||||
1128 | } elsif ($current_paragraph->{'auth_type'} eq 'ldap') { | ||||
1129 | $Conf{'ldap'}{$robot}++; | ||||
1130 | $Conf{'use_passwd'}{$robot} = 1; | ||||
1131 | ## Force the default scope because '' is interpreted as | ||||
1132 | ## 'base' | ||||
1133 | $current_paragraph->{'scope'} ||= 'sub'; | ||||
1134 | } elsif ($current_paragraph->{'auth_type'} eq 'user_table') { | ||||
1135 | $Conf{'use_passwd'}{$robot} = 1; | ||||
1136 | } | ||||
1137 | # setting default | ||||
1138 | $current_paragraph->{'regexp'} = '.*' | ||||
1139 | unless (defined($current_paragraph->{'regexp'})); | ||||
1140 | $current_paragraph->{'non_blocking_redirection'} = 'on' | ||||
1141 | unless ( | ||||
1142 | defined($current_paragraph->{'non_blocking_redirection'}) | ||||
1143 | ); | ||||
1144 | push(@paragraphs, $current_paragraph); | ||||
1145 | |||||
1146 | undef $current_paragraph; | ||||
1147 | } | ||||
1148 | next; | ||||
1149 | } | ||||
1150 | } | ||||
1151 | close(IN); | ||||
1152 | |||||
1153 | return \@paragraphs; | ||||
1154 | |||||
1155 | } | ||||
1156 | |||||
1157 | ## load charset.conf file (charset mapping for service messages) | ||||
1158 | sub load_charset { | ||||
1159 | my $charset = {}; | ||||
1160 | |||||
1161 | my $config_file = Sympa::search_fullpath('*', 'charset.conf'); | ||||
1162 | return {} unless $config_file; | ||||
1163 | |||||
1164 | unless (open CONFIG, $config_file) { | ||||
1165 | $log->syslog('err', 'Unable to read configuration file %s: %m', | ||||
1166 | $config_file); | ||||
1167 | return {}; | ||||
1168 | } | ||||
1169 | while (<CONFIG>) { | ||||
1170 | chomp $_; | ||||
1171 | s/\s*#.*//; | ||||
1172 | s/^\s+//; | ||||
1173 | next unless /\S/; | ||||
1174 | my ($lang, $cset) = split(/\s+/, $_); | ||||
1175 | unless ($cset) { | ||||
1176 | $log->syslog('err', | ||||
1177 | 'Charset name is missing in configuration file %s line %d', | ||||
1178 | $config_file, $NR); | ||||
1179 | next; | ||||
1180 | } | ||||
1181 | # canonicalize lang if possible. | ||||
1182 | $lang = Sympa::Language::canonic_lang($lang) || $lang; | ||||
1183 | $charset->{$lang} = $cset; | ||||
1184 | |||||
1185 | } | ||||
1186 | close CONFIG; | ||||
1187 | |||||
1188 | return $charset; | ||||
1189 | } | ||||
1190 | |||||
1191 | =over | ||||
1192 | |||||
1193 | =item lang2charset ( $lang ) | ||||
1194 | |||||
1195 | Gets charset for e-mail messages sent by Sympa. | ||||
1196 | |||||
1197 | Parameters: | ||||
1198 | |||||
1199 | $lang - language. | ||||
1200 | |||||
1201 | Returns: | ||||
1202 | |||||
1203 | Charset name. | ||||
1204 | If it is not known, returns default charset. | ||||
1205 | |||||
1206 | =back | ||||
1207 | |||||
1208 | =cut | ||||
1209 | |||||
1210 | # Old name: tools::lang2charset(). | ||||
1211 | # FIXME: This would be moved to such as Site package. | ||||
1212 | sub lang2charset { | ||||
1213 | my $lang = shift; | ||||
1214 | |||||
1215 | my $locale2charset; | ||||
1216 | if ($lang and %Conf::Conf # configuration loaded | ||||
1217 | and $locale2charset = $Conf::Conf{'locale2charset'} | ||||
1218 | ) { | ||||
1219 | foreach my $l (Sympa::Language::implicated_langs($lang)) { | ||||
1220 | if (exists $locale2charset->{$l}) { | ||||
1221 | return $locale2charset->{$l}; | ||||
1222 | } | ||||
1223 | } | ||||
1224 | } | ||||
1225 | return 'utf-8'; # the last resort | ||||
1226 | } | ||||
1227 | |||||
1228 | ## load nrcpt file (limite receipient par domain | ||||
1229 | sub load_nrcpt_by_domain { | ||||
1230 | my $config_file = Sympa::search_fullpath('*', 'nrcpt_by_domain.conf'); | ||||
1231 | return unless $config_file; | ||||
1232 | |||||
1233 | my $line_num = 0; | ||||
1234 | my $config_err = 0; | ||||
1235 | my $nrcpt_by_domain = {}; | ||||
1236 | my $valid_dom = 0; | ||||
1237 | |||||
1238 | ## Open the configuration file or return and read the lines. | ||||
1239 | unless (open IN, '<', $config_file) { | ||||
1240 | $log->syslog('err', 'Unable to open %s: %m', $config_file); | ||||
1241 | return; | ||||
1242 | } | ||||
1243 | while (<IN>) { | ||||
1244 | $line_num++; | ||||
1245 | next if (/^\s*$/o || /^[\#\;]/o); | ||||
1246 | if (/^(\S+)\s+(\d+)$/io) { | ||||
1247 | my ($domain, $value) = ($1, $2); | ||||
1248 | chomp $domain; | ||||
1249 | chomp $value; | ||||
1250 | $nrcpt_by_domain->{$domain} = $value; | ||||
1251 | $valid_dom += 1; | ||||
1252 | } else { | ||||
1253 | $log->syslog('notice', | ||||
1254 | 'Error at configuration file %s line %d: %s', | ||||
1255 | $config_file, $line_num, $_); | ||||
1256 | $config_err++; | ||||
1257 | } | ||||
1258 | } | ||||
1259 | close IN; | ||||
1260 | return $nrcpt_by_domain; | ||||
1261 | } | ||||
1262 | |||||
1263 | ## load .sql named filter conf file | ||||
1264 | sub load_sql_filter { | ||||
1265 | |||||
1266 | my $file = shift; | ||||
1267 | my %sql_named_filter_params = ( | ||||
1268 | 'sql_named_filter_query' => { | ||||
1269 | 'occurrence' => '1', | ||||
1270 | 'format' => { | ||||
1271 | 'db_type' => | ||||
1272 | {'format' => 'mysql|MySQL|Oracle|Pg|PostgreSQL|SQLite',}, | ||||
1273 | 'db_name' => {'format' => '.*', 'occurrence' => '1',}, | ||||
1274 | 'db_host' => {'format' => '.*', 'occurrence' => '0-1',}, | ||||
1275 | 'statement' => {'format' => '.*', 'occurrence' => '1',}, | ||||
1276 | 'db_user' => {'format' => '.*', 'occurrence' => '0-1',}, | ||||
1277 | 'db_passwd' => {'format' => '.*', 'occurrence' => '0-1',}, | ||||
1278 | 'db_options' => {'format' => '.*', 'occurrence' => '0-1',}, | ||||
1279 | 'db_env' => {'format' => '.*', 'occurrence' => '0-1',}, | ||||
1280 | 'db_port' => {'format' => '\d+', 'occurrence' => '0-1',}, | ||||
1281 | 'db_timeout' => {'format' => '\d+', 'occurrence' => '0-1',}, | ||||
1282 | } | ||||
1283 | } | ||||
1284 | ); | ||||
1285 | |||||
1286 | return undef unless (-r $file); | ||||
1287 | |||||
1288 | return ( | ||||
1289 | load_generic_conf_file($file, \%sql_named_filter_params, 'abort')); | ||||
1290 | } | ||||
1291 | |||||
1292 | ## load automatic_list_description.conf configuration file | ||||
1293 | sub load_automatic_lists_description { | ||||
1294 | my $robot = shift; | ||||
1295 | my $family = shift; | ||||
1296 | $log->syslog('debug2', 'Starting: Robot %s family %s', $robot, $family); | ||||
1297 | |||||
1298 | my %automatic_lists_params = ( | ||||
1299 | 'class' => { | ||||
1300 | 'occurrence' => '1-n', | ||||
1301 | 'format' => { | ||||
1302 | 'name' => {'format' => '.*', 'occurrence' => '1',}, | ||||
1303 | 'stamp' => {'format' => '.*', 'occurrence' => '1',}, | ||||
1304 | 'description' => {'format' => '.*', 'occurrence' => '1',}, | ||||
1305 | 'order' => {'format' => '\d+', 'occurrence' => '1',}, | ||||
1306 | 'instances' => {'occurrence' => '1', 'format' => '.*',}, | ||||
1307 | #'format' => { | ||||
1308 | #'instance' => { | ||||
1309 | #'occurrence' => '1-n', | ||||
1310 | #'format' => { | ||||
1311 | #'value' => {'format' => '.*', 'occurrence' => '1', }, | ||||
1312 | #'tag' => {'format' => '.*', 'occurrence' => '1', }, | ||||
1313 | #'order' => {'format' => '\d+', 'occurrence' => '1', }, | ||||
1314 | #}, | ||||
1315 | #}, | ||||
1316 | #}, | ||||
1317 | }, | ||||
1318 | }, | ||||
1319 | ); | ||||
1320 | # find appropriate automatic_lists_description.conf file | ||||
1321 | my $config = Sympa::search_fullpath( | ||||
1322 | $robot, | ||||
1323 | 'automatic_lists_description.conf', | ||||
1324 | subdir => ('families/' . $family) | ||||
1325 | ); | ||||
1326 | return undef unless $config; | ||||
1327 | my $description = | ||||
1328 | load_generic_conf_file($config, \%automatic_lists_params); | ||||
1329 | |||||
1330 | ## Now doing some structuration work because | ||||
1331 | ## Conf::load_automatic_lists_description() can't handle | ||||
1332 | ## data structured beyond one level of hash. This needs to be changed. | ||||
1333 | my @structured_data; | ||||
1334 | foreach my $class (@{$description->{'class'}}) { | ||||
1335 | my @structured_instances; | ||||
1336 | my @instances = split '%%%', $class->{'instances'}; | ||||
1337 | my $default_found = 0; | ||||
1338 | foreach my $instance (@instances) { | ||||
1339 | my $structured_instance; | ||||
1340 | my @instance_params = split '---', $instance; | ||||
1341 | foreach my $instance_param (@instance_params) { | ||||
1342 | $instance_param =~ /^\s*(\S+)\s+(.*)\s*$/; | ||||
1343 | my $key = $1; | ||||
1344 | my $value = $2; | ||||
1345 | $key =~ s/^\s*//; | ||||
1346 | $key =~ s/\s*$//; | ||||
1347 | $value =~ s/^\s*//; | ||||
1348 | $value =~ s/\s*$//; | ||||
1349 | $structured_instance->{$key} = $value; | ||||
1350 | } | ||||
1351 | $structured_instances[$structured_instance->{'order'}] = | ||||
1352 | $structured_instance; | ||||
1353 | if (defined $structured_instance->{'default'}) { | ||||
1354 | $default_found = 1; | ||||
1355 | } | ||||
1356 | } | ||||
1357 | unless ($default_found) { $structured_instances[0]->{'default'} = 1; } | ||||
1358 | $class->{'instances'} = \@structured_instances; | ||||
1359 | $structured_data[$class->{'order'}] = $class; | ||||
1360 | } | ||||
1361 | $description->{'class'} = \@structured_data; | ||||
1362 | return $description; | ||||
1363 | } | ||||
1364 | |||||
1365 | ## load trusted_application.conf configuration file | ||||
1366 | sub load_trusted_application { | ||||
1367 | my $that = shift || '*'; | ||||
1368 | |||||
1369 | # find appropriate trusted-application.conf file | ||||
1370 | my $config_file = | ||||
1371 | Sympa::search_fullpath($that, 'trusted_applications.conf'); | ||||
1372 | return undef unless $config_file and -r $config_file; | ||||
1373 | |||||
1374 | return load_generic_conf_file($config_file, \%trusted_applications); | ||||
1375 | } | ||||
1376 | |||||
1377 | ## load trusted_application.conf configuration file | ||||
1378 | sub load_crawlers_detection { | ||||
1379 | my $that = shift || '*'; | ||||
1380 | |||||
1381 | my %crawlers_detection_conf = ( | ||||
1382 | 'user_agent_string' => { | ||||
1383 | 'occurrence' => '0-n', | ||||
1384 | 'format' => '.+' | ||||
1385 | } | ||||
1386 | ); | ||||
1387 | |||||
1388 | my $config_file = | ||||
1389 | Sympa::search_fullpath($that, 'crawlers_detection.conf'); | ||||
1390 | return undef unless $config_file and -r $config_file; | ||||
1391 | my $hashtab = | ||||
1392 | load_generic_conf_file($config_file, \%crawlers_detection_conf); | ||||
1393 | my $hashhash; | ||||
1394 | |||||
1395 | foreach my $kword (keys %{$hashtab}) { | ||||
1396 | # ignore comments and default | ||||
1397 | next | ||||
1398 | unless ($crawlers_detection_conf{$kword}); | ||||
1399 | foreach my $value (@{$hashtab->{$kword}}) { | ||||
1400 | $hashhash->{$kword}{$value} = 'true'; | ||||
1401 | } | ||||
1402 | } | ||||
1403 | |||||
1404 | return $hashhash; | ||||
1405 | } | ||||
1406 | |||||
1407 | ############################################################ | ||||
1408 | # load_generic_conf_file | ||||
1409 | ############################################################ | ||||
1410 | # load a generic config organized by paragraph syntax | ||||
1411 | # | ||||
1412 | # IN : -$config_file (+): full path of config file | ||||
1413 | # -$structure_ref (+): ref(HASH) describing expected syntax | ||||
1414 | # -$on_error: optional. sub returns undef if set to 'abort' | ||||
1415 | # and an error is found in conf file | ||||
1416 | # OUT : ref(HASH) of parsed parameters | ||||
1417 | # | undef | ||||
1418 | # | ||||
1419 | ############################################################## | ||||
1420 | sub load_generic_conf_file { | ||||
1421 | my $config_file = shift; | ||||
1422 | my $structure_ref = shift; | ||||
1423 | my $on_error = shift; | ||||
1424 | my %structure = %$structure_ref; | ||||
1425 | |||||
1426 | my %admin; | ||||
1427 | my (@paragraphs); | ||||
1428 | |||||
1429 | ## Just in case... | ||||
1430 | local $RS = "\n"; | ||||
1431 | |||||
1432 | ## Set defaults to 1 | ||||
1433 | foreach my $pname (keys %structure) { | ||||
1434 | $admin{'defaults'}{$pname} = 1 | ||||
1435 | unless ($structure{$pname}{'internal'}); | ||||
1436 | } | ||||
1437 | |||||
1438 | ## Split in paragraphs | ||||
1439 | my $i = 0; | ||||
1440 | unless (open(CONFIG, $config_file)) { | ||||
1441 | $log->syslog('err', 'Unable to read configuration file %s', | ||||
1442 | $config_file); | ||||
1443 | return undef; | ||||
1444 | } | ||||
1445 | while (<CONFIG>) { | ||||
1446 | if (/^\s*$/) { | ||||
1447 | $i++ if $paragraphs[$i]; | ||||
1448 | } else { | ||||
1449 | push @{$paragraphs[$i]}, $_; | ||||
1450 | } | ||||
1451 | } | ||||
1452 | |||||
1453 | ## Parse each paragraph | ||||
1454 | for my $index (0 .. $#paragraphs) { | ||||
1455 | my @paragraph = @{$paragraphs[$index]}; | ||||
1456 | |||||
1457 | my $pname; | ||||
1458 | |||||
1459 | ## Clean paragraph, keep comments | ||||
1460 | for my $i (0 .. $#paragraph) { | ||||
1461 | my $changed = undef; | ||||
1462 | for my $j (0 .. $#paragraph) { | ||||
1463 | if ($paragraph[$j] =~ /^\s*\#/) { | ||||
1464 | chomp($paragraph[$j]); | ||||
1465 | push @{$admin{'comment'}}, $paragraph[$j]; | ||||
1466 | splice @paragraph, $j, 1; | ||||
1467 | $changed = 1; | ||||
1468 | } elsif ($paragraph[$j] =~ /^\s*$/) { | ||||
1469 | splice @paragraph, $j, 1; | ||||
1470 | $changed = 1; | ||||
1471 | } | ||||
1472 | last if $changed; | ||||
1473 | } | ||||
1474 | last unless $changed; | ||||
1475 | } | ||||
1476 | |||||
1477 | ## Empty paragraph | ||||
1478 | next unless ($#paragraph > -1); | ||||
1479 | |||||
1480 | ## Look for first valid line | ||||
1481 | unless ($paragraph[0] =~ /^\s*([\w-]+)(\s+.*)?$/) { | ||||
1482 | $log->syslog('notice', 'Bad paragraph "%s" in %s, ignored', | ||||
1483 | $paragraph[0], $config_file); | ||||
1484 | return undef if $on_error eq 'abort'; | ||||
1485 | next; | ||||
1486 | } | ||||
1487 | |||||
1488 | $pname = $1; | ||||
1489 | unless (defined $structure{$pname}) { | ||||
1490 | $log->syslog('notice', 'Unknown parameter "%s" in %s, ignored', | ||||
1491 | $pname, $config_file); | ||||
1492 | return undef if $on_error eq 'abort'; | ||||
1493 | next; | ||||
1494 | } | ||||
1495 | ## Uniqueness | ||||
1496 | if (defined $admin{$pname}) { | ||||
1497 | unless (($structure{$pname}{'occurrence'} eq '0-n') | ||||
1498 | or ($structure{$pname}{'occurrence'} eq '1-n')) { | ||||
1499 | $log->syslog('err', 'Multiple parameter "%s" in %s', | ||||
1500 | $pname, $config_file); | ||||
1501 | return undef if $on_error eq 'abort'; | ||||
1502 | } | ||||
1503 | } | ||||
1504 | |||||
1505 | ## Line or Paragraph | ||||
1506 | if (ref $structure{$pname}{'format'} eq 'HASH') { | ||||
1507 | ## This should be a paragraph | ||||
1508 | unless ($#paragraph > 0) { | ||||
1509 | $log->syslog( | ||||
1510 | 'notice', | ||||
1511 | 'Expecting a paragraph for "%s" parameter in %s, ignore it', | ||||
1512 | $pname, | ||||
1513 | $config_file | ||||
1514 | ); | ||||
1515 | return undef if $on_error eq 'abort'; | ||||
1516 | next; | ||||
1517 | } | ||||
1518 | |||||
1519 | ## Skipping first line | ||||
1520 | shift @paragraph; | ||||
1521 | |||||
1522 | my %hash; | ||||
1523 | for my $i (0 .. $#paragraph) { | ||||
1524 | next if ($paragraph[$i] =~ /^\s*\#/); | ||||
1525 | unless ($paragraph[$i] =~ /^\s*(\w+)\s*/) { | ||||
1526 | $log->syslog('notice', 'Bad line "%s" in %s', | ||||
1527 | $paragraph[$i], $config_file); | ||||
1528 | return undef if $on_error eq 'abort'; | ||||
1529 | } | ||||
1530 | my $key = $1; | ||||
1531 | unless (defined $structure{$pname}{'format'}{$key}) { | ||||
1532 | $log->syslog('notice', | ||||
1533 | 'Unknown key "%s" in paragraph "%s" in %s', | ||||
1534 | $key, $pname, $config_file); | ||||
1535 | return undef if $on_error eq 'abort'; | ||||
1536 | next; | ||||
1537 | } | ||||
1538 | |||||
1539 | unless ($paragraph[$i] =~ | ||||
1540 | /^\s*$key\s+($structure{$pname}{'format'}{$key}{'format'})\s*$/i | ||||
1541 | ) { | ||||
1542 | $log->syslog('notice', | ||||
1543 | 'Bad entry "%s" in paragraph "%s" in %s', | ||||
1544 | $paragraph[$i], $key, $pname, $config_file); | ||||
1545 | return undef if $on_error eq 'abort'; | ||||
1546 | next; | ||||
1547 | } | ||||
1548 | |||||
1549 | $hash{$key} = | ||||
1550 | _load_a_param($key, $1, | ||||
1551 | $structure{$pname}{'format'}{$key}); | ||||
1552 | } | ||||
1553 | |||||
1554 | ## Apply defaults & Check required keys | ||||
1555 | my $missing_required_field; | ||||
1556 | foreach my $k (keys %{$structure{$pname}{'format'}}) { | ||||
1557 | ## Default value | ||||
1558 | unless (defined $hash{$k}) { | ||||
1559 | if (defined $structure{$pname}{'format'}{$k}{'default'}) { | ||||
1560 | $hash{$k} = | ||||
1561 | _load_a_param($k, 'default', | ||||
1562 | $structure{$pname}{'format'}{$k}); | ||||
1563 | } | ||||
1564 | } | ||||
1565 | ## Required fields | ||||
1566 | if ($structure{$pname}{'format'}{$k}{'occurrence'} eq '1') { | ||||
1567 | unless (defined $hash{$k}) { | ||||
1568 | $log->syslog('notice', | ||||
1569 | 'Missing key %s in param %s in %s', | ||||
1570 | $k, $pname, $config_file); | ||||
1571 | return undef if $on_error eq 'abort'; | ||||
1572 | $missing_required_field++; | ||||
1573 | } | ||||
1574 | } | ||||
1575 | } | ||||
1576 | |||||
1577 | next if $missing_required_field; | ||||
1578 | |||||
1579 | delete $admin{'defaults'}{$pname}; | ||||
1580 | |||||
1581 | ## Should we store it in an array | ||||
1582 | if (($structure{$pname}{'occurrence'} =~ /n$/)) { | ||||
1583 | push @{$admin{$pname}}, \%hash; | ||||
1584 | } else { | ||||
1585 | $admin{$pname} = \%hash; | ||||
1586 | } | ||||
1587 | } else { | ||||
1588 | ## This should be a single line | ||||
1589 | my $xxxmachin = $structure{$pname}{'format'}; | ||||
1590 | unless ($#paragraph == 0) { | ||||
1591 | $log->syslog('err', | ||||
1592 | 'Expecting a single line for %s parameter in %s %s', | ||||
1593 | $pname, $config_file, $xxxmachin); | ||||
1594 | return undef if $on_error eq 'abort'; | ||||
1595 | } | ||||
1596 | |||||
1597 | unless ($paragraph[0] =~ | ||||
1598 | /^\s*$pname\s+($structure{$pname}{'format'})\s*$/i) { | ||||
1599 | $log->syslog('err', 'Bad entry "%s" in %s', | ||||
1600 | $paragraph[0], $config_file); | ||||
1601 | return undef if $on_error eq 'abort'; | ||||
1602 | next; | ||||
1603 | } | ||||
1604 | |||||
1605 | my $value = _load_a_param($pname, $1, $structure{$pname}); | ||||
1606 | |||||
1607 | delete $admin{'defaults'}{$pname}; | ||||
1608 | |||||
1609 | if (($structure{$pname}{'occurrence'} =~ /n$/) | ||||
1610 | && !(ref($value) =~ /^ARRAY/)) { | ||||
1611 | push @{$admin{$pname}}, $value; | ||||
1612 | } else { | ||||
1613 | $admin{$pname} = $value; | ||||
1614 | } | ||||
1615 | } | ||||
1616 | } | ||||
1617 | close CONFIG; | ||||
1618 | return \%admin; | ||||
1619 | } | ||||
1620 | |||||
1621 | ### load_a_param | ||||
1622 | # | ||||
1623 | sub _load_a_param { | ||||
1624 | my ($key, $value, $p) = @_; | ||||
1625 | |||||
1626 | ## Empty value | ||||
1627 | if ($value =~ /^\s*$/) { | ||||
1628 | return undef; | ||||
1629 | } | ||||
1630 | |||||
1631 | ## Default | ||||
1632 | if ($value eq 'default') { | ||||
1633 | $value = $p->{'default'}; | ||||
1634 | } | ||||
1635 | # Lower case if useful. | ||||
1636 | $value = lc($value) | ||||
1637 | if (defined $p->{'case'} && $p->{'case'} eq 'insensitive'); | ||||
1638 | |||||
1639 | ## Do we need to split param if it is not already an array | ||||
1640 | if ( ($p->{'occurrence'} =~ /n$/) | ||||
1641 | && $p->{'split_char'} | ||||
1642 | && !(ref($value) eq 'ARRAY')) { | ||||
1643 | my @array = split /$p->{'split_char'}/, $value; | ||||
1644 | foreach my $v (@array) { | ||||
1645 | $v =~ s/^\s*(.+)\s*$/$1/g; | ||||
1646 | } | ||||
1647 | |||||
1648 | return \@array; | ||||
1649 | } else { | ||||
1650 | return $value; | ||||
1651 | } | ||||
1652 | } | ||||
1653 | |||||
1654 | ## Simply load a config file and returns a hash. | ||||
1655 | ## the returned hash contains two keys: | ||||
1656 | ## 1- the key 'config' points to a hash containing the data found in the | ||||
1657 | ## config file. | ||||
1658 | ## 2- the key 'numbered_config' points to a hash containing the data found in | ||||
1659 | ## the config file. Each entry contains both the value of a parameter and the | ||||
1660 | ## line where it was found in the config file. | ||||
1661 | ## 3- the key 'errors' contains the number of config entries that could not be | ||||
1662 | ## loaded, due to an error. | ||||
1663 | ## Returns undef if something went wrong while attempting to read the file. | ||||
1664 | sub _load_config_file_to_hash { | ||||
1665 | my $param = shift; | ||||
1666 | |||||
1667 | my $line_num = 0; | ||||
1668 | ## Open the configuration file or return and read the lines. | ||||
1669 | unless (open(IN, $param->{'path_to_config_file'})) { | ||||
1670 | $log->syslog( | ||||
1671 | 'notice', | ||||
1672 | 'Unable to open %s: %m', | ||||
1673 | $param->{'path_to_config_file'} | ||||
1674 | ); | ||||
1675 | return undef; | ||||
1676 | } | ||||
1677 | |||||
1678 | # Initialize result. | ||||
1679 | my $result = { | ||||
1680 | errors => 0, | ||||
1681 | config => {}, | ||||
1682 | numbered_config => {}, | ||||
1683 | }; | ||||
1684 | |||||
1685 | while (<IN>) { | ||||
1686 | $line_num++; | ||||
1687 | # skip empty or commented lines | ||||
1688 | next if (/^\s*$/ || /^[\#;]/); | ||||
1689 | # match "keyword value" pattern | ||||
1690 | if (/^(\S+)\s+(.+)$/) { | ||||
1691 | my ($keyword, $value) = ($1, $2); | ||||
1692 | $value =~ s/\s*$//; | ||||
1693 | |||||
1694 | # Deprecated syntax: `command` | ||||
1695 | if ($value =~ /^\`(.*)\`$/) { | ||||
1696 | die sprintf | ||||
1697 | "%s: Backtick (`...`) in sympa.conf is no longer allowed. Check and modify configuration.\n", | ||||
1698 | $value; | ||||
1699 | } | ||||
1700 | |||||
1701 | $keyword = | ||||
1702 | $Sympa::Config::Schema::obsolete_robot_params{$keyword} | ||||
1703 | // $keyword; | ||||
1704 | # Resolve renamed parameters FIXME | ||||
1705 | $keyword = { | ||||
1706 | merge_feature => | ||||
1707 | 'personalization_feature', # 6.0b.2 - 6.2.59b.1 | ||||
1708 | use_blacklist => 'use_blocklist', # 5.3a.4 - 6.2.60 | ||||
1709 | domains_blacklist => 'domains_blocklist', # 6.2.41b.1 - 6.2.60 | ||||
1710 | }->{$keyword} // $keyword; | ||||
1711 | |||||
1712 | if ( exists $params{$keyword} | ||||
1713 | && defined $params{$keyword}{'multiple'} | ||||
1714 | && $params{$keyword}{'multiple'} == 1) { | ||||
1715 | if (defined $result->{'config'}{$keyword}) { | ||||
1716 | push @{$result->{'config'}{$keyword}}, $value; | ||||
1717 | push @{$result->{'numbered_config'}{$keyword}}, | ||||
1718 | [$value, $line_num]; | ||||
1719 | } else { | ||||
1720 | $result->{'config'}{$keyword} = [$value]; | ||||
1721 | $result->{'numbered_config'}{$keyword} = | ||||
1722 | [[$value, $line_num]]; | ||||
1723 | } | ||||
1724 | } else { | ||||
1725 | $result->{'config'}{$keyword} = $value; | ||||
1726 | $result->{'numbered_config'}{$keyword} = [$value, $line_num]; | ||||
1727 | } | ||||
1728 | } else { | ||||
1729 | $log->syslog('err', 'Error at line %d: %s', | ||||
1730 | $line_num, $param->{'path_to_config_file'}, $_); | ||||
1731 | $result->{'errors'}++; | ||||
1732 | } | ||||
1733 | } | ||||
1734 | close(IN); | ||||
1735 | return $result; | ||||
1736 | } | ||||
1737 | |||||
1738 | ## Checks a hash containing a sympa config and removes any entry that | ||||
1739 | ## is not supposed to be defined at the robot level. | ||||
1740 | sub _remove_unvalid_robot_entry { | ||||
1741 | my $param = shift; | ||||
1742 | my $config_hash = $param->{'config_hash'}; | ||||
1743 | foreach my $keyword (keys %$config_hash) { | ||||
1744 | unless ($valid_robot_key_words{$keyword}) { | ||||
1745 | $log->syslog('err', 'Removing unknown robot keyword %s', $keyword) | ||||
1746 | unless ($param->{'quiet'}); | ||||
1747 | delete $config_hash->{$keyword}; | ||||
1748 | } | ||||
1749 | } | ||||
1750 | return 1; | ||||
1751 | } | ||||
1752 | |||||
1753 | sub _detect_unknown_parameters_in_config { | ||||
1754 | my $param = shift; | ||||
1755 | my $number_of_unknown_parameters_found = 0; | ||||
1756 | foreach my $parameter (sort keys %{$param->{'config_hash'}}) { | ||||
1757 | next if (exists $params{$parameter}); | ||||
1758 | if (defined $old_params{$parameter}) { | ||||
1759 | if ($old_params{$parameter}) { | ||||
1760 | $log->syslog( | ||||
1761 | 'err', | ||||
1762 | 'Line %d of sympa.conf, parameter %s is no more available, read documentation for new parameter(s) %s', | ||||
1763 | $param->{'config_file_line_numbering_reference'} | ||||
1764 | {$parameter}[1], | ||||
1765 | $parameter, | ||||
1766 | $old_params{$parameter} | ||||
1767 | ); | ||||
1768 | } else { | ||||
1769 | $log->syslog( | ||||
1770 | 'err', | ||||
1771 | 'Line %d of sympa.conf, parameter %s is now obsolete', | ||||
1772 | $param->{'config_file_line_numbering_reference'} | ||||
1773 | {$parameter}[1], | ||||
1774 | $parameter | ||||
1775 | ); | ||||
1776 | next; | ||||
1777 | } | ||||
1778 | } else { | ||||
1779 | $log->syslog( | ||||
1780 | 'err', | ||||
1781 | 'Line %d, unknown field: %s in sympa.conf', | ||||
1782 | $param->{'config_file_line_numbering_reference'}{$parameter} | ||||
1783 | [1], | ||||
1784 | $parameter | ||||
1785 | ); | ||||
1786 | } | ||||
1787 | $number_of_unknown_parameters_found++; | ||||
1788 | } | ||||
1789 | return $number_of_unknown_parameters_found; | ||||
1790 | } | ||||
1791 | |||||
1792 | sub _infer_server_specific_parameter_values { | ||||
1793 | my $param = shift; | ||||
1794 | |||||
1795 | $param->{'config_hash'}{'robot_name'} = ''; | ||||
1796 | |||||
1797 | unless ( | ||||
1798 | Sympa::Tools::Data::smart_eq( | ||||
1799 | $param->{'config_hash'}{'dkim_feature'}, 'on' | ||||
1800 | ) | ||||
1801 | ) { | ||||
1802 | # dkim_signature_apply_ on nothing if dkim_feature is off | ||||
1803 | # Sets empty array. | ||||
1804 | $param->{'config_hash'}{'dkim_signature_apply_on'} = ['']; | ||||
1805 | } else { | ||||
1806 | $param->{'config_hash'}{'dkim_signature_apply_on'} =~ s/\s//g; | ||||
1807 | my @dkim = | ||||
1808 | split(/,/, $param->{'config_hash'}{'dkim_signature_apply_on'}); | ||||
1809 | $param->{'config_hash'}{'dkim_signature_apply_on'} = \@dkim; | ||||
1810 | } | ||||
1811 | unless ($param->{'config_hash'}{'dkim_signer_domain'}) { | ||||
1812 | $param->{'config_hash'}{'dkim_signer_domain'} = | ||||
1813 | $param->{'config_hash'}{'domain'}; | ||||
1814 | } | ||||
1815 | |||||
1816 | my @dmarc = split /[,\s]+/, | ||||
1817 | ($param->{'config_hash'}{'dmarc_protection_mode'} || ''); | ||||
1818 | if (@dmarc) { | ||||
1819 | $param->{'config_hash'}{'dmarc_protection_mode'} = \@dmarc; | ||||
1820 | } else { | ||||
1821 | delete $param->{'config_hash'}{'dmarc_protection_mode'}; | ||||
1822 | } | ||||
1823 | |||||
1824 | ## Set Regexp for accepted list suffixes | ||||
1825 | if (defined($param->{'config_hash'}{'list_check_suffixes'})) { | ||||
1826 | $param->{'config_hash'}{'list_check_regexp'} = | ||||
1827 | $param->{'config_hash'}{'list_check_suffixes'}; | ||||
1828 | $param->{'config_hash'}{'list_check_regexp'} =~ s/[,\s]+/\|/g; | ||||
1829 | } | ||||
1830 | |||||
1831 | # my $p = 1; | ||||
1832 | # foreach (split(/,/, $param->{'config_hash'}{'sort'})) { | ||||
1833 | # $param->{'config_hash'}{'poids'}{$_} = $p++; | ||||
1834 | # } | ||||
1835 | # $param->{'config_hash'}{'poids'}{'*'} = $p | ||||
1836 | # if !$param->{'config_hash'}{'poids'}{'*'}; | ||||
1837 | |||||
1838 | ## Parameters made of comma-separated list | ||||
1839 | foreach my $parameter ( | ||||
1840 | 'rfc2369_header_fields', 'anonymous_header_fields', | ||||
1841 | 'remove_headers', 'remove_outgoing_headers' | ||||
1842 | ) { | ||||
1843 | if ($param->{'config_hash'}{$parameter} eq 'none') { | ||||
1844 | delete $param->{'config_hash'}{$parameter}; | ||||
1845 | } else { | ||||
1846 | $param->{'config_hash'}{$parameter} = | ||||
1847 | [split(/,/, $param->{'config_hash'}{$parameter})]; | ||||
1848 | } | ||||
1849 | } | ||||
1850 | |||||
1851 | foreach | ||||
1852 | my $action (split /\s*,\s*/, $param->{'config_hash'}{'use_blocklist'}) | ||||
1853 | { | ||||
1854 | next unless $action =~ /\A[.\w]+\z/; | ||||
1855 | # Compat. <= 6.2.38 | ||||
1856 | $action = { | ||||
1857 | 'shared_doc.d_read' => 'd_read', | ||||
1858 | 'shared_doc.d_edit' => 'd_edit', | ||||
1859 | 'archive.access' => 'archive_mail_access', # obsoleted | ||||
1860 | 'web_archive.access' => 'archive_web_access', # obsoleted | ||||
1861 | 'archive.web_access' => 'archive_web_access', | ||||
1862 | 'archive.mail_access' => 'archive_mail_access', | ||||
1863 | 'tracking.tracking' => 'tracking', | ||||
1864 | }->{$action} | ||||
1865 | || $action; | ||||
1866 | |||||
1867 | $param->{'config_hash'}{'blocklist'}{$action} = 1; | ||||
1868 | } | ||||
1869 | |||||
1870 | if ($param->{'config_hash'}{'ldap_export_name'}) { | ||||
1871 | $param->{'config_hash'}{'ldap_export'} = { | ||||
1872 | $param->{'config_hash'}{'ldap_export_name'} => { | ||||
1873 | 'host' => $param->{'config_hash'}{'ldap_export_host'}, | ||||
1874 | 'suffix' => $param->{'config_hash'}{'ldap_export_suffix'}, | ||||
1875 | 'password' => $param->{'config_hash'}{'ldap_export_password'}, | ||||
1876 | 'DnManager' => | ||||
1877 | $param->{'config_hash'}{'ldap_export_dnmanager'}, | ||||
1878 | 'connection_timeout' => | ||||
1879 | $param->{'config_hash'}{'ldap_export_connection_timeout'} | ||||
1880 | } | ||||
1881 | }; | ||||
1882 | } | ||||
1883 | |||||
1884 | return 1; | ||||
1885 | } | ||||
1886 | |||||
1887 | sub _load_server_specific_secondary_config_files { | ||||
1888 | my $param = shift; | ||||
1889 | |||||
1890 | ## wwsympa.conf exists | ||||
1891 | if (-f get_wwsympa_conf()) { | ||||
1892 | $log->syslog( | ||||
1893 | 'notice', | ||||
1894 | '%s was found but it is no longer loaded. Please run sympa.pl --upgrade to migrate it', | ||||
1895 | get_wwsympa_conf() | ||||
1896 | ); | ||||
1897 | } | ||||
1898 | |||||
1899 | # canonicalize language, or if failed, apply site-wide default. | ||||
1900 | $param->{'config_hash'}{'lang'} = | ||||
1901 | Sympa::Language::canonic_lang($param->{'config_hash'}{'lang'}) | ||||
1902 | || 'en-US'; | ||||
1903 | |||||
1904 | ## Load charset.conf file if necessary. | ||||
1905 | if ($param->{'config_hash'}{'legacy_character_support_feature'} eq 'on') { | ||||
1906 | $param->{'config_hash'}{'locale2charset'} = load_charset(); | ||||
1907 | } else { | ||||
1908 | $param->{'config_hash'}{'locale2charset'} = {}; | ||||
1909 | } | ||||
1910 | |||||
1911 | ## Load nrcpt_by_domain.conf | ||||
1912 | $param->{'config_hash'}{'nrcpt_by_domain'} = load_nrcpt_by_domain(); | ||||
1913 | $param->{'config_hash'}{'crawlers_detection'} = | ||||
1914 | load_crawlers_detection($param->{'config_hash'}{'robot_name'}); | ||||
1915 | } | ||||
1916 | |||||
1917 | sub _infer_robot_parameter_values { | ||||
1918 | my $param = shift; | ||||
1919 | |||||
1920 | # 'domain' is mandatory, and synonym 'host' may be still used | ||||
1921 | # even if the doc requires domain. | ||||
1922 | $param->{'config_hash'}{'domain'} = $param->{'config_hash'}{'host'} | ||||
1923 | if not defined $param->{'config_hash'}{'domain'} | ||||
1924 | and defined $param->{'config_hash'}{'host'}; | ||||
1925 | |||||
1926 | $param->{'config_hash'}{'static_content_url'} ||= | ||||
1927 | $Conf{'static_content_url'}; | ||||
1928 | $param->{'config_hash'}{'static_content_path'} ||= | ||||
1929 | $Conf{'static_content_path'}; | ||||
1930 | |||||
1931 | unless ($param->{'config_hash'}{'email'}) { | ||||
1932 | $param->{'config_hash'}{'email'} = $Conf{'email'}; | ||||
1933 | } | ||||
1934 | # Obsoleted. Use get_address(). | ||||
1935 | $param->{'config_hash'}{'sympa'} = | ||||
1936 | $param->{'config_hash'}{'email'} . '@' | ||||
1937 | . $param->{'config_hash'}{'domain'}; | ||||
1938 | # Obsoleted. Use get_address('owner'). | ||||
1939 | $param->{'config_hash'}{'request'} = | ||||
1940 | $param->{'config_hash'}{'email'} | ||||
1941 | . '-request@' | ||||
1942 | . $param->{'config_hash'}{'domain'}; | ||||
1943 | |||||
1944 | # split action list for blocklist usage | ||||
1945 | foreach my $action (split /\s*,\s*/, $Conf{'use_blocklist'}) { | ||||
1946 | next unless $action =~ /\A[.\w]+\z/; | ||||
1947 | # Compat. <= 6.2.38 | ||||
1948 | $action = { | ||||
1949 | 'shared_doc.d_read' => 'd_read', | ||||
1950 | 'shared_doc.d_edit' => 'd_edit', | ||||
1951 | 'archive.access' => 'archive_mail_access', # obsoleted | ||||
1952 | 'web_archive.access' => 'archive_web_access', # obsoleted | ||||
1953 | 'archive.web_access' => 'archive_web_access', | ||||
1954 | 'archive.mail_access' => 'archive_mail_access', | ||||
1955 | 'tracking.tracking' => 'tracking', | ||||
1956 | }->{$action} | ||||
1957 | || $action; | ||||
1958 | |||||
1959 | $param->{'config_hash'}{'blocklist'}{$action} = 1; | ||||
1960 | } | ||||
1961 | |||||
1962 | # Hack because multi valued parameters are not available for Sympa 6.1. | ||||
1963 | if (defined $param->{'config_hash'}{'automatic_list_families'}) { | ||||
1964 | my @families = split ';', | ||||
1965 | $param->{'config_hash'}{'automatic_list_families'}; | ||||
1966 | my %families_description; | ||||
1967 | foreach my $family_description (@families) { | ||||
1968 | my %family; | ||||
1969 | my @family_parameters = split ':', $family_description; | ||||
1970 | foreach my $family_parameter (@family_parameters) { | ||||
1971 | my @parameter = split '=', $family_parameter; | ||||
1972 | $family{$parameter[0]} = $parameter[1]; | ||||
1973 | } | ||||
1974 | $family{'escaped_prefix_separator'} = $family{'prefix_separator'}; | ||||
1975 | $family{'escaped_prefix_separator'} =~ s/([+*?.])/\\$1/g; | ||||
1976 | $family{'escaped_classes_separator'} = | ||||
1977 | $family{'classes_separator'}; | ||||
1978 | $family{'escaped_classes_separator'} =~ s/([+*?.])/\\$1/g; | ||||
1979 | $families_description{$family{'name'}} = \%family; | ||||
1980 | } | ||||
1981 | $param->{'config_hash'}{'automatic_list_families'} = | ||||
1982 | \%families_description; | ||||
1983 | } | ||||
1984 | |||||
1985 | # canonicalize language | ||||
1986 | $param->{'config_hash'}{'lang'} = | ||||
1987 | Sympa::Language::canonic_lang($param->{'config_hash'}{'lang'}) | ||||
1988 | or delete $param->{'config_hash'}{'lang'}; | ||||
1989 | |||||
1990 | _parse_custom_robot_parameters( | ||||
1991 | {'config_hash' => $param->{'config_hash'}}); | ||||
1992 | } | ||||
1993 | |||||
1994 | sub _load_robot_secondary_config_files { | ||||
1995 | my $param = shift; | ||||
1996 | my $trusted_applications = | ||||
1997 | load_trusted_application($param->{'config_hash'}{'robot_name'}); | ||||
1998 | $param->{'config_hash'}{'trusted_applications'} = undef; | ||||
1999 | if (defined $trusted_applications) { | ||||
2000 | $param->{'config_hash'}{'trusted_applications'} = | ||||
2001 | $trusted_applications->{'trusted_application'}; | ||||
2002 | } | ||||
2003 | my $robot_name_for_auth_storing = $param->{'config_hash'}{'robot_name'} | ||||
2004 | || $Conf{'domain'}; | ||||
2005 | $Conf{'auth_services'}{$robot_name_for_auth_storing} = | ||||
2006 | _load_auth($param->{'config_hash'}{'robot_name'}); | ||||
2007 | if (defined $param->{'config_hash'}{'automatic_list_families'}) { | ||||
2008 | foreach my $family ( | ||||
2009 | keys %{$param->{'config_hash'}{'automatic_list_families'}}) { | ||||
2010 | $param->{'config_hash'}{'automatic_list_families'}{$family} | ||||
2011 | {'description'} = load_automatic_lists_description( | ||||
2012 | $param->{'config_hash'}{'robot_name'}, | ||||
2013 | $param->{'config_hash'}{'automatic_list_families'}{$family} | ||||
2014 | {'name'} | ||||
2015 | ); | ||||
2016 | } | ||||
2017 | } | ||||
2018 | return 1; | ||||
2019 | } | ||||
2020 | ## For parameters whose value is hard_coded, as per %hardcoded_params, set the | ||||
2021 | ## parameter value to the hardcoded value, whatever is defined in the config. | ||||
2022 | ## Returns a ref to a hash containing the ignored values. | ||||
2023 | # Deprecated. | ||||
2024 | #sub _set_hardcoded_parameter_values; | ||||
2025 | |||||
2026 | sub _detect_missing_mandatory_parameters { | ||||
2027 | my $param = shift; | ||||
2028 | my $number_of_errors = 0; | ||||
2029 | $param->{'file_to_check'} =~ /^(\/.*\/)?([^\/]+)$/; | ||||
2030 | my $config_file_name = $2; | ||||
2031 | foreach my $parameter (keys %params) { | ||||
2032 | ## next if (defined $params{$parameter}->{'file'} && $params{$parameter}->{'file'} ne $config_file_name); | ||||
2033 | unless (defined $param->{'config_hash'}{$parameter} | ||||
2034 | or defined $params{$parameter}->{'default'} | ||||
2035 | or defined $params{$parameter}->{'optional'}) { | ||||
2036 | $log->syslog('err', 'Required field not found in sympa.conf: %s', | ||||
2037 | $parameter); | ||||
2038 | $number_of_errors++; | ||||
2039 | next; | ||||
2040 | } | ||||
2041 | unless (defined $param->{'config_hash'}{$parameter}) { | ||||
2042 | $param->{'config_hash'}{$parameter} = | ||||
2043 | $params{$parameter}->{'default'}; | ||||
2044 | } | ||||
2045 | } | ||||
2046 | return $number_of_errors; | ||||
2047 | } | ||||
2048 | |||||
2049 | ## Some functionalities activated by some parameter values require that | ||||
2050 | ## some optional CPAN modules are installed. This function checks whether | ||||
2051 | ## these modules are installed and if they are missing, changes the config | ||||
2052 | ## to fall back to a functioning that doesn't require a module and issues | ||||
2053 | ## a warning. | ||||
2054 | ## Returns the number of missing modules. | ||||
2055 | sub _check_cpan_modules_required_by_config { | ||||
2056 | my $param = shift; | ||||
2057 | my $number_of_missing_modules = 0; | ||||
2058 | |||||
2059 | ## Some parameters require CPAN modules | ||||
2060 | if ($param->{'config_hash'}{'dkim_feature'} eq 'on') { | ||||
2061 | eval "require Mail::DKIM"; | ||||
2062 | if ($EVAL_ERROR) { | ||||
2063 | $log->syslog('notice', | ||||
2064 | 'Failed to load Mail::DKIM perl module ; setting "dkim_feature" to "off"' | ||||
2065 | ); | ||||
2066 | $param->{'config_hash'}{'dkim_feature'} = 'off'; | ||||
2067 | $number_of_missing_modules++; | ||||
2068 | } | ||||
2069 | } | ||||
2070 | |||||
2071 | return $number_of_missing_modules; | ||||
2072 | } | ||||
2073 | |||||
2074 | sub _dump_non_robot_parameters { | ||||
2075 | my $param = shift; | ||||
2076 | foreach my $key (keys %{$param->{'config_hash'}}) { | ||||
2077 | unless ($valid_robot_key_words{$key}) { | ||||
2078 | delete $param->{'config_hash'}{$key}; | ||||
2079 | $log->syslog('err', | ||||
2080 | 'Robot %s config: unknown robot parameter: %s', | ||||
2081 | $param->{'robot'}, $key); | ||||
2082 | } | ||||
2083 | } | ||||
2084 | } | ||||
2085 | |||||
2086 | sub _load_single_robot_config { | ||||
2087 | my $param = shift; | ||||
2088 | my $robot = $param->{'robot'}; | ||||
2089 | my $robot_conf; | ||||
2090 | |||||
2091 | my $config_err; | ||||
2092 | my $config_file = "$Conf{'etc'}/$robot/robot.conf"; | ||||
2093 | |||||
2094 | if (my $config_loading_result = | ||||
2095 | _load_config_file_to_hash({'path_to_config_file' => $config_file})) { | ||||
2096 | $robot_conf = $config_loading_result->{'config'}; | ||||
2097 | $config_err = $config_loading_result->{'errors'}; | ||||
2098 | } else { | ||||
2099 | $log->syslog('err', 'Unable to load %s. Aborting', $config_file); | ||||
2100 | return undef; | ||||
2101 | } | ||||
2102 | |||||
2103 | # Remove entries which are not supposed to be defined at the robot | ||||
2104 | # level. | ||||
2105 | _dump_non_robot_parameters( | ||||
2106 | {'config_hash' => $robot_conf, 'robot' => $robot}); | ||||
2107 | |||||
2108 | #FIXME: They may be no longer used. Kept for possible compatibility. | ||||
2109 | $robot_conf->{'host'} ||= $robot; | ||||
2110 | $robot_conf->{'robot_name'} ||= $robot; | ||||
2111 | |||||
2112 | unless ($robot_conf->{'dkim_signer_domain'}) { | ||||
2113 | $robot_conf->{'dkim_signer_domain'} = $robot; | ||||
2114 | } | ||||
2115 | |||||
2116 | my @dmarc = split /[,\s]+/, | ||||
2117 | ($robot_conf->{'dmarc_protection_mode'} || ''); | ||||
2118 | if (@dmarc) { | ||||
2119 | $robot_conf->{'dmarc_protection_mode'} = \@dmarc; | ||||
2120 | } else { | ||||
2121 | delete $robot_conf->{'dmarc_protection_mode'}; | ||||
2122 | } | ||||
2123 | |||||
2124 | _set_listmasters_entry({'config_hash' => $robot_conf}); | ||||
2125 | |||||
2126 | _infer_robot_parameter_values({'config_hash' => $robot_conf}); | ||||
2127 | |||||
2128 | _store_source_file_name( | ||||
2129 | {'config_hash' => $robot_conf, 'config_file' => $config_file}); | ||||
2130 | #XXX_save_config_hash_to_binary( | ||||
2131 | #XXX {'config_hash' => $robot_conf, 'source_file' => $config_file}); | ||||
2132 | return undef if ($config_err); | ||||
2133 | |||||
2134 | _replace_file_value_by_db_value({'config_hash' => $robot_conf}) | ||||
2135 | unless $param->{'no_db'}; | ||||
2136 | _load_robot_secondary_config_files({'config_hash' => $robot_conf}); | ||||
2137 | return $robot_conf; | ||||
2138 | } | ||||
2139 | |||||
2140 | sub _set_listmasters_entry { | ||||
2141 | my $param = shift; | ||||
2142 | my $number_of_valid_email = 0; | ||||
2143 | my $number_of_email_provided = 0; | ||||
2144 | # listmaster is a list of email separated by commas | ||||
2145 | if (defined $param->{'config_hash'}{'listmaster'} | ||||
2146 | && $param->{'config_hash'}{'listmaster'} !~ /^\s*$/) { | ||||
2147 | $param->{'config_hash'}{'listmaster'} =~ s/\s//g; | ||||
2148 | my @emails_provided = | ||||
2149 | split(/,/, $param->{'config_hash'}{'listmaster'}); | ||||
2150 | $number_of_email_provided = $#emails_provided + 1; | ||||
2151 | foreach my $lismaster_address (@emails_provided) { | ||||
2152 | if (Sympa::Tools::Text::valid_email($lismaster_address)) { | ||||
2153 | # Note: 'listmasters' was obsoleted. | ||||
2154 | push @{$param->{'config_hash'}{'listmasters'}}, | ||||
2155 | $lismaster_address; | ||||
2156 | $number_of_valid_email++; | ||||
2157 | } else { | ||||
2158 | $log->syslog( | ||||
2159 | 'err', | ||||
2160 | 'Robot %s config: Listmaster address "%s" is not a valid email', | ||||
2161 | $param->{'config_hash'}{'domain'}, | ||||
2162 | $lismaster_address | ||||
2163 | ); | ||||
2164 | } | ||||
2165 | } | ||||
2166 | } else { | ||||
2167 | if ($param->{'main_config'}) { | ||||
2168 | $log->syslog('err', | ||||
2169 | 'Robot %s config: No listmaster defined. This is the main config. It MUST define at least one listmaster. Stopping here' | ||||
2170 | ); | ||||
2171 | return undef; | ||||
2172 | } else { | ||||
2173 | # Note: 'listmasters' was obsoleted. | ||||
2174 | $param->{'config_hash'}{'listmasters'} = $Conf{'listmasters'}; | ||||
2175 | $param->{'config_hash'}{'listmaster'} = $Conf{'listmaster'}; | ||||
2176 | $number_of_valid_email = | ||||
2177 | $#{$param->{'config_hash'}{'listmasters'}}; | ||||
2178 | } | ||||
2179 | } | ||||
2180 | if ($number_of_email_provided > $number_of_valid_email) { | ||||
2181 | $log->syslog( | ||||
2182 | 'err', | ||||
2183 | 'Robot %s config: All the listmasters addresses found were not valid. Out of %s addresses provided, %s only are valid email addresses', | ||||
2184 | $param->{'config_hash'}{'domain'}, | ||||
2185 | $number_of_email_provided, | ||||
2186 | $number_of_valid_email | ||||
2187 | ); | ||||
2188 | return undef; | ||||
2189 | } | ||||
2190 | return $number_of_valid_email; | ||||
2191 | } | ||||
2192 | |||||
2193 | # No longer used. | ||||
2194 | #sub _check_double_url_usage; | ||||
2195 | |||||
2196 | sub _parse_custom_robot_parameters { | ||||
2197 | my $param = shift; | ||||
2198 | my $csp_tmp_storage = undef; | ||||
2199 | if (defined $param->{'config_hash'}{'custom_robot_parameter'} | ||||
2200 | && ref() ne 'HASH') { | ||||
2201 | foreach my $custom_p ( | ||||
2202 | @{$param->{'config_hash'}{'custom_robot_parameter'}}) { | ||||
2203 | if ($custom_p =~ /(\S+)\s*\;\s*(.+)/) { | ||||
2204 | $csp_tmp_storage->{$1} = $2; | ||||
2205 | } | ||||
2206 | } | ||||
2207 | $param->{'config_hash'}{'custom_robot_parameter'} = $csp_tmp_storage; | ||||
2208 | } | ||||
2209 | } | ||||
2210 | |||||
2211 | sub _replace_file_value_by_db_value { | ||||
2212 | my $param = shift; | ||||
2213 | my $robot = $param->{'config_hash'}{'robot_name'}; | ||||
2214 | # The name of the default robot is "*" in the database. | ||||
2215 | $robot = '*' if ($param->{'config_hash'}{'robot_name'} eq ''); | ||||
2216 | foreach my $label (keys %db_storable_parameters) { | ||||
2217 | next unless ($robot ne '*' && $valid_robot_key_words{$label} == 1); | ||||
2218 | my $value = get_db_conf($robot, $label); | ||||
2219 | if (defined $value) { | ||||
2220 | $param->{'config_hash'}{$label} = $value; | ||||
2221 | } | ||||
2222 | } | ||||
2223 | } | ||||
2224 | |||||
2225 | # Stores the config hash binary representation to a file. | ||||
2226 | # Returns 1 or undef if something went wrong. | ||||
2227 | # No longer used. | ||||
2228 | #sub _save_binary_cache; | ||||
2229 | |||||
2230 | # Loads the config hash binary representation from a file an returns it | ||||
2231 | # Returns the hash or undef if something went wrong. | ||||
2232 | # No longer used. | ||||
2233 | #sub _load_binary_cache; | ||||
2234 | |||||
2235 | # No longer used. | ||||
2236 | #sub _save_config_hash_to_binary; | ||||
2237 | |||||
2238 | # No longer used. | ||||
2239 | #sub _source_has_not_changed; | ||||
2240 | |||||
2241 | sub _store_source_file_name { | ||||
2242 | my $param = shift; | ||||
2243 | $param->{'config_hash'}{'source_file'} = $param->{'config_file'}; | ||||
2244 | } | ||||
2245 | |||||
2246 | # No longer used. Use Sympa::search_fullpath(). | ||||
2247 | #sub _get_config_file_name; | ||||
2248 | |||||
2249 | sub _create_robot_like_config_for_main_robot { | ||||
2250 | return if (defined $Conf::Conf{'robots'}{$Conf::Conf{'domain'}}); | ||||
2251 | my $main_conf_no_robots = Sympa::Tools::Data::dup_var(\%Conf); | ||||
2252 | delete $main_conf_no_robots->{'robots'}; | ||||
2253 | _remove_unvalid_robot_entry( | ||||
2254 | {'config_hash' => $main_conf_no_robots, 'quiet' => 1}); | ||||
2255 | $Conf{'robots'}{$Conf{'domain'}} = $main_conf_no_robots; | ||||
2256 | } | ||||
2257 | |||||
2258 | sub _get_parameters_names_by_category { | ||||
2259 | my $param_by_categories; | ||||
2260 | my $current_category; | ||||
2261 | foreach my $entry (@Sympa::ConfDef::params) { | ||||
2262 | unless ($entry->{'name'}) { | ||||
2263 | $current_category = $entry->{'gettext_id'}; | ||||
2264 | } else { | ||||
2265 | $param_by_categories->{$current_category}{$entry->{'name'}} = 1; | ||||
2266 | } | ||||
2267 | } | ||||
2268 | return $param_by_categories; | ||||
2269 | } | ||||
2270 | |||||
2271 | =over 4 | ||||
2272 | |||||
2273 | =item _load_wwsconf ( FILE ) | ||||
2274 | |||||
2275 | Load WWSympa configuration file. | ||||
2276 | |||||
2277 | =back | ||||
2278 | |||||
2279 | =cut | ||||
2280 | |||||
2281 | sub _load_wwsconf { | ||||
2282 | my $param = shift; | ||||
2283 | my $config_hash = $param->{'config_hash'}; | ||||
2284 | my $config_file = get_wwsympa_conf(); | ||||
2285 | |||||
2286 | return 0 unless -f $config_file; # this file is optional. | ||||
2287 | |||||
2288 | ## Old params | ||||
2289 | my %old_param = ( | ||||
2290 | 'alias_manager' => 'No more used, using ' | ||||
2291 | . $config_hash->{'alias_manager'}, | ||||
2292 | 'wws_path' => 'No more used', | ||||
2293 | 'icons_url' => 'No more used. Using static_content/icons instead.', | ||||
2294 | 'robots' => | ||||
2295 | 'Not used anymore. Robots are fully described in their respective robot.conf file.', | ||||
2296 | 'task_manager_pidfile' => 'No more used', | ||||
2297 | 'bounced_pidfile' => 'No more used', | ||||
2298 | 'archived_pidfile' => 'No more used', | ||||
2299 | ); | ||||
2300 | |||||
2301 | ## Valid params | ||||
2302 | my %default_conf = | ||||
2303 | map { $_->{'name'} => $_->{'default'} } | ||||
2304 | grep { exists $_->{'file'} and $_->{'file'} eq 'wwsympa.conf' } | ||||
2305 | @Sympa::ConfDef::params; | ||||
2306 | |||||
2307 | my $conf = \%default_conf; | ||||
2308 | |||||
2309 | my $fh; | ||||
2310 | unless (open $fh, '<', $config_file) { | ||||
2311 | $log->syslog('err', 'Unable to open %s', $config_file); | ||||
2312 | return undef; | ||||
2313 | } | ||||
2314 | |||||
2315 | while (<$fh>) { | ||||
2316 | next if /^\s*\#/; | ||||
2317 | |||||
2318 | if (/^\s*(\S+)\s+(.+)$/i) { | ||||
2319 | my ($k, $v) = ($1, $2); | ||||
2320 | $v =~ s/\s*$//; | ||||
2321 | if (exists $conf->{$k}) { | ||||
2322 | $conf->{$k} = $v; | ||||
2323 | } elsif (defined $old_param{$k}) { | ||||
2324 | $log->syslog('err', | ||||
2325 | 'Parameter %s in %s no more supported: %s', | ||||
2326 | $k, $config_file, $old_param{$k}); | ||||
2327 | } else { | ||||
2328 | $log->syslog('err', 'Unknown parameter %s in %s', | ||||
2329 | $k, $config_file); | ||||
2330 | } | ||||
2331 | } | ||||
2332 | next; | ||||
2333 | } | ||||
2334 | |||||
2335 | close $fh; | ||||
2336 | |||||
2337 | ## Check binaries and directories | ||||
2338 | if ($conf->{'arc_path'} && (!-d $conf->{'arc_path'})) { | ||||
2339 | $log->syslog('err', 'No web archives directory: %s', | ||||
2340 | $conf->{'arc_path'}); | ||||
2341 | } | ||||
2342 | |||||
2343 | if ($conf->{'bounce_path'} && (!-d $conf->{'bounce_path'})) { | ||||
2344 | $log->syslog( | ||||
2345 | 'err', | ||||
2346 | 'Missing directory "%s" (defined by "bounce_path" parameter)', | ||||
2347 | $conf->{'bounce_path'} | ||||
2348 | ); | ||||
2349 | } | ||||
2350 | |||||
2351 | if ($conf->{'mhonarc'} && (!-x $conf->{'mhonarc'})) { | ||||
2352 | $log->syslog('err', | ||||
2353 | 'MHonArc is not installed or %s is not executable', | ||||
2354 | $conf->{'mhonarc'}); | ||||
2355 | } | ||||
2356 | |||||
2357 | ## set default | ||||
2358 | $conf->{'log_facility'} ||= $config_hash->{'syslog'}; | ||||
2359 | |||||
2360 | foreach my $k (keys %$conf) { | ||||
2361 | $config_hash->{$k} = $conf->{$k}; | ||||
2362 | } | ||||
2363 | $wwsconf = $conf; | ||||
2364 | return $wwsconf; | ||||
2365 | } | ||||
2366 | |||||
2367 | # MOVED: Use Sympa::WWW::Tools::update_css(). | ||||
2368 | #sub update_css; | ||||
2369 | |||||
2370 | # lazy loading on demand | ||||
2371 | my %mime_types; | ||||
2372 | |||||
2373 | # Old name: Sympa::Tools::WWW::get_mime_type(). | ||||
2374 | # FIXME: This would be moved to such as Site package. | ||||
2375 | sub get_mime_type { | ||||
2376 | my $type = shift; | ||||
2377 | |||||
2378 | %mime_types = _load_mime_types() unless %mime_types; | ||||
2379 | |||||
2380 | return $mime_types{$type}; | ||||
2381 | } | ||||
2382 | |||||
2383 | # Old name: Sympa::Tools::WWW::load_mime_types(). | ||||
2384 | sub _load_mime_types { | ||||
2385 | my %types = (); | ||||
2386 | |||||
2387 | my @localisation = ( | ||||
2388 | Sympa::search_fullpath('*', 'mime.types'), | ||||
2389 | '/etc/mime.types', '/usr/local/apache/conf/mime.types', | ||||
2390 | '/etc/httpd/conf/mime.types', | ||||
2391 | ); | ||||
2392 | |||||
2393 | foreach my $loc (@localisation) { | ||||
2394 | my $fh; | ||||
2395 | next unless $loc and open $fh, '<', $loc; | ||||
2396 | |||||
2397 | foreach my $line (<$fh>) { | ||||
2398 | next if $line =~ /^\s*\#/; | ||||
2399 | chomp $line; | ||||
2400 | |||||
2401 | my ($k, $v) = split /\s+/, $line, 2; | ||||
2402 | next unless $k and $v and $v =~ /\S/; | ||||
2403 | |||||
2404 | my @extensions = split /\s+/, $v; | ||||
2405 | # provides file extention, given the content-type | ||||
2406 | if (@extensions) { | ||||
2407 | $types{$k} = $extensions[0]; | ||||
2408 | } | ||||
2409 | foreach my $ext (@extensions) { | ||||
2410 | $types{$ext} = $k; | ||||
2411 | } | ||||
2412 | } | ||||
2413 | |||||
2414 | close $fh; | ||||
2415 | return %types; | ||||
2416 | } | ||||
2417 | |||||
2418 | return; | ||||
2419 | } | ||||
2420 | |||||
2421 | 1; |