237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
|
((ping) *server-signature*)
(else
(api:dispatch-request dbstruct cmd run-id params))))))
(set! *api-process-request-count* newcount)
(set! *db-last-access* (current-seconds))
(match indat
((cmd run-id params meta)
(let* ((ttdat *server-info*)
(server-state (tt-state ttdat))
(status (cond
;; ((> newcount 600) 'busy)
;; ((> newcount 300) 'loaded)
(else 'ok)))
(errmsg (case status
((busy) (conc "Server overloaded, "newcount" threads in flight"))
((loaded) (conc "Server loaded, "newcount" threads in flight"))
(else #f)))
(result (case status
((busy) (- newcount 29)) ;; call back in as many seconds
((loaded)
(normal-proc cmd run-id params))
(else
(normal-proc cmd run-id params))))
(meta (case cmd
((ping) `((sstate . ,server-state)))
(else `((wait . ,delay-wait)))))
(payload (list status errmsg result meta)))
(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
|
>
>
>
>
>
>
>
|
|
>
>
|
<
|
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
|
((ping) *server-signature*)
(else
(api:dispatch-request dbstruct cmd run-id params))))))
(set! *api-process-request-count* newcount)
(set! *db-last-access* (current-seconds))
(match indat
((cmd run-id params meta)
(let* ((db-ok (let* ((dbfname (dbmod:run-id->dbfname run-id))
(ok (equal? dbfname (dbr:dbstruct-dbfname dbstruct))))
(case cmd
((ping) #t) ;; we are fine
(else
(if (not ok)(debug:print 0 *default-log-port* "ERROR: "cmd", run-id "run-id", not correct for dbfname "(dbr:dbstruct-dbfname dbstruct)))
(assert ok "FATAL: database file and run-id not aligned.")))))
(ttdat *server-info*)
(server-state (tt-state ttdat))
(status (cond
;; ((> newcount 600) 'busy)
((> newcount 300) 'loaded)
(else 'ok)))
(errmsg (case status
((busy) (conc "Server overloaded, "newcount" threads in flight"))
((loaded) (conc "Server loaded, "newcount" threads in flight"))
(else #f)))
(result (case status
((busy) (- newcount 29)) ;; call back in as many seconds
((loaded)
(if (eq? (rmt:transport-mode) 'tcp)
(thread-sleep! 0.5))
(normal-proc cmd run-id params))
(else
(normal-proc cmd run-id params))))
(meta (case cmd
((ping) `((sstate . ,server-state)))
(else `((wait . ,delay-wait)))))
(payload (list status errmsg result meta)))
(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 (not *no-sync-db*)
(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
|