Changeset 479

Timestamp:

10/04/09 05:01:12 (15 years ago)

Author:

nanardon

Message:

• create and delete keyword colapse with attribute name, prefixing action by an '@' in acls

Location:

LATMOS-Accounts

Files:

• MANIFEST (modified) (1 diff)
• bin/la-qacls (added)
• lib/LATMOS/Accounts/Acls.pm (modified) (4 diffs)

LATMOS-Accounts/MANIFEST

@@ -7 +7 @@
 annexes/sql.schema.sql
 bin/la-acls
+bin/la-attributes
 bin/la-config
 bin/la-create

LATMOS-Accounts/lib/LATMOS/Accounts/Acls.pm

@@ -33 +33 @@
 enclose into bracket, either a '*' to match any attribute.
 
-Special keyword C<CREATE> and C<DELETE> can be used to allow or deny object
+Special keyword C<@CREATE> and C<@DELETE> can be used to allow or deny object
 creation and deletion. In this case USER in form C<$...> and read permission
-have no effect (see below). C<*> do not include C<CREATE> and C<DELETE> action.
+have no effect (see below). C<*> do not include C<@CREATE> and C<@DELETE> action.
 
 =item USER can be
@@ -127 +127 @@
 sub check {
     my ($self, $obj, $attr, $perm, $who, $groups) = @_;
+    # Asking 'r' perm over create or delete has no sense:
+    $attr =~ /^@(CREATE|DELETE)$/ && $perm eq 'r' and return;
+
     foreach my $acl (@{$self->{_acls}}) {
         my $res = $acl->match($obj, $attr, $perm, $who, $groups);
@@ -188 +191 @@
     my $objtype = ref $obj ? lc($obj->type) : $obj;
     $attr = lc($attr);
+
+    # Does this ACL series concern this object:
     if (!($self->{obj} eq '*' || $self->{obj} eq $objtype)) {
         return
     }
-    grep { ($_ !~ /^(CREATE|DELETE)$/ && $_ eq '*') || $_ eq $attr } @{$self->{attr}} or return;
-
+    # Does this ACL series concern this attribute:
+    grep { ($_ !~ /^@(CREATE|DELETE)$/ && $_ eq '*') || $_ eq $attr } @{$self->{attr}} or return;
+
+    # Foreach user, testing if this permission match:
     foreach my $u (@{ $self->{users} }) {
+        # Obj have attr eq login user
         if (substr($u->{user}, 0, 1) eq '$') { # check attr content
             if (ref $obj) {
@@ -201 +209 @@
                 return ($u->{$perm} || 0) if (grep { $_ eq $who } @vals);
             }
+        # user is in group
         } elsif (substr($u->{user}, 0, 1) eq '%') { # group
             my $group = substr($u->{user}, 1);
             return ($u->{$perm} || 0) if (grep { $group eq $_ } @{$groups ||[]});
+        # any user
         } elsif ($u->{user} eq '*' || $u->{user} eq $who) {
             return $u->{$perm} || 0;
+        # any authenticated user
         } elsif (lc($u->{user}) eq '@authenticated' && $who) {
             return $u->{$perm} || 0;
+        # not login
         } elsif (lc($u->{user}) eq '@anonymous' && $who eq "") {
             return $u->{$perm} || 0;