diff -r 6cb38b11a354 -r c853cc971b78 shared.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/shared.pm Wed Dec 07 05:14:27 2005 +0000 @@ -0,0 +1,298 @@ +package shared; +# © 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. +# Die IMAP-Mailbox wird angelegt. + + + die "Need mailbox name for creation\n" if not @ARGV; + my $mbox = shift @ARGV; + + verbose("shared mbox:\n"); + + 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) + if $e->get_value(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() { + + if (!@ARGV) { + print "Mailbox: "; + chomp($_ = <>); + @ARGV = ($_); + } + + foreach my $mbox (@ARGV) { + + if ($Cf->mbox) { + verbose("\tdeleting mbox $mbox..."); + $imap->delete($mbox) and verbose("ok") + or verbose($imap->error); + } + + verbose("\n"); + } + +} + +sub _list() { + @ARGV = ("*") unless @ARGV; + + foreach (@ARGV) { + my @mboxes = $imap->list($_); + + foreach (@mboxes) { + my ($mbox, $attr, $sep) = @$_; + next if $mbox =~ /^user$sep/; + + print "$mbox: shared mailbox"; + + # Quota + my %q = $imap->listquota($mbox); + my ($used, $max) = map { int($_ / 1024) } @{$q{STORAGE}}; + + if (!$max) { + print ", no quota"; + } else { + print ", quota ($used/$max): " . int(100 * $used/$max) . "%"; + } + print "\n"; + + # ACL + my %acl = $imap->listacl($mbox); + foreach (sort keys %acl) { + print "\t$_: $acl{$_}\n"; + } + } + + } +} + +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: