ius/mailAdmin: comparison acl.pm

equal deleted inserted replaced

-:96f567261e87
+:6a6c18cddf46
 use Text::Wrap;
 use password;
 use Term::ReadKey;
 my $Cf;
-my ( $ldap, $ubase, $abase );
+my ( $ldap, $ubase,        $abase );
 my ( $imap, $acl_password, $nspat );
 END { $imap and $imap = undef; }
 sub _list();
 sub _mkpw($);
 || password::ask( "IMAP (" . $Cf->acl_admin . ") password: " );
 $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};
+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]}) {
+for ( @{ $ns->[2] } ) {
-(my $n = $_->[0]) =~ s/$_->[1]$//;
+( my $n = $_->[0] ) =~ s/$_->[1]$//;
-push @{$nspat}, [qr/\Q$n\E($_->[1]|$)/, $_->[1]];
+push @{$nspat}, [ qr/\Q$n\E($_->[1]|$)/, $_->[1] ];
 }
-if ( $Cf->add ) { _modify() }
+if    ( $Cf->add )    { _modify() }
-elsif ( $Cf->delete ) { $Cf->acl('delete') ; _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" }
 }
 # dn: uid=USER,...
 my @users;
 @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) {
+unless ( $r->count ) {
-prompt('No matching user found in ldap. Continue? (y/N)', "n\n") =~ /y/i or exit 0;
+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 {
 $user = $e;
 $dn   = '[dn not available]';
 my $modified = 0;
 verbose "$user:\n";
 verbose "\t$dn...\n";
-for my $folder (@{$Cf->folder}) {
+for my $folder ( @{ $Cf->folder } ) {
-$imap->create($folder) or die "Can't create folder '$folder': $@" if $Cf->create;
+$imap->create($folder)
+or die "Can't create folder '$folder': $@"
-for my $f (@{acl_folders($folder)}) {
+if $Cf->create;
-if ($Cf->acl eq 'delete') {
+for my $f ( @{ acl_folders($folder) } ) {
-$imap->deleteacl($f, $user) or die "Can't delete acl: $@";
+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");
 #}
 #@ARGV = ("*") unless @ARGV;
 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 =~ /\*/;
 #list_by_user($_) for @ARGV;
-warn "--folder option ignored when listing by user" unless $Cf->folder ~~ [];
+warn "--folder option ignored when listing by user"
-list_by_user($imap, @ARGV);
+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 '*'.";
 }
 }
 sub list_groups(@) {
 @_ = ('*') unless @_;
 my @ag = split ',', $Cf->imap_aclgroups;
 my $ag_att = AT_ACLGROUPS;
-my $filter = "(&($ag_att=*)"
+my $filter =
-. "(|" . join( "", map { "(uid=$_)" } @_ ) . "))";
+"(&($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) {
+unless ( $r->count ) {
-print ("No aclgroups found in ldap\n");
+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->{$_} =
-? [@{$users->{$_}}, $uid]
+defined $users->{$_}
-: [ $uid ]
+? [ @{ $users->{$_} }, $uid ]
-if $_ ~~ @ag_cur
+: [$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};
 }
 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;
 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);
+my ( $uid, $cn, $mr );
-if (ref $e eq 'Net::LDAP::Entry') {
+if ( ref $e eq 'Net::LDAP::Entry' ) {
-$uid  = $e->get_value("uid");
+$uid = $e->get_value("uid");
-$cn   = join( ", ", $e->get_value("cn") );
+$cn  = join( ", ", $e->get_value("cn") );
-$mr   = $e->get_value(AT_PRIMARYADDRESS) || "";                  # ??
+$mr  = $e->get_value(AT_PRIMARYADDRESS) || "";    # ??
 } else {
 $uid = $e;
 $cn  = '[cn not available]';
 $mr  = '[address not available]';
 }
 #if (($e->get_value("iusRestrictedMail")||"") eq "TRUE") {
 #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)
 #       [
 #           prefix,
 #       ],
 #       ...
 #   ]
 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 $perms = $imap->getacl($f) or die "Can't getacl '$f': $@";
-my ($u, $p);
+my ( $u, $p );
-while ($u = shift @{$perms} and $p = shift @{$perms}) {
+while ( $u = shift @{$perms} and $p = shift @{$perms} ) {
 next unless $u eq $uid;
 $hasacl = 1;
 print "\t$f: $u [$p]\n";
 }
 }
 }
-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";
 }
 }
 sub list_by_folder($) {
 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 $perms = $imap->getacl($f) or die $@;
-my ($u, $p);
+my ( $u, $p );
-while ($u = shift @{$perms} and $p = shift @{$perms}) {
+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 $gl = $u =~ /^#/  ? ' [global acl]' : '';
-my $gr = $u =~ /^\$/ ? ' [group acl]' : '';
+my $gr = $u =~ /^\$/ ? ' [group acl]'  : '';
 $hasacl = 1;
 print "\t$u [$p]$gr$gl\n";
 }
 print "\tno acl found\n" unless $hasacl;
 }
 }
 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 [];
 }
 sub imap_rlist($$$) {
-my ($ref, $folder, $sep) = @_;
+my ( $ref, $folder, $sep ) = @_;
 $folder =~ s/$sep+$//;
-my $list = imap_list($ref, $folder);
+my $list = imap_list( $ref, $folder );
-push @{$list}, @{imap_list($ref, "$folder$sep*")} if $Cf->recursive;
+push @{$list}, @{ imap_list( $ref, "$folder$sep*" ) } if $Cf->recursive;
 return $list;
 }
 sub acl_folders($) {
 my ($f) = @_;
 my $folders;
-for my $np (@{$nspat}) {
+for my $np ( @{$nspat} ) {
 # don't modify $f!
-(my $ft = $f) =~ s/$np->[1]$//;
+( my $ft = $f ) =~ s/$np->[1]$//;
-return imap_rlist('', $f, $np->[1]) if ($ft =~ /$np->[0]/);
+return imap_rlist( '', $f, $np->[1] ) if ( $ft =~ /$np->[0]/ );
 }
 die "Foldername '$f' must begin with the name of a shared namespace\n";
 }
 sub prompt($$) {
-my ($prompt, $default) = @_;
+my ( $prompt, $default ) = @_;
-print $prompt, substr($default, 0, 1), "\b";
+print $prompt, substr( $default, 0, 1 ), "\b";
-ReadMode 4; my $r = ReadKey(0); ReadMode 0;
+ReadMode 4;
-if ($r eq "\n") { $r = $default }
+my $r = ReadKey(0);
-else { $r .= substr($default, 1) }
+ReadMode 0;
+if ( $r eq "\n" ) { $r = $default }
+else              { $r .= substr( $default, 1 ) }
 print $r;
 return $r;
 }
 1;

branch	foerste
changeset 64	6a6c18cddf46
parent 63	96f567261e87
child 66	a41fd3429d63