--- a/acl.pm Tue Dec 13 13:01:23 2011 +0100
+++ b/acl.pm Tue Dec 13 13:39:03 2011 +0100
@@ -18,7 +18,7 @@
use Term::ReadKey;
my $Cf;
-my ( $ldap, $ubase, $abase );
+my ( $ldap, $ubase, $abase );
my ( $imap, $acl_password, $nspat );
END { $imap and $imap = undef; }
@@ -80,22 +80,23 @@
$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, "': ", $@;
+ )
+ 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};
+ die "IMAP Server does not advertise acl support"
+ unless $imap->capability->{acl};
# 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]];
+ 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() }
+ 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" }
@@ -110,23 +111,27 @@
@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";
+ $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;
+ 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)) {
+ while ( my $e = ( $r->shift_entry or shift @users ) ) {
- my ($user, $dn);
+ my ( $user, $dn );
- if (ref $e eq 'Net::LDAP::Entry') {
+ if ( ref $e eq 'Net::LDAP::Entry' ) {
$user = $e->get_value("uid");
$dn = $e->dn;
} else {
@@ -138,23 +143,27 @@
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;
+ for my $folder ( @{ $Cf->folder } ) {
- for my $f (@{acl_folders($folder)}) {
+ $imap->create($folder)
+ or die "Can't create folder '$folder': $@"
+ if $Cf->create;
- if ($Cf->acl eq 'delete') {
- $imap->deleteacl($f, $user) or die "Can't delete acl: $@";
+ for my $f ( @{ acl_folders($folder) } ) {
+
+ 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: $@";
+ $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");
@@ -178,28 +187,31 @@
die "option acl_admin required\n" unless $Cf->acl_admin;
- if ($Cf->aclgroups) {
+ if ( $Cf->aclgroups ) {
- warn "--folder option ignored when listing groups" unless $Cf->folder ~~ [];
+ 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 =~ /\*/;
+ # 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);
+ warn "--folder option ignored when listing by user"
+ unless $Cf->folder ~~ [];
+ list_by_user( $imap, @ARGV );
- } elsif (not $Cf->folder ~~ []) {
+ } elsif ( not $Cf->folder ~~ [] ) {
- list_by_folder($_) for @{$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 '*'.";
+ die
+ "Need either user or --folder. If you really want to search all users then supply the pattern '*'.";
}
@@ -210,33 +222,35 @@
@_ = ('*') unless @_;
my @ag = split ',', $Cf->imap_aclgroups;
my $ag_att = AT_ACLGROUPS;
- my $filter = "(&($ag_att=*)"
- . "(|" . join( "", map { "(uid=$_)" } @_ ) . "))";
+ my $filter =
+ "(&($ag_att=*)" . "(|" . join( "", map { "(uid=$_)" } @_ ) . "))";
my $r = $ldap->search(
- attrs => ['uid', AT_ACLGROUPS],
+ attrs => [ 'uid', AT_ACLGROUPS ],
filter => $filter,
base => $ubase,
);
die $r->error if $r->code;
- unless ($r->count) {
- print ("No aclgroups found in ldap\n");
+ unless ( $r->count ) {
+ print("No aclgroups found in ldap\n");
exit 0;
}
my $users;
- while (my $e = ($r->shift_entry)) {
+ while ( my $e = ( $r->shift_entry ) ) {
my $uid = $e->get_value('uid');
my @ag_cur = split ',', $e->get_value($ag_att);
for (@ag) {
- $users->{$_} = defined $users->{$_}
- ? [@{$users->{$_}}, $uid]
- : [ $uid ]
- if $_ ~~ @ag_cur
+ $users->{$_} =
+ defined $users->{$_}
+ ? [ @{ $users->{$_} }, $uid ]
+ : [$uid]
+ if $_ ~~ @ag_cur;
}
}
- print "$_:\n\t", join("\n\t", @{$users->{$_}}), "\n\n" for keys %{$users};
+ print "$_:\n\t", join( "\n\t", @{ $users->{$_} } ), "\n\n"
+ for keys %{$users};
}
@@ -244,6 +258,7 @@
my $imap = shift;
my $filter = "(|" . join( "", map { "(uid=$_)" } @_ ) . ")";
+
#my $filter = "(uid=$uid)";
my $r = $ldap->search(
filter => $filter,
@@ -251,18 +266,18 @@
);
die $r->error if $r->code;
my @users;
- unless ($r->count) {
+ unless ( $r->count ) {
verbose("No matching users found in ldap.\n");
@users = @_;
}
- while (my $e = ($r->shift_entry or shift @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) || ""; # ??
+ 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]';
@@ -275,7 +290,9 @@
#print " INTERNAL";
#}
- die "IMAP Server does not advertise acl support" unless $imap->capability->{acl};
+ die "IMAP Server does not advertise acl support"
+ unless $imap->capability->{acl};
+
# namespace() result looks like this
# [
# [ # list of private namespace(s)
@@ -300,16 +317,17 @@
# ]
my $hasacl;
my $ns = $imap->namespace() or die "No public namespaces available: $@";
+
# uns interessieren nur 'public' namespaces
- for my $n (@{$ns->[2]}) {
+ 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}) {
+ 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";
@@ -319,7 +337,8 @@
}
- print "\tno acl found on listable folders in shared namespaces\n" unless $hasacl;
+ print "\tno acl found on listable folders in shared namespaces\n"
+ unless $hasacl;
print "\n";
}
@@ -330,18 +349,18 @@
my ($folder) = @_;
- for my $f ( @{acl_folders($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}) {
+ 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 acl]' : '';
- my $gr = $u =~ /^\$/ ? ' [group acl]' : '';
+ my $gl = $u =~ /^#/ ? ' [global acl]' : '';
+ my $gr = $u =~ /^\$/ ? ' [group acl]' : '';
$hasacl = 1;
print "\t$u [$p]$gr$gl\n";
}
@@ -382,11 +401,14 @@
sub imap_list($$) {
- my ($ref, $folder) = @_;
+ my ( $ref, $folder ) = @_;
- my $list = $imap->list($ref, $folder) or die "Can't list('$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 [];
@@ -394,11 +416,11 @@
sub imap_rlist($$$) {
- my ($ref, $folder, $sep) = @_;
+ my ( $ref, $folder, $sep ) = @_;
$folder =~ s/$sep+$//;
- my $list = imap_list($ref, $folder);
- push @{$list}, @{imap_list($ref, "$folder$sep*")} if $Cf->recursive;
+ my $list = imap_list( $ref, $folder );
+ push @{$list}, @{ imap_list( $ref, "$folder$sep*" ) } if $Cf->recursive;
return $list;
}
@@ -407,10 +429,11 @@
my ($f) = @_;
my $folders;
- for my $np (@{$nspat}) {
+ for my $np ( @{$nspat} ) {
+
# don't modify $f!
- (my $ft = $f) =~ s/$np->[1]$//;
- return imap_rlist('', $f, $np->[1]) if ($ft =~ /$np->[0]/);
+ ( 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";
@@ -418,11 +441,13 @@
}
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) }
+ 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;
}