# HG changeset patch # User Matthias Förste foerste@schlittermann.de # Date 1323545816 -3600 # Node ID 1f74755c407ef7bcfbb24a65c78ea7d6a3445e5a # Parent a1399e17cca42160cf2664164e2a5201b0ee25b0 acl search should work diff -r a1399e17cca4 -r 1f74755c407e Common.pm --- a/Common.pm Thu Dec 08 21:23:58 2011 +0100 +++ b/Common.pm Sat Dec 10 20:36:56 2011 +0100 @@ -53,6 +53,13 @@ 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 => 1 }, + # * alias * group * members => { ARGS => ":s" }, diff -r a1399e17cca4 -r 1f74755c407e acl.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/acl.pm Sat Dec 10 20:36:56 2011 +0100 @@ -0,0 +1,397 @@ +package acl; + +# © 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::Entry; +use Mail::IMAPTalk; +use Text::Wrap; +use password; + +my $Cf; +my ( $ldap, $ubase, $abase ); +my ( $imap, $acl_password ); +END { $imap and $imap = undef; } + +sub _list(); +sub _mkpw($); + +sub list_by_user($@); +sub list_by_folder($$$); +sub uniq(@); +sub verbose(@); + +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 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; + + $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: " ); + + if ( $Cf->list ) { _list() } + elsif ( $Cf->modify ) { _modify() } + else { die "Need action (--modify|--list)\n" } + +} + +sub _modify() { + + die 'Not yet implemented'; + + # Auch hier gehen wir davon aus, daß die dn direkt aus dem User-Namen folgt: + # dn: uid=USER,... + my (@user) = @ARGV or die "Need user(s)\n"; + $Cf->user or die "Need user(s)\n"; + $Cf->acl or die "Need acl\n"; + my @dns; + + my $r = $ldap->search( + base => $ubase, + filter => "(|" . join( "", map { "(uid=$_)" } @ARGV ) . ")" + ); + die $r->error if $r->code; + die "No entries found.\n" if $r->count == 0; + + while ( my $e = $r->shift_entry ) { + my $r; + + my $user = $e->get_value("uid"); + my $dn = $e->dn; + + my $modified = 0; + verbose "$user:"; + + 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"); + #} + + 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 ( 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/^\+//; + + # Darf noch nicht woanders sein + $r = $ldap->search( base => $ubase, filter => "(mail=$a)" ); + die $r->error if $r->code; + die "$a ist schon vergeben\n" if $r->count; + + $e->add( (AT_ADDRESS) => [$a] ); + } + } + $modified++; + } + + if ( defined $Cf->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++; + } + + if ( defined $Cf->forward ) { + my @f = split /,/, $Cf->forward; + grep { /^[+-]/ } @f + or $e->delete(AT_FORWARDINGADDRESS) + if $e->get_value(AT_FORWARDINGADDRESS); + + foreach my $f (@f) { + if ( $f =~ s/^-// ) { + $e->delete( (AT_FORWARDINGADDRESS) => [$f] ); + } else { + $f =~ s/^\+//; + $e->add( (AT_FORWARDINGADDRESS) => [$f] ); + } + } + $modified++; + } + + 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 _list() { + + #@ARGV = ("*") unless @ARGV; + + die "option acl_admin required\n" unless $Cf->acl_admin; + + $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}; + + if (@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; + list_by_user($imap, @ARGV); + + } elsif ($Cf->folder) { + + list_by_folder($imap, $_, $Cf->recursive) for @{$Cf->folder}; + + } else { + + die "Need either user or --folder. If you really want to search all users then supply the pattern '*'."; + + } + +} + +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; + verbose("No matching users found\n") unless $r->count; + + 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) || ""; # ?? + + 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->list( '', "$n->[0]*" ) or die $@; + ref $folders or die "Got empty folder list. Does '$n->[0]' actually exist? Is it readable?"; + + for my $f ( @{$folders} ) { + + # single folder sieht wie folgt aus: [[flag1, flag2, ...], separator, foldername] + #next if '\\Noselect' ~~ $f->[0]; + my $perms = $imap->getacl( $f->[2] ) or die $@; + my ($u, $p); + while ($u = shift @{$perms} and $p = shift @{$perms} and $u eq $uid) { + $hasacl = 1; + print "\t$f->[2]: $u [$p]\n"; + } + + } + + } + + print "\tno acl found on listable folders in shared namespaces\n" unless $hasacl; + print "\n"; + + } + +} + +sub list_by_folder($$$) { + + my ($imap, $folder, $recursive) = @_; + + $folder .= '/' unless $folder =~ m,/$,; + my $folders = $recursive + ? ($imap->list('', "$folder*") or die $@) + : [[ undef, undef, $folder ]]; + + ref $folders or die "Got empty folder list. Does '$folder' actually exist? Is it readable?"; + + for my $f ( @{$folders} ) { + + my $hasacl; + print "$f->[2]\n"; + + # single folder sieht wie folgt aus: [[flag1, flag2, ...], separator, foldername] + #next if '\\Noselect' ~~ $f->[0]; + my $perms = $imap->getacl( $f->[2] ) or die $@; + my ($u, $p); + while ($u = shift @{$perms} + and $p = shift @{$perms}) { + next if $u eq $Cf->acl_admin or $u eq $Cf->imap_admin; + $hasacl = 1; + print "\t$u [$p]\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; + + } +} + +1; + +# vim:sts=4 sw=4 aw ai sm nohlsearch: diff -r a1399e17cca4 -r 1f74755c407e ma --- a/ma Thu Dec 08 21:23:58 2011 +0100 +++ b/ma Sat Dec 10 20:36:56 2011 +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!] @@ -28,20 +28,27 @@ --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 * - [ z.Z. nicht unterstützt ] + [ currently not supported ] * group options * --members=s List of Members [!$Cf->members!] --description=s Descripton [!$Cf->description!] - [ z.Z. nicht unterstützt ] + [ 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}!]. @@ -98,7 +105,7 @@ 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; @@ -106,6 +113,10 @@ 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);