[merged branch lv-doktor]
authorHeiko Schlittermann <hs@schlittermann.de>
Wed, 08 Apr 2009 11:10:26 +0200
changeset 18 6597387195d4
parent 2 3f6dece92961 (current diff)
parent 13 9850d169df53 (diff)
child 19 2518c7ff759b
[merged branch lv-doktor]
update-mailboxes
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/.perltidyrc	Wed Apr 08 11:10:26 2009 +0200
@@ -0,0 +1,1 @@
+--paren-tightness=2
--- a/update-mailboxes	Wed Apr 08 07:27:06 2009 +0000
+++ b/update-mailboxes	Wed Apr 08 11:10:26 2009 +0200
@@ -12,25 +12,24 @@
 use Pod::Usage;
 use if $ENV{DEBUG} => "Smart::Comments";
 
-my $ME       = basename $0;
-my $PRIVATE  = "$ENV{HOME}/private/accounts";
-my $LDAPCONF = "/etc/ldap/ldap.conf";
-my $SERVER   = "localhost";
-
-my $opt_delete  = 0;
-my $opt_help    = 0;
-my $opt_man     = 0;
-my $opt_verbose = -t STDOUT;
+my $ME        = basename $0;
+my $PRIVATE   = "$ENV{HOME}/private/accounts";
+my $LDAPCONF  = "/etc/ldap/ldap.conf";
+my $SERVER    = "localhost";
+my $BLACKLIST = "/etc/mail/update-mailboxes.blacklist";
+my $OULIST    = "/etc/mail/update-mailboxes.oulist";
 
-# USER und PASS kommen aus ~/private/accounts
-my ($USER, $PASS);
-{
-    open(my $priv, $PRIVATE);
-    chomp(
-        (undef, $USER, $PASS) = split /\s*:\s*/,
-        (grep /^cyrusadmin\s*:/, <$priv>)[0]
-    );
-}
+my $opt_delete   = 0;
+my $opt_protocol = undef;
+my $opt_help     = 0;
+my $opt_man      = 0;
+my $opt_verbose  = -t STDOUT;
+my $opt_dry      = 0;
+
+sub get_credentials($$);
+
+my ($USER,      $PASS)     = get_credentials($PRIVATE => "cyrusadmin");
+my ($LDAPADMIN, $LDAPPASS) = get_credentials($PRIVATE => "ldapadmin");
 
 my ($LDAPBASE, $LDAPSERVER);
 {
@@ -40,15 +39,32 @@
     ($LDAPSERVER) = /^\s*URI\s+(.*?)\s*$/ms;
 }
 
-my $LDAPADMIN = "cn=$USER,$LDAPBASE";
+my @OU;
+{
+    open(my $in, $OULIST);
+    @OU = grep /^(?!#)\S+/, map { /(\S+)/; $1 } <$in>;
+}
+
+my %BLACK;
+if (open(my $in, $BLACKLIST)) {
+    while (<$in>) {
+        chomp;
+        s/#.*//;
+        s/^\s*(.*)\s*$/$1/;
+        next if not $_;
+        $BLACK{$_} = 1;
+    }
+}
 
 MAIN: {
     Getopt::Long::Configure("bundling");
     GetOptions(
-        "d|delete"   => \$opt_delete,
-        "v|verbose!" => \$opt_verbose,
-        "man"        => \$opt_man,
-        "help"       => \$opt_help,
+        "p|protocol=s" => \$opt_protocol,
+        "d|delete"     => \$opt_delete,
+        "v|verbose!"   => \$opt_verbose,
+        "n|dry!"       => \$opt_dry,
+        "man"          => \$opt_man,
+        "help"         => \$opt_help,
     ) or pod2usage();
 
     pod2usage(-exitval => 0, -verbose => 3) if $opt_man;
@@ -66,42 +82,83 @@
 
     my %folder = map { $_, 1 } grep !m{/.*/}, $imap->folders();
 
-    # LDAP anzapfen
-    my $ldap = new Net::LDAP($LDAPSERVER, onerror => "die");
-    $ldap->bind($LDAPADMIN, password => $PASS);
-    my $msg = $ldap->search(
-        base   => $LDAPBASE,
-        filter => "(&(objectClass=user)(mail=*))",
-        attrs  => ["samAccountName"]
-    );
-    die "$ME: keine LDAP-Einträge gefunden\n" if $msg->count == 0;
+    # LDAP anzapfen und erstmal die Einträge sammeln (ist notwendig,
+    # weil wir jetzt mehrere Gruppen haben und der ADS leider nicht
+    # (ou:dn:=*) versteht
 
-    while (my $e = $msg->pop_entry) {
+    my @entries;
+    {
+        my $ldap = new Net::LDAP($LDAPSERVER, onerror => "die");
+        $ldap->bind($LDAPADMIN, password => $LDAPPASS);
+        foreach my $ou (@OU) {
+            eval {
+                my $msg = $ldap->search(
+                    base   => "$ou,$LDAPBASE",
+                    filter => "(&(samAccountName=*))",
+                    attrs  => ["samAccountName"],
+                );
+                push @entries, $msg->entries;
+            };
+            warn "problem using $ou,$LDAPBASE: $@\n" if $@;
+        }
 
-        my $folder = "user/" . $e->get_value("uid");
-        delete $folder{$folder};
+    }
+    die "$ME: keine LDAP-Einträge gefunden\n" if not @entries;
+
+    my %mbox;
+    foreach my $e (@entries) {
+
+        my $mbox = $e->get_value("samAccountName");
+
+        if ($BLACK{$mbox}) {
+            print "$mbox blacklisted\n";
+            next;
+        }
+
+        my $folder = "user/$mbox";
 
         print "$folder: ";
-        print "exists\n" and next if $imap->exists($folder);
+
+        if ($imap->exists($folder)) {
+            print "exists\n";
+            $mbox{$mbox} = $folder;
+            next;
+        }
+
+        if ($opt_dry) {
+            $mbox{$mbox} = $folder;
+            print " doing nothing (dry run)\n";
+            next;
+        }
 
         print "creating ";
-        $imap->create($folder)
-          or warn "$folder: $@\n"
-          and next;
+        if (!$imap->create($folder)) {
+            warn "$folder: $@\n";
+            next;
+        }
+
+        $mbox{$mbox} = $folder;
         print "acl ";
-        $imap->setacl($folder, $USER, "lrswipcda")
-          or warn "$folder: $@\n"
-          and next;
+
+        if (!$imap->setacl($folder, $USER, "lrswipcda")) {
+            warn "$folder: $@\n";
+            next;
+        }
 
         print "ok\n";
     }
 
+    delete @folder{ values %mbox };
+
+    # now check if there are still folders we didn't touch;
+    delete @folder{ map { "user/$_" } keys %mbox };
+
     if (keys %folder) {
         print scalar(keys %folder)
           . " unused mailboxe(s):\n" . "\t"
           . join("\n\t", keys %folder) . "\n";
 
-        if ($opt_delete) {
+        if ($opt_delete && $opt_dry == 0) {
             print "deleting unused mailboxes\n";
             foreach (keys %folder) {
                 print "$_ ";
@@ -109,9 +166,30 @@
                   or warn "$_: ($@)\n";
             }
         }
+        else {
+            %mbox = (%mbox, %folder);
+        }
+
     }
 
-    0;
+    if ($opt_protocol) {
+        open(my $o, ">$opt_protocol")
+          or die "Can't open >$opt_protocol: $!\n";
+        print $o join "\n", "# Liste der Mailboxen (nur zur Info)",
+          "# updater: $0 "
+          . '($Id$)',
+          sort(keys %mbox), "";
+    }
+
+    exit 0;
+}
+
+sub get_credentials($$) {
+    my ($file, $pattern) = @_;
+    open(my $fh, $file) or die "Can't open $file: $!\n";
+    my (undef, $u, $p) = (split /\s*:\s*/, (grep /^$pattern\s*:/, <$fh>)[0]);
+    chomp($u, $p);
+    return ($u, $p);
 }
 
 __END__
@@ -122,7 +200,7 @@
 
 =head1 SYNOPSIS
 
-	update-mailboxes [-v|--[no]verbose] [-d|--delete]
+	update-mailboxes [-n|--dry] [-p|--protocol file] [-v|--[no]verbose] [-d|--delete]
 	update-mailboxes --help | --man
 
 =head1 DESCRIPTION
@@ -138,10 +216,18 @@
 
 =over 4
 
+=item B<-n>|B<--dry>
+
+Macht nichts, außer aufzuschreiben, was es tun würde.
+
 =item B<-v>|B<--[no]verbose> 
 
 Etwas mehr Gesprächigkeit. (default: 1, wenn STDOUT ein TTY ist, sonst 0)
 
+=item B<-p>|B<--protocol> I<file>
+
+Schreibt eine Liste der aktuell existierenden Mailboxen in das File F<file>.
+
 =item B<-d>|B<--delete>
 
 Löscht Mailboxen, die dem ADS nicht bekannt sind. (default: 0)
@@ -152,6 +238,14 @@
 
 =back
 
+=head1 FILES
+
+In F</etc/mail/update-mailboxes.blacklist> ist eine Liste von ADS-Nutzern, für 
+die keine Mailbox angelegt werden soll!
+
+In F</etc/mail/update-mailboxes.oulist> ist eine Liste mit sub-Bäumen, die
+unterhalb der LDAP-Search-Base (aus F</etc/ldap/ldap.conf> durchsucht werden soll.
+
 =head1 AUTHOR
 
 Heiko Schlittermann
@@ -161,3 +255,6 @@
 L<cyradm(1)> L<ldapsearch(1)>
 
 =cut
+
+# vim:aw ts=4 sw=4 sts=4:
+