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
30package Conf;
31
32use strict;
33use warnings;
34use English qw(-no_match_vars);
35
36use Sympa;
37use Sympa::ConfDef;
38use Sympa::Constants;
39use Sympa::DatabaseManager;
40use Sympa::Language;
41use Sympa::Log;
42use Sympa::Regexps;
43use Sympa::Tools::Data;
44use Sympa::Tools::File;
45use Sympa::Tools::Text;
46
47my $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
62my $sth;
63# parameters hash, keyed by parameter name
64our %params =
65    map { $_->{name} => $_ }
66    grep { $_->{name} } @Sympa::ConfDef::params;
67
68# valid virtual host parameters, keyed by parameter name
69my %valid_robot_key_words;
70my %db_storable_parameters;
71my %optional_key_words;
72foreach 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
79our $params_by_categories = _get_parameters_names_by_category();
80
81my %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
115my %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
152our $wwsconf;
153our %Conf = ();
154
155=head2 FUNCTIONS
156
157=over 4
158
159=item load ( [ CONFIG_FILE ], [ NO_DB ], [ RETURN_RESULT ] )
160
161Loads and parses the configuration file.  Reports errors if any.
162
163do not try to load database values if NO_DB is set;
164do 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
173sub 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
258sub 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
301sub get_robot_conf {
302    my ($robot, $param) = @_;
303
304    $param = $Sympa::Config::Schema::obsolete_robot_params{$param} // $param;
305
306    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    return $Conf{$param};
314}
315
316=over 4
317
318=item get_sympa_conf
319
320Gets path name of main config file.
321Path name is taken from:
322
323=over 4
324
325=item 1
326
327C<--config> command line option
328
329=item 2
330
331C<SYMPA_CONFIG> environment variable
332
333=item 3
334
335built-in default
336
337=back
338
339=back
340
341=cut
342
343our $sympa_config;
344
345sub 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
353Gets path name of wwsympa.conf file.
354Path name is taken from:
355
356=over 4
357
358=item 1
359
360C<SYMPA_WWSCONFIG> environment variable
361
362=item 2
363
364built-in default
365
366=back
367
368=back
369
370=cut
371
372sub 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.
382sub 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.
404sub 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
415sub 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
450sub 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
529sub 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
604sub 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
674sub 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
712sub 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
807sub valid_robot {
808    my $robot   = shift;
809    my $options = shift;
810
811    ## Main host
812    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
845sub 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
866sub _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)
1158sub 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
1195Gets charset for e-mail messages sent by Sympa.
1196
1197Parameters:
1198
1199$lang - language.
1200
1201Returns:
1202
1203Charset name.
1204If 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.
1212sub 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
1229sub 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
1264sub 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
1293sub 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
1366sub 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
1378sub 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##############################################################
1420sub 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#
1623sub _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.
1664sub _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.
1740sub _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
1753sub _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
1792sub _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
1887sub _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
1917sub _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
1994sub _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
2026sub _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.
2055sub _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
2074sub _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
2086sub _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
2140sub _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
2196sub _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
2211sub _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
2241sub _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
2249sub _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
2258sub _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
2275Load WWSympa configuration file.
2276
2277=back
2278
2279=cut
2280
2281sub _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
2371my %mime_types;
2372
2373# Old name: Sympa::Tools::WWW::get_mime_type().
2374# FIXME: This would be moved to such as Site package.
2375sub 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().
2384sub _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
24211;
2422