diff -r 000000000000 -r 2a5f2464f8c6 account.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/account.pm Fri Nov 04 06:29:26 2005 +0000 @@ -0,0 +1,415 @@ +package account; +# © Heiko Schlittermann +# $Id$ +# $URL$ + +use strict; +use warnings; +use Net::LDAP; +use Net::LDAP::Constant qw(LDAP_ALREADY_EXISTS LDAP_NO_SUCH_OBJECT LDAP_TYPE_OR_VALUE_EXISTS); +use Net::LDAP::Entry; +use Cyrus::IMAP::Admin; +use Text::Wrap; +use password; + + +my $Cf; +my ($ldap, $ubase, $abase); +my ($imap); +END { $imap and $imap = undef; }; + + +sub _add(); +sub _list(); +sub _delete(); +sub _mkpw($); +sub uniq(@); +sub verbose(@); + +sub OU_ACCOUNTS(); +sub OU_ALIASES(); +sub AT_PRIMARYADDRESS(); +sub OC_RECIPIENT(); +sub AT_ADDRESS(); +sub AT_GROUP(); +sub AT_FORWARDINGADDRESS(); + +sub import(@) { + $Cf = shift; + + require constant; + import constant OU_ACCOUNTS => $Cf->ldap_ou_accounts; + import constant OU_ALIASES => $Cf->ldap_ou_aliases; + import constant OC_RECIPIENT => $Cf->ldap_oc_recipient; + import constant AT_PRIMARYADDRESS => $Cf->ldap_at_primaryaddress; + import constant AT_ADDRESS => $Cf->ldap_at_address; + import constant AT_GROUP => $Cf->ldap_at_group; + import constant AT_FORWARDINGADDRESS => $Cf->ldap_at_forwardingaddress; + + $ubase = OU_ACCOUNTS . "," . $Cf->ldap_base; + $abase = OU_ALIASES . "," . $Cf->ldap_base; +} + +sub run($) { + # Eigentlich brauchen wir für alles imap und 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; + + $imap = new Cyrus::IMAP::Admin or die $@; + $imap->authenticate(-server => $Cf->imap_server, -user => $Cf->imap_admin, + -password => $Cf->imap_password || $ENV{IMAP_PASS} || password::ask("IMAP (". $Cf->imap_admin .") password: ")) + or die $@; + + + 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() { +# Beim Hinzufügen tragen wir nur das unbedingt notwendige +# ein. Wenn es schon eine mailPrimaryAddress gibt oder eine +# mail, machen wir gar nichts. +# Ansonsten: +# uid wird hinzugefügt +# cn, sn bleiben unangetastet +# Wenn die mailbox-Option gesetzt ist, wird die +# IMAP-Mailbox angelegt. + + + die "Need user name for creation\n" if not @ARGV; + my $user = shift @ARGV; + my $mbox = "user/$user"; + my $cn = $Cf->fullname || $user; + my $sn = (reverse split " ", $cn)[0]; + my $mailPrimaryAddress = $Cf->primary || $user; + my $mailAddress = [$user, split /,/, $Cf->other || ""]; + my $mailGroup = [split /,/, $Cf->group || ""]; + my $pw = _mkpw($Cf->password || "{pwgen}"); + + + my $dn = "uid=$user,$ubase"; + my $r; + + verbose("$user:\n"); + + verbose("\t$dn..."); + + $r = $ldap->search(base => $ubase, filter => "(uid=$user)"); + die $r->error if $r->code; + die "Multiple entries not expected" if $r->count > 1; + + my $e; + if ($r->count) { + $e = $r->shift_entry; + } else { + $e = new Net::LDAP::Entry; + $e->dn($dn); + } + + if ($e->exists("mail") || $e->exists(AT_PRIMARYADDRESS) || $e->exists("userPassword")) { + verbose "exists\n"; + } else { + + # Bevor wir ans Werk gehen, noch ein paar Tests (mailPrimaryAddress und mail darf + # darf noch nicht vergeben sein) + foreach my $a ($mailPrimaryAddress, @$mailAddress) { + $a =~ s/!$// and next; # wenn ein ! am Ende steht, dann ist es so gewollt und wird + # nicht geprüft + $r = $ldap->search(filter => "(mail=$a)", base => $ubase); + die $r->error if $r->code; + die "$a ist schon vergeben\n" if $r->count; + } + + $e->replace(objectClass => [uniq $e->get("objectClass"), qw/uidObject person/, OC_RECIPIENT]); + $e->replace(uid => [uniq $e->get("uid"), $user]); + + $e->add((AT_ADDRESS) => $mailAddress); + $e->add((AT_PRIMARYADDRESS) => $mailPrimaryAddress); + $e->add(userPassword => $pw); + $e->add((AT_GROUP) => $mailGroup) if @$mailGroup; + # $e->add(iusRestrictedMail => $Cf->internal) if $Cf->internal ne ":"; + + $e->exists("sn") or $e->add(sn => $sn); + $e->exists("cn") or $e->add(cn => $cn); + + + $r = $e->update($ldap); + die $r->error if $r->code; + + verbose("ok"); + verbose(" Password: $pw") if not $Cf->password or $Cf->password eq "{pwgen}"; + } + + if($Cf->mbox) { + verbose("\n\t$mbox..."); + + if ($imap->list($mbox)) { verbose("exists") } + else { + $imap->create($mbox) and verbose("ok") or die $@; + $imap->setacl($mbox, $Cf->imap_admin => "lrswipcda") or die $@; + $imap->setquota($mbox, STORAGE => 1024 * $Cf->imap_quota) or die $@; + } + } + + + verbose("\n"); +} + +sub _modify() { +# Auch hier gehen wir davon aus, daß die dn direkt aus dem User-Namen folgt: +# dn: uid=USER,... + my (@users) = @ARGV or die "Need username(s)\n"; + my @dns; + + my $r = $ldap->search(base => $ubase, + filter => "(|" . join("", map { "(uid=$_)" } @ARGV) . ")"); + die $r->error if $r->code; + die "No entries found.\n" if $r->count == 0; + + while (my $e = $r->shift_entry) { + my $r; + + my $user = $e->get_value("uid"); + my $dn = $e->dn; + my $mbox = "user/$user"; + + my $modified = 0; + verbose "$user:"; + + verbose "\n\t$dn..."; + + # Fix: iusMailOptions wurde erst später eingeführt, bei Bedarf also hinzufügen + #if (!grep /^iusMailOptions$/, @{$e->get("objectClass")}) { + #$e->add(objectClass => "iusMailOptions"); + #} + + if (my $cn = $Cf->fullname) { + # Aus dem Fullnamen leiten wir cn und sn ab. + my $sn = (reverse split " ", $cn)[0]; + + if ($cn =~ s/^\+//) { + $e->replace( + cn => [uniq $e->get("cn"), $cn], + sn => [uniq $e->get("sn"), $sn]); + } elsif ($cn =~ s/^-//) { + $e->delete(cn => [$cn], sn => [$sn]); + } else { $e->replace(cn => $cn, sn => $sn); } + $modified++; + } + + if (defined $Cf->other) { + my @o = split /,/, $Cf->other; + grep { /^[+-]/ } @o or $e->delete(AT_ADDRESS); + + foreach my $a (split /,/, $Cf->other) { + if ($a =~ s/^-//) { + $e->delete((AT_ADDRESS) => [$a]) + } else { + $a =~ s/^\+//; + + # Darf noch nicht woanders sein + $r = $ldap->search(base => $ubase, filter => "(mail=$a)"); + die $r->error if $r->code; + die "$a ist schon vergeben\n" if $r->count; + + $e->add((AT_ADDRESS) => [$a]) + } + } + $modified++; + } + + if (defined $Cf->group) { + my @g = split /,/, $Cf->group; + grep { /^[+-]/ } @g or $e->delete(AT_GROUP); + + foreach my $g (@g) { + if ($g =~ s/^-//) { + $e->delete((AT_GROUP) => [$g]) + } else { + $g =~ s/^\+//; + $e->add((AT_GROUP) => [$g]) + } + } + $modified++; + } + + if (my $a = $Cf->primary) { + $r = $ldap->search(base => $ubase, + # filter => "(|(mailPrimaryAddress=$a)(mail=$a))"); + filter => "(mail=$a)"); + die $r->error if $r->code; + die "$a ist schon vergeben\n" if $r->count; + + $e->replace((AT_PRIMARYADDRESS) => $Cf->primary); + $modified++; + } + + if (my $pw = _mkpw($Cf->password)) { + $e->replace(userPassword => $pw); + $modified++; + } + + #if ($Cf->internal ne ":") { + #$e->replace(iusRestrictedMail => $Cf->internal ? "TRUE" : "FALSE"); + #$modified++; + #} + + $e->dump if $Cf->debug; + + if ($modified) { + $r = $e->update($ldap); + die $r->error.$r->code if $r->code; + } + + # FIXME: Wenn keine Mailbox existiert, gibt es hier ein Problem + if (defined $Cf->imap_quota) { + $imap->setquota($mbox, STORAGE => $Cf->imap_quota * 1024) + or die $@; + } + + verbose "ok\n"; + + print "\n"; + } +} + +sub _delete() { +# Wir gehen davon aus, daß es einen dn uid=USER,ou=.... gibt, den wir löschen können. +# Wir löschen den kompletten Container. Es kann natürlich sein, daß er noch jemand anders gehört. +# Dann ist das Pech. Um es besser zu haben, müßten wir für alles unsere eigenen +# Objektklassen haben... + + if (!@ARGV) { + print "User: "; + chomp($_ = <>); + @ARGV = ($_); + } + + + foreach (@ARGV) { + my $user = $_; + my $dn = "uid=$user,$ubase"; + my $mbox = "user/$user"; + + verbose("$user:\n"); + + # Nachsehen, ob es noch aliase gibt, in denen dieser Nutzer steht: + my $r = $ldap->search(base => $abase, + filter => "(".AT_FORWARDINGADDRESS."=$_)", + attrs => ["mail", AT_FORWARDINGADDRESS]); + while (my $e = $r->shift_entry) { + verbose("\tdeleting $user from alias ".$e->get_value("mail")."..."); + $e->delete((AT_FORWARDINGADDRESS) => [$user]); + + my $r = $e->update($ldap); + if ($r->code == 0) { verbose("ok\n") } + else { die $r->error } + } + + verbose("\tdeleting $dn..."); + $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"); + + if ($Cf->mbox) { + verbose("\tdeleting mbox $mbox..."); + $imap->delete($mbox) and verbose("ok") + or verbose($imap->error); + } + + verbose("\n"); + + } +} + +sub _list() { + my $filter; + @ARGV = ("*") unless @ARGV; + $filter = "(|" . join("", map { "(uid=$_)" } @ARGV) . ")"; + + my $r = $ldap->search( + filter => $filter, + base => $ubase, + attrs => [qw/uid cn mail userPassword/] + ); + die $r->error if $r->code; + + + while (my $e = $r->shift_entry) { + my $uid = $e->get_value("uid"); + my $cn = join(", ", $e->get_value("cn")); + my $mr = $e->get_value(AT_PRIMARYADDRESS) || "??"; + my $ml = join(", ", $e->get_value(AT_ADDRESS)) || "??"; + my $mg = join(", ", $e->get_value(AT_GROUP)) || "??"; + my $mbox = "user/$uid"; + + print "$uid: $cn <$mr>"; + + #if (($e->get_value("iusRestrictedMail")||"") eq "TRUE") { + #print " INTERNAL"; + #} + + MBOX: { + if (!$imap->list($mbox)) { + print ", no mbox"; + last MBOX; + } + print ", mbox"; + my %q = $imap->listquota($mbox); + my ($used, $max) = map { int($_ / 1024) } @{$q{STORAGE}}; + + if (!$max) { + print ", no quota"; + last MBOX; + } + print ", quota ($used/$max): " . int(100 * $used/$max) . "%"; + } + print "\n"; + + print "\tPassword: ", $> == 0 ? $e->get_value("userPassword") : "*", "\n"; + + print wrap("\t", "\t\t", "Local Adresses: $ml\n") if $ml; + print wrap("\t", "\t\t", "Mail Groups: $mg\n") if $mg; + + } +} + +sub verbose(@) { + printf STDERR @_; +} + +sub uniq(@) { + my %x; + @x{@_} = (); + return keys %x; +} + +{ my @pw; +sub _mkpw($) { + my $in = $_[0]; + + return $in unless $in and $in eq "{pwgen}"; + + if (!@pw) { + chomp(@pw = `pwgen 8 10 2>/dev/null|| mkpasswd`); + die "pwgen/mkpasswd: $!" if $?; + } + return shift @pw; + +} } + +1; +# vim:sts=4 sw=4 aw ai sm nohlsearch: