| ︙ | | |
28
29
30
31
32
33
34
35
36
37
38
39
40
41
|
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
|
+
+
+
+
+
+
+
|
(import commonmod)
(declare (uses apimod))
(import apimod)
(declare (uses rmtmod))
(import rmtmod)
;; should not be here
(declare (uses dbmod))
(import dbmod)
(declare (uses configfmod))
(import configfmod)
(include "common_records.scm")
;; (declare (uses rmtmod))
;; (import rmtmod)
;;
|
| ︙ | | |
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
|
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
-
-
|
#f)))
(if cinfo
cinfo
(if (server:check-if-running areapath)
(client:setup areapath)
#f))))
(define *send-receive-mutex* (make-mutex)) ;; should have separate mutex per run-id
|
| ︙ | | |
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
|
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
|
-
+
|
(cons 'none 0))
(loop (car tal)(cdr tal) newmax-cmd currmax)))))))
(mutex-unlock! *db-stats-mutex*)
res))
(define (rmt:open-qry-close-locally cmd run-id params #!key (remretries 5))
(let* ((qry-is-write (not (member cmd api:read-only-queries)))
(db-file-path (db:dbfile-path)) ;; 0))
(db-file-path (common:get-db-tmp-area)) ;; db:dbfile-path)) ;; 0))
(dbstruct-local (db:setup #t)) ;; make-dbr:dbstruct path: dbdir local: #t)))
(read-only (not (file-write-access? db-file-path)))
(start (current-milliseconds))
(resdat (if (not (and read-only qry-is-write))
(let ((v (api:execute-requests dbstruct-local (vector (symbol->string cmd) params))))
(handle-exceptions ;; there has been a long history of receiving strange errors from values returned by the client when things go wrong..
exn ;; This is an attempt to detect that situation and recover gracefully
|
| ︙ | | |
457
458
459
460
461
462
463
464
465
466
467
468
469
470
|
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
|
+
|
(rmt:send-receive 'start-server 0 (list run-id)))
;;======================================================================
;; M I S C
;;======================================================================
(define (rmt:login run-id)
(assert *my-client-signature* "ERROR: login attempted without first calling (client:get-signature).")
(rmt:send-receive 'login run-id (list *toppath* megatest-version *my-client-signature*)))
;; This login does no retries under the hood - it acts a bit like a ping.
;; Deprecated for nmsg-transport.
;;
(define (rmt:login-no-auto-client-setup connection-info)
(case *transport-type* ;; run-id of 0 is just a placeholder
|
| ︙ | | |
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
|
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
|
-
+
+
|
(rmt:send-receive 'update-run-event_time #f (list run-id)))
(define (rmt:get-runs-by-patt keys runnamepatt targpatt offset limit fields last-runs-update #!key (sort-order "asc")) ;; fields of #f uses default
(rmt:send-receive 'get-runs-by-patt #f (list keys runnamepatt targpatt offset limit fields last-runs-update sort-order)))
(define (rmt:find-and-mark-incomplete run-id ovr-deadtime)
;; (if (rmt:send-receive 'have-incompletes? run-id (list run-id ovr-deadtime))
(rmt:send-receive 'mark-incomplete run-id (list run-id ovr-deadtime))) ;; )
(rmt:send-receive 'mark-incomplete run-id (list run-id ovr-deadtime))
) ;; )
(define (rmt:get-main-run-stats run-id)
(rmt:send-receive 'get-main-run-stats #f (list run-id)))
(define (rmt:get-var varname)
(rmt:send-receive 'get-var #f (list varname)))
|
| ︙ | | |
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
|
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
|
+
-
-
+
+
|
;;======================================================================
;; T E S T D A T A
;;======================================================================
(define (rmt:read-test-data run-id test-id categorypatt #!key (work-area #f))
(rmt:send-receive 'read-test-data run-id (list run-id test-id categorypatt)))
(define (rmt:read-test-data* run-id test-id categorypatt varpatt #!key (work-area #f))
(rmt:send-receive 'read-test-data* run-id (list run-id test-id categorypatt varpatt)))
(define (rmt:read-test-data-varpatt run-id test-id categorypatt varpatt #!key (work-area #f))
(rmt:send-receive 'read-test-data-varpatt run-id (list run-id test-id categorypatt varpatt)))
(define (rmt:get-data-info-by-id test-data-id)
(rmt:send-receive 'get-data-info-by-id #f (list test-data-id)))
(define (rmt:testmeta-add-record testname)
(rmt:send-receive 'testmeta-add-record #f (list testname)))
|
| ︙ | | |