sympa.pl.in

#!--PERL--
# -*- 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, 2019, 2020, 2021 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/>.

use lib split(/:/, $ENV{SYMPALIB} || ''), '--modulesdir--';
use strict;
use warnings;
use Digest::MD5;
use English qw(-no_match_vars);
use Fcntl qw();
use File::Basename qw();
use File::Copy qw();
use File::Path qw();
use Getopt::Long;
use Pod::Usage;
use POSIX qw();

use Sympa;
use Sympa::Aliases;
use Conf;
use Sympa::Constants;
use Sympa::DatabaseManager;
use Sympa::Family;
use Sympa::Language;
use Sympa::List;
use Sympa::Log;
use Sympa::Mailer;
use Sympa::Message;
use Sympa::Spindle::ProcessDigest;
use Sympa::Spindle::ProcessRequest;
use Sympa::Spool::Archive;
use Sympa::Template;
use Sympa::Tools::Data;
use Sympa::Upgrade;

## Init random engine
srand(time());

# Check options.
my %options;
unless (
    GetOptions(
        \%main::options,                'dump=s',
        'debug|d',                      'log_level=s',
        'config|f=s',                   'lang|l=s',
        'mail|m',                       'help|h',
        'version|v',                    'import=s',
        'make_alias_file',              'lowercase',
        'sync_list_db',                 'md5_encode_password',
        'close_list=s',                 'rename_list=s',
        'copy_list=s',                  'new_listname=s',
        'new_listrobot=s',              'purge_list=s',
        'create_list',                  'instantiate_family=s',
        'robot=s',                      'add_list=s',
        'modify_list=s',                'close_family=s',
        'md5_digest=s',                 'change_user_email',
        'current_email=s',              'new_email=s',
        'input_file=s',                 'sync_include=s',
        'upgrade',                      'upgrade_shared',
        'from=s',                       'to=s',
        'reload_list_config',           'list=s',
        'quiet',                        'close_unknown',
        'test_database_message_buffer', 'conf_2_db',
        'export_list',                  'health_check',
        'send_digest',                  'keep_digest',
        'upgrade_config_location',      'role=s',
        'dump_users',                   'restore_users',
        'open_list=s',                  'show_pending_lists=s',
        'notify',                       'rebuildarc=s'
    )
) {
    pod2usage(-exitval => 1, -output => \*STDERR);
}
if ($main::options{'help'}) {
    pod2usage(0);
} elsif ($main::options{'version'}) {
    printf "Sympa %s\n", Sympa::Constants::VERSION;
    exit 0;
}
$Conf::sympa_config = $main::options{config};

if ($main::options{'debug'}) {
    $main::options{'log_level'} = 2 unless $main::options{'log_level'};
}

my $log = Sympa::Log->instance;
$log->{log_to_stderr} = 'notice,err'
    if $main::options{'upgrade'}
    || $main::options{'reload_list_config'}
    || $main::options{'test_database_message_buffer'}
    || $main::options{'conf_2_db'};

if ($main::options{'upgrade_config_location'}) {
    my $config_file = Conf::get_sympa_conf();

    if (-f $config_file) {
        printf "Sympa configuration already located at %s\n", $config_file;
        exit 0;
    }

    my ($file, $dir, $suffix) = File::Basename::fileparse($config_file);
    my $old_dir = $dir;
    $old_dir =~ s/sympa\///;

    # Try to create config path if it does not exist
    unless (-d $dir) {
        my $error;
        File::Path::make_path(
            $dir,
            {   mode  => 0755,
                owner => Sympa::Constants::USER(),
                group => Sympa::Constants::GROUP(),
                error => \$error
            }
        );
        if (@$error) {
            my $diag = pop @$error;
            my ($target, $error) = %$diag;
            die "Unable to create $target: $error";
        }
    }

    # Check ownership of config folder
    my @stat = stat($dir);
    my $user = (getpwuid $stat[4])[0];
    if ($user ne Sympa::Constants::USER()) {
        die sprintf
            "Config dir %s exists but is not owned by %s (owned by %s).\n",
            $dir, Sympa::Constants::USER(), $user;
    }

    # Check permissions on config folder
    if (($stat[2] & Fcntl::S_IRWXU()) != Fcntl::S_IRWXU()) {
        die
            "Config dir $dir exists, but sympa does not have rwx permissions on it";
    }

    # Move files from old location to new one
    opendir(my $dh, $old_dir) or die("Could not open $dir for reading");
    my @files = grep(/^(ww)?sympa\.conf.*$/, readdir($dh));
    closedir($dh);

    foreach my $file (@files) {
        unless (File::Copy::move("$old_dir/$file", "$dir/$file")) {
            die sprintf 'Could not move %s/%s to %s/%s: %s', $old_dir, $file,
                $dir, $file, $ERRNO;
        }
    }

    printf "Sympa configuration moved to %s\n", $dir;
    exit 0;
} elsif ($main::options{'health_check'}) {
    ## Health check

    ## Load configuration file. Ignoring database config for now: it avoids
    ## trying to load a database that could not exist yet.
    unless (Conf::load(Conf::get_sympa_conf(), 'no_db')) {
        #FIXME: force reload
        die sprintf
            "Configuration file %s has errors.\n",
            Conf::get_sympa_conf();
    }

    ## Open the syslog and say we're read out stuff.
    $log->openlog(
        $Conf::Conf{'syslog'},
        $Conf::Conf{'log_socket_type'},
        service => 'sympa/health_check'
    );

    ## Setting log_level using conf unless it is set by calling option
    if ($main::options{'log_level'}) {
        $log->{level} = $main::options{'log_level'};
        $log->syslog(
            'info',
            'Configuration file read, log level set using options: %s',
            $main::options{'log_level'}
        );
    } else {
        $log->{level} = $Conf::Conf{'log_level'};
        $log->syslog(
            'info',
            'Configuration file read, default log level %s',
            $Conf::Conf{'log_level'}
        );
    }

    ## Check if db_type is not the boilerplate one
    if ($Conf::Conf{'db_type'} eq '(You must define this parameter)') {
        die sprintf
            "Database type \"%s\" defined in sympa.conf is the boilerplate one and obviously incorrect. Verify db_xxx parameters in sympa.conf\n",
            $Conf::Conf{'db_type'};
    }

    ## Preliminary check of db_type
    unless ($Conf::Conf{'db_type'} and $Conf::Conf{'db_type'} =~ /\A\w+\z/) {
        die sprintf
            "Database type \"%s\" defined in sympa.conf seems incorrect. Verify db_xxx parameters in sympa.conf\n",
            $Conf::Conf{'db_type'};
    }

    ## Check database connectivity and probe database
    unless (Sympa::DatabaseManager::probe_db()) {
        die sprintf
            "Database %s defined in sympa.conf has not the right structure or is unreachable. Verify db_xxx parameters in sympa.conf\n",
            $Conf::Conf{'db_name'};
    }

    ## Now trying to load full config (including database)
    unless (Conf::load()) {    #FIXME: load Site, then robot cache
        die sprintf
            "Unable to load Sympa configuration, file %s or any of the virtual host robot.conf files contain errors. Exiting.\n",
            Conf::get_sympa_conf();
    }

    ## Change working directory.
    if (!chdir($Conf::Conf{'home'})) {
        printf STDERR "Can't chdir to %s: %s\n", $Conf::Conf{'home'}, $ERRNO;
        exit 1;
    }

    ## Check for several files.
    unless (Conf::checkfiles_as_root()) {
        printf STDERR "Missing files.\n";
        exit 1;
    }

    ## Check that the data structure is uptodate
    unless (Conf::data_structure_uptodate()) {
        printf STDOUT
            "Data structure was not updated; you should run sympa.pl --upgrade to run the upgrade process.\n";
    }

    exit 0;
}

my $default_lang;

my $language = Sympa::Language->instance;
my $mailer   = Sympa::Mailer->instance;

_load();

$log->openlog($Conf::Conf{'syslog'}, $Conf::Conf{'log_socket_type'});

# Set the User ID & Group ID for the process
$GID = $EGID = (getgrnam(Sympa::Constants::GROUP))[2];
$UID = $EUID = (getpwnam(Sympa::Constants::USER))[2];

## Required on FreeBSD to change ALL IDs
## (effective UID + real UID + saved UID)
POSIX::setuid((getpwnam(Sympa::Constants::USER))[2]);
POSIX::setgid((getgrnam(Sympa::Constants::GROUP))[2]);

## Check if the UID has correctly been set (useful on OS X)
unless (($GID == (getgrnam(Sympa::Constants::GROUP))[2])
    && ($UID == (getpwnam(Sympa::Constants::USER))[2])) {
    die
        "Failed to change process user ID and group ID. Note that on some OS Perl scripts can't change their real UID. In such circumstances Sympa should be run via sudo.\n";
}

# Sets the UMASK
umask(oct($Conf::Conf{'umask'}));

## Most initializations have now been done.
$log->syslog('notice', 'Sympa %s Started', Sympa::Constants::VERSION());

# Check for several files.
#FIXME: This would be done in --health_check mode.
unless (Conf::checkfiles()) {
    die "Missing files.\n";
    ## No return.
}

# Daemon called for dumping subscribers list
if ($main::options{'dump'} or $main::options{'dump_users'}) {
    my $all_lists;

    # Compat. for old style "--dump=LIST".
    my $list_id = $main::options{'dump'} || $main::options{'list'};

    if (defined $list_id and $list_id eq 'ALL') {
        $all_lists =
            Sympa::List::get_lists('*', filter => [status => 'open']);
    } elsif (defined $list_id and length $list_id) {
        # The parameter is list ID and list have to be open.
        unless (0 < index $list_id, '@') {
            $log->syslog('err', 'Incorrect list address %s', $list_id);
            exit 1;
        }
        my $list = Sympa::List->new($list_id);
        unless (defined $list) {
            $log->syslog('err', 'Unknown list %s', $list_id);
            exit 1;
        }
        unless ($list->{'admin'}{'status'} eq 'open') {
            $log->syslog('err', 'List is not open: %s', $list);
            exit 1;
        }

        $all_lists = [$list];
    } else {
        $log->syslog('err', 'No lists specified');
        exit 1;
    }

    my @roles = qw(member);
    if ($main::options{'role'}) {
        my %roles = map { ($_ => 1) }
            ($main::options{'role'} =~ /\b(member|owner|editor)\b/g);
        @roles = sort keys %roles;
        unless (@roles) {
            $log->syslog('err', 'Unknown role %s', $main::options{'role'});
            exit 1;
        }
    }

    foreach my $list (@$all_lists) {
        foreach my $role (@roles) {
            unless ($list->dump_users($role)) {
                printf STDERR "%s: Could not dump list users (%s)\n",
                    $list->get_id, $role;
            } else {
                printf STDERR "%s: Dumped list users (%s)\n",
                    $list->get_id, $role;
            }
        }
    }

    exit 0;
} elsif ($main::options{'restore_users'}) {
    my $all_lists;

    my $list_id = $main::options{'list'};

    if (defined $list_id and $list_id eq 'ALL') {
        $all_lists =
            Sympa::List::get_lists('*', filter => [status => 'open']);
    } elsif (defined $list_id and length $list_id) {
        # The parameter is list ID and list have to be open.
        unless (0 < index $list_id, '@') {
            $log->syslog('err', 'Incorrect list address %s', $list_id);
            exit 1;
        }
        my $list = Sympa::List->new($list_id);
        unless (defined $list) {
            $log->syslog('err', 'Unknown list %s', $list_id);
            exit 1;
        }
        unless ($list->{'admin'}{'status'} eq 'open') {
            $log->syslog('err', 'List is not open: %s', $list);
            exit 1;
        }

        $all_lists = [$list];
    } else {
        $log->syslog('err', 'No lists specified');
        exit 1;
    }

    my @roles = qw(member);
    if ($main::options{'role'}) {
        my %roles = map { ($_ => 1) }
            ($main::options{'role'} =~ /\b(member|owner|editor)\b/g);
        @roles = sort keys %roles;
        unless (@roles) {
            $log->syslog('err', 'Unknown role %s', $main::options{'role'});
            exit 1;
        }
    }

    foreach my $list (@$all_lists) {
        foreach my $role (@roles) {
            unless ($list->restore_users($role)) {
                printf STDERR "%s: Could not restore list users (%s)\n",
                    $list->get_id, $role;
            } else {
                printf STDERR "%s: Restored list users (%s)\n",
                    $list->get_id, $role;
            }
        }
    }

    exit 0;
} elsif ($main::options{'make_alias_file'}) {
    my $robots = $main::options{'robot'} || '*';
    my @robots;
    if ($robots eq '*') {
        @robots = Sympa::List::get_robots();
    } else {
        for my $name (split /[\s,]+/, $robots) {
            next unless length($name);
            if (Conf::valid_robot($name)) {
                push @robots, $name;
            } else {
                printf STDERR "Invalid robot %s\n", $name;
            }
        }
    }
    exit 0 unless @robots;

    # There may be multiple aliases files.  Give each of them suffixed
    # name.
    my ($basename, %robots_of, %sympa_aliases);
    $basename = sprintf '%s/sympa_aliases.%s', $Conf::Conf{'tmpdir'}, $PID;

    foreach my $robot (@robots) {
        my $file = Conf::get_robot_conf($robot, 'sendmail_aliases');
        next if $file eq 'none';

        $robots_of{$file} ||= [];
        push @{$robots_of{$file}}, $robot;
    }
    if (1 < scalar(keys %robots_of)) {
        my $i = 0;
        %sympa_aliases = map {
            $i++;
            map { $_ => sprintf('%s.%03d', $basename, $i) } @{$robots_of{$_}}
        } sort keys %robots_of;
    } else {
        %sympa_aliases = map { $_ => $basename } @robots;
    }

    # Create files.
    foreach my $sympa_aliases (values %sympa_aliases) {
        my $fh;
        unless (open $fh, '>', $sympa_aliases) {    # truncate if exists
            printf STDERR "Unable to create %s: %s\n", $sympa_aliases, $ERRNO;
            exit 1;
        }
        close $fh;
    }

    # Write files.
    foreach my $robot (sort @robots) {
        my $alias_manager = Conf::get_robot_conf($robot, 'alias_manager');
        my $sympa_aliases = $sympa_aliases{$robot};

        my $aliases =
            Sympa::Aliases->new($alias_manager, file => $sympa_aliases);
        next
            unless $aliases and $aliases->isa('Sympa::Aliases::Template');

        my $fh;
        unless (open $fh, '>>', $sympa_aliases) {    # append
            printf STDERR "Unable to create %s: %s\n", $sympa_aliases, $ERRNO;
            exit 1;
        }
        printf $fh "#\n#\tAliases for all Sympa lists open on %s\n#\n",
            $robot;
        close $fh;

        my $all_lists = Sympa::List::get_lists($robot);
        foreach my $list (@{$all_lists || []}) {
            next unless $list->{'admin'}{'status'} eq 'open';

            $aliases->add($list);
        }
    }

    if (1 < scalar(keys %robots_of)) {
        printf
            "Sympa aliases files %s.??? were made.  You probably need to install them in your SMTP engine.\n",
            $basename;
    } else {
        printf
            "Sympa aliases file %s was made.  You probably need to install it in your SMTP engine.\n",
            $basename;
    }
    exit 0;
} elsif ($main::options{'md5_digest'}) {
    my $md5 = Digest::MD5::md5_hex($main::options{'md5_digest'});
    printf "md5 digest : %s \n", $md5;

    exit 0;
} elsif ($main::options{'import'}) {
    #FIXME The parameter should be a list address.
    unless ($main::options{'import'} =~ /\@/) {
        printf STDERR "Incorrect list address %s\n", $main::options{'import'};
        exit 1;
    }
    my $list;
    unless ($list = Sympa::List->new($main::options{'import'})) {
        printf STDERR "Unknown list name %s\n", $main::options{'import'};
        exit 1;
    }
    my $dump = do { local $RS; <STDIN> };

    my $spindle = Sympa::Spindle::ProcessRequest->new(
        context          => $list,
        action           => 'import',
        dump             => $dump,
        force            => 1,
        sender           => Sympa::get_address($list, 'listmaster'),
        scenario_context => {skip => 1},
        quiet            => $main::options{quiet},
    );
    unless ($spindle and $spindle->spin) {
        printf STDERR "Failed to add email addresses to %s\n", $list;
        exit 1;
    }
    my $status = _report($spindle);
    printf STDERR "Total imported subscribers: %d\n",
        scalar(grep { $_->[1] eq 'notice' and $_->[2] eq 'now_subscriber' }
            @{$spindle->{stash} || []});
    exit($status ? 0 : 1);

} elsif ($main::options{'md5_encode_password'}) {
    print STDERR "Obsoleted.  Use upgrade_sympa_password.pl.\n";

    exit 0;
} elsif ($main::options{'lowercase'}) {
    print STDERR "Working on user_table...\n";
    my $total = _lowercase_field('user_table', 'email_user');

    if (defined $total) {
        print STDERR "Working on subscriber_table...\n";
        my $total_sub =
            _lowercase_field('subscriber_table', 'user_subscriber');
        if (defined $total_sub) {
            $total += $total_sub;
        }
    }

    unless (defined $total) {
        print STDERR "Could not work on dabatase.\n";
        exit 1;
    }

    printf STDERR "Total lowercased rows: %d\n", $total;

    exit 0;
} elsif ($main::options{'close_list'}) {
    my ($listname, $robot_id) = split /\@/, $main::options{'close_list'}, 2;
    my $current_list = Sympa::List->new($listname, $robot_id);
    unless ($current_list) {
        printf STDERR "Incorrect list name %s.\n",
            $main::options{'close_list'};
        exit 1;
    }

    my $spindle = Sympa::Spindle::ProcessRequest->new(
        context          => $robot_id,
        action           => 'close_list',
        current_list     => $current_list,
        sender           => Sympa::get_address($robot_id, 'listmaster'),
        scenario_context => {skip => 1},
    );
    unless ($spindle and $spindle->spin and _report($spindle)) {
        printf STDERR "Could not close list %s\n", $current_list->get_id;
        exit 1;
    }
    exit 0;

} elsif ($main::options{'change_user_email'}) {
    unless ($main::options{'current_email'} and $main::options{'new_email'}) {
        print STDERR "Missing current_email or new_email parameter\n";
        exit 1;
    }

    my $spindle = Sympa::Spindle::ProcessRequest->new(
        context          => [Sympa::List::get_robots()],
        action           => 'move_user',
        current_email    => $main::options{'current_email'},
        email            => $main::options{'new_email'},
        sender           => Sympa::get_address('*', 'listmaster'),
        scenario_context => {skip => 1},
    );
    unless ($spindle and $spindle->spin and _report($spindle)) {
        printf STDERR "Failed to change user email address %s to %s\n",
            $main::options{'current_email'}, $main::options{'new_email'};
        exit 1;
    }
    exit 0;

} elsif ($main::options{'purge_list'}) {
    my ($listname, $robot_id) = split /\@/, $main::options{'purge_list'}, 2;
    my $current_list = Sympa::List->new($listname, $robot_id);
    unless ($current_list) {
        printf STDERR "Incorrect list name %s\n",
            $main::options{'purge_list'};
        exit 1;
    }

    my $spindle = Sympa::Spindle::ProcessRequest->new(
        context          => $robot_id,
        action           => 'close_list',
        current_list     => $current_list,
        mode             => 'purge',
        scenario_context => {skip => 1},
    );
    unless ($spindle and $spindle->spin and _report($spindle)) {
        printf STDERR "Could not purge list %s\n", $current_list->get_id;
        exit 1;
    }
    exit 0;

} elsif ($main::options{'rename_list'}) {
    my $current_list =
        Sympa::List->new(split(/\@/, $main::options{'rename_list'}, 2),
        {just_try => 1});
    unless ($current_list) {
        printf STDERR "Incorrect list name %s\n",
            $main::options{'rename_list'};
        exit 1;
    }

    my $listname = $main::options{'new_listname'};
    unless (defined $listname and length $listname) {
        print STDERR "Missing parameter new_listname\n";
        exit 1;
    }

    my $robot_id = $main::options{'new_listrobot'};
    unless (defined $robot_id) {
        $robot_id = $current_list->{'domain'};
    } else {
        unless (length $robot_id and Conf::valid_robot($robot_id)) {
            printf STDERR "Unknown robot \"%s\"\n", $robot_id;
            exit 1;
        }
    }

    my $spindle = Sympa::Spindle::ProcessRequest->new(
        context          => $robot_id,
        action           => 'move_list',
        current_list     => $current_list,
        listname         => $listname,
        sender           => Sympa::get_address($robot_id, 'listmaster'),
        scenario_context => {skip => 1},
    );
    unless ($spindle and $spindle->spin and _report($spindle)) {
        printf STDERR "Could not rename list %s to %s\@%s\n",
            $current_list->get_id, $listname, $robot_id;
        exit 1;
    }
    exit 0;

} elsif ($main::options{'copy_list'}) {
    my $current_list =
        Sympa::List->new(split(/\@/, $main::options{'copy_list'}, 2),
        {just_try => 1});
    unless ($current_list) {
        printf STDERR "Incorrect list name %s\n", $main::options{'copy_list'};
        exit 1;
    }

    my $listname = $main::options{'new_listname'};
    unless (defined $listname and length $listname) {
        print STDERR "Missing parameter new_listname\n";
        exit 1;
    }

    my $robot_id = $main::options{'new_listrobot'};
    unless (defined $robot_id) {
        $robot_id = $current_list->{'domain'};
    } else {
        unless (length $robot_id and Conf::valid_robot($robot_id)) {
            printf STDERR "Unknown robot \"%s\"\n", $robot_id;
            exit 1;
        }
    }

    my $spindle = Sympa::Spindle::ProcessRequest->new(
        context          => $robot_id,
        action           => 'move_list',
        current_list     => $current_list,
        listname         => $listname,
        mode             => 'copy',
        sender           => Sympa::get_address($robot_id, 'listmaster'),
        scenario_context => {skip => 1},
    );
    unless ($spindle and $spindle->spin and _report($spindle)) {
        printf STDERR "Could not copy list %s to %s\@%s\n",
            $current_list->get_id, $listname, $robot_id;
        exit 1;
    }
    exit 0;

} elsif ($main::options{'test_database_message_buffer'}) {
    print
        "Deprecated.  Size of messages no longer limited by database packet size.\n";
    exit 1;
} elsif ($main::options{'conf_2_db'}) {

    printf
        "Sympa is going to store %s in database conf_table. This operation do NOT remove original files\n",
        Conf::get_sympa_conf();
    if (Conf::conf_2_db()) {
        printf "Done";
    } else {
        printf "an error occur";
    }
    exit 1;

} elsif ($main::options{'create_list'}) {
    my $robot = $main::options{'robot'} || $Conf::Conf{'domain'};

    unless ($main::options{'input_file'}) {
        print STDERR "Error : missing 'input_file' parameter\n";
        exit 1;
    }

    my $spindle = Sympa::Spindle::ProcessRequest->new(
        context          => $robot,
        action           => 'create_list',
        parameters       => {file => $main::options{'input_file'}},
        sender           => Sympa::get_address($robot, 'listmaster'),
        scenario_context => {skip => 1}
    );
    unless ($spindle and $spindle->spin and _report($spindle)) {
        print STDERR "Could not create list\n";
        exit 1;
    }
    exit 0;

} elsif ($main::options{'instantiate_family'}) {
    my $robot = $main::options{'robot'} || $Conf::Conf{'domain'};

    my $family_name;
    unless ($family_name = $main::options{'instantiate_family'}) {
        print STDERR "Error : missing family parameter\n";
        exit 1;
    }
    my $family;
    unless ($family = Sympa::Family->new($family_name, $robot)) {
        printf STDERR
            "The family %s does not exist, impossible instantiation\n",
            $family_name;
        exit 1;
    }

    unless ($main::options{'input_file'}) {
        print STDERR "Error : missing input_file parameter\n";
        exit 1;
    }

    unless (-r $main::options{'input_file'}) {
        printf STDERR "Unable to read %s file\n",
            $main::options{'input_file'};
        exit 1;
    }

    unless (
        instantiate(
            $family,
            $main::options{'input_file'},
            close_unknown => $main::options{'close_unknown'},
            quiet         => $main::options{quiet},
        )
    ) {
        print STDERR "\nImpossible family instantiation : action stopped \n";
        exit 1;
    }

    my %result;
    my $err = get_instantiation_results($family, \%result);

    unless ($main::options{'quiet'}) {
        print STDOUT "@{$result{'info'}}";
        print STDOUT "@{$result{'warn'}}";
    }
    if ($err >= 0) {
        print STDERR "@{$result{'errors'}}";
        exit 1;
    }

    exit 0;
} elsif ($main::options{'add_list'}) {
    my $robot = $main::options{'robot'} || $Conf::Conf{'domain'};

    my $family_name;
    unless ($family_name = $main::options{'add_list'}) {
        print STDERR "Error : missing family parameter\n";
        exit 1;
    }

    my $family;
    unless ($family = Sympa::Family->new($family_name, $robot)) {
        printf STDERR
            "The family %s does not exist, impossible to add a list\n",
            $family_name;
        exit 1;
    }

    unless ($main::options{'input_file'}) {
        print STDERR "Error : missing 'input_file' parameter\n";
        exit 1;
    }

    my $spindle = Sympa::Spindle::ProcessRequest->new(
        context          => $family,
        action           => 'create_automatic_list',
        parameters       => {file => $main::options{'input_file'}},
        sender           => Sympa::get_address($family, 'listmaster'),
        scenario_context => {skip => 1},
    );
    unless ($spindle and $spindle->spin and _report($spindle)) {
        printf STDERR "Impossible to add a list to the family %s\n",
            $family_name;
        exit 1;
    }

    exit 0;

} elsif ($main::options{'sync_include'}) {
    my $list = Sympa::List->new($main::options{'sync_include'});
    my $role = $main::options{'role'} || 'member';    # Compat. <= 6.2.54

    unless (defined $list) {
        printf STDERR "Incorrect list name %s\n",
            $main::options{'sync_include'};
        exit 1;
    }
    unless (grep { $role eq $_ } qw(member owner editor)) {
        printf STDERR "Unknown role %s\n", $role;
        exit 1;
    }

    my $spindle = Sympa::Spindle::ProcessRequest->new(
        context          => $list,
        action           => 'include',
        role             => $role,
        sender           => Sympa::get_address($list, 'listmaster'),
        scenario_context => {skip => 1},
    );
    unless ($spindle and $spindle->spin and _report($spindle)) {
        printf STDERR "Could not sync role %s of list %s with data sources\n",
            $role, $list->get_id;
        exit 1;
    }
    exit 0;
## Migration from one version to another
} elsif ($main::options{'upgrade'}) {

    $log->syslog('notice', "Upgrade process...");

    $main::options{'from'} ||= Sympa::Upgrade::get_previous_version();
    $main::options{'to'}   ||= Sympa::Constants::VERSION;

    if ($main::options{'from'} eq $main::options{'to'}) {
        $log->syslog('notice', 'Current version: %s; no upgrade is required',
            $main::options{'to'});
        exit 0;
    } else {
        $log->syslog('notice', "Upgrading from %s to %s...",
            $main::options{'from'}, $main::options{'to'});
    }

    unless (
        Sympa::Upgrade::upgrade($main::options{'from'}, $main::options{'to'}))
    {
        $log->syslog('err', "Migration from %s to %s failed",
            $main::options{'from'}, $main::options{'to'});
        exit 1;
    }

    $log->syslog('notice', 'Upgrade process finished');
    Sympa::Upgrade::update_version();

    exit 0;

} elsif ($main::options{'upgrade_shared'}) {
    print STDERR "Obsoleted.  Use upgrade_shared_repository.pl.\n";

    exit 0;
} elsif ($main::options{'reload_list_config'}) {
    if ($main::options{'list'}) {
        $log->syslog('notice', 'Loading list %s...', $main::options{'list'});
        my $list =
            Sympa::List->new($main::options{'list'}, '',
            {reload_config => 1});
        unless (defined $list) {
            printf STDERR "Error : incorrect list name '%s'\n",
                $main::options{'list'};
            exit 1;
        }
    } else {
        $log->syslog('notice', "Loading ALL lists...");
        my $all_lists = Sympa::List::get_lists('*', reload_config => 1);
    }
    $log->syslog('notice', '...Done.');

    exit 0;
}

##########################################
elsif ($main::options{'modify_list'}) {
    my $robot = $main::options{'robot'} || $Conf::Conf{'domain'};

    my $family;
    unless ($main::options{'modify_list'}) {
        print STDERR "Error : missing family parameter\n";
        exit 1;
    }
    unless ($family =
        Sympa::Family->new($main::options{'modify_list'}, $robot)) {
        printf STDERR
            "The family %s does not exist, impossible to modify the list.\n",
            $main::options{'modify_list'};
        exit 1;
    }
    unless ($main::options{'input_file'}) {
        print STDERR "Error : missing input_file parameter\n";
        exit 1;
    }

    # list config family updating
    my $spindle = Sympa::Spindle::ProcessRequest->new(
        context          => $family,
        action           => 'update_automatic_list',
        parameters       => {file => $main::options{'input_file'}},
        sender           => Sympa::get_address($family, 'listmaster'),
        scenario_context => {skip => 1},
    );
    unless ($spindle and $spindle->spin and _report($spindle)) {
        print STDERR "No object list resulting from updating\n";
        exit 1;
    }

    exit 0;
}

##########################################
elsif ($main::options{'close_family'}) {
    my $robot = $main::options{'robot'} || $Conf::Conf{'domain'};

    my $family_name;
    unless ($family_name = $main::options{'close_family'}) {
        pod2usage(-exitval => 1, -output => \*STDERR);
    }
    my $family;
    unless ($family = Sympa::Family->new($family_name, $robot)) {
        printf STDERR
            "The family %s does not exist, impossible family closure\n",
            $family_name;
        exit 1;
    }

    my $lists = Sympa::List::get_lists($family);
    my @impossible_close;
    my @close_ok;

    foreach my $list (@{$lists || []}) {
        my $listname = $list->{'name'};

        my $spindle = Sympa::Spindle::ProcessRequest->new(
            context          => $family->{'domain'},
            action           => 'close_list',
            current_list     => $list,
            sender           => Sympa::get_address($family, 'listmaster'),
            scenario_context => {skip => 1},
        );
        unless ($spindle and $spindle->spin and _report($spindle)) {
            push @impossible_