︙ | | | ︙ | |
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
|
(module apimod
(
api:run-server-process
api:start-server
api:dispatch-cmd
api:execute-requests
api:process-request
)
(import scheme
chicken.base
chicken.process-context.posix
chicken.string
chicken.time
|
|
|
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
|
(module apimod
(
api:run-server-process
api:start-server
api:dispatch-cmd
api:execute-requests
;; api:process-request
)
(import scheme
chicken.base
chicken.process-context.posix
chicken.string
chicken.time
|
︙ | | | ︙ | |
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
|
(logd (conc apath "/logs"))
(logf (conc logd "/server-launch-";;(current-process-id)
(seconds->year-work-week/day-time-fname (current-seconds))
"-"cleandbname".log"))
(logf2 (conc logd "/server-"
(seconds->year-work-week/day-time-fname (current-seconds))
"-"cleandbname"-"))
(cmd (conc "nbfake megatest -server - -area "apath
" -db "dbname" -autolog "logf2)))
(if (not (directory-exists? logd))
(create-directory logd #t))
(system (conc "NBFAKE_LOG="logf" "cmd))))
;; special function to get server
;; look up in db
;; if found -> return it
|
|
|
>
|
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
|
(logd (conc apath "/logs"))
(logf (conc logd "/server-launch-";;(current-process-id)
(seconds->year-work-week/day-time-fname (current-seconds))
"-"cleandbname".log"))
(logf2 (conc logd "/server-"
(seconds->year-work-week/day-time-fname (current-seconds))
"-"cleandbname"-"))
(cmd (conc "nbfake megatest -server - -area "apath" -db "dbname)
;; " -autolog "logf2 ;; the side log did not help. Ended up with two logs and the pid in the name was not that useful.
))
(if (not (directory-exists? logd))
(create-directory logd #t))
(system (conc "NBFAKE_LOG="logf" "cmd))))
;; special function to get server
;; look up in db
;; if found -> return it
|
︙ | | | ︙ | |
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
|
((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 run-id 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))
;; TASKS
((find-task-queue-records) (apply tasks:find-task-queue-records dbstruct params))
|
|
|
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
|
((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 run-id realparams)))
((sdb-qry) (apply sdb:qry params))
((ping) `(#t ,(current-process-id) ,(cadr params))) ;; (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))
;; TASKS
((find-task-queue-records) (apply tasks:find-task-queue-records dbstruct params))
|
︙ | | | ︙ | |
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
|
;; http-server send-response
;; api:process-request
;; db:*
;;
;; NB// Runs on the server as part of the server loop
;;
(define (api:process-request dbstruct indat) ;; the $ is the request vars proc
(let* ((cmd-in (alist-ref 'cmd indat)) ;; ($ 'cmd))
(cmd (if (string? cmd-in)(string->symbol cmd-in) cmd-in))
(params (alist-ref 'params indat))
(key (alist-ref 'key indat)) ;; TODO - add this back
;; (doprint (apply common:low-noise-print 10 params))
)
;; (if doprint (debug:print 0 *default-log-port* "cmd: " cmd " with params: " params ", key: " key))
|
|
|
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
|
;; http-server send-response
;; api:process-request
;; db:*
;;
;; NB// Runs on the server as part of the server loop
;;
#;(define (api:process-request dbstruct indat) ;; the $ is the request vars proc
(let* ((cmd-in (alist-ref 'cmd indat)) ;; ($ 'cmd))
(cmd (if (string? cmd-in)(string->symbol cmd-in) cmd-in))
(params (alist-ref 'params indat))
(key (alist-ref 'key indat)) ;; TODO - add this back
;; (doprint (apply common:low-noise-print 10 params))
)
;; (if doprint (debug:print 0 *default-log-port* "cmd: " cmd " with params: " params ", key: " key))
|
︙ | | | ︙ | |