# HG changeset patch
# User Matthias Förste <foerste@schlittermann.de>
# Date 1429007669 -7200
# Node ID e3d571c7734da9c9a2b7a6ef2ebd8b3c7f4a6182
# Parent  59c7146ec6f0dd6b4d499df0452105a15f968572# Parent  2bb072311ed860ac183d1a7cf2a6f7546147398c
[savepoint]

diff -r 59c7146ec6f0 -r e3d571c7734d .hgignore
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/.hgignore	Tue Apr 14 12:34:29 2015 +0200
@@ -0,0 +1,4 @@
+syntax: glob
+.ok.*
+*.[0-9].gz
+x
diff -r 59c7146ec6f0 -r e3d571c7734d .hgtags
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/.hgtags	Tue Apr 14 12:34:29 2015 +0200
@@ -0,0 +1,1 @@
+6a6c18cddf46998e8a1acc933ff4afbacdb177b8 hhsp-dovecot-0.1
diff -r 59c7146ec6f0 -r e3d571c7734d .perltidyrc
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/.perltidyrc	Tue Apr 14 12:34:29 2015 +0200
@@ -0,0 +1,2 @@
+-ce
+-noll
diff -r 59c7146ec6f0 -r e3d571c7734d Common.pm
--- a/Common.pm	Tue Jul 31 10:46:37 2007 +0000
+++ b/Common.pm	Tue Apr 14 12:34:29 2015 +0200
@@ -1,4 +1,5 @@
 package Common;
+
 # $Id$
 # $URL$
 use strict;
@@ -9,64 +10,84 @@
     GLOBAL => { DEFAULT => undef },
 
     # * common *
-    add =>	    { ARGS => "!",  ALIAS => [qw/new create/] },
-    list =>	    { ARGS => "!",  ALIAS => "ls" },
-    modify =>	    { ARGS => "!",  ALIAS => "change" },
-    delete =>	    { ARGS => "!",  ALIAS => "remove" },
+    add    => { ARGS => "!", ALIAS => [qw/new create/] },
+    list   => { ARGS => "!", ALIAS => "ls" },
+    modify => { ARGS => "!", ALIAS => "change" },
+    delete => { ARGS => "!", ALIAS => "remove" },
 
-    ldap_base =>    { ARGS => "=s", DEFAULT => ldapBase(qw(/etc/openldap/ldap.conf /etc/ldap/ldap.conf)) },
-    ldap_server =>  { ARGS => "=s", DEFAULT => "localhost" },
-    ldap_bind_dn => { ARGS => "=s", DEFAULT => "cn=admin", ALIAS => "ldap_admin" },
-    ldap_password =>{ ARGS => "=s" },
+    ldap_base => {
+        ARGS    => "=s",
+        DEFAULT => ldapBase(qw(/etc/openldap/ldap.conf /etc/ldap/ldap.conf))
+    },
+    ldap_server => { ARGS => "=s", DEFAULT => "localhost" },
+    ldap_bind_dn =>
+      { ARGS => "=s", DEFAULT => "cn=admin", ALIAS => "ldap_admin" },
+    ldap_password => { ARGS => "=s" },
 
-    help =>	    { ARGS => "!" },
-    debug =>	    { ARGS => "!" },
+    help  => { ARGS => "!" },
+    debug => { ARGS => "!" },
 
-    description =>  { ARGS => "=s" },
-
+    description => { ARGS => "=s" },
 
     # * account *
     default_domain => { ARGS => "=s", DEFAULT => "" },
-    imap_server =>  { ARGS => "=s", DEFAULT => "localhost" },
-    imap_admin =>   { ARGS => "=s", DEFAULT => $ENV{USER} },
-    imap_password =>{ ARGS => "=s" },
-    imap_quota =>   { ARGS => "=i", DEFAULT => 300, ALIAS => "quota" },
+    imap_server    => { ARGS => "=s", DEFAULT => "localhost" },
+    imap_port      => { ARGS => "=s", DEFAULT => "143" },
+    imap_admin     => { ARGS => "=s", DEFAULT => $ENV{USER} },
+    imap_password  => { ARGS => "=s" },
+    imap_quota =>
+      { ARGS => "=i", DEFAULT => 300 * 1024 * 1024, ALIAS => "quota" },
+    imap_aclgroups => { ARGS => "=s", ALIAS => "aclgroups" },
+
+    # dovecots mail_location (%1, %u & %d supported)
+    imap_mail_location =>
+      { ARGS => "=s", DEFAULT => '/var/vmail/users/%d/%1/%u' },
+
+    mbox     => { ARGS => "!", DEFAULT => 1 },
+    password => { ARGS => "=s" },
 
-    mbox =>	    { ARGS => "!",  DEFAULT => 1 },
-    password =>	    { ARGS => "=s" },
-#   internal =>	    { ARGS => "!",  DEFAULT => ":", ALIAS => "restricted" },	    
+    #   internal =>	    { ARGS => "!",  DEFAULT => ":", ALIAS => "restricted" },
 
-    other =>	    { ARGS => ":s" },
-    group =>	    { ARGS => ":s" },
-    forward =>	    { ARGS => ":s" },
-    fullname =>	    { ARGS => "=s", ALIAS => "realname" },
-    address =>	    { ARGS => "=s", ALIAS => "primary" },
+    other    => { ARGS => ":s" },
+    group    => { ARGS => ":s" },
+    forward  => { ARGS => ":s" },
+    fullname => { ARGS => "=s", ALIAS => "realname" },
+    address  => { ARGS => "=s", ALIAS => "primary" },
+
+    # * acl *
+    acl_admin    => { ARGS => "=s" },
+    acl_password => { ARGS => "=s" },
+    folder       => { ARGS => ":s@" },
+    acl          => { ARGS => "=s" },
+    recursive    => { ARGS => "!", DEFAULT => 0 },
 
     # * alias * group *
-    members =>	    { ARGS => ":s" },
+    members => { ARGS => ":s" },
 
     # * shared *
     #access =>	    { ARGS => ":s" },
 
     # * group *
-    gid_min =>	    { ARGS => "=i", DEFAULT => 60000 },
-    gid_max =>	    { ARGS => "=i", DEFAULT => 60100 },
+    gid_min => { ARGS => "=i", DEFAULT => 60000 },
+    gid_max => { ARGS => "=i", DEFAULT => 60100 },
 
     # * ldap intern *
-    ldap_ou_aliases =>	    { ARGS => "=s", DEFAULT => "ou=MailAliases" },
-    ldap_ou_accounts =>	    { ARGS => "=s", DEFAULT => "ou=MailAccounts" },
-    ldap_ou_groups =>	    { ARGS => "=s", DEFAULT => "ou=Groups" },
+    ldap_ou_aliases  => { ARGS => "=s", DEFAULT => "ou=MailAliases" },
+    ldap_ou_accounts => { ARGS => "=s", DEFAULT => "ou=MailAccounts" },
+    ldap_ou_groups   => { ARGS => "=s", DEFAULT => "ou=Groups" },
+
+    ldap_oc_alias       => { ARGS => "=s", DEFAULT => "XXXmailAlias" },
+    ldap_oc_recipient   => { ARGS => "=s", DEFAULT => "XXXmailRecipient" },
+    ldap_oc_accessgroup => { ARGS => "=s", DEFAULT => "XXXmailAccessGroup" },
 
-    ldap_oc_alias =>	    { ARGS => "=s", DEFAULT => "XXXmailAlias" },
-    ldap_oc_recipient =>    { ARGS => "=s", DEFAULT => "XXXmailRecipient" },
-    ldap_oc_accessgroup =>  { ARGS => "=s", DEFAULT => "XXXmailAccessGroup" },
-
-    ldap_at_address =>	    { ARGS => "=s", DEFAULT => "XXXmailAddress" },
-    ldap_at_group =>	    { ARGS => "=s", DEFAULT => "XXXmailGroup" },
+    ldap_at_address   => { ARGS => "=s", DEFAULT => "XXXmailAddress" },
+    ldap_at_group     => { ARGS => "=s", DEFAULT => "XXXmailGroup" },
+    ldap_at_quota     => { ARGS => "=s", DEFAULT => "XXXmailQuota" },
+    ldap_at_aclgroups => { ARGS => "=s", DEFAULT => "XXXmailACLGroups" },
     ldap_at_forwardingaddress =>
