account.pm
branchfoerste
changeset 64 6a6c18cddf46
parent 60 3293084cfdd9
child 68 e8285fb4fb63
equal deleted inserted replaced
63:96f567261e87 64:6a6c18cddf46
   188 
   188 
   189         if ( -d $mbox ) {
   189         if ( -d $mbox ) {
   190 
   190 
   191             verbose('exists')
   191             verbose('exists')
   192 
   192 
   193         } elsif ( ($imap->login( $user, $pw ) or die $@) and $imap->capability->{acl} ) {
   193         } elsif ( ( $imap->login( $user, $pw ) or die $@ )
       
   194             and $imap->capability->{acl} )
       
   195         {
   194 
   196 
   195             # wenn wir acl verwenden,
   197             # wenn wir acl verwenden,
   196             #  * dann triggert 'list' acl file (und damit maildir) erzeugung
   198             #  * dann triggert 'list' acl file (und damit maildir) erzeugung
   197             #    bei dovecot
   199             #    bei dovecot
   198             #  * müssen wir dem master nutzer ausdrücklich rechte gewähren
   200             #  * müssen wir dem master nutzer ausdrücklich rechte gewähren
   199             #  (sofern wir das nicht eleganter über globale acl regeln können)
   201             #  (sofern wir das nicht eleganter über globale acl regeln können)
   200             #    (lra: sicht-, les- und administrierbar)
   202             #    (lra: sicht-, les- und administrierbar)
   201             my $f = $imap->list( '', '*' ) or die $@;
   203             my $f = $imap->list( '', '*' ) or die $@;
       
   204 
   202             #$imap->setacl( $f->[0]->[2], $Cf->imap_admin, 'lra' ) or die $@;
   205             #$imap->setacl( $f->[0]->[2], $Cf->imap_admin, 'lra' ) or die $@;
   203             verbose('ok');
   206             verbose('ok');
   204 
   207 
   205         } else {
   208         } else {
   206 
   209 
   323 
   326 
   324         if ( defined $Cf->aclgroups ) {
   327         if ( defined $Cf->aclgroups ) {
   325 
   328 
   326             my $ag = $Cf->aclgroups;
   329             my $ag = $Cf->aclgroups;
   327 
   330 
   328             if ($ag =~ /(^|,\s*)[+-]/) {
   331             if ( $ag =~ /(^|,\s*)[+-]/ ) {
   329                 my %x;
   332                 my %x;
   330                 @x{split /,/, $e->get_value(AT_ACLGROUPS)} = ();
   333                 @x{ split /,/, $e->get_value(AT_ACLGROUPS) } = ();
   331                 for (split /,/, $ag) {
   334                 for ( split /,/, $ag ) {
   332                     if (s/^-//) {
   335                     if (s/^-//) {
   333                         delete $x{$_};
   336                         delete $x{$_};
   334                     } else {
   337                     } else {
   335                         s/^\+//;
   338                         s/^\+//;
   336                         $x{$_} = undef;
   339                         $x{$_} = undef;
   438                 verbose("\tdeleting $m...");
   441                 verbose("\tdeleting $m...");
   439                 verbose( ( remove_tree $m) ? 'ok' : " Can't remove '$m': $!" );
   442                 verbose( ( remove_tree $m) ? 'ok' : " Can't remove '$m': $!" );
   440             }
   443             }
   441         }
   444         }
   442 
   445 
   443         print "Don't forget to remove acl entries for this user if any exist!\n";
   446         print
       
   447           "Don't forget to remove acl entries for this user if any exist!\n";
   444         verbose("\n");
   448         verbose("\n");
   445 
   449 
   446     }
   450     }
   447 }
   451 }
   448 
   452 
   486           or die "Can't connect to IMAP Server '", $Cf->imap_server,
   490           or die "Can't connect to IMAP Server '", $Cf->imap_server,
   487           "', Port '", $Cf->imap_port, "': ", $@;
   491           "', Port '", $Cf->imap_port, "': ", $@;
   488         $imap->login( "$uid*" . $Cf->imap_admin, $imap_password ) or die $@;
   492         $imap->login( "$uid*" . $Cf->imap_admin, $imap_password ) or die $@;
   489 
   493 
   490         my %q;
   494         my %q;
   491         if ($imap->capability->{quota}) {
   495         if ( $imap->capability->{quota} ) {
   492 
   496 
   493             # prepare patterns for shared folders - we want to ignore them in
   497             # prepare patterns for shared folders - we want to ignore them in
   494             # quota calculations (TODO: what happens if a user has/attempts to
   498             # quota calculations (TODO: what happens if a user has/attempts to
   495             # create a folder with the name of a namespace? he could avoid
   499             # create a folder with the name of a namespace? he could avoid
   496             # quota limits that way?)
   500             # quota limits that way?)
   497             my $ns = $imap->namespace() or die $@;
   501             my $ns = $imap->namespace() or die $@;
   498             my @p = map qr{^\Q$_->[0]\E}, (@{$ns->[1]}, @{$ns->[2]});
   502             my @p = map qr{^\Q$_->[0]\E}, ( @{ $ns->[1] }, @{ $ns->[2] } );
   499 
   503 
   500             my $folders = $imap->list( '', '*' ) or die $@;
   504             my $folders = $imap->list( '', '*' ) or die $@;
   501 
   505 
   502             for my $f ( @{$folders} ) {
   506             for my $f ( @{$folders} ) {
   503 
   507 
   504                 # single folder sieht wie folgt aus: [[flag1, flag2, ...], separator, foldername]
   508                 # single folder sieht wie folgt aus: [[flag1, flag2, ...], separator, foldername]
   505                 #next if '\\Noselect' ~~ $f->[0];
   509                 #next if '\\Noselect' ~~ $f->[0];
   506                 # ignore shared folders
   510                 # ignore shared folders
   507                 map { next if ( $f->[2] . $f->[1]) =~ $_ } @p;
   511                 map { next if ( $f->[2] . $f->[1] ) =~ $_ } @p;
   508                 my $q = $imap->getquotaroot( $f->[2] )
   512                 my $q = $imap->getquotaroot( $f->[2] )
   509                     or $@ eq q{IMAP Command : 'getquotaroot' failed. Response was : no - Not showing other users' quota.}
   513                   or $@ eq
   510                     or die $@;
   514                   q{IMAP Command : 'getquotaroot' failed. Response was : no - Not showing other users' quota.}
       
   515                   or die $@;
   511                 delete $q->{quotaroot};
   516                 delete $q->{quotaroot};
   512                 %q = ( %q, %{$q} );
   517                 %q = ( %q, %{$q} );
   513 
   518 
   514             }
   519             }
   515 
   520 
   537           "\n";
   542           "\n";
   538 
   543 
   539         print wrap( "\t", "\t\t", "Other Adresses: $ml\n" ) if $ml;
   544         print wrap( "\t", "\t\t", "Other Adresses: $ml\n" ) if $ml;
   540         print wrap( "\t", "\t\t", "Mail Groups: $mg\n" )    if $mg;
   545         print wrap( "\t", "\t\t", "Mail Groups: $mg\n" )    if $mg;
   541         print wrap( "\t", "\t\t", "Forwardings: $forw\n" )  if $forw;
   546         print wrap( "\t", "\t\t", "Forwardings: $forw\n" )  if $forw;
   542         print wrap( "\t", "\t\t", "ACL Groups: $ag\n" )  if $ag;
   547         print wrap( "\t", "\t\t", "ACL Groups: $ag\n" )     if $ag;
   543 
   548 
   544     }
   549     }
   545 }
   550 }
   546 
   551 
   547 sub verbose(@) {
   552 sub verbose(@) {