Developers of Sympa

[Francis Lachapelle <address@concealed>]

Hi,

Almost two years ago, my good friend Ludovic Marcotte modified the
alias_manger.pl script to be fully LDAP-aware
(http://listes.cru.fr/sympa/arc/sympa-dev/2004-06/msg00001.html).

Kazuo Moriwaka seems to have modified the script to make it work with
Sympa 5.0.1
(http://listes.cru.fr/sympa/arc/sympa-dev/2005-07/msg00008.html).
However, it seems that his patched script was not attached to his
message nor added to the contributed software page.

I attached to this message a new version of this script that works with
Sympa 5.1.2.

Comments are welcome!

Thanks,

Francis
#!/usr/bin/perl

$ENV{'PATH'} = '';

## Load Sympa.conf
use strict;
use lib '/usr/lib/sympa/bin';
use Conf;
use POSIX;
require "tools.pl";
require "tt2.pl";

use Net::LDAP;

unless (Conf::load('/etc/sympa.conf')) {
   print gettext("The configuration file /etc/sympa.conf contains errors.\n");
   exit(1);
}

## LDAP configuration
my $ldap_connection = undef;
my $ldap_host = "localhost";
my $ldap_search_base = "dc=example,dc=com";
my $ldap_bind_dn = "cn=admin,dc=example,dc=com";
my $ldap_bind_pw = "password";
my $ldap_mail_attribute = "mail";
my $ldap_sample_dn = "uid={ALIAS},ou=list,dc=example,dc=com";
my %ldap_attributes = ("objectClass" => ["top","person", "organizationalPerson", "inetOrgPerson", "qmailUser"],
		       "cn" => ['{ALIAS}'],
		       "sn" => ['{ALIAS}'],
		       "uid" => ['{ALIAS}'],
		       "deliveryProgramPath" => ['{COMMAND}']
		       );

my $default_domain;
my ($operation, $listname, $domain, $file) = @ARGV;


if (($operation !~ /^(add)|(del)$/) || ($#ARGV < 2)) {
    printf "Usage: $0 <add|del> <listname> <domain> [<file>]\n";
    exit(2);
}

$default_domain = $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{'is_default_domain'} = 1 if ($domain eq $default_domain);
my @aliases ;

my $tt2_include_path = [$Conf{'etc'}.'/'.$domain,
                        $Conf{'etc'},
                        '/usr/share/sympa'];

my $aliases_dump;
&tt2::parse_tt2(\%data, 'list_aliases.tt2',\$aliases_dump, $tt2_include_path);

@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) {
	if ($alias =~ /^\#/) {
	    next;
	}
	
	$alias =~ /^([^:]+):\s*(\".*\")$/;
	my $alias_value = $1;
	my $command_value = $2;

	if ($command_value =~ m/bouncequeue/) {
	    $command_value = "sympabounce";
	} else{
	    $command_value = "sympa";
	} 

	# We create the new LDAP entry.
        my $entry = Net::LDAP::Entry->new;
	
	# We add the required mail attribute
	$entry->add($ldap_mail_attribute, $alias_value."\@".$domain);
	
	# We substitute all occurences 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;

	# We set the dn
	my $value = $ldap_sample_dn;
	$value =~ s/{ALIAS}/$alias_value/;
	$entry->dn($value);

	# We add the rest of the attributes
	foreach my $hash_key (keys %ldap_attributes) {
	    foreach my $hash_value (@{$ldap_attributes{$hash_key}}) {
		$value = $hash_value;
		$value =~ s/{ALIAS}/$alias_value/;
		$value =~ s/{COMMAND}/$command_value/;
		$entry->add($hash_key, $value);
	    }
	}

	# 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;
    }

    &finalize_ldap;

}
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 =~ /^([^:]+):/; 
	my $alias_value = $1;
	$alias_value =~ s/\+/\-/g;

	my $value = $ldap_sample_dn;
	$value =~ s/{ALIAS}/$alias_value/;
	$ldap_connection->delete($value);
    }

    &finalize_ldap;
}
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 =~ /^([^:]+):/;

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

## Initialize the LDAP connection
sub initialize_ldap {
    unless ($ldap_connection = Net::LDAP->new($ldap_host), version => 3) {
	print STDERR "Can't connect to LDAP server $ldap_host: $@\n";
	return 0;
    }
    
    my $msg = $ldap_connection->bind($ldap_bind_dn, password => $ldap_bind_pw);
    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;
    }
}