account.pm
branchfoerste
changeset 48 36aca6fb0ab8
parent 47 05d5ada37387
child 49 0277d8ad4d9d
--- a/account.pm	Fri Nov 25 15:29:45 2011 +0100
+++ b/account.pm	Mon Nov 28 09:49:28 2011 +0100
@@ -1,4 +1,5 @@
 package account;
+
 # © Heiko Schlittermann
 # $Id$
 # $URL$
@@ -7,18 +8,17 @@
 use warnings;
 use File::Path qw(remove_tree);
 use Net::LDAP;
-use Net::LDAP::Constant qw(LDAP_ALREADY_EXISTS LDAP_NO_SUCH_OBJECT LDAP_TYPE_OR_VALUE_EXISTS);
+use Net::LDAP::Constant
+  qw(LDAP_ALREADY_EXISTS LDAP_NO_SUCH_OBJECT LDAP_TYPE_OR_VALUE_EXISTS);
 use Net::LDAP::Entry;
 use Mail::IMAPTalk;
 use Text::Wrap;
 use password;
 
-
 my $Cf;
-my ($ldap, $ubase, $abase);
-my ($imap, $imap_password);
-END { $imap and $imap = undef; };
-
+my ( $ldap, $ubase, $abase );
+my ( $imap, $imap_password );
+END { $imap and $imap = undef; }
 
 sub _add();
 sub _list();
@@ -41,67 +41,74 @@
     $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 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;
-    import constant AT_QUOTA => $Cf->ldap_at_quota;
+    import constant AT_QUOTA             => $Cf->ldap_at_quota;
 
     $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: "));
+    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 = Mail::IMAPTalk->new(Server => $Cf->imap_server, Port => $Cf->imap_port)
-        or die "Can't connect to IMAP Server '", $Cf->imap_server, "', Port '", $Cf->imap_port, "': ", $@;
-    $imap_password = $Cf->imap_password || $ENV{IMAP_PASS} || password::ask("IMAP (". $Cf->imap_admin .") password: ");
+    $imap =
+      Mail::IMAPTalk->new( Server => $Cf->imap_server, Port => $Cf->imap_port )
+      or die "Can't connect to IMAP Server '", $Cf->imap_server, "', Port '",
+      $Cf->imap_port, "': ", $@;
+    $imap_password =
+         $Cf->imap_password
+      || $ENV{IMAP_PASS}
+      || password::ask( "IMAP (" . $Cf->imap_admin . ") password: " );
 
-    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" };
+    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.
 
+    # 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 $mailPrimaryAddress = $Cf->primary || $user;	    # evtl. mit !
-    my $mailAddress = [$user, split /,/, $Cf->other || ""]; # ditto
+    my $mailPrimaryAddress = $Cf->primary || $user;    # evtl. mit !
+    my $mailAddress = [ $user, split /,/, $Cf->other || "" ];    # ditto
 
-    $user =~ s/!$//;					    # jetzt können wir ! nicht mehr brauchn
+    $user =~ s/!$//;    # jetzt können wir ! nicht mehr brauchn
     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}");
+    my $sn = ( reverse split " ", $cn )[0];
+    my $mailGroup             = [ split /,/, $Cf->group   || "" ];
+    my $mailForwardingAddress = [ split /,/, $Cf->forward || "" ];
+    my $pw = _mkpw( $Cf->password || "{pwgen}" );
     my $mbox = _mbox($user);
 
-    if ($mailPrimaryAddress !~ /@/) {
-	$mailPrimaryAddress .= "@" . $Cf->default_domain;
+    if ( $mailPrimaryAddress !~ /@/ ) {
+        $mailPrimaryAddress .= "@" . $Cf->default_domain;
     }
 
-
     my $dn = "uid=$user,$ubase";
     my $r;
 
@@ -109,74 +116,88 @@
 
     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;
-	}
-
-	$e->replace(objectClass => [uniq $e->get("objectClass"), qw/uidObject person/, OC_RECIPIENT]);
-	$e->replace(uid => [uniq $e->get("uid"), $user]);
+        # 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->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(iusRestrictedMail => $Cf->internal) if $Cf->internal ne ":";
+        $e->replace(
+            objectClass => [
+                uniq $e->get("objectClass"),
+                qw/uidObject person/,
+                OC_RECIPIENT
+            ]
+        );
+        $e->replace( uid => [ uniq $e->get("uid"), $user ] );
 
