List.pm

# -*- indent-tabs-mode: nil; -*-
# vim:ft=perl:et:sw=4
# $Id$

# Sympa - SYsteme de Multi-Postage Automatique
#
# Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel
# Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
# 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
# Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER
# Copyright 2017, 2018 The Sympa Community. See the AUTHORS.md file at the
# top-level directory of this distribution and at
# <https://github.com/sympa-community/sympa.git>.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

package Sympa::List;

use strict;
use warnings;
use Digest::MD5 qw();
use English qw(-no_match_vars);
use HTTP::Request;
use IO::Scalar;
use LWP::UserAgent;
use POSIX qw();
use Storable qw();
BEGIN { eval 'use IO::Socket::SSL'; }

use Sympa;
use Conf;
use Sympa::ConfDef;
use Sympa::Constants;
use Sympa::Database;
use Sympa::DatabaseDescription;
use Sympa::DatabaseManager;
use Sympa::Datasource;
use Sympa::Family;
use Sympa::Language;
use Sympa::List::Config;
use Sympa::ListDef;
use Sympa::LockedFile;
use Sympa::Log;
use Sympa::Process;
use Sympa::Regexps;
use Sympa::Robot;
use Sympa::Scenario;
use Sympa::Spindle::ProcessTemplate;
use Sympa::Spool::Auth;
use Sympa::Template;
use Sympa::Ticket;
use Sympa::Tools::Data;
use Sympa::Tools::File;
use Sympa::Tools::Password;
use Sympa::Tools::SMIME;
use Sympa::Tools::Text;
use Sympa::User;

my @sources_providing_listmembers = qw/
    include_file
    include_ldap_2level_query
    include_ldap_query
    include_remote_file
    include_remote_sympa_list
    include_sql_query
    include_sympa_list
    /;

#XXX include_admin
my @more_data_sources = qw/
    editor_include
    owner_include
    member_include
    /;

# All non-pluggable sources are in the admin user file
# NO LONGER USED.
my %config_in_admin_user_file = map +($_ => 1),
    @sources_providing_listmembers;

my $language = Sympa::Language->instance;
my $log      = Sympa::Log->instance;

=encoding utf-8

#=head1 NAME
#
#List - Mailing list

=head1 CONSTRUCTOR

=over

=item new( [PHRASE] )

 Sympa::List->new();

Creates a new object which will be used for a list and
eventually loads the list if a name is given. Returns
a List object.

=back

=head1 METHODS

=over 4

=item load ( LIST )

Loads the indicated list into the object.

=item save ( LIST )

Saves the indicated list object to the disk files.

=item savestats ()

B<Deprecated> on 6.2.23b.

Saves updates the statistics file on disk.

=item update_stats( count, [ sent, bytes, sent_by_bytes ] )

Updates the stats, argument is number of bytes, returns list fo the updated
values.  Returns zeroes if failed.

=item delete_list_member ( ARRAY )

Delete the indicated users from the list.

=item delete_list_admin ( ROLE, ARRAY )

Delete the indicated admin user with the predefined role from the list.
ROLE may be C<'owner'> or C<'editor'>.

=item dump_users ( ROLE )

Dump user information in user store into file C<I<$role>.dump> under
list directory. ROLE may be C<'member'>, C<'owner'> or C<'editor'>.

=item get_cookie ()

Returns the cookie for a list, if available.

=item get_max_size ()

Returns the maximum allowed size for a message.

=item get_reply_to ()

Returns an array with the Reply-To values.

=item get_default_user_options ()

Returns a default option of the list for subscription.

=item get_total ( [ 'nocache' ] )

Returns the number of subscribers to the list.

=item get_global_user ( USER )

Returns a hash with the information regarding the indicated
user.

=item get_list_member ( USER )

Returns a subscriber of the list.

=item get_list_admin ( ROLE, USER)

Return an admin user of the list with predefined role

OBSOLETED.
Use get_admins().

=item get_first_list_member ()

Returns a hash to the first user on the list.

=item get_first_list_admin ( ROLE )

