Changeset 1048

Timestamp:

06/01/12 08:25:19 (12 years ago)

Author:

nanardon

Message:

• split L::A::Acls module using proper perl fs

Location:

trunk/LATMOS-Accounts

Files:

• MANIFEST (modified) (1 diff)
• lib/LATMOS/Accounts/Acls (added)
• lib/LATMOS/Accounts/Acls.pm (modified) (7 diffs)
• lib/LATMOS/Accounts/Acls/Acl.pm (added)
• t/21_acls.t (modified) (1 diff)

trunk/LATMOS-Accounts/MANIFEST

@@ -44 +44 @@
 latmos-accounts.spec.in
 lib/LATMOS/Accounts/Acls.pm
+lib/LATMOS/Accounts/Acls/Acl.pm
 lib/LATMOS/Accounts/Bases/Ad/Group.pm
 lib/LATMOS/Accounts/Bases/Ad/User.pm

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

@@ -4 +4 @@
 use warnings;
 use LATMOS::Accounts::Log;
+use LATMOS::Accounts::Acls::Acl;
 
 our $VERSION = (q$Rev: 330 $ =~ /^Rev: (\d+) /)[0];
@@ -15 +16 @@
 =cut
 
-=head1 new($file)
+=head2 new ($file)
 
 Instanciate Acls from C<$file>
@@ -107 +108 @@
                     push(@{$self->{_acls}}, $acl);
                 }
-                $acl = LATMOS::Accounts::Acls::acl->new($1) or do {
+                $acl = LATMOS::Accounts::Acls::Acl->new($1) or do {
                     la_log(LA_ERR, "Error in %s at line %d", $file,
                         $line_nb);
@@ -147 +148 @@
 sub add {
     my ($self, $obj, $list) = @_;
-    my $acl = LATMOS::Accounts::Acls::acl->new(
+    my $acl = LATMOS::Accounts::Acls::Acl->new(
         $obj, $list) or return;
     push(@{$self->{_acls}}, $acl);
@@ -172 +173 @@
 }
 
+=head2 dump
+
+Return currently load acl as text
+
+=cut
+
 sub dump {
     my ($self) = @_;
@@ -179 +186 @@
 }
 
-package LATMOS::Accounts::Acls::acl;
-use strict;
-use warnings;
-
-=head1 LATMOS::Accounts::Acls::acl
-
-=head2 new($objdotatt, $list)
-
-Create new sub acl where C<$objdotatt> is object in form C<Object.Attribute> and
-C<$list> the list of permission.
-
-=cut
-
-sub new {
-    my ($class, $objdotatt, $list) = @_;
-    my ($obj, $attr) = $objdotatt =~ /^([^.]+)\.(.*)/ or return;
-    my @attrs = ($attr =~ /^\{(.*)\}$/)
-        ? (split(/\s*,\s*/, $1))
-        : ($attr);
-    @attrs or return;
-    my $acl = {
-        obj => lc($obj),
-        attr => [ map { lc } @attrs ],
-        users => [], # user->{r} = 1 
-    };
-    bless($acl, $class);
-    foreach my $k (@{ $list || [] }) {
-        $acl->add_perm($k) or return;
-    }
-    $acl
-}
-
-=head2 add_perm($perm)
-
-Add a permission to this sub acl
-
-=cut
-
-sub add_perm {
-    my ($self, $perm) = @_;
-    my ($username, $perms) = $perm =~ /^\s*(\S*):\s*(.*)$/;
-    $username && $perms or return;
-    my $user = { user => $username };
-    foreach (split(/\s*,\s*/, $perms)) {
-        /^read$/i  and do { $user->{r} = 1; next; };
-        /^write$/i and do { $user->{w} = 1; next; };
-        /^deny$/i and do {
-            # reseting...
-            $user->{r} = 0;
-            $user->{w} = 0;
-            last; # we end here, life is hard
-        };
-        return;
-    }
-    push(@{$self->{users}}, $user);
-    1
-}
-
-=head2 match($obj, $attr, $perm, $who, $groups)
-
-Return true is this sub acl apply to C<$obj>/C<$attr> for C<$perm> by user
-C<$who> in groups C<$groups>.
-
-=cut
-
-sub match {
-    my ($self, $obj, $attr, $perm, $who, $groups) = @_;
-    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
-    }
-    # Does this ACL series concern this attribute:
-    grep { $_ 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) {
-                my $attribute = substr($u->{user}, 1);
-                my $val = $obj->_get_c_field($attribute) or return;
-                my @vals = ref $val ? (@{ $val }) : ($val);
-                return $u->{$perm} if (defined($u->{$perm}) && 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} if (defined($u->{$perm}) && grep { $group eq $_ } grep { $_ } @{$groups ||[]});
-        # any user
-        } elsif ($u->{user} eq '*' || $u->{user} eq $who) {
-            return $u->{$perm} if (defined($u->{$perm}));
-        # any authenticated user
-        } elsif (lc($u->{user}) eq '@authenticated' && $who) {
-            return $u->{$perm} if (defined($u->{$perm}));
-        # not login
-        } elsif (lc($u->{user}) eq '@anonymous' && $who eq "") {
-            return $u->{$perm} if (defined($u->{$perm}));
-        }
-    }
-    return;
-}
-
-=head2 dump
-
-Return a textual dump of the sub acl
-
-=cut
-
-sub dump {
-    my ($self) = @_;
-    my $dump = sprintf("%s.{%s}\n", $self->{obj}, join(', ', @{$self->{attr}}));
-    foreach my $u (@{ $self->{users} }) {
-        $dump .= sprintf("\t%s: %s\n",
-            $u->{user},
-            join(', ', ($u->{r} ? 'read' : ()), ($u->{w} ? 'write' : ())) ||
-            'deny');
-    }
-    $dump
-}
-
 1;
 
@@ -307 +191 @@
 
 =head1 SEE ALSO
+
+L<LATMOS::Accounts::Acls::Acl>
 
 =head1 AUTHOR

trunk/LATMOS-Accounts/t/21_acls.t

@@ -1 +1 @@
 use strict;
 use warnings;
-use Test::More tests => 14;
+use Test::More tests => 15;
 
 use_ok('LATMOS::Accounts::Acls');
+use_ok('LATMOS::Accounts::Acls::Acl');
 
 {
-    ok(my $acl = LATMOS::Accounts::Acls::acl->new('user.uid', [ 'user1: read' ]),
+    ok(my $acl = LATMOS::Accounts::Acls::Acl->new('user.uid', [ 'user1: read' ]),
         "can create single acl");
     is($acl->match(fakeobject->new('user', 'user1'), 'uid', 'r', 'user1'), 1, "acl match");