#!/usr/local/bin/perl
# -*- indent-tabs-mode: nil; -*-
# vim:ft=perl:et:sw=4
# $Id$

# Sympa - SYsteme de Multi-Postage Automatique
#
# Copyright 2017 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 strict;
use warnings;
use lib split(/:/, $ENV{SYMPALIB} || ''), '/usr/local/libexec/sympa';
use English qw(-no_match_vars);
use Net::LDAP;
use Net::LDAP::Entry;
use Net::LDAPS;
use POSIX;

use Conf;
use Sympa::Constants;
use Sympa::Crash;    # Show traceback.
use Sympa::Template;

$ENV{'PATH'} = '';

## Load Sympa.conf
unless (Conf::load(Sympa::Constants::CONFIG)) {
    print gettext("The configuration file contains errors.\n");
    exit(1);
}

my $manager_conf_file = $Conf::Conf{etc} . '/ldap_alias_manager.conf';

## LDAP configuration
my %ldap_params;
my ($ldap_host,       $ldap_base_dn,        $ldap_bind_dn,
    $ldap_bind_pwd,   $ldap_mail_attribute, $ldap_objectclasses,
    $ldap_cachain,    $ldap_ssl,            $ldap_ssl_version,
    $queue_transport, $bouncequeue_transport
);
GetLdapParameter();

my $ldap_connection = undef;
$ldap_host = $ldap_params{'ldap_host'}
    or print STDERR
    "Missing required parameter ldap_host in the config file $manager_conf_file\n"
    and exit 0;
$ldap_base_dn = $ldap_params{'ldap_base_dn'}
    or print STDERR
    "Missing required parameter ldap_base_dn in the config file $manager_conf_file\n"
    and exit 0;
$ldap_bind_dn = $ldap_params{'ldap_bind_dn'}
    or print STDERR
    "Missing required parameter ldap_bind_dn in the config file $manager_conf_file\n"
    and exit 0;
$ldap_bind_pwd = $ldap_params{'ldap_bind_pwd'}
    or print STDERR
    "Missing required parameter ldap_bind_pwd in the config file $manager_conf_file\n"
    and exit 0;
$ldap_mail_attribute = $ldap_params{'ldap_mail_attribute'}
    or print STDERR
    "Missing required parameter ldap_mail_attribute in the config file $manager_conf_file\n"
    and exit 0;
(($ldap_ssl = $ldap_params{'ldap_ssl'}) ne '')
    or print STDERR
    "Missing required parameter ldap_ssl (possible value: 0 or 1) in the config file $manager_conf_file\n"
    and exit 0;

$ldap_ssl_version = lc($ldap_params{'ldap_ssl_version'} || '');
unless ($ldap_ssl_version) {
    $ldap_ssl_version = $ldap_ssl ? 'tlsv1' : undef;
} elsif ($ldap_ssl_version !~ /\A(sslv2|sslv3|tlsv1|tlsv1_[123])\z/) {
    printf STDERR
        "Invalid parameter ldap_ssl_version in the config file %s\n",
        $manager_conf_file;
    exit 0;
}

$ldap_cachain = $ldap_params{'ldap_cachain'} or undef;
$queue_transport = $ldap_params{'queue_transport'}
    or print STDERR
    "Missing required parameter queue_transport in the config file $manager_conf_file\n"
    and exit 0;
$bouncequeue_transport = $ldap_params{'bouncequeue_transport'}
    or print STDERR
    "Missing required parameter bouncequeue_transport in the config file $manager_conf_file\n"
    and exit 0;

my $default_domain;

# Check for simulation mode
my $simulation_mode = 0;
if (grep(/^-s$/, @ARGV)) {
    $simulation_mode = 1;
    @ARGV = grep(!/^-s$/, @ARGV);
}
my ($operation, $listname, $domain, $file) = @ARGV;

if (($operation !~ /^(add|del)$/) || ($#ARGV < 2)) {
    printf "Usage: $0 <add|del> <listname> <domain> [<file>]\n";
    printf "\n";
    printf "  Options:\n";
    printf
        "    -s\tSimulation mode. Dump the entries but don't add it to the directory.\n";
    exit(2);
}

$default_domain = $Conf::Conf{'domain'};

my %data;
$data{'date'} = POSIX::strftime("%d %b %Y", localtime(time));
$data{'list'}{'domain'} = $data{'robot'} = $domain;
$data{'list'}{'name'}   = $listname;
$data{'default_domain'} = $default_domain;
$data{'ldap_base_dn'}   = $ldap_base_dn;
$data{'is_default_domain'} = 1 if ($domain eq $default_domain);
$data{'return_path_suffix'} =
    Conf::get_robot_conf($domain, 'return_path_suffix');
my @aliases;

my $aliases_dump;
my $template = Sympa::Template->new($domain);
unless ($template->parse(\%data, 'list_aliases.tt2', \$aliases_dump)) {
    print STDERR "Can't parse list_aliases.tt2\n";
    exit 15;
}

@aliases = split /\n/, $aliases_dump;

unless (@aliases) {
    print STDERR "No aliases defined\n";
    exit(15);
}

if ($operation eq 'add') {

## Check existing aliases
    if (already_defined(@aliases)) {
        print STDERR "some alias already exist\n";
        exit(13);
    }

    if (!initialize_ldap()) {
        print STDERR "Can't bind to LDAP server\n";
        exit(14);
    }

    foreach my $alias (@aliases) {
        next if ($alias =~ /^\#/);
        next if ($alias =~ /^\s*$/);

        $alias =~ /^([^\s:]+)[\s:]+\"\s*\|\s*(.*)\s+(.*)\s*\"$/;
        my $alias_value   = $1;
        my $command_value = $2;
        my $maildrop      = $3;

        if ($command_value =~ m/bouncequeue/) {
            $command_value = $bouncequeue_transport;
        } else {
            $command_value = $queue_transport;
        }

        # We substitute all occurrences of + by - for the rest of the
        # attributes, including the dn.
        # The rationale behind this is that the "uid" attribute prevents the
        # use of the '+' character.
        $alias_value =~ s/\+/\-/g;

        my $ldif_dump;
        $data{'list'}{'alias'}    = $alias_value;
        $data{'list'}{'command'}  = $command_value;
        $data{'list'}{'maildrop'} = $maildrop;
        unless ($template->parse(\%data, 'ldap_alias_entry.tt2', \$ldif_dump))
        {
            print STDERR "Can't parse ldap_alias_entry.tt2\n";
            exit 15;
        }
        my @attribute_lines = split /\n/, $ldif_dump;

        # We create the new LDAP entry.
        my %ldap_attributes = ();
        my $entry           = Net::LDAP::Entry->new;
        foreach my $line (@attribute_lines) {
            next if ($line =~ /^\s*$/);
            next if ($line =~ /^\s*\#/);
            $line =~ /^([^:]+):\s*(.+)\s*$/;
            if ($1 eq 'dn') {
                $entry->dn($2);
            } else {
                push @{$ldap_attributes{$1}}, $2;
            }
        }

        # We add the the attributes
        foreach my $hash_key (keys %ldap_attributes) {
            foreach my $hash_value (@{$ldap_attributes{$hash_key}}) {
                $entry->add($hash_key, $hash_value);
            }
        }

        if ($simulation_mode) {
            $entry->dump;
        } else {
            # We finally add the entry
            my $msg = $ldap_connection->add($entry);
            if ($msg->is_error()) {
                print STDERR "Can't add entry for $alias_value\@$domain: ",
                    $msg->error(), "\n";
                exit(15);
            }
        }
        $entry = undef;
    }    # end foreach aliases

    finalize_ldap();

}    # end if add
elsif ($operation eq 'del') {

    if (!initialize_ldap()) {
        print STDERR "Can't bind to LDAP server\n";
        exit(7);
    }

    foreach my $alias (@aliases) {
        if ($alias =~ /^\#/) {
            next;
        }

        $alias =~ /^([^\s:]+)[\s:]/;
        my $alias_value = $1;
        $alias_value =~ s/\+/\-/g;

        my $ldif_dump;
        $data{'list'}{'alias'} = $alias_value;
        unless ($template->parse(\%data, 'ldap_alias_entry.tt2', \$ldif_dump))
        {
            print STDERR "Can't parse ldap_alias_entry.tt2\n";
            exit 15;
        }
        my $value = (grep(/^dn:/, split(/\n/, $ldif_dump)))[0];
        $value =~ s/^dn:\s*//;

        if ($simulation_mode) {
            printf "Would delete dn $value\n";
        } else {
            $ldap_connection->delete($value);
        }
    }    # end foreach aliases

    finalize_ldap();
}    # end if del
else {
    print STDERR "Action $operation not implemented yet\n";
    exit(2);
}

exit 0;

## Check if an alias is already defined
sub already_defined {

    my @aliases = @_;

    initialize_ldap();

    foreach my $alias (@aliases) {

        $alias =~ /^([^\s:]+)[\s:]/;

        my $source_result = $ldap_connection->search(
            filter => "("
                . $ldap_mail_attribute . "="
                . $1 . "\@"
                . $domain . ")",
            base => $ldap_base_dn
        );
        if ($source_result->count != 0) {
            print STDERR "Alias already defined : $1\n";
            finalize_ldap();
            return 1;
        }
    }

    finalize_ldap();
    return 0;
}

## Parse the alias_ldap.conf config file
sub GetLdapParameter {
    #read the config file
    open my $ifh, '<', $manager_conf_file
        or printf STDERR "Can't read the config file %s\n", $manager_conf_file
        and return 0;
    my @ldap_conf = <$ifh>;
    close $ifh;
    foreach (@ldap_conf) {
        #we skip the comments
        if ($_ =~ /^\s*\#/) {
            next;
        } elsif ($_ =~ /^\s*(\w+)\s+(.+)\s*$/) {

            my ($param_name, $param_value) = ($1, $2);
            $ldap_params{$param_name} = $param_value;
            #print "$param_name: $ldap_params{$param_name}\n";
        }
        #we skip the blank line
        elsif ($_ =~ /^\s*$/) {
            next;
        } else {
            print STDERR "Unknown syntax in config file $manager_conf_file\n"
                and return 0;
        }

    }

}

## Initialize the LDAP connection
sub initialize_ldap {

    if ($ldap_ssl eq '1') {
        unless (
            $ldap_connection = Net::LDAPS->new(
                $ldap_host,
                version    => 3,
                verify     => ($ldap_cachain ? 'require' : 'none'),
                sslversion => $ldap_ssl_version,
                ($ldap_cachain ? (cafile => $ldap_cachain) : ())
            )
        ) {
            printf STDERR
                "Can't connect to LDAP server using SSL or unable to verify Server certificate for %s: %s\n",
                $ldap_host, $EVAL_ERROR;
            return 0;
        }
    } else {
        unless ($ldap_connection = Net::LDAP->new($ldap_host, version => 3)) {
            print STDERR
                "Can't connect to LDAP server $ldap_host: $EVAL_ERROR\n";
            return 0;
        }
    }

    my $msg =
        $ldap_connection->bind($ldap_bind_dn, password => $ldap_bind_pwd);
    if ($msg->is_error()) {
        print STDERR "Can't bind to server $ldap_host: ", $msg->error(), "\n";
        return 0;
    }

    return 1;
}

## Close the LDAP connection
sub finalize_ldap {
    if (defined $ldap_connection) {
        $ldap_connection->unbind;
        $ldap_connection = undef;
    }
}

__END__

=encoding utf-8

=head1 NAME

ldap_alias_manager, ldap_alias_manager.pl - LDAP alias manager

=head1 DESCRIPTION

TBD.

=head1 FILES

=over

=item F<$SYSCONFDIR/ldap_alias_manager.conf>

Configuration file of ldap_alias_manager.

=item F<$SYSCONFDIR/ldap_alias_entry.tt2>

Template for ldap entries.

=back

=head1 SEE ALSO

alias_manager(8).

=head1 HISTORY

F<ldap_alias_manager> appeared on Sympa 5.2b2.

It was originally written by Philippe Baumgart, British Telecom.
And it was customized by
Ludovic Marcotte, Kazuo Moriwaka and Francis Lachapelle.

Philippe Baumgart added optional LDAPS support
and configuration stored in a separate config file F<ldap_alias_manager.conf>.

Roland Hopferwieser added template for entry definition
and simulation mode.

=cut
