78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
|
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
|
-
+
|
;; Given a run id start a server process ### NOTE ### > file 2>&1
;; if the run-id is zero and the target-host is set
;; try running on that host
;;
(define (server:run run-id)
(let* ((target-host (configf:lookup *configdat* "server" "homehost" ))
(cmdln (conc (if (getenv "MT_MEGATEST") (getenv "MT_MEGATEST") "megatest")
(cmdln (conc (common:get-megatest-exe)
" -server - -run-id " run-id " >> " *toppath* "/db/" run-id ".log 2>&1 &")))
(debug:print 0 "INFO: Starting server (" cmdln ") as none running ...")
(push-directory *toppath*)
(if target-host
(begin
(set-environment-variable "TARGETHOST" target-host)
(system (conc "nbfake " cmdln)))
|
125
126
127
128
129
130
131
|
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
|
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(if res
res
(begin
(open-run-close tasks:server-force-clean-running-records-for-run-id tasks:open-db run-id
" server:check-if-running")
res)))
#f)))
(define (server:ping-server run-id iface port)
(with-input-from-pipe
(conc (common:get-megatest-exe) " -run-id " run-id " -ping " (conc iface ":" port))
(lambda ()
(let loop ((inl (read-line))
(res "NOREPLY"))
(if (eof-object? inl)
(case (string->symbol res)
((NOREPLY) #f)
((LOGIN_OK) #t)
(else #f))
(loop (read-line) inl))))))
|