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

KindCoveredAll%
expression0111 0.0
branch04 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; -*- Mode: lisp; Syntax: ansi-common-lisp; Base: 10; Package: org.datagraph.spocq.implementation; -*-
2
 
3
 (in-package :org.datagraph.spocq.server.implementation)
4
 
5
 #|
6
 run a toplevel for http-based access
7
 
8
 
9
 |#
10
 
11
 
12
 (defun main-repl (&rest args &key (init-name (or (getarg "--spocqinit") "init-http-repl")) &allow-other-keys)
13
   (when (getarg "--spocqhelp") ;; --help is seen by sbcl
14
     (format *trace-output* "~a :~{~% ~a~}~%" (first (spocq.i::command-line-argument-list))
15
             (sort spocq.i::*getarg-options* #'string-lessp))
16
     (exit-lisp 0))
17
   (setq spocq.i:*configuration-pathname* (make-pathname :directory '(:relative) :name init-name :type "sxp"))
18
   (handler-case (spocq.i:initialize-spocq)
19
     (error (condition)
20
       (log-error "http:main-repl: termination due to condition: ~a" condition)
21
       (spocq.i::maybe-exit-on-error)))
22
   ;; avoid first initialization error
23
   (handler-case (make-instance 'spocq.i::query :sse-expression () :id "" :repository-id "system/system")
24
     (error (c) (log-warn "initial instantiation error: ~a" c))
25
     (:no-error (result) (log-notice "initial instantiation: ~a" result)))
26
   (apply #'run-repl args))
27
 
28
 (defun run-repl (&key (request-class *service-request-class*)
29
                       (response-class *service-response-class*)
30
                       init-name)
31
   "Initiate the http server with a background admin process."
32
   (declare (ignore init-name))
33
   (spocq.i:enable-interrupt :sigterm #'spocq.i:sigterm-handler)
34
   (setq spocq.i:*start-timestamp* (iso-time))
35
   (setq spocq.i:*response-header-types* nil)  ; to be sure that no prefixes are sent out
36
   #+sbcl(sb-ext:gc :full t)
37
 
38
   (dydra:log-info "Start ~a." spocq.i:*start-timestamp*)
39
   (let* ((host-name (dydra:server-host-name))                                                                             
40
          (host-package (or (find-package host-name)                                                                       
41
                            (make-package host-name :use ()))))                                                            
42
     (import *response-functions* host-package)
43
     (with-package-iterator (next host-package :internal)
44
       (loop (multiple-value-bind (symbol-p symbol) (next)
45
               (unless symbol-p (return))
46
               (export symbol host-package))))
47
     (let* ((hunchentoot:*acceptor*
48
             (make-instance 'spocq-acceptor
49
               :name "spocq-repl"
50
               ;; tcp attributes do not matter as the acceptor is never started
51
               :port *host-port* :address (spocq.i::host-name)
52
               :request-class request-class
53
               :response-class response-class
54
               :taskmaster (make-instance *class.taskmaster*
55
                             :name (concatenate 'string (spocq.i::host-name) "-taskmaster"))))
56
            (*spocq-acceptor* hunchentoot:*acceptor*)
57
            (*history-directory* #p"/srv/dydra/history/"))
58
       (setf (http:acceptor-dispatch-function *spocq-acceptor*) host-package)
59
       (setq *run-state* :process)
60
       (loop while (eq spocq.i:*run-state* :process)
61
         do (write-string "sparql> " *standard-output*) (finish-output *standard-output*)
62
         do (process-top-level-task hunchentoot:*acceptor* *standard-input* *standard-output*)
63
         finally (dydra:log-notice "run-repl: complete")))))
64
 
65
 (defgeneric process-top-level-task (acceptor source destination &rest args)
66
   (:documentation "Given input and output streams, read the request from the source,
67
    execute it and emit the result to the destination.")
68
   (:method ((acceptor t) (source stream) (destination stream) &rest args)
69
     (dydra:log-notice "process-top-level-task: initiate: ~a ~a" source destination)
70
     (let ((chunga:*accept-bogus-eols* t))
71
       (unwind-protect (multiple-value-bind (request response)
72
                                            (apply #'hunchentoot::process-asynchronous-connection acceptor source destination args)
73
                         (dydra:log-notice "process-top-level-task: ~a: ~a: ~a"
74
                                           source request response)
75
                         response)))))