| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Authorization::AccessControl::Grant 0.04; |
|
2
|
7
|
|
|
7
|
|
189359
|
use v5.26; |
|
|
7
|
|
|
|
|
31
|
|
|
3
|
7
|
|
|
7
|
|
39
|
use warnings; |
|
|
7
|
|
|
|
|
15
|
|
|
|
7
|
|
|
|
|
453
|
|
|
4
|
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
# ABSTRACT: Encapsulation of the parameters of a privilege grant |
|
6
|
|
|
|
|
|
|
|
|
7
|
7
|
|
|
7
|
|
4082
|
use Data::Compare; |
|
|
7
|
|
|
|
|
106243
|
|
|
|
7
|
|
|
|
|
68
|
|
|
8
|
7
|
|
|
7
|
|
37219
|
use Readonly; |
|
|
7
|
|
|
|
|
36365
|
|
|
|
7
|
|
|
|
|
566
|
|
|
9
|
7
|
|
|
7
|
|
64
|
use Scalar::Util qw(looks_like_number); |
|
|
7
|
|
|
|
|
19
|
|
|
|
7
|
|
|
|
|
435
|
|
|
10
|
|
|
|
|
|
|
|
|
11
|
7
|
|
|
7
|
|
2765
|
use experimental qw(signatures); |
|
|
7
|
|
|
|
|
22250
|
|
|
|
7
|
|
|
|
|
53
|
|
|
12
|
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
use overload |
|
14
|
7
|
|
|
7
|
|
1469
|
'""' => 'to_string'; |
|
|
7
|
|
|
|
|
17
|
|
|
|
7
|
|
|
|
|
67
|
|
|
15
|
|
|
|
|
|
|
|
|
16
|
62
|
|
|
62
|
1
|
284584
|
sub new($class, %params) { |
|
|
62
|
|
|
|
|
175
|
|
|
|
62
|
|
|
|
|
215
|
|
|
|
62
|
|
|
|
|
252
|
|
|
17
|
62
|
|
|
|
|
131
|
my $role = delete($params{role}); |
|
18
|
62
|
|
|
|
|
121
|
my $resource = delete($params{resource}); |
|
19
|
62
|
|
|
|
|
117
|
my $action = delete($params{action}); |
|
20
|
62
|
|
|
|
|
119
|
my $restrictions = delete($params{restrictions}); |
|
21
|
62
|
100
|
|
|
|
203
|
$restrictions = {} unless (defined($restrictions)); |
|
22
|
|
|
|
|
|
|
|
|
23
|
62
|
100
|
|
|
|
219
|
die("Unsupported params: ", join(', ', keys(%params))) if (keys(%params)); |
|
24
|
61
|
100
|
66
|
|
|
308
|
die("Role must be a non-empty string") if (defined($role) && (ref($role) || $role eq '')); |
|
|
|
|
100
|
|
|
|
|
|
25
|
60
|
100
|
66
|
|
|
277
|
die("Resource is required") unless ($resource && !ref($resource)); |
|
26
|
58
|
100
|
66
|
|
|
236
|
die("Action is required") unless ($action && !ref($action)); |
|
27
|
56
|
50
|
33
|
|
|
236
|
die("Restrictions must be a HashRef") unless (defined($restrictions) && ref($restrictions) eq 'HASH'); |
|
28
|
|
|
|
|
|
|
|
|
29
|
56
|
|
|
|
|
356
|
Readonly::Scalar my $data => { |
|
30
|
|
|
|
|
|
|
_role => $role, |
|
31
|
|
|
|
|
|
|
_resource => $resource, |
|
32
|
|
|
|
|
|
|
_action => $action, |
|
33
|
|
|
|
|
|
|
_restrictions => $restrictions |
|
34
|
|
|
|
|
|
|
}; |
|
35
|
|
|
|
|
|
|
|
|
36
|
56
|
|
|
|
|
7653
|
bless($data, $class); |
|
37
|
|
|
|
|
|
|
} |
|
38
|
|
|
|
|
|
|
|
|
39
|
9
|
|
|
9
|
0
|
850
|
sub to_string($self, @params) { |
|
|
9
|
|
|
|
|
41
|
|
|
|
9
|
|
|
|
|
22
|
|
|
|
9
|
|
|
|
|
14
|
|
|
40
|
9
|
100
|
|
|
|
47
|
my $role = $self->{_role} ? '[' . $self->{_role} . '] ' : ''; |
|
41
|
9
|
|
|
|
|
83
|
my $restrictions = ''; |
|
42
|
9
|
|
|
|
|
29
|
foreach (keys($self->{_restrictions}->%*)) { |
|
43
|
3
|
|
|
|
|
82
|
my $v; |
|
44
|
3
|
50
|
|
|
|
13
|
if ($self->{_restrictions}->{$_}) {$v = $self->{_restrictions}->{$_}} |
|
|
3
|
0
|
|
|
|
42
|
|
|
45
|
0
|
|
|
|
|
0
|
elsif (looks_like_number($self->{_restrictions}->{$_})) {$v = 0} |
|
46
|
0
|
|
|
|
|
0
|
else {$v = 'false'} |
|
47
|
3
|
|
|
|
|
42
|
$restrictions .= "$_=$v,"; |
|
48
|
|
|
|
|
|
|
} |
|
49
|
9
|
|
|
|
|
82
|
chop($restrictions); |
|
50
|
9
|
|
|
|
|
25
|
$role . $self->{_resource} . ' => ' . $self->{_action} . '(' . $restrictions . ')'; |
|
51
|
|
|
|
|
|
|
} |
|
52
|
|
|
|
|
|
|
|
|
53
|
164
|
|
|
164
|
1
|
674
|
sub role($self) { |
|
|
164
|
|
|
|
|
221
|
|
|
|
164
|
|
|
|
|
216
|
|
|
54
|
164
|
|
|
|
|
531
|
$self->{_role}; |
|
55
|
|
|
|
|
|
|
} |
|
56
|
|
|
|
|
|
|
|
|
57
|
70
|
|
|
70
|
1
|
263
|
sub resource($self) { |
|
|
70
|
|
|
|
|
98
|
|
|
|
70
|
|
|
|
|
110
|
|
|
58
|
70
|
|
|
|
|
172
|
$self->{_resource}; |
|
59
|
|
|
|
|
|
|
} |
|
60
|
|
|
|
|
|
|
|
|
61
|
54
|
|
|
54
|
1
|
193
|
sub action($self) { |
|
|
54
|
|
|
|
|
88
|
|
|
|
54
|
|
|
|
|
74
|
|
|
62
|
54
|
|
|
|
|
189
|
$self->{_action}; |
|
63
|
|
|
|
|
|
|
} |
|
64
|
|
|
|
|
|
|
|
|
65
|
18
|
|
|
18
|
1
|
67
|
sub restrictions($self) { |
|
|
18
|
|
|
|
|
26
|
|
|
|
18
|
|
|
|
|
27
|
|
|
66
|
18
|
|
|
|
|
47
|
$self->{_restrictions}; |
|
67
|
|
|
|
|
|
|
} |
|
68
|
|
|
|
|
|
|
|
|
69
|
24
|
|
|
24
|
|
57
|
sub _satisfies_role($self, @roles) { |
|
|
24
|
|
|
|
|
37
|
|
|
|
24
|
|
|
|
|
42
|
|
|
|
24
|
|
|
|
|
66
|
|
|
70
|
24
|
100
|
|
|
|
105
|
return 1 unless ($self->{_role}); |
|
71
|
10
|
|
|
|
|
123
|
return (grep {$_ eq $self->{_role}} @roles) > 0; |
|
|
6
|
|
|
|
|
27
|
|
|
72
|
|
|
|
|
|
|
} |
|
73
|
|
|
|
|
|
|
|
|
74
|
90
|
|
|
90
|
|
111
|
sub _satisfies_resource($self, $resource) { |
|
|
90
|
|
|
|
|
117
|
|
|
|
90
|
|
|
|
|
115
|
|
|
|
90
|
|
|
|
|
107
|
|
|
75
|
90
|
100
|
|
|
|
191
|
return 0 unless (defined($resource)); |
|
76
|
89
|
|
|
|
|
273
|
return $self->{_resource} eq $resource; |
|
77
|
|
|
|
|
|
|
} |
|
78
|
|
|
|
|
|
|
|
|
79
|
51
|
|
|
51
|
|
67
|
sub _satisfies_action($self, $action) { |
|
|
51
|
|
|
|
|
65
|
|
|
|
51
|
|
|
|
|
72
|
|
|
|
51
|
|
|
|
|
59
|
|
|
80
|
51
|
100
|
|
|
|
104
|
return 0 unless (defined($action)); |
|
81
|
50
|
|
|
|
|
137
|
return $self->{_action} eq $action; |
|
82
|
|
|
|
|
|
|
} |
|
83
|
|
|
|
|
|
|
|
|
84
|
18
|
|
|
18
|
|
27
|
sub _satisfies_restrictions($self, $attributes) { |
|
|
18
|
|
|
|
|
30
|
|
|
|
18
|
|
|
|
|
40
|
|
|
|
18
|
|
|
|
|
26
|
|
|
85
|
18
|
|
|
|
|
71
|
my %attrs = $attributes->%*; |
|
86
|
18
|
|
|
|
|
135
|
delete($attrs{$_}) foreach (grep {!exists($self->{_restrictions}->{$_})} keys(%attrs)); |
|
|
16
|
|
|
|
|
118
|
|
|
87
|
18
|
|
|
|
|
218
|
my $v = Compare($self->{_restrictions}, \%attrs); |
|
88
|
18
|
|
|
|
|
2498
|
return $v; |
|
89
|
|
|
|
|
|
|
} |
|
90
|
|
|
|
|
|
|
|
|
91
|
82
|
|
|
82
|
1
|
181
|
sub is_equal($self, $priv) { |
|
|
82
|
|
|
|
|
117
|
|
|
|
82
|
|
|
|
|
106
|
|
|
|
82
|
|
|
|
|
100
|
|
|
92
|
82
|
100
|
100
|
|
|
161
|
return 0 unless (($self->role // '') eq ($priv->role // '')); |
|
|
|
|
100
|
|
|
|
|
|
93
|
35
|
100
|
|
|
|
411
|
return 0 unless ($self->resource eq $priv->resource); |
|
94
|
27
|
100
|
|
|
|
208
|
return 0 unless ($self->action eq $priv->action); |
|
95
|
9
|
100
|
|
|
|
73
|
return 0 unless (Compare($self->restrictions, $priv->restrictions)); |
|
96
|
6
|
|
|
|
|
685
|
return 1; |
|
97
|
|
|
|
|
|
|
} |
|
98
|
|
|
|
|
|
|
|
|
99
|
90
|
|
|
90
|
1
|
5289
|
sub accepts($self, %params) { |
|
|
90
|
|
|
|
|
116
|
|
|
|
90
|
|
|
|
|
162
|
|
|
|
90
|
|
|
|
|
1072
|
|
|
100
|
90
|
|
|
|
|
198
|
my ($roles, $resource, $action, $attributes) = @params{qw(roles resource action attributes)}; |
|
101
|
|
|
|
|
|
|
|
|
102
|
90
|
100
|
|
|
|
160
|
return 0 unless ($self->_satisfies_resource($resource)); |
|
103
|
51
|
100
|
|
|
|
416
|
return 0 unless ($self->_satisfies_action($action)); |
|
104
|
24
|
100
|
100
|
|
|
244
|
return 0 unless ($self->_satisfies_role(($roles // [])->@*)); |
|
105
|
18
|
100
|
100
|
|
|
216
|
return 0 unless ($self->_satisfies_restrictions($attributes // {})); |
|
106
|
11
|
|
|
|
|
90
|
return 1; |
|
107
|
|
|
|
|
|
|
} |
|
108
|
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=head1 NAME |
|
110
|
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
Authorization::AccessControl::Grant - Encapsulation of the parameters of a privilege grant |
|
112
|
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
114
|
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
use Authorization::AccessControl::Grant; |
|
116
|
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
my $grant = Authorization::AccessControl::Grant->new( |
|
118
|
|
|
|
|
|
|
resource => 'Book', |
|
119
|
|
|
|
|
|
|
action => 'read', |
|
120
|
|
|
|
|
|
|
); |
|
121
|
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
$grant->accepts(resource => 'Book', action => 'read'); |
|
123
|
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
125
|
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
This is a simple class to encapsulate the properties of a privilege grant: |
|
127
|
|
|
|
|
|
|
resource, action, roles, and restrictions, with the latter two optional. Methods |
|
128
|
|
|
|
|
|
|
are available for checking all properties at once (L) and determining |
|
129
|
|
|
|
|
|
|
if another grant is exactly equal (used for duplicate detection) (L). |
|
130
|
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
Grant instances are immutable: none of their properties may be altered after |
|
132
|
|
|
|
|
|
|
object creation. |
|
133
|
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=head1 METHODS |
|
135
|
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
=head2 new |
|
137
|
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
Authorization::AccessControl::Grant->new( %params ) |
|
139
|
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
Creates a new privilege grant instance. Normally, you should use |
|
141
|
|
|
|
|
|
|
L rather than this constructor |
|
142
|
|
|
|
|
|
|
directly, to create and "register" instances. C, C, C, |
|
143
|
|
|
|
|
|
|
and C keys are respected in C<%params> |
|
144
|
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
=head2 role |
|
146
|
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
Accessor for the C property |
|
148
|
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
=head2 resource |
|
150
|
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
Accessor for the C property |
|
152
|
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
=head2 action |
|
154
|
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
Accessor for the C property |
|
156
|
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
=head2 restrictions |
|
158
|
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
Accessor for the C property |
|
160
|
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
=head2 is_equal |
|
162
|
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
$grant1->is_equal($grant2) |
|
164
|
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
Returns true if all properties of both grants are exactly the same, false |
|
166
|
|
|
|
|
|
|
otherwise |
|
167
|
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
=head2 accepts |
|
169
|
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
$grant->accepts( %params ) |
|
171
|
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
Returns true if the parameters meet all of the requirements of the grant, false |
|
173
|
|
|
|
|
|
|
otherwise. Specifically, this means that C and C must match |
|
174
|
|
|
|
|
|
|
exactly, the grant's C (if set) must be contained within the C |
|
175
|
|
|
|
|
|
|
ArrayRef, and every item in the grant's C must be matched by a |
|
176
|
|
|
|
|
|
|
corresponding entry with the same value in the C HashRef |
|
177
|
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=head1 AUTHOR |
|
179
|
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
Mark Tyrrell C<< >> |
|
181
|
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
=head1 LICENSE |
|
183
|
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
Copyright (c) 2024 Mark Tyrrell |
|
185
|
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
Permission is hereby granted, free of charge, to any person obtaining a copy |
|
187
|
|
|
|
|
|
|
of this software and associated documentation files (the "Software"), to deal |
|
188
|
|
|
|
|
|
|
in the Software without restriction, including without limitation the rights |
|
189
|
|
|
|
|
|
|
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell |
|
190
|
|
|
|
|
|
|
copies of the Software, and to permit persons to whom the Software is |
|
191
|
|
|
|
|
|
|
furnished to do so, subject to the following conditions: |
|
192
|
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
The above copyright notice and this permission notice shall be included in all |
|
194
|
|
|
|
|
|
|
copies or substantial portions of the Software. |
|
195
|
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR |
|
197
|
|
|
|
|
|
|
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, |
|
198
|
|
|
|
|
|
|
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE |
|
199
|
|
|
|
|
|
|
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER |
|
200
|
|
|
|
|
|
|
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, |
|
201
|
|
|
|
|
|
|
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE |
|
202
|
|
|
|
|
|
|
SOFTWARE. |
|
203
|
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
=cut |
|
205
|
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
1; |
|
207
|
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
__END__ |