--- a/account.pm Thu Dec 15 16:08:16 2011 +0100
+++ b/account.pm Tue Apr 14 12:34:29 2015 +0200
@@ -1,24 +1,23 @@
package account;
-
# © Heiko Schlittermann
# $Id$
# $URL$
use strict;
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 Cyrus::IMAP::Admin;
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);
+END { $imap and $imap = undef; };
+
sub _add();
sub _list();
@@ -26,7 +25,6 @@
sub _mkpw($);
sub uniq(@);
sub verbose(@);
-sub _mbox($);
sub OU_ACCOUNTS();
sub OU_ALIASES();
@@ -35,82 +33,73 @@
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 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_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: " ) );
+ 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 = 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 $@;
+
- 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 $mbox = "user/$user";
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 $mbox = _mbox($user);
+ my $sn = (reverse split " ", $cn)[0];
+ my $mailGroup = [split /,/, $Cf->group || ""];
+ my $mailForwardingAddress = [split /,/, $Cf->forward || ""];
+ my $pw = _mkpw($Cf->password || "{pwgen}");
- if ( $mailPrimaryAddress !~ /@/ ) {
- $mailPrimaryAddress .= "@" . $Cf->default_domain;
+ if ($mailPrimaryAddress !~ /@/) {
+ $mailPrimaryAddress .= "@" . $Cf->default_domain;
}
+
my $dn = "uid=$user,$ubase";
my $r;
@@ -118,342 +107,257 @@
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;
- }
+ # 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]);
- $e->replace(
- objectClass => [
- uniq $e->get("objectClass"),
- qw/uidObject person/,
- OC_RECIPIENT
- ]
- );
- $e->replace( uid => [ uniq $e->get("uid"), $user ] );
+ $e->add((AT_ADDRESS) => $mailAddress);
+ $e->add((AT_PRIMARYADDRESS) => $mailPrimaryAddress);
+ $e->add(userPassword => $pw);
+ $e->add((AT_GROUP) => $mailGroup) if @$mailGroup;
+ $e->add((AT_FORWARDINGADDRESS) => $mailForwardingAddress) if @$mailForwardingAddress;
+
+ # $e->add(iusRestrictedMail => $Cf->internal) if $Cf->internal ne ":";
- $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( (AT_ACLGROUPS) => $Cf->imap_aclgroups ) if $Cf->imap_aclgroups;
+ $e->exists("sn") or $e->add(sn => $sn);
+ $e->exists("cn") or $e->add(cn => $cn);
- # $e->add(iusRestrictedMail => $Cf->internal) if $Cf->internal ne ":";
- $e->exists("sn") or $e->add( sn => $sn );
- $e->exists("cn") or $e->add( cn => $cn );
+ $r = $e->update($ldap);
+ die $r->error if $r->code;
- $r = $e->update($ldap);
- die $r->error if $r->code;
-
- verbose('ok');
- verbose(" Password: $pw")
- if not $Cf->password
- or $Cf->password eq "{pwgen}";
+ verbose("ok");
+ verbose(" Password: $pw") if not $Cf->password or $Cf->password eq "{pwgen}";
}
- if ( $Cf->mbox ) {
-
- verbose("\n\t$mbox...");
-
- if ( -d $mbox ) {
-
- verbose('exists')
-
- } elsif ( ( $imap->login( $user, $pw ) or die $@ )
- and $imap->capability->{acl} )
- {
+ if($Cf->mbox) {
+ verbose("\n\t$mbox...");
- # 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
- # (sofern wir das nicht eleganter über globale acl regeln können)
- # (lra: sicht-, les- und administrierbar)
- my $f = $imap->list( '', '*' ) or die $@;
+ if ($imap->list($mbox)) { verbose("exists") }
+ else {
+ $imap->create($mbox) and verbose("ok") or die $imap->error();
+ $imap->setacl($mbox, $Cf->imap_admin => "lrswipcda") or die $imap->error();
+ $imap->setquota($mbox, STORAGE => 1024 * $Cf->imap_quota) or die $imap->errror();
+ }
+ }
- #$imap->setacl( $f->[0]->[2], $Cf->imap_admin, 'lra' ) or die $@;
- verbose('ok');
-
- } else {
-
- verbose('will be created automatically on first email delivery');
-
- }
-
- }
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;
-
- my $user = $e->get_value("uid");
- my $dn = $e->dn;
-
- my $modified = 0;
- verbose "$user:";
+ while (my $e = $r->shift_entry) {
+ my $r;
- verbose "\n\t$dn...";
+ my $user = $e->get_value("uid");
+ my $dn = $e->dn;
+ my $mbox = "user/$user";
- # 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 ) {
+ my $modified = 0;
+ verbose "$user:";
- # Aus dem Fullnamen leiten wir cn und sn ab.
- my $sn = ( reverse split " ", $cn )[0];
+ verbose "\n\t$dn...";
- 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++;
- }
+ # Fix: iusMailOptions wurde erst später eingeführt, bei Bedarf also hinzufügen
+ #if (!grep /^iusMailOptions$/, @{$e->get("objectClass")}) {
+ #$e->add(objectClass => "iusMailOptions");
+ #}
- if ( defined $Cf->other ) {
- my @o = split /,/, $Cf->other;
- grep { /^[+-]/ } @o or $e->delete(AT_ADDRESS);
+ if (my $cn = $Cf->fullname) {
+ # Aus dem Fullnamen leiten wir cn und sn ab.
+ my $sn = (reverse split " ", $cn)[0];
- foreach my $a ( split /,/, $Cf->other ) {
- if ( $a =~ s/^-// ) {
- $e->delete( (AT_ADDRESS) => [$a] );
- } else {
- $a =~ s/^\+//;
+ 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++;
+ }
- # 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++;
- }
+ if (defined $Cf->other) {
+ my @o = split /,/, $Cf->other;
+ grep { /^[+-]/ } @o or $e->delete(AT_ADDRESS);
- if ( defined $Cf->group ) {
- my @g = split /,/, $Cf->group;
- grep { /^[+-]/ } @g
- or $e->delete(AT_GROUP)
- if $e->get_value(AT_GROUP);
+ 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;
- foreach my $g (@g) {
- if ( $g =~ s/^-// ) {
- $e->delete( (AT_GROUP) => [$g] );
- } else {
- $g =~ s/^\+//;
- $e->add( (AT_GROUP) => [$g] );
- }
- }
- $modified++;
- }
+ $e->add((AT_ADDRESS) => [$a])
+ }
+ }
+ $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->group) {
+ my @g = split /,/, $Cf->group;
+ grep { /^[+-]/ } @g or $e->delete(AT_GROUP)
+ if $e->get_value(AT_GROUP);
- foreach my $f (@f) {
- if ( $f =~ s/^-// ) {
- $e->delete( (AT_FORWARDINGADDRESS) => [$f] );
- } else {
- $f =~ s/^\+//;
- $e->add( (AT_FORWARDINGADDRESS) => [$f] );
- }
- }
- $modified++;
- }
-
- if ( defined $Cf->quota ) {
- $e->replace( (AT_QUOTA) => $Cf->quota );
- $modified++;
- }
-
- if ( defined $Cf->aclgroups ) {
+ foreach my $g (@g) {
+ if ($g =~ s/^-//) {
+ $e->delete((AT_GROUP) => [$g])
+ } else {
+ $g =~ s/^\+//;
+ $e->add((AT_GROUP) => [$g])
+ }
+ }
+ $modified++;
+ }
- my $ag = $Cf->aclgroups;
- my $lag = $e->get_value(AT_ACLGROUPS);
- # groups should be supplied with leading '$' for consistency with
- # dovecots imap acl, but should not be saved in ldap with it!
- $ag =~ s/(^|,[+-]?)\K\$//g;
+ if (defined $Cf->forward) {
+ my @f = split /,/, $Cf->forward;
+ grep { /^[+-]/ } @f or $e->delete(AT_FORWARDINGADDRESS)
+ if $e->get_value(AT_FORWARDINGADDRESS);
- if ( $ag =~ /(^|,\s*)[+-]/ ) {
- my %x;
- @x{ split /,/, $lag } = ();
- for ( split /,/, $ag ) {
- if (s/^-//) {
- delete $x{$_};
- } else {
- s/^\+//;
- $x{$_} = undef;
- }
- }
-
- $ag = join ',', sort keys %x;
-
- }
+ foreach my $f (@f) {
+ if ($f =~ s/^-//) {
+ $e->delete((AT_FORWARDINGADDRESS) => [$f]);
+ } else {
+ $f =~ s/^\+//;
+ $e->add((AT_FORWARDINGADDRESS) => [$f]);
+ }
+ }
+ $modified++;
+ }
- if ($ag) {
- $e->replace( (AT_ACLGROUPS) => $ag );
- } else {
- $e->delete( AT_ACLGROUPS ) if $lag;
- }
- $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++;
- #}
-
- $e->dump if $Cf->debug;
+ if ($modified) {
+ $r = $e->update($ldap);
+ die $r->error.$r->code if $r->code;
+ }
- 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 $@;
+ }
- verbose "ok\n";
+ verbose "ok\n";
- print "\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";
+ my $mbox = "user/$user";
- 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);
-
- if ( $r->code == LDAP_NO_SUCH_OBJECT ) {
- verbose("doesn't exist");
- } elsif ( $r->code == 0 ) {
- verbose("ok");
- } else {
- die $r->error;
- }
- verbose("\n");
+ verbose("\tdeleting $dn...");
+ $r = $ldap->delete($dn);
- if ( $Cf->mbox ) {
- my $m = _mbox($user);
- 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': $!" );
- }
- }
+ 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) {
+ verbose("\tdeleting mbox $mbox...");
+ $imap->delete($mbox) and verbose("ok")
+ or verbose($imap->error);
+ }
- print
- "Don't forget to remove acl entries for this user if any exist!\n";
- verbose("\n");
+ verbose("\n");
}
}
@@ -461,99 +365,55 @@
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) ) || "";
- my $ag = $e->get_value(AT_ACLGROUPS);
- $ag = '$' . join ',$', split /,/, $ag if $ag;
-
- print "$uid: $cn <$mr>";
-
- #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 $@;
+ 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)) || "";
+ my $mbox = "user/$uid";
- my %q;
- if ( $imap->capability->{quota} ) {
+ print "$uid: $cn <$mr>";
- # prepare patterns for shared folders - we want to ignore them in
- # quota calculations (TODO: what happens if a user has/attempts to
- # create a folder with the name of a namespace? he could avoid
- # quota limits that way?)
- my $ns = $imap->namespace() or die $@;
- my @p = map qr{^\Q$_->[0]\E}, ( @{ $ns->[1] }, @{ $ns->[2] } );
-
- my $folders = $imap->list( '', '*' ) or die $@;
-
- for my $f ( @{$folders} ) {
+ #if (($e->get_value("iusRestrictedMail")||"") eq "TRUE") {
+ #print " INTERNAL";
+ #}
- # single folder sieht wie folgt aus: [[flag1, flag2, ...], separator, foldername]
- #next if '\\Noselect' ~~ $f->[0];
- # ignore shared folders
- map { next if ( $f->[2] . $f->[1] ) =~ $_ } @p;
- my $q = $imap->getquotaroot( $f->[2] )
- or $@ eq
- q{IMAP Command : 'getquotaroot' failed. Response was : no - Not showing other users' quota.}
- or die $@;
- delete $q->{quotaroot};
- %q = ( %q, %{$q} );
-
- }
-
- }
-
- $imap->logout or die $@;
+ MBOX: {
+ if (!$imap->list($mbox)) {
+ print ", no mbox";
+ last MBOX;
+ }
+ print ", mbox";
+ my %q = $imap->listquota($mbox);
+ my ($used, $max) = map { int($_ / 1024) } @{$q{STORAGE}};
- # da wir uns anmelden konnten haben wir auch eine 'mbox'
- print ", mbox";
- my $has_quota;
- 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 ];
- $max ||= 1;
- print ", quota '$qr': $used/${max}MB "
- . int( 100 * $used / $max ) . "%";
- $has_quota = 1;
- }
- print ", no quota" unless $has_quota;
- print "\n";
+ if (!$max) {
+ print ", no quota";
+ last MBOX;
+ }
+ print ", quota ($used/$max): " . int(100 * $used/$max) . "%";
+ }
+ 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 wrap( "\t", "\t\t", "ACL Groups: $ag\n" ) if $ag;
+ 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;
}
}
@@ -568,44 +428,19 @@
return keys %x;
}
-{
- my @pw;
-
- sub _mkpw($) {
- my $in = $_[0];
-
- return $in unless $in and $in eq "{pwgen}";
+{ my @pw;
+sub _mkpw($) {
+ my $in = $_[0];
- if ( !@pw ) {
- chomp( @pw = `pwgen 8 10 2>/dev/null` );
- die "pwgen: $!" if $?;
- }
- return shift @pw;
-
- }
-}
-
-sub _mbox($) {
+ return $in unless $in and $in eq "{pwgen}";
- my ($user) = @_;
-
- my ( $localpart, $domain, $escapes );
-
- # assuming usernames of the form localpart@domain
- $user =~ /(.+)@(.+)$/;
- ( $localpart, $domain ) = ( $1, $2 );
-
- 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};
-
- return $mbox;
-
-}
+ if (!@pw) {
+ chomp(@pw = `pwgen 8 10 2>/dev/null|| mkpasswd`);
+ die "pwgen/mkpasswd: $!" if $?;
+ }
+ return shift @pw;
+
+} }
1;
-
# vim:sts=4 sw=4 aw ai sm nohlsearch: