acl.pm
branchfoerste
changeset 63 96f567261e87
parent 61 e0895d4224f2
child 64 6a6c18cddf46
equal deleted inserted replaced
62:69e1077f1de3 63:96f567261e87
    25 sub _list();
    25 sub _list();
    26 sub _mkpw($);
    26 sub _mkpw($);
    27 
    27 
    28 sub list_by_user($@);
    28 sub list_by_user($@);
    29 sub list_by_folder($);
    29 sub list_by_folder($);
       
    30 sub list_groups(@);
    30 sub uniq(@);
    31 sub uniq(@);
    31 sub verbose(@);
    32 sub verbose(@);
    32 sub prompt($$);
    33 sub prompt($$);
    33 sub imap_list($$);
    34 sub imap_list($$);
    34 sub imap_rlist($$$);
    35 sub imap_rlist($$$);
    40 sub OC_RECIPIENT();
    41 sub OC_RECIPIENT();
    41 sub AT_ADDRESS();
    42 sub AT_ADDRESS();
    42 sub AT_GROUP();
    43 sub AT_GROUP();
    43 sub AT_FORWARDINGADDRESS();
    44 sub AT_FORWARDINGADDRESS();
    44 sub AT_QUOTA();
    45 sub AT_QUOTA();
       
    46 sub AT_ACLGROUPS();
    45 
    47 
    46 sub import(@) {
    48 sub import(@) {
    47     $Cf = shift;
    49     $Cf = shift;
    48 
    50 
    49     require constant;
    51     require constant;
    52     import constant OC_RECIPIENT         => $Cf->ldap_oc_recipient;
    54     import constant OC_RECIPIENT         => $Cf->ldap_oc_recipient;
    53     import constant AT_PRIMARYADDRESS    => $Cf->ldap_at_primaryaddress;
    55     import constant AT_PRIMARYADDRESS    => $Cf->ldap_at_primaryaddress;
    54     import constant AT_ADDRESS           => $Cf->ldap_at_address;
    56     import constant AT_ADDRESS           => $Cf->ldap_at_address;
    55     import constant AT_GROUP             => $Cf->ldap_at_group;
    57     import constant AT_GROUP             => $Cf->ldap_at_group;
    56     import constant AT_FORWARDINGADDRESS => $Cf->ldap_at_forwardingaddress;
    58     import constant AT_FORWARDINGADDRESS => $Cf->ldap_at_forwardingaddress;
       
    59     import constant AT_ACLGROUPS         => $Cf->ldap_at_aclgroups;
    57 
    60 
    58     $ubase = OU_ACCOUNTS . "," . $Cf->ldap_base;
    61     $ubase = OU_ACCOUNTS . "," . $Cf->ldap_base;
    59     $abase = OU_ALIASES . "," . $Cf->ldap_base;
    62     $abase = OU_ALIASES . "," . $Cf->ldap_base;
    60 }
    63 }
    61 
    64 
    89     for (@{$ns->[2]}) {
    92     for (@{$ns->[2]}) {
    90         (my $n = $_->[0]) =~ s/$_->[1]$//;
    93         (my $n = $_->[0]) =~ s/$_->[1]$//;
    91         push @{$nspat}, [qr/\Q$n\E($_->[1]|$)/, $_->[1]];
    94         push @{$nspat}, [qr/\Q$n\E($_->[1]|$)/, $_->[1]];
    92     }
    95     }
    93 
    96 
    94     if    ( $Cf->list )   { _list() }
    97     if ( $Cf->add ) { _modify() }
       
    98     elsif ( $Cf->delete ) { $Cf->acl('delete') ; _modify() }
       
    99     elsif ( $Cf->list )   { _list() }
    95     elsif ( $Cf->modify ) { _modify() }
   100     elsif ( $Cf->modify ) { _modify() }
    96     elsif ( $Cf->delete ) { $Cf->acl('delete') ; _modify() }
   101     else { die "Need action (--add|--delete|--list|--modify)\n" }
    97     else { die "Need action (--delete|--modify|--list)\n" }
       
    98 
   102 
    99 }
   103 }
   100 
   104 
   101 sub _modify() {
   105 sub _modify() {
   102 
   106 
   172 
   176 
   173     #@ARGV = ("*") unless @ARGV;
   177     #@ARGV = ("*") unless @ARGV;
   174 
   178 
   175     die "option acl_admin required\n" unless $Cf->acl_admin;
   179     die "option acl_admin required\n" unless $Cf->acl_admin;
   176 
   180 
   177     if (@ARGV) {
   181     if ($Cf->aclgroups) {
       
   182 
       
   183         warn "--folder option ignored when listing groups" unless $Cf->folder ~~ [];
       
   184         list_groups(@ARGV);
       
   185 
       
   186     } elsif (@ARGV) {
   178 
   187 
   179 #        my $uid = $ARGV[0];
   188 #        my $uid = $ARGV[0];
   180 #        # searching by more than use user may be too expensive
   189 #        # searching by more than use user may be too expensive
   181 #        die "Searching by more than one user not supported" unless @ARGV == 1 or $uid =~ /\*/;
   190 #        die "Searching by more than one user not supported" unless @ARGV == 1 or $uid =~ /\*/;
   182         #list_by_user($_) for @ARGV;
   191         #list_by_user($_) for @ARGV;
   191     } else {
   200     } else {
   192 
   201 
   193         die "Need either user or --folder. If you really want to search all users then supply the pattern '*'.";
   202         die "Need either user or --folder. If you really want to search all users then supply the pattern '*'.";
   194 
   203 
   195     }
   204     }
       
   205 
       
   206 }
       
   207 
       
   208 sub list_groups(@) {
       
   209 
       
   210     @_ = ('*') unless @_;
       
   211     my @ag = split ',', $Cf->imap_aclgroups;
       
   212     my $ag_att = AT_ACLGROUPS;
       
   213     my $filter = "(&($ag_att=*)"
       
   214                . "(|" . join( "", map { "(uid=$_)" } @_ ) . "))";
       
   215     my $r = $ldap->search(
       
   216         attrs  => ['uid', AT_ACLGROUPS],
       
   217         filter => $filter,
       
   218         base   => $ubase,
       
   219     );
       
   220     die $r->error if $r->code;
       
   221 
       
   222     unless ($r->count) {
       
   223         print ("No aclgroups found in ldap\n");
       
   224         exit 0;
       
   225     }
       
   226 
       
   227     my $users;
       
   228     while (my $e = ($r->shift_entry)) {
       
   229         my $uid = $e->get_value('uid');
       
   230         my @ag_cur = split ',', $e->get_value($ag_att);
       
   231         for (@ag) {
       
   232             $users->{$_} = defined $users->{$_}
       
   233             ? [@{$users->{$_}}, $uid]
       
   234             : [ $uid ]
       
   235             if $_ ~~ @ag_cur
       
   236         }
       
   237     }
       
   238 
       
   239     print "$_:\n\t", join("\n\t", @{$users->{$_}}), "\n\n" for keys %{$users};
   196 
   240 
   197 }
   241 }
   198 
   242 
   199 sub list_by_user($@) {
   243 sub list_by_user($@) {
   200 
   244