-			    { ARGS => "=s", DEFAULT => "XXXmailForwardingAddress" },
-    ldap_at_primaryaddress => 
-			    { ARGS => "=s", DEFAULT => "XXXmailPrimaryAddress" },
+      { ARGS => "=s", DEFAULT => "XXXmailForwardingAddress" },
+    ldap_at_primaryaddress =>
+      { ARGS => "=s", DEFAULT => "XXXmailPrimaryAddress" },
 
 );
 
diff -r 59c7146ec6f0 -r e3d571c7734d Makefile
--- a/Makefile	Tue Jul 31 10:46:37 2007 +0000
+++ b/Makefile	Tue Apr 14 12:34:29 2015 +0200
@@ -75,4 +75,7 @@
 	rubber ${RUBBER_FLAGS} $<
 
 %.gz:	%.pod
-	iconv -f utf8 -t iso8859-15 $< | pod2man --name $(basename $<) --section $(subst .,,$(suffix $@)) | gzip >$@
+	pod2man --utf8 --name $(basename $<) --section $(subst .,,$(suffix $@)) $< | gzip >$@
+
+tidy:
+	perltidy -b $(SCRIPTS) $(PM)
diff -r 59c7146ec6f0 -r e3d571c7734d account.pm
diff -r 59c7146ec6f0 -r e3d571c7734d acl.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/acl.pm	Tue Apr 14 12:34:29 2015 +0200
@@ -0,0 +1,461 @@
+package acl;
+
+# © Heiko Schlittermann
+# $Id$
+# $URL$
+
+use strict;
+use warnings;
+require 5.10.0;
+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::Entry;
+use Mail::IMAPTalk;
+use Text::Wrap;
+use password;
+use Term::ReadKey;
+
+my $Cf;
+my ( $ldap, $ubase,        $abase );
+my ( $imap, $acl_password, $nspat );
+END { $imap and $imap = undef; }
+
+sub _list();
+sub _mkpw($);
+
+sub list_by_user($@);
+sub list_by_folder($);
+sub list_groups(@);
+sub uniq(@);
+sub verbose(@);
+sub prompt($$);
+sub imap_list($$);
+sub imap_rlist($$$);
+sub acl_folders($);
+
+sub OU_ACCOUNTS();
+sub OU_ALIASES();
+sub AT_PRIMARYADDRESS();
+sub OC_RECIPIENT();
+sub AT_ADDRESS();
+sub AT_GROUP();
+sub AT_FORWARDINGADDRESS();
+sub AT_QUOTA();
+sub AT_ACLGROUPS();
+
+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;
+    import constant AT_ACLGROUPS         => $Cf->ldap_at_aclgroups;
+
+    $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;
+
+    $acl_password =
+         $Cf->acl_password
+      || $ENV{IMAP_PASS}
+      || password::ask( "IMAP (" . $Cf->acl_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->login( $Cf->acl_admin, $acl_password ) or die $@;
+    die "IMAP Server does not advertise acl support"
+      unless $imap->capability->{acl};
+
+    $imap->set_tracing(1) if $ENV{TRACE};
+
+    # requires an imap connection
+    my $ns = $imap->namespace() or die "No public namespaces available: $@";
+    $nspat = [];
+    for ( @{ $ns->[2] } ) {
+        ( my $n = $_->[0] ) =~ s/$_->[1]$//;
+        push @{$nspat}, [ qr/\Q$n\E($_->[1]|$)/, $_->[1] ];
+    }
+
+    if    ( $Cf->add )    { _modify() }
+    elsif ( $Cf->delete ) { $Cf->acl('delete'); _modify() }
+    elsif ( $Cf->list )   { _list() }
+    elsif ( $Cf->modify ) { _modify() }
+    else { die "Need action (--add|--delete|--list|--modify)\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 user(s)\n";
+    $Cf->folder ~~ [] and die "Need folders(s)\n";
+    $Cf->acl or die "Need acl\n";
+    $Cf->recursive
+      and $Cf->create
+      and die "Use either --recursive or --create but not both\n";
+
+    my $r = $ldap->search(
+        base   => $ubase,
+        filter => "(|" . join( "", map { "(uid=$_)" } @ARGV ) . ")"
+    );
+    die $r->error if $r->code;
+    unless ( $r->count ) {
+        prompt( 'No matching user found in ldap. Continue? (y/N)', "n\n" ) =~
+          /y/i
+          or exit 0;
+        @users = @ARGV;
+    }
+
+    while ( my $e = ( $r->shift_entry or shift @users ) ) {
+
+        my ( $user, $dn );
+
+        if ( ref $e eq 'Net::LDAP::Entry' ) {
+            $user = $e->get_value("uid");
+            $dn   = $e->dn;
+        } else {
+            $user = $e;
+            $dn   = '[dn not available]';
+        }
+
+        my $modified = 0;
+        verbose "$user:\n";
+        verbose "\t$dn...\n";
+
+        for my $folder ( @{ $Cf->folder } ) {
+
+            $imap->create($folder)
+              or die "Can't create folder '$folder': $@"
+              if $Cf->create;
+
+            my @folders = @{ acl_folders($folder) } or die "Got empty folderlist - does '$folder' exist? (use --create if you want me to create it)";
+            for my $f ( @folders ) {
+
+                if ( $Cf->acl eq 'delete' ) {
+                    $imap->deleteacl( $f, $user ) or die "Can't delete acl: $@";
+                    verbose "\t$f: none\n";
+                } else {
+                    $imap->setacl( $f, $user, $Cf->acl )
+                      or die "Can't set acl: $@";
+                    verbose "\t$f: " . $Cf->acl . "\n";
+                }
+
+            }
+
+        }
+
+        # Fix: iusMailOptions wurde erst später eingeführt, bei Bedarf also hinzufügen
+        #if (!grep /^iusMailOptions$/, @{$e->get("objectClass")}) {
+        #$e->add(objectClass => "iusMailOptions");
+        #}
+
+        #if ($Cf->internal ne ":") {
+        #$e->replace(iusRestrictedMail => $Cf->internal ? "TRUE" : "FALSE");
+        #$modified++;
+        #}
+
+        verbose "ok\n";
+        print "\n";
+
+    }
+
+}
+
+sub _list() {
+
+    #@ARGV = ("*") unless @ARGV;
+
+    die "option acl_admin required\n" unless $Cf->acl_admin;
+
+    if ( $Cf->aclgroups ) {
+
+        warn "--folder option ignored when listing groups"
+          unless $Cf->folder ~~ [];
+        list_groups(@ARGV);
+
+    } elsif (@ARGV) {
+
+        #        my $uid = $ARGV[0];
+        #        # searching by more than use user may be too expensive
+        #        die "Searching by more than one user not supported" unless @ARGV == 1 or $uid =~ /\*/;
+        #list_by_user($_) for @ARGV;
+
+        warn "--folder option ignored when listing by user"
+          unless $Cf->folder ~~ [];
+        list_by_user( $imap, @ARGV );
+
+    } elsif ( not $Cf->folder ~~ [] ) {
+
+        list_by_folder($_) for @{ $Cf->folder };
+
+    } else {
+
+        die
+          "Need either user or --folder. If you really want to search all users then supply the pattern '*'.";
+
+    }
+
+}
+
+sub list_groups(@) {
+
+    @_ = ('*') unless @_;
+    my @ag = split ',', $Cf->imap_aclgroups;
+    my $ag_all = 1 if '*' ~~ @ag;
+    my $ag_att = AT_ACLGROUPS;
+    my $filter =
+      "(&($ag_att=*)" . "(|" . join( "", map { "(uid=$_)" } @_ ) . "))";
+    my $r = $ldap->search(
+        attrs  => [ 'uid', AT_ACLGROUPS ],
+        filter => $filter,
+        base   => $ubase,
+    );
+    die $r->error if $r->code;
+
+    unless ( $r->count ) {
+        print("No aclgroups found in ldap\n");
+        exit 0;
+    }
+
+    my $users;
+    while ( my $e = ( $r->shift_entry ) ) {
+        my $uid = $e->get_value('uid');
+        my @ag_cur = split ',', $e->get_value($ag_att);
+        for (@ag_cur) {
+            $users->{$_} =
+              defined $users->{$_}
+              ? [ @{ $users->{$_} }, $uid ]
+              : [$uid]
+              if $ag_all or $_ ~~ @ag;
+        }
+    }
+
+    print "$_:\n\t", join( "\n\t", @{ $users->{$_} } ), "\n\n"
+      for keys %{$users};
+
+}
+
+sub list_by_user($@) {
+
+    my $imap = shift;
+    my $filter = "(|" . join( "", map { "(uid=$_)" } @_ ) . ")";
+
+    #my $filter = "(uid=$uid)";
+    my $r = $ldap->search(
+        filter => $filter,
+        base   => $ubase,
+    );
+    die $r->error if $r->code;
+    my @users;
+    unless ( $r->count ) {
+        verbose("No matching users found in ldap.\n");
+        @users = @_;
+    }
+
+    while ( my $e = ( $r->shift_entry or shift @users ) ) {
+
+        my ( $uid, $cn, $mr );
+        if ( ref $e eq 'Net::LDAP::Entry' ) {
+            $uid = $e->get_value("uid");
+            $cn  = join( ", ", $e->get_value("cn") );
+            $mr  = $e->get_value(AT_PRIMARYADDRESS) || "";    # ??
+        } else {
+            $uid = $e;
+            $cn  = '[cn not available]';
+            $mr  = '[address not available]';
+        }
+
+        print "$uid: $cn <$mr>\n";
+
+        #if (($e->get_value("iusRestrictedMail")||"") eq "TRUE") {
+        #print " INTERNAL";
+        #}
+
+        die "IMAP Server does not advertise acl support"
+          unless $imap->capability->{acl};
+
+        # namespace() result looks like this
+        # [
+        #   [   # list of private namespace(s)
+        #       [
+        #           prefix,
+        #           name
+        #       ],
+        #       ...
+        #   ],
+        #   [   # list of namespace(s) for mailboxes shared by other users
+        #       [
+        #           prefix,
+        #           name
+        #       ],
+        #       ...
+        #   [   # list of namespace(s) for 'public' shared mailboxes
+        #       [
+        #           prefix,
+        #           name
+        #       ],
+        #       ...
+        #   ]
+        my $hasacl;
+        my $ns = $imap->namespace() or die "No public namespaces available: $@";
+
+        # uns interessieren nur 'public' namespaces
+        for my $n ( @{ $ns->[2] } ) {
+
+            my $folders = imap_rlist( '', $n->[0], $n->[1] );
+            for my $f ( @{$folders} ) {
+
+                #next if '\\Noselect' ~~ $f->[0];
+                my $perms = $imap->getacl($f) or die "Can't getacl '$f': $@";
+                my ( $u, $p );
+                while ( $u = shift @{$perms} and $p = shift @{$perms} ) {
+                    next unless $u eq $uid;
+                    $hasacl = 1;
+                    print "\t$f: $u [$p]\n";
+                }
+
+            }
+
+        }
+
+        print "\tno acl found on listable folders in shared namespaces\n"
+          unless $hasacl;
+        print "\n";
+
+    }
+
+}
+
+sub list_by_folder($) {
+
+    my ($folder) = @_;
+
+    for my $f ( @{ acl_folders($folder) } ) {
+
+        my $hasacl;
+        print "$f\n";
+
+        my $perms = $imap->getacl($f) or die $@;
+        my ( $u, $p );
+        while ( $u = shift @{$perms} and $p = shift @{$perms} ) {
+
+            # '#user' will be listed when we have a global acl for 'user'
+            my $gl = $u =~ /^\$?#/  ? ' [global]' : '';
+            my $gr = $u =~ /^#?\$/ ? ' [group]'  : '';
+            $hasacl = 1;
+            print "\t$u [$p]$gr$gl\n";
+        }
+
+        print "\tno acl found\n" unless $hasacl;
+        print "\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` );
+            die "pwgen: $!" if $?;
+        }
+        return shift @pw;
+
+    }
+}
+
+sub imap_list($$) {
+
+    my ( $ref, $folder ) = @_;
+
+    my $list = $imap->list( $ref, $folder )
+      or die "Can't list('$ref', '$folder'): $@";
+
+    # single folder sieht wie folgt aus: [[flag1, flag2, ...], separator, foldername]
+    ref $list and return [ map $_->[2], @{$list} ];
+
+    # assuming empty result list otherwise
+    return [];
+
+}
+
+sub imap_rlist($$$) {
+
+    my ( $ref, $folder, $sep ) = @_;
+    $folder =~ s/$sep+$//;
+
+    my $list = imap_list( $ref, $folder );
+    push @{$list}, @{ imap_list( $ref, "$folder$sep*" ) } if $Cf->recursive;
+    return $list;
+}
+
+sub acl_folders($) {
+
+    my ($f) = @_;
+    my $folders;
+
+    for my $np ( @{$nspat} ) {
+
+        # don't modify $f!
+        ( my $ft = $f ) =~ s/$np->[1]$//;
+        return imap_rlist( '', $f, $np->[1] ) if ( $ft =~ /$np->[0]/ );
+    }
+
+    die "Foldername '$f' must begin with the name of a shared namespace\n";
+
+}
+
+sub prompt($$) {
+    my ( $prompt, $default ) = @_;
+    print $prompt, substr( $default, 0, 1 ), "\b";
+    ReadMode 4;
+    my $r = ReadKey(0);
+    ReadMode 0;
+    if ( $r eq "\n" ) { $r = $default }
+    else              { $r .= substr( $default, 1 ) }
+    print $r;
+    return $r;
+}
+
+1;
+
+# vim:sts=4 sw=4 aw ai sm nohlsearch:
diff -r 59c7146ec6f0 -r e3d571c7734d alias.pm
--- a/alias.pm	Tue Jul 31 10:46:37 2007 +0000
+++ b/alias.pm	Tue Apr 14 12:34:29 2015 +0200
@@ -1,4 +1,5 @@
 package alias;
