Implement LDAP aliases for mailman

* backend/Makefile.PL: Add sv_mailman_ldap
* backend/mail/sv_mailman_ldap: New file. This is temporary. It is
planned to merge with sv_mailman at some point.

2 files changed, 699 insertions, 0 deletions

diff --git a/backend/Makefile.PL b/backend/Makefile.PL
index 8cc1c5c..84bb042 100644
--- a/backend/Makefile.PL
+++ b/backend/Makefile.PL
@@ -33,6 +33,7 @@ WriteMakefile(
 	'export/sv_export_cleaner', 
 
 	'mail/sv_mailman', 
+	'mail/sv_mailman_ldap', 
 	'mail/sv_aliases', 
 	'mail/sv_mailman_and_mailarchivedotcom', 
 
diff --git a/backend/mail/sv_mailman_ldap b/backend/mail/sv_mailman_ldap
new file mode 100644
index 0000000..c0b804c
--- /dev/null
+++ b/backend/mail/sv_mailman_ldap
@@ -0,0 +1,698 @@
+#! /usr/bin/perl
+# Copyright (C) 2004-2006 Mathieu Roy <yeupou@gnu.org>
+#                          BBN Technologies Corp
+# Copyrignt (C) 2005-2016 Sergey Poznyakoff <gray@gnu.org>
+#
+# 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 3, 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 Getopt::Long;
+use Savane;
+use Savane::Conf;
+use Savane::Backend;
+use Savane::LDAP;
+use File::Temp qw(tempfile);
+use File::Path qw(make_path remove_tree);
+use File::Copy;
+use File::Compare;
+use String::Random qw(random_string);
+use Text::Wrap;
+use IO::Handle;
+use feature 'state';
+use Symbol qw(gensym);
+
+my $skipmail;
+my $sync;
+backend_setup(descr => "maintain Mailman mailing lists in sync with the Savane database", 
+	      options => { 'skip-mail|no-mail' => \$skipmail,
+			   'sync' => \$sync,
+	      },
+	      cron => GetConf('backend.sv_mailman.cron'));
+
+my $sys_mailman_user = GetConf('backend.sv_mailman.user')
+    or abend(EX_CONFIG, 'backend.sv_mailman.user not set');
+my $sys_mailman_dir = GetConf('backend.sv_mailman.mailman_dir')
+    or abend(EX_CONFIG, 'backend.sv_mailman.mailman_dir not set');
+# FIXME REMOVE
+#my $sys_mailman_list_dir = GetConf('backend.sv_mailman.list_dir')
+#    or abend(EX_CONFIG, 'backend.sv_mailman.list_dir not set');
+# my $sys_mailman_archive_dir = GetConf('backend.sv_mailman.archive_dir')
+#     or abend(EX_CONFIG, 'backend.sv_mailman.archive_dir not set');
+my $sys_mail_domain = GetConf('mail.mail_domain')
+    or abend(EX_CONFIG, 'mail.mail_domain not set');
+my $sys_mailman_command = GetConf('backend.sv_mailman.mailman_command')
+    or abend(EX_CONFIG, 'backend.sv_mailman.mailman_command not set');
+my $sys_mail_aliases = GetConf('backend.sv_aliases.alias_file');
+my $sys_mailman_keep_archives = GetConf('backend.sv_mailman.keep_archives');
+    
+my $mailman_bin_dir = GetConf('backend.sv_mailman.mailman_bin_dir')
+    || "$sys_mailman_dir/bin";
+
+my $error_count;
+my $create_count = 0;
+my $delete_count = 0;
+my $reconf_count = 0;
+
+$Text::Wrap::columns = 72;
+
+my $ldap = new Savane::LDAP;
+
+my @mailman_ops = qw(post admin bounces confirm join leave owner request subscribe unsubscribe);
+
+sub alias_pairs {
+    my $list_name = shift;
+    map { [$_ eq "post" ? $list_name : "$list_name-$_", $_] } @mailman_ops;
+}
+
+sub create_aliases {
+    my $list_name = shift;
+    foreach my $p (alias_pairs($list_name)) {
+	unless ($ldap->getalias($p->[0])) {
+	    my $al = new Savane::LDAP::alias(
+	     name => $p->[0],
+             mem => [ "$sys_mailman_command $p->[1] $list_name" ]);
+	    debug("Adding alias $al");
+	    $ldap->chalias($al) unless dry_run();
+        }	    
+    }
+}
+
+sub remove_aliases {
+    my $list_name = shift;
+    foreach my $p (alias_pairs($list_name)) {
+	if (my $ent = $ldap->getalias($p->[0])) {
+	    debug("Removing $ent");
+	    $ldap->delete($ent) unless dry_run();
+	}
+    }
+}
+
+sub config_list {
+    my $list = shift;
+    my $descr = $list->{description};
+    if ($descr =~ /[ \"\\]/) {
+	$descr =~ s/[\"\\]/\\$&/g;
+    }
+    my @vars = ( "description=\"$descr\"",
+		 'require_explicit_destination=0',
+		 'private_roster=2' );
+    if ($list->{is_public}) {
+	push @vars, 'archive_private=0', 'advertised=1', 'subscribe_policy=1';
+    } else {
+	push @vars, 'archive_private=1', 'advertised=0', 'subscribe_policy=3';
+    }
+	
+    return runcommand("$mailman_bin_dir/sv_config_list",
+		      $list->{name},
+		      @vars);
+}
+
+my %existing_lists;
+
+sub mailman_get_lists {
+    open(my $fd, '-|', "$mailman_bin_dir/list_lists", '-b')
+	or abend(EX_OSERR, "can't run $mailman_bin_dir/list_lists: $!");
+    while (<$fd>) {
+	chomp;
+	$existing_lists{$_} = $_;
+    }
+    close($fd);
+}
+
+# ####
+
+# FIXME!
+# my (undef,undef,$uid,$gid) = getpwnam($sys_mailman_user) 
+#     or abend(EX_NOUSER, "no such user: $sys_mailman_user");
+
+# FIXME: it's remote
+# abend(EX_OSFILE, "directory $mailman_bin_dir doesn't exist")
+#     unless -d $mailman_bin_dir;
+
+#abend(EX_OSFILE, "directory $sys_mailman_list_dir doesn't exist")
+#    unless -d $sys_mailman_list_dir;
+
+AcquireReplicationLock('aliases.lock');
+
+# Run as mailman user
+# FIXME!
+# if ($< == 0) {
+#     $) = $gid;
+#     $> = $uid;
+# } elsif ($< != $uid) {
+#     abend(EX_USAGE, "must be run as root or $sys_mailman_user");
+# }
+
+# #########################################################################
+## Note about status of list:
+##   - Status 0: list is deleted (ie, does not exist).
+##   - Status 1: list is marked for creation.
+##   - Status 2: list is marked for reconfiguration.
+##   - Status 5: list has been created (ie, it exists).
+##
+##   The frontend php script sets status to:
+##      0 if user deletes a list before the backend ever actually created it.
+##      1 if user adds a list
+##      2 if user reconfigures an _existing_ list (ie, status was 5)
+##
+##   This backend script sets status to:
+##      0 when a list is actually deleted
+##      5 when a list is actually created
+
+my $sync_query = q{SELECT m.list_name AS name,
+                          t.mailing_list_virtual_host AS virtual_host
+                   FROM mail_group_list AS m, group_type AS t, groups AS g
+		   WHERE m.status = '5'
+                     AND g.group_id = m.group_id
+                     AND t.type_id = g.type};
+
+sub mailman_sync_ldap {
+    my $list = shift;
+
+    my $name = $list->{name};
+    $name .= '@'.$list->{virtual_host}
+	if (defined($list->{virtual_host}) && $list->{virtual_host} ne '');
+    delete $existing_lists{$name};
+    create_aliases($name);
+}
+
+if ($sync) {
+    mailman_get_lists();
+    db_foreach(\&mailman_sync_ldap, $sync_query);
+    foreach my $name (keys %existing_lists) {
+	create_aliases($name);
+    }
+    exit(0);
+}
+
+
+my $newlist_query = qq{SELECT m.list_name AS name,
+       m.is_public AS is_public,
+       m.password AS password,
+       m.description AS description,
+       t.mailing_list_virtual_host AS virtual_host,
+       u.email AS admin,
+       group_concat(u1.email) AS group_admins
+FROM mail_group_list AS m, group_type AS t, groups AS g,
+     user AS u, user AS u1, user_group ug
+WHERE m.status IN('0','1')
+  AND g.group_id = m.group_id
+  AND t.type_id = g.type
+  AND u.user_id = m.list_admin
+  AND ug.group_id = g.group_id
+  AND ug.admin_flags='A'
+  AND ug.user_id = u1.user_id
+  GROUP BY 1};
+
+sub mailman_list_create {
+    my $list = shift;
+
+    return unless defined $list->{name};
+
+    $list->{complete_name} = $list->{name};
+    $list->{complete_name} .= '@'.$list->{virtual_host}
+	if (defined($list->{virtual_host}) && $list->{virtual_host} ne '');
+
+    debug("creating list $list->{name}: $list->{complete_name}");
+    unless (runcommand("$mailman_bin_dir/newlist -q $list->{complete_name} $list->{admin} $list->{password}")) {
+	++$error_count;
+	return;
+    }
+    create_aliases($list->{complete_name});
+
+    # FIXME: Not needed. mboxsync uses os.makedirs, which recursively creates
+    # all intermediate dirs.
+    
+    # my $dir = "$sys_mailman_archive_dir/$list->{name}";
+    # debug("creating $dir");
+    # unless (dry_run()) {
+    # 	make_path($dir, { mode => 02775 })
+    # 	    or do {
+    # 		++$error_count;
+    # 		logit('err', "can't create $dir: $!");
+    # 		return;
+    # 	};
+    # }
+
+    debug("configuring list $list->{name}");
+    unless (config_list($list)) {
+	++$error_count;
+	return;
+    }
+
+    unless ($skipmail) {
+	my ($name, $pass) = ($list->{name}, $list->{password});
+	debug("sending mail to $list->{group_admins} for list $list->{name}");
+	my $mail = <<EOT;
+Hello,
+
+You requested the creation of the list $name at $sys_mail_domain.
+
+The list administrator password of the newly created list is:
+    
+    $pass
+
+You are advised to change the password, and to avoid at any cost using 
+a password you use for others important account, as mailman does not
+really provide security for these list passwords.
+
+Regards
+EOT
+;
+	MailSend("", $list->{group_admins}, "Mailman list $name", $mail)
+	    unless dry_run();
+    }
+
+    SetDBSettings("mail_group_list",
+		  'list_name=?',
+		  "status='5', password=NULL",
+                  $list->{name}) unless dry_run();
+
+    logit('info', "list $list->{name} <$list->{admin}> created");
+    $create_count++;
+}
+
+my $remove_query = qq{SELECT group_list_id AS id, list_name AS name
+FROM mail_group_list
+WHERE status!='0' AND is_public='9'
+};
+
+sub mailman_list_remove {
+    my $list = shift;
+
+    debug("deleting list $list->{name}");
+    my @args;
+    push @args, '-a' unless $sys_mailman_keep_archives;
+    push @args, $list->{name};
+    unless (runcommand("$mailman_bin_dir/rmlist", @args)) {
+	++$error_count;
+	return;
+    }
+
+    # FIXME!!!
+    # unless ($sys_mailman_keep_archives) {
+    # 	my $dir = "$sys_mailman_archive_dir/$list->{name}";
+    # 	debug("removing $dir");
+    # 	unless (dry_run()) {
+    # 	    my $err;
+    # 	    remove_tree($dir, { error => \$err });
+    # 	    if (@$err) {
+    # 		for my $diag (@$err) {
+    # 		    ++$error_count;
+    # 		    my ($file, $message) = %$diag;
+    # 		    if ($file eq '') {
+    # 			logit('err', $message);
+    # 		    } else {
+    # 			logit('err', "can't unlink $file: $message");
+    # 		    }
+    # 		}
+    # 	    }
+    # 	}
+    # }
+    
+    remove_aliases($list->{name});
+    DeleteDB("mail_group_list", "group_list_id='$list->{id}'")
+	unless dry_run();
+
+    logit('info', "list $list->{name} deleted");
+    $delete_count++;
+}    
+
+my $reconf_query = qq{SELECT group_list_id AS id,
+    list_name AS name,
+    is_public,
+    description
+FROM mail_group_list
+WHERE status='2' AND is_public!='9'};
+
+sub mailman_list_reconf {
+    my $list = shift;
+    
+    debug("configuring list $list->{name}");
+    unless (config_list($list)) {
+	++$error_count;
+	return;
+    }
+
+    SetDBSettings("mail_group_list",
+		  'group_list_id=?',
+		  "status='5'",
+                  $list->{id}) unless dry_run();
+    logit('info', "list $list->{name} reconfigured");
+    ++$reconf_count;
+}    
+
+my $pwreset_query = qq{SELECT mail_group_list.group_list_id AS id,
+     mail_group_list.list_name AS name,
+     group_concat(user.email) AS admin
+FROM mail_group_list, user, user_group, groups
+WHERE mail_group_list.password = '1'
+  AND groups.group_id = mail_group_list.group_id
+  AND user_group.group_id = groups.group_id
+  AND user_group.admin_flags='A'
+  AND user_group.user_id = user.user_id};
+
+sub mailman_list_pwreset {
+    my $list = shift;
+		      
+    return unless defined $list->{name};
+    debug("resetting password on $list->{name} for $list->{admin}");
+    # Create a new password, random enough, with not too weird characters
+    my $password = random_string("ssssssss");
+    
+    unless (runcommand("$mailman_bin_dir/change_pw",
+		       "-l",
+		       $list->{name},
+		       "-p",
+		       $password,
+		       "--quiet")) {
+	++$error_count;
+	return;
+    }
+
+    SetDBSettings("mail_group_list",
+		  'group_list_id=?',
+		  'password=NULL', $list->{id}) unless dry_run();
+
+    logit('info', "list $list->{name} password was reset");
+
+         # Send a mail giving the password
+    unless ($skipmail) {
+	my $mail = <<EOT;
+Hello,
+
+You requested the password of the list $list->{name} at $sys_mail_domain to be
+reset.
+
+The new list administrator password of this mailing list is:
+
+       $password 
+
+You are advised to change the password, and to avoid at any cost using 
+a password you use for others important account, as mailman does not
+really provide security for these list passwords.
+
+Regards
+EOT
+;
+	MailSend("", $list->{admin}, "Mailman list $list->{name}", $mail)
+	    unless dry_run();
+    }
+}
+
+####
+logit('info', 'creating new lists');
+db_foreach(\&mailman_list_create, $newlist_query);
+debug("total lists created: $create_count");
+
+logit('info', 'removing lists scheduled for deletion');
+db_foreach(\&mailman_list_remove, $remove_query);
+debug("total lists deleted: $delete_count");
+
+#################################################################
+### Reconfigure all lists marked for reconfiguration (status = 2), but
+### that have not been deleted.
+logit('info', 'reconfiguring lists');
+db_foreach(\&mailman_list_reconf, $reconf_query);
+debug("total lists reconfigured: $reconf_count");
+
+#################################################################
+### Reset passwords
+logit('info','resetting passwords');
+db_foreach(\&mailman_list_pwreset, $pwreset_query);
+
+#################################################################
+
+$) = 0; 
+$> = 0;
+
+logit('info', "statistics: created: $create_count, deleted: $delete_count, reconfigured: $reconf_count");
+if ($error_count) {
+    logit('err', "there were $error_count errors");
+    exit(EX_UNAVAILABLE);
+} 
+
+backend_done();
+
+=head1 NAME
+
+sv_mailman - maintain Mailman mailing lists in sync with the Savane database
+
+=head1 SYNOPSIS
+
+B<sv_mailman>]
+[B<-F> I<FACILITY>]
+[B<-dn>]
+[B<--cron>]
+[B<--debug>]
+[B<--dry-run>]
+[B<--facility=>I<FACILITY>]
+[B<--no-mail>]
+[B<--recreate>] 
+[B<--skip-mail>]
+[B<--stderr>]
+[B<--syslog>]
+
+B<sv_mailman> [B<-h>] [B<--help>]
+    
+=head1 DESCRIPTION
+
+Creates, deletes and modifies B<mailman>-driven mailing lists according
+to changes in the Savane database.
+
+The process runs in four stages:
+
+=over 4
+
+=item *
+    
+Creation of new lists.
+
+Lists marked with status 0 and 1 in the database are created.  For each
+list B<newaliases> is invoked to create it, the directory for html files
+is created under B<backend.sv_mailman.archive_dir> and a list alias file is
+created in B<backend.sv_mailman.list_dir>.  Administrators of the group for
+which the list is created are then notified via email about the fact.    
+    
+=item *
+
+Deletion of existing lists scheduled for removal.
+
+Each list is removed using B<rmlist>.  List alias file is removed.    
+Archive and html files are deleted, unless B<backend.sv_mailman.keep_archives>
+is set to B<1>.   
+
+=item *
+
+Modification of existing lists.
+
+For each list scheduled for modification, a temporary control file is
+created and B<config_list> is run.    
+
+=item *
+
+Resetting admin passwords for lists that requested it.
+
+=item *
+
+Updating of MTA alias file.
+
+Whereas all prior stages are performed with the privileges of mailman
+user (as set by the B<backend.sv_mailman.user> variable), this stage is run
+with superuser privileges.    
+    
+This stage depends on the B<backend.sv_mailman.directory_file> variable.  If
+it is not set, aliases from all list alias files are copied to the
+main alias file, specified by the B<backend.sv_aliases.alias_file> variable.
+Care is taken to preserve any existing entries, that do not belong to
+B<sv_mailman>.
+
+If B<backend.sv_mailman.directory_file> is set, a file named by its value
+is filled with the names of existing mailing lists (one per line).
+Unless the file name is absolute, it is taken relative to the
+B<backend.sv_mailman.list_dir> directory.  The previous content of the file is
+preserved in a backup, whose name is derived by appending a tilde to the
+original file name.  
+
+Finally, the command specified by the B<backend.sv_aliases.rebuild_command>
+variable is run.
+    
+=back    
+
+=head1 OPTIONS
+
+=over 8
+    
+=item B<--cron>
+
+Run only if the configuration variable B<backend.sv_mailman.cron> is set to
+B<yes>.  Implies B<--syslog>.
+    
+=item B<-d>, B<--debug>
+
+Increase debugging level.
+
+=item B<-n>, B<--dry-run>
+
+Do nothing, print everything.  Implies B<--debug>.
+
+=item B<-F>, B<--facility=>I<NAME>
+
+Log to the syslog facility I<NAME>.  If I<NAME> begins with a slash,
+it is understood as the name of the file where to direct the logging
+output.
+
+=item B<--no-mail>, B<--skip-mail>
+
+Do not send mail.    
+
+=item B<--recreate>
+
+Recreate MTA aliases even if there were no changes to the list system.    
+    
+=item B<--stderr>
+
+Log to standard error.  This is the default.
+    
+=item B<--syslog>
+
+Log to syslog.
+
+=back
+
+=head1 CONFIGURATION VARIABLES
+
+=over 4
+    
+=item B<sql.database>
+
+=item B<sql.user>
+
+=item B<sql.password>
+
+=item B<sql.host>
+
+=item B<sql.params>
+    
+Database credentials.    
+
+=item B<backend.sv_mailman.cron>
+
+This variable is consulted if B<sv_mailman> is run with the B<--cron>
+flag.  If it is B<1>, the program continues running.  If it is B<0>,
+it exits without actually doing anything.    
+    
+=item B<backend.sv_mailman.user>
+
+System name of the mailman user.    
+    
+=item B<backend.sv_mailman.mailman_dir>
+
+Mailman installation directory.
+    
+=item B<backend.sv_mailman.list_dir>
+
+Directory where created list alias files are kept.
+    
+=item B<backend.sv_mailman.archive_dir>
+
+This is where Mailman stores HTML versions of received mails.    
+    
+=item B<backend.sv_aliases.alias_file>
+
+Location of the alias file to update.  This variable can contain several
+file names, separated with spaces.  In this case, each of the files will
+be updated, but the rebuild program will be run only if the first file
+changed.
+    
+=item B<mail.mail_domain>
+
+Mail domain.
+    
+=item B<backend.sv_aliases.rebuild_command>
+
+Command to run if aliases were updated.  It will be executed with superuser
+privileges.    
+    
+=item B<backend.sv_mailman.keep_archives>
+
+If set to 1, B<sv_mailman> will not remove archives remaining after deletion
+of mailing lists.
+    
+=item B<backend.sv_mailman.directory_file>
+
+If not set, B<sv_mailman> will directly update system mail alias file,
+by inserting or removing statements corresponding to the mailing lists.
+    
+If set, B<sv_mailman> will not touch system alias file, but will, instead,
+write a list of list names to the file named by this variable.  Unless the
+value of this variable begins with a B</>, it is taken relative to
+B<backend.sv_mailman.list_dir> directory.
+    
+=back
+    
+=head1 EXIT CODES
+
+=over 8
+
+=item 0
+
+Successful termination.
+    
+=item 64
+
+Command line usage error.
+
+=item 66
+
+Cannot open input file.
+    
+=item 67
+
+User specified by the B<backend.sv_mailman.user> variable does not exist.
+
+=item 69
+
+One or more errors ocurred, but the program was able to proceed.
+    
+=item 71
+
+Execution of a B<mailman> utility failed.    
+    
+=item 72
+
+Required file or directory is missing
+    
+=item 73
+
+Can't create (user) output file.
+    
+=item 78
+
+Error in configuration file.
+
+=back
+
+=head1 SEE ALSO
+
+B<sv_aliases>(1),    
+Mailman: B<http://www.gnu.org/software/mailman/>.
+    
+=head1 AUTHOR
+
+Sergey Poznyakoff <gray@gnu.org>
+    
+=cut    
+    
+