ius/mailAdmin: comparison account.pm

equal deleted inserted replaced

-:cc9a80eb647c
+:a0ed03bc2e1d
 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 Mail::IMAPTalk;
 use Text::Wrap;
 use password;
 my $Cf;
 my ($ldap, $ubase, $abase);
-my ($imap);
+my ($imap, $imap_password);
 END { $imap and $imap = undef; };
 sub _add();
 sub _list();
 sub AT_PRIMARYADDRESS();
 sub OC_RECIPIENT();
 sub AT_ADDRESS();
 sub AT_GROUP();
 sub AT_FORWARDINGADDRESS();
+sub AT_QUOTA();
 sub import(@) {
 $Cf = shift;
 require constant;
 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;
+import constant AT_QUOTA => $Cf->ldap_at_quota;
 $ubase = OU_ACCOUNTS . "," . $Cf->ldap_base;
 $abase = OU_ALIASES . "," . $Cf->ldap_base;
 }
 $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 = Mail::IMAPTalk->new(Server => $Cf->imap_server, Port => $Cf->imap_port)
-$imap->authenticate(-server => $Cf->imap_server, -user => $Cf->imap_admin,
+or die "Can't connect to IMAP Server '", $Cf->imap_server, "', Port '", $Cf->imap_port, "': ", $@;
-	-password => $Cf->imap_password || $ENV{IMAP_PASS} || password::ask("IMAP (". $Cf->imap_admin .") password: "))
+$imap_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() }
 my $user = shift @ARGV;
 my $mailPrimaryAddress = $Cf->primary || $user;	    # evtl. mit !
 my $mailAddress = [$user, split /,/, $Cf->other || ""]; # ditto
 $user =~ s/!$//;					    # jetzt können wir ! nicht mehr brauchn
-my $mbox = "user/$user";
 my $cn = $Cf->fullname || $user;
 my $sn = (reverse split " ", $cn)[0];
 my $mailGroup = [split /,/, $Cf->group || ""];
 my $mailForwardingAddress = [split /,/, $Cf->forward || ""];
 my $pw = _mkpw($Cf->password || "{pwgen}");
+# assuming usernames of the form localpart@domain
+$user =~ /@(.+)$/;
+my $escapes;
+die "Invalid username '$user'" unless $escapes->{'%u'} = $user
+and $escapes->{'%1'} = substr $user, 0, 1
+and $escapes->{'%d'} = $1;
+my $mbox = $Cf->imap_mail_location;
+$mbox =~ s/$_/$escapes->{$_}/ for keys %{$escapes};
 if ($mailPrimaryAddress !~ /@/) {
 	$mailPrimaryAddress .= "@" . $Cf->default_domain;
 }
 	$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(userPassword => "{plain}$pw");
 	$e->add((AT_GROUP) => $mailGroup) if @$mailGroup;
 	$e->add((AT_FORWARDINGADDRESS) => $mailForwardingAddress) if @$mailForwardingAddress;
+	$e->add((AT_QUOTA) => $Cf->imap_quota);
 	# $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('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") }
+	if (-d $mbox) { verbose('exists') }
 	else {
-	    $imap->create($mbox) and verbose("ok") or die $@;
-	    $imap->setacl($mbox, $Cf->imap_admin => "lrswipcda") or die $@;
+$imap->login($user, $pw) or die $@;
-	    $imap->setquota($mbox, STORAGE => 1024 * $Cf->imap_quota) or die $@;
+# 'list' seems to trigger acl file (and thus the maildir) creation with dovecot
-	}
+$imap->list('', '*') or die $@;
-}
+verbose('ok');
+	}
+}
 verbose("\n");
 }
 sub _modify() {
 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...";
 	    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)
+#	    $imap->setquota($mbox, STORAGE => $Cf->imap_quota * 1024)
-	    or die $@;
+#	    or die $@;
 	}
 	verbose "ok\n";
 	print "\n";
 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,
 	    die $r->error;
 	}
 	verbose("\n");
 	if ($Cf->mbox) {
-	    verbose("\tdeleting mbox $mbox...");
+verbose("\tdeleting mbox for $user...");
-	    $imap->delete($mbox) and verbose("ok")
+my $m = user_dovecot( 'LOGIN' )->{'home'};
-	    or verbose($imap->error);
+if (not (defined $m and $m)) { verbose("can't determine mbox location - not deleting it"); }
+elsif (not unlink $m) { verbose("Can't unlink $m: $!"); }
+else { verbose('ok'); }
 	}
 	verbose("\n");
 }
 	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 $forw = join (", ", $e->get_value(AT_FORWARDINGADDRESS)) || "";
-	my $mbox = "user/$uid";
 	print "$uid: $cn <$mr>";
 	#if (($e->get_value("iusRestrictedMail")||"") eq "TRUE") {
 	    #print " INTERNAL";
 	#}
+$imap->login("$uid*" . $Cf->imap_admin, $imap_password ) or die $@;
 	MBOX: {
-	    if (!$imap->list($mbox)) {
+	    if (!$imap->list()) {
 		print ", no mbox";
 		last MBOX;
 	    }
 	    print ", mbox";
-	    my %q = $imap->listquota($mbox);
+	    my %q = $imap->listquota();
 	    my ($used, $max) = map { int($_ / 1024) } @{$q{STORAGE}};
 	    if (!$max) {
 		print ", no quota";
 		last MBOX;

branch	foerste
changeset 41	a0ed03bc2e1d
parent 23	72ba031fec20
child 42	b90dc89e8c66