OBSOLETED.
Use get_admins().

=item get_next_list_member ()

Returns a hash to the next users, until we reach the end of
the list.

=item get_next_list_admin ()

OBSOLETED.
Use get_admins().

=item restore_users ( ROLE )

Import user information into user store from file C<I<$role>.dump> under
list directory. ROLE may be C<'member'>, C<'owner'> or C<'editor'>.

=item update_list_member ( $email, key =E<gt> value, ... )

I<Instance method>.
Sets the new values given in the pairs for the user.

=item update_list_admin ( USER, ROLE, HASHPTR )

Sets the new values given in the hash for the admin user.

=item add_list_member ( USER, HASHPTR )

Adds a new user to the list. May overwrite existing
entries.

=item add_admin_user ( USER, ROLE, HASHPTR )

Adds a new admin user to the list. May overwrite existing
entries.

=item is_list_member ( USER )

Returns true if the indicated user is member of the list.

=item am_i ( ROLE, USER )

DEPRECATED. Use is_admin().

=item get_state ( FLAG )

Returns the value for a flag : sig or sub.

=item may_do ( ACTION, USER )

B<Note>:
This method was obsoleted.

Chcks is USER may do the ACTION for the list. ACTION can be
one of following : send, review, index, getm add, del,
reconfirm, purge.

=item is_moderated ()

Returns true if the list is moderated.

=item archive_exist ( FILE )

DEPRECATED.
Returns true if the indicated file exists.

=item archive_send ( WHO, FILE )

DEPRECATED.
Send the indicated archive file to the user, if it exists.

=item archive_ls ()

DEPRECATED.
Returns the list of available files, if any.

=item archive_msg ( MSG )

DEPRECATED.
Archives the Mail::Internet message given as argument.

=item is_archived ()

Returns true is the list is configured to keep archives of
its messages.

=item is_archiving_enabled ( )

Returns true is the list is configured to keep archives of
its messages, i.e. process_archive parameter is set to "on".

=item is_included ( )

Returns true value if the list is included in another list(s).

=item get_stats ( )

Returns array of the statistics.

=item print_info ( FDNAME )

Print the list information to the given file descriptor, or the
currently selected descriptor.

=back

=cut

## Database and SQL statement handlers
my ($sth, @sth_stack);

# DB fields with numeric type.
# We should not do quote() for these while inserting data.
my %db_struct = Sympa::DatabaseDescription::full_db_struct();
my %numeric_field;
foreach my $t (qw(subscriber_table admin_table)) {
    foreach my $k (keys %{$db_struct{$t}->{fields}}) {
        if ($db_struct{$t}->{fields}{$k}{struct} =~ /\A(tiny|small|big)?int/)
        {
            $numeric_field{$k} = 1;
        }
    }
}

# This is the generic hash which keeps all lists in memory.
my %list_of_lists = ();