-	$e->exists("sn") or $e->add(sn => $sn);
-	$e->exists("cn") or $e->add(cn => $cn);
+        $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(iusRestrictedMail => $Cf->internal) if $Cf->internal ne ":";
 
-	$r = $e->update($ldap);
-	die $r->error if $r->code;
+        $e->exists("sn") or $e->add( sn => $sn );
+        $e->exists("cn") or $e->add( cn => $cn );
 
-	verbose('ok');
-        verbose(" Password: $pw") if not $Cf->password or $Cf->password eq "{pwgen}";
+        $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) {
+    if ( $Cf->mbox ) {
 
-	verbose("\n\t$mbox...");
+        verbose("\n\t$mbox...");
 
-	if (-d $mbox) {
+        if ( -d $mbox ) {
 
             verbose('exists')
 
-        } elsif($imap->capability->{acl}) {
+        } elsif ( $imap->capability->{acl} ) {
 
-            $imap->login($user, $pw) or die $@;
+            $imap->login( $user, $pw ) or die $@;
+
             # 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
             #    (lra: sicht-, les- und administrierbar)
-            my $f = $imap->list('', '*') or die $@;
-            $imap->setacl($f->[0]->[2], $Cf->imap_admin, 'lra') or die $@;
+            my $f = $imap->list( '', '*' ) or die $@;
+            $imap->setacl( $f->[0]->[2], $Cf->imap_admin, 'lra' ) or die $@;
             verbose('ok');
 
         } else {
@@ -185,195 +206,210 @@
 
         }
 
-
     }
 
     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 $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 ) {
+
+            # 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 ( $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);
+        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/^\+//;
+            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;
+                    # 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++;
-	}
+                    $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);
+        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++;
-	}
+            foreach my $g (@g) {
+                if ( $g =~ s/^-// ) {
+                    $e->delete( (AT_GROUP) => [$g] );
+                } else {
+                    $g =~ s/^\+//;
+                    $e->add( (AT_GROUP) => [$g] );
+                }
+            }
+            $modified++;
+        }
 
