# HG changeset patch # User Matthias Förste # Date 1392980199 -3600 # Node ID 66bf85163780118da1aa2f028b639babf7996ba5 # Parent 59c7146ec6f0dd6b4d499df0452105a15f968572 merged changes from branch "foerste", but one rejected hunk diff -r 59c7146ec6f0 -r 66bf85163780 .hgignore --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/.hgignore Fri Feb 21 11:56:39 2014 +0100 @@ -0,0 +1,4 @@ +syntax: glob +.ok.* +*.[0-9].gz +x diff -r 59c7146ec6f0 -r 66bf85163780 .hgtags --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/.hgtags Fri Feb 21 11:56:39 2014 +0100 @@ -0,0 +1,1 @@ +6a6c18cddf46998e8a1acc933ff4afbacdb177b8 hhsp-dovecot-0.1 diff -r 59c7146ec6f0 -r 66bf85163780 .perltidyrc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/.perltidyrc Fri Feb 21 11:56:39 2014 +0100 @@ -0,0 +1,2 @@ +-ce +-noll diff -r 59c7146ec6f0 -r 66bf85163780 Common.pm --- a/Common.pm Tue Jul 31 10:46:37 2007 +0000 +++ b/Common.pm Fri Feb 21 11:56:39 2014 +0100 @@ -1,4 +1,5 @@ package Common; + # $Id$ # $URL$ use strict; @@ -9,64 +10,84 @@ 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_admin => { ARGS => "=s", DEFAULT => $ENV{USER} }, - imap_password =>{ ARGS => "=s" }, - imap_quota => { ARGS => "=i", DEFAULT => 300, 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" }, + imap_aclgroups => { ARGS => "=s", ALIAS => "aclgroups" }, + + # dovecots mail_location (%1, %u & %d supported) + imap_mail_location => + { ARGS => "=s", DEFAULT => '/var/vmail/users/%d/%1/%u' }, + + mbox => { ARGS => "!", DEFAULT => 1 }, + password => { ARGS => "=s" }, - mbox => { ARGS => "!", DEFAULT => 1 }, - password => { ARGS => "=s" }, -# internal => { ARGS => "!", DEFAULT => ":", ALIAS => "restricted" }, + # 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" }, + + # * acl * + acl_admin => { ARGS => "=s" }, + acl_password => { ARGS => "=s" }, + folder => { ARGS => ":s@" }, + acl => { ARGS => "=s" }, + recursive => { ARGS => "!", DEFAULT => 0 }, # * 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_address => { ARGS => "=s", DEFAULT => "XXXmailAddress" }, + ldap_at_group => { ARGS => "=s", DEFAULT => "XXXmailGroup" }, + ldap_at_quota => { ARGS => "=s", DEFAULT => "XXXmailQuota" }, + ldap_at_aclgroups => { ARGS => "=s", DEFAULT => "XXXmailACLGroups" }, 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 59c7146ec6f0 -r 66bf85163780 Makefile --- a/Makefile Tue Jul 31 10:46:37 2007 +0000 +++ b/Makefile Fri Feb 21 11:56:39 2014 +0100 @@ -75,4 +75,7 @@ rubber ${RUBBER_FLAGS} $< %.gz: %.pod - iconv -f utf8 -t iso8859-15 $< | pod2man --name $(basename $<) --section $(subst .,,$(suffix $@)) | gzip >$@ + pod2man --utf8 --name $(basename $<) --section $(subst .,,$(suffix $@)) $< | gzip >$@ + +tidy: + perltidy -b $(SCRIPTS) $(PM) diff -r 59c7146ec6f0 -r 66bf85163780 account.pm --- a/account.pm Tue Jul 31 10:46:37 2007 +0000 +++ b/account.pm Fri Feb 21 11:56:39 2014 +0100 @@ -1,23 +1,24 @@ 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 Cyrus::IMAP::Admin; +use Mail::IMAPTalk; use Text::Wrap; use password; - my $Cf; -my ($ldap, $ubase, $abase); -my ($imap); -END { $imap and $imap = undef; }; - +my ( $ldap, $ubase, $abase ); +my ( $imap, $imap_password ); +END { $imap and $imap = undef; } sub _add(); sub _list(); @@ -25,6 +26,7 @@ sub _mkpw($); sub uniq(@); sub verbose(@); +sub _mbox($); sub OU_ACCOUNTS(); sub OU_ALIASES(); @@ -33,73 +35,82 @@ 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 = 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 = + 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 - my $mbox = "user/$user"; + $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; @@ -365,55 +376,99 @@ 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; - 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"; + print "$uid: $cn <$mr>"; + + #if (($e->get_value("iusRestrictedMail")||"") eq "TRUE") { + #print " INTERNAL"; + #} - print "$uid: $cn <$mr>"; + # 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 $@; - #if (($e->get_value("iusRestrictedMail")||"") eq "TRUE") { - #print " INTERNAL"; - #} + my %q; + if ( $imap->capability->{quota} ) { + + # 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} ) { - 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}}; + # 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 $@; - if (!$max) { - print ", no quota"; - last MBOX; - } - print ", quota ($used/$max): " . int(100 * $used/$max) . "%"; - } - print "\n"; + # 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"; - 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; + print wrap( "\t", "\t\t", "ACL Groups: $ag\n" ) if $ag; } } @@ -428,19 +483,44 @@ return keys %x; } -{ my @pw; -sub _mkpw($) { - my $in = $_[0]; +{ + my @pw; + + sub _mkpw($) { + my $in = $_[0]; + + return $in unless $in and $in eq "{pwgen}"; - return $in unless $in and $in eq "{pwgen}"; + if ( !@pw ) { + chomp( @pw = `pwgen 8 10 2>/dev/null` ); + die "pwgen: $!" if $?; + } + return shift @pw; + + } +} + +sub _mbox($) { - if (!@pw) { - chomp(@pw = `pwgen 8 10 2>/dev/null|| mkpasswd`); - die "pwgen/mkpasswd: $!" if $?; - } - return shift @pw; - -} } + 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; + +} 1; + # vim:sts=4 sw=4 aw ai sm nohlsearch: diff -r 59c7146ec6f0 -r 66bf85163780 account.pm.rej --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/account.pm.rej Fri Feb 21 11:56:39 2014 +0100 @@ -0,0 +1,530 @@ +--- account.pm Mon Mar 02 13:51:24 2009 +0000 ++++ account.pm Thu Dec 15 16:08:16 2011 +0100 +@@ -118,257 +129,342 @@ + + 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( (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->add(iusRestrictedMail => $Cf->internal) if $Cf->internal ne ":"; ++ # $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); ++ $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 ( $Cf->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 $@; +- } ++ verbose("\n\t$mbox..."); ++ ++ if ( -d $mbox ) { ++ ++ verbose('exists') ++ ++ } elsif ( ( $imap->login( $user, $pw ) or die $@ ) ++ and $imap->capability->{acl} ) ++ { ++ ++ # 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 $@; ++ ++ #$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; ++ 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 $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 ) { + +- 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++; +- } ++ # Aus dem Fullnamen leiten wir cn und sn ab. ++ my $sn = ( reverse split " ", $cn )[0]; + +- if (defined $Cf->other) { +- my @o = split /,/, $Cf->other; +- grep { /^[+-]/ } @o or $e->delete(AT_ADDRESS); ++ 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++; ++ } + +- foreach my $a (split /,/, $Cf->other) { +- if ($a =~ s/^-//) { +- $e->delete((AT_ADDRESS) => [$a]) +- } else { +- $a =~ s/^\+//; ++ if ( defined $Cf->other ) { ++ my @o = split /,/, $Cf->other; ++ grep { /^[+-]/ } @o or $e->delete(AT_ADDRESS); + +- # 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 $a ( split /,/, $Cf->other ) { ++ if ( $a =~ s/^-// ) { ++ $e->delete( (AT_ADDRESS) => [$a] ); ++ } else { ++ $a =~ s/^\+//; + +- $e->add((AT_ADDRESS) => [$a]) +- } +- } +- $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; + +- if (defined $Cf->group) { +- my @g = split /,/, $Cf->group; +- grep { /^[+-]/ } @g or $e->delete(AT_GROUP) +- if $e->get_value(AT_GROUP); ++ $e->add( (AT_ADDRESS) => [$a] ); ++ } ++ } ++ $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->group ) { ++ my @g = split /,/, $Cf->group; ++ grep { /^[+-]/ } @g ++ or $e->delete(AT_GROUP) ++ if $e->get_value(AT_GROUP); + +- if (defined $Cf->forward) { +- my @f = split /,/, $Cf->forward; +- grep { /^[+-]/ } @f or $e->delete(AT_FORWARDINGADDRESS) +- if $e->get_value(AT_FORWARDINGADDRESS); ++ foreach my $g (@g) { ++ if ( $g =~ s/^-// ) { ++ $e->delete( (AT_GROUP) => [$g] ); ++ } else { ++ $g =~ s/^\+//; ++ $e->add( (AT_GROUP) => [$g] ); ++ } ++ } ++ $modified++; ++ } + +- foreach my $f (@f) { +- if ($f =~ s/^-//) { +- $e->delete((AT_FORWARDINGADDRESS) => [$f]); +- } else { +- $f =~ s/^\+//; +- $e->add((AT_FORWARDINGADDRESS) => [$f]); +- } +- } +- $modified++; +- } ++ if ( defined $Cf->forward ) { ++ my @f = split /,/, $Cf->forward; ++ grep { /^[+-]/ } @f ++ or $e->delete(AT_FORWARDINGADDRESS) ++ if $e->get_value(AT_FORWARDINGADDRESS); + +- 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++; +- } ++ foreach my $f (@f) { ++ if ( $f =~ s/^-// ) { ++ $e->delete( (AT_FORWARDINGADDRESS) => [$f] ); ++ } else { ++ $f =~ s/^\+//; ++ $e->add( (AT_FORWARDINGADDRESS) => [$f] ); ++ } ++ } ++ $modified++; ++ } + +- if (my $pw = _mkpw($Cf->password)) { +- $e->replace(userPassword => $pw); +- $modified++; +- } ++ if ( defined $Cf->quota ) { ++ $e->replace( (AT_QUOTA) => $Cf->quota ); ++ $modified++; ++ } + +- #if ($Cf->internal ne ":") { +- #$e->replace(iusRestrictedMail => $Cf->internal ? "TRUE" : "FALSE"); +- #$modified++; +- #} ++ if ( defined $Cf->aclgroups ) { + +- $e->dump if $Cf->debug; ++ 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 ($modified) { +- $r = $e->update($ldap); +- die $r->error.$r->code if $r->code; +- } ++ if ( $ag =~ /(^|,\s*)[+-]/ ) { ++ my %x; ++ @x{ split /,/, $lag } = (); ++ for ( split /,/, $ag ) { ++ if (s/^-//) { ++ delete $x{$_}; ++ } else { ++ s/^\+//; ++ $x{$_} = undef; ++ } ++ } + +- # 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 $@; +- } ++ $ag = join ',', sort keys %x; + +- verbose "ok\n"; ++ } + +- print "\n"; ++ 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 $pw = _mkpw( $Cf->password ) ) { ++ $e->replace( userPassword => $pw ); ++ $modified++; ++ } ++ ++ #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; ++ } ++ ++ 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 "User: "; +- 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 "User: "; ++ chomp( $_ = <> ); ++ @ARGV = ($_); + } + ++ foreach (@ARGV) { ++ my $user = $_; ++ my $dn = "uid=$user,$ubase"; + +- foreach (@ARGV) { +- 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); + +- 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 ($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); +- } ++ 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': $!" ); ++ } ++ } + +- verbose("\n"); ++ print ++ "Don't forget to remove acl entries for this user if any exist!\n"; ++ verbose("\n"); + + } + } diff -r 59c7146ec6f0 -r 66bf85163780 acl.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/acl.pm Fri Feb 21 11:56:39 2014 +0100 @@ -0,0 +1,461 @@ +package acl; + +# © Heiko Schlittermann +# $Id$ +# $URL$ + +use strict; +use warnings; +require 5.10.0; +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::Entry; +use Mail::IMAPTalk; +use Text::Wrap; +use password; +use Term::ReadKey; + +my $Cf; +my ( $ldap, $ubase, $abase ); +my ( $imap, $acl_password, $nspat ); +END { $imap and $imap = undef; } + +sub _list(); +sub _mkpw($); + +sub list_by_user($@); +sub list_by_folder($); +sub list_groups(@); +sub uniq(@); +sub verbose(@); +sub prompt($$); +sub imap_list($$); +sub imap_rlist($$$); +sub acl_folders($); + +sub OU_ACCOUNTS(); +sub OU_ALIASES(); +sub AT_PRIMARYADDRESS(); +sub OC_RECIPIENT(); +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 AT_FORWARDINGADDRESS => $Cf->ldap_at_forwardingaddress; + 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: " ) ); + die $r->error, "\n" if $r->code; + + $acl_password = + $Cf->acl_password + || $ENV{IMAP_PASS} + || password::ask( "IMAP (" . $Cf->acl_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->login( $Cf->acl_admin, $acl_password ) or die $@; + die "IMAP Server does not advertise acl support" + unless $imap->capability->{acl}; + + $imap->set_tracing(1) if $ENV{TRACE}; + + # requires an imap connection + my $ns = $imap->namespace() or die "No public namespaces available: $@"; + $nspat = []; + for ( @{ $ns->[2] } ) { + ( my $n = $_->[0] ) =~ s/$_->[1]$//; + push @{$nspat}, [ qr/\Q$n\E($_->[1]|$)/, $_->[1] ]; + } + + if ( $Cf->add ) { _modify() } + elsif ( $Cf->delete ) { $Cf->acl('delete'); _modify() } + elsif ( $Cf->list ) { _list() } + elsif ( $Cf->modify ) { _modify() } + else { die "Need action (--add|--delete|--list|--modify)\n" } + +} + +sub _modify() { + + # Auch hier gehen wir davon aus, daß die dn direkt aus dem User-Namen folgt: + # dn: uid=USER,... + my @users; + @ARGV or die "Need user(s)\n"; + $Cf->folder ~~ [] and die "Need folders(s)\n"; + $Cf->acl or die "Need acl\n"; + $Cf->recursive + and $Cf->create + and die "Use either --recursive or --create but not both\n"; + + my $r = $ldap->search( + base => $ubase, + filter => "(|" . join( "", map { "(uid=$_)" } @ARGV ) . ")" + ); + die $r->error if $r->code; + unless ( $r->count ) { + prompt( 'No matching user found in ldap. Continue? (y/N)', "n\n" ) =~ + /y/i + or exit 0; + @users = @ARGV; + } + + while ( my $e = ( $r->shift_entry or shift @users ) ) { + + my ( $user, $dn ); + + if ( ref $e eq 'Net::LDAP::Entry' ) { + $user = $e->get_value("uid"); + $dn = $e->dn; + } else { + $user = $e; + $dn = '[dn not available]'; + } + + my $modified = 0; + verbose "$user:\n"; + verbose "\t$dn...\n"; + + for my $folder ( @{ $Cf->folder } ) { + + $imap->create($folder) + or die "Can't create folder '$folder': $@" + if $Cf->create; + + my @folders = @{ acl_folders($folder) } or die "Got empty folderlist - does '$folder' exist? (use --create if you want me to create it)"; + for my $f ( @folders ) { + + if ( $Cf->acl eq 'delete' ) { + $imap->deleteacl( $f, $user ) or die "Can't delete acl: $@"; + verbose "\t$f: none\n"; + } else { + $imap->setacl( $f, $user, $Cf->acl ) + or die "Can't set acl: $@"; + verbose "\t$f: " . $Cf->acl . "\n"; + } + + } + + } + + # Fix: iusMailOptions wurde erst später eingeführt, bei Bedarf also hinzufügen + #if (!grep /^iusMailOptions$/, @{$e->get("objectClass")}) { + #$e->add(objectClass => "iusMailOptions"); + #} + + #if ($Cf->internal ne ":") { + #$e->replace(iusRestrictedMail => $Cf->internal ? "TRUE" : "FALSE"); + #$modified++; + #} + + verbose "ok\n"; + print "\n"; + + } + +} + +sub _list() { + + #@ARGV = ("*") unless @ARGV; + + die "option acl_admin required\n" unless $Cf->acl_admin; + + if ( $Cf->aclgroups ) { + + warn "--folder option ignored when listing groups" + unless $Cf->folder ~~ []; + list_groups(@ARGV); + + } elsif (@ARGV) { + + # my $uid = $ARGV[0]; + # # searching by more than use user may be too expensive + # die "Searching by more than one user not supported" unless @ARGV == 1 or $uid =~ /\*/; + #list_by_user($_) for @ARGV; + + warn "--folder option ignored when listing by user" + unless $Cf->folder ~~ []; + list_by_user( $imap, @ARGV ); + + } elsif ( not $Cf->folder ~~ [] ) { + + list_by_folder($_) for @{ $Cf->folder }; + + } else { + + die + "Need either user or --folder. If you really want to search all users then supply the pattern '*'."; + + } + +} + +sub list_groups(@) { + + @_ = ('*') unless @_; + my @ag = split ',', $Cf->imap_aclgroups; + my $ag_all = 1 if '*' ~~ @ag; + my $ag_att = AT_ACLGROUPS; + my $filter = + "(&($ag_att=*)" . "(|" . join( "", map { "(uid=$_)" } @_ ) . "))"; + my $r = $ldap->search( + attrs => [ 'uid', AT_ACLGROUPS ], + filter => $filter, + base => $ubase, + ); + die $r->error if $r->code; + + unless ( $r->count ) { + print("No aclgroups found in ldap\n"); + exit 0; + } + + my $users; + while ( my $e = ( $r->shift_entry ) ) { + my $uid = $e->get_value('uid'); + my @ag_cur = split ',', $e->get_value($ag_att); + for (@ag_cur) { + $users->{$_} = + defined $users->{$_} + ? [ @{ $users->{$_} }, $uid ] + : [$uid] + if $ag_all or $_ ~~ @ag; + } + } + + print "$_:\n\t", join( "\n\t", @{ $users->{$_} } ), "\n\n" + for keys %{$users}; + +} + +sub list_by_user($@) { + + my $imap = shift; + my $filter = "(|" . join( "", map { "(uid=$_)" } @_ ) . ")"; + + #my $filter = "(uid=$uid)"; + my $r = $ldap->search( + filter => $filter, + base => $ubase, + ); + die $r->error if $r->code; + my @users; + unless ( $r->count ) { + verbose("No matching users found in ldap.\n"); + @users = @_; + } + + while ( my $e = ( $r->shift_entry or shift @users ) ) { + + my ( $uid, $cn, $mr ); + if ( ref $e eq 'Net::LDAP::Entry' ) { + $uid = $e->get_value("uid"); + $cn = join( ", ", $e->get_value("cn") ); + $mr = $e->get_value(AT_PRIMARYADDRESS) || ""; # ?? + } else { + $uid = $e; + $cn = '[cn not available]'; + $mr = '[address not available]'; + } + + print "$uid: $cn <$mr>\n"; + + #if (($e->get_value("iusRestrictedMail")||"") eq "TRUE") { + #print " INTERNAL"; + #} + + die "IMAP Server does not advertise acl support" + unless $imap->capability->{acl}; + + # namespace() result looks like this + # [ + # [ # list of private namespace(s) + # [ + # prefix, + # name + # ], + # ... + # ], + # [ # list of namespace(s) for mailboxes shared by other users + # [ + # prefix, + # name + # ], + # ... + # [ # list of namespace(s) for 'public' shared mailboxes + # [ + # prefix, + # name + # ], + # ... + # ] + my $hasacl; + my $ns = $imap->namespace() or die "No public namespaces available: $@"; + + # uns interessieren nur 'public' namespaces + for my $n ( @{ $ns->[2] } ) { + + my $folders = imap_rlist( '', $n->[0], $n->[1] ); + for my $f ( @{$folders} ) { + + #next if '\\Noselect' ~~ $f->[0]; + my $perms = $imap->getacl($f) or die "Can't getacl '$f': $@"; + my ( $u, $p ); + while ( $u = shift @{$perms} and $p = shift @{$perms} ) { + next unless $u eq $uid; + $hasacl = 1; + print "\t$f: $u [$p]\n"; + } + + } + + } + + print "\tno acl found on listable folders in shared namespaces\n" + unless $hasacl; + print "\n"; + + } + +} + +sub list_by_folder($) { + + my ($folder) = @_; + + for my $f ( @{ acl_folders($folder) } ) { + + my $hasacl; + print "$f\n"; + + my $perms = $imap->getacl($f) or die $@; + my ( $u, $p ); + while ( $u = shift @{$perms} and $p = shift @{$perms} ) { + + # '#user' will be listed when we have a global acl for 'user' + my $gl = $u =~ /^\$?#/ ? ' [global]' : ''; + my $gr = $u =~ /^#?\$/ ? ' [group]' : ''; + $hasacl = 1; + print "\t$u [$p]$gr$gl\n"; + } + + print "\tno acl found\n" unless $hasacl; + print "\n"; + + } + +} + +sub verbose(@) { + printf STDERR @_; +} + +sub uniq(@) { + my %x; + @x{@_} = (); + return keys %x; +} + +{ + my @pw; + + 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 $?; + } + return shift @pw; + + } +} + +sub imap_list($$) { + + my ( $ref, $folder ) = @_; + + my $list = $imap->list( $ref, $folder ) + or die "Can't list('$ref', '$folder'): $@"; + + # single folder sieht wie folgt aus: [[flag1, flag2, ...], separator, foldername] + ref $list and return [ map $_->[2], @{$list} ]; + + # assuming empty result list otherwise + return []; + +} + +sub imap_rlist($$$) { + + my ( $ref, $folder, $sep ) = @_; + $folder =~ s/$sep+$//; + + my $list = imap_list( $ref, $folder ); + push @{$list}, @{ imap_list( $ref, "$folder$sep*" ) } if $Cf->recursive; + return $list; +} + +sub acl_folders($) { + + my ($f) = @_; + my $folders; + + for my $np ( @{$nspat} ) { + + # don't modify $f! + ( my $ft = $f ) =~ s/$np->[1]$//; + return imap_rlist( '', $f, $np->[1] ) if ( $ft =~ /$np->[0]/ ); + } + + die "Foldername '$f' must begin with the name of a shared namespace\n"; + +} + +sub prompt($$) { + my ( $prompt, $default ) = @_; + print $prompt, substr( $default, 0, 1 ), "\b"; + ReadMode 4; + my $r = ReadKey(0); + ReadMode 0; + if ( $r eq "\n" ) { $r = $default } + else { $r .= substr( $default, 1 ) } + print $r; + return $r; +} + +1; + +# vim:sts=4 sw=4 aw ai sm nohlsearch: diff -r 59c7146ec6f0 -r 66bf85163780 alias.pm --- a/alias.pm Tue Jul 31 10:46:37 2007 +0000 +++ b/alias.pm Fri Feb 21 11:56:39 2014 +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 59c7146ec6f0 -r 66bf85163780 group.pm --- a/group.pm Tue Jul 31 10:46:37 2007 +0000 +++ b/group.pm Fri Feb 21 11:56:39 2014 +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 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 59c7146ec6f0 -r 66bf85163780 imap.pm --- a/imap.pm Tue Jul 31 10:46:37 2007 +0000 +++ b/imap.pm Fri Feb 21 11:56:39 2014 +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 59c7146ec6f0 -r 66bf85163780 ldapBase.pm --- a/ldapBase.pm Tue Jul 31 10:46:37 2007 +0000 +++ b/ldapBase.pm Fri Feb 21 11:56:39 2014 +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 59c7146ec6f0 -r 66bf85163780 ma --- a/ma Tue Jul 31 10:46:37 2007 +0000 +++ b/ma Fri Feb 21 11:56:39 2014 +0100 @@ -5,10 +5,10 @@ # $Id$ # use constant USAGE => <<'#'; -Usage: !ME! account|alias|group --add|--list|--modify|--delete [options] [user|alias|shared mbox] +Usage: !ME! account|alias|group|acl --add|--list|--modify|--delete [options] [user|alias|shared mbox] * common options * --ldap_server=s LDAP-Server [!$Cf->ldap_server!] - --ldap_base=s LDAP-Basis [!$Cf->ldap_base!] + --ldap_base=s LDAP-Base [!$Cf->ldap_base!] --ldap_admin=s LDAP BIND DN [!$Cf->ldap_admin!] --ldap_password=s [!$Cf->ldap_password!] @@ -19,7 +19,8 @@ * account options * --default_domain Default Domain [!$Cf->default_domain!] --[no]mbox Create MBox [!$Cf->mbox!] - --imap_quota=i Mail Quota (MB) [!$Cf->imap_quota!] + --imap_quota=i Mail Quota [!$Cf->imap_quota!] + (Bytes) --address=s Primary Mail [!$Cf->address!] --other:s Alternative Mail addresses (comma sep.) [!$Cf->other!] @@ -28,17 +29,28 @@ --forward:s Forwarding [!$Cf->forward!] --fullname=s Real Name [!$Cf->fullname!] - --password=s Passwort [!$Cf->password!] + --password=s Password [!$Cf->password!] + + * acl options * + --acl_admin=s ACL Admin [!$Cf->acl_admin!] + --acl_password=s Pasword [!$Cf->acl_admin!] + --folder:s@ Folder(s) [!join ',', @{$Cf->folder}!] + --acl=s ACL list [!$Cf->acl!] + --[no]recursive Rekursive [!$Cf->recursive!] * alias options * --members=s List of Members [!$Cf->members!] * shared mailbox options * + [ currently not supported ] + * group options * --members=s List of Members [!$Cf->members!] --description=s Descripton [!$Cf->description!] + [ currently not supported ] + Passwords for LDAP and IMAP can be read from environment LDAP_PASS resp. IMAP_PASS. Options can be read from config file named in $MA_CONF [!$ENV{MA_CONF}!]. @@ -52,13 +64,12 @@ use warnings; use IO::File; -use Cyrus::IMAP::Admin; use AppConfig qw(:expand); use File::Basename; use FindBin; use Carp; -use lib ("$FindBin::RealBin/..", "$FindBin::RealBin/../lib/ma"); +use lib ( "$FindBin::RealBin/..", "$FindBin::RealBin/../lib/ma" ); use Common; use ldapBase; @@ -68,57 +79,61 @@ 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/; + @_ = grep { $_ =~ /^\Q$Module\E/ } qw/account acl 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') { - require shared; - shared::import($Cf); - shared::run(); - } elsif ($_[0] eq 'group') { - require group; - group::import($Cf); - group::run(); + if ( $_[0] eq 'account' ) { + require account; + account::import($Cf); + account::run(); + } elsif ( $_[0] eq 'acl' ) { + require acl; + acl::import($Cf); + acl::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' ) { + die "Command '$_[0]' is currently not supported\n"; + require group; + group::import($Cf); + group::run(); } else { - die "Shit"; + die "Shit"; } } @@ -128,7 +143,7 @@ } sub help() { - ($_ = USAGE) =~ s/!(.*?)!/(eval $1) || ""/eg; + ( $_ = USAGE ) =~ s/!(.*?)!/(eval $1) || ""/eg; return $_; } diff -r 59c7146ec6f0 -r 66bf85163780 ma.8.pod --- a/ma.8.pod Tue Jul 31 10:46:37 2007 +0000 +++ b/ma.8.pod Fri Feb 21 11:56:39 2014 +0100 @@ -1,3 +1,5 @@ +=encoding utf8 + =head1 NAME ma -- mailadmin tool @@ -51,9 +53,9 @@ =head1 OPTIONS -=over 4 +=head2 OPTIONS für beide Sub-Kommandos -=head2 OPTIONS für beide Sub-Kommandos +=over 4 =item B<--add>|B<--modify>|B<--delete>|B<--list> @@ -142,6 +144,7 @@ Es kann eine sprechende Bezeichnung für die Gruppe angegeben werden. Dieser Bezeichnung wird immer(!) "CYRUS MAIL ACCESS GROUP" vorangestellt. +=back =head1 EXAMPLES @@ -190,6 +193,6 @@ =back -=head1 AUTHOR +=head1 AUTHORS -Heiko Schlittermann +Heiko Schlittermann , Matthias Förste diff -r 59c7146ec6f0 -r 66bf85163780 ma.conf.ex --- a/ma.conf.ex Tue Jul 31 10:46:37 2007 +0000 +++ b/ma.conf.ex Fri Feb 21 11:56:39 2014 +0100 @@ -18,7 +18,10 @@ at_forwardingaddress = XXXMailForwardingAddress at_primaryaddress = XXXMailPrimaryAddress at_group = XXXMailGroup +at_quota = XXXMailQuotaBytes [imap] admin = cyrus password = SECRET +server = localhost +port = 143 diff -r 59c7146ec6f0 -r 66bf85163780 password.pm --- a/password.pm Tue Jul 31 10:46:37 2007 +0000 +++ b/password.pm Fri Feb 21 11:56:39 2014 +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 59c7146ec6f0 -r 66bf85163780 shared.pm --- a/shared.pm Tue Jul 31 10:46:37 2007 +0000 +++ b/shared.pm Fri Feb 21 11:56:39 2014 +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 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: