diff -r 05d5ada37387 -r 36aca6fb0ab8 group.pm
--- a/group.pm	Fri Nov 25 15:29:45 2011 +0100
+++ b/group.pm	Mon Nov 28 09:49:28 2011 +0100
@@ -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 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: