Coverage report: /development/source/library/org/datagraph/spocq-shard/src/store/account.lisp

KindCoveredAll%
expression26392 6.6
branch114 7.1
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 "accounts"
6
   "management functions for user accounts")
7
 
8
 ;;; (load #p"LIBRARY:org;datagraph;spocq;src;core;package.lisp")
9
 ;;; (load #p"LIBRARY:org;datagraph;spocq;src;store;account.lisp")
10
 
11
 ;;;
12
 ;;; account initialization
13
 
14
 (defgeneric initialize-account-metadata (account &key email)
15
   (:documentation "Ensure that minimal account metadata are present in the store.
16
     Clear the respective graph; generate the minimal statements and insert them.")
17
 
18
   (:method ((account account) &key email)
19
     (flet ((filter-field (field)
20
              (loop for stmt in field
21
                    if (member nil stmt)
22
                    do (log-warn "initialize-account-metadata: incomplete statement: ~s" stmt)
23
                    else collect stmt)))
24
       (let ((account-repository-name (compute-repository-id (account-name account) *system-repository-name*))
25
             (account-uri (account-identifier account))
26
             (account-name (account-name account)))
27
         (destructuring-bind (&key ((:system system-data) nil) ((:account account-data) nil))
28
                             (compute-initial-account-metadata account)
29
           (with-open-transaction (account-repository-name :normal-disposition :commit :read-only-p nil)
30
             (let* ((existing-field (repository-match-field *transaction* account-uri account-uri '?::p '?::o))
31
                    (encrypted-password (cond ((fourth (find |urn:dydra|:|encryptedPassword| existing-field :key #'third)))
32
                                              (t
33
                                               (log-notice "initialize-account-metadata: initial null password: ~a" account)
34
                                               "")))
35
                    (authentication-token (cond ((fourth (find |urn:dydra|:|accessToken| existing-field :key #'third)))
36
                                                (t
37
                                                 (log-notice "initialize-account-metadata: initial generated token: ~a" account)
38
                                                 (make-sha1-digest (iso-time))))))
39
               (repository-clear-graph *transaction* account-uri :if-does-not-exist nil)
40
               (repository-insert-field *transaction*
41
                                        (filter-field (append (when encrypted-password
42
                                                                `((spocq.a:|quad| ,account-uri |urn:dydra|:|encryptedPassword| ,encrypted-password ,account-uri)))
43
                                                              (when authentication-token
44
                                                                `((spocq.a:|quad| ,account-uri |urn:dydra|:|accessToken| ,authentication-token ,account-uri)))
45
                                                              account-data)))
46
               (let* ((sql-account (make-sql-account :name account-name
47
                                                     :encrypted-password encrypted-password
48
                                                     :authentication-token authentication-token
49
                                                     :email (or email ""))))
50
                 (write-sql-account sql-account)
51
                 (log-notice "initialize-account-metadata: mysql initialized: ~a ~a" account (agent)))))
52
           (with-open-transaction (*system-repository-id* :normal-disposition :commit :read-only-p nil)
53
             (repository-clear-graph *transaction* account-uri :if-does-not-exist nil)
54
             (repository-insert-field *transaction* (filter-field system-data))))))))
55
 
56
 
57
 (defmethod create-account ((account rdfcache-account) &key (if-exists :error) email)
58
   "provision it in the store - first the account and then its metadata repository.
59
    then, in a second phase initialize the metadata repository with the minimal authorization specification."
60
   (let ((name (account-name account)))
61
     (cond ((account-exists-p name)
62
            (ecase if-exists
63
              (:error (error "account exists: ~s." name))
64
              ((nil) nil)))
65
           (t
66
            (cli-create-account name)
67
            (let* ((repository-id (instance-repository-id account))
68
                   (repository (repository repository-id)))
69
              (initialize-repository-storage (repository-id repository) repository)
70
              (initialize-account-metadata account :email email)
71
              (initialize-repository-metadata repository)
72
              account)))))
73
 
74
 (defgeneric cli-create-account (account)
75
   (:method ((name string))
76
     (let ((process (run-program (admin-executable-pathname) (list "create-account" name) :wait t)))
77
       (if process
78
           (run-program-close process)
79
           (error "Failed to create account: ~s." name))
80
       t))
81
   (:method ((account account))
82
     (cli-create-account (account-name account))))
83
 
84
 
85
 
86
 (defun compute-account-metadata-uri (account-name &rest path)
87
   (intern-iri (format nil "http://~a/accounts/~a~{/~a~}" (site-name) account-name path)))
88
 ;;; (compute-account-metadata-uri "jhacker" "foaf" "configuration")
89
 
90
 (defun compute-initial-account-authorization-graph (account-name)
91
     (let* ((owner-uri (compute-user-identifier account-name))
92
            (metadata-access-node (cons-global-blank-node :prefix "acl"))
93
            (account-uri (compute-account-identifier account-name))
94
            (sesame-uri (intern-iri (format nil "http://~a/~a" (site-name) account-name)))
95
            (repository-access-node (cons-global-blank-node :prefix "acl"))
96
            (repository-uri (compute-repository-identifier account-name *system-repository-name*))
97
            (graphstore-repository-uri (intern-iri (format nil "http://~a/~a/~a" (site-name) account-name *system-repository-name*)))
98
            (metadata-repository-uri (intern-iri (format nil "http://~a/accounts/~a/repositories/~a" (site-name) account-name *system-repository-name*)))
99
            (sesame-repository-uri (intern-iri (format nil "http://~a/~a/repositories/~a" (site-name) account-name *system-repository-name*))))
100
       `(;; access control for the account itself - covers the individual auth, config, and profile
101
         (spocq.a:|quad| ,metadata-access-node |acl|:|accessTo| ,account-uri ,account-uri)
102
         (spocq.a:|quad| ,metadata-access-node |acl|:|accessTo| ,sesame-uri ,account-uri)
103
         (spocq.a:|quad| ,metadata-access-node |acl|:|mode| |acl|:|Read| ,account-uri)
104
         (spocq.a:|quad| ,metadata-access-node |acl|:|mode| |acl|:|Write| ,account-uri)
105
         (spocq.a:|quad| ,metadata-access-node |acl|:|mode| |acl|:|Control| ,account-uri)
106
         (spocq.a:|quad| ,metadata-access-node |acl|:|mode| |acl|:|Execute| ,account-uri)  ;; auth transfer
107
         (spocq.a:|quad| ,metadata-access-node |acl|:|agent| ,owner-uri ,account-uri)
108
         ;; acl for the account metadata repository -- w/o control access
109
         (spocq.a:|quad| ,repository-access-node |acl|:|accessTo| ,repository-uri ,repository-uri)
110
         (spocq.a:|quad| ,repository-access-node |acl|:|accessTo| ,graphstore-repository-uri ,repository-uri)
111
         (spocq.a:|quad| ,repository-access-node |acl|:|accessTo| ,metadata-repository-uri ,repository-uri)
112
         (spocq.a:|quad| ,repository-access-node |acl|:|accessTo| ,sesame-repository-uri ,repository-uri)
113
         (spocq.a:|quad| ,repository-access-node |acl|:|mode| |acl|:|Read| ,account-uri)
114
         (spocq.a:|quad| ,repository-access-node |acl|:|mode| |acl|:|Write| ,account-uri)
115
         (spocq.a:|quad| ,repository-access-node |acl|:|agent| ,owner-uri ,account-uri))))
116
 
117
 (defgeneric compute-initial-account-metadata (account)
118
   (:method ((account account))
119
     (let* ((account-uri (account-identifier account))
120
            (name (account-name account))
121
            (owner-uri (compute-user-identifier (account-name account))))
122
     `(:system
123
       ;; identifying information for the account and for the user
124
       ;; place it in the 'account' graph to facilitate modifications
125
       ((spocq.a:|quad| ,account-uri |rdf|:|type| |urn:dydra|:|Account| ,account-uri)
126
        (spocq.a:|quad| ,account-uri |foaf|:|accountName| ,name ,account-uri)
127
        (spocq.a:|quad| ,account-uri |dc|:|title| ,name ,account-uri)
128
        (spocq.a:|quad| ,account-uri |sioc|:|has_owner| ,owner-uri ,account-uri)
129
        (spocq.a:|quad| ,account-uri |acl|:|owner| ,owner-uri ,account-uri)
130
        (spocq.a:|quad| ,account-uri |sioc|:|account_of| ,owner-uri ,account-uri)
131
        ;; owner assertions are placed in the <urn:dydra:users> graph
132
        (spocq.a:|quad| ,owner-uri |rdf|:|type| |urn:dydra|:|User| |urn:dydra|:|users|)
133
        (spocq.a:|quad| ,owner-uri |sioc|:|id| ,owner-uri |urn:dydra|:|users|))
134
       :account
135
       ;; the initial account configuration includes just the base iri
136
       ((spocq.a:|quad| ,account-uri |urn:dydra|:|baseIRI| ,account-uri ,account-uri)
137
        ;; plus the minimal authorization, which gives the owner access
138
        ,@(compute-initial-resource-authorization-graph account))))))
139
 
140
 
141
 (defmethod account-catalog-pathname ((account account))
142
   (account-catalog-pathname (account-name account)))
143
 
144
 (defmethod account-catalog-pathname ((account-name string))
145
   (merge-pathnames (make-pathname :directory `(:relative "accounts" ,account-name))
146
                    *metadata-root-pathname*))
147
 
148
 (defmethod account-uuid ((account account))
149
   (let* ((catalog-pathname (account-catalog-pathname account)))
150
     (when (probe-file catalog-pathname)
151
       (sb-posix:readlink catalog-pathname))))
152
 
153
 (defgeneric account-exists-p (repository)
154
   (:documentation "Given an account or its id, test wheter it exists.
155
     Test by probing for the matadata directory pathname.")
156
   (:method ((account-name string))
157
     (probe-file (account-catalog-pathname account-name)))
158
   (:method ((account account))
159
     (account-exists-p (account-name account))))
160
 
161
 #|
162
 (sb-profile:profile probe-file merge-pathnames make-pathname )
163
 ; as pathname probe (time (dotimes (x 1000) (account-exists-p "jhacker"))) = 0.025 s
164
   seconds  |     gc     |   consed  | calls |  sec/call  |  name  
165
 -------------------------------------------------------
166
      0.018 |      0.000 | 2,450,384 | 1,000 |   0.000018 | PROBE-FILE
167
      0.001 |      0.000 |         0 | 1,000 |   0.000001 | MAKE-PATHNAME
168
     0.0003 |      0.000 |   425,984 | 2,000 |  0.0000001 | MERGE-PATHNAMES
169
 -------------------------------------------------------
170
      0.019 |      0.000 | 2,876,368 | 4,000 |            | Total
171
 |#
172
 
173
 #+(or)
174
 (defgeneric account-exists-p (repository)
175
   (:documentation "Given an account or its id, test whether it exists.
176
     Test by checking whether an authentication list exists.
177
     The initial metadata test will require the acl list to be loaded,
178
     but subsequent tests should reduce to checking that the cached acl is current.")
179
 
180
   (:method ((account-id string))
181
     (account-exists-p (account account-id)))
182
 
183
   (:method ((account account))
184
     (not (null (authorization-list-controls (resource-authorization-list account))))))
185
 
186
 #|
187
 (sb-profile:profile resource-store-repository-id authorization-list-controls
188
                     resource-authorization-list synchronize-resource resource-synchronized-p
189
                     resource-store-revision resolve-repository-revision-id
190
                     resource-clean-p instance-repository-id
191
                     make-resource-authorization-list
192
                     read-resource
193
                     setf-resource-authorization-list)
194
 ; as store probe (time (let ((account (account "jhacker"))) (dotimes (x 1000) (account-exists-p account)))) = 0.056 s
195
   seconds  |     gc     |   consed  | calls |  sec/call  |  name  
196
 -------------------------------------------------------
197
      0.025 |      0.000 | 229,024 |  1,000 |   0.000025 | RESOLVE-REPOSITORY-REVISION-ID
198
      0.004 |      0.000 |       0 |  2,000 |   0.000002 | INSTANCE-REPOSITORY-ID
199
      0.003 |      0.000 |       0 |  1,000 |   0.000003 | RESOURCE-SYNCHRONIZED-P
200
      0.001 |      0.000 |       0 |  1,000 |   0.000001 | AUTHORIZATION-LIST-CONTROLS
201
      0.000 |      0.000 |       0 |  1,000 |   0.000000 | RESOURCE-CLEAN-P
202
      0.000 |      0.000 |       0 |  1,000 |   0.000000 | RESOURCE-STORE-REVISION
203
      0.000 |      0.000 |       0 |  1,000 |   0.000000 | SYNCHRONIZE-RESOURCE
204
      0.000 |      0.000 |       0 |  1,000 |   0.000000 | RESOURCE-AUTHORIZATION-LIST
205
      0.000 |      0.000 |       0 |  1,000 |   0.000000 | RESOURCE-STORE-REPOSITORY-ID
206
      0.000 |      0.000 |       0 |  1,000 |   0.000000 | ACCOUNT-EXISTS-P
207
 ------------------------------------------------------
208
      0.032 |      0.000 | 229,024 | 11,000 |            | Total
209
 
210
 whereby, evidently half the time is system time.
211
 
212
 |#
213
 
214
 
215
 
216
 (defmethod read-instance-metadata-statements ((account account))
217
   "Given an account, use the respective account-identifier and account-repository-name to
218
  retrieve the pertinent quads from the account-specific and the system-global repositories."
219
   (let* ((account-identifier (account-identifier account))
220
          (system-repository-id *system-repository-id*)
221
          (account-repository-id (instance-repository-id account)))
222
     (flet ((match-field (context subject predicate object)
223
              (let ((field (repository-matrix-field *transaction* context subject predicate object)))
224
                (prog1 (term-value-field field)
225
                  (release-field-data field)))))
226
       (append (with-open-transaction (system-repository-id)
227
                 (append (match-field |urn:dydra|:|default| account-identifier '?::p '?::o)
228
                         (match-field account-identifier '?::s '?::p '?::o)))
229
               (with-open-transaction (account-repository-id :if-does-not-exist :create)
230
                 (append (match-field |urn:dydra|:|default| '?::s '?::p '?::o)
231
                         (match-field account-identifier '?::s '?::p '?::o)))))))
232
 
233
 ;;; (pprint-sse (read-instance-metadata (account "james")))
234
 
235
 
236
 (defun account-names ()
237
   (let* ((results (run-sparql-internal `(spocq.a:|distinct| (spocq.a:|select|
238
                                  (spocq.a:|join|
239
                                    (spocq.a:|graph| |urn:dydra|:|accounts|
240
                                      (spocq.a:|bgp| (spocq.a:|triple| ?::accountIdentifier |rdf|:|type| |urn:dydra|:|Account|)))
241
                                    (spocq.a:|graph| ?::accountIdentifier
242
                                      (spocq.a:|bgp|
243
                                        (spocq.a:|triple| ?::accountIdentifier |dc|:|title| ?::title))))
244
                                   (?::title)))
245
                               :agent (system-agent)
246
                               :repository-id *system-repository-id*)))
247
       (when (consp results)
248
         (mapcar #'first results))))
249
 
250
 (defun account-and-repository-names ()
251
   (let ((cache (make-hash-table :test 'equal))
252
         (results (run-sparql-internal `(spocq.a:|select|
253
                                 (spocq.a:|graph| ?::account
254
                                   (spocq.a:|bgp|
255
                                     (spocq.a:|triple| ?::account |foaf|:|accountName| ?::accountName) ;; slig, not title
256
                                     (spocq.a:|triple| ?::repository |foaf|:|name| ?::repositoryName) ;; slig, not title
257
                                     (spocq.a:|triple| ?::repository |sioc|:|has_parent| ?::account)
258
                                     (spocq.a:|triple| ?::repository |rdf|:|type| |urn:dydra|:|Repository|)
259
                                     )
260
                                    )
261
                                   (?::accountName ?::repositoryName))
262
                                 :agent (system-agent)
263
                                 :repository-id *system-repository-id*)))
264
     (loop for (account repository) in results
265
       do (push repository (gethash account cache)))
266
     (loop for account being each hash-key in cache
267
       using (hash-value repositories)
268
       collect (cons account repositories))))
269
 ;;; (account-and-repository-names)
270
 
271
 (defgeneric account-repository-names (account)
272
   (:method ((account string))
273
     (account-repository-names (account account)))
274
   (:method ((account account))
275
     (let* ((account-identifier (account-identifier account))
276
            (results (run-sparql-internal `(spocq.a:|distinct| (spocq.a:|select|
277
                                   (spocq.a:|graph| ,account-identifier
278
                                    (spocq.a:|bgp|
279
                                     (spocq.a:|triple| ?::repository |foaf|:|name| ?::name) ;; slig, not title
280
                                     (spocq.a:|triple| ?::repository |sioc|:|has_parent| ,account-identifier)
281
                                     (spocq.a:|triple| ?::repository |rdf|:|type| |urn:dydra|:|Repository|)
282
                                     )
283
                                    )
284
                                   (?::name)))
285
                                 :agent (system-agent)
286
                                 :repository-id *system-repository-id*)))
287
       (when (consp results)
288
         (mapcar #'first results)))))
289
 
290
 ;;; (spocq.i::account-repository-names (spocq.i::account "test"))
291
 
292
 (defgeneric not-account-repository-names (account)
293
   (:method ((account account))
294
     (let* ((account-identifier (account-identifier account))
295
            (results (run-sparql-internal `(spocq.a:|select|
296
                                   (spocq.a:|graph| ,account-identifier
297
                                    (spocq.a:|bgp|
298
                                     (spocq.a:|triple| ?::repository |dc|:|title| ?::title)
299
                                     ;(spocq.a:|triple| ?::repository ?::p ?::o)
300
                                     ;(spocq.a:|triple| ?::repository |sioc|:|has_parent| ,account-identifier)
301
                                     ;(spocq.a:|triple| ?::repository |rdf|:|type| |urn:dydra|:|Repository|)
302
                                     )
303
                                    )
304
                                   (?::repository ?::p ?::o))
305
                                 :agent (system-agent)
306
                                 :repository-id *system-repository-id*)))
307
       results)))
308
 
309
 ;;; (spocq.i::not-account-repository-names (spocq.i::account "test"))
310
 ;;; (run-sparql-internal "select * where {graph <http://dydra.com/accounts/test> {?s ?p ?o}}" :agent (system-agent) :repository-id *system-repository-id*)
311
 ;;; (run-sparql-internal "select distinct ?g where {graph ?g {?s ?p ?o}}" :agent (system-agent) :repository-id *system-repository-id*)
312
 
313
 (defgeneric account-repositories (account)
314
   (:method ((account string))
315
     (account-repositories (account account)))
316
   (:method ((account account))
317
     (let ((account-name (account-name account)))
318
       (loop for repository-name in (account-repository-names account)
319
             for id = (concatenate 'string account-name "/" repository-name)
320
         for repository = (ignore-errors (repository id :name repository-name :external-name id))
321
         when repository 
322
         collect repository))))
323
 
324
 ;;; (account-repositories (account "james"))
325
 
326
 
327
 (defgeneric agent-account-names (agent)
328
   (:method ((agent-name string))
329
     (agent-account-names (make-agent :name agent-name
330
                                      :identifier (compute-user-identifier agent-name))))
331
   (:method ((agent agent))
332
     (let* ((agent-id (if (typep agent 'administrator) '?::id (agent-identifier agent)))
333
            (results (run-sparql-internal `(spocq.a:|select|
334
                                   (spocq.a:|graph| ?::graph
335
                                    (spocq.a:|bgp|
336
                                     (spocq.a:|triple| ?::account |dc|:|title| ?::title)
337
                                     (spocq.a:|triple| ?::account |sioc|:|has_owner| ,agent-id)))
338
                                   (?::title))
339
                                 :agent (system-agent)
340
                                 :repository-id *system-repository-id*)))
341
       (when (consp results)
342
         (mapcar #'first results)))))
343
 
344
 ;;; (agent-account-names "openrdf-sesame")
345
 
346
 (defun agent-accounts (agent)
347
   (loop for account-name in (agent-account-names agent)
348
         collect (account account-name)))
349
 
350
 ;;; (agent-accounts "openrdf-sesame")
351
 ;;; (agent-accounts (system-agent))