1#!--PERL--
2# -*- indent-tabs-mode: nil; -*-
3# vim:ft=perl:et:sw=4
4# $Id$
5
6# Sympa - SYsteme de Multi-Postage Automatique
7#
8# Copyright 2017 The Sympa Community. See the AUTHORS.md file at the top-level
9# directory of this distribution and at
10# <https://github.com/sympa-community/sympa.git>.
11#
12# This program is free software; you can redistribute it and/or modify
13# it under the terms of the GNU General Public License as published by
14# the Free Software Foundation; either version 2 of the License, or
15# (at your option) any later version.
16#
17# This program is distributed in the hope that it will be useful,
18# but WITHOUT ANY WARRANTY; without even the implied warranty of
19# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
20# GNU General Public License for more details.
21#
22# You should have received a copy of the GNU General Public License
23# along with this program.  If not, see <http://www.gnu.org/licenses/>.
24
25use strict;
26use warnings;
27use lib split(/:/, $ENV{SYMPALIB} || ''), '--modulesdir--';
28use English qw(-no_match_vars);
29use Net::LDAP;
30use Net::LDAP::Entry;
31use Net::LDAPS;
32use POSIX;
33
34use Conf;
35use Sympa::Constants;
36use Sympa::Crash;    # Show traceback.
37use Sympa::Template;
38
39$ENV{'PATH'} = '';
40
41## Load Sympa.conf
42unless (Conf::load(Sympa::Constants::CONFIG)) {
43    print gettext("The configuration file contains errors.\n");
44    exit(1);
45}
46
47my $manager_conf_file = $Conf::Conf{etc} . '/ldap_alias_manager.conf';
48
49## LDAP configuration
50my %ldap_params;
51my ($ldap_host,       $ldap_base_dn,        $ldap_bind_dn,
52    $ldap_bind_pwd,   $ldap_mail_attribute, $ldap_objectclasses,
53    $ldap_cachain,    $ldap_ssl,            $ldap_ssl_version,
54    $queue_transport, $bouncequeue_transport
55);
56GetLdapParameter();
57
58my $ldap_connection = undef;
59$ldap_host = $ldap_params{'ldap_host'}
60    or print STDERR
61    "Missing required parameter ldap_host in the config file $manager_conf_file\n"
62    and exit 0;
63$ldap_base_dn = $ldap_params{'ldap_base_dn'}
64    or print STDERR
65    "Missing required parameter ldap_base_dn in the config file $manager_conf_file\n"
66    and exit 0;
67$ldap_bind_dn = $ldap_params{'ldap_bind_dn'}
68    or print STDERR
69    "Missing required parameter ldap_bind_dn in the config file $manager_conf_file\n"
70    and exit 0;
71$ldap_bind_pwd = $ldap_params{'ldap_bind_pwd'}
72    or print STDERR
73    "Missing required parameter ldap_bind_pwd in the config file $manager_conf_file\n"
74    and exit 0;
75$ldap_mail_attribute = $ldap_params{'ldap_mail_attribute'}
76    or print STDERR
77    "Missing required parameter ldap_mail_attribute in the config file $manager_conf_file\n"
78    and exit 0;
79(($ldap_ssl = $ldap_params{'ldap_ssl'}) ne '')
80    or print STDERR
81    "Missing required parameter ldap_ssl (possible value: 0 or 1) in the config file $manager_conf_file\n"
82    and exit 0;
83
84$ldap_ssl_version = lc($ldap_params{'ldap_ssl_version'} || '');
85unless ($ldap_ssl_version) {
86    $ldap_ssl_version = $ldap_ssl ? 'tlsv1' : undef;
87} elsif ($ldap_ssl_version !~ /\A(sslv2|sslv3|tlsv1|tlsv1_[123])\z/) {
88    printf STDERR
89        "Invalid parameter ldap_ssl_version in the config file %s\n",
90        $manager_conf_file;
91    exit 0;
92}
93
94$ldap_cachain = $ldap_params{'ldap_cachain'} or undef;
95$queue_transport = $ldap_params{'queue_transport'}
96    or print STDERR
97    "Missing required parameter queue_transport in the config file $manager_conf_file\n"
98    and exit 0;
99$bouncequeue_transport = $ldap_params{'bouncequeue_transport'}
100    or print STDERR
101    "Missing required parameter bouncequeue_transport in the config file $manager_conf_file\n"
102    and exit 0;
103
104my $default_domain;
105
106# Check for simulation mode
107my $simulation_mode = 0;
108if (grep(/^-s$/, @ARGV)) {
109    $simulation_mode = 1;
110    @ARGV = grep(!/^-s$/, @ARGV);
111}
112my ($operation, $listname, $domain, $file) = @ARGV;
113
114if (($operation !~ /^(add|del)$/) || ($#ARGV < 2)) {
115    printf "Usage: $0 <add|del> <listname> <domain> [<file>]\n";
116    printf "\n";
117    printf "  Options:\n";
118    printf
119        "    -s\tSimulation mode. Dump the entries but don't add it to the directory.\n";
120    exit(2);
121}
122
123$default_domain = $Conf::Conf{'domain'};
124
125my %data;
126$data{'date'} = POSIX::strftime("%d %b %Y", localtime(time));
127$data{'list'}{'domain'} = $data{'robot'} = $domain;
128$data{'list'}{'name'}   = $listname;
129$data{'default_domain'} = $default_domain;
130$data{'ldap_base_dn'}   = $ldap_base_dn;
131$data{'is_default_domain'} = 1 if ($domain eq $default_domain);
132$data{'return_path_suffix'} =
133    Conf::get_robot_conf($domain, 'return_path_suffix');
134my @aliases;
135
136my $aliases_dump;
137my $template = Sympa::Template->new($domain);
138unless ($template->parse(\%data, 'list_aliases.tt2', \$aliases_dump)) {
139    print STDERR "Can't parse list_aliases.tt2\n";
140    exit 15;
141}
142
143@aliases = split /\n/, $aliases_dump;
144
145unless (@aliases) {
146    print STDERR "No aliases defined\n";
147    exit(15);
148}
149
150if ($operation eq 'add') {
151
152## Check existing aliases
153    if (already_defined(@aliases)) {
154        print STDERR "some alias already exist\n";
155        exit(13);
156    }
157
158    if (!initialize_ldap()) {
159        print STDERR "Can't bind to LDAP server\n";
160        exit(14);
161    }
162
163    foreach my $alias (@aliases) {
164        next if ($alias =~ /^\#/);
165        next if ($alias =~ /^\s*$/);
166
167        $alias =~ /^([^\s:]+)[\s:]+\"\s*\|\s*(.*)\s+(.*)\s*\"$/;
168        my $alias_value   = $1;
169        my $command_value = $2;
170        my $maildrop      = $3;
171
172        if ($command_value =~ m/bouncequeue/) {
173            $command_value = $bouncequeue_transport;
174        } else {
175            $command_value = $queue_transport;
176        }
177
178        # We substitute all occurrences of + by - for the rest of the
179        # attributes, including the dn.
180        # The rationale behind this is that the "uid" attribute prevents the
181        # use of the '+' character.
182        $alias_value =~ s/\+/\-/g;
183
184        my $ldif_dump;
185        $data{'list'}{'alias'}    = $alias_value;
186        $data{'list'}{'command'}  = $command_value;
187        $data{'list'}{'maildrop'} = $maildrop;
188        unless ($template->parse(\%data, 'ldap_alias_entry.tt2', \$ldif_dump))
189        {
190            print STDERR "Can't parse ldap_alias_entry.tt2\n";
191            exit 15;
192        }
193        my @attribute_lines = split /\n/, $ldif_dump;
194
195        # We create the new LDAP entry.
196        my %ldap_attributes = ();
197        my $entry           = Net::LDAP::Entry->new;
198        foreach my $line (@attribute_lines) {
199            next if ($line =~ /^\s*$/);
200            next if ($line =~ /^\s*\#/);
201            $line =~ /^([^:]+):\s*(.+)\s*$/;
202            if ($1 eq 'dn') {
203                $entry->dn($2);
204            } else {
205                push @{$ldap_attributes{$1}}, $2;
206            }
207        }
208
209        # We add the the attributes
210        foreach my $hash_key (keys %ldap_attributes) {
211            foreach my $hash_value (@{$ldap_attributes{$hash_key}}) {
212                $entry->add($hash_key, $hash_value);
213            }
214        }
215
216        if ($simulation_mode) {
217            $entry->dump;
218        } else {
219            # We finally add the entry
220            my $msg = $ldap_connection->add($entry);
221            if ($msg->is_error()) {
222                print STDERR "Can't add entry for $alias_value\@$domain: ",
223                    $msg->error(), "\n";
224                exit(15);
225            }
226        }
227        $entry = undef;
228    }    # end foreach aliases
229
230    finalize_ldap();
231
232}    # end if add
233elsif ($operation eq 'del') {
234
235    if (!initialize_ldap()) {
236        print STDERR "Can't bind to LDAP server\n";
237        exit(7);
238    }
239
240    foreach my $alias (@aliases) {
241        if ($alias =~ /^\#/) {
242            next;
243        }
244
245        $alias =~ /^([^\s:]+)[\s:]/;
246        my $alias_value = $1;
247        $alias_value =~ s/\+/\-/g;
248
249        my $ldif_dump;
250        $data{'list'}{'alias'} = $alias_value;
251        unless ($template->parse(\%data, 'ldap_alias_entry.tt2', \$ldif_dump))
252        {
253            print STDERR "Can't parse ldap_alias_entry.tt2\n";
254            exit 15;
255        }
256        my $value = (grep(/^dn:/, split(/\n/, $ldif_dump)))[0];
257        $value =~ s/^dn:\s*//;
258
259        if ($simulation_mode) {
260            printf "Would delete dn $value\n";
261        } else {
262            $ldap_connection->delete($value);
263        }
264    }    # end foreach aliases
265
266    finalize_ldap();
267}    # end if del
268else {
269    print STDERR "Action $operation not implemented yet\n";
270    exit(2);
271}
272
273exit 0;
274
275## Check if an alias is already defined
276sub already_defined {
277
278    my @aliases = @_;
279
280    initialize_ldap();
281
282    foreach my $alias (@aliases) {
283
284        $alias =~ /^([^\s:]+)[\s:]/;
285
286        my $source_result = $ldap_connection->search(
287            filter => "("
288                . $ldap_mail_attribute . "="
289                . $1 . "\@"
290                . $domain . ")",
291            base => $ldap_base_dn
292        );
293        if ($source_result->count != 0) {
294            print STDERR "Alias already defined : $1\n";
295            finalize_ldap();
296            return 1;
297        }
298    }
299
300    finalize_ldap();
301    return 0;
302}
303
304## Parse the alias_ldap.conf config file
305sub GetLdapParameter {
306    #read the config file
307    open(LDAPCONFIG, $manager_conf_file)
308        or print STDERR "Can't read the config file $manager_conf_file\n"
309        and return 0;
310    my @ldap_conf = <LDAPCONFIG>;
311    close LDAPCONFIG;
312    foreach (@ldap_conf) {
313        #we skip the comments
314        if ($_ =~ /^\s*\#/) {
315            next;
316        } elsif ($_ =~ /^\s*(\w+)\s+(.+)\s*$/) {
317
318            my ($param_name, $param_value) = ($1, $2);
319            $ldap_params{$param_name} = $param_value;
320            #print "$param_name: $ldap_params{$param_name}\n";
321        }
322        #we skip the blank line
323        elsif ($_ =~ /^\s*$/) {
324            next;
325        } else {
326            print STDERR "Unknown syntax in config file $manager_conf_file\n"
327                and return 0;
328        }
329
330    }
331
332}
333
334## Initialize the LDAP connection
335sub initialize_ldap {
336
337    if ($ldap_ssl eq '1') {
338        unless (
339            $ldap_connection = Net::LDAPS->new(
340                $ldap_host,
341                version    => 3,
342                verify     => ($ldap_cachain ? 'require' : 'none'),
343                sslversion => $ldap_ssl_version,
344                ($ldap_cachain ? (cafile => $ldap_cachain) : ())
345            )
346        ) {
347            printf STDERR
348                "Can't connect to LDAP server using SSL or unable to verify Server certificate for %s: %s\n",
349                $ldap_host, $EVAL_ERROR;
350            return 0;
351        }
352    } else {
353        unless ($ldap_connection = Net::LDAP->new($ldap_host, version => 3)) {
354            print STDERR
355                "Can't connect to LDAP server $ldap_host: $EVAL_ERROR\n";
356            return 0;
357        }
358    }
359
360    my $msg =
361        $ldap_connection->bind($ldap_bind_dn, password => $ldap_bind_pwd);
362    if ($msg->is_error()) {
363        print STDERR "Can't bind to server $ldap_host: ", $msg->error(), "\n";
364        return 0;
365    }
366
367    return 1;
368}
369
370## Close the LDAP connection
371sub finalize_ldap {
372    if (defined $ldap_connection) {
373        $ldap_connection->unbind;
374        $ldap_connection = undef;
375    }
376}
377
378__END__
379
380=encoding utf-8
381
382=head1 NAME
383
384ldap_alias_manager, ldap_alias_manager.pl - LDAP alias manager
385
386=head1 DESCRIPTION
387
388TBD.
389
390=head1 FILES
391
392=over
393
394=item F<$SYSCONFDIR/ldap_alias_manager.conf>
395
396Configuration file of ldap_alias_manager.
397
398=item F<$SYSCONFDIR/ldap_alias_entry.tt2>
399
400Template for ldap entries.
401
402=back
403
404=head1 SEE ALSO
405
406alias_manager(8).
407
408=head1 HISTORY
409
410F<ldap_alias_manager> appeared on Sympa 5.2b2.
411
412It was originally written by Philippe Baumgart, British Telecom.
413And it was customized by
414Ludovic Marcotte, Kazuo Moriwaka and Francis Lachapelle.
415
416Philippe Baumgart added optional LDAPS support
417and configuration stored in a separate config file F<ldap_alias_manager.conf>.
418
419Roland Hopferwieser added template for entry definition
420and simulation mode.
421
422=cut
423