#!--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 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/>.

use lib '--modulesdir--';
use strict;
use warnings;
use Encode qw();
use English qw(-no_match_vars);
use Getopt::Long;
use Pod::Usage;
use Sys::Hostname qw();

use Sympa::ConfDef;
use Sympa::Constants;

my $with_CPAN;    # check if module "CPAN" installed.
my $modfail;      # any of required modules are not installed.

BEGIN {
    $with_CPAN = eval { require CPAN; };
    $modfail = !eval {
        require Conf;
        require Sympa::Language;
        require Sympa::Tools::Text;
    };
}

# Detect console encoding.
if (-t) {
    no warnings;

    eval { require Encode::Locale; };
    unless ($EVAL_ERROR
        or Encode::resolve_alias($Encode::Locale::ENCODING_CONSOLE_IN) eq
        'ascii'
        or Encode::resolve_alias($Encode::Locale::ENCODING_CONSOLE_OUT) eq
        'ascii') {
        binmode(STDIN,  ':encoding(console_in):bytes');
        binmode(STDOUT, ':encoding(console_out):bytes');
        binmode(STDERR, ':encoding(console_out):bytes');
    }
}

# Set language context if possible.
if ($modfail) {
    no warnings;

    *gettext = sub { $_[1] ? sprintf('%*s', $_[1], $_[0]) : $_[0] };

    eval { require Text::Wrap; };
    if ($EVAL_ERROR) {
        *Sympa::Tools::Text::wrap_text = sub {"$_[1]$_[0]\n"};
    } else {
        $Text::Wrap::columns = 78;
        *Sympa::Tools::Text::wrap_text =
            sub { Text::Wrap::wrap($_[1], $_[2], $_[0]) . "\n"; };
    }
} else {
    no warnings;

    my $language = Sympa::Language->instance;
    *gettext = sub {
        $_[1]
            ? Sympa::Tools::Text::pad($language->gettext($_[0]), $_[1])
            : $language->gettext($_[0]);
    };

    my $lang = $ENV{'LANGUAGE'} || $ENV{'LC_ALL'} || $ENV{'LANG'};
    $lang =~ s/\..*// if $lang;
    $language->set_lang($lang, 'en-US', 'en');
}

## sympa configuration file
my $sympa_conf = Sympa::Constants::CONFIG;

my %options;
GetOptions(
    \%options,
    'target=s',
    'create:s',    # parameter is optional and only "sympa.conf" is allowed.
    'batch',
    'display',
    'check',
    'help|h',
    'version|v',
);

if ($options{help}) {
    pod2usage();
} elsif ($options{'version'}) {
    printf "Sympa %s\n", Sympa::Constants::VERSION;
    exit 0;
} elsif (defined $options{create}) {
    create_configuration();
} elsif ($options{display}) {
    display_configuration();
} elsif ($options{check}) {
    check_cpan();
} else {
    my %user_param;
    foreach my $arg (@ARGV) {
        # check for key/values settings
        if ($arg =~ /\A(\w+)=(.+)/) {
            $user_param{$1} = $2;
        } else {
            die "$0: Invalid commandline argument: $arg\n";
        }
    }
    edit_configuration(%user_param);
}

exit 0;