## Creates an object.
sub new {
    my ($pkg, $name, $robot, $options) = @_;
    my $list = {};
    $log->syslog('debug2', '(%s, %s, %s)', $name, $robot,
        join('/', keys %$options));

    # Lowercase list name.
    $name = lc $name;
    # In case the variable was multiple. FIXME:required?
    $name = $1 if $name =~ /^(\S+)\0/;

    ## Allow robot in the name
    if ($name =~ /\@/) {
        my @parts = split /\@/, $name;
        $robot ||= $parts[1];
        $name = $parts[0];
    }

    # Look for the list if no robot was provided.
    if (not $robot or $robot eq '*') {
        #FIXME: Default robot would be used instead of oppotunistic search.
        $robot = search_list_among_robots($name);
    }

    unless ($robot) {
        $log->syslog('err',
            'Missing robot parameter, cannot create list object for %s',
            $name)
            unless ($options->{'just_try'});
        return undef;
    }

    $options = {} unless (defined $options);

    ## Only process the list if the name is valid.
    my $listname_regexp = Sympa::Regexps::listname();
    unless ($name and ($name =~ /^($listname_regexp)$/io)) {
        $log->syslog('err', 'Incorrect listname "%s"', $name)
            unless ($options->{'just_try'});
        return undef;
    }
    ## Lowercase the list name.
    $name = $1;
    $name =~ tr/A-Z/a-z/;

    ## Reject listnames with reserved list suffixes
    my $regx = Conf::get_robot_conf($robot, 'list_check_regexp');
    if ($regx) {
        if ($name =~ /^(\S+)-($regx)$/) {
            $log->syslog(
                'err',
                'Incorrect name: listname "%s" matches one of service aliases',
                $name
            ) unless ($options->{'just_try'});
            return undef;
        }
    }

    my $status;
    ## If list already in memory and not previously purged by another process
    if ($list_of_lists{$robot}{$name}
        and -d $list_of_lists{$robot}{$name}{'dir'}) {
        # use the current list in memory and update it
        $list = $list_of_lists{$robot}{$name};

        $status = $list->load($name, $robot, $options);
    } else {
        # create a new object list
        bless $list, $pkg;

        $options->{'first_access'} = 1;
        $status = $list->load($name, $robot, $options);
    }
    unless (defined $status) {
        return undef;
    }

    ## Config file was loaded or reloaded
    my $pertinent_ttl = $list->{'admin'}{'distribution_ttl'}
        || $list->{'admin'}{'ttl'};
    if (    $status
        and grep { $list->{'admin'}{'status'} eq $_ } qw(open pending)
        and (
            (   not $options->{'skip_sync_admin'}
                and $list->_cache_read_expiry('last_sync_admin_user') <
                time - $pertinent_ttl
            )
            or $options->{'force_sync_admin'}
        )
    ) {
        ## Update admin_table
        unless (defined $list->sync_include_admin()) {
            $log->syslog('err', '')
                unless ($options->{'just_try'});
        }
        if (not @{$list->get_admins('owner') || []}
            and $list->{'admin'}{'status'} ne 'error_config') {
            $log->syslog('err', 'The list "%s" has got no owner defined',
                $list->{'name'});
            $list->set_status_error_config('no_owner_defined');
        }
    }

    return $list;
}

## When no robot is specified, look for a list among robots
sub search_list_among_robots {
    my $listname = shift;

    unless ($listname) {
        $log->syslog('err', 'Missing list parameter');
        return undef;
    }

    ## Search in default robot
    if (-d $Conf::Conf{'home'} . '/' . $listname) {
        return $Conf::Conf{'domain'};
    }

    foreach my $r (keys %{$Conf::Conf{'robots'}}) {
        if (-d $Conf::Conf{'home'} . '/' . $r . '/' . $listname) {
            return $r;
        }
    }

    return 0;
}

## set the list in status error_config and send a notify to listmaster
sub set_status_error_config {
    $log->syslog('debug2', '(%s, %s, ...)', @_);
    my ($self, $msg, @param) = @_;

    unless ($self->{'admin'}
        and $self->{'admin'}{'status'} eq 'error_config') {
        $self->{'admin'}{'status'} = 'error_config';

        # No more save config in error...
        # $self->save_config(tools::get_address($self->{'domain'},
        #     'listmaster'));
        $log->syslog('err',
            'The list %s is set in status error_config: %s(%s)',
            $self, $msg, join(', ', @param));
        Sympa::send_notify_to_listmaster($self, $msg,
            [$self->{'name'}, @param]);
    }
}

# Destroy multiton instance. FIXME
sub destroy_multiton {
    my $self = shift;
    delete $list_of_lists{$self->{'domain'}}{$self->{'name'}};
}

## set the list in status family_closed and send a notify to owners
# Deprecated.  Use Sympa::Request::Handler::close_list handler.
#sub set_status_family_closed;

# Saves the statistics data to disk.
# Deprecated. Use Sympa::List::update_stats().
#sub savestats;

## msg count.
# Old name: increment_msg_count().
sub _increment_msg_count {
    $log->syslog('debug2', '(%s)', @_);
    my $self = shift;

    # Be sure the list has been loaded.
    my $file = "$self->{'dir'}/msg_count";

    my %count;
    if (open(MSG_COUNT, $file)) {
        while (<MSG_COUNT>) {
            if ($_ =~ /^(\d+)\s(\d+)$/) {
                $count{$1} = $2;
            }
        }
        close MSG_COUNT;
    }
    my $today = int(time / 86400);
    if ($count{$today}) {
        $count{$today}++;
    } else {
        $count{$today} = 1;
    }

    unless (open(MSG_COUNT, ">$file.$PID")) {
        $log->syslog('err', 'Unable to create "%s.%s": %m', $file, $PID);
        return undef;
    }
    foreach my $key (sort { $a <=> $b } keys %count) {
        printf MSG_COUNT "%d\t%d\n", $key, $count{$key};
    }
    close MSG_COUNT;

    unless (rename("$file.$PID", $file)) {
        $log->syslog('err', 'Unable to write "%s": %m', $file);
        return undef;
    }
    return 1;
}

# Returns the number of messages sent to the list
sub get_msg_count {
    $log->syslog('debug2', '(%s)', @_);
    my $self = shift;

    # Be sure the list has been loaded.
    my $file = "$self->{'dir'}/stats";

    my $count = 0;
    if (open(MSG_COUNT, $file)) {
        while (<MSG_COUNT>) {
            if ($_ =~ /^(\d+)\s+(.*)$/) {
                $count = $1;
            }
        }
        close MSG_COUNT;
    }

    return $count;
}
## last date of distribution message .
sub get_latest_distribution_date {
    $log->syslog('debug2', '(%s)', @_);
    my $self = shift;

    # Be sure the list has been loaded.
    my $file = "$self->{'dir'}/msg_count";

    my $latest_date = 0;
    unless (open(MSG_COUNT, $file)) {
        $log->syslog('debug2', 'Unable to open %s', $file);
        return undef;
    }

    while (<MSG_COUNT>) {
        if ($_ =~ /^(\d+)\s(\d+)$/) {
            $latest_date = $1 if ($1 > $latest_date);
        }
    }
    close MSG_COUNT;

    return undef if ($latest_date == 0);
    return $latest_date;
}

## Update the stats struct
## Input  : num of bytes of msg
## Output : num of msgs sent
# Old name: List::update_stats().
# No longer used. Use Sympa::List::update_stats(1);
#sub get_next_sequence;

sub get_stats {
    my $self = shift;

    my @stats;
    my $lock_fh = Sympa::LockedFile->new($self->{'dir'} . '/stats', 2, '<');
    if ($lock_fh) {
        @stats = split /\s+/, do { my $line = <$lock_fh>; $line };
        $lock_fh->close;
    }

    foreach my $i ((0 .. 3)) {
        $stats[$i] = 0 unless $stats[$i];
    }
    return @stats[0 .. 3];
}

sub update_stats {
    $log->syslog('debug2', '(%s, %s, %s, %s, %s)', @_);
    my $self  = shift;
    my @diffs = @_;

    my $lock_fh = Sympa::LockedFile->new($self->{'dir'} . '/stats', 2, '+>>');
    unless ($lock_fh) {
        $log->syslog('err', 'Could not create new lock');
        return;
    }

    # Update stats file.
    # Note: The last three fields total, last_sync and last_sync_admin_user
    # were deprecated.
    seek $lock_fh, 0, 0;
    my @stats = split /\s+/, do { my $line = <$lock_fh>; $line };
    foreach my $i ((0 .. 3)) {
        $stats[$i] ||= 0;
        $stats[$i] += $diffs[$i] if $diffs[$i];
    }
    seek $lock_fh, 0, 0;
    truncate $lock_fh, 0;
    printf $lock_fh "%d %.0f %.0f %.0f\n", @stats;

    return unless $lock_fh->close;

    if ($diffs[0]) {
        $self->_increment_msg_count;
    }

    return @stats;
}

