acl.pm
branchfoerste
changeset 67 deadc72b7e6c
parent 66 a41fd3429d63
child 75 63b7c7fcd0cb
equal deleted inserted replaced
66:a41fd3429d63 67:deadc72b7e6c
    85       "', Port '", $Cf->imap_port, "': ", $@;
    85       "', Port '", $Cf->imap_port, "': ", $@;
    86     $imap->login( $Cf->acl_admin, $acl_password ) or die $@;
    86     $imap->login( $Cf->acl_admin, $acl_password ) or die $@;
    87     die "IMAP Server does not advertise acl support"
    87     die "IMAP Server does not advertise acl support"
    88       unless $imap->capability->{acl};
    88       unless $imap->capability->{acl};
    89 
    89 
       
    90     $imap->set_tracing(1) if $ENV{TRACE};
       
    91 
    90     # requires an imap connection
    92     # requires an imap connection
    91     my $ns = $imap->namespace() or die "No public namespaces available: $@";
    93     my $ns = $imap->namespace() or die "No public namespaces available: $@";
    92     $nspat = [];
    94     $nspat = [];
    93     for ( @{ $ns->[2] } ) {
    95     for ( @{ $ns->[2] } ) {
    94         ( my $n = $_->[0] ) =~ s/$_->[1]$//;
    96         ( my $n = $_->[0] ) =~ s/$_->[1]$//;
   147 
   149 
   148             $imap->create($folder)
   150             $imap->create($folder)
   149               or die "Can't create folder '$folder': $@"
   151               or die "Can't create folder '$folder': $@"
   150               if $Cf->create;
   152               if $Cf->create;
   151 
   153 
   152             for my $f ( @{ acl_folders($folder) } ) {
   154             my @folders = @{ acl_folders($folder) } or die "Got empty folderlist - does '$folder' exist? (use --create if you want me to create it)";
       
   155             for my $f ( @folders ) {
   153 
   156 
   154                 if ( $Cf->acl eq 'delete' ) {
   157                 if ( $Cf->acl eq 'delete' ) {
   155                     $imap->deleteacl( $f, $user ) or die "Can't delete acl: $@";
   158                     $imap->deleteacl( $f, $user ) or die "Can't delete acl: $@";
   156                     verbose "\t$f: none\n";
   159                     verbose "\t$f: none\n";
   157                 } else {
   160                 } else {
   358         my $perms = $imap->getacl($f) or die $@;
   361         my $perms = $imap->getacl($f) or die $@;
   359         my ( $u, $p );
   362         my ( $u, $p );
   360         while ( $u = shift @{$perms} and $p = shift @{$perms} ) {
   363         while ( $u = shift @{$perms} and $p = shift @{$perms} ) {
   361 
   364 
   362             # '#user' will be listed when we have a global acl for 'user'
   365             # '#user' will be listed when we have a global acl for 'user'
   363             my $gl = $u =~ /^#/  ? ' [global acl]' : '';
   366             my $gl = $u =~ /^\$?#/  ? ' [global]' : '';
   364             my $gr = $u =~ /^\$/ ? ' [group acl]'  : '';
   367             my $gr = $u =~ /^#?\$/ ? ' [group]'  : '';
   365             $hasacl = 1;
   368             $hasacl = 1;
   366             print "\t$u [$p]$gr$gl\n";
   369             print "\t$u [$p]$gr$gl\n";
   367         }
   370         }
   368 
   371 
   369         print "\tno acl found\n" unless $hasacl;
   372         print "\tno acl found\n" unless $hasacl;