[309] | 1 | use strict; |
---|
| 2 | use warnings; |
---|
[1048] | 3 | use Test::More tests => 15; |
---|
[309] | 4 | |
---|
| 5 | use_ok('LATMOS::Accounts::Acls'); |
---|
[1048] | 6 | use_ok('LATMOS::Accounts::Acls::Acl'); |
---|
[309] | 7 | |
---|
| 8 | { |
---|
[1048] | 9 | ok(my $acl = LATMOS::Accounts::Acls::Acl->new('user.uid', [ 'user1: read' ]), |
---|
[309] | 10 | "can create single acl"); |
---|
[310] | 11 | is($acl->match(fakeobject->new('user', 'user1'), 'uid', 'r', 'user1'), 1, "acl match"); |
---|
[490] | 12 | is($acl->match(fakeobject->new('user', 'user2'), 'uid', 'w', 'user1') || 0, 0, "acl match"); |
---|
[309] | 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"); |
---|
[310] | 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"); |
---|
[420] | 42 | is( |
---|
| 43 | $acls->check('user', 'CREATE', 'w', 'user1', [ 'admin' ]), 1, |
---|
| 44 | "user can create a new user"); |
---|
[309] | 45 | } |
---|
[310] | 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 | |
---|
[2343] | 56 | sub base { return $_[0] } |
---|
| 57 | |
---|
| 58 | sub get_object { return $_[0] } |
---|
| 59 | |
---|
[310] | 60 | sub type { |
---|
| 61 | $_[0]->{type} |
---|
| 62 | } |
---|
| 63 | |
---|
| 64 | sub id { |
---|
| 65 | $_[0]->{id} |
---|
| 66 | } |
---|
| 67 | |
---|
[317] | 68 | sub _get_c_field { |
---|
[310] | 69 | $_[0]->{id} |
---|
| 70 | } |
---|