22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
|
(use srfi-69 posix)
(declare (unit api))
(declare (uses rmt))
(declare (uses db))
(declare (uses dbmod))
(declare (uses tasks))
(import dbmod)
;; allow these queries through without starting a server
;;
(define api:read-only-queries
'(get-key-val-pairs
get-var
get-keys
|
>
>
|
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
|
(use srfi-69 posix)
(declare (unit api))
(declare (uses rmt))
(declare (uses db))
(declare (uses dbmod))
(declare (uses dbfile))
(declare (uses tasks))
(import dbmod)
(import dbfile)
;; allow these queries through without starting a server
;;
(define api:read-only-queries
'(get-key-val-pairs
get-var
get-keys
|
142
143
144
145
146
147
148
149
150
151
152
153
154
155
|
;; These are called by the server on recipt of /api calls
;; - keep it simple, only return the actual result of the call, i.e. no meta info here
;;
;; - returns #( flag result )
;;
(define (api:execute-requests dbstruct dat)
(handle-exceptions
exn
(let ((call-chain (get-call-chain)))
(debug:print 0 *default-log-port* "WARNING: api:execute-requests received an exception from peer, dat=" dat ", exn=" exn)
(print-call-chain (current-error-port))
(debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
(vector #f (vector exn call-chain dat))) ;; return some stuff for debug if an exception happens
|
>
|
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
|
;; These are called by the server on recipt of /api calls
;; - keep it simple, only return the actual result of the call, i.e. no meta info here
;;
;; - returns #( flag result )
;;
(define (api:execute-requests dbstruct dat)
(db:open-no-sync-db) ;; sets *no-sync-db*
(handle-exceptions
exn
(let ((call-chain (get-call-chain)))
(debug:print 0 *default-log-port* "WARNING: api:execute-requests received an exception from peer, dat=" dat ", exn=" exn)
(print-call-chain (current-error-port))
(debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
(vector #f (vector exn call-chain dat))) ;; return some stuff for debug if an exception happens
|
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
|
;; MISC
((get-latest-host-load) (apply db:get-latest-host-load dbstruct params))
((have-incompletes?) (apply db:have-incompletes? dbstruct params))
((login) (apply db:login dbstruct params))
((general-call) (let ((stmtname (car params))
(run-id (cadr params))
(realparams (cddr params)))
(db:general-call dbstruct stmtname realparams)))
((sdb-qry) (apply sdb:qry params))
((ping) (current-process-id))
((get-changed-record-ids) (apply db:get-changed-record-ids dbstruct params))
((get-run-record-ids) (apply db:get-run-record-ids dbstruct params))
;; TESTMETA
((testmeta-get-record) (apply db:testmeta-get-record dbstruct params))
|
|
|
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
|
;; MISC
((get-latest-host-load) (apply db:get-latest-host-load dbstruct params))
((have-incompletes?) (apply db:have-incompletes? dbstruct params))
((login) (apply db:login dbstruct params))
((general-call) (let ((stmtname (car params))
(run-id (cadr params))
(realparams (cddr params)))
(db:general-call dbstruct run-id stmtname realparams)))
((sdb-qry) (apply sdb:qry params))
((ping) (current-process-id))
((get-changed-record-ids) (apply db:get-changed-record-ids dbstruct params))
((get-run-record-ids) (apply db:get-run-record-ids dbstruct params))
;; TESTMETA
((testmeta-get-record) (apply db:testmeta-get-record dbstruct params))
|