-	if (defined $Cf->forward) {
-	    my @f = split /,/, $Cf->forward;
-	    grep { /^[+-]/ } @f or $e->delete(AT_FORWARDINGADDRESS)
-		if $e->get_value(AT_FORWARDINGADDRESS);
+        if ( defined $Cf->forward ) {
+            my @f = split /,/, $Cf->forward;
+            grep { /^[+-]/ } @f
+              or $e->delete(AT_FORWARDINGADDRESS)
+              if $e->get_value(AT_FORWARDINGADDRESS);
 
-	    foreach my $f (@f) {
-		if ($f =~ s/^-//) {
-		    $e->delete((AT_FORWARDINGADDRESS) => [$f]);
-		} else {
-		    $f =~ s/^\+//;
-		    $e->add((AT_FORWARDINGADDRESS) => [$f]);
-		}
-	    }
-	    $modified++;
-	}
+            foreach my $f (@f) {
+                if ( $f =~ s/^-// ) {
+                    $e->delete( (AT_FORWARDINGADDRESS) => [$f] );
+                } else {
+                    $f =~ s/^\+//;
+                    $e->add( (AT_FORWARDINGADDRESS) => [$f] );
+                }
+            }
+            $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 $a = $Cf->primary ) {
+            $r = $ldap->search(
+                base => $ubase,
 
-	if (my $pw = _mkpw($Cf->password)) {
-	    $e->replace(userPassword => $pw);
-	    $modified++;
-	}
+                # 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 ($Cf->internal ne ":") {
-	    #$e->replace(iusRestrictedMail => $Cf->internal ? "TRUE" : "FALSE");
-	    #$modified++;
-	#}
+        if ( my $pw = _mkpw( $Cf->password ) ) {
+            $e->replace( userPassword => $pw );
+            $modified++;
+        }
 
-	$e->dump if $Cf->debug;
+        #if ($Cf->internal ne ":") {
+        #$e->replace(iusRestrictedMail => $Cf->internal ? "TRUE" : "FALSE");
+        #$modified++;
+        #}
 
-	if ($modified) {
-	    $r = $e->update($ldap);
-	    die $r->error.$r->code if $r->code;
-	}
+        $e->dump if $Cf->debug;
 
-	verbose "ok\n";
+        if ($modified) {
+            $r = $e->update($ldap);
+            die $r->error . $r->code if $r->code;
+        }
 
-	print "\n";
+        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...
+
+    # 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 = ($_);
+    if ( !@ARGV ) {
+        print "User: ";
+        chomp( $_ = <> );
+        @ARGV = ($_);
     }
 
-
     foreach (@ARGV) {
-	my $user = $_;
-	my $dn = "uid=$user,$ubase";
+        my $user = $_;
+        my $dn   = "uid=$user,$ubase";
 
-	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 ($Cf->mbox) {
+        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 ) {
             my $m = _mbox($user);
-            if (not (defined $m and $m)) {
+            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( ( remove_tree $m) ? 'ok' : " Can't remove '$m': $!" );
             }
         }
 
-	verbose("\n");
+        verbose("\n");
 
     }
 }
@@ -381,43 +417,48 @@
 sub _list() {
     my $filter;
     @ARGV = ("*") unless @ARGV;
-    $filter = "(|" . join("", map { "(uid=$_)" } @ARGV) . ")";
+    $filter = "(|" . join( "", map { "(uid=$_)" } @ARGV ) . ")";
 
     my $r = $ldap->search(
-	filter => $filter,
-	base => $ubase,
-	#attrs => [qw/uid cn mail userPassword/, (AT_PRIMARYADDRESS)]
+        filter => $filter,
+        base   => $ubase,
+
+        #attrs => [qw/uid cn mail userPassword/, (AT_PRIMARYADDRESS)]
     );
     die $r->error if $r->code;
 
     #if (-t STDOUT) { open(LESS, "|less -F -X") and select LESS; }
 
+    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 $forw = join( ", ", $e->get_value(AT_FORWARDINGADDRESS) ) || "";
 
-    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 $forw = join (", ", $e->get_value(AT_FORWARDINGADDRESS)) || "";
+        print "$uid: $cn <$mr>";
 
-	print "$uid: $cn <$mr>";
-
-	#if (($e->get_value("iusRestrictedMail")||"") eq "TRUE") {
-	    #print " INTERNAL";
-	#}
+        #if (($e->get_value("iusRestrictedMail")||"") eq "TRUE") {
+        #print " INTERNAL";
+        #}
 
         # das imap protokoll sieht keine zustandsänderung von 'authenticated'
         # zu 'not authenticated' vor - daher müssen wir für jeden nutzer eine
         # eigene verbindung aufbauen
-        $imap = Mail::IMAPTalk->new(Server => $Cf->imap_server, Port => $Cf->imap_port)
-            or die "Can't connect to IMAP Server '", $Cf->imap_server, "', Port '", $Cf->imap_port, "': ", $@;
-        $imap->login("$uid*" . $Cf->imap_admin, $imap_password ) or die $@;
-        my $folders = $imap->list('', '*') or die $@;
+        $imap = Mail::IMAPTalk->new(
+            Server => $Cf->imap_server,
+            Port   => $Cf->imap_port
+          )
+          or die "Can't connect to IMAP Server '", $Cf->imap_server,
+          "', Port '", $Cf->imap_port, "': ", $@;
+        $imap->login( "$uid*" . $Cf->imap_admin, $imap_password ) or die $@;
+        my $folders = $imap->list( '', '*' ) or die $@;
         my %q;
-        for my $f(@{$folders}) {
+        for my $f ( @{$folders} ) {
+
             # single folder sieht wie folgt aus: [[flag1, flag2, ...], separator, foldername]
-            my $q = $imap->getquotaroot($f->[2]) or die $@;
+            my $q = $imap->getquotaroot( $f->[2] ) or die $@;
             delete $q->{quotaroot};
             %q = ( %q, %{$q} );
         }
@@ -426,22 +467,24 @@
         # da wir uns anmelden konnten haben wir auch eine 'mbox'
         print ", mbox";
         my $has_quota;
-        for my $qr(keys %q) {
-            my @q = @{$q{$qr}};
+        for my $qr ( keys %q ) {
+            my @q    = @{ $q{$qr} };
             my $elem = '';
             $elem = shift @q while defined $elem and $elem ne 'STORAGE';
-            my ($used, $max) = map { int($_ / 1024) } @q[0..1];
-            print ", quota '$qr': $used/${max}MB " . int(100 * $used/$max) . "%";
+            my ( $used, $max ) = map { int( $_ / 1024 ) } @q[ 0 .. 1 ];
+            print ", quota '$qr': $used/${max}MB "
+              . int( 100 * $used / $max ) . "%";
             $has_quota = 1;
         }
         print ", no quota" unless $has_quota;
-	print "\n";
+        print "\n";
 
-	print "\tPassword: ", $> == 0 ? $e->get_value("userPassword") : "*", "\n";
-	
-	print  wrap("\t", "\t\t", "Other Adresses: $ml\n") if $ml;
-	print wrap("\t", "\t\t", "Mail Groups: $mg\n") if $mg;
-	print wrap("\t", "\t\t", "Forwardings: $forw\n") if $forw;
+        print "\tPassword: ", $> == 0 ? $e->get_value("userPassword") : "*",
+          "\n";
+
+        print wrap( "\t", "\t\t", "Other Adresses: $ml\n" ) if $ml;
+        print wrap( "\t", "\t\t", "Mail Groups: $mg\n" )    if $mg;
+        print wrap( "\t", "\t\t", "Forwardings: $forw\n" )  if $forw;
 
     }
 }
@@ -456,33 +499,37 @@
     return keys %x;
 }
 
-{   my @pw;
-sub _mkpw($) {
-    my $in = $_[0];
+{
+    my @pw;
 
-    return $in unless $in and $in eq "{pwgen}";
+    sub _mkpw($) {
+        my $in = $_[0];
+
+        return $in unless $in and $in eq "{pwgen}";
 
-    if (!@pw) {
-	chomp(@pw = `pwgen 8 10 2>/dev/null`);
-	die "pwgen: $!" if $?;
+        if ( !@pw ) {
+            chomp( @pw = `pwgen 8 10 2>/dev/null` );
+            die "pwgen: $!" if $?;
+        }
+        return shift @pw;
+
     }
-    return shift @pw;
-    
-} }
+}
 
 sub _mbox($) {
 
     my ($user) = @_;
 
-    my ($localpart, $domain, $escapes);
+    my ( $localpart, $domain, $escapes );
 
     # assuming usernames of the form localpart@domain
     $user =~ /(.+)@(.+)$/;
-    ($localpart, $domain) = ($1, $2);
+    ( $localpart, $domain ) = ( $1, $2 );
 
-    die "Invalid username '$user'" unless $escapes->{'%u'} = $localpart
-        and $escapes->{'%1'} = substr $localpart, 0, 1
-        and $escapes->{'%d'} = $domain;
+    die "Invalid username '$user'"
+      unless $escapes->{'%u'} = $localpart
+          and $escapes->{'%1'} = substr $localpart, 0, 1
+          and $escapes->{'%d'} = $domain;
     my $mbox = $Cf->imap_mail_location;
     $mbox =~ s/$_/$escapes->{$_}/ for keys %{$escapes};
 
@@ -491,4 +538,5 @@
 }
 
 1;
+
 # vim:sts=4 sw=4 aw ai sm nohlsearch: