diff -r 05d5ada37387 -r 36aca6fb0ab8 account.pm --- a/account.pm Fri Nov 25 15:29:45 2011 +0100 +++ b/account.pm Mon Nov 28 09:49:28 2011 +0100 @@ -1,4 +1,5 @@ package account; + # © Heiko Schlittermann # $Id$ # $URL$ @@ -7,18 +8,17 @@ 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 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, $imap_password ); +END { $imap and $imap = undef; } sub _add(); sub _list(); @@ -41,67 +41,74 @@ $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_QUOTA => $Cf->ldap_at_quota; $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 = + 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: " ); - 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 $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 $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); - if ($mailPrimaryAddress !~ /@/) { - $mailPrimaryAddress .= "@" . $Cf->default_domain; + if ( $mailPrimaryAddress !~ /@/ ) { + $mailPrimaryAddress .= "@" . $Cf->default_domain; } - my $dn = "uid=$user,$ubase"; my $r; @@ -109,74 +116,88 @@ 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; - } - - $e->replace(objectClass => [uniq $e->get("objectClass"), qw/uidObject person/, OC_RECIPIENT]); - $e->replace(uid => [uniq $e->get("uid"), $user]); + # 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->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(iusRestrictedMail => $Cf->internal) if $Cf->internal ne ":"; + $e->replace( + objectClass => [ + uniq $e->get("objectClass"), + qw/uidObject person/, + OC_RECIPIENT + ] + ); + $e->replace( uid => [ uniq $e->get("uid"), $user ] ); - $e->exists("sn") or $e->add(sn => $sn); - $e->exists("cn") or $e->add(cn => $cn); + $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(iusRestrictedMail => $Cf->internal) if $Cf->internal ne ":"; - $r = $e->update($ldap); - die $r->error if $r->code; + $e->exists("sn") or $e->add( sn => $sn ); + $e->exists("cn") or $e->add( cn => $cn ); - verbose('ok'); - verbose(" Password: $pw") if not $Cf->password or $Cf->password eq "{pwgen}"; + $r = $e->update($ldap); + die $r->error if $r->code; + + verbose('ok'); + verbose(" Password: $pw") + if not $Cf->password + or $Cf->password eq "{pwgen}"; } - if($Cf->mbox) { + if ( $Cf->mbox ) { - verbose("\n\t$mbox..."); + verbose("\n\t$mbox..."); - if (-d $mbox) { + if ( -d $mbox ) { verbose('exists') - } elsif($imap->capability->{acl}) { + } elsif ( $imap->capability->{acl} ) { - $imap->login($user, $pw) or die $@; + $imap->login( $user, $pw ) or die $@; + # 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 # (lra: sicht-, les- und administrierbar) - my $f = $imap->list('', '*') or die $@; - $imap->setacl($f->[0]->[2], $Cf->imap_admin, 'lra') or die $@; + my $f = $imap->list( '', '*' ) or die $@; + $imap->setacl( $f->[0]->[2], $Cf->imap_admin, 'lra' ) or die $@; verbose('ok'); } else { @@ -185,195 +206,210 @@ } - } 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 $user = $e->get_value("uid"); + my $dn = $e->dn; - 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 (defined $Cf->forward) { - my @f = split /,/, $Cf->forward; - grep { /^[+-]/ } @f or $e->delete(AT_FORWARDINGADDRESS) - if $e->get_value(AT_FORWARDINGADDRESS); + if ( defined $Cf->forward ) { + my @f = split /,/, $Cf->forward; + grep { /^[+-]/ } @f + or $e->delete(AT_FORWARDINGADDRESS) + if $e->get_value(AT_FORWARDINGADDRESS); - foreach my $f (@f) { - if ($f =~ s/^-//) { - $e->delete((AT_FORWARDINGADDRESS) => [$f]); - } else { - $f =~ s/^\+//; - $e->add((AT_FORWARDINGADDRESS) => [$f]); - } - } - $modified++; - } + foreach my $f (@f) { + if ( $f =~ s/^-// ) { + $e->delete( (AT_FORWARDINGADDRESS) => [$f] ); + } else { + $f =~ s/^\+//; + $e->add( (AT_FORWARDINGADDRESS) => [$f] ); + } + } + $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, - if (my $pw = _mkpw($Cf->password)) { - $e->replace(userPassword => $pw); - $modified++; - } + # 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 ($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; - 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... + + # 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"; - 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); + 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"); - - if ($Cf->mbox) { + 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 ) { my $m = _mbox($user); - if (not (defined $m and $m)) { + 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': $!"); + verbose( ( remove_tree $m) ? 'ok' : " Can't remove '$m': $!" ); } } - verbose("\n"); + verbose("\n"); } } @@ -381,43 +417,48 @@ 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) ) || ""; - 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)) || ""; + print "$uid: $cn <$mr>"; - print "$uid: $cn <$mr>"; - - #if (($e->get_value("iusRestrictedMail")||"") eq "TRUE") { - #print " INTERNAL"; - #} + #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 $@; - my $folders = $imap->list('', '*') or die $@; + $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 $@; + my $folders = $imap->list( '', '*' ) or die $@; my %q; - for my $f(@{$folders}) { + for my $f ( @{$folders} ) { + # single folder sieht wie folgt aus: [[flag1, flag2, ...], separator, foldername] - my $q = $imap->getquotaroot($f->[2]) or die $@; + my $q = $imap->getquotaroot( $f->[2] ) or die $@; delete $q->{quotaroot}; %q = ( %q, %{$q} ); } @@ -426,22 +467,24 @@ # da wir uns anmelden konnten haben wir auch eine 'mbox' print ", mbox"; my $has_quota; - for my $qr(keys %q) { - my @q = @{$q{$qr}}; + 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]; - print ", quota '$qr': $used/${max}MB " . int(100 * $used/$max) . "%"; + my ( $used, $max ) = map { int( $_ / 1024 ) } @q[ 0 .. 1 ]; + print ", quota '$qr': $used/${max}MB " + . int( 100 * $used / $max ) . "%"; $has_quota = 1; } print ", no quota" unless $has_quota; - print "\n"; + 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 "\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; } } @@ -456,33 +499,37 @@ 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`); - die "pwgen: $!" if $?; + if ( !@pw ) { + chomp( @pw = `pwgen 8 10 2>/dev/null` ); + die "pwgen: $!" if $?; + } + return shift @pw; + } - return shift @pw; - -} } +} sub _mbox($) { my ($user) = @_; - my ($localpart, $domain, $escapes); + my ( $localpart, $domain, $escapes ); # assuming usernames of the form localpart@domain $user =~ /(.+)@(.+)$/; - ($localpart, $domain) = ($1, $2); + ( $localpart, $domain ) = ( $1, $2 ); - die "Invalid username '$user'" unless $escapes->{'%u'} = $localpart - and $escapes->{'%1'} = substr $localpart, 0, 1 - and $escapes->{'%d'} = $domain; + 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}; @@ -491,4 +538,5 @@ } 1; + # vim:sts=4 sw=4 aw ai sm nohlsearch: