79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
|
get-run-info
get-run-status
get-run-state
get-run-stats
get-run-times
get-targets
get-target
;; register-run
|
<
|
79
80
81
82
83
84
85
86
87
88
89
90
91
92
|
get-run-info
get-run-status
get-run-state
get-run-stats
get-run-times
get-targets
get-target
get-tests-tags
get-test-times
get-tests-for-run
get-tests-for-run-state-status
get-test-id
get-tests-for-runs-mindata
get-tests-for-run-mindata
|
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
|
;; MISC
((get-latest-host-load) (apply db:get-latest-host-load dbstruct params))
((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 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))
|
|
|
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
|
;; MISC
((get-latest-host-load) (apply db:get-latest-host-load dbstruct params))
((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))
|
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
|
;; 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
)
(debug:print 0 *default-log-port* "cmd:" cmd " with params " params ", key " key)
(case cmd-in
((ping) #t)
;; ((quit) (exit))
(else
(if (equal? key *my-signature*) ;; TODO - get real key involved
(begin
(set! *api-process-request-count* (+ *api-process-request-count* 1))
(let* ((res (api:execute-requests dbstruct cmd params)))
(debug:print 0 *default-log-port* "res:" res)
#;(if (not success)
(debug:print 0 *default-log-port* "ERROR: success flag is #f for " cmd " with params " params))
(if (> *api-process-request-count* *max-api-process-requests*)
(set! *max-api-process-requests* *api-process-request-count*))
(set! *api-process-request-count* (- *api-process-request-count* 1))
#;(sexpr->string res)
res))
(begin
(debug:print 0 *default-log-port* "Server refused to process request. Sever id mismatch. recived " key " expected: " *my-signature* ".\nOther arguments recived: cmd=" cmd " params = " params)
(conc "Server refused to process request server signature mismatch: " key ", " *my-signature*)))))))
)
|
>
|
|
|
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
|
;; 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))
(case cmd-in
((ping) #t)
;; ((quit) (exit))
(else
(if (equal? key *my-signature*) ;; TODO - get real key involved
(begin
(set! *api-process-request-count* (+ *api-process-request-count* 1))
(let* ((res (api:execute-requests dbstruct cmd params)))
(if doprint (debug:print 0 *default-log-port* "res:" res))
#;(if (not success)
(debug:print 0 *default-log-port* "ERROR: success flag is #f for " cmd " with params " params))
(if (> *api-process-request-count* *max-api-process-requests*)
(set! *max-api-process-requests* *api-process-request-count*))
(set! *api-process-request-count* (- *api-process-request-count* 1))
#;(sexpr->string res)
res))
(begin
(debug:print 0 *default-log-port* "Server refused to process request. Sever id mismatch. recived " key " expected: " *my-signature* ".\nOther arguments recived: cmd=" cmd " params = " params)
(conc "Server refused to process request server signature mismatch: " key ", " *my-signature*)))))))
)
|