account.pm.rej
branchfoerste-cms
changeset 72 66bf85163780
equal deleted inserted replaced
36:59c7146ec6f0 72:66bf85163780
       
     1 --- account.pm	Mon Mar 02 13:51:24 2009 +0000
       
     2 +++ account.pm	Thu Dec 15 16:08:16 2011 +0100
       
     3 @@ -118,257 +129,342 @@
       
     4  
       
     5      verbose("\t$dn...");
       
     6  
       
     7 -    $r = $ldap->search(base => $ubase, filter => "(uid=$user)");
       
     8 +    $r = $ldap->search( base => $ubase, filter => "(uid=$user)" );
       
     9      die $r->error if $r->code;
       
    10      die "Multiple entries not expected" if $r->count > 1;
       
    11  
       
    12      my $e;
       
    13 -    if ($r->count) {
       
    14 -	$e = $r->shift_entry;
       
    15 +    if ( $r->count ) {
       
    16 +        $e = $r->shift_entry;
       
    17      } else {
       
    18 -	$e = new Net::LDAP::Entry;
       
    19 -	$e->dn($dn);
       
    20 +        $e = new Net::LDAP::Entry;
       
    21 +        $e->dn($dn);
       
    22      }
       
    23  
       
    24 -    if ($e->exists("mail") || $e->exists(AT_PRIMARYADDRESS) || $e->exists("userPassword")) {
       
    25 -	verbose "exists\n";
       
    26 +    if (   $e->exists("mail")
       
    27 +        || $e->exists(AT_PRIMARYADDRESS)
       
    28 +        || $e->exists("userPassword") )
       
    29 +    {
       
    30 +        verbose "exists\n";
       
    31      } else {
       
    32 -    FORCE:
       
    33 +      FORCE:
       
    34  
       
    35 -	# Bevor wir ans Werk gehen, noch ein paar Tests (mailPrimaryAddress und mail darf
       
    36 -	# noch nicht vergeben sein)
       
    37 -	foreach my $a ($mailPrimaryAddress, @$mailAddress) {
       
    38 -	    $a =~ s/!$// and next;   # wenn ein ! am Ende steht, dann ist es so gewollt und wird
       
    39 -				     # nicht geprüft
       
    40 -	    $r = $ldap->search(filter => "(mail=$a)", base => $ubase);
       
    41 -	    die $r->error if $r->code;
       
    42 -	    die "$a ist schon vergeben\n" if $r->count;
       
    43 -	}
       
    44 +        # Bevor wir ans Werk gehen, noch ein paar Tests (mailPrimaryAddress und mail darf
       
    45 +        # noch nicht vergeben sein)
       
    46 +        foreach my $a ( $mailPrimaryAddress, @$mailAddress ) {
       
    47 +            $a =~ s/!$//
       
    48 +              and
       
    49 +              next;  # wenn ein ! am Ende steht, dann ist es so gewollt und wird
       
    50 +                     # nicht geprüft
       
    51 +            $r = $ldap->search( filter => "(mail=$a)", base => $ubase );
       
    52 +            die $r->error if $r->code;
       
    53 +            die "$a ist schon vergeben\n" if $r->count;
       
    54 +        }
       
    55  
       
    56 -	$e->replace(objectClass => [uniq $e->get("objectClass"), qw/uidObject person/, OC_RECIPIENT]);
       
    57 -	$e->replace(uid => [uniq $e->get("uid"), $user]);
       
    58 +        $e->replace(
       
    59 +            objectClass => [
       
    60 +                uniq $e->get("objectClass"),
       
    61 +                qw/uidObject person/,
       
    62 +                OC_RECIPIENT
       
    63 +            ]
       
    64 +        );
       
    65 +        $e->replace( uid => [ uniq $e->get("uid"), $user ] );
       
    66  
       
    67 -	$e->add((AT_ADDRESS) => $mailAddress);
       
    68 -	$e->add((AT_PRIMARYADDRESS) => $mailPrimaryAddress);
       
    69 -	$e->add(userPassword => $pw);
       
    70 -	$e->add((AT_GROUP) => $mailGroup) if @$mailGroup;
       
    71 -	$e->add((AT_FORWARDINGADDRESS) => $mailForwardingAddress) if @$mailForwardingAddress;
       
    72 +        $e->add( (AT_ADDRESS)        => $mailAddress );
       
    73 +        $e->add( (AT_PRIMARYADDRESS) => $mailPrimaryAddress );
       
    74 +        $e->add( userPassword => "{plain}$pw" );
       
    75 +        $e->add( (AT_GROUP) => $mailGroup ) if @$mailGroup;
       
    76 +        $e->add( (AT_FORWARDINGADDRESS) => $mailForwardingAddress )
       
    77 +          if @$mailForwardingAddress;
       
    78 +        $e->add( (AT_QUOTA) => $Cf->imap_quota );
       
    79 +        $e->add( (AT_ACLGROUPS) => $Cf->imap_aclgroups ) if $Cf->imap_aclgroups;
       
    80  
       
    81 -	# $e->add(iusRestrictedMail => $Cf->internal) if $Cf->internal ne ":";
       
    82 +        # $e->add(iusRestrictedMail => $Cf->internal) if $Cf->internal ne ":";
       
    83  
       
    84 -	$e->exists("sn") or $e->add(sn => $sn);
       
    85 -	$e->exists("cn") or $e->add(cn => $cn);
       
    86 +        $e->exists("sn") or $e->add( sn => $sn );
       
    87 +        $e->exists("cn") or $e->add( cn => $cn );
       
    88  
       
    89 +        $r = $e->update($ldap);
       
    90 +        die $r->error if $r->code;
       
    91  
       
    92 -	$r = $e->update($ldap);
       
    93 -	die $r->error if $r->code;
       
    94 -
       
    95 -	verbose("ok");
       
    96 -	verbose(" Password: $pw") if not $Cf->password or $Cf->password eq "{pwgen}";
       
    97 +        verbose('ok');
       
    98 +        verbose(" Password: $pw")
       
    99 +          if not $Cf->password
       
   100 +              or $Cf->password eq "{pwgen}";
       
   101      }
       
   102  
       
   103 -    if($Cf->mbox) {
       
   104 -	verbose("\n\t$mbox...");
       
   105 +    if ( $Cf->mbox ) {
       
   106  
       
   107 -	if ($imap->list($mbox)) { verbose("exists") }
       
   108 -	else {
       
   109 -	    $imap->create($mbox) and verbose("ok") or die $@;
       
   110 -	    $imap->setacl($mbox, $Cf->imap_admin => "lrswipcda") or die $@;
       
   111 -	    $imap->setquota($mbox, STORAGE => 1024 * $Cf->imap_quota) or die $@;
       
   112 -	}
       
   113 +        verbose("\n\t$mbox...");
       
   114 +
       
   115 +        if ( -d $mbox ) {
       
   116 +
       
   117 +            verbose('exists')
       
   118 +
       
   119 +        } elsif ( ( $imap->login( $user, $pw ) or die $@ )
       
   120 +            and $imap->capability->{acl} )
       
   121 +        {
       
   122 +
       
   123 +            # wenn wir acl verwenden,
       
   124 +            #  * dann triggert 'list' acl file (und damit maildir) erzeugung
       
   125 +            #    bei dovecot
       
   126 +            #  * müssen wir dem master nutzer ausdrücklich rechte gewähren
       
   127 +            #  (sofern wir das nicht eleganter über globale acl regeln können)
       
   128 +            #    (lra: sicht-, les- und administrierbar)
       
   129 +            my $f = $imap->list( '', '*' ) or die $@;
       
   130 +
       
   131 +            #$imap->setacl( $f->[0]->[2], $Cf->imap_admin, 'lra' ) or die $@;
       
   132 +            verbose('ok');
       
   133 +
       
   134 +        } else {
       
   135 +
       
   136 +            verbose('will be created automatically on first email delivery');
       
   137 +
       
   138 +        }
       
   139 +
       
   140      }
       
   141  
       
   142 -
       
   143      verbose("\n");
       
   144  }
       
   145  
       
   146  sub _modify() {
       
   147 -# Auch hier gehen wir davon aus, daß die dn direkt aus dem User-Namen folgt:
       
   148 -# dn: uid=USER,...
       
   149 +
       
   150 +    # Auch hier gehen wir davon aus, daß die dn direkt aus dem User-Namen folgt:
       
   151 +    # dn: uid=USER,...
       
   152      my (@users) = @ARGV or die "Need username(s)\n";
       
   153      my @dns;
       
   154  
       
   155 -    my $r = $ldap->search(base => $ubase, 
       
   156 -	filter => "(|" . join("", map { "(uid=$_)" } @ARGV) . ")");
       
   157 +    my $r = $ldap->search(
       
   158 +        base   => $ubase,
       
   159 +        filter => "(|" . join( "", map { "(uid=$_)" } @ARGV ) . ")"
       
   160 +    );
       
   161      die $r->error if $r->code;
       
   162      die "No entries found.\n" if $r->count == 0;
       
   163  
       
   164 -    while (my $e = $r->shift_entry) {
       
   165 -	my $r;
       
   166 +    while ( my $e = $r->shift_entry ) {
       
   167 +        my $r;
       
   168  
       
   169 -	my $user = $e->get_value("uid");
       
   170 -	my $dn = $e->dn;
       
   171 -	my $mbox = "user/$user";
       
   172 +        my $user = $e->get_value("uid");
       
   173 +        my $dn   = $e->dn;
       
   174  
       
   175 -	my $modified = 0;
       
   176 -	verbose "$user:";
       
   177 +        my $modified = 0;
       
   178 +        verbose "$user:";
       
   179  
       
   180 -	verbose "\n\t$dn...";
       
   181 +        verbose "\n\t$dn...";
       
   182  
       
   183 -	# Fix: iusMailOptions wurde erst später eingeführt, bei Bedarf also hinzufügen
       
   184 -	#if (!grep /^iusMailOptions$/, @{$e->get("objectClass")}) {
       
   185 -	    #$e->add(objectClass => "iusMailOptions");
       
   186 -	#}
       
   187 +        # Fix: iusMailOptions wurde erst später eingeführt, bei Bedarf also hinzufügen
       
   188 +        #if (!grep /^iusMailOptions$/, @{$e->get("objectClass")}) {
       
   189 +        #$e->add(objectClass => "iusMailOptions");
       
   190 +        #}
       
   191  
       
   192 -	if (my $cn = $Cf->fullname) {
       
   193 -	    # Aus dem Fullnamen leiten wir cn und sn ab.
       
   194 -	    my $sn = (reverse split " ", $cn)[0];
       
   195 +        if ( my $cn = $Cf->fullname ) {
       
   196  
       
   197 -	    if ($cn =~ s/^\+//) {
       
   198 -		$e->replace(
       
   199 -		    cn => [uniq $e->get("cn"), $cn], 
       
   200 -		    sn => [uniq $e->get("sn"), $sn]);
       
   201 -	    } elsif ($cn =~ s/^-//) {
       
   202 -		$e->delete(cn => [$cn], sn => [$sn]);
       
   203 -	    } else { $e->replace(cn => $cn, sn => $sn); }
       
   204 -	    $modified++;
       
   205 -	}
       
   206 +            # Aus dem Fullnamen leiten wir cn und sn ab.
       
   207 +            my $sn = ( reverse split " ", $cn )[0];
       
   208  
       
   209 -	if (defined $Cf->other) {
       
   210 -	    my @o = split /,/, $Cf->other;
       
   211 -	    grep { /^[+-]/ } @o or $e->delete(AT_ADDRESS);
       
   212 +            if ( $cn =~ s/^\+// ) {
       
   213 +                $e->replace(
       
   214 +                    cn => [ uniq $e->get("cn"), $cn ],
       
   215 +                    sn => [ uniq $e->get("sn"), $sn ]
       
   216 +                );
       
   217 +            } elsif ( $cn =~ s/^-// ) {
       
   218 +                $e->delete( cn => [$cn], sn => [$sn] );
       
   219 +            } else {
       
   220 +                $e->replace( cn => $cn, sn => $sn );
       
   221 +            }
       
   222 +            $modified++;
       
   223 +        }
       
   224  
       
   225 -	    foreach my $a (split /,/, $Cf->other) {
       
   226 -		if ($a =~ s/^-//) { 
       
   227 -		    $e->delete((AT_ADDRESS) => [$a]) 
       
   228 -		} else {
       
   229 -		    $a =~ s/^\+//;
       
   230 +        if ( defined $Cf->other ) {
       
   231 +            my @o = split /,/, $Cf->other;
       
   232 +            grep { /^[+-]/ } @o or $e->delete(AT_ADDRESS);
       
   233  
       
   234 -		    # Darf noch nicht woanders sein
       
   235 -		    $r = $ldap->search(base => $ubase, filter => "(mail=$a)");
       
   236 -		    die $r->error if $r->code;
       
   237 -		    die "$a ist schon vergeben\n" if $r->count;
       
   238 +            foreach my $a ( split /,/, $Cf->other ) {
       
   239 +                if ( $a =~ s/^-// ) {
       
   240 +                    $e->delete( (AT_ADDRESS) => [$a] );
       
   241 +                } else {
       
   242 +                    $a =~ s/^\+//;
       
   243  
       
   244 -		    $e->add((AT_ADDRESS) => [$a]) 
       
   245 -		}
       
   246 -	    }
       
   247 -	    $modified++;
       
   248 -	}
       
   249 +                    # Darf noch nicht woanders sein
       
   250 +                    $r = $ldap->search( base => $ubase, filter => "(mail=$a)" );
       
   251 +                    die $r->error if $r->code;
       
   252 +                    die "$a ist schon vergeben\n" if $r->count;
       
   253  
       
   254 -	if (defined $Cf->group) {
       
   255 -	    my @g = split /,/, $Cf->group;
       
   256 -	    grep { /^[+-]/ } @g or $e->delete(AT_GROUP)
       
   257 -		if $e->get_value(AT_GROUP);
       
   258 +                    $e->add( (AT_ADDRESS) => [$a] );
       
   259 +                }
       
   260 +            }
       
   261 +            $modified++;
       
   262 +        }
       
   263  
       
   264 -	    foreach my $g (@g) {
       
   265 -		if ($g =~ s/^-//) {
       
   266 -		    $e->delete((AT_GROUP) => [$g])
       
   267 -		} else {
       
   268 -		    $g =~ s/^\+//;
       
   269 -		    $e->add((AT_GROUP) => [$g])
       
   270 -		}
       
   271 -	    }
       
   272 -	    $modified++;
       
   273 -	}
       
   274 +        if ( defined $Cf->group ) {
       
   275 +            my @g = split /,/, $Cf->group;
       
   276 +            grep { /^[+-]/ } @g
       
   277 +              or $e->delete(AT_GROUP)
       
   278 +              if $e->get_value(AT_GROUP);
       
   279  
       
   280 -	if (defined $Cf->forward) {
       
   281 -	    my @f = split /,/, $Cf->forward;
       
   282 -	    grep { /^[+-]/ } @f or $e->delete(AT_FORWARDINGADDRESS)
       
   283 -		if $e->get_value(AT_FORWARDINGADDRESS);
       
   284 +            foreach my $g (@g) {
       
   285 +                if ( $g =~ s/^-// ) {
       
   286 +                    $e->delete( (AT_GROUP) => [$g] );
       
   287 +                } else {
       
   288 +                    $g =~ s/^\+//;
       
   289 +                    $e->add( (AT_GROUP) => [$g] );
       
   290 +                }
       
   291 +            }
       
   292 +            $modified++;
       
   293 +        }
       
   294  
       
   295 -	    foreach my $f (@f) {
       
   296 -		if ($f =~ s/^-//) {
       
   297 -		    $e->delete((AT_FORWARDINGADDRESS) => [$f]);
       
   298 -		} else {
       
   299 -		    $f =~ s/^\+//;
       
   300 -		    $e->add((AT_FORWARDINGADDRESS) => [$f]);
       
   301 -		}
       
   302 -	    }
       
   303 -	    $modified++;
       
   304 -	}
       
   305 +        if ( defined $Cf->forward ) {
       
   306 +            my @f = split /,/, $Cf->forward;
       
   307 +            grep { /^[+-]/ } @f
       
   308 +              or $e->delete(AT_FORWARDINGADDRESS)
       
   309 +              if $e->get_value(AT_FORWARDINGADDRESS);
       
   310  
       
   311 -	if (my $a = $Cf->primary) {
       
   312 -	    $r = $ldap->search(base => $ubase, 
       
   313 -		# filter => "(|(mailPrimaryAddress=$a)(mail=$a))");
       
   314 -		filter => "(mail=$a)");
       
   315 -	    die $r->error if $r->code;
       
   316 -	    die "$a ist schon vergeben\n" if $r->count;
       
   317 -    
       
   318 -	    $e->replace((AT_PRIMARYADDRESS) => $Cf->primary);
       
   319 -	    $modified++;
       
   320 -	}
       
   321 +            foreach my $f (@f) {
       
   322 +                if ( $f =~ s/^-// ) {
       
   323 +                    $e->delete( (AT_FORWARDINGADDRESS) => [$f] );
       
   324 +                } else {
       
   325 +                    $f =~ s/^\+//;
       
   326 +                    $e->add( (AT_FORWARDINGADDRESS) => [$f] );
       
   327 +                }
       
   328 +            }
       
   329 +            $modified++;
       
   330 +        }
       
   331  
       
   332 -	if (my $pw = _mkpw($Cf->password)) {
       
   333 -	    $e->replace(userPassword => $pw);
       
   334 -	    $modified++;
       
   335 -	}
       
   336 +        if ( defined $Cf->quota ) {
       
   337 +            $e->replace( (AT_QUOTA) => $Cf->quota );
       
   338 +            $modified++;
       
   339 +        }
       
   340  
       
   341 -	#if ($Cf->internal ne ":") {
       
   342 -	    #$e->replace(iusRestrictedMail => $Cf->internal ? "TRUE" : "FALSE");
       
   343 -	    #$modified++;
       
   344 -	#}
       
   345 +        if ( defined $Cf->aclgroups ) {
       
   346  
       
   347 -	$e->dump if $Cf->debug;
       
   348 +            my $ag = $Cf->aclgroups;
       
   349 +            my $lag = $e->get_value(AT_ACLGROUPS); 
       
   350 +            # groups should be supplied with leading '$' for consistency with
       
   351 +            # dovecots imap acl, but should not be saved in ldap with it!
       
   352 +            $ag =~ s/(^|,[+-]?)\K\$//g;
       
   353  
       
   354 -	if ($modified) {
       
   355 -	    $r = $e->update($ldap);
       
   356 -	    die $r->error.$r->code if $r->code;
       
   357 -	}
       
   358 +            if ( $ag =~ /(^|,\s*)[+-]/ ) {
       
   359 +                my %x;
       
   360 +                @x{ split /,/, $lag } = ();
       
   361 +                for ( split /,/, $ag ) {
       
   362 +                    if (s/^-//) {
       
   363 +                        delete $x{$_};
       
   364 +                    } else {
       
   365 +                        s/^\+//;
       
   366 +                        $x{$_} = undef;
       
   367 +                    }
       
   368 +                }
       
   369  
       
   370 -	# FIXME: Wenn keine Mailbox existiert, gibt es hier ein Problem
       
   371 -	if (defined $Cf->imap_quota) {
       
   372 -	    $imap->setquota($mbox, STORAGE => $Cf->imap_quota * 1024)
       
   373 -	    or die $@;
       
   374 -	}
       
   375 +                $ag = join ',', sort keys %x;
       
   376  
       
   377 -	verbose "ok\n";
       
   378 +            }
       
   379  
       
   380 -	print "\n";
       
   381 +            if ($ag) {
       
   382 +                $e->replace( (AT_ACLGROUPS) => $ag );
       
   383 +            } else {
       
   384 +                $e->delete( AT_ACLGROUPS ) if $lag;
       
   385 +            }
       
   386 +            $modified++;
       
   387 +        }
       
   388 +
       
   389 +        if ( my $a = $Cf->primary ) {
       
   390 +            $r = $ldap->search(
       
   391 +                base => $ubase,
       
   392 +
       
   393 +                # filter => "(|(mailPrimaryAddress=$a)(mail=$a))");
       
   394 +                filter => "(mail=$a)"
       
   395 +            );
       
   396 +            die $r->error if $r->code;
       
   397 +            die "$a ist schon vergeben\n" if $r->count;
       
   398 +
       
   399 +            $e->replace( (AT_PRIMARYADDRESS) => $Cf->primary );
       
   400 +            $modified++;
       
   401 +        }
       
   402 +
       
   403 +        if ( my $pw = _mkpw( $Cf->password ) ) {
       
   404 +            $e->replace( userPassword => $pw );
       
   405 +            $modified++;
       
   406 +        }
       
   407 +
       
   408 +        #if ($Cf->internal ne ":") {
       
   409 +        #$e->replace(iusRestrictedMail => $Cf->internal ? "TRUE" : "FALSE");
       
   410 +        #$modified++;
       
   411 +        #}
       
   412 +
       
   413 +        $e->dump if $Cf->debug;
       
   414 +
       
   415 +        if ($modified) {
       
   416 +            $r = $e->update($ldap);
       
   417 +            die $r->error . $r->code if $r->code;
       
   418 +        }
       
   419 +
       
   420 +        verbose "ok\n";
       
   421 +
       
   422 +        print "\n";
       
   423      }
       
   424  }
       
   425  
       
   426  sub _delete() {
       
   427 -# Wir gehen davon aus, daß es einen dn uid=USER,ou=.... gibt, den wir löschen können.
       
   428 -# Wir löschen den kompletten Container.  Es kann natürlich sein, daß er noch jemand anders gehört.  
       
   429 -# Dann ist das Pech.  Um es besser zu haben, müßten wir für alles unsere eigenen
       
   430 -# Objektklassen haben...
       
   431  
       
   432 -    if (!@ARGV) {
       
   433 -	print "User: ";
       
   434 -	chomp($_ = <>);
       
   435 -	@ARGV = ($_);
       
   436 +    # Wir gehen davon aus, daß es einen dn uid=USER,ou=.... gibt, den wir löschen können.
       
   437 +    # Wir löschen den kompletten Container.  Es kann natürlich sein, daß er noch jemand anders gehört.
       
   438 +    # Dann ist das Pech.  Um es besser zu haben, müßten wir für alles unsere eigenen
       
   439 +    # Objektklassen haben...
       
   440 +
       
   441 +    if ( !@ARGV ) {
       
   442 +        print "User: ";
       
   443 +        chomp( $_ = <> );
       
   444 +        @ARGV = ($_);
       
   445      }
       
   446  
       
   447 +    foreach (@ARGV) {
       
   448 +        my $user = $_;
       
   449 +        my $dn   = "uid=$user,$ubase";
       
   450  
       
   451 -    foreach (@ARGV) {
       
   452 -	my $user = $_;
       
   453 -	my $dn = "uid=$user,$ubase";
       
   454 -	my $mbox = "user/$user";
       
   455 +        verbose("$user:\n");
       
   456  
       
   457 -	verbose("$user:\n");
       
   458 +        # Nachsehen, ob es noch aliase gibt, in denen dieser Nutzer steht:
       
   459 +        my $r = $ldap->search(
       
   460 +            base   => $abase,
       
   461 +            filter => "(" . AT_FORWARDINGADDRESS . "=$_)",
       
   462 +            attrs  => [ "mail", AT_FORWARDINGADDRESS ]
       
   463 +        );
       
   464 +        while ( my $e = $r->shift_entry ) {
       
   465 +            verbose("\tdeleting $user from alias "
       
   466 +                  . $e->get_value("mail")
       
   467 +                  . "..." );
       
   468 +            $e->delete( (AT_FORWARDINGADDRESS) => [$user] );
       
   469  
       
   470 -	# Nachsehen, ob es noch aliase gibt, in denen dieser Nutzer steht:
       
   471 -	my $r = $ldap->search(base => $abase,
       
   472 -	    filter => "(".AT_FORWARDINGADDRESS."=$_)",
       
   473 -	    attrs => ["mail", AT_FORWARDINGADDRESS]);
       
   474 -	while (my $e = $r->shift_entry) {
       
   475 -	    verbose("\tdeleting $user from alias ".$e->get_value("mail")."...");
       
   476 -	    $e->delete((AT_FORWARDINGADDRESS) => [$user]);
       
   477 +            my $r = $e->update($ldap);
       
   478 +            if   ( $r->code == 0 ) { verbose("ok\n") }
       
   479 +            else                   { die $r->error }
       
   480 +        }
       
   481  
       
   482 -	    my $r = $e->update($ldap);
       
   483 -	    if ($r->code == 0) { verbose("ok\n") } 
       
   484 -	    else { die $r->error }
       
   485 -	}
       
   486 +        verbose("\tdeleting $dn...");
       
   487 +        $r = $ldap->delete($dn);
       
   488  
       
   489 -	verbose("\tdeleting $dn...");
       
   490 -	$r = $ldap->delete($dn);
       
   491 +        if ( $r->code == LDAP_NO_SUCH_OBJECT ) {
       
   492 +            verbose("doesn't exist");
       
   493 +        } elsif ( $r->code == 0 ) {
       
   494 +            verbose("ok");
       
   495 +        } else {
       
   496 +            die $r->error;
       
   497 +        }
       
   498 +        verbose("\n");
       
   499  
       
   500 -	if ($r->code == LDAP_NO_SUCH_OBJECT) {
       
   501 -	    verbose("doesn't exist");
       
   502 -	} elsif ($r->code == 0) {
       
   503 -	    verbose("ok");
       
   504 -	} else {
       
   505 -	    die $r->error;
       
   506 -	}
       
   507 -	verbose("\n");
       
   508 -	
       
   509 -	if ($Cf->mbox) {
       
   510 -	    verbose("\tdeleting mbox $mbox...");
       
   511 -	    $imap->delete($mbox) and verbose("ok")
       
   512 -	    or verbose($imap->error);
       
   513 -	}
       
   514 +        if ( $Cf->mbox ) {
       
   515 +            my $m = _mbox($user);
       
   516 +            if ( not( defined $m and $m ) ) {
       
   517 +                verbose("can't determine mbox location - not deleting it");
       
   518 +            } else {
       
   519 +                verbose("\tdeleting $m...");
       
   520 +                verbose( ( remove_tree $m) ? 'ok' : " Can't remove '$m': $!" );
       
   521 +            }
       
   522 +        }
       
   523  
       
   524 -	verbose("\n");
       
   525 +        print
       
   526 +          "Don't forget to remove acl entries for this user if any exist!\n";
       
   527 +        verbose("\n");
       
   528  
       
   529      }
       
   530  }