Coverage report: /development/source/library/org/datagraph/spocq-shard/src/spocq-server/admin.lisp

KindCoveredAll%
expression1331611 8.3
branch294 2.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.server.implementation; -*-
2
 ;;;  Copyright 2013 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved
3
 
4
 (in-package :org.datagraph.spocq.server.implementation)
5
 
6
 (:documentation "sparql server administration resources"
7
 
8
 "This file defines a special branch of the resource tree which comprises administration and
9
 test operations.
10
 
11
 The the principle areas are
12
 - resource curation - creation, deletion, enumeration
13
 - intrpspective resource metadata
14
 - service statistics and history
15
 
16
  ${STORE_URL}/system
17
   /accounts             : POST    : create an account
18
     /${ACCOUNT}         : GET     : retrieve resource introspection data
19
                           DELETE  : delete resource
20
       /configuration
21
       /repositories     : GET     : enumerate account repository names
22
                         : POST    : create a repository
23
       /repositories/${REPOSITORY} : GET    : retrieve resource introspection data
24
                                   : DELETE
25
       /repositories/${REPOSITORY}/service_description : SPARQL service description
26
       /repositories/${REPOSITORY}/service_history     : time-series data on query execution
27
       /repositories/${REPOSITORY}/service_statistics  : aggregate statistics on query performance
28
       /repositories/${REPOSITORY}/revisions           : time-series data on transactions
29
       /repositories/${REPOSITORY}/views         : enumerate repository view names
30
       /repositories/${REPOSITORY}/views/${VIEW} : retrieve resource introspection data  or query text
31
       /services/${HOST}/${PATH}                 : GET :  retrieve resource introspection data for a service location
32
   /history
33
     /queries            : time-series data on service query execution
34
     /transactions       : time-series data on service transactions
35
   /status               : yields a synopsis of system status
36
 ")
37
 
38
 (defparameter *root-directory-pathname* (make-pathname :directory '(:absolute "opt" "rails" "public")))
39
 (defparameter *admin-solution-limit* 100)
40
 
41
 (defun read-configuration (&optional (pathname spocq.i::*configuration-pathname*))
42
   (with-open-file (stream pathname :direction :input)
43
     (loop with (name value) = (read stream nil nil)
44
       while name
45
       collect (list name (typecase value
46
                            (cons (write-to-string value))
47
                            (pathname (namestring value))
48
                            (t value))))))
49
 
50
 (defparameter spocq.si::*administration.print-methods* nil)
51
 (defun spocq.si::trace-administration (resource request response content-type accept)
52
   (when spocq.si::*administration.print-methods*
53
     (let ((*print-pretty* nil))
54
       (print (list resource request response content-type accept))
55
       (map nil 'print (compute-applicable-methods #'spocq.si::administration
56
                                                   (list resource request response content-type accept)))
57
       (describe resource)
58
       (describe request)
59
       (map nil #'print (http:request-headers request)))))
60
 
61
 
62
 (http:def-resource-function administration (resource request response)
63
   (:documentation
64
     "Respond to requests for adminstration operations.")
65
 
66
   (:log )
67
 
68
   (:auth http:authenticate-request-password)
69
   (:auth http:authenticate-request-token)
70
   (:auth http:authenticate-request-session)
71
   (:auth http:authenticate-request-location)
72
 
73
   (:auth http:authorize-request)
74
 
75
   (:encode :default mime:text/html)
76
   (:encode mime:circos)
77
   (:encode mime:text/html)
78
   (:encode mime:text/plain)
79
   (:encode mime:application/sparql-results)
80
   (:encode mime:application/sparql-query)
81
   (:encode mime:application/json)
82
   (:encode mime:image/x-icon)
83
   (:encode (resource request response (request-type t) (response-type mime:application/sparql-query))
84
            (let ((result (call-next-method)))
85
              (when (stringp result) (write-string result (http:response-content-stream response))))
86
            nil)
87
 
88
   (:decode mime:application/json)
89
   (:decode mime:application/sparql-query)
90
   (:decode mime:application/x-www-form-urlencoded)
91
 
92
   (:around ((resource resource) request response (request-type t) (response-type t))
93
     (spocq.si::trace-administration resource request response request-type response-type)
94
     (setf (http:response-header response :Access-Control-Expose-Headers) "*")
95
     (setf (http:response-header response :Access-Control-Allow-Headers)
96
           "Accept, Accept-Asynchronous, Accept-Datetime, Asynchronous-Content-Type, Asynchronous-Location, Asynchronous-Method, Authorization, Content-Disposition, Content-Encoding, Content-Type, Etag, Graph, Introspection-Content-Type, Link, Location, Revision, X-Requested-With")
97
     (cond ((http:request-authentication request)
98
            (setf (http:response-header response :Access-Control-Allow-Origin) (or (http:request-origin request) (dydra:host-name))
99
                  (http:response-header response :Access-Control-Allow-Methods) "GET, HEAD, POST, PUT, DELETE, OPTIONS, PATCH"))
100
           ((setf (http:response-header response :Access-Control-Allow-Origin) "*"
101
                  (http:response-header response :Access-Control-Allow-Methods) (or (http:request-header request :Access-Control-Request-Methods) "*"))))
102
     (setf (http:response-header response :Access-Control-Allow-Credentials) "true")
103
     (setf (http:response-header response :Access-Control-Max-Age) "86400")
104
     (setf (http:response-header response "Client-Request-ID") (request-client-request-id request))
105
     (case *transport-security-mode*
106
       (:strict ;; the default is to require https
107
        (setf (http:response-header response :Strict-Transport-Security) "max-age=31536000"))
108
       (t ))
109
     (call-next-method))
110
 
111
   (:head ((resource resource) request response (request-type t) (response-type t))
112
     (administration-head resource request response request-type response-type))
113
 
114
   (:get ((resource |/favicon.ico|) (request t) (response t) (content-type t) (response-type t))
115
     (hunchentoot:handle-static-file (make-pathname :directory (pathname-directory *root-directory-pathname*)
116
                                                    :name "favicon" :type "ico")
117
                                     (symbol-name (type-of response-type))))
118
 
119
 
120
   (:options ((resource resource) request response (request-type t) (response-type t))
121
     (graph-store-options resource request response request-type response-type))
122
 
123
   (:get ((resource |/system/status|) request response (request-type t) (response-type t))
124
     (let ((uptime 0)
125
           (memory-total 0)
126
           (memory-free 0)
127
           (memory-available 0)
128
           (cputime-total 0)
129
           (cputime-idle 0)
130
           (load-average 0))
131
       (with-open-file (input #p"/proc/uptime" :direction :input)
132
         (setf uptime (read input)))
133
       (with-open-file (input #p"/proc/meminfo" :direction :input)
134
         (loop for line = (read-line input nil nil)
135
           until (null line)
136
           do (progn (cond ((string-equal "memavailable" line :end2 (min (length line) 12))
137
                            (setf memory-available (with-input-from-string (stream line :start 13) (read stream))))
138
                           ((string-equal "memfree" line :end2 (min (length line) 7))
139
                            (setf memory-free (with-input-from-string (stream line :start 8) (read stream))))
140
                           ((string-equal "memtotal" line :end2 (min (length line) 8))
141
                            (setf memory-total (with-input-from-string (stream line :start 9) (read stream)))))
142
                (when (and (plusp memory-free) (plusp memory-total) (plusp memory-available))
143
                  (return)))))
144
       (with-open-file (input #p"/proc/stat" :direction :input)
145
         (let ((stat-line (read-line input)))
146
           (with-input-from-string (stat-input stat-line)
147
             (read stat-input)
148
             (let* ((times (loop for time = (read stat-input nil nil)
149
                             until (null time)
150
                             collect time)))
151
               (setf cputime-total (reduce #'+ times :initial-value 0))
152
               (setf cputime-idle (fourth times))))))
153
       (with-open-file (input #p"/proc/loadavg" :direction :input)
154
         (setf load-average (read input)))
155
       (dydra:send-response-message :log
156
                                    (list '(?::|Uptime| ?::|MemTotal| ?::|MemFree| ?::|MemAvailable| ?::|CputimeTotal| ?::|CputimeFree| ?::|Loadavg|
157
                                            ?::|VersionId| ?::|VersionTimestamp|)
158
                                          (list uptime memory-total memory-free memory-available cputime-total cputime-idle load-average
159
                                                spocq.i::*build-revision* spocq.i::*build-timestamp*))
160
                                    (http:response-content-stream response)
161
                                    response-type))
162
     nil)
163
 
164
   (:get ((resource |/system/accounts|) request response (request-type t) (response-type t))
165
     (compute-get-accounts (http:request-agent request)))
166
 
167
   (:post ((resource |/system/accounts|) request response (request-type t) (response-type t))
168
     (let* ((specification (call-next-method)))
169
       (compute-post-accounts resource request response specification)))
170
 
171
   (:get ((resource |/system/accounts/:account|) request response (request-type t) (response-type mime:application/json))
172
      (if (dydra:access-authorized-p (resource-account resource) (http:request-agent request) |acl|:|Read|)
173
        (let ((model (compute-instance-model (resource-account resource) response-type)))
174
          (cl-user::format-json-compact (http:response-content-stream response) model)
175
          (fresh-line (http:response-content-stream response))
176
          nil)
177
        (http:unauthorized "Access to resource not üermittes: ~a" (resource-identifier resource))))
178
 
179
   (:get ((resource |/system/accounts/:account/authorization|) request response (request-type t) (response-type t))
180
     (let* ((resource-account (resource-account resource))
181
            (resource-repository (spocq.i::instance-repository resource-account))
182
            (agent (http:request-agent request))
183
            (role (intern-iri (or (http:request-query-argument request "role")
184
                                  (http:bad-request "A role uri is required."))))
185
            (target (let ((arg (http:request-query-argument request "target")))
186
                      (when arg (intern-iri arg))))
187
            (mode (let ((arg (http:request-query-argument request "mode")))
188
                    (if arg
189
                        (find-symbol (string-capitalize arg) "acl")
190
                        |acl|:|Read|)))
191
            (account (let ((arg (http:request-query-argument request "account")))
192
                      (when arg (intern-iri arg))))
193
            (class (let ((arg (http:request-query-argument request "class")))
194
                      (when arg (intern-iri arg))))
195
            (view (let ((arg (http:request-query-argument request "view")))
196
                      (when arg (intern-iri arg))))
197
            (repository (let ((arg (http:request-query-argument request "repository")))
198
                          (when arg (repository arg)))))
199
       (if (dydra:access-authorized-p resource-repository agent |acl|:|Read|)
200
           (let* ((solutions (spocq.i::query-direct-capability resource-repository role target mode
201
                                                              :account account
202
                                                              :class class
203
                                                              :repository repository
204
                                                              :view view))
205
                 (dimensions (when solutions
206
                               (subseq '(?::|role| ?::|target| ?::|mode| ?::|mediator|) 0 (length (first solutions))))))
207
             (dydra:send-response-message :query
208
                                          (cons dimensions
209
                                                solutions)
210
                                          (http:response-content-stream response)
211
                                          response-type)
212
             nil)
213
           (http:unauthorized "Request and subject accounts must agree."))))
214
 
215
   #+(or) ;; not supported
216
   (:post ((resource |/system/accounts/:account/authorization|) request response (request-type t) (response-type t))
217
     "Given new configuration state, rdf:nil indicates to clear the authorization, dydra:default
218
     indicates to reset it, while anything else should be a file, which is decoded into the metadata instance.
219
     Commit the new state and return no content"
220
     (let* ((account (resource-account resource))
221
            (authorization-list (dydra:resource-authorization-list account))
222
            (new-state (call-next-method)))
223
       (handler-case (progn (dydra:decode-presentation-graph authorization-list new-state)
224
                            (dydra:commit-resource authorization-list))
225
         (error (c) (http:bad-request "Invalid authorization specification: ~a~%~s" c new-state)))
226
       (http:no-content)))
227
 
228
 
229
   (:get ((resource |/system/accounts/:account/configuration|) request response)
230
         (let* ((account (resource-account resource))
231
               (configuration (spocq.i::instance-metadata account))
232
               (configuration-field (dydra:encode-presentation-graph configuration)))
233
           (dydra:make-list-solution-field :dimensions *configuration-dimensions*
234
                                      :solutions configuration-field)))
235
   #+(or)
236
   (:get ((resource |/system/accounts/:account/configuration|) request response (request-type t) (response-type t))
237
         (let ((configuration-field (dydra:configuration resource)))
238
           (dydra:make-list-solution-field :dimensions *configuration-dimensions*
239
                                           :solutions configuration-field)))
240
 
241
   (:put ((resource |/system/accounts/:account/configuration|) request response)
242
          (let ((configuration (call-next-method)))
243
            (setf (dydra::configuration resource) configuration)
244
            (dydra:commit-resource resource)
245
            (http:no-content)))
246
 
247
   (:post ((resource |/system/accounts/:account/configuration|) request response)
248
          (let ((new-configuration (call-next-method))
249
                (old-configuration (dydra:configuration resource)))
250
            (setf (dydra::configuration resource) (remove-duplicates (append new-configuration old-configuration)
251
                                                                     :test #'equalp :from-end t :key #'second))
252
            (dydra:commit-resource resource)
253
            (http:no-content)))
254
 
255
   #+(or)                                ; obsolete : abstracted to apply to all metadata resources
256
   (:decode ((resource account-metadata-resource) request response (request-type mime:application/x-www-form-urlencoded) (response-type t))
257
             (let* ((arguments (http:request-post-argument-list request))
258
                    (parsed-arguments (decode-x-www-form-urlencoded arguments))
259
                    (account-arguments (or (rest (assoc :account parsed-arguments :test #'string-equal))
260
                                           parse-arguments)))
261
               (if account-arguments
262
                 (compute-plist-field (resource-model-instance resource) account-arguments)
263
                 (http:bad-request "no account configuration was provided: ~s." arguments))))
264
 
265
   (:get ((resource |/system/accounts/:account/profile|) request response (request-type t) response-type)
266
     (report-resource-profile resource
267
                               :agent (http:request-agent request)
268
                               :output-stream (http:response-content-stream response)
269
                               :response-content-type response-type)
270
     nil)
271
   #+(or) ;; not supported
272
   (:post ((resource |/system/accounts/:account/profile|) request response)
273
          (let* ((new-profile (call-next-method)))
274
            (dydra:decode-presentation-graph resource new-profile)
275
            (dydra:commit-resource resource)
276
            (http:no-content)))
277
 
278
   (:get ((resource |/system/accounts/:account/repositories|) request response)
279
     (compute-get-accounts-repositories (resource-account resource) (http:request-agent request)))
280
 
281
   (:post ((resource |/system/accounts/:account/repositories|) request response)
282
     ;; (print "create a repository")
283
     (let* ((specification (call-next-method)))
284
       (compute-post-accounts-repositories resource request response specification)))
285
 
286
   (:delete ((resource |/system/accounts/:account/repositories/:repository|) request response request-type response-type)
287
     ;; (print "delete a repository")
288
     (let* ((specification (call-next-method)))
289
       (compute-delete-accounts-repositories resource request response specification)))
290
 
291
   (:get ((resource |/system/accounts/:account/repositories/:repository|) request response (request-type t) (response-type mime:application/json))
292
      (if (dydra:access-authorized-p (resource-repository resource) (http:request-agent request) |acl|:|Read|)
293
        (let* ((predicates (split-string (http:request-query-argument request "predicates") ","))
294
               (views (split-string (http:request-query-argument request "views") ","))
295
               (model (compute-instance-model (resource-repository resource) response-type :predicates predicates :views views)))
296
          (cl-user::format-json-compact (http:response-content-stream response) model)
297
          (fresh-line (http:response-content-stream response))
298
          nil)
299
        (http:unauthorized "Access to resource not permitted: ~a" (resource-identifier resource))))
300
 
301
   (:get ((resource |/system/accounts/:account/repositories/:repository|) request response (request-type t) (response-type mime:image/vnd.dydra.sparql-results+circos+svg+xml))
302
      "compute the repository instance model and transform it into a graph which represents the relationships
303
       - repository - view
304
       - repository - pattern
305
       - view - pattern
306
       return this as a solution field to be encoded as a circos diagram"
307
      (if (dydra:access-authorized-p (resource-repository resource) (http:request-agent request) |acl|:|Read|)
308
        (let* ((*repository* (resource-repository resource))
309
               (predicates (split-string (http:request-query-argument request "predicates") ","))
310
               (views (loop for view-name in (split-string (http:request-query-argument request "views") ",")
311
                        collect (spocq.i::repository-view-definition *repository* view-name)))
312
               (result (compute-instance-model *repository* response-type :predicates predicates :views views)))
313
          (when result
314
            (dydra:send-response-message :query
315
                                         result
316
                                         (http:response-content-stream response)
317
                                         response-type))
318
          nil)))
319
 
320
   (:get ((resource |/system/accounts/:account/services/:host/:path*|) request response (request-type t) (response-type mime:image/vnd.dydra.sparql-results+circos+svg+xml))
321
     "generate a response for a remote service location simular to that for a local repository."
322
     (if (dydra:access-authorized-p (resource-repository resource) (http:request-agent request) |acl|:|Read|)
323
        (let* ((*repository* (resource-repository resource))
324
               (result (compute-instance-model *repository* response-type)))
325
          (when result
326
            (dydra:send-response-message :query
327
                                         result
328
                                         (http:response-content-stream response)
329
                                         response-type))
330
          nil)))
331
 #|
332
 explore a repository's content - whether local or remote
333
 1. display the predicates
334
 2. display the graph patterns and the linked patterns
335
 3. allow selection in the predicate list
336
    a. display a small number of respective values?
337
 4. selection modifies a mutable list
338
 5. for the content of the list, determine the respective patterns
339
 6. use the linked patterns to combine the graph patterns into a query
340
 7. allow a pop-up with media types
341
 8. request the query to the mediating repoository or direct to the respective service location?
342
 
343
 9. allow result documents in place of the (4) selection: extract the attributes, match with predicates and proceed as with (6)
344
 |#
345
 
346
   #+(or)
347
   ;; this resource cannot be used to handle configuration updates as it is
348
   ;; reserved for sesame query operations
349
   (:post ((resource |/system/accounts/:account/repositories/:repository|) request response (request-type mime:application/x-www-form-urlencoded) (response-type t))
350
         (let* ((new-state (call-next-method)))
351
            (dydra:decode-presentation-graph resource new-state)
352
            (dydra:decode-presentation-graph (dydra:instance-metadata (resource-repository resource)) new-state)
353
            (dydra:commit-resource resource)
354
            (dydra:commit-resource (dydra:instance-metadata (resource-repository resource)))
355
            (http:no-content)))
356
 
357
   (:get ((resource |/system/accounts/:account/repositories/:repository/authorization|) request response (request-type t) (response-type t))
358
     (let* ((repository (resource-repository resource))
359
            (authorization (dydra:resource-authorization-list repository)))
360
       (dydra:read-resource authorization)
361
       (dydra:send-response-message :query
362
                                   (cons (dydra:construct-dimensions)
363
                                         (dydra:encode-presentation-graph authorization))
364
                                   (http:response-content-stream response)
365
                                   response-type))
366
     nil)
367
 
368
   (:get ((resource |/system/accounts/:account/repositories/:repository/service_description|) request response (request-type t) (response-type mime:rdf))
369
         (dydra:send-response-message :query
370
                                      (cons (dydra:construct-dimensions)
371
                                            (spocq.i::repository-service-description (resource-repository resource)))
372
                                      (http:response-content-stream response)
373
                                      response-type)
374
         nil)
375
 
376
   ;; repository-specific service performance data either as time-series or aggregated
377
   (:get ((resource |/system/accounts/:account/repositories/:repository/service_history|) request response (request-type t) (response-type mime:sparql-results))
378
         "Generate a time-series document to communicate the query performance over an interval"
379
         (let ((solution-field (compute-repository-query-event-timeseries (resource-repository resource) request)))
380
           (setf (http:response-content-disposition response) '("inline" "filename" "service_history.sr"))
381
           (setf (http:response-cache-control response) "private")
382
           (dydra:send-response-message :log solution-field (http:response-content-stream response) response-type)
383
           nil))
384
   (:get ((resource |/system/accounts/:account/repositories/:repository/service_history|) request response (request-type t) (response-type mime:application/json))
385
         "Generate a time-series document to communicate the query performance over an interval"
386
         (let ((solution-field (compute-repository-query-event-timeseries (resource-repository resource) request)))
387
           (setf (http:response-content-disposition response) '("inline" "filename" "service_history.sr"))
388
           (setf (http:response-cache-control response) "private")
389
           (dydra:send-response-message :log solution-field (http:response-content-stream response) response-type)
390
           nil))
391
 
392
   (:get ((resource |/system/accounts/:account/repositories/:repository/service_statistics|) request response (request-type t) (response-type mime:sparql-results))
393
         "Generate an aggregate of the query performance over an interval"
394
         (let ((solution-field (compute-repository-query-event-statistics (resource-repository resource) request)))
395
           (setf (http:response-content-disposition response) '("inline" "filename" "service_statistics.sr"))
396
           (setf (http:response-cache-control response) "private")
397
           (dydra:send-response-message :log solution-field (http:response-content-stream response) response-type)
398
           nil))
399
   (:get ((resource |/system/accounts/:account/repositories/:repository/service_statistics|) request response (request-type t) (response-type mime:application/json))
400
         "Generate an aggregate of the query performance over an interval"
401
         (let ((solution-field (compute-repository-query-event-statistics (resource-repository resource) request)))
402
           (setf (http:response-content-disposition response) '("inline" "filename" "service_statistics.sr"))
403
           (setf (http:response-cache-control response) "private")
404
           (dydra:send-response-message :log solution-field (http:response-content-stream response) response-type)
405
           nil))
406
 
407
   (:get ((resource |/system/accounts/:account/repositories/:repository/revisions|) request response (request-type t) (response-type mime:text/plain))
408
         (let ((revisions (spocq.i::repository-list-revision-ids  (resource-repository resource))))
409
           (format (http:response-content-stream response) "~{~a~%~}" revisions))
410
         nil)
411
 
412
   (:get ((resource |/system/accounts/:account/repositories/:repository/revisions|) request response (request-type t) (response-type mime:application/sparql-results))
413
         (let ((revisions (spocq.i::repository-list-revision-ids  (resource-repository resource))))
414
           (spocq.i::make-list-solution-field
415
            :dimensions '(?::|revision-id|)
416
            :solutions (mapcar #'list revisions))))
417
 
418
   #+(or) ;; not supported; reimplement as an update on the account's system repository
419
   (:post ((resource |/system/accounts/:account/repositories/:repository/authorization|) request response)
420
     "Given new configuration state, rdf:nil indicates to clear the authorization, dydra:default
421
     indicates to reset it, while anything else should be a file, which is decoded into the metadata instance.
422
     Commit the new state and return no content"
423
     (let* ((repository (resource-repository resource))
424
            (authorization-list (dydra:resource-authorization-list repository))
425
            (new-state (call-next-method)))
426
       (handler-case (progn (dydra:decode-presentation-graph authorization-list new-state)
427
                            (dydra:commit-resource authorization-list))
428
         (error (c) (http:bad-request "Invalid authorization specification: ~a~%~s" c new-state)))
429
       (http:no-content)))
430
 
431
 
432
   (:get ((resource |/system/accounts/:account/repositories/:repository/configuration|) request response)
433
         (let* ((repository (resource-repository resource))
434
               (configuration (spocq.i::instance-metadata repository))
435
               (configuration-field (dydra:encode-presentation-graph configuration)))
436
           (dydra:make-list-solution-field :dimensions *configuration-dimensions*
437
                                      :solutions configuration-field)))
438
 
439
   (:get ((resource |/system/accounts/:account/repositories/:repository/configuration/:property|) request response)
440
         (let* ((repository (resource-repository resource))
441
                (configuration (spocq.i::instance-metadata repository))
442
                (configuration-field (dydra:encode-presentation-graph configuration))
443
                (request-property (configuration-resource-property resource)))
444
           (flet ((request-property-p (content-property)
445
                    (string-equal request-property (spocq.i::field-property-keyword content-property))))
446
             (declare (dynamic-extent #'request-property-p))
447
             (let ((property-field (remove-if-not #'request-property-p configuration-field :key #'second)))
448
               (dydra:make-list-solution-field :dimensions *configuration-dimensions*
449
                                               :solutions property-field)))))
450
 
451
   (:get ((resource |/system/accounts/:account/repositories/:repository/profile|) request response (request-type t) response-type)
452
      (report-resource-profile resource
453
                               :agent (http:request-agent request)
454
                               :output-stream (http:response-content-stream response)
455
                               :response-content-type response-type)
456
      nil)
457
 
458
   (:get ((resource |/system/accounts/:account/repositories/:repository/views|) request response (request-type t) response-type) ;; rdf?
459
     "Return a list of the view definitions associated with this repository"
460
     (let ((views (spocq.i::repository-view-definitions (resource-repository resource))))
461
       (spocq.i::make-list-solution-field
462
        :dimensions '(?::name ?::description ?::url ?::query ?::uuid ?::site-url ?::identifier)
463
        :solutions (loop for view in views
464
                     collect (list (spocq.i::view-name view)
465
                                   (spocq.i::view-summary view)
466
                                   (spocq.i::resource-uri view)
467
                                   (spocq.i::view-query view)
468
                                   (spocq.i::view-uuid view)
469
                                   (spocq.i::view-identifier view)
470
                                   (spocq.i::view-admin-uri view))))))
471
 
472
   (:get ((resource |/system/accounts/:account/repositories/:repository/views|) request response (request-type t) (response-type mime:text/plain))
473
     "Return a list of the view definitions associated with this repository"
474
     (let ((views (spocq.i::repository-view-definitions (resource-repository resource))))
475
       (loop for view in views
476
         with stream = (http:response-content-stream response)
477
         do (format stream "~a~%" (spocq.i::view-name view))))
478
     nil)
479
 
480
   (:get ((resource |/system/accounts/:account/repositories/:repository/views/:view|) request response (request-type t) response-type)
481
     "Return the view definition. This includes the name, the uuid, the site and the resource urls, and the query text.
482
      The admin url is not necessary, as it is this location."
483
     (let ((view (spocq.i::repository-view-definition (resource-repository resource) (resource-view resource))))
484
       (if view
485
           (spocq.i::make-list-solution-field
486
            :dimensions '(?::name ?::description ?::url ?::query ?::uuid ?::site-url)
487
            :solutions (list (list (spocq.i::view-name view)
488
                                   (spocq.i::view-summary view)
489
                                   (spocq.i::resource-uri view)
490
                                   (spocq.i::view-query view)
491
                                   (spocq.i::view-uuid view)
492
                                   (spocq.i::view-identifier view))))
493
           ;; just, in case
494
           (http:not-found))))
495
 
496
   (:get ((resource |/system/accounts/:account/repositories/:repository/views/:view|) request response (request-type t) (response-type mime:application/sparql-query))
497
     "Return the view query text only."
498
     (let ((view (spocq.i::repository-view-definition (resource-repository resource) (resource-view resource))))
499
       (cond (view
500
              (write-string (spocq.i::view-query view) (http:response-content-stream response))
501
              (terpri (http:response-content-stream response))
502
              nil)
503
             ;; just, in case
504
             (http:not-found))))
505
 
506
   (:get ((resource |/system/accounts/:account/repositories/:repository/views/:view|) request response (request-type t) (response-type mime:application/json))
507
     (if (dydra:access-authorized-p (resource-view resource) (http:request-agent request) |acl|:|Read|)
508
         (let ((model (compute-instance-model (resource-view resource) response-type)))
509
           (cl-user::format-json-compact (http:response-content-stream response) model)
510
           (fresh-line (http:response-content-stream response))
511
           nil)
512
         (http:unauthorized "Access to resource not üermittes: ~a" (resource-identifier resource))))
513
 
514
 
515
   #+(or) ;; not supported  
516
   (:post ((resource |/system/accounts/:account/repositories/:repository/configuration|) request response)
517
    "Given new configuration state, rdf:nil indicates to reset the configuration, while
518
     anything else should be a file, which is decoded into the metadata instance.
519
     Commit the new state and return no content"
520
    (let* ((new-state (call-next-method))
521
           (metadata (dydra:instance-metadata (resource-repository resource))))
522
      (handler-case (progn (dydra:decode-presentation-graph metadata new-state)
523
                           (dydra:commit-resource metadata))
524
        (error (c) (http:bad-request "Invalid configuration specification: ~a~%~s" c new-state)))
525
      (http:no-content)))
526
   #+(or) ;; not supported
527
   (:put ((resource |/system/accounts/:account/repositories/:repository/configuration/:property|) request response)
528
          "Accept a new or replacement value for an individual configuration property.
529
           allow that the decoded specification is either an atomic value, in which case the
530
           uri property applies, or is a keyed value, in which case the key must agree
531
           with the uri."
532
          (let* ((new-state (call-next-method))
533
                 (content-property (second (first new-state)))
534
                 (request-property (configuration-resource-property resource))
535
                 (metadata (dydra:instance-metadata (resource-repository resource))))
536
            (unless (and new-state (null (rest new-state))
537
                         (string-equal request-property (spocq.i::field-property-keyword content-property)))
538
              (http:bad-request "Invalid configuration setting: property does not match request content: ~a: ~s" request-property new-state))
539
            (handler-case (progn (dydra:decode-presentation-graph metadata new-state)
540
                                 (dydra:commit-resource metadata))
541
              (error (c) (http:bad-request "Invalid configuration setting: ~a~%~s" c new-state)))
542
            (http:no-content)))
543
   #+(or) ;; not supported
544
   (:delete ((resource |/system/accounts/:account/repositories/:repository/configuration/:property|) request response)
545
          "Remove the indicated value by assigning rdf:nil."
546
          (let* ((request-property (configuration-resource-property resource))
547
                 (deletion-content `((,request-property . (("type" . "uri") ("value" . "http://www.w3.org/1999/02/22-rdf-syntax-ns#nil")))))
548
                 (metadata (dydra:instance-metadata (resource-repository resource)))
549
                 (deletion-state (transcode-field metadata deletion-content mime:application/json mime:application/n-triples)))
550
            (handler-case (progn (dydra:decode-presentation-graph metadata deletion-state)
551
                                 (dydra:commit-resource metadata))
552
              (error (c) (http:bad-request "Invalid configuration setting: ~a~%~s" c deletion-state)))
553
            (http:no-content)))
554
 
555
   #+(or)
556
   (:put ((resource |/system/accounts/:account/repositories/:repository/configuration/namespaces|) request response)
557
     "Accept just the namespace bindings for a configuration. The format is that of the 'tuple query results'
558
      standard for the sesame api, in which the two variables are 'prefix' and 'namespace'."
559
     (let* ((namespaces (third (find |urn:dydra|:|prefixes| (call-next-method) :key #'second)))
560
            (repository (resource-repository resource))
561
            (metadata (spocq.i::instance-metadata repository)))
562
       (typecase namespaces
563
         (list (loop for binding in namespaces
564
                     do (unless (typep binding '(cons string string))
565
                          (http:bad-request "Invalid namespace bindings: ~s" namespaces))))
566
         (string (setf namespaces (spocq.i::decode-configuration-parameter namespaces :prefixes)))
567
         (t (http:bad-request "Invalid namespace bindings: ~s" namespaces)))
568
       (setf (spocq.i::metadata-namespace-bindings metadata) namespaces)
569
       (setf (spocq.i::resource-state metadata) :dirty)
570
       (dydra:commit-resource metadata)
571
       (http:no-content)))
572
   #+(or) ;; not supported
573
   (:post ((resource |/system/accounts/:account/repositories/:repository/profile|) request response)
574
     (let* ((new-state (call-next-method)))
575
            (handler-case (progn (dydra:decode-presentation-graph resource new-state)
576
                                 (dydra:commit-resource resource))
577
              (error (c) (http:bad-request "Invalid profile: ~a~%~s" c new-state)))
578
            (http:no-content)))
579
 
580
 
581
   (:get ((resource |/system/queries|) (request t) (response t) (content-type t) (response-type mime:text/html))
582
     (format (http:response-content-stream response)
583
             "<!DOCTYPE html>
584
 <html lang='en' xmlns='http://www.w3.org/1999/xhtml'>
585
   <head>
586
     <meta charset='UTF-8'/>
587
     <meta http-equiv='Content-Type' content='application/xhtml+xml; charset=UTF-8'/>
588
     <meta http-equiv='X-UA-Compatible' content='IE=edge'/>
589
     <meta name='viewport' content='width=device-width, initial-scale=1'/>
590
     <meta name='author' content='datagraph gmbh'/>
591
     <link rel='icon' href='/favicon.ico'/>
592
     <title>Dydra Agent [~a] - ~a</title>
593
     <link rel='stylesheet' href='/css/bootstrap.min.css'/>
594
     <link rel='stylesheet' href='/css/bootstrap-theme.min.css'/>
595
     <link rel='stylesheet' href='/css/tablesorter/theme.bootstrap.css'/>
596
     <!-- HTML5 shim and Respond.js IE8 support of HTML5 elements and media queries -->
597
     <!--[if lt IE 9]>
598
       <script src='https://oss.maxcdn.com/html5shiv/3.7.2/html5shiv.min.js'></script>
599
       <script src='https://oss.maxcdn.com/respond/1.4.2/respond.min.js'></script>
600
     <![endif]-->
601
   </head>
602
 
603
   <body>
604
     <div class='container'>
605
       <div class='page-header'>
606
         </div> <!--/page-header-->
607
       <div class='render'>
608
         <table class='table table-striped tablesorter' id='output'>
609
           <thead>
610
             <tr><td style='background-color: silver'>queries</td></td>
611
           </thead>
612
           <tbody>"
613
             (dydra:host-name) (http:resource-path resource))
614
     (loop for query in (spocq.i::list-queries)
615
       do (format (http:response-content-stream response) "~%<tr><td style='white-space: pre'><code>~a</code></td></tr>"
616
                  (spocq.i::task-id query)))
617
     (format (http:response-content-stream response) "
618
           </tbody>
619
         </table>
620
       </div> <!--/render-->
621
     </div> <!--/container-->
622
   </body>
623
 </html>
624
 "))
625
 
626
 
627
   (:get ((resource |/system/threads|) (request t) (response t) (content-type t) (response-type mime:text/html))
628
     (format (http:response-content-stream response)
629
             "<!DOCTYPE html>
630
 <html lang='en' xmlns='http://www.w3.org/1999/xhtml'>
631
   <head>
632
     <meta charset='UTF-8'/>
633
     <meta http-equiv='Content-Type' content='application/xhtml+xml; charset=UTF-8'/>
634
     <meta http-equiv='X-UA-Compatible' content='IE=edge'/>
635
     <meta name='viewport' content='width=device-width, initial-scale=1'/>
636
     <link rel='icon' href='/favicon.ico'/>
637
     <title>Dydra Agent [~a] - ~a</title>
638
     <link rel='stylesheet' href='/css/bootstrap.min.css'/>
639
     <link rel='stylesheet' href='/css/bootstrap-theme.min.css'/>
640
     <link rel='stylesheet' href='/css/tablesorter/theme.bootstrap.css'/>
641
     <!-- HTML5 shim and Respond.js IE8 support of HTML5 elements and media queries -->
642
     <!--[if lt IE 9]>
643
       <script src='https://oss.maxcdn.com/html5shiv/3.7.2/html5shiv.min.js'></script>
644
       <script src='https://oss.maxcdn.com/respond/1.4.2/respond.min.js'></script>
645
     <![endif]-->
646
   </head>
647
 
648
   <body>
649
     <div class='container'>
650
       <div class='page-header'>
651
         </div> <!--/page-header-->
652
       <div class='render'>
653
         <table class='table table-striped tablesorter' id='output'>
654
           <thead>
655
             <tr><td style='background-color: silver'>threads</td></tr>
656
           </thead>
657
           <tbody><tr><td style='white-space: pre'>"
658
             (dydra:host-name) (http:resource-path resource))
659
     (format (http:response-content-stream response) "<code>~%")
660
     ;; do not attempt network i/o while interrupting threads!
661
     (write-string (with-output-to-string (stream) (spocq.i::backtrace-threads :stream stream))
662
                   (http:response-content-stream response))
663
     (format (http:response-content-stream response) "</code>~%")
664
     (format (http:response-content-stream response) "
665
           </td></tr></tbody>
666
         </table>
667
       </div> <!--/render-->
668
     </div> <!--/container-->
669
   </body>
670
 </html>
671
 ")  )
672
 
673
   ;; implement just the json content for admin resources.
674
   ;; the wrapper pages are still left to php - eventually specialize the text/html response type
675
   (:get ((resource |/system/service_history/imports|) (request t) (response t) (content-type t) (response-type mime:mime-type))
676
     (http:not-found))
677
   (:get ((resource |/system/service_history/imports.:type|) (request t) (response t) (content-type t) (response-type mime:mime-type))
678
     (/system/service_history/imports.type resource request response content-type response-type))
679
   (:get ((resource |/system/service_history/imports|) (request t) (response t) (content-type t) (response-type mime:text/html))
680
     ;; NYI - left to php
681
     (http:not-acceptable "Media type combination (GET ~a) not supported for '~a'."
682
                          (type-of response-type)
683
                          (http:resource-path resource)))
684
 
685
 
686
   ;; non-specific service performance data either as time-series or aggregated
687
   (:get ((resource |/system/service_history/queries|) (request t) (response t) (content-type t) (response-type mime:text/html))
688
     ;; NYI - left to php
689
     (http:not-acceptable "Media type combination (GET ~a) not supported for '~a'."
690
                          (type-of response-type)
691
                          (http:resource-path resource)))
692
   (:get ((resource |/system/service_history/queries|) (request t) (response t) (content-type t) (response-type mime:mime-type))
693
         "Generate a time-series document to communicate the query performance over an interval"
694
         (let ((solution-field (compute-repository-query-event-timeseries (resource-repository resource) request)))
695
           (setf (http:response-content-disposition response) '("inline" "filename" "service_history.sr"))
696
           (setf (http:response-cache-control response) "private")
697
           (dydra:send-response-message :log solution-field (http:response-content-stream response) response-type)
698
           nil))
699
   (:get ((resource |/system/service_history/queries.:type|) (request t) (response t) (content-type t) (response-type t))
700
         "Generate a time-series document to communicate the query performance over an interval"
701
         (let ((solution-field (compute-repository-query-event-timeseries (resource-repository resource) request)))
702
           (setf (http:response-content-disposition response) '("inline" "filename" "service_history.sr"))
703
           (setf (http:response-cache-control response) "private")
704
           (setf response-type
705
                 (graph-store-effective-accept-media-type resource request response-type))
706
           (dydra:send-response-message :log solution-field (http:response-content-stream response) response-type)
707
           nil))
708
 
709
   (:get ((resource |/system/service_statistics/queries|) (request t) (response t) (content-type t) (response-type mime:text/html))
710
     ;; NYI - left to php
711
     (http:not-acceptable "Media type combination (GET ~a) not supported for '~a'."
712
                          (type-of response-type)
713
                          (http:resource-path resource)))
714
   (:get ((resource |/system/service_statistics/queries|) (request t) (response t) (content-type t) (response-type mime:mime-type))
715
         "Generate a time-series document to communicate the query performance over an interval"
716
         (let ((solution-field (compute-repository-query-event-statistics nil request)))
717
           (setf (http:response-content-disposition response) '("inline" "filename" "service_history.sr"))
718
           (setf (http:response-cache-control response) "private")
719
           (dydra:send-response-message :log solution-field (http:response-content-stream response) response-type)
720
           nil))
721
   (:get ((resource |/system/service_statistics/queries.:type|) (request t) (response t) (content-type t) (response-type t))
722
         "Generate a time-series document to communicate the query performance over an interval"
723
         (let ((solution-field (compute-repository-query-event-statistics nil request)))
724
           (setf (http:response-content-disposition response) '("inline" "filename" "service_history.sr"))
725
           (setf (http:response-cache-control response) "private")
726
           (setf response-type
727
                 (graph-store-effective-accept-media-type resource request response-type))
728
           (dydra:send-response-message :log solution-field (http:response-content-stream response) response-type)
729
           nil))
730
 
731
   (:get ((resource |/system/service_history/transactions|) (request t) (response t) (content-type t) (response-type mime:mime-type))
732
     (http:not-found))
733
   (:get ((resource |/system/service_history/transactions.:type|) (request t) (response t) (content-type t) (response-type mime:mime-type))
734
     (/system/service_history/transactions.type resource request response content-type response-type))
735
   (:get ((resource |/system/service_history/transactions|) (request t) (response t) (content-type t) (response-type mime:text/html))
736
     ;; NYI - left to php
737
     (http:not-acceptable "Media type combination (GET ~a) not supported for '~a'."
738
                          (type-of response-type)
739
                          (http:resource-path resource)))
740
 
741
   (:get ((resource |/system/service_statistics/transactions|) (request t) (response t) (content-type t) (response-type mime:mime-type))
742
     (http:not-found))
743
   (:get ((resource |/system/service_statistics/transactions.:type|) (request t) (response t) (content-type t) (response-type mime:mime-type))
744
     (/system/service_history/transactions.type resource request response content-type response-type))
745
   (:get ((resource |/system/service_statistics/transactions|) (request t) (response t) (content-type t) (response-type mime:text/html))
746
     ;; NYI - left to php
747
     (http:not-acceptable "Media type combination (GET ~a) not supported for '~a'."
748
                          (type-of response-type)
749
                          (http:resource-path resource)))
750
 
751
 #+(or)(
752
   (:get ((resource |/system/status/accounts|) (request t) (response t) (content-type t) (response-type mime:mime-type))
753
     (http:not-found))
754
   (:get ((resource |/system/status/accounts/:account.:type|) (request t) (response t) (content-type t) (response-type mime:mime-type))
755
     (/system/status/accounts.type resource request response content-type response-type))
756
 
757
   (:get ((resource |/system/status/accounts/:account/repositories|) (request t) (response t) (content-type t) (response-type mime:mime-type))
758
     (http:not-found))
759
   (:get ((resource |/system/status/accounts/:account/repositories/:repositories.:type|) (request t) (response t) (content-type t) (response-type mime:mime-type))
760
     (/system/status/accounts/:account/repositores/:repository.type resource request response content-type response-type))
761
 )
762
   (:get ((resource |/admin/status.:type|) (request t) (response t) (content-type t) (response-type t))
763
         ;; duplicate of below
764
         (let ((test-accounts (split-string (or (http:request-query-argument request "accounts") "") ","))
765
               (test-percent (http:request-query-argument request "percent")))
766
           (multiple-value-bind (test-results test-error-count)
767
                                (test-repository-access test-accounts :percent (or (when test-percent (ignore-errors (parse-integer test-percent))) 100))
768
             (cond ((zerop test-error-count)
769
                    (http:ok)
770
                    (spocq.i::make-list-solution-field :dimensions '(?::|name| ?::|status|)
771
                                                       :solutions test-results))
772
                   (t
773
                    (spocq.i::log-error "admin-status failed: ~s ~s" test-error-count test-results)
774
                    (http:internal-error))))))
775
   (:get ((resource |/system/status.:type|) (request t) (response t) (content-type t) (response-type t))
776
     "generate a page to indicate that the service is operating:
777
      - list all production repositories with an indicator, that it is possible to create a read transaction.
778
      - perform a no-op update to statistics/statistics"
779
     (let ((test-accounts (split-string (or (http:request-query-argument request "accounts") "") ","))
780
           (test-percent (http:request-query-argument request "percent")))
781
       (multiple-value-bind (test-results test-error-count)
782
                            (test-repository-access test-accounts :percent (or (when test-percent (ignore-errors (parse-integer test-percent))) 100))
783
         (cond ((zerop test-error-count)
784
                (http:ok)
785
                (spocq.i::make-list-solution-field :dimensions '(?::|name| ?::|status|)
786
                                                   :solutions test-results))
787
               (t
788
                (spocq.i::log-error "admin-status failed: ~s ~s" test-error-count test-results)
789
                (http:internal-error))))))
790
 
791
   (:get ((resource |/system/users/:user/profile|) request response (request-type t) response-type)
792
      (report-resource-profile resource
793
                               :agent (http:request-agent request)
794
                               :output-stream (http:response-content-stream response)
795
                               :response-content-type response-type)
796
      nil)
797
 
798
   (:get ((resource |/system/configuration.:type|) (request t) (response t) (content-type t) (response-type t))
799
     "generate a page to indicate that the service is operating:
800
      - list all production repositories with an indicator, that it is possible to create a read transaction.
801
      - perform a no-op update to statistics/statistics"
802
     (let ((configuration (read-configuration)))
803
       (spocq.i::make-list-solution-field :dimensions '(?::|setting| ?::|value|)
804
                                          :solutions configuration)))
805
   )
806
 
807
 (defun test-repository-access (accounts-to-test &key (percent 100))
808
   "given a list of repositories, for those which are known, attempt to open a transaction for
809
    the repository. allow the :percent argument to limit the fraction for which that is done.
810
    return the result list and an error count
811
    values
812
    result : (list repository-id status)
813
    error-count : integer"
814
   ;; this needs to read from mysql until the metadata repositoy reflects deletion
815
   (let* ((repositories-to-test (loop for (account repository) in (run-sparql "
816
   select ?account ?repository
817
   where { 
818
   graph ?accountURI {
819
   ?repositorURI rdf:type <urn:dydra:Repository>; foaf:name ?repository; sioc:has_parent ?accountURI .
820
   ?accountURI foaf:accountName ?account .
821
   }
822
   graph <urn:dydra:accounts> { ?accountURI rdf:type <urn:dydra:Account> }
823
   }"
824
                                            :agent (spocq.i::system-agent)
825
                                            :repository-id spocq.i::*system-repository-id*)
826
                                  when (member account accounts-to-test :test #'equalp)
827
                                  collect (list account repository)))
828
          (error-count 0)
829
          (test-results (loop for (account repository) in repositories-to-test
830
                          collect (if (< (random 100) percent)
831
                                      (let ((id (spocq.i::make-repository-id :account-name account :repository-name repository)))
832
                                        (cond ((spocq.i::repository-exists-p id)
833
                                               (handler-case (with-open-transaction (id)
834
                                                               "ok")
835
                                                 (spocq.e:repository-not-found-error (c)
836
                                                    ;; repository has been deleted
837
                                                    (declare (ignore c))
838
                                                    (format nil "~a: deleted" id))
839
                                                 (condition (c) (incf error-count) (format nil "~a: ~a" id c))))
840
                                              (t
841
                                               (dydra:log-warn "test-repository-access: ~a missing" id)
842
                                               (format nil "~a missing" id))))
843
                                      "n/a"))))
844
     (values (loop for (account repository) in repositories-to-test
845
               for result in test-results
846
               collect (list (spocq.i::make-repository-id :account-name account :repository-name repository) result))
847
             error-count)))
848
 ;;; (time (test-repository-access '("james" "jhacker"))) : 0.369 / 464 repos
849
 ;;; (dotimes (x 10) (time (print (multiple-value-list (spocq.si::test-repository-access '("james"))))) (sleep 5))
850
 
851
 
852
 
853
 (defun /system/service_history/imports.type (resource request response content-type response-type)
854
   (declare (ignore content-type))
855
   (cond ((not (dydra:administrator-p (http:request-agent request)))
856
          (http:not-found)) ; not unauthorized
857
         ((not (compute-applicable-methods #'spocq.i::send-response-message (list :log
858
                                                                                  '(spocq.a:|table|)
859
                                                                                  (http:response-content-stream response)
860
                                                                                  response-type)))
861
          (http:not-acceptable "Media type combination (GET ~a) not supported for '~a'."
862
                               (type-of response-type)
863
                               (http:resource-path resource)))
864
         (t
865
          (let* ((account (http:request-query-argument request "account"))
866
                 (agent (http:request-query-argument request "agent"))
867
                 (limit (or (http:request-query-argument request "limit") *admin-solution-limit*))
868
                 (offset (http:request-query-argument request "offset"))
869
                 (solution-field (compute-/system/service_history/imports-solutions :account account :agent agent :limit limit :offset offset)))
870
            (setf (http:response-content-disposition response)
871
                  '("inline" "filename" "history.imports.json"))
872
            (setf (http:response-cache-control response) "private")
873
            (dydra:send-response-message :log solution-field (http:response-content-stream response) response-type)
874
            nil))))
875
 
876
 ;;; nb. this reflects just the entries created by the rails service when it handles an import request.
877
 ;;; that includes neither graph store requests nor internal operations.
878
 ;;; those are reflected in the transaction history only.
879
 ;;; !!! it should be deprecated in favor of transaction history
880
 
881
 (defun compute-/system/service_history/imports-solutions (&key (limit nil) (offset nil) (account nil) (agent nil))
882
   (let* ((agent-constraint (when agent (format nil "ag.cached_slug = '~a'" agent)))
883
          (account-constraint (when account (format nil "a.cached_slug = '~a'" account)))
884
          (where (if agent-constraint
885
                     (if account-constraint
886
                         (format nil " ~a and ~a " agent-constraint account-constraint)
887
                         agent-constraint)
888
                     (if account-constraint
889
                         account-constraint
890
                         nil)))
891
          (select (format nil (concatenate 'string
892
                                           "SELECT l.job_id, l.created_at, a.cached_slug as account_key, r.cached_slug AS repository_key, ag.cached_slug AS agent_key, l.url, l.base_uri, l.context, l.triples, l.success "
893
                                           "FROM repository_import_logs l "
894
                                           "LEFT JOIN accounts ag ON l.account_id = ag.id "
895
                                           "LEFT JOIN repositories r ON l.repository_id = r.id "
896
                                           "LEFT JOIN accounts a ON r.account_id = a.id "
897
                                           "~@[ WHERE ~a ~]"
898
                                           "ORDER BY ag.id DESC ~@[ limit ~a~]~@[ offset ~a~];")
899
                          where limit offset))
900
          (command (format nil "mysql -h ~a -u root ~a -BNe ~s"
901
                           spocq.i::*mysql-host* spocq.i::*mysql-database* select ))
902
          (process (run-program "/bin/sh" (list "-c" command)
903
                                :wait nil
904
                                :input nil :output :stream)))
905
     (cond ((and process (typep (run-program-exit-code process) '(or null (eql 0))))
906
            (unwind-protect
907
                (cons '("uuid" "timestamp" "account_key" "repository_key" "agent_key" "source_uri" "base_uri" "context_uri" "quad_count" "success")
908
                      (loop for line = (read-line (run-program-output process) nil)
909
                        until (null line)
910
                        for row = (loop for value in (split-string line #(#\tab) :strict t)
911
                                    if (equal value "NULL")
912
                                    collect nil
913
                                    else collect value)
914
                        collect row))
915
              (close (run-program-output process))
916
              (run-program-close process)))
917
           (t
918
            (http:internal-error "import history retrieval failed")))))
919
 ;;; (compute-/system/service_history/imports-solutions :limit 10)
920
 ;;; mysql -h localhost -u root public -BNe "SELECT l.job_id, l.created_at, a.cached_slug as account_key, r.cached_slug AS repository_key, ag.cached_slug AS agent_key, l.url, l.base_uri, l.context, l.triples, l.success FROM repository_import_logs l LEFT JOIN accounts ag ON l.account_id = ag.id LEFT JOIN repositories r ON l.repository_id = r.id LEFT JOIN accounts a ON r.account_id = a.id ORDER BY ag.id DESC  limit 10;"
921
 
922
 
923
 (defun /system/service_history/transactions.type (resource request response content-type response-type
924
                                                   &key
925
                                                   (limit (http:request-query-argument request "limit"))
926
                                                   (offset (http:request-query-argument request "offset")))
927
   (declare (ignore content-type))
928
   (let* ((pathname (resource-pathname resource))
929
          (stream (http:response-content-stream response)))
930
     (unless (compute-applicable-methods #'spocq.i::send-response-message (list :log '(spocq.a:|table|) stream response-type))
931
       (http:not-acceptable "Media type combination (GET ~a) not supported for '~a'."
932
                            (type-of response-type)
933
                            (http:resource-path resource)))
934
     (setf limit
935
           (typecase limit
936
             (string (unless (equal limit "")
937
                       (or (ignore-errors (parse-integer limit)) *admin-solution-limit*)))
938
             (integer limit)
939
             (null *admin-solution-limit*)
940
             (t *admin-solution-limit*)))
941
     (setf offset (typecase offset
942
                    (string (if (equal offset "")
943
                                0
944
                                (or (ignore-errors (parse-integer offset)) 0)))
945
                    (integer offset)
946
                    (t 0)))
947
     (if (probe-file pathname)
948
         (if (dydra:authenticated-agent-p (http:request-agent request))
949
             (let* ((solution-field (compute-/system/service_history/transactions-solutions resource :limit nil :offset 0))
950
                    (solution-count (length (rest solution-field)))
951
                    (next-offset (+ offset limit))
952
                    (next-link (when (< next-offset solution-count) (format nil "?offset=~a" next-offset)))
953
                    (previous-offset (- offset limit))
954
                    (previous-link (when (>= previous-offset 0) (format nil "?offset=~a" previous-offset)))
955
                    (page-count  (ceiling (/ solution-count limit)))
956
                    (page  (1+ (floor (/ offset limit))))
957
                    (links (loop for i below page-count
958
                             for page-offset from 0 by limit
959
                             collect (format nil "?offset=~a" page-offset)))
960
                    (first-link (first links))
961
                    (last-link (first (last links))))
962
               (setf (http:response-content-disposition response)
963
                     '("inline" "filename" "history.transactions.json"))
964
               (setf (http:response-cache-control response) "private")
965
               (format stream "{\"page\": ~a, \"page_count\": ~a, \"page_size\": ~a, \"pages\": {~{\"~d\": \"~a\"~^, ~}}, \"links\": {\"first\": \"~a\"~@[, \"prev\": \"~a\"~]~@[, \"next\": \"~a\"~], \"last\": \"~a\"}, \"limit\": ~a, \"offset\": ~a,~% \"data\": "
966
                       page
967
                       page-count
968
                       limit
969
                       (loop for i from 1 for link in links collect i collect link)
970
                       first-link
971
                       previous-link
972
                       next-link
973
                       last-link
974
                       limit offset)
975
               (setf solution-field (cons (first solution-field)
976
                                          (subseq (rest solution-field)
977
                                                  (min offset solution-count)
978
                                                  (when limit (min solution-count (+ offset limit))))))
979
               (dydra:send-response-message :log solution-field stream response-type)
980
               (write-string "}" stream)
981
                 nil)
982
             (http:not-found))
983
         (http:not-found))))
984
 
985
 
986
 (defparameter *compute-/system/service_history/transactions.scanner*
987
   (cl-ppcre:create-scanner '(:SEQUENCE :START-ANCHOR
988
                                        (:REGISTER (:GREEDY-REPETITION 1 NIL :NON-WHITESPACE-CHAR-CLASS)) (:GREEDY-REPETITION 1 NIL #\space)
989
                                        (:GREEDY-REPETITION 0 NIL :EVERYTHING) " COMMIT-TRANSACTION "
990
                                        (:REGISTER (:GREEDY-REPETITION 1 NIL :NON-WHITESPACE-CHAR-CLASS)) " => "
991
                                        (:REGISTER (:GREEDY-REPETITION 1 NIL :NON-WHITESPACE-CHAR-CLASS)) #\/
992
                                        (:REGISTER (:GREEDY-REPETITION 1 NIL :NON-WHITESPACE-CHAR-CLASS)) (:GREEDY-REPETITION 1 NIL #\space)
993
                                        #\( #\-
994
                                        (:REGISTER (:GREEDY-REPETITION 1 NIL :digit-class)) #\, (:GREEDY-REPETITION 1 NIL #\space)
995
                                        #\+ (:REGISTER (:GREEDY-REPETITION 1 NIL :digit-class)) #\)
996
                                        (:GREEDY-REPETITION 1 NIL #\space) "by" (:GREEDY-REPETITION 1 NIL #\space)
997
                                        (:REGISTER (:GREEDY-REPETITION 1 NIL :NON-WHITESPACE-CHAR-CLASS))
998
                                        (:GREEDY-REPETITION 0 NIL #\space)
999
                                        (:REGISTER (:GREEDY-REPETITION 0 NIL :EVERYTHING))
1000
                                        :END-ANCHOR)))
1001
 
1002
 (defgeneric compute-/system/service_history/transactions-solutions (resource &key limit offset agent)
1003
   (:documentation "extract transaction information from a log file.
1004
    This was originally /var/log/dydra/commits.log, but that is no lomger generated.")
1005
   (:method ((resource http:resource) &rest args)
1006
     (apply #'compute-/system/service_history/transactions-solutions (resource-pathname resource) args))
1007
 
1008
   (:method ((pathname pathname) &key (limit *admin-solution-limit*) (offset 0)
1009
             (agent (http:request-agent http:*request*)))
1010
     (let* ((admin-p (dydra:administrator-p agent))
1011
            (last-repository-id nil)
1012
            (last-repository nil))
1013
       (flet ((transaction-repository (id)
1014
                (when id
1015
                  (if (equal last-repository-id id)
1016
                      last-repository
1017
                      (setf last-repository-id id
1018
                            last-repository (ignore-errors (repository last-repository-id)))))))
1019
         (cons '(?::|timestamp| ?::|uuid| ?::|account_key| ?::|repository_key|
1020
                    ?::|insert_count| ?::|remove_count| ?::|agent_key| ?::|agent_tag|)
1021
               (with-open-file (stream pathname :direction :input)
1022
                 (loop for line = (read-line stream nil nil)
1023
                   with count = 0
1024
                   with entries = ()
1025
                   until (or (null line) (and limit (>= count limit)))
1026
                   do (cl-ppcre:register-groups-bind (timestamp uuid account repository insert remove transaction-agent tag)
1027
                                                     (*compute-/system/service_history/transactions.scanner* line)
1028
                        (when (and (transaction-repository (spocq.i::make-repository-id :account-name account :repository-name repository))
1029
                                   (or admin-p (dydra:access-authorized-p last-repository agent |acl|:|Read|)))
1030
                          (when (< (decf offset) 0)
1031
                            (incf count)
1032
                            (push (list timestamp uuid account repository insert remove transaction-agent tag)
1033
                                  entries))))
1034
                   finally (return (nreverse entries)))))))))
1035
 ;;; (compute-/system/service_history/transactions-solutions (make-instance '|/system/service_history/transactions|))
1036
 ;;; (dydra:access-authorized-p (make-instance '|/system/service_history/transactions|) (spocq.i::ensure-agent :name "james" :admin-p t) |acl|:|Read|)
1037
 ;;;          (transaction-statistics (repository-transaction-statistics repository request))
1038
 
1039
 (defun /system/status/accounts.type (resource request response content-type response-type)
1040
   (declare (ignore content-type))
1041
   (cond ((not (dydra:administrator-p (http:request-agent request)))
1042
          (http:not-found)) ; not unauthorized
1043
         ((not (compute-applicable-methods #'spocq.i::send-response-message (list :log
1044
                                                                                  '(spocq.a:|table|)
1045
                                                                                  (http:response-content-stream response)
1046
                                                                                  response-type)))
1047
          (http:not-acceptable "Media type combination (GET ~a) not supported for '~a'."
1048
                               (type-of response-type)
1049
                               (http:resource-path resource)))
1050
         (t
1051
          (let* ((account (http:request-query-argument request "account"))
1052
                 (solutions (compute-/system/status/accounts-solutions account))
1053
                 (solution-field (cons '("key" "name" "email" "fullname" "admin" "balance")
1054
                                       solutions)))
1055
            (setf (http:response-content-disposition response)
1056
                  '("inline" "filename" "manage.accounts.json"))
1057
            (setf (http:response-cache-control response) "private")
1058
            (dydra:send-response-message :log solution-field (http:response-content-stream response) response-type)
1059
            nil))))
1060
 
1061
 (defun compute-/system/status/accounts-solutions (account)
1062
   (let* ((command (format nil  "mysql -h ~a -u root ~a -BNe \"SELECT cached_slug, name, email, fullname FROM accounts~@[ WHERE accounts.cached_slug ='~a'~] order by cached_slug;\""
1063
                           spocq.i::*mysql-host* spocq.i::*mysql-database* account))
1064
          (process (run-program "/bin/sh" (list "-c" command)
1065
                                :wait nil
1066
                                :input nil :output :stream)))
1067
     (cond ((and process (typep (run-program-exit-code process) '(or null (eql 0))))
1068
            (unwind-protect
1069
                (loop for line = (read-line (run-program-output process) nil)
1070
                  until (null line)
1071
                  for row = (loop for value in (split-string line #(#\tab) :strict t)
1072
                              if (equal value "NULL")
1073
                              collect nil
1074
                              else collect value)
1075
                  for (cached-slug) = row
1076
                  for is-admin = (dydra:administrator-p cached-slug)
1077
                  collect (append row (list is-admin nil)))
1078
              (close (run-program-output process))
1079
              (run-program-close process)))
1080
           (t
1081
            (http:internal-error "account retrieval failed")))))
1082
 
1083
 ;;; (/system/service_history/accounts (make-instance '|/system/service_history/accounts|) nil)
1084
 ;;; (compute-/system/status/accounts-solutions nil)
1085
 
1086
 
1087
 ;;; query history data, as series and as aggregate
1088
 
1089
 (defun compute-repository-query-event-timeseries (repository request)
1090
   "Return a solution set of the repository query event statistics.
1091
    include the account and repository names in each to allow for case where the events include more than one"
1092
   (let* ((query-events (repository-query-events repository request)))
1093
     ;; (?::|uuid| ?::|timestamp| ?::|query_time| ?::|run_time| ?::|match_requests| ?::|match_responses| ?::|signature| ?::|agent_name| ?::|account_name| ?::|repository_name|)
1094
     (cons '("elapsed_time" "run_time" "requests" "responses" "uuid" "timestamp" "signature" "agent" "account" "repository")
1095
           (loop for event in query-events
1096
             ;;do (print (spocq.i::query-event-timestamp event))
1097
             collect (list (spocq.i::query-event-elapsed-time event)
1098
                           (spocq.i::query-event-process-time event)
1099
                           (spocq.i::query-event-match-requests event)
1100
                           (spocq.i::query-event-match-responses event)
1101
                           (spocq.i::query-event-uuid event)
1102
                           (spocq.i::query-event-timestamp event)
1103
                           (spocq.i::query-event-sha1 event)
1104
                           (or (spocq.i::query-event-agent-name event) "")
1105
                           (spocq.i::query-event-account-key event)
1106
                           (spocq.i::query-event-repository-key event))))))
1107
 
1108
 
1109
 (defun compute-repository-query-event-statistics (repository request)
1110
   "return a single-element solution set which combines repository metadata with query event statistics."
1111
   (let* ((query-events (repository-query-events repository request))
1112
          (event-count (length query-events))
1113
          (metadata (rlmdb:get-metadata repository))
1114
          (byte-count (sb-posix:stat-size (sb-posix:stat (make-pathname :name "data" :type "mdb" :defaults (repository-pathname repository)))))
1115
          (match-request-count 0)
1116
          (match-response-count 0)
1117
          (elapsed-time 0)
1118
          (run-time 0))
1119
     ;; (?::|uuid| ?::|timestamp| ?::|query_time| ?::|run_time| ?::|match_requests| ?::|match_responses| ?::|signature| ?::|agent_name| ?::|account_name| ?::|repository_name|)
1120
     (cons '("elapsed_time" "run_time" "requests" "responses" "query_count"
1121
             "revision_uuid" "revision_timestamp" "statement_count" "byte_count"
1122
             "account" "repository" )
1123
           (when (plusp event-count)
1124
             ;; aggregate just the quantitative data
1125
             (loop for event in query-events
1126
               do (progn
1127
                    (incf match-request-count (spocq.i::query-event-match-requests event))
1128
                    (incf match-response-count (spocq.i::query-event-match-responses event))
1129
                    (incf elapsed-time (spocq.i::query-event-elapsed-time event))
1130
                    (incf run-time (spocq.i::query-event-process-time event))))
1131
             (list
1132
              (list elapsed-time
1133
                   run-time
1134
                   match-request-count
1135
                   match-response-count
1136
                   event-count
1137
                   (rest (assoc :|revision-uuid| metadata))
1138
                   (rest (assoc :|revision-time| metadata))
1139
                   (repository-statement-count repository)
1140
                   byte-count
1141
                   (spocq.i::repository-account-name repository)
1142
                   (spocq.i::repository-name repository)))))))
1143
 ;;; (compute-/system/status/repository-solutions (repository "james/cms") nil)
1144
 ��