+
 # © Heiko Schlittermann
 # $Id$
 # $URL$
@@ -7,17 +8,17 @@
 use warnings;
 use Net::LDAP;
 use Net::LDAP::Constant qw(
-    LDAP_ALREADY_EXISTS 
-    LDAP_NO_SUCH_OBJECT
-    LDAP_NO_SUCH_ATTRIBUTE
-    LDAP_TYPE_OR_VALUE_EXISTS);
+  LDAP_ALREADY_EXISTS
+  LDAP_NO_SUCH_OBJECT
+  LDAP_NO_SUCH_ATTRIBUTE
+  LDAP_TYPE_OR_VALUE_EXISTS);
 use Net::LDAP::Entry;
 use Text::Wrap;
 
 use password;
 
 my $Cf;
-my ($ldap, $abase, $ubase);
+my ( $ldap, $abase, $ubase );
 
 sub _add();
 sub _list();
@@ -37,142 +38,151 @@
     $Cf = shift;
 
     require constant;
-    import constant OU_ACCOUNTS => $Cf->ldap_ou_accounts;
-    import constant OU_ALIASES => $Cf->ldap_ou_aliases;
-    import constant OC_ALIAS => $Cf->ldap_oc_alias;
+    import constant OU_ACCOUNTS          => $Cf->ldap_ou_accounts;
+    import constant OU_ALIASES           => $Cf->ldap_ou_aliases;
+    import constant OC_ALIAS             => $Cf->ldap_oc_alias;
     import constant AT_FORWARDINGADDRESS => $Cf->ldap_at_forwardingaddress;