sub _cache_publish_expiry {
    my $self = shift;
    my $type = shift;

    my $stat_file;
    if ($type eq 'member') {
        $stat_file = $self->{'dir'} . '/.last_change.member';
    } elsif ($type eq 'last_sync') {
        $stat_file = $self->{'dir'} . '/.last_sync.member';
    } elsif ($type eq 'admin_user') {
        $stat_file = $self->{'dir'} . '/.last_change.admin';
    } elsif ($type eq 'last_sync_admin_user') {
        $stat_file = $self->{'dir'} . '/.last_sync.admin';
    } else {
        die 'bug in logic. Ask developer';
    }

    # Touch status file.
    my $fh;
    open $fh, '>', $stat_file and close $fh;
}

sub _cache_read_expiry {
    my $self = shift;
    my $type = shift;

    if ($type eq 'member') {
        # If changes have never been done, just now is assumed.
        my $stat_file = $self->{'dir'} . '/.last_change.member';
        $self->_cache_publish_expiry('member') unless -e $stat_file;
        return [stat $stat_file]->[9];
    } elsif ($type eq 'last_sync') {
        # If syncs have never been done, earliest time is assumed.
        return Sympa::Tools::File::get_mtime(
            $self->{'dir'} . '/.last_sync.member');
    } elsif ($type eq 'admin_user') {
        # If changes have never been done, just now is assumed.
        my $stat_file = $self->{'dir'} . '/.last_change.admin';
        $self->_cache_publish_expiry('admin_user') unless -e $stat_file;
        return [stat $stat_file]->[9];
    } elsif ($type eq 'last_sync_admin_user') {
        # If syncs have never been done, earliest time is assumed.
        return Sympa::Tools::File::get_mtime(
            $self->{'dir'} . '/.last_sync.admin');
    } elsif ($type eq 'edit_list_conf') {
        return [stat Sympa::search_fullpath($self, 'edit_list.conf')]->[9];
    } else {
        die 'bug in logic. Ask developer';
    }
}

sub _cache_get {
    my $self = shift;
    my $type = shift;

    my $lasttime = $self->{_mtime}{$type};
    my $mtime;
    if ($type eq 'total' or $type eq 'is_list_member') {
        $mtime = $self->_cache_read_expiry('member');
    } else {
        $mtime = $self->_cache_read_expiry($type);
    }
    $self->{_mtime}{$type} = $mtime;

    return undef unless defined $lasttime and defined $mtime;
    return undef if $lasttime < $mtime;
    return $self->{_cached}{$type};
}

sub _cache_put {
    my $self  = shift;
    my $type  = shift;
    my $value = shift;

    return $self->{_cached}{$type} = $value;
}

# Old name: List::extract_verp_rcpt().
# Moved to: Sympa::Spindle::DistributeMessage::_extract_verp_rcpt().
#sub _extract_verp_rcpt;

# Dumps a copy of list users to disk, in text format.
# Old name: Sympa::List::dump() which dumped only members.
sub dump_users {
    $log->syslog('debug2', '(%s, %s)', @_);
    my $self = shift;
    my $role = shift;

    die 'bug in logic. Ask developer'
        unless grep { $role eq $_ } qw(member owner editor);

    my $file = $self->{'dir'} . '/' . $role . '.dump';

    unlink $file . '.old' if -e $file . '.old';
    rename $file, $file . '.old' if -e $file;
    my $lock_fh = Sympa::LockedFile->new($file, 5, '>');
    unless ($lock_fh) {
        $log->syslog(
            'err', 'Failed to save file %s.new: %s',
            $file, Sympa::LockedFile->last_error
        );
        return undef;
    }

    if ($role eq 'member') {
        my %map_field = _map_list_member_cols();

        my $user;
        for (
            $user = $self->get_first_list_member();
            $user;
            $user = $self->get_next_list_member()
        ) {
            foreach my $k (sort keys %map_field) {
                printf $lock_fh "%s %s\n", $k, $user->{$k}
                    if defined $user->{$k} and length $user->{$k};
            }
            print $lock_fh "\n";
        }
    } else {
        my %map_field = _map_list_admin_cols();

        foreach my $user (@{$self->get_current_admins || []}) {
            next unless $user->{role} eq $role;
            foreach my $k (sort keys %map_field) {
                printf $lock_fh "%s %s\n", $k, $user->{$k}
                    if defined $user->{$k} and length $user->{$k};
            }
            print $lock_fh "\n";
        }
    }

    $lock_fh->close;

    # FIXME:Are these lines required?
    $self->{'_mtime'}{'config'} =
        Sympa::Tools::File::get_mtime($self->{'dir'} . '/config');

    return 1;
}

## Saves the configuration file to disk
sub save_config {
    my ($self, $email) = @_;
    $log->syslog('debug3', '(%s, %s)', $self->{'name'}, $email);

    return undef
        unless ($self);

    my $config_file_name = "$self->{'dir'}/config";

    ## Lock file
    my $lock_fh = Sympa::LockedFile->new($config_file_name, 5, '+<');
    unless ($lock_fh) {
        $log->syslog('err', 'Could not create new lock');
        return undef;
    }

    my $name                 = $self->{'name'};
    my $old_serial           = $self->{'admin'}{'serial'};
    my $old_config_file_name = "$self->{'dir'}/config.$old_serial";

    ## Update management info
    $self->{'admin'}{'serial'}++;
    $self->{'admin'}{'update'} = {
        'email'      => $email,
        'date_epoch' => time,
    };

    unless (
        $self->_save_list_config_file(
            $config_file_name, $old_config_file_name
        )
    ) {
        $log->syslog('info', 'Unable to save config file %s',
            $config_file_name);
        $lock_fh->close();
        return undef;
    }

    ## Also update the binary version of the data structure
    if (Conf::get_robot_conf($self->{'domain'}, 'cache_list_config') eq
        'binary_file') {
        eval {
            Storable::store($self->{'admin'}, "$self->{'dir'}/config.bin");
        };
        if ($@) {
            $log->syslog('err',
                'Failed to save the binary config %s. error: %s',
                "$self->{'dir'}/config.bin", $@);
        }
    }

    ## Release the lock
    unless ($lock_fh->close()) {
        return undef;
    }

    unless ($self->_update_list_db) {
        $log->syslog('err', "Unable to update list_table");
    }

    return 1;
}

