# HG changeset patch # User Matthias Förste foerste@schlittermann.de # Date 1323779943 -3600 # Node ID 6a6c18cddf46998e8a1acc933ff4afbacdb177b8 # Parent 96f567261e87b93032426823fbad865f526cdb01 [perltidy] diff -r 96f567261e87 -r 6a6c18cddf46 .perltidyrc --- a/.perltidyrc Tue Dec 13 13:01:23 2011 +0100 +++ b/.perltidyrc Tue Dec 13 13:39:03 2011 +0100 @@ -1,2 +1,2 @@ -ce --nolc +-noll diff -r 96f567261e87 -r 6a6c18cddf46 Common.pm --- a/Common.pm Tue Dec 13 13:01:23 2011 +0100 +++ b/Common.pm Tue Dec 13 13:39:03 2011 +0100 @@ -37,8 +37,7 @@ imap_password => { ARGS => "=s" }, imap_quota => { ARGS => "=i", DEFAULT => 300 * 1024 * 1024, ALIAS => "quota" }, - imap_aclgroups => - { ARGS => "=s", ALIAS => "aclgroups" }, + imap_aclgroups => { ARGS => "=s", ALIAS => "aclgroups" }, # dovecots mail_location (%1, %u & %d supported) imap_mail_location => @@ -56,11 +55,11 @@ address => { ARGS => "=s", ALIAS => "primary" }, # * acl * - acl_admin => { ARGS => "=s" }, + acl_admin => { ARGS => "=s" }, acl_password => { ARGS => "=s" }, - folder => { ARGS => ":s@" }, - acl => { ARGS => "=s" }, - recursive => { ARGS => "!", DEFAULT => 0 }, + folder => { ARGS => ":s@" }, + acl => { ARGS => "=s" }, + recursive => { ARGS => "!", DEFAULT => 0 }, # * alias * group * members => { ARGS => ":s" }, @@ -81,10 +80,10 @@ 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_quota => { ARGS => "=s", DEFAULT => "XXXmailQuota" }, - ldap_at_aclgroups => { ARGS => "=s", DEFAULT => "XXXmailACLGroups" }, + 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 => diff -r 96f567261e87 -r 6a6c18cddf46 account.pm --- a/account.pm Tue Dec 13 13:01:23 2011 +0100 +++ b/account.pm Tue Dec 13 13:39:03 2011 +0100 @@ -190,7 +190,9 @@ verbose('exists') - } elsif ( ($imap->login( $user, $pw ) or die $@) and $imap->capability->{acl} ) { + } elsif ( ( $imap->login( $user, $pw ) or die $@ ) + and $imap->capability->{acl} ) + { # wenn wir acl verwenden, # * dann triggert 'list' acl file (und damit maildir) erzeugung @@ -199,6 +201,7 @@ # (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'); @@ -325,10 +328,10 @@ my $ag = $Cf->aclgroups; - if ($ag =~ /(^|,\s*)[+-]/) { + if ( $ag =~ /(^|,\s*)[+-]/ ) { my %x; - @x{split /,/, $e->get_value(AT_ACLGROUPS)} = (); - for (split /,/, $ag) { + @x{ split /,/, $e->get_value(AT_ACLGROUPS) } = (); + for ( split /,/, $ag ) { if (s/^-//) { delete $x{$_}; } else { @@ -440,7 +443,8 @@ } } - print "Don't forget to remove acl entries for this user if any exist!\n"; + print + "Don't forget to remove acl entries for this user if any exist!\n"; verbose("\n"); } @@ -488,14 +492,14 @@ $imap->login( "$uid*" . $Cf->imap_admin, $imap_password ) or die $@; my %q; - if ($imap->capability->{quota}) { + 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 @p = map qr{^\Q$_->[0]\E}, ( @{ $ns->[1] }, @{ $ns->[2] } ); my $folders = $imap->list( '', '*' ) or die $@; @@ -504,10 +508,11 @@ # 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; + 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 $@; + or $@ eq + q{IMAP Command : 'getquotaroot' failed. Response was : no - Not showing other users' quota.} + or die $@; delete $q->{quotaroot}; %q = ( %q, %{$q} ); @@ -539,7 +544,7 @@ 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; + print wrap( "\t", "\t\t", "ACL Groups: $ag\n" ) if $ag; } } diff -r 96f567261e87 -r 6a6c18cddf46 acl.pm --- 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; }