Changeset 2344

Timestamp:

04/10/20 11:27:06 (4 years ago)

Author:

nanardon

Message:

Ensure object from acl are deferenced to allow object alias to work

Location:

trunk/LATMOS-Accounts/lib/LATMOS/Accounts

Files:

• Acls.pm (modified) (1 diff)
• Acls/Acl.pm (modified) (4 diffs)
• Bases.pm (modified) (1 diff)
• Bases/Objects.pm (modified) (1 diff)

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

@@ -171 +171 @@
 
 sub check {
-    my ($self, $obj, $attr, $perm, $who, $groups) = @_;
+    my ($self, $obj, $attr, $perm, $who, $groups, $base) = @_;
     # Asking 'r' perm over create or delete has no sense:
     $attr =~ /^@(CREATE|DELETE)$/ && $perm eq 'r' and return;
 
     foreach my $acl (@{$self->{_acls}}, @{$self->{_default_acls}}) {
-        my $res = $acl->match($obj, $attr, $perm, $who, $groups);
+        my $res = $acl->match($obj, $attr, $perm, $who, $groups, $base);
         if ( defined($res) ) {
             if ( $ENV{LA_ACL_DEBUG} ) {

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

@@ -65 +65 @@
 }
 
-=head2 match($obj, $attr, $perm, $who, $groups)
+=head2 match($obj, $attr, $perm, $who, $groups, $base)
 
 Return true is this sub acl apply to C<$obj>/C<$attr> for C<$perm> by user
@@ -73 +73 @@
 
 sub match {
-    my ($self, $obj, $attr, $perm, $who, $groups) = @_;
+    my ($self, $obj, $attr, $perm, $who, $groups, $base) = @_;
     my $objtype = ref $obj ? lc($obj->type) : $obj;
     $attr = lc($attr);
@@ -89 +89 @@
         # Obj have attr eq login user
         if (substr($u->{user}, 0, 1) eq '$') { # check attr content
-            if (ref $obj) {
-                my $attribute = substr($u->{user}, 1);
-                my $val = $obj->_get_c_field($attribute) or return;
-                my @vals = ref $val ? (@{ $val }) : ($val);
-                foreach (@vals) {
-                    my $uobj = $obj->base->get_object('user', $_) or next;
-                    return $u->{$perm} if ($uobj->id eq $who);
-                }
+            my $attribute = substr($u->{user}, 1);
+            my $val = $obj->_get_c_field($attribute) or return;
+            my @vals = ref $val ? (@{ $val }) : ($val);
+            foreach (@vals) {
+                return $u->{$perm} if ($self->_objId('user', $_, $base) eq $who);
             }
         # user is in group
         } elsif (substr($u->{user}, 0, 1) eq '%') { # group
             my $group = substr($u->{user}, 1);
-            return $u->{$perm} if (grep { $group eq $_ } grep { $_ } @{$groups ||[]});
+            return $u->{$perm} if (grep { $self->_objId('group', $group, $base) eq $_ } grep { $_ } @{$groups ||[]});
         # any user
         } elsif ($u->{user} eq '*' || $u->{user} eq $who) {
@@ -116 +113 @@
     }
     return;
+}
+
+sub _objId {
+    my ( $self, $otype, $id, $base ) = @_;
+
+    $base or return $id;
+
+    my $obj = $base->get_object( $otype, $id ) or return $id;
+
+    return $obj->AclID;
 }
 

trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Bases.pm

@@ -1277 +1277 @@
             $who = '';
         }
-        my $res = $self->{_acls}->check($obj, $attr, $perm, $who, $groups);
+        my $res = $self->{_acls}->check($obj, $attr, $perm, $who, $groups, $self);
         $self->log(LA_INFO, 'permission denied for "%s" to get %s.%s for %s',
            $who, ref $obj ? $obj->id . '(' . $obj->type . ')' : $obj, $attr, $perm) if (!$res);

trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Objects.pm

@@ -129 +129 @@
     $self->{_id}
 }
+
+=head2 AclID
+
+Return object for acl check
+
+=cut
+
+sub AclID { $_[0]->id }
 
 =head2 Iid