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

KindCoveredAll%
expression0719 0.0
branch042 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; -*- package: org.dataagraph.spocq.implementation -*- 
2
 ;;;
3
 ;;; define the internal operators which implement the SSL core api
4
 
5
 ;;; (load (compile-file "/opt/spocq/patches/ssl/ssl-api-internal.lisp"))
6
 
7
 ;;; see file:///Development/Downloads/VOWL/WebVOWL_Single_Ont/webvowl.html
8
 ;;; for the ontology diagram generator
9
 
10
 ;;; http : http://www.w3.org/TR/HTTP-in-RDF10
11
 ;;; http-headers : http://www.w3.org/2011/http-headers
12
 
13
 (in-package :spocq.i)
14
 
15
 (defparameter *request-http-method* "POST")
16
 
17
 (define-condition ssl::control-condition (condition)
18
   ((tag :initform (error "tag is required")
19
         :initarg :tag
20
         :reader ssl::condition-tag)))
21
 
22
 (defun ssl::control-condition (tag)
23
   (make-condition 'ssl::control-condition :tag tag))
24
 
25
 
26
 
27
 ;;; operator implementations
28
 
29
 (defgeneric ssl::abort-transaction (transaction)
30
   (:documentation "Abort the given transaction.
31
    If either no transaction exists, or the current transactionis no longer active, the operation
32
    has no effect.
33
    Returns the transaction.")
34
   (:method ((targets list))
35
     ;; allow null at this level
36
     (loop for target in targets do (ssl::abort-transaction target)))
37
   (:method ((transaction transaction))
38
     (transaction-close transaction :abort)
39
     transaction)
40
   (:method ((dataset string))
41
     (ssl::abort-transaction (repository dataset)))
42
   (:method ((dataset repository))
43
     (let ((transaction (task-dataset-transaction *task* dataset)))
44
       (if transaction
45
           (ssl::abort-transaction transaction)
46
           (error "No transaction active for specified dataset: ~s" dataset)))))
47
 
48
 
49
 (defgeneric ssl::begin-transaction (task dataset &key mode)
50
   (:documentation "Begin a new transaction for the given dataset in the active thread for the active task.
51
    If the dataset is the task's primary, then the transaction should become its primary transaction.
52
    The default dataset is the thread's current dataset.
53
    If there is no transaction for the dataset, create a new one and register it.
54
    If there is one reuse it.
55
    In either case, ensure it is bound as the task's primary.
56
    As the last step, ensure that it is open.
57
    Returns no value.
58
 
59
    nb. this operation does not apply any authorization constraints. Within the query processor,
60
    protection rules are applied at the point where a dataset is instantiated, as they apply
61
    to entities other than just repositories - for example notification and federation client
62
    request streams. Within the store, the read/write authorization are applied independent of
63
    any within the query processor.")
64
 
65
   (:method ((task task) (revision repository-revision) &key (mode (task-access-mode task)))
66
     ;; (print (list :begin-transaction task revision (repository-id revision) mode) *trace-output*)
67
     (let ((transaction (ensure-task-dataset-transaction task revision mode)))
68
       ;; (print (list :begin-transaction transaction) *trace-output*)
69
       (when (and (eq revision (task-revision task)) (null (get-task-transaction task)))
70
         (setq *transaction* transaction)
71
         (setf-task-transaction transaction task))
72
       (unless (transaction-open-p transaction)
73
         (transaction-open transaction :if-does-not-exist :error))
74
       transaction)))
75
 
76
 
77
 (defgeneric ssl::bind-task (task dataset method)
78
   (:method ((task task) (dataset string) method)
79
     (ssl::bind-task task (repository dataset) method))
80
 
81
   (:method ((task task) (dataset t) (method symbol))
82
     "If provided just a method name, presume the target repository contains also the entailment
83
      regime definition and instantiate the regime accordingly."
84
     (ssl::bind-task task dataset (make-instance method :task task :dataset dataset)))
85
 
86
   (:method ((task task) (dataset repository-revision) (method t))
87
     "The base method compiles the query and initializes it - which activates its threaded
88
      processing"
89
     (if (null *task*)
90
       (setq *task* task)
91
       (assert (eq *task* task) ()
92
               "Task incompatible: ~s != !s" *task* task))
93
     #+(or)(when (null (task-revision task))
94
       (setf (slot-value task 'revision) dataset))
95
     #+(or)
96
     (if (null *repository*)
97
       (setq *repository* dataset)
98
       (assert (eq *repository* dataset) ()
99
               "Repository incompatible : ~s != ~s" *repository* dataset))
100
     (setq *repository* dataset)
101
     (setf (task-revision task) (repository-revision dataset))
102
     (setf (query-entailment-method task) method)
103
     ;; ensure there is an active transaction
104
     (ssl::begin-transaction task dataset)
105
     (add-task-thread task (bt:current-thread))
106
     (initialize-task task)
107
     ;; outside of the local contour
108
     task)
109
 
110
   (:method :after  ((task t) (dataset t) (method t))
111
     (generate-accounting-note :abstract)))
112
 
113
 
114
 (defgeneric ssl::commit-transaction (transaction)
115
   (:method ((targets list))
116
     ;; allow null at this level
117
     (loop for target in targets do (ssl::commit-transaction target)))
118
   (:method ((transaction transaction))
119
     (transaction-close transaction :commit)
120
     transaction)
121
   (:method ((dataset string))
122
     (ssl::commit-transaction (repository dataset)))
123
   (:method ((dataset repository))
124
     (let ((transaction (task-dataset-transaction *task* dataset)))
125
       (if transaction
126
           (ssl::commit-transaction transaction)
127
           (error "No transaction active for specified dataset: ~s" dataset))))
128
 
129
   (:method :after ((transaction transaction))
130
     ;; process provenance information to any declared destination
131
     (log-debug "commit-transaction: process declared provenance: ~s" *task*)
132
     (process-provenance-information *task*)))
133
 
134
 
135
 (defgeneric ssl::compose (steps)
136
   (:method ((steps list))
137
     (ssl:run steps)))
138
 
139
 
140
 (defgeneric ssl::conditional (value consequent alternative)
141
   (:method ((value t) consequent alternative)
142
     (ssl:if value consequent alternative)))
143
 
144
 
145
 (defgeneric ssl::configure (location)
146
   (:method ((location null))
147
     (values))
148
   (:method ((run-time request-processor))
149
     (ssl::configure (processor-configuration-location run-time)))
150
   (:method ((location stream))
151
     (case (peek-char nil location)
152
       (#\( (let* ((*package* (find-package :org.datagraph.spocq.implementation))
153
                   (configuration (read location)))
154
              (load-configuration configuration)))
155
       (t (load-configuration location)))
156
     (values))
157
   ;; allow for http and amqp to take the cfg from their headers
158
   )
159
 
160
 
161
 (defgeneric ssl::constrain (steps &key dataset name source)
162
   (:method :before (steps &rest args)
163
            (declare (dynamic-extent args))
164
            (log-debug "ssl::constrain : (~s . ~s)" steps args))
165
   
166
   (:method ((steps list) &key (dataset (task-repository *task*))
167
             (source (error "notify: source is required")) 
168
             name)
169
     (with-task (query :user-id name
170
                       :request-location source
171
                       :repository (when dataset (repository dataset)))
172
       (let ((complete-p nil))
173
         (unwind-protect (progn (ssl:run steps)
174
                           (task-close-transactions *task* :disposition nil)
175
                           (log-debug "ssl:constrain: ~s: transaction close upon completion" *task*)
176
                           (setf complete-p t))
177
           (unless complete-p
178
             (task-close-transactions *task* :disposition :abort)
179
             (log-debug "ssl:constrain: ~s: transaction abort upon completion" *task*)
180
             (log-debug "ssl:constrain complete: :task ~s :transaction ~s :generator ~s"
181
                        *task* (task-transaction *task*)
182
                        (task-result-generator *task*))
183
             (task-result-generator *task*)))))))
184
 
185
 
186
 (defclass ssl::dataset ()
187
   ((location
188
     :initarg :location :initform (error "location is requires")
189
     :reader ssl::dataset-location)
190
    (operation
191
     :initarg :operation :initform |acl|:|Read|
192
     :reader ssl::dataset-operation)))
193
 
194
 (defclass ssl::iri-dataset (ssl::dataset)
195
   ())
196
 
197
 (defgeneric ssl::dataset (location &key operation)
198
   (:documentation "Resolve the location to a concrete instance and return the instance.
199
    Enforce task agent access authorization restrictions with respect to the specific
200
    (location x operation) combination.
201
    LOCATION : (or string repository iri) : the intended dataset location
202
    :OPERATION : string : defaults to the current task operation
203
    VALUES : (or stream dataset repository)
204
 
205
    The primay case is the <account-name>/<repository-name> combination for local repositories.
206
    Additional possibilities are
207
    - iri : an internal federation location a remote one
208
    - request content designator : for graph store operations
209
    - response content designator : the standard for results
210
    - remote git repository : for query or data sources
211
    - remote http location : for notification
212
    Authorization constraints are applied here for the cases which will not include
213
    transaction creation, as there are more situations than just repository access.
214
    This means repositories are not checked until a transaction is created -
215
    perhaps implicitly by begin-transaction.")
216
 
217
   (:method ((location string) &rest args)
218
     "Given a string, apply patterns to distinguish the entity type creation."
219
     (declare (dynamic-extent args))
220
     (cond ((repository-string-p location)
221
            (apply #'ssl::dataset (repository location) args))
222
           ((url-string-p location)
223
            (apply #'ssl::dataset (iri location) args))
224
           (t
225
            (error "invalid dataset location: ~s" location))))
226
 
227
   (:method ((location spocq:iri) &key (operation (task-operation *task*)))
228
     ;; make a remote location dataset for query retrieval, federation, or result delivery,
229
     (let ((local-repository (and (iri-service-repository-id location)
230
                                  (service-repository location :if-does-not-exist nil))))
231
       (cond (local-repository
232
              (ssl::dataset local-repository :operation operation))
233
             ((access-authorized-p location (task-agent *task*) operation)
234
              (make-instance 'ssl::iri-dataset :location location :operation operation))
235
             (t
236
              (spocq.e:task-authorization-error :task *task* :operation operation)))))
237
 
238
   (:method ((location stream) &key operation)
239
     (declare (ignore operation))
240
     location)
241
 
242
   (:method ((location (eql |http|:|body|)) &key operation)
243
     (if (access-authorized-p location (task-agent *task*) operation)
244
       (case operation
245
         ((|acl|:|Execute| |acl|:|Read|)  (ssl::request-stream))
246
         (|acl|:|Write| (ssl::response-stream))
247
         (t (error "invalid dataset location: ~s . ~s" location operation)))
248
       (spocq.e:task-authorization-error :task *task* :operation operation)))
249
         
250
   (:method ((repository repository) &key operation)
251
     (declare (ignore operation))
252
     repository))
253
 
254
 (defgeneric ssl::decode (location media-type)
255
   (:argument-precedence-order media-type location)
256
   (:method :before ((source t) (media-type t))
257
     (log-debug "ssl::decode : (~s ~s)" source media-type))
258
 
259
   (:method ((source (eql '|http|:|body|)) (media-type t))
260
     (ssl::decode (ssl::dataset source :operation |acl|:|Execute|) media-type))
261
   (:method ((source t) (media-type (eql '|http-headers|:|content-type|)))
262
     (ssl::decode source (ssl::request-content-type)))
263
   (:method ((source t) (media-type mime:application/sparql-query+cascalog))
264
     (parse-cascalog source))
265
   #+(or) ; not yet
266
   (:method ((source t) (media-type mime:application/sparql-query+arq-sse))
267
     (parse-arq-sse source))
268
   (:method ((source t) (media-type mime:application/sparql-query+sse))
269
     (parse-sparql-sse source))
270
 
271
   (:method ((source t) (media-type mime:application/sparql-query))
272
            (multiple-value-bind (sse-expression options query-tokens index)
273
                                 (parse-sparql source)
274
              (declare (ignore query-tokens index))
275
              (apply #'reinitialize-instance *task*
276
                     :sse-expression sse-expression
277
                     :dataset-graphs *dataset-graphs*      ; as parsed when not asserted by the request
278
                     options))
279
            *task*)
280
 
281
   (:method ((source t) (media-type mime:application/vnd.dydra.sparql-query-algebra))
282
            (multiple-value-bind (operation options)
283
                                 (parse-sparql-sse source)
284
              (apply #'reinitialize-instance *task*
285
                     :operation operation
286
                     options))
287
            *task*)
288
 
289
   (:method ((source t) (media-type mime:application/sparql-query+cascalog))
290
            (multiple-value-bind (operation options)
291
                                 (parse-cascalog source)
292
              (apply #'reinitialize-instance *task*
293
                     :operation operation
294
                     options))
295
            *task*)
296
   )
297
 
298
 
299
 (defgeneric ssl::encode (result-field location media-type &key)
300
   (:documentation "Given a solution field, encode its content as a response to
301
     the given destination location as per the given media type.
302
     The principle use-case is to encode sparql results, but it can also serve to
303
     send visualizations or execution plans and/or statistics.
304
 
305
    It handles also authorization:
306
    - streams are accepted always; they are present as the process input and output streams and are
307
      always available
308
    - a dataset argument implies that it has authorized access from the current agent and
309
      the method can delegate to a stream implementation.
310
    - any other argument type is wrapped first in a dataset for that to effect authorization
311
      and signal an exception for violations, and then re-iterated with the dataset argument.")
312
 
313
   (:method ((result solution-generator) (destination stream) (media-type mime:application/vnd.dydra.sparql-query-algebra) &key)
314
     "An algebra response encodes the task script/query as per themedia type"
315
     (send-response-message :abstract (task-sse-expression *task*) destination media-type)
316
     result)
317
 
318
   (:method ((result t) (destination stream) (media-type mime:mime-type) &key)
319
     "The default message delegates to send-response, which specializes for the media types"
320
     (send-response-message (task-operation *task*) result destination media-type)
321
     result)
322
 
323
   (:method ((solution-field solution-generator) (destination repository) (media-type t) &key)
324
     "given a generator and a destination repository, copy the content,
325
      !!! without provenance recording"
326
     (let* ((dimensions (abstract-field-generator-dimensions solution-field))
327
            (arity (length dimensions)))
328
       (case arity
329
         (3
330
          (with-open-repository (destination :read-only-p nil :normal-disposition :commit)
331
            (let ((%transaction (transaction-record *transaction*)))
332
              (do-solution-field (subject predicate object) solution-field
333
                (when (and (/= subject 0) (/= predicate 0) (/= object 0))
334
                  (rdfcache::insert-statement %transaction
335
                                              rdfcache:*default-context-number*
336
                                              subject predicate object))))))
337
         (4
338
          (with-open-repository (destination :read-only-p nil :normal-disposition :commit)
339
            (let ((%transaction (transaction-record *transaction*)))
340
              (do-solution-field (subject predicate object graph) solution-field
341
               (when (and (/= subject 0) (/= predicate 0) (/= object 0) (/= graph 0))
342
                 (rdfcache::insert-statement %transaction graph subject predicate object))))))
343
         (t
344
          (invalid-argument-type ssl::encode solution-field graph-generator))))
345
     solution-field))
346
 
347
 (defgeneric ssl::end-transaction (transaction)
348
   (:documentation "use the first argument on the stack to designate a repository/revision/transaction to close without disposition")
349
 
350
   (:method ((transaction transaction))
351
     (transaction-close transaction nil)
352
     (setq *transaction* nil)
353
     transaction))
354
 
355
 
356
 (defgeneric ssl:for (projection code)
357
   (:documentation "Iterate over a solution field. For each solution, extend the
358
    initial script environment for all bound dimensions and execute the code sequence
359
    with the initial stack and that extended environment.
360
    Upon completion, retain the last stack, but restore the environment")
361
   
362
   (:method ((projection solution-generator) (code list))
363
     (sslr:do-field (projection code))))
364
 
365
 (defgeneric ssl:for-every (projection code)
366
   (:documentation "Iterate over a solution field. For each solution, extend the
367
    initial script environment for all bound dimensions and execute the code sequence
368
    with the initial stack and that extended environment.
369
    If any execution does not yield true, terminate the iteration.
370
    Yield the final value on the stack
371
    Upon completion, but restore the environment")
372
   
373
   (:method ((projection solution-generator) (code list))
374
     (let ((last nil))
375
       (sslr:do-field (projection code)
376
            (setf last (sslr:pop))
377
            (unless (ssl:true last) (return)))
378
       last)))
379
 
380
 (defgeneric ssl:for-some (projection code)
381
   (:documentation "Iterate over a solution field. For each solution, extend the
382
    script environment for all _bound_ dimensions and execute the code sequence
383
    in the extended environment. If any execution returns true, terminate the iteration
384
    and return that value.")
385
 
386
   (:method ((projection solution-generator) (code list))
387
     (sslr:do-field (projection code)
388
       (let ((result (sslr:pop)))
389
         (when (ssl:true result) (return result))))))
390
 
391
 
392
 (defgeneric ssl::graph-matcher (method dataset)
393
   )
394
 
395
 
396
 (defun ssl::run-block (body-operator &optional (name |rdf|:|nil|))
397
   (declare (dynamic-extent body-operator))
398
   (restart-bind ((nil (lambda (&optional (value nil)) (return-from ssl::run-block value))
399
                       :test-function (lambda (c)
400
                                        (typecase c
401
                                          (ssl::control-condition
402
                                           (let ((tag (ssl::condition-tag c)))
403
                                             (or (equalp tag name)
404
                                                 (and (or (stringp tag) (symbolp tag))
405
                                                      (string-equal tag name)))))
406
                                          (t
407
                                           nil)))
408
                       :report-function (lambda (stream) (format stream "Return from block (~a)." name))))
409
     (funcall body-operator)))
410
 
411
 (defmacro ssl::block (name &body body)
412
   (let ((block-body-op (gensym "block")))
413
     `(flet ((,block-body-op () ,@body))
414
        (declare (dynamic-extent #',block-body-op))
415
        (ssl::run-block #',block-body-op ,name))))
416
 
417
 
418
 (defgeneric ssl::loop (steps &key name)
419
   (:method ((steps list) &key (name |rdf|:|nil|))
420
     (ssl::block name
421
       (loop (ssl:run steps)))))
422
 
423
 (defgeneric ssl::notify (steps &key dataset source destination mode)
424
   (:documentation "Perform a query with the intent to project the result to a
425
     named location.
426
     :dataset : the target dataet : default is the current task _repository_,
427
       which may resolve to some other revsion than that for the task
428
     :source : the source for the query text. for direct http, this could be a
429
       mime section, otherwise the body is already consumed for the main query,
430
       which means, this must name an autonomous resource
431
     :destination : the destination for the result.
432
       must be some external location in order to serve as notification.
433
       iri are handled with external /opt/dydra/lib/exec/curl
434
       default remains, however the response content stream.
435
 
436
     intends to operate in the context of an activ query/update, from which it
437
     adopts various parameters  ")
438
 
439
   (:method :before (steps &rest args)
440
     (declare (dynamic-extent args))
441
     (log-debug "ssl::notify : (~s . ~s)" steps args))
442
 
443
   (:method ((location t) &rest args)
444
     (declare (dynamic-extent args))
445
     (apply #'ssl::notify (load-ssl-graph location) args))
446
 
447
   (:method ((steps list) &rest args &key
448
             ((:name *task-name*) *task-name*)
449
             ((:dataset *repository-id*) *repository-id*)
450
             ((:revision *revision-id*) *revision-id*)
451
             ((:source *request-location*) *request-location*)
452
             ((:source-type *request-content-type*) mime:application/sparql-query)
453
             ((:destination *response-location*) *response-location*)
454
             ((:destination-type *response-content-type*) mime:application/sparql-results+json)
455
             (mode |urn:dydra|:|synchronous|))
456
     "Implement notify the same as a normal query.
457
      It differs only in that the default encoding location is not the response content stream,
458
      but instead configuration parameter."
459
 
460
     
461
       (flet ((do-notify ()
462
                (let ((*task-parent* *task*)
463
                      (*task* nil)
464
                      (*query* nil)
465
                      (*repository* nil)
466
                      (*transaction* nil)
467
                      (complete-p nil))
468
                  (unwind-protect (ssl::block *task-name*
469
                                    (ssl:run steps) ; these make the task
470
                                    (task-close-transactions *task* :disposition nil)
471
                                    (log-debug "ssl:notify: ~s: transaction close upon completion" *task*)
472
                                    (setf complete-p t))
473
                    (cond (*task*
474
                           (unless complete-p
475
                             (task-close-transactions *task* :disposition :abort)
476
                             (log-debug "ssl:query: ~s: transaction abort upon completion" *task*)))
477
                          (t
478
                           (log-debug "ssl:notify no task ~s" args))))
479
                  (log-debug "ssl:notify complete: :task ~s" *task*)
480
                  *task*)))
481
         (ecase mode
482
           (|urn:dydra|:|synchronous|
483
            (do-notify))
484
           (|urn:dydra|:|asynchronous|
485
            (bt:make-thread #'do-notify
486
                            :name *task-name*
487
                            :initial-bindings `((*thread-name* . ,*task-name*)
488
                                                (*task* . ,*task*)
489
                                                (*request-processor* . ',*request-processor*)))
490
            ;; there is no task to be returned
491
            |rdf|:|nil|)))))
492
 
493
 
494
 (defgeneric ssl::project (query quad-field method media-type)
495
   (:documentation "Project a task as per the given media type.
496
    This includes query processing as well as depictions of introspective analysis.")
497
 
498
   (:method :before (task (field t) (method t) (media-type t))
499
            (log-debug "ssl::project : (~s ~s ~s ~s)" task field method media-type))
500
 
501
   (:method ((query query) (source-quad-field repository) (method t) (media-type mime:application/sparql-results))
502
     "Apply a query to a dataset quad field to yield a solution field.
503
    Establishes the query's dynamic context to perform compilation if necessary and then
504
    sets the threads task instance to the given query."
505
 
506
     (declare (ignore method))
507
     (with-task-environment (:task query)
508
       (add-task-thread query (bt:current-thread))
509
       ;; (re)build the data from graph anew each time in order to creae fresh queues
510
       (initialize-task query)
511
       ;; initiate task processsing thread for the top node
512
       (let ((generator (task-result-generator query)))
513
         (query-run-in-thread query generator)
514
         (log-debug "project-data: task: ~s; generator: ~s" query generator)
515
         ;; return the field generator
516
         generator)))
517
 
518
   (:method ((task task) (source t) (method t) (media-type mime:application/sparql-query))
519
    "If the response type is itself a query variation, yield the query and leave
520
     the work to the encode operation"
521
    task))
522
 
523
    
524
 (defgeneric ssl::query (steps &key dataset name revision source destination)
525
   (:method :before (steps &rest args)
526
     (declare (dynamic-extent args))
527
     (log-debug "ssl::query : (~s . ~s)" steps args))
528
 
529
   (:method ((location t) &rest args)
530
     (declare (dynamic-extent args))
531
     (apply #'ssl::query (load-ssl-graph location) args))
532
 
533
   (:method ((steps list) &rest args &key
534
             ((:name *task-name*) *task-name*)
535
             ((:dataset *repository-id*) *repository-id*)
536
             ((:revision *revision-id*) *revision-id*)
537
             ((:source *request-location*) *request-location*)
538
             ((:source-type *request-content-type*) mime:application/sparql-query)
539
             ((:destination *response-location*) *response-location*)
540
             ((:destination-type *response-content-type*) mime:application/sparql-results+json))
541
     (let ((*task-parent* *task*)
542
           (*task* nil)
543
           (*query* nil)
544
           (*repository* nil)
545
           (*transaction* nil)
546
           (complete-p nil))
547
       (unwind-protect (ssl::block *task-name*
548
                         (ssl:run steps) ; these make the task
549
                         (task-close-transactions *task* :disposition nil)
550
                         (log-debug "ssl:query: ~s: transaction close upon completion" *task*)
551
                         (setf complete-p t))
552
         (cond (*task*
553
                (unless complete-p
554
                  (task-close-transactions *task* :disposition :abort)
555
                  (log-debug "ssl:query: ~s: transaction abort upon completion" *task*))
556
                (generate-accounting-note :complete :task *task*)
557
                (finalize-task *task*))
558
               (t
559
                (log-debug "ssl:query no task ~s" args))))
560
       (log-debug "ssl:query complete: :task ~s" *task*)
561
       *task*)))
562
     
563
 
564
 (defgeneric ssl::request (content location request-media-type response-media-type &key method)
565
   (:documentation "Given a request location - in particular http, connect, send the request and/or retrieve content")
566
   (:argument-precedence-order request-media-type response-media-type content location)
567
 
568
   (:method (content location (request-media-type string) response-media-type &rest args)
569
     (declare (dynamic-extent args))
570
     (apply #'ssl::request content location (mime:mime-type request-media-type) response-media-type args))
571
   (:method (content location request-media-type (response-media-type string) &rest args)
572
     (declare (dynamic-extent args))
573
     (apply #'ssl::request content location request-media-type (mime:mime-type response-media-type) args))
574
 
575
   (:method ((content solution-field) (location spocq:http-url) (request-media-type mime:mime-type) (response-media-type t) &key (method *request-http-method*))
576
     "Given an http location, the combinations are
577
      :get - response content
578
      :put - request content
579
      :post - request content and response content given a type"
580
     (let ((pathname (make-pathname :directory '(:absolute "tmp")
581
                                    :name (string (gensym (task-id *task*)))))
582
           (result content))
583
       ;; buffer the output to a temporary file in order to size it
584
       (unwind-protect
585
           (progn
586
             (with-open-file (tmp-stream pathname :direction :output :if-does-not-exist :create :if-exists :error)
587
               (ssl::encode content tmp-stream request-media-type))
588
             (with-http-request-stream (request-http-stream response-http-stream location
589
                                                            :content-type request-media-type
590
                                                            :content-pathname pathname
591
                                                            :accept response-media-type
592
                                                            :method method)
593
               (if (mime:mime-type-p response-media-type)
594
                   (setf result (ssl::decode response-http-stream response-media-type))
595
                   (loop for byte = (read-char response-http-stream nil nil)
596
                     until (null byte)
597
                     do (write-char byte)))))
598
         (when (probe-file pathname) (delete-file pathname)))
599
       result))
600
 
601
   (:method ((content solution-field) (location spocq:mailto-url) (request-media-type mime:mime-type) (response-media-type t) &key method)
602
     "Given a mailto location, encode the content as mail"
603
     (declare (ignore method))
604
     (let* ((address (subseq (spocq:iri-lexical-form location) 7))
605
            (from (format nil "spocq@~a" (site-name)))
606
            (process (or (run-program "/usr/sbin/sendmail" `("-f" ,from ,address)
607
                                      :wait nil
608
                                      :input :stream
609
                                      :input nil)
610
                         (error "ssl:request: run-program-failed.")))
611
            (mail-stream (run-program-input process)))
612
       (unwind-protect
613
           (progn
614
             (format mail-stream "From: ~a~c~cSubject: ~a~c~c~c~c"
615
                     from #\return #\linefeed (task-id *task*) #\return #\linefeed #\return #\linefeed )
616
             (ssl::encode content mail-stream request-media-type)
617
             (fresh-line mail-stream)
618
             (force-output mail-stream)
619
             (close mail-stream)
620
             (run-program-wait process)
621
             content)
622
         (run-program-close process))))
623
 
624
   (:method ((content (eql |rdf|:|nil|)) (location spocq:url) (request-media-type t) (response-media-type mime:mime-type) &key (method :get))
625
     "Given an http location, and no content the request must be :GET
626
      make the request, decode  and return the response"
627
     (with-http-request-stream (request-http-stream response-http-stream location
628
                                :accept response-media-type
629
                                :method method)
630
       (declare (ignore request-http-stream))
631
       (ssl::decode response-http-stream response-media-type)))
632
 
633
   (:method ((result-field t) (dataset ssl::iri-dataset) request-media-type response-media-type &rest args)
634
     (apply #'ssl::request result-field (ssl::dataset-location dataset) request-media-type response-media-type
635
            args)))
636
 
637
 
638
 
639
 
640
 (defgeneric ssl::return (&key name value)
641
   (:documentation "Returned from the named loop, by default rdf:nil.")
642
   (:method (&key (name |rdf|:|nil|) (value nil v-s))
643
     (let ((restart (first (compute-restarts (ssl::control-condition name)))))
644
       (if restart
645
           (if v-s
646
               (invoke-restart restart value)
647
               (invoke-restart restart))
648
           (error "Attempt to return from an unknown loop: (~a)." name)))))
649
 
650
 
651
 (defgeneric ssl::update (steps &key dataset name source destination)
652
   (:method :before (steps &rest args)
653
     (declare (dynamic-extent args))
654
     (log-debug "ssl::notify : (~s . ~s)" steps args))
655
 
656
   (:method ((location t) &rest args)
657
     (declare (dynamic-extent args))
658
     (apply #'ssl::update (load-ssl-graph location) args))
659
 
660
   (:method ((steps list) &rest args &key
661
             ((:name *task-name*) *task-name*)
662
             ((:dataset *repository-id*) *repository-id*)
663
             ((:revision *revision-id*) *revision-id*)
664
             ((:source *request-location*) *request-location*)
665
             ((:source-type *request-content-type*) mime:application/sparql-query)
666
             ((:destination *response-location*) *response-location*)
667
             ((:destination-type *response-content-type*) mime:application/sparql-results+json))
668
     (let ((*task-parent* *task*)
669
           (*task* nil)
670
           (*query* nil)
671
           (*repository* nil)
672
           (*transaction* nil)
673
           (complete-p nil))
674
       (unwind-protect (ssl::block *task-name*
675
                         (ssl:run steps) ; these make the task
676
                         (task-close-transactions *task* :disposition nil)
677
                         (log-debug "ssl:update: ~s: transaction close upon completion" *task*)
678
                         (setf complete-p t))
679
         (cond (*task*
680
                (unless complete-p
681
                  (task-close-transactions *task* :disposition :abort)
682
                  (log-debug "ssl:update: ~s: transaction abort upon completion" *task*)))
683
               (t
684
                (log-warn "ssl:update no task ~s" args))))
685
       (log-debug "ssl:update complete: :task ~s" *task*)
686
       *task*))
687
   )