78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
(set! *ttdat* newremote)
newremote)))
;; NB// area-dat replaced by ttdat
;;
(define (rmt:send-receive cmd run-id params #!key (attemptnum 1)(ttdat #f))
(assert *toppath* "FATAL: rmt:send-receive called with *toppath* not set.")
(let* ((start-time (current-seconds)) ;; snapshot time so all use cases get same value
(areapath *toppath*);; TODO - resolve from dbstruct to be compatible with multiple areas
(attemptnum (+ 1 attemptnum))
(testsuite (common:get-testsuite-name))
(mtexe (common:find-local-megatest))
(dbfname (conc (dbfile:run-id->dbnum run-id)".db"))
(ttdat (rmt:set-ttdat areapath ttdat))
(conn (tt:get-conn ttdat dbfname))
(is-main (equal? dbfname "main.db")) ;; why not (not run-id) ?
(server-start-proc (if is-main
#f
(lambda ()
;; (debug:print-info 0 *default-log-port* "starting server for dbfname: "dbfname)
(rmt:start-server ;; tt:server-process-run
areapath
testsuite ;; (dbfile:testsuite-name)
mtexe
run-id)))))
;; here we look at ttdat, if dbfname is NOT main.db we check that a conn exists for it
;; and if there is no conn we first send a request to the main.db server to start a
;; server for the dbfname.
#;(if (and (not is-main)(not conn)) ;; no existing connection to non-main server, call in a start up request
(begin
(server-start-proc)
(thread-sleep! 1)))
(tt:handler ttdat cmd run-id params attemptnum readonly-mode dbfname testsuite mtexe server-start-proc)))
;; KEEP THIS HERE FOR A WHILE, WE MAY WANT TO RESURECT IT
;; (define (nfs-transport-handler runremote cmd run-id params attemptnum area-dat areapath readonly-mode testsuite mtexe)
;; (let* ((keys (common:get-fields *configdat*))
;; (dbstruct (dbmod:nfs-get-dbstruct run-id keys (dbfile:db-init-proc) areapath tmpadj: "/dashboard")))
;; (api:dispatch-request dbstruct cmd run-id params)))
|
<
|
<
|
>
>
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
>
>
>
<
|
|
|
|
|
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
(set! *ttdat* newremote)
newremote)))
;; NB// area-dat replaced by ttdat
;;
(define (rmt:send-receive cmd run-id params #!key (attemptnum 1)(ttdat #f))
(assert *toppath* "FATAL: rmt:send-receive called with *toppath* not set.")
(let* ((areapath *toppath*) ;; TODO - resolve from dbstruct to be compatible with multiple areas
(readonly-mode (rmtmod:calc-ro-mode ttdat *toppath*))
(testsuite (common:get-testsuite-name)))
(case (rmt:transport-mode)
((tcp)
(let* ((start-time (current-seconds)) ;; snapshot time so all use cases get same value
(attemptnum (+ 1 attemptnum))
(mtexe (common:find-local-megatest))
(dbfname (conc (dbfile:run-id->dbnum run-id)".db"))
(ttdat (rmt:set-ttdat areapath ttdat))
(conn (tt:get-conn ttdat dbfname))
(is-main (equal? dbfname "main.db")) ;; why not (not run-id) ?
(server-start-proc (if is-main
#f
(lambda ()
;; (debug:print-info 0 *default-log-port* "starting server for dbfname: "dbfname)
(rmt:start-server ;; tt:server-process-run
areapath
testsuite ;; (dbfile:testsuite-name)
mtexe
run-id)))))
;; here we look at ttdat, if dbfname is NOT main.db we check that a conn exists for it
;; and if there is no conn we first send a request to the main.db server to start a
;; server for the dbfname.
#;(if (and (not is-main)(not conn)) ;; no existing connection to non-main server, call in a start up request
(begin
(server-start-proc)
(thread-sleep! 1)))
(tt:handler ttdat cmd run-id params attemptnum readonly-mode dbfname testsuite mtexe server-start-proc)))
((nfs)
(nfs-transport-handler cmd run-id params attemptnum areapath readonly-mode testsuite))
(else
(debug:print-info 0 *default-log-port* "rmt:transport-mode is "(rmt:transport-mode))
(assert #f "FATAL: rmt:transport-mode set to invalid value.")))))
(define (nfs-transport-handler cmd run-id params attemptnum areapath readonly-mode testsuite)
(let* ((keys (common:get-fields *configdat*))
(dbstruct (dbmod:nfs-get-dbstruct run-id keys (dbfile:db-init-proc) areapath)))
(api:dispatch-request dbstruct cmd run-id params)))
(define (rmt:get-max-query-average run-id)
(mutex-lock! *db-stats-mutex*)
(let* ((runkey (conc "run-id=" run-id " "))
(cmds (filter (lambda (x)
(substring-index runkey x))
(hash-table-keys *db-stats*)))
|