## Loads the administrative data for a list
sub load {
    $log->syslog('debug2', '(%s, %s, %s, ...)', @_);
    my $self    = shift;
    my $name    = shift;
    my $robot   = shift;
    my $options = shift;

    die 'bug in logic. Ask developer' unless $robot;

    ## Set of initializations ; only performed when the config is first loaded
    if ($options->{'first_access'}) {
        if ($robot && (-d "$Conf::Conf{'home'}/$robot")) {
            $self->{'dir'} = "$Conf::Conf{'home'}/$robot/$name";
        } elsif (lc($robot) eq lc($Conf::Conf{'domain'})) {
            $self->{'dir'} = "$Conf::Conf{'home'}/$name";
        } else {
            $log->syslog('err', 'No such robot (virtual domain) %s', $robot)
                unless ($options->{'just_try'});
            return undef;
        }

        $self->{'domain'} = $robot;

        # default list host is robot domain: Deprecated.
        #XXX$self->{'admin'}{'host'} ||= $self->{'domain'};
        $self->{'name'} = $name;
    }

    unless ((-d $self->{'dir'}) && (-f "$self->{'dir'}/config")) {
        $log->syslog('debug2', 'Missing directory (%s) or config file for %s',
            $self->{'dir'}, $name)
            unless ($options->{'just_try'});
        return undef;
    }

    # Last modification of list config ($last_time_config) on memory cache.
    # Note: "subscribers" file was deprecated. No need to load "stats" file.
    my $last_time_config = $self->{'_mtime'}{'config'};
    $last_time_config = POSIX::INT_MIN() unless defined $last_time_config;

    my $time_config = Sympa::Tools::File::get_mtime("$self->{'dir'}/config");
    my $time_config_bin =
        Sympa::Tools::File::get_mtime("$self->{'dir'}/config.bin");
    my $main_config_time =
        Sympa::Tools::File::get_mtime(Sympa::Constants::CONFIG);
    # my $web_config_time  = Sympa::Tools::File::get_mtime(Sympa::Constants::WWSCONFIG);
    my $config_reloaded = 0;
    my $admin;

    if (Conf::get_robot_conf($self->{'domain'}, 'cache_list_config') eq
            'binary_file'
        and !$options->{'reload_config'}
        and $time_config_bin > $last_time_config
        and $time_config_bin >= $time_config
        and $time_config_bin >= $main_config_time) {
        ## Get a shared lock on config file first
        my $lock_fh =
            Sympa::LockedFile->new($self->{'dir'} . '/config', 5, '<');
        unless ($lock_fh) {
            $log->syslog('err', 'Could not create new lock');
            return undef;
        }

        ## Load a binary version of the data structure
        ## unless config is more recent than config.bin
        eval { $admin = Storable::retrieve("$self->{'dir'}/config.bin") };
        if ($@) {
            $log->syslog('err',
                'Failed to load the binary config %s, error: %s',
                "$self->{'dir'}/config.bin", $@);
            $lock_fh->close();
            return undef;
        }

        $config_reloaded  = 1;
        $last_time_config = $time_config_bin;
        $lock_fh->close();
    } elsif ($self->{'name'} ne $name
        or $time_config > $last_time_config
        or $options->{'reload_config'}) {
        $admin = $self->_load_list_config_file;

        ## Get a shared lock on config file first
        my $lock_fh =
            Sympa::LockedFile->new($self->{'dir'} . '/config', 5, '+<');
        unless ($lock_fh) {
            $log->syslog('err', 'Could not create new lock');
            return undef;
        }

        ## update the binary version of the data structure
        if (Conf::get_robot_conf($self->{'domain'}, 'cache_list_config') eq
            'binary_file') {
            eval { Storable::store($admin, "$self->{'dir'}/config.bin") };
            if ($@) {
                $log->syslog('err',
                    'Failed to save the binary config %s. error: %s',
                    "$self->{'dir'}/config.bin", $@);
            }
        }

        $config_reloaded = 1;
        unless (defined $admin) {
            $log->syslog(
                'err',
                'Impossible to load list config file for list %s set in status error_config',
                $self
            );
            $self->set_status_error_config('load_admin_file_error');
            $lock_fh->close();
            return undef;
        }

        $last_time_config = $time_config;
        $lock_fh->close();
    }

    ## If config was reloaded...
    if ($admin) {
        $self->{'admin'} = $admin;

        ## check param_constraint.conf if belongs to a family and the config
        ## has been loaded
        if (defined $admin->{'family_name'}
            && ($admin->{'status'} ne 'error_config')) {
            my $family;
            unless ($family = $self->get_family()) {
                $log->syslog(
                    'err',
                    'Impossible to get list %s family: %s. The list is set in status error_config',
                    $self,
                    $self->{'admin'}{'family_name'}
                );
                $self->set_status_error_config('no_list_family',
                    $self->{'admin'}{'family_name'});
                return undef;
            }
            my $error = $family->check_param_constraint($self);
            unless ($error) {
                $log->syslog(
                    'err',
                    'Impossible to check parameters constraint for list % set in status error_config',
                    $self->{'name'}
                );
                $self->set_status_error_config('no_check_rules_family',
                    $family->{'name'});
            }
            if (ref($error) eq 'ARRAY') {
                $log->syslog(
                    'err',
                    'The list "%s" does not respect the rules from its family %s',
                    $self->{'name'},
                    $family->{'name'}
                );
                $self->set_status_error_config('no_respect_rules_family',
                    $family->{'name'});
            }
        }
    }

    $self->{'as_x509_cert'} = 1
        if ((-r "$self->{'dir'}/cert.pem")
        || (-r "$self->{'dir'}/cert.pem.enc"));

    $self->{'_mtime'}{'config'} = $last_time_config;

    $list_of_lists{$self->{'domain'}}{$name} = $self;