--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/.hgignore Tue Apr 14 12:34:29 2015 +0200
@@ -0,0 +1,4 @@
+syntax: glob
+.ok.*
+*.[0-9].gz
+x
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/.hgtags Tue Apr 14 12:34:29 2015 +0200
@@ -0,0 +1,1 @@
+6a6c18cddf46998e8a1acc933ff4afbacdb177b8 hhsp-dovecot-0.1
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/.perltidyrc Tue Apr 14 12:34:29 2015 +0200
@@ -0,0 +1,2 @@
+-ce
+-noll
--- a/Common.pm Tue Jul 31 10:46:37 2007 +0000
+++ b/Common.pm Tue Apr 14 12:34:29 2015 +0200
@@ -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" },
);
--- a/Makefile Tue Jul 31 10:46:37 2007 +0000
+++ b/Makefile Tue Apr 14 12:34:29 2015 +0200
@@ -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)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/acl.pm Tue Apr 14 12:34:29 2015 +0200
@@ -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:
--- a/alias.pm Tue Jul 31 10:46:37 2007 +0000
+++ b/alias.pm Tue Apr 14 12:34:29 2015 +0200
@@ -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:
--- a/group.pm Tue Jul 31 10:46:37 2007 +0000
+++ b/group.pm Tue Apr 14 12:34:29 2015 +0200
@@ -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:
--- a/imap.pm Tue Jul 31 10:46:37 2007 +0000
+++ b/imap.pm Tue Apr 14 12:34:29 2015 +0200
@@ -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;
}
--- a/ldapBase.pm Tue Jul 31 10:46:37 2007 +0000
+++ b/ldapBase.pm Tue Apr 14 12:34:29 2015 +0200
@@ -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:
--- a/ma Tue Jul 31 10:46:37 2007 +0000
+++ b/ma Tue Apr 14 12:34:29 2015 +0200
@@ -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 $_;
}
--- a/ma.8.pod Tue Jul 31 10:46:37 2007 +0000
+++ b/ma.8.pod Tue Apr 14 12:34:29 2015 +0200
@@ -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 <hs@schlittermann.de>
+Heiko Schlittermann <hs@schlittermann.de>, Matthias Förste <foerste@schlittermann.de>
--- a/ma.conf.ex Tue Jul 31 10:46:37 2007 +0000
+++ b/ma.conf.ex Tue Apr 14 12:34:29 2015 +0200
@@ -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
--- a/password.pm Tue Jul 31 10:46:37 2007 +0000
+++ b/password.pm Tue Apr 14 12:34:29 2015 +0200
@@ -5,9 +5,9 @@
return undef if not -t;
print $_[0];
- system(stty => "-echo");
+ system( stty => "-echo" );
my $ans = <STDIN>;
- system(stty => "echo");
+ system( stty => "echo" );
print "\n";
chomp $ans;
--- a/populate.ldif Tue Jul 31 10:46:37 2007 +0000
+++ b/populate.ldif Tue Apr 14 12:34:29 2015 +0200
@@ -1,25 +1,43 @@
# $Id$
# $URL$
-dn: ou=Cyrus,o=ahreick
+dn: dc=heimrich-hannot,dc=de
+objectClass: top
+objectClass: dcObject
+objectClass: Organization
+dc: heimrich-hannot
+o: Heimrich-hANNOT gMbH
+
+dn: cn=admin,dc=heimrich-hannot,dc=de
+objectClass: simpleSecurityObject
+objectClass: organizationalRole
+cn: admin
+description: LDAP administrator
+userPassword: x
+
+dn: ou=Cyrus,dc=heimrich-hannot,dc=de
objectClass: organizationalUnit
ou: Cyrus
description: cyrus mail administration objects
-dn: uid=root,ou=Cyrus,o=ahreick
+dn: uid=root,ou=Cyrus,dc=heimrich-hannot,dc=de
objectClass: simpleSecurityObject
objectClass: account
uid: root
-userPassword: {crypt}KycC6akPBSoYY
+userPassword: x
description: cyrus administrator
-dn: ou=MailAccounts,o=ahreick
+dn: ou=Mail,dc=heimrich-hannot,dc=de
objectClass: OrganizationalUnit
-ou: MailAccounts
+ou: Mail
+description: all mail objects
+
+dn: ou=Accounts,ou=Mail,dc=heimrich-hannot,dc=de
+objectClass: OrganizationalUnit
+ou: Accounts
description: all mail users
-dn: ou=MailAliases,o=ahreick
+dn: ou=Aliases,ou=Mail,dc=heimrich-hannot,dc=de
objectClass: OrganizationalUnit
-ou: MailAliases
+ou: Aliases
description: global e-mail aliases
-
--- a/shared.pm Tue Jul 31 10:46:37 2007 +0000
+++ b/shared.pm Tue Apr 14 12:34:29 2015 +0200
@@ -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: