Coverage report: /development/source/library/org/datagraph/spocq-shard/src/core/capabilities.lisp

KindCoveredAll%
expression93229 40.6
branch36 50.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; -*- Mode: lisp; Syntax: ansi-common-lisp; Base: 10; Package: org.datagraph.spocq.implementation; -*-
2
 
3
 (in-package :org.datagraph.spocq.implementation)
4
 
5
 (:documentation "Authorization operators"
6
  "Implement authorization constraints in the form of a two-phased query.
7
  - First, look for a direct match given a context, the target, the agent and the operation.
8
    This is a probe for direct pattern which combines acl:accessTo, the repository
9
    the access mode and the agent, with the repository as context, against the respective
10
    <account>/system repository.
11
  - If that yields no answer, then a more complex query with path traversal is perfomed,
12
    in which both the agent and the resource permit rdf:type entailment.
13
 
14
   The results are cached based on the four components for later reference.
15
   the cache is in the respective agent, which turns the acl description into a capability system.
16
 
17
   the auth questions are:
18
   - as which agent does the request authenticate
19
   - does the agent have access to an entity ( account repository view )?
20
   - does the account have access to an entity ( repository view ) ?
21
   - does the view have access to an entity (repository view)?
22
   ")
23
 
24
 
25
 #|
26
 ;;; authorization is tested with
27
 ;;; context : repository, task, repository from request resource,
28
 ;;; target : url (service location), repository (or revision), arbitrary url(?) null (from http resource id, not path)
29
 ;;; agent : agent, task account (delegated access)
30
 ;;; action: a w3c mode uri
31
 
32
 the context determines the source for the acl. for a repository or an account this is the respective metadata repository
33
 the target is the "accessTo" assertion subject
34
 the agent is whatever the thread has
35
 the action is an acl action
36
 
37
 if the target is null, then the context bevomes the target
38
 |#
39
 
40
 
41
 (defparameter *direct-capability-view-name* nil) ;; "direct-capability")
42
 (defparameter *inferred-capability-view-name* nil) ;; "inferred-capability")
43
 (defparameter *capability.mode* :direct)
44
 
45
 (defgeneric capability-identifier (instance)
46
   (:documentation "Returns the 'generic' identifier for an instance.
47
    In the case of revisions their identifer differs from that of their reference repository,
48
    but the authorization should be that of the repository, without requiring specific assertions.")
49
   (:method ((instance linked-resource))
50
     "a linked resource relies on its site uri for authorization"
51
     (resource-site-uri instance))
52
   (:method ((instance identified-object))
53
     (or (instance-identifier instance) (site-namespace)))
54
   (:method ((instance repository-revision))
55
     (capability-identifier (repository-revision-reference instance)))
56
   (:method ((instance agent))
57
     (or (instance-identifier instance) |foaf|:|Agent|))
58
   (:method ((instance null))
59
     nil)
60
   (:method ((instance t))
61
     nil)
62
   (:method ((instance spocq:iri))
63
     instance)
64
   (:method ((instance symbol))
65
     (when (iri-p instance) instance))
66
   (:method ((role-name string))
67
     (intern-iri role-name)))
68
 
69
 (defgeneric capability-class (instance)
70
   (:method ((instance authenticated-agent))
71
     |urn:dydra|:|User|)
72
   (:method ((instance located-agent))
73
     |urn:dydra|:|LocatedAgent|)
74
   (:method ((instance agent))
75
     |foaf|:|Agent|)
76
   (:method ((instance t))
77
     nil))
78
 
79
 (defgeneric capability-account (instance)
80
   (:method ((instance authenticated-agent))
81
     (agent-account instance))
82
   (:method ((instance t))
83
     nil))
84
 
85
 
86
 (defun query-capability (acg-repository-id agent target action &rest args)
87
   (declare (dynamic-extent args))
88
   (or (apply #'query-direct-capability acg-repository-id agent target action args)
89
       (and (eq *capability.mode* :inferred)
90
            (apply #'query-inferred-capability acg-repository-id agent target action args))))
91
 
92
 
93
 (defgeneric query-direct-capability (system-repository agent target action &key account class repository view)
94
                                                        
95
   (:method ((system-repository-id string) (agent identified-object) (target t) (action t) &rest args
96
             &key (account (capability-account agent))
97
             (class (capability-class agent))
98
             &allow-other-keys)
99
     (declare (dynamic-extent args))
100
     (apply #'query-direct-capability system-repository-id (capability-identifier agent) target action
101
            :account account
102
            :class class
103
            args))
104
 
105
   (:method ((system-repository-id string) (agent-id t) (target t) (action t) 
106
             &key (account (when *task* (task-account *task*))) (class nil)
107
             (repository (when *task* (task-repository *task*)))
108
             (repository-id (capability-identifier repository))
109
             (view (when *task* (task-request-location *task*))))
110
     "Extract the direct access permission for a given object - agent, account, repository, etc.
111
      If the instance has no identity (eg and anonymous agent), use the site uri.
112
      Allow both the target and the action to be either terms or null, in which case
113
      return all respective asserted modes.
114
 
115
      This is an expensive query, in that it first contructs the authorization complete graph."
116
     ;; eliminate repositories which are generated from resource names, but need not exist
117
     (unless (repository-exists-p system-repository-id)
118
       (return-from query-direct-capability nil))
119
     (let* ((class-id (capability-identifier class))
120
            (target-id (capability-identifier target))
121
            (account-id (capability-identifier account))
122
            (view-id (capability-identifier view))
123
            (auth-view (and *direct-capability-view-name*
124
                            (repository-view system-repository-id *direct-capability-view-name*))))
125
       (if auth-view
126
           (run-sparql-internal auth-view :repository-id system-repository-id
127
                       :agent (system-agent)
128
                       :dynamic-bindings `((?::|agent| ?::|agentClass| ?::|target| ?::|context| ?::|account| ?::|view| ?::|repository|
129
                                               ?::|mode|)
130
                                           ,agent-id ,class-id ,target-id ,target-id
131
                                           ,account-id ,view-id ,repository-id
132
                                           ,action))
133
           (flet ((compute-context-query ()
134
                    (let* ((role-unions
135
                            (loop for role in (remove-duplicates (list agent-id class-id target-id account-id view-id repository-id))
136
                              when role
137
                              collect `(spocq.a:|extend|
138
                                          (spocq.a:|union|
139
                                             (spocq.a:|graph| <urn:dydra:all>
140
                                               (spocq.a:|bgp|
141
                                                 (spocq.a:|triple| ?::aclEntry |acl|:|accessTo| ?::|target|)
142
                                                 (spocq.a:|triple| ?::aclEntry |acl|:|mode| ?::|mode|)
143
                                                 (spocq.a:|triple| ?::aclEntry |acl|:|agent| ,role)))
144
                                             (spocq.a:|join|
145
                                               (spocq.a:|graph| <urn:dydra:all>
146
                                                 (spocq.a:|bgp|
147
                                                   (spocq.a:|triple| ?::aclEntry |acl|:|accessTo| ?::|target|)
148
                                                   (spocq.a:|triple| ?::aclEntry |acl|:|mode| ?::|mode|)
149
                                                   (spocq.a:|triple| ?::aclEntry |acl|:|agent| ?::|mediator|)))
150
                                               (spocq.a:|bgp|
151
                                                 (spocq.a:|triple| ?::|mediator| |prov|:|hadMember| ,role))))
152
                                          ?::|role| ,role)))
153
                           (compound-role-unions (loop for role-union in role-unions
154
                                                   for unions = role-union then `(spocq.a:|union| ,unions ,role-union)
155
                                                   finally (return unions))))
156
                      `(spocq.a:|select| ,compound-role-unions
157
                                (?::|role| ?::|target| ?::|mode| ?::|mediator|)))))
158
             ;; bind mode dynamically in order to return it
159
             (or (run-sparql-internal `(spocq.a:|select| (spocq.a:|graph| <urn:dydra:all>
160
                                                         (spocq.a:|bgp|
161
                                                                  (spocq.a:|triple| ?::aclEntry |acl|:|accessTo| ?::|target|)
162
                                                                  (spocq.a:|triple| ?::aclEntry |acl|:|mode| ?::|mode|)
163
                                                                  (spocq.a:|triple| ?::aclEntry |acl|:|agent| ?::|role|)))
164
                                       (?::|role| ?::|target| ?::|mode|))
165
                             :repository-id system-repository-id
166
                             :agent (system-agent)
167
                             :dynamic-bindings `((?::|target| ?::|mode| ?::|role|) ,target-id ,action ,agent-id))
168
                 (run-sparql-internal `(spocq.a:|select| 
169
                                         (spocq.a:|join|
170
                                           (spocq.a:|union|
171
                                             (spocq.a:|graph| <urn:dydra:all>
172
                                               (spocq.a:|bgp|
173
                                                 (spocq.a:|triple| ?::aclEntry |acl|:|accessTo| ?::|target|)
174
                                                 (spocq.a:|triple| ?::aclEntry |acl|:|mode| ?::|mode|)
175
                                                 (spocq.a:|triple| ?::aclEntry |acl|:|agent| ?::|role|)))
176
                                             (spocq.a:|join|
177
                                               (spocq.a:|graph| <urn:dydra:all>
178
                                                 (spocq.a:|bgp|
179
                                                   (spocq.a:|triple| ?::aclEntry |acl|:|accessTo| ?::|target|)
180
                                                   (spocq.a:|triple| ?::aclEntry |acl|:|mode| ?::|mode|)
181
                                                   (spocq.a:|triple| ?::aclEntry |acl|:|agent| ?::|mediator|)))
182
                                               (spocq.a:|bgp|
183
                                                 (spocq.a:|triple| ?::|mediator| |prov|:|hadMember| ?::|role|))))
184
                                           (spocq.a:|bindings|
185
                                             ,(loop for role in (remove-duplicates
186
                                                                 (list agent-id class-id target-id account-id view-id repository-id))
187
                                                collect (list role))
188
                                             (?::|role|)))
189
                                         (?::|role| ?::|target| ?::|mode| ?::|mediator|))
190
                                      :repository-id system-repository-id
191
                                      :agent (system-agent)
192
                                      :dynamic-bindings `((?::|target| ?::|mode|) ,target-id ,action))
193
                 #+(or)
194
                 (run-sparql-internal (compute-context-query)
195
                             :repository-id system-repository-id
196
                             :agent (system-agent)
197
                             :dynamic-bindings `((?::|target| ?::|mode|) ,target-id ,action))
198
                 #+(or) ; 20200710 eliminated explicit account context when changed to search all contexts
199
                 (when (and account-id (not (eq account-id target-id)))
200
                   (run-sparql-internal (compute-context-query account-id)
201
                               :repository-id system-repository-id
202
                               :agent (system-agent)
203
                               :dynamic-bindings `((?::|target| ?::|mode|) ,target-id ,action)))
204
                 #+(or) ; 20200710 eliminated explicit repository context when changed to search all contexts
205
                 (when (and repository-id (not (eq repository-id target-id)))
206
                   (run-sparql-internal (compute-context-query repository-id)
207
                               :repository-id system-repository-id
208
                               :agent (system-agent)
209
                               :dynamic-bindings `((?::|target| ?::|mode|) ,target-id ,action))))))))
210
   (:method ((repository string) (agent t) (target authorized-resource) (action t) &rest args)
211
     (declare (dynamic-extent args))
212
     (apply #'query-direct-capability repository agent (capability-identifier target) action args))
213
 
214
   (:method ((repository string) (agent t) (target repository) (action t) &rest args)
215
     (declare (dynamic-extent args))
216
     (apply #'query-direct-capability repository agent (capability-identifier target) action args))
217
 
218
   (:method ((repository repository) agent target action &rest args)
219
     (declare (dynamic-extent args))
220
     (apply #'query-direct-capability (repository-id repository) agent target action args))
221
 
222
   #+(or) ;; subsumed by the agent-id method
223
   (:method ((system-repository-id string) (agent identified-object) (target-id (eql t)) (action (eql t)))
224
     (query-direct-capability system-repository-id (instance-authentication-id agent) target-id action))
225
 
226
   #+(or) ;; subsumed by the agent-id method
227
   (:method ((system-repository-id string) (role t) (target-id (eql t)) (action (eql t)))
228
     "Absent a target, return everything to which the agent has access"
229
     (let* ((query `(spocq.a:|select|
230
                             (spocq.a:|extend|
231
                                      (spocq.a:|graph| |urn:dydra|:|all|
232
                                               (spocq.a:|union|
233
                                                        (spocq.a:|bgp|
234
                                                                 (spocq.a:|triple| ?::aclEntry |acl|:|accessTo| ?::|target|)
235
                                                                 (spocq.a:|triple| ?::aclEntry |acl|:|mode| ?::|mode|)
236
                                                                 (spocq.a:|triple| ?::aclEntry |acl|:|agent| ,role))
237
                                                        (spocq.a:|bgp|
238
                                                                 (spocq.a:|triple| ?::aclEntry |acl|:|accessTo| ?::|target|)
239
                                                                 (spocq.a:|triple| ?::aclEntry |acl|:|mode| ?::|mode|)
240
                                                                 (spocq.a:|triple| ?::aclEntry |acl|:|agent| ?::|mediator|)
241
                                                                 (spocq.a:|triple| ?::|mediator| |prov|:|hadMember| ,role))))
242
                                      ?::|role| ,role)
243
                             (?::|role| ?::|target| ?::|mode| ?::|mediator|))))
244
       (run-sparql-internal query :repository-id system-repository-id
245
                   :agent (system-agent)))))
246
 ;;; (run-sparql-internal "select count(*) where {?s ?p ?o}" :repository-id "james/foaf" :agent (ensure-agent))
247
 
248
 #+(or)
249
 (test-sparql "select ?role where { {bind ((?x) as ?role)} union  {bind ((?y) as ?role)} }"
250
              :repository-id "james/system"
251
              :dynamic-bindings '((?::|x| ?::|y|) "a" "s"))
252
 
253
 ;; (trace run-sparql)
254
 ;; (query-direct-capability "nxp/system" <http://dydra.com/nxp/plm> <http://dydra.com/users/tibco> |acl|:|Read|)
255
 ;; (query-direct-capability "nxp/system" <http://dydra.com/nxp/plm> <http://dydra.com/users/tibco> |acl|:|Write|)
256
 ;; (query-direct-capability "nxp/system" <http://dydra.com/nxp/plm> <http://dydra.com/users/tibco> |acl|:|Control|)
257
 ;; (query-direct-capability "nxp/system" t (ensure-agent :name "tibco") t)
258
 
259
 ;;; (access-authorized-p (repository "test/unesco-thesaurus") (user "jhacker") |acl|:|Read|)
260
 ;;; (REPOSITORY-PATTERN-COUNT  (repository "test/unesco-thesaurus") '?::|mediator| |http://www.w3.org/ns/prov#|:|hadMember| <http://dydra.com/users/jhacker> |urn:dydra|:|all|)
261
 ;;; (REPOSITORY-PATTERN-COUNT  (repository "test/unesco-thesaurus") '?::|mediator| |http://www.w3.org/ns/prov#|:|hadMember| <http://dydra.com/users/jhacker> nil)
262
 
263
 
264
 (defgeneric query-inferred-capability (system-repository target agent action &key account class repository view)
265
   (:method ((system-repository-id string) (agent identified-object) (target t) (action t) &rest args
266
             &key (account (agent-account agent))
267
             (class (capability-class agent))
268
             &allow-other-keys)
269
     (declare (dynamic-extent args))
270
     (apply #'query-inferred-capability system-repository-id (capability-identifier agent) target action
271
            :account account
272
            :class class
273
            args))
274
 
275
   (:method ((system-repository-id string) (agent-id t) (target t) (action t) 
276
             &key (account (when *task* (task-account *task*))) (class nil)
277
             (repository (when *task* (task-repository *task*)))
278
             (view (when *task* (task-request-location *task*))))
279
     "Extract the inferred access permission for a given object - agent, account, repository, etc.
280
      If the instance has no identity (eg and anonymous agent), use the site uri.
281
      When action is provided, constraint the query to just that.
282
      Otherwise return all asserted modes"
283
     (let* ((class-id (capability-identifier class))
284
            (target-id (capability-identifier target))
285
            (account-id (capability-identifier account))
286
            (view-id (capability-identifier view))
287
            (repository-id (capability-identifier repository))
288
            (auth-view (and *inferred-capability-view-name*
289
                            (repository-view system-repository-id *inferred-capability-view-name*)))
290
            (member-path (make-bounded-property-path :element (make-property-path-verb :iri |prov|:|hadMember|) :min 0 :max nil)))
291
      (if auth-view
292
          (run-sparql-internal auth-view :repository-id system-repository-id
293
                       :agent (system-agent)
294
                       :dynamic-bindings `((?::|agent| ?::|agentClass| ?::|target| ?::|context| ?::|account| ?::|view| ?::|repository|
295
                                               ?::|mode|)
296
                                           ,agent-id ,class-id ,target-id ,target-id
297
                                           ,account-id ,view-id ,repository-id
298
                                           ,action))
299
           (let* (#+(or)(role-unions
300
                   (loop for role in (remove-duplicates (list agent-id class-id target-id account-id view-id repository-id))
301
                     when role
302
                     collect `(spocq.a:|extend|
303
                                       (spocq.a:|join|
304
                                                (spocq.a:|graph| ,target-id 
305
                                                         (spocq.a:|bgp|
306
                                                                  (spocq.a:|triple| ?::aclEntry |acl|:|accessTo| ?::container)
307
                                                                  (spocq.a:|triple| ?::aclEntry |acl|:|mode| ?::mode)
308
                                                                  (spocq.a:|triple| ?::aclEntry |acl|:|agent| ?::mediator)))
309
                                                (spocq.a:|join|
310
                                                         (spocq.a:|bgp|
311
                                                                  (spocq.a:|triple| ?::mediator ,member-path ,role))
312
                                                         (spocq.a:|bgp|
313
                                                                  (spocq.a:|triple| ?::container ,member-path ?::|target|))))
314
                                       ?::|role| ,role)))
315
                  #+(or)(compound-role-unions (loop for role-union in role-unions
316
                                          for unions = role-union then `(spocq.a:|union| ,unions ,role-union)
317
                                          finally (return unions)))
318
                  (query `(spocq.a:|select|
319
                            (spocq.a:|join|
320
                              (spocq.a:|join|
321
                                (spocq.a:|graph| ,target-id 
322
                                  (spocq.a:|bgp|
323
                                    (spocq.a:|triple| ?::aclEntry |acl|:|accessTo| ?::container)
324
                                    (spocq.a:|triple| ?::aclEntry |acl|:|mode| ?::mode)
325
                                    (spocq.a:|triple| ?::aclEntry |acl|:|agent| ?::mediator)))
326
                                (spocq.a:|join|
327
                                  (spocq.a:|bgp|
328
                                    (spocq.a:|triple| ?::mediator ,member-path ?::|role|))
329
                                  (spocq.a:|bgp|
330
                                    (spocq.a:|triple| ?::container ,member-path ?::|target|))))
331
                              (spocq.a:|bindings|
332
                                ,(loop for role in (remove-duplicates
333
                                                    (list agent-id class-id target-id account-id view-id repository-id))
334
                                   collect (list role))
335
                                (?::|role|)))
336
                            (?::|role| ?::|target| ?::|mode| ?::|mediator| ?::|container|))))
337
             (first (run-sparql-internal query :repository-id system-repository-id
338
                                :agent (system-agent)
339
                                :dynamic-bindings `((?::|target| ?::|mode|) ,target-id ,action)))))))
340
            
341
   (:method ((repository string) (target authorized-resource) (agent t) (action t) &rest args)
342
     (declare (dynamic-extent args))
343
     (apply #'query-inferred-capability repository (instance-identifier target) agent action args))
344
 
345
   (:method ((repository string) (target repository) (agent t) (action t) &rest args)
346
     (declare (dynamic-extent args))
347
     (apply #'query-inferred-capability repository (instance-identifier target) agent action args))
348
 
349
   (:method ((repository repository) target agent action &rest args)
350
     (declare (dynamic-extent args))
351
     (apply #'query-inferred-capability (repository-id repository) target agent action args))
352
 
353
   #+(or)
354
   (:method ((system-repository-id string) (target-id (eql t)) (role t) (action (eql t)))
355
     "Absent a target, return everything to which the agent has access"
356
     (let* ((query `(spocq.a:|select|
357
                             (spocq.a:|extend|
358
                                      (spocq.a:|join|
359
                                               (spocq.a:|graph| |urn:dydra|:|all|
360
                                                        (spocq.a:|bgp|
361
                                                                 (spocq.a:|triple| ?::aclEntry |acl|:|accessTo| ?::container)
362
                                                                 (spocq.a:|triple| ?::aclEntry |acl|:|mode| ?::mode)
363
                                                                 (spocq.a:|triple| ?::aclEntry |acl|:|agent| ?::mediator)))
364
                                               (spocq.a:|join|
365
                                                        (spocq.a:|bgp|
366
                                                                 (spocq.a:|triple| ?::mediator
367
                                                                          ,(make-bounded-property-path :element |prov|:|hadMember| :min 0 :max nil)
368
                                                                          ,role))
369
                                                        (spocq.a:|bgp|
370
                                                                  (spocq.a:|triple| ?::container
371
                                                                           ,(make-bounded-property-path :element |prov|:|hadMember| :min 0 :max nil)
372
                                                                           ,target-id))))
373
                                      ?::|role| ,role)
374
                             (?::|role| ?::|target| ?::|mode| ?::|mediator|))))
375
       (run-sparql-internal query :repository-id system-repository-id
376
                   :agent (system-agent)))))
377