diff -r 59c7146ec6f0 -r 66bf85163780 account.pm.rej
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/account.pm.rej	Fri Feb 21 11:56:39 2014 +0100
@@ -0,0 +1,530 @@
+--- account.pm	Mon Mar 02 13:51:24 2009 +0000
++++ account.pm	Thu Dec 15 16:08:16 2011 +0100
+@@ -118,257 +129,342 @@
+ 
+     verbose("\t$dn...");
+ 
+-    $r = $ldap->search(base => $ubase, filter => "(uid=$user)");
++    $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;
++    if ( $r->count ) {
++        $e = $r->shift_entry;
+     } else {
+-	$e = new Net::LDAP::Entry;
+-	$e->dn($dn);
++        $e = new Net::LDAP::Entry;
++        $e->dn($dn);
+     }
+ 
+-    if ($e->exists("mail") || $e->exists(AT_PRIMARYADDRESS) || $e->exists("userPassword")) {
+-	verbose "exists\n";
++    if (   $e->exists("mail")
++        || $e->exists(AT_PRIMARYADDRESS)
++        || $e->exists("userPassword") )
++    {
++        verbose "exists\n";
+     } else {
+-    FORCE:
++      FORCE:
+ 
+-	# Bevor wir ans Werk gehen, noch ein paar Tests (mailPrimaryAddress und mail 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;
+-	}
++        # Bevor wir ans Werk gehen, noch ein paar Tests (mailPrimaryAddress und mail 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->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((AT_FORWARDINGADDRESS) => $mailForwardingAddress) if @$mailForwardingAddress;
++        $e->add( (AT_ADDRESS)        => $mailAddress );
++        $e->add( (AT_PRIMARYADDRESS) => $mailPrimaryAddress );
++        $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( (AT_ACLGROUPS) => $Cf->imap_aclgroups ) if $Cf->imap_aclgroups;
+ 
+-	# $e->add(iusRestrictedMail => $Cf->internal) if $Cf->internal ne ":";
++        # $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);
++        $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;
+ 
+-	$r = $e->update($ldap);
+-	die $r->error if $r->code;
+-
+-	verbose("ok");
+-	verbose(" Password: $pw") if not $Cf->password or $Cf->password eq "{pwgen}";
++        verbose('ok');
++        verbose(" Password: $pw")
++          if not $Cf->password
++              or $Cf->password eq "{pwgen}";
+     }
+ 
+-    if($Cf->mbox) {
+-	verbose("\n\t$mbox...");
++    if ( $Cf->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\t$mbox...");
++
++        if ( -d $mbox ) {
++
++            verbose('exists')
++
++        } elsif ( ( $imap->login( $user, $pw ) or die $@ )
++            and $imap->capability->{acl} )
++        {
++
++            # wenn wir acl verwenden,
++            #  * dann triggert 'list' acl file (und damit maildir) erzeugung
++            #    bei dovecot
++            #  * müssen wir dem master nutzer ausdrücklich rechte gewähren
++            #  (sofern wir das nicht eleganter über globale acl regeln können)
++            #    (lra: sicht-, les- und administrierbar)
++            my $f = $imap->list( '', '*' ) or die $@;
++
++            #$imap->setacl( $f->[0]->[2], $Cf->imap_admin, 'lra' ) or die $@;
++            verbose('ok');
++
++        } else {
++
++            verbose('will be created automatically on first email delivery');
++
++        }
++
+     }
+ 
+-
+     verbose("\n");
+ }
+ 
+ sub _modify() {
+-# Auch hier gehen wir davon aus, daß die dn direkt aus dem User-Namen folgt:
+-# dn: uid=USER,...
++
++    # 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) . ")");
++    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;
++    while ( my $e = $r->shift_entry ) {
++        my $r;
+ 
+-	my $user = $e->get_value("uid");
+-	my $dn = $e->dn;
+-	my $mbox = "user/$user";
++        my $user = $e->get_value("uid");
++        my $dn   = $e->dn;
+ 
+-	my $modified = 0;
+-	verbose "$user:";
++        my $modified = 0;
++        verbose "$user:";
+ 
+-	verbose "\n\t$dn...";
++        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");
+-	#}
++        # 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 ( my $cn = $Cf->fullname ) {
+ 
+-	    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++;
+-	}
++            # Aus dem Fullnamen leiten wir cn und sn ab.
++            my $sn = ( reverse split " ", $cn )[0];
+ 
+-	if (defined $Cf->other) {
+-	    my @o = split /,/, $Cf->other;
+-	    grep { /^[+-]/ } @o or $e->delete(AT_ADDRESS);
++            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++;
++        }
+ 
+-	    foreach my $a (split /,/, $Cf->other) {
+-		if ($a =~ s/^-//) { 
+-		    $e->delete((AT_ADDRESS) => [$a]) 
+-		} else {
+-		    $a =~ s/^\+//;
++        if ( defined $Cf->other ) {
++            my @o = split /,/, $Cf->other;
++            grep { /^[+-]/ } @o or $e->delete(AT_ADDRESS);
+ 
+-		    # 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;
++            foreach my $a ( split /,/, $Cf->other ) {
++                if ( $a =~ s/^-// ) {
++                    $e->delete( (AT_ADDRESS) => [$a] );
++                } else {
++                    $a =~ s/^\+//;
+ 
+-		    $e->add((AT_ADDRESS) => [$a]) 
+-		}
+-	    }
+-	    $modified++;
+-	}
++                    # 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;
+ 
+-	if (defined $Cf->group) {
+-	    my @g = split /,/, $Cf->group;
+-	    grep { /^[+-]/ } @g or $e->delete(AT_GROUP)
+-		if $e->get_value(AT_GROUP);
++                    $e->add( (AT_ADDRESS) => [$a] );
++                }
++            }
++            $modified++;
++        }
+ 
+-	    foreach my $g (@g) {
+-		if ($g =~ s/^-//) {
+-		    $e->delete((AT_GROUP) => [$g])
+-		} else {
+-		    $g =~ s/^\+//;
+-		    $e->add((AT_GROUP) => [$g])
+-		}
+-	    }
+-	    $modified++;
+-	}
++        if ( defined $Cf->group ) {
++            my @g = split /,/, $Cf->group;
++            grep { /^[+-]/ } @g
++              or $e->delete(AT_GROUP)
++              if $e->get_value(AT_GROUP);
+ 
+-	if (defined $Cf->forward) {
+-	    my @f = split /,/, $Cf->forward;
+-	    grep { /^[+-]/ } @f or $e->delete(AT_FORWARDINGADDRESS)
+-		if $e->get_value(AT_FORWARDINGADDRESS);
++            foreach my $g (@g) {
++                if ( $g =~ s/^-// ) {
++                    $e->delete( (AT_GROUP) => [$g] );
++                } else {
++                    $g =~ s/^\+//;
++                    $e->add( (AT_GROUP) => [$g] );
++                }
++            }
++            $modified++;
++        }
+ 
+-	    foreach my $f (@f) {
+-		if ($f =~ s/^-//) {
+-		    $e->delete((AT_FORWARDINGADDRESS) => [$f]);
+-		} else {
+-		    $f =~ s/^\+//;
+-		    $e->add((AT_FORWARDINGADDRESS) => [$f]);
+-		}
+-	    }
+-	    $modified++;
+-	}
++        if ( defined $Cf->forward ) {
++            my @f = split /,/, $Cf->forward;
++            grep { /^[+-]/ } @f
++              or $e->delete(AT_FORWARDINGADDRESS)
++              if $e->get_value(AT_FORWARDINGADDRESS);
+ 
+-	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++;
+-	}
++            foreach my $f (@f) {
++                if ( $f =~ s/^-// ) {
++                    $e->delete( (AT_FORWARDINGADDRESS) => [$f] );
++                } else {
++                    $f =~ s/^\+//;
++                    $e->add( (AT_FORWARDINGADDRESS) => [$f] );
++                }
++            }
++            $modified++;
++        }
+ 
+-	if (my $pw = _mkpw($Cf->password)) {
+-	    $e->replace(userPassword => $pw);
+-	    $modified++;
+-	}
++        if ( defined $Cf->quota ) {
++            $e->replace( (AT_QUOTA) => $Cf->quota );
++            $modified++;
++        }
+ 
+-	#if ($Cf->internal ne ":") {
+-	    #$e->replace(iusRestrictedMail => $Cf->internal ? "TRUE" : "FALSE");
+-	    #$modified++;
+-	#}
++        if ( defined $Cf->aclgroups ) {
+ 
+-	$e->dump if $Cf->debug;
++            my $ag = $Cf->aclgroups;
++            my $lag = $e->get_value(AT_ACLGROUPS); 
++            # groups should be supplied with leading '$' for consistency with
++            # dovecots imap acl, but should not be saved in ldap with it!
++            $ag =~ s/(^|,[+-]?)\K\$//g;
+ 
+-	if ($modified) {
+-	    $r = $e->update($ldap);
+-	    die $r->error.$r->code if $r->code;
+-	}
++            if ( $ag =~ /(^|,\s*)[+-]/ ) {
++                my %x;
++                @x{ split /,/, $lag } = ();
++                for ( split /,/, $ag ) {
++                    if (s/^-//) {
++                        delete $x{$_};
++                    } else {
++                        s/^\+//;
++                        $x{$_} = undef;
++                    }
++                }
+ 
+-	# 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 $@;
+-	}
++                $ag = join ',', sort keys %x;
+ 
+-	verbose "ok\n";
++            }
+ 
+-	print "\n";
++            if ($ag) {
++                $e->replace( (AT_ACLGROUPS) => $ag );
++            } else {
++                $e->delete( AT_ACLGROUPS ) if $lag;
++            }
++            $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;
++        }
++
++        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 = ($_);
++    # 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";
+ 
+-    foreach (@ARGV) {
+-	my $user = $_;
+-	my $dn = "uid=$user,$ubase";
+-	my $mbox = "user/$user";
++        verbose("$user:\n");
+ 
+-	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] );
+ 
+-	# 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 }
++        }
+ 
+-	    my $r = $e->update($ldap);
+-	    if ($r->code == 0) { verbose("ok\n") } 
+-	    else { die $r->error }
+-	}
++        verbose("\tdeleting $dn...");
++        $r = $ldap->delete($dn);
+ 
+-	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 ($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);
+-	}
++        if ( $Cf->mbox ) {
++            my $m = _mbox($user);
++            if ( not( defined $m and $m ) ) {
++                verbose("can't determine mbox location - not deleting it");
++            } else {
++                verbose("\tdeleting $m...");
++                verbose( ( remove_tree $m) ? 'ok' : " Can't remove '$m': $!" );
++            }
++        }
+ 
+-	verbose("\n");
++        print
++          "Don't forget to remove acl entries for this user if any exist!\n";
++        verbose("\n");
+ 
+     }
+ }