# HG changeset patch # User Matthias Förste # Date 1429007669 -7200 # Node ID e3d571c7734da9c9a2b7a6ef2ebd8b3c7f4a6182 # Parent 59c7146ec6f0dd6b4d499df0452105a15f968572# Parent 2bb072311ed860ac183d1a7cf2a6f7546147398c [savepoint] diff -r 2bb072311ed8 -r e3d571c7734d account.pm --- 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: