1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271 | -----------------------------------------------------------------------
-- security-contexts -- Context to provide security information and verify permissions
-- Copyright (C) 2011, 2012, 2016, 2022 Stephane Carrez
-- Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
-- http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.
-----------------------------------------------------------------------
with Ada.Task_Attributes;
with Ada.Unchecked_Deallocation;
package body Security.Contexts is
use type Security.Policies.Policy_Context_Array_Access;
use type Security.Policies.Policy_Access;
use type Security.Policies.Policy_Context_Access;
package Task_Context is new Ada.Task_Attributes
(Security_Context_Access, null);
procedure Free is
new Ada.Unchecked_Deallocation (Object => Security.Policies.Policy_Context'Class,
Name => Security.Policies.Policy_Context_Access);
-- ------------------------------
-- Get the application associated with the current service operation.
-- ------------------------------
function Get_User_Principal (Context : in Security_Context'Class)
return Security.Principal_Access is
begin
return Context.Principal;
end Get_User_Principal;
-- ------------------------------
-- Get the permission manager.
-- ------------------------------
function Get_Permission_Manager (Context : in Security_Context'Class)
return Security.Policies.Policy_Manager_Access is
begin
return Context.Manager;
end Get_Permission_Manager;
-- ------------------------------
-- Get the policy with the name <b>Name</b> registered in the policy manager.
-- Returns null if there is no such policy.
-- ------------------------------
function Get_Policy (Context : in Security_Context'Class;
Name : in String) return Security.Policies.Policy_Access is
use type Security.Policies.Policy_Manager_Access;
begin
if Context.Manager = null then
return null;
else
return Context.Manager.Get_Policy (Name);
end if;
end Get_Policy;
-- ------------------------------
-- Check if the permission identified by <b>Permission</b> is allowed according to
-- the current security context.
-- Returns True if the permission is granted.
-- ------------------------------
function Has_Permission (Context : in Security_Context;
Permission : in Permissions.Permission_Index) return Boolean is
use type Security.Policies.Policy_Manager_Access;
begin
if Context.Manager = null then
return False;
end if;
declare
Perm : Security.Permissions.Permission (Permission);
begin
return Context.Manager.Has_Permission (Context, Perm);
end;
end Has_Permission;
-- ------------------------------
-- Check if the permission identified by <b>Permission</b> is allowed according to
-- the current security context.
-- Returns True if the permission is granted.
-- ------------------------------
function Has_Permission (Context : in Security_Context;
Permission : in String) return Boolean is
Index : constant Permissions.Permission_Index
:= Permissions.Get_Permission_Index (Permission);
begin
return Security_Context'Class (Context).Has_Permission (Index);
end Has_Permission;
-- ------------------------------
-- Check if the permission identified by <b>Permission</b> is allowed according to
-- the current security context.
-- Returns True if the permission is granted.
-- ------------------------------
function Has_Permission (Context : in Security_Context;
Permission : in Permissions.Permission'Class) return Boolean is
use type Security.Policies.Policy_Manager_Access;
begin
if Context.Manager = null then
return False;
else
return Context.Manager.Has_Permission (Context, Permission);
end if;
end Has_Permission;
-- ------------------------------
-- Initializes the service context. By creating the <b>Security_Context</b> variable,
-- the instance will be associated with the current task attribute. If the current task
-- already has a security context, the new security context is installed, the old one
-- being kept.
-- ------------------------------
overriding
procedure Initialize (Context : in out Security_Context) is
begin
Context.Previous := Task_Context.Value;
-- If we already have a security context, setup the manager and user principal.
if Context.Previous /= null then
Context.Manager := Context.Previous.Manager;
Context.Principal := Context.Previous.Principal;
end if;
Task_Context.Set_Value (Context'Unchecked_Access);
end Initialize;
-- ------------------------------
-- Finalize the security context releases any object. The previous security context is
-- restored to the current task attribute.
-- ------------------------------
overriding
procedure Finalize (Context : in out Security_Context) is
procedure Free is
new Ada.Unchecked_Deallocation (Object => Security.Policies.Policy_Context_Array,
Name => Security.Policies.Policy_Context_Array_Access);
begin
Task_Context.Set_Value (Context.Previous);
if Context.Contexts /= null then
for I in Context.Contexts'Range loop
Free (Context.Contexts (I));
end loop;
Free (Context.Contexts);
end if;
end Finalize;
-- ------------------------------
-- Set a policy context information represented by <b>Value</b> and associated with
-- the policy index <b>Policy</b>.
-- ------------------------------
procedure Set_Policy_Context (Context : in out Security_Context;
Policy : in Security.Policies.Policy_Access;
Value : in Security.Policies.Policy_Context_Access) is
begin
if Context.Contexts = null then
Context.Contexts := Context.Manager.Create_Policy_Contexts;
end if;
Free (Context.Contexts (Policy.Get_Policy_Index));
Context.Contexts (Policy.Get_Policy_Index) := Value;
end Set_Policy_Context;
-- ------------------------------
-- Get the policy context information registered for the given security policy in the security
-- context <b>Context</b>.
-- Raises <b>Invalid_Context</b> if there is no such information.
-- Raises <b>Invalid_Policy</b> if the policy was not set.
-- ------------------------------
function Get_Policy_Context (Context : in Security_Context;
Policy : in Security.Policies.Policy_Access)
return Security.Policies.Policy_Context_Access is
Result : Security.Policies.Policy_Context_Access;
begin
if Policy = null then
raise Invalid_Policy;
end if;
if Context.Contexts = null then
raise Invalid_Context;
end if;
Result := Context.Contexts (Policy.Get_Policy_Index);
return Result;
end Get_Policy_Context;
-- ------------------------------
-- Returns True if a context information was registered for the security policy.
-- ------------------------------
function Has_Policy_Context (Context : in Security_Context;
Policy : in Security.Policies.Policy_Access) return Boolean is
begin
return Policy /= null and then Context.Contexts /= null
and then Context.Contexts (Policy.Get_Policy_Index) /= null;
end Has_Policy_Context;
-- ------------------------------
-- Set the current application and user context.
-- ------------------------------
procedure Set_Context (Context : in out Security_Context;
Manager : in Security.Policies.Policy_Manager_Access;
Principal : in Security.Principal_Access) is
use type Security.Policies.Policy_Manager_Access;
begin
if Manager /= null then
Context.Manager := Manager;
end if;
if Principal /= null then
Context.Principal := Principal;
end if;
if Manager = null and then Principal = null then
raise Invalid_Context with "There is no policy manager and no user principal";
end if;
end Set_Context;
-- ------------------------------
-- Get the current security context.
-- Returns null if the current thread is not associated with any security context.
-- ------------------------------
function Current return Security_Context_Access is
begin
return Task_Context.Value;
end Current;
-- ------------------------------
-- Check if the permission identified by <b>Permission</b> is allowed according to
-- the current security context.
-- ------------------------------
function Has_Permission (Permission : in Permissions.Permission_Index) return Boolean is
Context : constant Security_Context_Access := Current;
begin
if Context = null then
return False;
else
return Context.Has_Permission (Permission);
end if;
end Has_Permission;
-- ------------------------------
-- Check if the permission identified by <b>Permission</b> is allowed according to
-- the current security context.
-- ------------------------------
function Has_Permission (Permission : in String) return Boolean is
Context : constant Security_Context_Access := Current;
begin
if Context = null then
return False;
else
return Context.Has_Permission (Permission);
end if;
end Has_Permission;
-- ------------------------------
-- Check if the permission identified by <b>Permission</b> is allowed according to
-- the current security context.
-- ------------------------------
function Has_Permission (Permission : in Permissions.Permission'Class) return Boolean is
Context : constant Security_Context_Access := Current;
begin
if Context = null then
return False;
else
return Context.Has_Permission (Permission);
end if;
end Has_Permission;
end Security.Contexts;
|