-    import constant AT_GROUP => $Cf->ldap_at_group;
-    import constant AT_PRIMARYADDRESS => $Cf->ldap_at_primaryaddress;
+    import constant AT_GROUP             => $Cf->ldap_at_group;
+    import constant AT_PRIMARYADDRESS    => $Cf->ldap_at_primaryaddress;
 
     $abase = OU_ALIASES . "," . $Cf->ldap_base;
     $ubase = OU_ACCOUNTS . "," . $Cf->ldap_base;
 }
 
 sub run($) {
+
     # Eigentlich brauchen wir für alles 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;
 
-
-    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() {
-# Wenn's den Alias schon gibt, wird er nicht mehr
-# angelegt
+
+    # Wenn's den Alias schon gibt, wird er nicht mehr
+    # angelegt
 
     die "Need alias name for creation\n" if not @ARGV;
     die "Need members\n" if not defined $Cf->members;
-    my $alias = shift @ARGV;
+    my $alias   = shift @ARGV;
     my @members = split /,/, $Cf->members;
-    my $dn = "mail=$alias,$abase";
+    my $dn      = "mail=$alias,$abase";
 
     my $r;
 
     verbose("$alias:\n");
     verbose("\t$dn...");
 
-    $r = $ldap->search(base => $abase, filter => "(mail=$alias)");
+    $r = $ldap->search( base => $abase, filter => "(mail=$alias)" );
     die $r->error if $r->code;
     die "Multiple entries not expected" if $r->count > 1;
-    
-    $r = $ldap->add($dn, attrs => [
-	objectClass => OC_ALIAS,
-	mail => $alias,
-	(AT_FORWARDINGADDRESS) => \@members
-    ]);
-    if ($r->code == LDAP_ALREADY_EXISTS) { verbose "exists" }
-    elsif ($r->code) { die $r->error } 
-    else { verbose "ok" }
+
+    $r = $ldap->add(
+        $dn,
+        attrs => [
+            objectClass            => OC_ALIAS,
+            mail                   => $alias,
+            (AT_FORWARDINGADDRESS) => \@members
+        ]
+    );
+    if    ( $r->code == LDAP_ALREADY_EXISTS ) { verbose "exists" }
+    elsif ( $r->code )                        { die $r->error }
+    else                                      { verbose "ok" }
 
     verbose("\n");
 }
 
 sub _modify() {
-# Auch hier gehen wir davon aus, daß die dn direkt aus dem Alias-Namen folgt:
-# dn: cn=USER,...
-# Jetzt behandeln wir lediglich die Modifikation auf Basis eines
-# alias-Namens!
+
+    # Auch hier gehen wir davon aus, daß die dn direkt aus dem Alias-Namen folgt:
+    # dn: cn=USER,...
+    # Jetzt behandeln wir lediglich die Modifikation auf Basis eines
+    # alias-Namens!
 
     my (@users) = @ARGV or die "Need alias names(s)\n";
     my @members = split /,/, $Cf->members;
     my @add = grep { s/^\+// } @_ = @members;
-    my @del = grep { s/^-// } @_ = @members;
+    my @del = grep { s/^-// } @_  = @members;
     my @set = grep { !/^[\+-]/ } @members;
 
-
     foreach my $alias (@ARGV) {
-	my $dn = "mail=$alias,$abase";
-	verbose "$alias:";
+        my $dn = "mail=$alias,$abase";
+        verbose "$alias:";
 
-	my $r = $ldap->search(base => $abase, filter => "(mail=$alias)");
-	die $r->error if $r->code;
+        my $r = $ldap->search( base => $abase, filter => "(mail=$alias)" );
+        die $r->error if $r->code;
 
-	if ($r->count == 0) {
-	    verbose " not found\n";
-	    next;
-	}
+        if ( $r->count == 0 ) {
+            verbose " not found\n";
+            next;
+        }
 
-	while (my $e = $r->shift_entry) {
+        while ( my $e = $r->shift_entry ) {
 
-	    verbose "\n\t" . $e->dn . " ";
+            verbose "\n\t" . $e->dn . " ";
 
-	    if (@set) {
-		$e->replace((AT_FORWARDINGADDRESS) => \@set);
-	    } else {
-		@add and $e->replace((AT_FORWARDINGADDRESS) => [uniq $e->get(AT_FORWARDINGADDRESS), @add]);
-		@del and $e->delete((AT_FORWARDINGADDRESS) => \@del);
-	    }
+            if (@set) {
+                $e->replace( (AT_FORWARDINGADDRESS) => \@set );
+            } else {
+                @add
+                  and $e->replace( (AT_FORWARDINGADDRESS) =>
+                      [ uniq $e->get(AT_FORWARDINGADDRESS), @add ] );
+                @del and $e->delete( (AT_FORWARDINGADDRESS) => \@del );
+            }
 
-	    $e->dump if $Cf->debug;
+            $e->dump if $Cf->debug;
 
-	    my $r = $e->update($ldap);
-	    if ($r->code == LDAP_NO_SUCH_ATTRIBUTE) {
-		verbose "no member";
-	    } elsif ($r->code) {
-		die $r->error . "/" . $r->code;
-	    }  else {
-		verbose "ok";
-	    }
-	}
+            my $r = $e->update($ldap);
+            if ( $r->code == LDAP_NO_SUCH_ATTRIBUTE ) {
+                verbose "no member";
+            } elsif ( $r->code ) {
+                die $r->error . "/" . $r->code;
+            } else {
+                verbose "ok";
+            }
+        }
 
-	print "\n";
+        print "\n";
     }
 }
 
 sub _delete() {
-# Wir gehen davon aus, daß es einen dn mail=ALIAS,ou=MailAliases,...
-# gibt und löschen diesen gnadenlos.
+
+    # Wir gehen davon aus, daß es einen dn mail=ALIAS,ou=MailAliases,...
+    # gibt und löschen diesen gnadenlos.
 
-    if (!@ARGV) {
-	print "User: ";
-	chomp($_ = <>);
-	@ARGV = ($_);
+    if ( !@ARGV ) {
+        print "User: ";
+        chomp( $_ = <> );
+        @ARGV = ($_);
     }
 
     foreach (@ARGV) {
-	my $dn = "mail=$_,$abase";
+        my $dn = "mail=$_,$abase";
 
-	verbose("$_:\n");
-	verbose("\tdeleting $dn...");
-	my $r = $ldap->delete($dn);
+        verbose("$_:\n");
+        verbose("\tdeleting $dn...");
+        my $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");
 
     }
 }
@@ -180,45 +190,45 @@
 sub _list() {
     my $filter;
     @ARGV = ("*") unless @ARGV;
-    $filter = "(|" . join("", map { "(mail=$_)" } @ARGV) . ")";
+    $filter = "(|" . join( "", map { "(mail=$_)" } @ARGV ) . ")";
 
     my $r = $ldap->search(
-	filter => $filter,
-	base => $abase,
-	attrs => [qw/mail/, AT_FORWARDINGADDRESS],
+        filter => $filter,
+        base   => $abase,
+        attrs  => [ qw/mail/, AT_FORWARDINGADDRESS ],
     );
 
     die $r->error if $r->code;
 
     $Text::Wrap::columns = columns() || 80;
 
-    while (my $e = $r->shift_entry) {
-	my $mail = $e->get("mail");
+    while ( my $e = $r->shift_entry ) {
+        my $mail = $e->get("mail");
 
-	print wrap("", "\t", $e->get_value("mail") 
-	    . ": "
-	    . join(", ", $e->get(AT_FORWARDINGADDRESS))
-	    . "\n");
-	    
+        print wrap( "", "\t",
+                $e->get_value("mail") . ": "
+              . join( ", ", $e->get(AT_FORWARDINGADDRESS) )
+              . "\n" );
+
     }
 
-    $filter = "(|" . join("", map { "(".AT_GROUP."=$_)" } @ARGV) . ")";
+    $filter = "(|" . join( "", map { "(" . AT_GROUP . "=$_)" } @ARGV ) . ")";
     $r = $ldap->search(
-	filter => $filter,
-	base => $ubase,
-	attrs => [AT_GROUP, AT_PRIMARYADDRESS]
+        filter => $filter,
+        base   => $ubase,
+        attrs  => [ AT_GROUP, AT_PRIMARYADDRESS ]
     );
     die $r->error if $r->code;
 
     my %group;
-    while (my $e = $r->shift_entry) {
-	my $mail = $e->get_value(AT_PRIMARYADDRESS);
-	foreach my $g ($e->get_value(AT_GROUP)) {
-	    push @{$group{$g}}, $mail;
-	}
+    while ( my $e = $r->shift_entry ) {
+        my $mail = $e->get_value(AT_PRIMARYADDRESS);
+        foreach my $g ( $e->get_value(AT_GROUP) ) {
+            push @{ $group{$g} }, $mail;
+        }
     }
-    foreach my $g (keys %group) {
-	print wrap("", "\t", "$g⇒ " . join(", ", @{$group{$g}}) . "\n");
+    foreach my $g ( keys %group ) {
+        print wrap( "", "\t", "$g⇒ " . join( ", ", @{ $group{$g} } ) . "\n" );
     }
 }
 
@@ -238,4 +248,5 @@
 }
 
 1;
+
 # vim:sts=4 sw=4 aw ai sm:
diff -r 59c7146ec6f0 -r e3d571c7734d group.pm
--- a/group.pm	Tue Jul 31 10:46:37 2007 +0000
+++ b/group.pm	Tue Apr 14 12:34:29 2015 +0200
@@ -1,4 +1,5 @@
 package group;
+
 # © Heiko Schlittermann
 # $Id$
 # $URL$
@@ -6,18 +7,18 @@
 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::Constant
+  qw(LDAP_ALREADY_EXISTS LDAP_NO_SUCH_OBJECT LDAP_TYPE_OR_VALUE_EXISTS);
 use Net::LDAP::Entry;
-use Cyrus::IMAP::Admin;
+
+#use Cyrus::IMAP::Admin;
 use Text::Wrap;
 use password;
 
-
 my $Cf;
-my ($ldap, $ubase, $abase, $gbase);
+my ( $ldap, $ubase, $abase, $gbase );
 my ($imap);
-END { $imap and $imap = undef; };
-
+END { $imap and $imap = undef; }
 
 sub _add();
 sub _list();
@@ -40,16 +41,16 @@
     $Cf = shift;
 
     require constant;
-    import constant OU_ACCOUNTS => $Cf->ldap_ou_accounts;
-    import constant OU_ALIASES => $Cf->ldap_ou_aliases;
-    import constant OU_GROUPS => $Cf->ldap_ou_groups;
-    import constant OC_RECIPIENT => $Cf->ldap_oc_recipient;
-    import constant OC_ACCESSGROUP => $Cf->ldap_oc_accessgroup;
-    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 OU_GROUPS            => $Cf->ldap_ou_groups;
+    import constant OC_RECIPIENT         => $Cf->ldap_oc_recipient;
+    import constant OC_ACCESSGROUP       => $Cf->ldap_oc_accessgroup;
+    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_MEMBERUID => "memberUid";
+    import constant AT_MEMBERUID         => "memberUid";
 
     $gbase = OU_GROUPS . "," . $Cf->ldap_base;
     $ubase = OU_ACCOUNTS . "," . $Cf->ldap_base;
@@ -57,41 +58,46 @@
 }
 
 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 = 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 $@;
-
+    $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" };
+    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 group name for creation\n" if not @ARGV;
     my $group = shift @ARGV;
-    my @members = split /,/, $Cf->members||"";
-
+    my @members = split /,/, $Cf->members || "";
 
     my $dn = "cn=$group,$gbase";
     my $r;
@@ -100,41 +106,50 @@
 
     verbose("\t$dn...");
 
-    $r = $ldap->search(base => $gbase, filter => "(cn=$group)");
+    $r = $ldap->search( base => $gbase, filter => "(cn=$group)" );
 
     die $r->error if $r->code;
     die "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;
-	# Jetzt eine neue ID finden
-	foreach ($Cf->gid_min .. $Cf->gid_max) {
-	    # ist einfach eine lineare Suche, im Augenblick weiß ich nichts
-	    # clevereres
-	    my $r = $ldap->search(base => $gbase,
-		filter => "(gidNumber=$_)",
-		attrs => []);
-	    if ($r->count == 0) {
-		$e->add(gidNumber => $_);
-		last;
-	    }
-	}
-	$e->dn($dn);
-	$e->add(cn => $group);
+        $e = new Net::LDAP::Entry;
+
+        # Jetzt eine neue ID finden
+        foreach ( $Cf->gid_min .. $Cf->gid_max ) {
+
+            # ist einfach eine lineare Suche, im Augenblick weiß ich nichts
+            # clevereres
+            my $r = $ldap->search(
+                base   => $gbase,
+                filter => "(gidNumber=$_)",
+                attrs  => []
+            );
+            if ( $r->count == 0 ) {
+                $e->add( gidNumber => $_ );
+                last;
+            }
+        }
+        $e->dn($dn);
+        $e->add( cn => $group );
     }
 
-    grep /^CYRUS MAIL ACCESS GROUP/, $e->get("description") or $e->add(description => "CYRUS MAIL ACCESS GROUP");
+    grep /^CYRUS MAIL ACCESS GROUP/, $e->get("description")
+      or $e->add( description => "CYRUS MAIL ACCESS GROUP" );
 
-    if (defined $Cf->description) {
-	my @d = map { s/^(CYRUS MAIL ACCESS GROUP).*/"$1: ".$Cf->description/eg; $_ } $e->get("description");
-	$e->replace(description => \@d);
+    if ( defined $Cf->description ) {
+        my @d =
+          map { s/^(CYRUS MAIL ACCESS GROUP).*/"$1: ".$Cf->description/eg; $_ }
+          $e->get("description");
+        $e->replace( description => \@d );
     }
 
-    $e->replace(objectClass => [uniq $e->get("objectClass"), OC_ACCESSGROUP, "posixGroup"]);
-    $e->replace((AT_MEMBERUID) => [uniq $e->get(AT_MEMBERUID), @members]) if @members;
+    $e->replace( objectClass =>
+          [ uniq $e->get("objectClass"), OC_ACCESSGROUP, "posixGroup" ] );
+    $e->replace( (AT_MEMBERUID) => [ uniq $e->get(AT_MEMBERUID), @members ] )
+      if @members;
 
     $r = $e->update($ldap);
     die $r->error if $r->code;
@@ -144,122 +159,137 @@
 }
 
 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 (@groups) = @ARGV or die "Need groupname(s)\n";
 
-    my $r = $ldap->search(base => $gbase, 
-	filter => $_ = "(&(objectClass=".OC_ACCESSGROUP.")(|" . join("", map { "(cn=$_)" } @ARGV) . "))");
+    my $r = $ldap->search(
+        base   => $gbase,
+        filter => $_ =
+            "(&(objectClass="
+          . OC_ACCESSGROUP . ")(|"
+          . join( "", map { "(cn=$_)" } @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 $group = $e->get_value("cn");
-	my $dn = $e->dn;
+        my $group = $e->get_value("cn");
+        my $dn    = $e->dn;
 
-	my $modified = 0;
-	verbose "$group:";
+        my $modified = 0;
+        verbose "$group:";
 
-	verbose "\n\t$dn...";
+        verbose "\n\t$dn...";
 
-	if (defined $Cf->members) {
-	    my @m = split /,/, $Cf->members;
-	    grep { /^[+-]/ } @m or $e->delete(AT_MEMBERUID)
-		if $e->get_value(AT_MEMBERUID);
+        if ( defined $Cf->members ) {
+            my @m = split /,/, $Cf->members;
+            grep { /^[+-]/ } @m
+              or $e->delete(AT_MEMBERUID)
+              if $e->get_value(AT_MEMBERUID);
 
-	    foreach my $m (@m) {
-		if ($m =~ s/^-//) {
-		    $e->delete((AT_MEMBERUID) => [$m])
-		} else {
-		    $m =~ s/^\+//;
-		    $e->add((AT_MEMBERUID) => [$m])
-		}
-	    }
-	    $modified++;
-	}
+            foreach my $m (@m) {
+                if ( $m =~ s/^-// ) {
+                    $e->delete( (AT_MEMBERUID) => [$m] );
+                } else {
+                    $m =~ s/^\+//;
+                    $e->add( (AT_MEMBERUID) => [$m] );
+                }
+            }
+            $modified++;
+        }
 
-	if (defined $Cf->description) {
-	    my @d = map { s/^(CYRUS MAIL ACCESS GROUP).*/"$1: ".$Cf->description/eg; $_ } $e->get("description");
-	    $e->replace(description => \@d);
-	    $modified++;
-	}
-
-	$e->dump if $Cf->debug;
+        if ( defined $Cf->description ) {
+            my @d = map {
+                s/^(CYRUS MAIL ACCESS GROUP).*/"$1: ".$Cf->description/eg;
+                $_
+            } $e->get("description");
+            $e->replace( description => \@d );
+            $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...
 
-    if (!@ARGV) {
-	print "Group: ";
-	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 "Group: ";
+        chomp( $_ = <> );
+        @ARGV = ($_);
     }
 
     #my $filter = "(&((cn=%s)(objectClass=".OC_ACCESSGROUP.")))";
 
-    my $r = $ldap->search(base => $gbase,
-	filter => "(&(objectClass=".OC_ACCESSGROUP.")(|" . join("", map { "(cn=$_)" } @ARGV) . "))",
-	attrs => [AT_MEMBERUID, "cn"]); 
+    my $r = $ldap->search(
+        base   => $gbase,
+        filter => "(&(objectClass="
+          . OC_ACCESSGROUP . ")(|"
+          . join( "", map { "(cn=$_)" } @ARGV ) . "))",
+        attrs => [ AT_MEMBERUID, "cn" ]
+    );
 
-    if ($r->count == 0) {
-	verbose "No objects found\n";
-	return;
+    if ( $r->count == 0 ) {
+        verbose "No objects found\n";
+        return;
     }
 
-    while (my $e = $r->shift_entry) {
-	my $dn = $e->dn;
-	verbose $dn;
-	my $r = $ldap->delete($dn);
+    while ( my $e = $r->shift_entry ) {
+        my $dn = $e->dn;
+        verbose $dn;
+        my $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");
     }
 }
 
 sub _list() {
     my $filter;
     @ARGV = ("*") unless @ARGV;
+
     #$filter = "(|" . join("", map { "(uid=$_)" } @ARGV) . ")";
-    $filter = "(objectClass=".OC_ACCESSGROUP.")";
+    $filter = "(objectClass=" . OC_ACCESSGROUP . ")";
 
     my $r = $ldap->search(
-	filter => $filter,
-	base => $gbase,
-	attrs => [AT_MEMBERUID, qw/cn description/],
+        filter => $filter,
+        base   => $gbase,
+        attrs  => [ AT_MEMBERUID, qw/cn description/ ],
     );
     die $r->error if $r->code;
 
+    while ( my $e = $r->shift_entry ) {
+        my $cn    = $e->get_value("cn");
+        my $descr = $e->get_value("description");
+        my @uids  = $e->get_value(AT_MEMBERUID);
 
-    while (my $e = $r->shift_entry) {
-	my $cn = $e->get_value("cn");
-	my $descr = $e->get_value("description");
-	my @uids = $e->get_value(AT_MEMBERUID);
-
-	print "$cn: ($descr)\n";
-	print "\t", join "\n\t", @uids;
-	print "\n";
+        print "$cn: ($descr)\n";
+        print "\t", join "\n\t", @uids;
+        print "\n";
     }
 }
 
@@ -273,19 +303,23 @@
     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|| mkpasswd`);
-	die "pwgen/mkpasswd: $!" if $?;
+        if ( !@pw ) {
+            chomp( @pw = `pwgen 8 10 2>/dev/null|| mkpasswd` );
+            die "pwgen/mkpasswd: $!" if $?;
+        }
+        return shift @pw;
+
     }
-    return shift @pw;
-    
-} }
+}
 
 1;
+
 # vim:sts=4 sw=4 aw ai sm nohlsearch:
diff -r 59c7146ec6f0 -r e3d571c7734d imap.pm
--- a/imap.pm	Tue Jul 31 10:46:37 2007 +0000
+++ b/imap.pm	Tue Apr 14 12:34:29 2015 +0200
@@ -6,12 +6,13 @@
     verbose(" imap:");
     my $imap = connectImap();
 
-    $imap->setacl($mbox, $Cf->imap_admin => "lrswipcda");
-    if ($imap->list($mbox)) {
-	verbose("(exists)");
+    $imap->setacl( $mbox, $Cf->imap_admin => "lrswipcda" );
+    if ( $imap->list($mbox) ) {
+        verbose("(exists)");
     } else {
-	$imap->create($mbox) or die ":$@: $mbox\n";
-	$imap->setquota($mbox, STORAGE => 1024 * $Cf->imap_quota) or die ":$@: $mbox\n";
+        $imap->create($mbox) or die ":$@: $mbox\n";
+        $imap->setquota( $mbox, STORAGE => 1024 * $Cf->imap_quota )
+          or die ":$@: $mbox\n";
     }
     verbose("ok");
 
@@ -23,21 +24,23 @@
     verbose(" imap:");
     my $imap = connectImap();
 
-    $imap->setacl($mbox, $Cf->imap_admin, "rc");
+    $imap->setacl( $mbox, $Cf->imap_admin, "rc" );
 
-    if (not $imap->exists($mbox)) {
-	verbose("does not exist");
+    if ( not $imap->exists($mbox) ) {
+        verbose("does not exist");
     } else {
-	$imap->delete($mbox) or die "$@";
+        $imap->delete($mbox) or die "$@";
     }
     verbose("ok");
 }
 
-
 sub connectImap() {
-    my $imap = new Cyrus::IMAP::Admin($Cf->imap_server) or die "$@";
-    $imap->authenticate(-user => $Cf->imap_admin,
-	-password => $ENV{IMAP_PASS} || askPass("IMAP (" . $Cf->imap_admin .") password: "));
+    my $imap = new Cyrus::IMAP::Admin( $Cf->imap_server ) or die "$@";
+    $imap->authenticate(
+        -user     => $Cf->imap_admin,
+        -password => $ENV{IMAP_PASS}
+          || askPass( "IMAP (" . $Cf->imap_admin . ") password: " )
+    );
 
     return $imap;
 }
diff -r 59c7146ec6f0 -r e3d571c7734d ldapBase.pm
--- a/ldapBase.pm	Tue Jul 31 10:46:37 2007 +0000
+++ b/ldapBase.pm	Tue Apr 14 12:34:29 2015 +0200
@@ -1,4 +1,5 @@
 package ldapBase;
+
 # © Heiko Schlittermann
 # $Id$
 # $URL$
@@ -6,16 +7,15 @@
 use strict;
 use warnings;
 use Exporter();
-our @ISA = qw/Exporter/;
+our @ISA    = qw/Exporter/;
 our @EXPORT = qw/&ldapBase/;
 
-
-sub ldapBase(@) { 
-    no warnings 'once'; 
-    local @ARGV = grep { -f } @_; 
+sub ldapBase(@) {
+    no warnings 'once';
+    local @ARGV = grep { -f } @_;
     die "Can't find ldap.conf (searched @_)\n" if !@ARGV;
-    my $r = (reverse grep { /^\s*BASE\s+(.*?)\s*$/ and $_ = $1 } <>)[0];
+    my $r = ( reverse grep { /^\s*BASE\s+(.*?)\s*$/ and $_ = $1 } <> )[0];
     return $r;
-};
+}
 
 # vim:sts=4 sw=4 aw ai sm:
diff -r 59c7146ec6f0 -r e3d571c7734d ma
--- a/ma	Tue Jul 31 10:46:37 2007 +0000
+++ b/ma	Tue Apr 14 12:34:29 2015 +0200
@@ -5,10 +5,10 @@
 # $Id$
 #
 use constant USAGE => <<'#';
-Usage: !ME! account|alias|group --add|--list|--modify|--delete [options] [user|alias|shared mbox]
+Usage: !ME! account|alias|group|acl --add|--list|--modify|--delete [options] [user|alias|shared mbox]
        * common options *
        --ldap_server=s	LDAP-Server	[!$Cf->ldap_server!]
-       --ldap_base=s	LDAP-Basis	[!$Cf->ldap_base!]
+       --ldap_base=s	LDAP-Base	[!$Cf->ldap_base!]
        --ldap_admin=s	LDAP BIND DN	[!$Cf->ldap_admin!]
        --ldap_password=s		[!$Cf->ldap_password!]
 
@@ -19,7 +19,8 @@
        * account options *
        --default_domain	Default Domain  [!$Cf->default_domain!]
        --[no]mbox	Create MBox	[!$Cf->mbox!]
-       --imap_quota=i	Mail Quota (MB) [!$Cf->imap_quota!]
+       --imap_quota=i	Mail Quota      [!$Cf->imap_quota!]
+                        (Bytes)
        --address=s	Primary Mail	[!$Cf->address!]
        --other:s	Alternative Mail addresses
 		        (comma sep.)    [!$Cf->other!]
@@ -28,17 +29,28 @@
        --forward:s	Forwarding	[!$Cf->forward!]
 
        --fullname=s	Real Name	[!$Cf->fullname!]
-       --password=s	Passwort	[!$Cf->password!]
+       --password=s	Password	[!$Cf->password!]
+
+       * acl options *
+       --acl_admin=s    ACL Admin       [!$Cf->acl_admin!]
+       --acl_password=s Pasword         [!$Cf->acl_admin!]
+       --folder:s@      Folder(s)       [!join ',', @{$Cf->folder}!]
+       --acl=s          ACL list        [!$Cf->acl!]
+       --[no]recursive  Rekursive       [!$Cf->recursive!]
 
        * alias options *
        --members=s	List of Members	[!$Cf->members!]
 
        * shared mailbox options *
 
+       [ currently not supported ]
+
        * group options *
        --members=s	List of Members	[!$Cf->members!]
        --description=s  Descripton      [!$Cf->description!]
 
+       [ currently not supported ]
+
 Passwords for LDAP and IMAP can be read from environment LDAP_PASS resp. IMAP_PASS.
 Options can be read from config file named in $MA_CONF [!$ENV{MA_CONF}!].
 
@@ -52,13 +64,12 @@
 use warnings;
 
 use IO::File;
-use Cyrus::IMAP::Admin;
 use AppConfig qw(:expand);
 use File::Basename;
 use FindBin;
 use Carp;
 
-use lib ("$FindBin::RealBin/..", "$FindBin::RealBin/../lib/ma");
+use lib ( "$FindBin::RealBin/..", "$FindBin::RealBin/../lib/ma" );
 use Common;
 use ldapBase;
 
@@ -68,57 +79,61 @@
 sub help();
 
 my $Module = shift if @ARGV && $ARGV[0] !~ /^-/;
-   $Module ||= "UNKNOWN";
-
+$Module ||= "UNKNOWN";
 
-$SIG{__DIE__} = sub { die "\n".ME.": ", @_ };
-
+$SIG{__DIE__} = sub { die "\n" . ME . ": ", @_ };
 
 MAIN: {
 
     $Cf = new AppConfig Common::CONFIG or die;
 
-    if (exists $ENV{MA_CONF} and -f $ENV{MA_CONF}) {
-	my $f = $ENV{MA_CONF};
-	die ": $f is group/world readable/writeable\n" if  077 & (stat _)[2];
-	$Cf->file($f) or die;
+    if ( exists $ENV{MA_CONF} and -f $ENV{MA_CONF} ) {
+        my $f = $ENV{MA_CONF};
+        die ": $f is group/world readable/writeable\n" if 077 & ( stat _ )[2];
+        $Cf->file($f) or die;
     }
-    $Cf->getopt(\@ARGV) or die "Bad Usage.  Try --help.\n";
+    $Cf->getopt( \@ARGV ) or die "Bad Usage.  Try --help.\n";
 
     die "Need ldap base.\n" if not $Cf->ldap_base;
-    if ($Cf->ldap_admin !~ /\Q$Cf->ldap_base/) {
-	$Cf->ldap_admin($Cf->ldap_admin . "," . $Cf->ldap_base);
+    if ( $Cf->ldap_admin !~ /\Q$Cf->ldap_base/ ) {
+        $Cf->ldap_admin( $Cf->ldap_admin . "," . $Cf->ldap_base );
     }
 
-    if ($Cf->help) {
-	if (-t STDOUT and -x "/usr/bin/less") { open(X, "|less -FX") }
-	else { open(X, ">&STDOUT"); }
-	print X help();
-	exit 0;
+    if ( $Cf->help ) {
+        if   ( -t STDOUT and -x "/usr/bin/less" ) { open( X, "|less -FX" ) }
+        else                                      { open( X, ">&STDOUT" ); }
+        print X help();
+        exit 0;
     }
 
-    @_ = grep { $_ =~ /^\Q$Module\E/ } qw/account alias shared group/;
+    @_ = grep { $_ =~ /^\Q$Module\E/ } qw/account acl alias shared group/;
     die "Need module.  Try --help\n" if @_ == 0;
     die "Module ambigous. (@_)\n" if @_ > 1;
 
-    if ($_[0] eq 'account') {
-	require account;
-	account::import($Cf);
-	account::run();
-    } elsif ($_[0] eq 'alias') {
-	require alias;
-	alias::import($Cf);
-	alias::run();
-    } elsif ($_[0] eq 'shared') {
-	require shared;
-	shared::import($Cf);
-	shared::run();
-    } elsif ($_[0] eq 'group') {
-	require group;
-	group::import($Cf);
-	group::run();
+    if ( $_[0] eq 'account' ) {
+        require account;
+        account::import($Cf);
+        account::run();
+    } elsif ( $_[0] eq 'acl' ) {
+        require acl;
+        acl::import($Cf);
+        acl::run();
+    } elsif ( $_[0] eq 'alias' ) {
+        require alias;
+        alias::import($Cf);
+        alias::run();
+    } elsif ( $_[0] eq 'shared' ) {
+        die "Command '$_[0]' is currently not supported\n";
+        require shared;
+        shared::import($Cf);
+        shared::run();
+    } elsif ( $_[0] eq 'group' ) {
+        die "Command '$_[0]' is currently not supported\n";
+        require group;
+        group::import($Cf);
+        group::run();
     } else {
-	die "Shit";
+        die "Shit";
     }
 
 }
@@ -128,7 +143,7 @@
 }
 
 sub help() {
-    ($_ = USAGE) =~ s/!(.*?)!/(eval $1) || ""/eg;
+    ( $_ = USAGE ) =~ s/!(.*?)!/(eval $1) || ""/eg;
     return $_;
 }
 
diff -r 59c7146ec6f0 -r e3d571c7734d ma.8.pod
--- a/ma.8.pod	Tue Jul 31 10:46:37 2007 +0000
+++ b/ma.8.pod	Tue Apr 14 12:34:29 2015 +0200
@@ -1,3 +1,5 @@
+=encoding utf8
+
 =head1 NAME
 
 ma -- mailadmin tool
@@ -51,9 +53,9 @@
 
 =head1 OPTIONS
 
-=over 4
+=head2 OPTIONS für beide Sub-Kommandos
 
-=head2 OPTIONS für beide Sub-Kommandos
+=over 4
 
 =item B<--add>|B<--modify>|B<--delete>|B<--list>
 
@@ -142,6 +144,7 @@
 Es kann eine sprechende Bezeichnung für die Gruppe angegeben werden.  Dieser
 Bezeichnung wird immer(!) "CYRUS MAIL ACCESS GROUP" vorangestellt.
 
+=back
 
 =head1 EXAMPLES
 
@@ -190,6 +193,6 @@
 =back
 
 
-=head1 AUTHOR
+=head1 AUTHORS
 
-Heiko Schlittermann <hs@schlittermann.de>
+Heiko Schlittermann <hs@schlittermann.de>, Matthias Förste <foerste@schlittermann.de>
diff -r 59c7146ec6f0 -r e3d571c7734d ma.conf.ex
--- a/ma.conf.ex	Tue Jul 31 10:46:37 2007 +0000
+++ b/ma.conf.ex	Tue Apr 14 12:34:29 2015 +0200
@@ -18,7 +18,10 @@
 at_forwardingaddress = XXXMailForwardingAddress
 at_primaryaddress = XXXMailPrimaryAddress
 at_group = XXXMailGroup
+at_quota = XXXMailQuotaBytes
 
 [imap]
 admin = cyrus
 password = SECRET
+server = localhost
+port = 143
diff -r 59c7146ec6f0 -r e3d571c7734d password.pm
--- a/password.pm	Tue Jul 31 10:46:37 2007 +0000
+++ b/password.pm	Tue Apr 14 12:34:29 2015 +0200
@@ -5,9 +5,9 @@
     return undef if not -t;
 
     print $_[0];
-    system(stty => "-echo");
+    system( stty => "-echo" );
     my $ans = <STDIN>;
-    system(stty => "echo");
+    system( stty => "echo" );
     print "\n";
 
     chomp $ans;
diff -r 59c7146ec6f0 -r e3d571c7734d populate.ldif
--- a/populate.ldif	Tue Jul 31 10:46:37 2007 +0000
+++ b/populate.ldif	Tue Apr 14 12:34:29 2015 +0200
@@ -1,25 +1,43 @@
 # $Id$
 # $URL$
 
-dn: ou=Cyrus,o=ahreick
+dn: dc=heimrich-hannot,dc=de
+objectClass: top
+objectClass: dcObject
+objectClass: Organization
+dc: heimrich-hannot
+o: Heimrich-hANNOT gMbH
+
+dn: cn=admin,dc=heimrich-hannot,dc=de
+objectClass: simpleSecurityObject
+objectClass: organizationalRole
+cn: admin
+description: LDAP administrator
+userPassword: x
+
+dn: ou=Cyrus,dc=heimrich-hannot,dc=de
 objectClass: organizationalUnit
 ou: Cyrus
 description: cyrus mail administration objects
 
-dn: uid=root,ou=Cyrus,o=ahreick
+dn: uid=root,ou=Cyrus,dc=heimrich-hannot,dc=de
 objectClass: simpleSecurityObject
 objectClass: account
 uid: root
-userPassword: {crypt}KycC6akPBSoYY
+userPassword: x
 description: cyrus administrator 
 
-dn: ou=MailAccounts,o=ahreick
+dn: ou=Mail,dc=heimrich-hannot,dc=de
 objectClass: OrganizationalUnit
-ou: MailAccounts
+ou: Mail
+description: all mail objects
+
+dn: ou=Accounts,ou=Mail,dc=heimrich-hannot,dc=de
+objectClass: OrganizationalUnit
+ou: Accounts
 description: all mail users
 
-dn: ou=MailAliases,o=ahreick
+dn: ou=Aliases,ou=Mail,dc=heimrich-hannot,dc=de
 objectClass: OrganizationalUnit
-ou: MailAliases
+ou: Aliases
 description: global e-mail aliases
-
diff -r 59c7146ec6f0 -r e3d571c7734d shared.pm
--- a/shared.pm	Tue Jul 31 10:46:37 2007 +0000
+++ b/shared.pm	Tue Apr 14 12:34:29 2015 +0200
@@ -1,4 +1,5 @@
 package shared;
+
 # © Heiko Schlittermann
 # $Id$
 # $URL$
@@ -6,18 +7,18 @@
 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::Constant
+  qw(LDAP_ALREADY_EXISTS LDAP_NO_SUCH_OBJECT LDAP_TYPE_OR_VALUE_EXISTS);
 use Net::LDAP::Entry;
-use Cyrus::IMAP::Admin;
+
+#use Cyrus::IMAP::Admin;
 use Text::Wrap;
 use password;
 
-
 my $Cf;
-my ($ldap, $ubase, $abase);
+my ( $ldap, $ubase, $abase );
 my ($imap);
-END { $imap and $imap = undef; };
-
+END { $imap and $imap = undef; }
 
 sub _add();
 sub _list();
@@ -37,12 +38,12 @@
     $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;
 
     $ubase = OU_ACCOUNTS . "," . $Cf->ldap_base;
@@ -50,188 +51,205 @@
 }
 
 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 = 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 $@;
-
+    $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" };
+    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.
 
+    # 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 ( $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 $@;
-	}
+        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,...
+
+    # 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 $mbox = "user/$user";
 
-	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 (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,
+
+                # filter => "(|(mailPrimaryAddress=$a)(mail=$a))");
+                filter => "(mail=$a)"
+            );
+            die $r->error if $r->code;
+            die "$a ist schon vergeben\n" if $r->count;
 
-	if (my $pw = _mkpw($Cf->password)) {
-	    $e->replace(userPassword => $pw);
-	    $modified++;
-	}
+            $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;
+
+        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 $@;
-	}
+        # 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";
+        verbose "ok\n";
 
-	print "\n";
+        print "\n";
     }
 }
 
 sub _delete() {
 
-    if (!@ARGV) {
-	print "Mailbox: ";
-	chomp($_ = <>);
-	@ARGV = ($_);
+    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);
-	}
+        if ( $Cf->mbox ) {
+            verbose("\tdeleting mbox $mbox...");
+            $imap->delete($mbox) and verbose("ok")
+              or verbose( $imap->error );
+        }
 
-	verbose("\n");
+        verbose("\n");
     }
 
 }
@@ -240,32 +258,33 @@
     @ARGV = ("*") unless @ARGV;
 
     foreach (@ARGV) {
-	my @mboxes = $imap->list($_);
+        my @mboxes = $imap->list($_);
 
-	foreach (@mboxes) {
-	    my ($mbox, $attr, $sep) = @$_;
-	    next if $mbox =~ /^user$sep/;
+        foreach (@mboxes) {
+            my ( $mbox, $attr, $sep ) = @$_;
+            next if $mbox =~ /^user$sep/;
 
-	    print "$mbox: shared mailbox";
+            print "$mbox: shared mailbox";
 
-	    # Quota
-	    my %q = $imap->listquota($mbox);
-	    my ($used, $max) = map { int($_ / 1024) } @{$q{STORAGE}};
+            # 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";
+            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";
-	    }
-	}
-	
+            # ACL
+            my %acl = $imap->listacl($mbox);
+            foreach ( sort keys %acl ) {
+                print "\t$_: $acl{$_}\n";
+            }
+        }
+
     }
 }
 
@@ -279,19 +298,23 @@
     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|| mkpasswd`);
-	die "pwgen/mkpasswd: $!" if $?;
+        if ( !@pw ) {
+            chomp( @pw = `pwgen 8 10 2>/dev/null|| mkpasswd` );
+            die "pwgen/mkpasswd: $!" if $?;
+        }
+        return shift @pw;
+
     }
-    return shift @pw;
-    
-} }
+}
 
 1;
+
 # vim:sts=4 sw=4 aw ai sm nohlsearch: