144
145
146
147
148
149
150
151
152
153
154
155
156
157
|
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
|
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
|
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
|
-
-
-
-
+
+
+
+
|
;; TASKS
((tasks-add) (apply tasks:add dbstruct params))
((tasks-set-state-given-param-key) (apply tasks:set-state-given-param-key dbstruct params))
((tasks-get-last) (apply tasks:get-last dbstruct params))
;; NO SYNC DB
((no-sync-set) (apply db:no-sync-set *no-sync-db* params))
((no-sync-get/default) (apply db:no-sync-get/default *no-sync-db* params))
((no-sync-del!) (apply db:no-sync-del! *no-sync-db* params))
((no-sync-get-lock) (apply db:no-sync-get-lock *no-sync-db* params))
((no-sync-set) (apply db:no-sync-set (db:no-sync-db *no-sync-db*) params))
((no-sync-get/default) (apply db:no-sync-get/default (db:no-sync-db *no-sync-db*) params))
((no-sync-del!) (apply db:no-sync-del! (db:no-sync-db *no-sync-db*) params))
((no-sync-get-lock) (apply db:no-sync-get-lock (db:no-sync-db *no-sync-db*) params))
;; ARCHIVES
;; ((archive-get-allocations)
((archive-register-disk) (apply db:archive-register-disk dbstruct params))
((archive-register-block-name)(apply db:archive-register-block-name dbstruct params))
;; ((archive-allocate-testsuite/area-to-block)(apply db:archive-allocate-testsuite/area-to-block dbstruct block-id testsuite-name areakey))
|