1 | use strict; |
---|
2 | use warnings; |
---|
3 | use Test::More tests => 15; |
---|
4 | |
---|
5 | use_ok('LATMOS::Accounts::Acls'); |
---|
6 | use_ok('LATMOS::Accounts::Acls::Acl'); |
---|
7 | |
---|
8 | { |
---|
9 | ok(my $acl = LATMOS::Accounts::Acls::Acl->new('user.uid', [ 'user1: read' ]), |
---|
10 | "can create single acl"); |
---|
11 | is($acl->match(fakeobject->new('user', 'user1'), 'uid', 'r', 'user1'), 1, "acl match"); |
---|
12 | is($acl->match(fakeobject->new('user', 'user2'), 'uid', 'w', 'user1') || 0, 0, "acl match"); |
---|
13 | } |
---|
14 | |
---|
15 | { |
---|
16 | ok(my $acls = LATMOS::Accounts::Acls->new, "Can create new acls objects"); |
---|
17 | ok($acls->add('user.uid', [ 'user1: read' ]), "Can add new acl"); |
---|
18 | } |
---|
19 | |
---|
20 | { |
---|
21 | ok(my $acls = LATMOS::Accounts::Acls->new('testdata/acls1'), |
---|
22 | "Can create new acls objects from file"); |
---|
23 | # now testing... |
---|
24 | is( |
---|
25 | $acls->check(fakeobject->new('user', 'user1'), 'uid', 'r', 'user1'), |
---|
26 | 1, "user can read uid"); |
---|
27 | is( |
---|
28 | $acls->check(fakeobject->new('user', 'user1'), 'userPassword', 'r', 'user1'), |
---|
29 | 0, "user cannot read userPassword"); |
---|
30 | is( |
---|
31 | $acls->check(fakeobject->new('user', 'user1'), 'uid', 'w', 'user1'), |
---|
32 | 0, "user cannot write uid"); |
---|
33 | is( |
---|
34 | $acls->check(fakeobject->new('user', 'user1'), 'givenName', 'w', 'user1'), |
---|
35 | 1, "user can write givenName"); |
---|
36 | is( |
---|
37 | $acls->check(fakeobject->new('user', 'user1'), 'uid', 'w', |
---|
38 | 'user1', [ 'admin' ]), 0, "user cannot write user attribute"); |
---|
39 | is( |
---|
40 | $acls->check(fakeobject->new('group', 'group1'), 'uid', 'w', |
---|
41 | 'user1', [ 'admin' ]), 1, "user can write group attribute"); |
---|
42 | is( |
---|
43 | $acls->check('user', 'CREATE', 'w', 'user1', [ 'admin' ]), 1, |
---|
44 | "user can create a new user"); |
---|
45 | } |
---|
46 | |
---|
47 | |
---|
48 | # A fake object to test only ACLs |
---|
49 | package fakeobject; |
---|
50 | |
---|
51 | sub new { |
---|
52 | my ($class, $type, $id) = @_; |
---|
53 | bless({type => $type, id => $id}, $class); |
---|
54 | } |
---|
55 | |
---|
56 | sub type { |
---|
57 | $_[0]->{type} |
---|
58 | } |
---|
59 | |
---|
60 | sub id { |
---|
61 | $_[0]->{id} |
---|
62 | } |
---|
63 | |
---|
64 | sub _get_c_field { |
---|
65 | $_[0]->{id} |
---|
66 | } |
---|