sub create_configuration {
    my $conf;
    if ($options{create} eq '' or $options{create} eq 'sympa.conf') {
        $conf = $options{target} ? $options{target} : $sympa_conf;
    } else {
        pod2usage("$options{create} is not a valid argument");
        exit 1;
    }

    if (-f $conf) {
        print STDERR "$conf file already exists, exiting\n";
        exit 1;
    }

    my $umask = umask 037;
    unless (open NEWF, '>', $conf) {
        umask $umask;
        die "$0: "
            . sprintf(gettext("Unable to open %s : %s"), $conf, $ERRNO)
            . "\n";
    }
    umask $umask;

    if ($options{create} eq 'sympa.conf') {
#        print NEWF <<EOF
## Configuration file for Sympa
## many parameters are optional
## refer to the documentation for a detailed list of parameters

#EOF
    }

    my $title;
    foreach my $param (@Sympa::ConfDef::params) {
        next if $param->{obsolete};

        unless ($param->{'name'}) {
            $title = gettext($param->{'gettext_id'})
                if $param->{'gettext_id'};
            next;
        }

        next unless $param->{'file'};
        ##next unless defined $param->{'default'} or defined $param->{'sample'};

        if ($title) {
            printf NEWF "###\\\\\\\\ %s ////###\n\n", $title;
            undef $title;
        }

        printf NEWF "## %s\n", $param->{'name'};

        if ($param->{'gettext_id'}) {
            print NEWF Sympa::Tools::Text::wrap_text(
                gettext($param->{'gettext_id'}),
                '## ', '## ');
        }

        print NEWF Sympa::Tools::Text::wrap_text(
            gettext($param->{'gettext_comment'}),
            '## ', '## ')
            if $param->{'gettext_comment'};

        if (defined $param->{'sample'}) {
            printf NEWF '## ' . gettext('Example: ') . "%s\t%s\n",
                $param->{'name'}, $param->{'sample'};
        }

        if (defined $param->{'default'}) {
            printf NEWF "#%s\t%s\n", $param->{'name'}, $param->{'default'};
        } elsif ($param->{'optional'}) {
            printf NEWF "#%s\t\n", $param->{'name'};
        } else {
            printf NEWF "#%s\t%s\n", $param->{'name'},
                gettext("(You must define this parameter)");
        }
        print NEWF "\n";
    }

    close NEWF;
    print STDERR "$conf file has been created\n";
}

sub display_configuration {
    die "$0: You must run as superuser.\n"
        if $UID;
    die "$0: Installation of Sympa has not been completed.\n"
        . "Run sympa_wizard.pl --check\n"
        if $modfail;

    # Load sympa config (but not using database)
    unless (defined Conf::load($sympa_conf, 1)) {
        printf STDERR
            "$0: Unable to load sympa configuration, file %s or one of the virtual host robot.conf files contain errors. Exiting.\n",
            $sympa_conf;
        exit 1;
    }

    my ($var, $disp);

    print "[SYMPA]\n";
    foreach my $key (sort keys %Conf::Conf) {
        next
            if grep { $key eq $_ }
            qw(auth_services blocklist cas_number crawlers_detection
            generic_sso_number ldap ldap_number listmasters
            locale2charset nrcpt_by_domain robot_by_http_host request
            robot_name robots source_file sympa trusted_applications
            use_passwd);

        $var = $Conf::Conf{$key};

        if ($key eq 'automatic_list_families') {
            $disp = join ';', map {
                my $name = $_;
                join ':', map { sprintf '%s=%s', $_, $var->{$name}{$_} }
                    grep { !/\Aescaped_/ }
                    sort keys %{$var->{$name} || {}};
            } sort keys %{$var || {}};
        } elsif (ref $var eq 'ARRAY') {
            $disp = join(',', map { defined $_ ? $_ : '' } @$var);
        } else {
            $disp = defined $var ? $var : '';
        }

        printf "%s=\"%s\"\n", $key, $disp;
    }
}

sub edit_configuration {
    my %user_param = @_;

    die "$0: You must run as superuser.\n"
        if $UID;
    die "$0: Installation of Sympa has not been completed.\n"
        . "Run sympa_wizard.pl --check\n"
        if $modfail;

    # complement required fields.
    foreach my $param (@Sympa::ConfDef::params) {
        next if $param->{obsolete};
        next unless $param->{'name'};
        if ($param->{'name'} eq 'domain') {
            $param->{'default'} = Sys::Hostname::hostname();
        } elsif ($param->{'name'} eq 'wwsympa_url') {
            $param->{'default'} = sprintf 'http://%s/sympa',
                Sys::Hostname::hostname();
        } elsif ($param->{'name'} eq 'listmaster') {
            $param->{'default'} = sprintf 'your_email_address@%s',
                Sys::Hostname::hostname();
        }
    }

    ## Load sympa config (but not using database)
    unless (defined Conf::load($sympa_conf, 1)) {
        printf STDERR
            "$0: Unable to load sympa configuration, file %s or one of the virtual host robot.conf files contain errors. Exiting.\n",
            $sympa_conf;
        exit 1;
    }

    my $somechange = 0;

    my @new_sympa_conf;
    my $title = undef;

    # dynamic defaults
    my $domain    = Sys::Hostname::hostname();
    my $http_host = "http://$domain";

    ## Edition mode
    foreach my $param (@Sympa::ConfDef::params) {
        next if $param->{obsolete};

        unless ($param->{'name'}) {
            $title = gettext($param->{'gettext_id'})
                if $param->{'gettext_id'};
            next;
        }

        my $file  = $param->{'file'};
        my $name  = $param->{'name'};
        my $query = $param->{'gettext_id'} || '';
        $query = gettext($query) if $query;
        my $advice = $param->{'gettext_comment'};
        $advice = gettext($advice) if $advice;
        my $sample = $param->{'sample'};
        my $current_value;

        next unless $file;
        if ($file eq 'sympa.conf' or $file eq 'wwsympa.conf') {
            $current_value = $Conf::Conf{$name};
            $current_value = '' unless defined $current_value;
        } else {
            next;
        }

        if ($title) {
            ## write to conf file
            push @new_sympa_conf,
                sprintf "###\\\\\\\\ %s ////###\n\n", $title;
        }

        my $new_value = '';
        if ($options{batch}) {
            if (exists $user_param{$name}) {
                $new_value = $user_param{$name};
            }
        } elsif ($param->{'edit'} and $param->{'edit'} eq '1') {
            print "\n\n** $title **\n" if $title;

            print "\n";
            print Sympa::Tools::Text::wrap_text($query || '', '* ', '  ');
            print Sympa::Tools::Text::wrap_text($advice, '  ... ', '  ')
                if $advice;
            printf(gettext('%s [%s] : '), $name, $current_value);
            $new_value = <STDIN>;
            chomp $new_value;
        }
        if ($new_value eq '') {
            $new_value = $current_value;
        }

        undef $title;

        ## Skip empty parameters
        next if $new_value eq '' and !$sample;

        ## param is an ARRAY
        if (ref($new_value) eq 'ARRAY') {
            $new_value = join ',', @{$new_value};
        }

        unless ($file eq 'sympa.conf' or $file eq 'wwsympa.conf') {
            printf STDERR gettext("Incorrect parameter definition: %s\n"),
                $file;
        }

        if ($new_value eq '') {
            next unless $sample;

            push @new_sympa_conf,
                Sympa::Tools::Text::wrap_text($query, '## ', '## ');

            if (defined $advice and length $advice) {
                push @new_sympa_conf,
                    Sympa::Tools::Text::wrap_text($advice, '## ', '## ');
            }

            push @new_sympa_conf, "# $name\t$sample\n\n";
        } else {
            push @new_sympa_conf,
                Sympa::Tools::Text::wrap_text($query, '## ', '## ');
            if (defined $advice and length $advice) {
                push @new_sympa_conf,
                    Sympa::Tools::Text::wrap_text($advice, '## ', '## ');
            }

            if ($current_value ne $new_value) {
                push @new_sympa_conf, "# was $name $current_value\n";
                $somechange = 1;
            }

            push @new_sympa_conf, "$name\t$new_value\n\n";
        }
    }

    if ($somechange) {
        my @time = localtime time;
        my $date = sprintf '%d%02d%02d%02d%02d%02d',
            $time[5] + 1900, $time[4] + 1, @time[3, 2, 1, 0];

        ## Keep old config file
        unless (rename $sympa_conf, $sympa_conf . '.' . $date) {
            warn sprintf(gettext("Unable to rename %s : %s"),
                $sympa_conf, $ERRNO);
        }

        ## Write new config file
        my $umask = umask 037;
        unless (open(SYMPA, "> $sympa_conf")) {
            umask $umask;
            die "$0: "
                . sprintf(gettext("Unable to open %s : %s"),
                $sympa_conf, $ERRNO)
                . "\n";
        }
        umask $umask;
        chown [getpwnam(Sympa::Constants::USER)]->[2],
            [getgrnam(Sympa::Constants::GROUP)]->[2], $sympa_conf;

        print SYMPA @new_sympa_conf;
        close SYMPA;

        printf gettext(
            "%s have been updated.\nPrevious versions have been saved as %s.\n"
        ), $sympa_conf, "$sympa_conf.$date";
    }
}

sub check_cpan {
    my %cpan_modules = CPANFile::load() or die;

    print gettext(
        "##############################################################################
# This process will help you install all Perl (CPAN) modules required by Sympa
# software.
# Sympa requires from 50 to 65 additional Perl modules to run properly. 
# The whole installation process should take around 15 minutes.
# You'll first have to configure the CPAN shell itself and select your
# favourite CPAN server.
# Note that you might prefer to install the required Perl modules using your
# favourite DEB/RPM mechanism.
# Feel free to interrupt the process if needed ; you can restart it safely
# afterward.
##############################################################################
Press the Enter key to continue..."
    ) . "\n";
    my $rep = <STDIN>;

    print "\n";

    # Choose default DBD module if it has not been defined.
    my $db_type;
    if (open my $fh, '<', $sympa_conf) {
        foreach my $line (<$fh>) {
            if ($line =~ /\Adb_type\s+(\S*)/) {
                $db_type = $1;
            }
        }
        close $fh;
    }
    if ($db_type
        and exists $cpan_modules{'DBD::' . $db_type}) {
        $cpan_modules{'DBD::' . $db_type}->{mandatory} = 1;
    } else {
        my @dbd = (
            'MySQL/MariaDB' => 'DBD::mysql',
            'PostgreSQL'    => 'DBD::Pg',
            'SQLite'        => 'DBD::SQLite',
            'Oracle'        => 'DBD::Oracle',
        );
        my $selected;
        while (1) {
            print "\n"
                . gettext('Which RDBMS will you use for core database:')
                . "\n";
            for (my $i = 0; $i < scalar @dbd; $i += 2) {
                printf "%d: %s\n", $i / 2 + 1, $dbd[$i];
            }
            printf gettext('-> Select RDBMS [1-%d] '), scalar @dbd / 2;
            $selected = <STDIN>;
            chomp $selected;
            last
                if $selected =~ /\A\d+\z/
                and 0 < $selected
                and $selected * 2 <= scalar @dbd;
        }
        $cpan_modules{$dbd[$selected * 2 - 1]}->{mandatory} = 1;
    }

    ### REQ perl version
    print "\n" . gettext('Checking for PERL version:') . "\n\n";
    # Compat. for perl < 5.10: $^V is not an object but a vector of integers.
    my $rpv = eval 'v' . $cpan_modules{"perl"}{'required_version'} or die $@;
    if ($^V ge $rpv) {
        printf gettext('Your version of perl is OK (%s  >= %s)') . "\n", $],
            $cpan_modules{"perl"}{'required_version'};
    } else {
        printf gettext(
            "Your version of perl is TOO OLD (%s  < %s)\nPlease INSTALL a new one !"
        ) . "\n", $], $cpan_modules{"perl"}{'required_version'};
    }

    print "\n" . gettext('Checking for REQUIRED modules:') . "\n\n";
    check_modules('y', \%cpan_modules, 'mandatory');
    print "\n" . gettext('Checking for OPTIONAL modules:') . "\n\n";
    check_modules('n', \%cpan_modules, 'optional');

    print gettext(
        "******* NOTE *******
You can retrieve all theses modules from any CPAN server
(for example ftp://ftp.pasteur.fr/pub/computing/CPAN/CPAN.html)"
    ) . "\n";
###--------------------------
# reports modules status
# $cpan_modules is the cpan_modules structure
# $type is the type of modules (mandatory | optional) that should be installed
###--------------------------
}

sub check_modules {
#    my($default, $todo, $versions, $opt_features) = @_;
    my ($default, $cpan_modules, $type) = @_;

    printf "%s%s\n", gettext('perl module', -32), gettext('STATUS');
    printf "%-32s%s\n", gettext('-----------'), gettext('------');

    foreach my $mod (sort keys %$cpan_modules) {

        ## Only check modules of the expected type
        if ($type eq 'mandatory') {
            next unless ($cpan_modules->{$mod}{mandatory});
        } elsif ($type eq 'optional') {
            next if ($cpan_modules->{$mod}{mandatory});
        }

        ## Skip perl itself to prevent a huge upgrade
        next if ($mod eq 'perl');

        printf "%-32s", $mod;

        eval "require $mod";
        if ($EVAL_ERROR) {
            ### not installed
            print gettext('was not found on this system.') . "\n";
            install_module($mod, {'default' => $default}, $cpan_modules);
        } else {
            my ($vs, $v);
            $vs = "$mod" . "::VERSION";
            {
                no strict 'refs';
                $v = $$vs;
            }

            my $rv = $cpan_modules->{$mod}{required_version} || "1.0";
            ### OK: check version
            if ($v ge $rv) {
                printf gettext('OK (%-6s >= %s)') . "\n", $v, $rv;
                next;
            } else {
                printf gettext('version is too old (%s < %s)') . "\n", $v,
                    $rv;
                printf gettext(
                    '>>>>>>> You must update "%s" to version "%s" <<<<<<.')
                    . "\n", $mod,
                    $cpan_modules->{$mod}{required_version};
                install_module($mod, {'default' => $default}, $cpan_modules);
            }
        }
    }
}

##----------------------
# Install a CPAN module
##----------------------
sub install_module {
    return unless $with_CPAN;

    my ($module, $options, $cpan_modules) = @_;

    my $default = $options->{'default'};

    unless ($ENV{'FTP_PASSIVE'} and $ENV{'FTP_PASSIVE'} eq 1) {
        $ENV{'FTP_PASSIVE'} = 1;
        print "Setting FTP Passive mode\n";
    }

    # This is required on RedHat 9 for DBD::mysql installation
    my $lang;
    if ($ENV{'LANG'} and $ENV{'LANG'} =~ /UTF-8/) {
        $lang = $ENV{'LANG'};
        $ENV{'LANG'} = 'C';
    }

    unless ($EUID == 0) {
        printf gettext('## You need root privileges to install %s module. ##')
            . "\n", $module;
        print gettext(
            '## Press the Enter key to continue checking modules. ##')
            . "\n";
        my $t = <STDIN>;
        return undef;
    }

    unless ($options->{'force'}) {
        print Sympa::Tools::Text::wrap_text(
            sprintf(
                gettext('-> Usage of this module: %s') . "\n",
                gettext($cpan_modules->{$module}{'gettext_id'})
            ),
            '', '   '
        ) if ($cpan_modules->{$module}{'gettext_id'});
        print Sympa::Tools::Text::wrap_text(
            sprintf(
                gettext('-> Prerequisites: %s') . "\n",
                gettext($cpan_modules->{$module}{'gettext_comment'})
            ),
            '', '   '
        ) if ($cpan_modules->{$module}{'gettext_comment'});
        printf gettext('-> Install module %s ? [%s] '), $module, $default;
        my $answer = <STDIN>;
        chomp $answer;
        $answer ||= $default;
        return unless ($answer =~ /^y$/i);
    }

    $CPAN::Config->{'inactivity_timeout'} =
        0;   ## disable timeout to prevent timeout during modules installation
    $CPAN::Config->{'colorize_output'} = 1;
    $CPAN::Config->{'build_requires_install_policy'} =
        'yes';    ## automatically installed prerequisites without asking
    $CPAN::Config->{'prerequisites_policy'} =
        'follow';    ## build prerequisites automatically
    $CPAN::Config->{'load_module_verbosity'} =
        'none';      ## minimum verbosity during module loading
    $CPAN::Config->{'tar_verbosity'} =
        'none';      ## minimum verbosity with tar command

    # CPAN::Shell->clean($module) if ($options->{'force'});

    # CPAN::Shell->make($module);
    # if ($options->{'force'}) {
    #     CPAN::Shell->force('test', $module);
    # } else {
    #     CPAN::Shell->test($module);
    # }
    # # Could use CPAN::Shell->force('install') if make test failed
    CPAN::Shell->install($module);

    ## Check if module has been successfuly installed
    unless (eval "require $module") {

        ## Prevent recusive calls if already in force mode
        if ($options->{'force'}) {
            printf gettext(
                "Installation of %s still FAILED. You should download the tar.gz from http://search.cpan.org and install it manually."
            ), $module;
            my $answer = <STDIN>;
        } else {
            printf gettext(
                'Installation of %s FAILED. Do you want to force the installation of this module? (y/N) '
            ), $module;
            my $answer = <STDIN>;
            chomp $answer;
            if ($answer =~ /^y/i) {
                install_module($module, {'force' => 1}, $cpan_modules);
            }
        }
    }

    # Restore lang
    $ENV{'LANG'} = $lang if $lang;
}

package CPANFile;

use lib '--modulesdir--';
use strict;
use warnings;

our $description;
our $is_optional;
my %cpan_modules;

sub feature {
    shift;
    local $description = shift;
    local $is_optional = 1;
    shift->();
}

sub on {
    return unless shift eq 'runtime';
    shift->();
}

sub recommends {
    local $is_optional = 1;
    _depends(@_);
}

sub requires {
    _depends(@_);
}

sub load {
    do 'cpanfile';
    %cpan_modules;
}

sub _depends {
    my $module = shift;
    my $verreq = shift || '0';
    $verreq = [grep { !/[!<]/ } split /\s*,\s*/, $verreq]->[0];
    $verreq =~ s/\A[\s=>]+//;
    $cpan_modules{$module} = {
        required_version => $verreq,
        ($is_optional ? () : (mandatory => 1)),
        ($description ? (gettext_id => $description) : ()),
    };
}

1;
__END__

=encoding utf-8

=head1 NAME

sympa_wizard, sympa_wizard.pl - Help Performing Sympa Initial Setup
    
=head1 SYNOPSIS

C<sympa_wizard.pl>
S<[ C<--batch> [ I<key>=I<value> ... ] ]>
S<[ C<--check> ]>
S<[ C<--create> [ C<--target=>I<file> ] ]>
S<[ C<--display> ]>
S<[ C<-h, --help> ]>
S<[ C<-v, --version> ]>

=head1 OPTIONS

=over 4

=item C<sympa_wizard.pl>

Edit current Sympa configuration.

=item C<sympa_wizard.pl> C<--batch> I<key>=I<value> ...

Edit in batch mode.
Arguments would include pairs of parameter name and value.

=item C<sympa_wizard.pl> C<--check>

Check CPAN modules needed for running Sympa.

=item C<sympa_wizard.pl> C<--create> [ C<--target> I<file> ]

Creates a new F<sympa.conf> configuration file.

=item C<sympa_wizard.pl> C<--display>

Outputs all configuration parameters.

=item C<sympa_wizard.pl> C<--help>

Display usage instructions.

=item C<sympa_wizard.pl> C<--version>

Print version number.

=back

=head1 HISTORY

This program was originally written by:

=over 4

=item Serge Aumont <sa@cru.fr>

=item Olivier SalaE<252>n <os@cru.fr>

=back

C<--batch> and C<--display> options are added on Sympa 6.1.25 and 6.2.15.

=cut