# HG changeset patch # User Matthias Förste foerste@schlittermann.de # Date 1322470168 -3600 # Node ID 36aca6fb0ab8963f86e5e3004c7c69ecd2a4322f # Parent 05d5ada37387fcd705bb4746db3a04cbcce86d32 [perltidy] diff -r 05d5ada37387 -r 36aca6fb0ab8 .perltidyrc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/.perltidyrc Mon Nov 28 09:49:28 2011 +0100 @@ -0,0 +1,2 @@ +-ce +-nolc diff -r 05d5ada37387 -r 36aca6fb0ab8 Common.pm --- a/Common.pm Fri Nov 25 15:29:45 2011 +0100 +++ b/Common.pm Mon Nov 28 09:49:28 2011 +0100 @@ -1,4 +1,5 @@ package Common; + # $Id$ # $URL$ use strict; @@ -9,68 +10,75 @@ GLOBAL => { DEFAULT => undef }, # * common * - add => { ARGS => "!", ALIAS => [qw/new create/] }, - list => { ARGS => "!", ALIAS => "ls" }, - modify => { ARGS => "!", ALIAS => "change" }, - delete => { ARGS => "!", ALIAS => "remove" }, + add => { ARGS => "!", ALIAS => [qw/new create/] }, + list => { ARGS => "!", ALIAS => "ls" }, + modify => { ARGS => "!", ALIAS => "change" }, + delete => { ARGS => "!", ALIAS => "remove" }, - ldap_base => { ARGS => "=s", DEFAULT => ldapBase(qw(/etc/openldap/ldap.conf /etc/ldap/ldap.conf)) }, - ldap_server => { ARGS => "=s", DEFAULT => "localhost" }, - ldap_bind_dn => { ARGS => "=s", DEFAULT => "cn=admin", ALIAS => "ldap_admin" }, - ldap_password =>{ ARGS => "=s" }, + ldap_base => { + ARGS => "=s", + DEFAULT => ldapBase(qw(/etc/openldap/ldap.conf /etc/ldap/ldap.conf)) + }, + ldap_server => { ARGS => "=s", DEFAULT => "localhost" }, + ldap_bind_dn => + { ARGS => "=s", DEFAULT => "cn=admin", ALIAS => "ldap_admin" }, + ldap_password => { ARGS => "=s" }, - help => { ARGS => "!" }, - debug => { ARGS => "!" }, + help => { ARGS => "!" }, + debug => { ARGS => "!" }, - description => { ARGS => "=s" }, - + description => { ARGS => "=s" }, # * account * default_domain => { ARGS => "=s", DEFAULT => "" }, - imap_server => { ARGS => "=s", DEFAULT => "localhost" }, - imap_port => { ARGS => "=s", DEFAULT => "143" }, - imap_admin => { ARGS => "=s", DEFAULT => $ENV{USER} }, - imap_password =>{ ARGS => "=s" }, - imap_quota => { ARGS => "=i", DEFAULT => 300 * 1024 * 1024, ALIAS => "quota" }, + imap_server => { ARGS => "=s", DEFAULT => "localhost" }, + imap_port => { ARGS => "=s", DEFAULT => "143" }, + imap_admin => { ARGS => "=s", DEFAULT => $ENV{USER} }, + imap_password => { ARGS => "=s" }, + imap_quota => + { ARGS => "=i", DEFAULT => 300 * 1024 * 1024, ALIAS => "quota" }, + # dovecots mail_location (%1, %u & %d supported) - imap_mail_location => { ARGS => "=s", DEFAULT => '/var/vmail/users/%d/%1/%u' }, + imap_mail_location => + { ARGS => "=s", DEFAULT => '/var/vmail/users/%d/%1/%u' }, - mbox => { ARGS => "!", DEFAULT => 1 }, - password => { ARGS => "=s" }, -# internal => { ARGS => "!", DEFAULT => ":", ALIAS => "restricted" }, + mbox => { ARGS => "!", DEFAULT => 1 }, + password => { ARGS => "=s" }, + + # internal => { ARGS => "!", DEFAULT => ":", ALIAS => "restricted" }, - other => { ARGS => ":s" }, - group => { ARGS => ":s" }, - forward => { ARGS => ":s" }, - fullname => { ARGS => "=s", ALIAS => "realname" }, - address => { ARGS => "=s", ALIAS => "primary" }, + other => { ARGS => ":s" }, + group => { ARGS => ":s" }, + forward => { ARGS => ":s" }, + fullname => { ARGS => "=s", ALIAS => "realname" }, + address => { ARGS => "=s", ALIAS => "primary" }, # * alias * group * - members => { ARGS => ":s" }, + members => { ARGS => ":s" }, # * shared * #access => { ARGS => ":s" }, # * group * - gid_min => { ARGS => "=i", DEFAULT => 60000 }, - gid_max => { ARGS => "=i", DEFAULT => 60100 }, + gid_min => { ARGS => "=i", DEFAULT => 60000 }, + gid_max => { ARGS => "=i", DEFAULT => 60100 }, # * ldap intern * - ldap_ou_aliases => { ARGS => "=s", DEFAULT => "ou=MailAliases" }, - ldap_ou_accounts => { ARGS => "=s", DEFAULT => "ou=MailAccounts" }, - ldap_ou_groups => { ARGS => "=s", DEFAULT => "ou=Groups" }, + ldap_ou_aliases => { ARGS => "=s", DEFAULT => "ou=MailAliases" }, + ldap_ou_accounts => { ARGS => "=s", DEFAULT => "ou=MailAccounts" }, + ldap_ou_groups => { ARGS => "=s", DEFAULT => "ou=Groups" }, - ldap_oc_alias => { ARGS => "=s", DEFAULT => "XXXmailAlias" }, - ldap_oc_recipient => { ARGS => "=s", DEFAULT => "XXXmailRecipient" }, - ldap_oc_accessgroup => { ARGS => "=s", DEFAULT => "XXXmailAccessGroup" }, + ldap_oc_alias => { ARGS => "=s", DEFAULT => "XXXmailAlias" }, + ldap_oc_recipient => { ARGS => "=s", DEFAULT => "XXXmailRecipient" }, + ldap_oc_accessgroup => { ARGS => "=s", DEFAULT => "XXXmailAccessGroup" }, - ldap_at_address => { ARGS => "=s", DEFAULT => "XXXmailAddress" }, - ldap_at_group => { ARGS => "=s", DEFAULT => "XXXmailGroup" }, - ldap_at_quota => { ARGS => "=s", DEFAULT => "XXXmailQuota" }, + ldap_at_address => { ARGS => "=s", DEFAULT => "XXXmailAddress" }, + ldap_at_group => { ARGS => "=s", DEFAULT => "XXXmailGroup" }, + ldap_at_quota => { ARGS => "=s", DEFAULT => "XXXmailQuota" }, ldap_at_forwardingaddress => - { ARGS => "=s", DEFAULT => "XXXmailForwardingAddress" }, - ldap_at_primaryaddress => - { ARGS => "=s", DEFAULT => "XXXmailPrimaryAddress" }, + { ARGS => "=s", DEFAULT => "XXXmailForwardingAddress" }, + ldap_at_primaryaddress => + { ARGS => "=s", DEFAULT => "XXXmailPrimaryAddress" }, ); diff -r 05d5ada37387 -r 36aca6fb0ab8 Makefile --- a/Makefile Fri Nov 25 15:29:45 2011 +0100 +++ b/Makefile Mon Nov 28 09:49:28 2011 +0100 @@ -76,3 +76,6 @@ %.gz: %.pod pod2man --utf8 --name $(basename $<) --section $(subst .,,$(suffix $@)) $< | gzip >$@ + +tidy: + perltidy -b $(SCRIPTS) $(PM) 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: diff -r 05d5ada37387 -r 36aca6fb0ab8 alias.pm --- a/alias.pm Fri Nov 25 15:29:45 2011 +0100 +++ b/alias.pm Mon Nov 28 09:49:28 2011 +0100 @@ -1,4 +1,5 @@ package alias; + # © Heiko Schlittermann # $Id$ # $URL$ @@ -7,17 +8,17 @@ use warnings; use Net::LDAP; use Net::LDAP::Constant qw( - LDAP_ALREADY_EXISTS - LDAP_NO_SUCH_OBJECT - LDAP_NO_SUCH_ATTRIBUTE - LDAP_TYPE_OR_VALUE_EXISTS); + LDAP_ALREADY_EXISTS + LDAP_NO_SUCH_OBJECT + LDAP_NO_SUCH_ATTRIBUTE + LDAP_TYPE_OR_VALUE_EXISTS); use Net::LDAP::Entry; use Text::Wrap; use password; my $Cf; -my ($ldap, $abase, $ubase); +my ( $ldap, $abase, $ubase ); sub _add(); sub _list(); @@ -37,142 +38,151 @@ $Cf = shift; require constant; - import constant OU_ACCOUNTS => $Cf->ldap_ou_accounts; - import constant OU_ALIASES => $Cf->ldap_ou_aliases; - import constant OC_ALIAS => $Cf->ldap_oc_alias; + import constant OU_ACCOUNTS => $Cf->ldap_ou_accounts; + import constant OU_ALIASES => $Cf->ldap_ou_aliases; + import constant OC_ALIAS => $Cf->ldap_oc_alias; import constant AT_FORWARDINGADDRESS => $Cf->ldap_at_forwardingaddress; - import constant AT_GROUP => $Cf->ldap_at_group; - import constant AT_PRIMARYADDRESS => $Cf->ldap_at_primaryaddress; + import constant AT_GROUP => $Cf->ldap_at_group; + import constant AT_PRIMARYADDRESS => $Cf->ldap_at_primaryaddress; $abase = OU_ALIASES . "," . $Cf->ldap_base; $ubase = OU_ACCOUNTS . "," . $Cf->ldap_base; } sub run($) { + # Eigentlich brauchen wir für alles 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; - - 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() { -# Wenn's den Alias schon gibt, wird er nicht mehr -# angelegt + + # Wenn's den Alias schon gibt, wird er nicht mehr + # angelegt die "Need alias name for creation\n" if not @ARGV; die "Need members\n" if not defined $Cf->members; - my $alias = shift @ARGV; + my $alias = shift @ARGV; my @members = split /,/, $Cf->members; - my $dn = "mail=$alias,$abase"; + my $dn = "mail=$alias,$abase"; my $r; verbose("$alias:\n"); verbose("\t$dn..."); - $r = $ldap->search(base => $abase, filter => "(mail=$alias)"); + $r = $ldap->search( base => $abase, filter => "(mail=$alias)" ); die $r->error if $r->code; die "Multiple entries not expected" if $r->count > 1; - - $r = $ldap->add($dn, attrs => [ - objectClass => OC_ALIAS, - mail => $alias, - (AT_FORWARDINGADDRESS) => \@members - ]); - if ($r->code == LDAP_ALREADY_EXISTS) { verbose "exists" } - elsif ($r->code) { die $r->error } - else { verbose "ok" } + + $r = $ldap->add( + $dn, + attrs => [ + objectClass => OC_ALIAS, + mail => $alias, + (AT_FORWARDINGADDRESS) => \@members + ] + ); + if ( $r->code == LDAP_ALREADY_EXISTS ) { verbose "exists" } + elsif ( $r->code ) { die $r->error } + else { verbose "ok" } verbose("\n"); } sub _modify() { -# Auch hier gehen wir davon aus, daß die dn direkt aus dem Alias-Namen folgt: -# dn: cn=USER,... -# Jetzt behandeln wir lediglich die Modifikation auf Basis eines -# alias-Namens! + + # Auch hier gehen wir davon aus, daß die dn direkt aus dem Alias-Namen folgt: + # dn: cn=USER,... + # Jetzt behandeln wir lediglich die Modifikation auf Basis eines + # alias-Namens! my (@users) = @ARGV or die "Need alias names(s)\n"; my @members = split /,/, $Cf->members; my @add = grep { s/^\+// } @_ = @members; - my @del = grep { s/^-// } @_ = @members; + my @del = grep { s/^-// } @_ = @members; my @set = grep { !/^[\+-]/ } @members; - foreach my $alias (@ARGV) { - my $dn = "mail=$alias,$abase"; - verbose "$alias:"; + my $dn = "mail=$alias,$abase"; + verbose "$alias:"; - my $r = $ldap->search(base => $abase, filter => "(mail=$alias)"); - die $r->error if $r->code; + my $r = $ldap->search( base => $abase, filter => "(mail=$alias)" ); + die $r->error if $r->code; - if ($r->count == 0) { - verbose " not found\n"; - next; - } + if ( $r->count == 0 ) { + verbose " not found\n"; + next; + } - while (my $e = $r->shift_entry) { + while ( my $e = $r->shift_entry ) { - verbose "\n\t" . $e->dn . " "; + verbose "\n\t" . $e->dn . " "; - if (@set) { - $e->replace((AT_FORWARDINGADDRESS) => \@set); - } else { - @add and $e->replace((AT_FORWARDINGADDRESS) => [uniq $e->get(AT_FORWARDINGADDRESS), @add]); - @del and $e->delete((AT_FORWARDINGADDRESS) => \@del); - } + if (@set) { + $e->replace( (AT_FORWARDINGADDRESS) => \@set ); + } else { + @add + and $e->replace( (AT_FORWARDINGADDRESS) => + [ uniq $e->get(AT_FORWARDINGADDRESS), @add ] ); + @del and $e->delete( (AT_FORWARDINGADDRESS) => \@del ); + } - $e->dump if $Cf->debug; + $e->dump if $Cf->debug; - my $r = $e->update($ldap); - if ($r->code == LDAP_NO_SUCH_ATTRIBUTE) { - verbose "no member"; - } elsif ($r->code) { - die $r->error . "/" . $r->code; - } else { - verbose "ok"; - } - } + my $r = $e->update($ldap); + if ( $r->code == LDAP_NO_SUCH_ATTRIBUTE ) { + verbose "no member"; + } elsif ( $r->code ) { + die $r->error . "/" . $r->code; + } else { + verbose "ok"; + } + } - print "\n"; + print "\n"; } } sub _delete() { -# Wir gehen davon aus, daß es einen dn mail=ALIAS,ou=MailAliases,... -# gibt und löschen diesen gnadenlos. + + # Wir gehen davon aus, daß es einen dn mail=ALIAS,ou=MailAliases,... + # gibt und löschen diesen gnadenlos. - if (!@ARGV) { - print "User: "; - chomp($_ = <>); - @ARGV = ($_); + if ( !@ARGV ) { + print "User: "; + chomp( $_ = <> ); + @ARGV = ($_); } foreach (@ARGV) { - my $dn = "mail=$_,$abase"; + my $dn = "mail=$_,$abase"; - verbose("$_:\n"); - verbose("\tdeleting $dn..."); - my $r = $ldap->delete($dn); + verbose("$_:\n"); + verbose("\tdeleting $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"); } } @@ -180,45 +190,45 @@ sub _list() { my $filter; @ARGV = ("*") unless @ARGV; - $filter = "(|" . join("", map { "(mail=$_)" } @ARGV) . ")"; + $filter = "(|" . join( "", map { "(mail=$_)" } @ARGV ) . ")"; my $r = $ldap->search( - filter => $filter, - base => $abase, - attrs => [qw/mail/, AT_FORWARDINGADDRESS], + filter => $filter, + base => $abase, + attrs => [ qw/mail/, AT_FORWARDINGADDRESS ], ); die $r->error if $r->code; $Text::Wrap::columns = columns() || 80; - while (my $e = $r->shift_entry) { - my $mail = $e->get("mail"); + while ( my $e = $r->shift_entry ) { + my $mail = $e->get("mail"); - print wrap("", "\t", $e->get_value("mail") - . ": " - . join(", ", $e->get(AT_FORWARDINGADDRESS)) - . "\n"); - + print wrap( "", "\t", + $e->get_value("mail") . ": " + . join( ", ", $e->get(AT_FORWARDINGADDRESS) ) + . "\n" ); + } - $filter = "(|" . join("", map { "(".AT_GROUP."=$_)" } @ARGV) . ")"; + $filter = "(|" . join( "", map { "(" . AT_GROUP . "=$_)" } @ARGV ) . ")"; $r = $ldap->search( - filter => $filter, - base => $ubase, - attrs => [AT_GROUP, AT_PRIMARYADDRESS] + filter => $filter, + base => $ubase, + attrs => [ AT_GROUP, AT_PRIMARYADDRESS ] ); die $r->error if $r->code; my %group; - while (my $e = $r->shift_entry) { - my $mail = $e->get_value(AT_PRIMARYADDRESS); - foreach my $g ($e->get_value(AT_GROUP)) { - push @{$group{$g}}, $mail; - } + while ( my $e = $r->shift_entry ) { + my $mail = $e->get_value(AT_PRIMARYADDRESS); + foreach my $g ( $e->get_value(AT_GROUP) ) { + push @{ $group{$g} }, $mail; + } } - foreach my $g (keys %group) { - print wrap("", "\t", "$g⇒ " . join(", ", @{$group{$g}}) . "\n"); + foreach my $g ( keys %group ) { + print wrap( "", "\t", "$g⇒ " . join( ", ", @{ $group{$g} } ) . "\n" ); } } @@ -238,4 +248,5 @@ } 1; + # vim:sts=4 sw=4 aw ai sm: 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: diff -r 05d5ada37387 -r 36aca6fb0ab8 imap.pm --- a/imap.pm Fri Nov 25 15:29:45 2011 +0100 +++ b/imap.pm Mon Nov 28 09:49:28 2011 +0100 @@ -6,12 +6,13 @@ verbose(" imap:"); my $imap = connectImap(); - $imap->setacl($mbox, $Cf->imap_admin => "lrswipcda"); - if ($imap->list($mbox)) { - verbose("(exists)"); + $imap->setacl( $mbox, $Cf->imap_admin => "lrswipcda" ); + if ( $imap->list($mbox) ) { + verbose("(exists)"); } else { - $imap->create($mbox) or die ":$@: $mbox\n"; - $imap->setquota($mbox, STORAGE => 1024 * $Cf->imap_quota) or die ":$@: $mbox\n"; + $imap->create($mbox) or die ":$@: $mbox\n"; + $imap->setquota( $mbox, STORAGE => 1024 * $Cf->imap_quota ) + or die ":$@: $mbox\n"; } verbose("ok"); @@ -23,21 +24,23 @@ verbose(" imap:"); my $imap = connectImap(); - $imap->setacl($mbox, $Cf->imap_admin, "rc"); + $imap->setacl( $mbox, $Cf->imap_admin, "rc" ); - if (not $imap->exists($mbox)) { - verbose("does not exist"); + if ( not $imap->exists($mbox) ) { + verbose("does not exist"); } else { - $imap->delete($mbox) or die "$@"; + $imap->delete($mbox) or die "$@"; } verbose("ok"); } - sub connectImap() { - my $imap = new Cyrus::IMAP::Admin($Cf->imap_server) or die "$@"; - $imap->authenticate(-user => $Cf->imap_admin, - -password => $ENV{IMAP_PASS} || askPass("IMAP (" . $Cf->imap_admin .") password: ")); + my $imap = new Cyrus::IMAP::Admin( $Cf->imap_server ) or die "$@"; + $imap->authenticate( + -user => $Cf->imap_admin, + -password => $ENV{IMAP_PASS} + || askPass( "IMAP (" . $Cf->imap_admin . ") password: " ) + ); return $imap; } diff -r 05d5ada37387 -r 36aca6fb0ab8 ldapBase.pm --- a/ldapBase.pm Fri Nov 25 15:29:45 2011 +0100 +++ b/ldapBase.pm Mon Nov 28 09:49:28 2011 +0100 @@ -1,4 +1,5 @@ package ldapBase; + # © Heiko Schlittermann # $Id$ # $URL$ @@ -6,16 +7,15 @@ use strict; use warnings; use Exporter(); -our @ISA = qw/Exporter/; +our @ISA = qw/Exporter/; our @EXPORT = qw/&ldapBase/; - -sub ldapBase(@) { - no warnings 'once'; - local @ARGV = grep { -f } @_; +sub ldapBase(@) { + no warnings 'once'; + local @ARGV = grep { -f } @_; die "Can't find ldap.conf (searched @_)\n" if !@ARGV; - my $r = (reverse grep { /^\s*BASE\s+(.*?)\s*$/ and $_ = $1 } <>)[0]; + my $r = ( reverse grep { /^\s*BASE\s+(.*?)\s*$/ and $_ = $1 } <> )[0]; return $r; -}; +} # vim:sts=4 sw=4 aw ai sm: diff -r 05d5ada37387 -r 36aca6fb0ab8 ma --- a/ma Fri Nov 25 15:29:45 2011 +0100 +++ b/ma Mon Nov 28 09:49:28 2011 +0100 @@ -61,7 +61,7 @@ use FindBin; use Carp; -use lib ("$FindBin::RealBin/..", "$FindBin::RealBin/../lib/ma"); +use lib ( "$FindBin::RealBin/..", "$FindBin::RealBin/../lib/ma" ); use Common; use ldapBase; @@ -71,59 +71,57 @@ sub help(); my $Module = shift if @ARGV && $ARGV[0] !~ /^-/; - $Module ||= "UNKNOWN"; - +$Module ||= "UNKNOWN"; -$SIG{__DIE__} = sub { die "\n".ME.": ", @_ }; - +$SIG{__DIE__} = sub { die "\n" . ME . ": ", @_ }; MAIN: { $Cf = new AppConfig Common::CONFIG or die; - if (exists $ENV{MA_CONF} and -f $ENV{MA_CONF}) { - my $f = $ENV{MA_CONF}; - die ": $f is group/world readable/writeable\n" if 077 & (stat _)[2]; - $Cf->file($f) or die; + if ( exists $ENV{MA_CONF} and -f $ENV{MA_CONF} ) { + my $f = $ENV{MA_CONF}; + die ": $f is group/world readable/writeable\n" if 077 & ( stat _ )[2]; + $Cf->file($f) or die; } - $Cf->getopt(\@ARGV) or die "Bad Usage. Try --help.\n"; + $Cf->getopt( \@ARGV ) or die "Bad Usage. Try --help.\n"; die "Need ldap base.\n" if not $Cf->ldap_base; - if ($Cf->ldap_admin !~ /\Q$Cf->ldap_base/) { - $Cf->ldap_admin($Cf->ldap_admin . "," . $Cf->ldap_base); + if ( $Cf->ldap_admin !~ /\Q$Cf->ldap_base/ ) { + $Cf->ldap_admin( $Cf->ldap_admin . "," . $Cf->ldap_base ); } - if ($Cf->help) { - if (-t STDOUT and -x "/usr/bin/less") { open(X, "|less -FX") } - else { open(X, ">&STDOUT"); } - print X help(); - exit 0; + if ( $Cf->help ) { + if ( -t STDOUT and -x "/usr/bin/less" ) { open( X, "|less -FX" ) } + else { open( X, ">&STDOUT" ); } + print X help(); + exit 0; } @_ = grep { $_ =~ /^\Q$Module\E/ } qw/account alias shared group/; die "Need module. Try --help\n" if @_ == 0; die "Module ambigous. (@_)\n" if @_ > 1; - if ($_[0] eq 'account') { - require account; - account::import($Cf); - account::run(); - } elsif ($_[0] eq 'alias') { - require alias; - alias::import($Cf); - alias::run(); - } elsif ($_[0] eq 'shared') { + if ( $_[0] eq 'account' ) { + require account; + account::import($Cf); + account::run(); + } elsif ( $_[0] eq 'alias' ) { + require alias; + alias::import($Cf); + alias::run(); + } elsif ( $_[0] eq 'shared' ) { die "Command '$_[0]' is currently not supported\n"; - require shared; - shared::import($Cf); - shared::run(); - } elsif ($_[0] eq 'group') { + require shared; + shared::import($Cf); + shared::run(); + } elsif ( $_[0] eq 'group' ) { die "Command '$_[0]' is currently not supported\n"; - require group; - group::import($Cf); - group::run(); + require group; + group::import($Cf); + group::run(); } else { - die "Shit"; + die "Shit"; } } @@ -133,7 +131,7 @@ } sub help() { - ($_ = USAGE) =~ s/!(.*?)!/(eval $1) || ""/eg; + ( $_ = USAGE ) =~ s/!(.*?)!/(eval $1) || ""/eg; return $_; } diff -r 05d5ada37387 -r 36aca6fb0ab8 ma.8.pod --- a/ma.8.pod Fri Nov 25 15:29:45 2011 +0100 +++ b/ma.8.pod Mon Nov 28 09:49:28 2011 +0100 @@ -193,6 +193,6 @@ =back -=head1 AUTHOR +=head1 AUTHORS -Heiko Schlittermann +Heiko Schlittermann , Matthias Förste diff -r 05d5ada37387 -r 36aca6fb0ab8 password.pm --- a/password.pm Fri Nov 25 15:29:45 2011 +0100 +++ b/password.pm Mon Nov 28 09:49:28 2011 +0100 @@ -5,9 +5,9 @@ return undef if not -t; print $_[0]; - system(stty => "-echo"); + system( stty => "-echo" ); my $ans = ; - system(stty => "echo"); + system( stty => "echo" ); print "\n"; chomp $ans; diff -r 05d5ada37387 -r 36aca6fb0ab8 shared.pm --- a/shared.pm Fri Nov 25 15:29:45 2011 +0100 +++ b/shared.pm Mon Nov 28 09:49:28 2011 +0100 @@ -1,4 +1,5 @@ package shared; + # © 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); +my ( $ldap, $ubase, $abase ); my ($imap); -END { $imap and $imap = undef; }; - +END { $imap and $imap = undef; } sub _add(); sub _list(); @@ -37,12 +38,12 @@ $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; $ubase = OU_ACCOUNTS . "," . $Cf->ldap_base; @@ -50,188 +51,205 @@ } 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. -# Die IMAP-Mailbox wird angelegt. + # Beim Hinzufügen tragen wir nur das unbedingt notwendige + # ein. + # Die IMAP-Mailbox wird angelegt. die "Need mailbox name for creation\n" if not @ARGV; my $mbox = shift @ARGV; verbose("shared mbox:\n"); - if($Cf->mbox) { - verbose("\n\t$mbox..."); + if ( $Cf->mbox ) { + verbose("\n\t$mbox..."); - if ($imap->list($mbox)) { verbose("exists") } - else { - $imap->create($mbox) and verbose("ok") or die $@; - $imap->setacl($mbox, $Cf->imap_admin => "lrswipcda") or die $@; - $imap->setquota($mbox, STORAGE => 1024 * $Cf->imap_quota) or die $@; - } + if ( $imap->list($mbox) ) { verbose("exists") } + else { + $imap->create($mbox) and verbose("ok") or die $@; + $imap->setacl( $mbox, $Cf->imap_admin => "lrswipcda" ) or die $@; + $imap->setquota( $mbox, STORAGE => 1024 * $Cf->imap_quota ) + or die $@; + } } - 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 $mbox = "user/$user"; + my $user = $e->get_value("uid"); + my $dn = $e->dn; + my $mbox = "user/$user"; - 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 (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++; + #} - if ($modified) { - $r = $e->update($ldap); - die $r->error.$r->code if $r->code; - } + $e->dump if $Cf->debug; + + 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 $@; - } + # 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() { - if (!@ARGV) { - print "Mailbox: "; - chomp($_ = <>); - @ARGV = ($_); + if ( !@ARGV ) { + print "Mailbox: "; + chomp( $_ = <> ); + @ARGV = ($_); } foreach my $mbox (@ARGV) { - if ($Cf->mbox) { - verbose("\tdeleting mbox $mbox..."); - $imap->delete($mbox) and verbose("ok") - or verbose($imap->error); - } + if ( $Cf->mbox ) { + verbose("\tdeleting mbox $mbox..."); + $imap->delete($mbox) and verbose("ok") + or verbose( $imap->error ); + } - verbose("\n"); + verbose("\n"); } } @@ -240,32 +258,33 @@ @ARGV = ("*") unless @ARGV; foreach (@ARGV) { - my @mboxes = $imap->list($_); + my @mboxes = $imap->list($_); - foreach (@mboxes) { - my ($mbox, $attr, $sep) = @$_; - next if $mbox =~ /^user$sep/; + foreach (@mboxes) { + my ( $mbox, $attr, $sep ) = @$_; + next if $mbox =~ /^user$sep/; - print "$mbox: shared mailbox"; + print "$mbox: shared mailbox"; - # Quota - my %q = $imap->listquota($mbox); - my ($used, $max) = map { int($_ / 1024) } @{$q{STORAGE}}; + # Quota + my %q = $imap->listquota($mbox); + my ( $used, $max ) = map { int( $_ / 1024 ) } @{ $q{STORAGE} }; - if (!$max) { - print ", no quota"; - } else { - print ", quota ($used/$max): " . int(100 * $used/$max) . "%"; - } - print "\n"; + if ( !$max ) { + print ", no quota"; + } else { + print ", quota ($used/$max): " + . int( 100 * $used / $max ) . "%"; + } + print "\n"; - # ACL - my %acl = $imap->listacl($mbox); - foreach (sort keys %acl) { - print "\t$_: $acl{$_}\n"; - } - } - + # ACL + my %acl = $imap->listacl($mbox); + foreach ( sort keys %acl ) { + print "\t$_: $acl{$_}\n"; + } + } + } } @@ -279,19 +298,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: