--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/alias.pm	Fri Nov 04 06:29:26 2005 +0000
@@ -0,0 +1,215 @@
+package alias;
+# © Heiko Schlittermann
+# $Id$
+# $URL$
+
+use strict;
+use warnings;
+use Net::LDAP;
+use Net::LDAP::Constant qw(
+    LDAP_ALREADY_EXISTS 
+    LDAP_NO_SUCH_OBJECT
+    LDAP_NO_SUCH_ATTRIBUTE
+    LDAP_TYPE_OR_VALUE_EXISTS);
+use Net::LDAP::Entry;
+use Text::Wrap;
+
+use password;
+
+my $Cf;
+my ($ldap, $abase);
+
+sub _add();
+sub _list();
+sub _delete();
+sub uniq(@);
+sub verbose(@);
+sub columns();
+
+sub OU_ALIASES();
+sub OC_ALIAS();
+sub AT_FORWARDINGADDRESS();
+
+sub import(@) {
+    $Cf = shift;
+
+    require constant;
+    import constant OU_ALIASES => $Cf->ldap_ou_aliases;
+    import constant OC_ALIAS => $Cf->ldap_oc_alias;
+    import constant AT_FORWARDINGADDRESS => $Cf->ldap_at_forwardingaddress;
+
+    $abase = OU_ALIASES . "," . $Cf->ldap_base;
+}
+
+sub run($) {
+    # Eigentlich brauchen wir für alles ldap
+    $ldap = new Net::LDAP $Cf->ldap_server or die;
+    my $r = $ldap->bind($Cf->ldap_bind_dn,
+	password => $Cf->ldap_password || $ENV{LDAP_PASS} || password::ask("LDAP (". $Cf->ldap_bind_dn .") password: "));
+    die $r->error, "\n" if $r->code;
+
+
+    if ($Cf->list) { _list() }
+    elsif ($Cf->add) { _add() }
+    elsif ($Cf->delete) { _delete() }
+    elsif ($Cf->modify) { _modify() }
+    else { die "Need action (--add|--modify|--list|--delete)\n" };
+
+}
+
+sub _add() {
+# Wenn's den Alias schon gibt, wird er nicht mehr
+# angelegt
+
+    die "Need alias name for creation\n" if not @ARGV;
+    die "Need members\n" if not defined $Cf->members;
+    my $alias = shift @ARGV;
+    my @members = split /,/, $Cf->members;
+    my $dn = "mail=$alias,$abase";
+
+    my $r;
+
+    verbose("$alias:\n");
+    verbose("\t$dn...");
+
+    $r = $ldap->search(base => $abase, filter => "(mail=$alias)");
+    die $r->error if $r->code;
+    die "Multiple entries not expected" if $r->count > 1;
+    
+    $r = $ldap->add($dn, attrs => [
+	objectClass => OC_ALIAS,
+	mail => $alias,
+	(AT_FORWARDINGADDRESS) => \@members
+    ]);
+    if ($r->code == LDAP_ALREADY_EXISTS) { verbose "exists" }
+    elsif ($r->code) { die $r->error } 
+    else { verbose "ok" }
+
+    verbose("\n");
+}
+
+sub _modify() {
+# Auch hier gehen wir davon aus, daß die dn direkt aus dem Alias-Namen folgt:
+# dn: cn=USER,...
+# Jetzt behandeln wir lediglich die Modifikation auf Basis eines
+# alias-Namens!
+
+    my (@users) = @ARGV or die "Need alias names(s)\n";
+    my @members = split /,/, $Cf->members;
+    my @add = grep { s/^\+// } @_ = @members;
+    my @del = grep { s/^-// } @_ = @members;
+    my @set = grep { !/^[\+-]/ } @members;
+
+
+    foreach my $alias (@ARGV) {
+	my $dn = "mail=$alias,$abase";
+	verbose "$alias:";
+
+	my $r = $ldap->search(base => $abase, filter => "(mail=$alias)");
+	die $r->error if $r->code;
+
+	if ($r->count == 0) {
+	    verbose " not found\n";
+	    next;
+	}
+
+	while (my $e = $r->shift_entry) {
+
+	    verbose "\n\t" . $e->dn . " ";
+
+	    if (@set) {
+		$e->replace((AT_FORWARDINGADDRESS) => \@set);
+	    } else {
+		@add and $e->replace((AT_FORWARDINGADDRESS) => [uniq $e->get(AT_FORWARDINGADDRESS), @add]);
+		@del and $e->delete((AT_FORWARDINGADDRESS) => \@del);
+	    }
+
+	    $e->dump if $Cf->debug;
+
+	    my $r = $e->update($ldap);
+	    if ($r->code == LDAP_NO_SUCH_ATTRIBUTE) {
+		verbose "no member";
+	    } elsif ($r->code) {
+		die $r->error . "/" . $r->code;
+	    }  else {
+		verbose "ok";
+	    }
+	}
+
+	print "\n";
+    }
+}
+
+sub _delete() {
+# Wir gehen davon aus, daß es einen dn mail=ALIAS,ou=MailAliases,...
+# gibt und löschen diesen gnadenlos.
+
+    if (!@ARGV) {
+	print "User: ";
+	chomp($_ = <>);
+	@ARGV = ($_);
+    }
+
+    foreach (@ARGV) {
+	my $dn = "mail=$_,$abase";
+
+	verbose("$_:\n");
+	verbose("\tdeleting $dn...");
+	my $r = $ldap->delete($dn);
+
+	if ($r->code == LDAP_NO_SUCH_OBJECT) {
+	    verbose("doesn't exist");
+	} elsif ($r->code == 0) {
+	    verbose("ok");
+	} else {
+	    die $r->error;
+	}
+	
+	verbose("\n");
+
+    }
+}
+
+sub _list() {
+    my $filter;
+    @ARGV = ("*") unless @ARGV;
+    $filter = "(|" . join("", map { "(mail=$_)" } @ARGV) . ")";
+
+    my $r = $ldap->search(
+	filter => $filter,
+	base => $abase,
+	attrs => [qw/mail/, AT_FORWARDINGADDRESS],
+    );
+
+    die $r->error if $r->code;
+
+    $Text::Wrap::columns = columns() || 80;
+
+    while (my $e = $r->shift_entry) {
+	my $mail = $e->get("mail");
+
+	print wrap("", "\t", $e->get_value("mail") 
+	    . ": "
+	    . join(", ", $e->get(AT_FORWARDINGADDRESS))
+	    . "\n");
+	    
+    }
+}
+
+sub verbose(@) {
+    printf STDERR @_;
+}
+
+sub uniq(@) {
+    my %x;
+    @x{@_} = ();
+    return keys %x;
+}
+
+sub columns() {
+    `stty -a` =~ /columns\s+(\d+)/;
+    $1;
+}
+
+1;
+# vim:sts=4 sw=4 aw ai sm: