23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
|
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
|
+
-
+
+
+
+
+
+
+
+
+
|
(declare (uses debugprint))
(declare (uses dbmod))
(declare (uses dbfile))
(declare (uses tcp-transportmod))
(declare (uses megatestmod))
(module apimod
(
*
*server-signature*
api:tcp-dispatch-request-make-handler-core
api:register-thread
api:unregister-thread
api:get-count-threads-alive
api:print-db-stats
api:queue-processor
api:dispatch-request
)
(import scheme chicken data-structures extras)
(import (prefix sqlite3 sqlite3:) posix matchable typed-records srfi-1 srfi-18 srfi-69 )
(import commonmod)
(import debugprint)
(import dbmod)
(import dbfile)
|
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
|
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
|
-
+
+
+
+
-
+
+
|
(set! *db-last-access* (current-seconds))
(match indat
((cmd run-id params meta)
(let* ((start-t (current-milliseconds))
;; factor this out and move before this let, it is just
;; an assert if not ping and dbfname is not correct
(db-ok (let* ((dbfname (dbmod:run-id->dbfname run-id))
(ok (equal? dbfname (dbr:dbstruct-dbfname dbstruct))))
(ok (equal? dbfname (dbr:dbstruct-dbfname dbstruct)))
(message ""))
(case cmd
((ping) #t) ;; we are fine
(else
(begin
(set! message (conc "tcp request handler: dbstruct database file " (dbr:dbstruct-dbfname dbstruct) " not aligned with run-id " run-id))
(assert ok "FATAL: database file and run-id not aligned.")))))
(assert ok message)))))
)
(ttdat *server-info*)
(server-state (tt-state ttdat))
(status 'ok) ;; anything legit we can do with status?
(delay-wait 0)
(result (if (eq? cmd 'ping)
*server-signature* ;; (current-process-id) ;; process id or server-signature?
(outer-proc cmd run-id params)))
|