150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
|
(define *server-signature* #f)
;; 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
#;((> *api-process-request-count* 200) ;; 20)
(debug:print 0 *default-log-port* "WARNING: api:execute-requests received an overloaded message.")
(set! *server-overloaded* #t)
(vector #f (vector #f 'overloaded))) ;; the inner vector is what gets returned. nope, don't know why. please refactor!
|
<
<
<
<
<
<
<
<
<
<
<
<
|
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
|
(define *server-signature* #f)
;; 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)
(if (> *api-process-request-count* 200)
(begin
(if (common:low-noise-print 30 "too many threads")
(debug:print 0 *default-log-port* "WARNING: "*api-process-request-count*" threads, potential overload, adding 0.5 sec delay."))
(thread-sleep! 0.5) ;; take a nap
))
(cond
((not (vector? dat)) ;; it is an error to not receive a vector
(vector #f (vector #f "remote must be called with a vector")))
(else
(let* ((cmd-in (vector-ref dat 0))
(cmd (if (symbol? cmd-in)
cmd-in
(string->symbol cmd-in)))
(params (vector-ref dat 1))
(run-id (if (null? params)
|
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
|
(set! *api-process-request-count* (- *api-process-request-count* 1))
(serialize payload)))
(else
(assert #f "FATAL: failed to deserialize indat "indat))))))
(define (api:dispatch-request dbstruct cmd run-id params)
(db:open-no-sync-db)
(case cmd
;;===============================================
;; READ/WRITE QUERIES
;;===============================================
((get-keys-write) (db:get-keys dbstruct)) ;; force a dummy "write" query to force server; for debug in -repl
|
>
>
|
|
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
|
(set! *api-process-request-count* (- *api-process-request-count* 1))
(serialize payload)))
(else
(assert #f "FATAL: failed to deserialize indat "indat))))))
(define (api:dispatch-request dbstruct cmd run-id params)
(if (and (not *no-sync-db*)
(member cmd '(db:no-sync-set db:no-sync-get/default db:no-sync-del! db:no-sync-get-lock )))
(db:open-no-sync-db))
(case cmd
;;===============================================
;; READ/WRITE QUERIES
;;===============================================
((get-keys-write) (db:get-keys dbstruct)) ;; force a dummy "write" query to force server; for debug in -repl
|