--- /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: