109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
+
+
+
+
+
+
+
+
+
|
((rpc) (db:obj->string (vector success/fail query-sig result)))
((http) (db:obj->string (vector success/fail query-sig result)))
((fs) result)
(else
(debug:print-error 0 *default-log-port* "unrecognised transport type: " *transport-type*)
result)))
(define (server:what-type-of-invocation)
(cond
((args:get-arg "-run") "run")
((args:get-arg "-server") "server")
((args:get-arg "-execute") "execute")
((or (args:get-arg "-remove-runs")) "run-related")
((string-search (car (argv)) "dboard") "dboard")
(else (conc "other:"(string-intersperse (command-line-arguments) "_")))))
;; Given an area path, start a server process ### NOTE ### > file 2>&1
;; if the target-host is set
;; try running on that host
;; incidental: rotate logs in logs/ dir.
;;
(define (server:run areapath) ;; areapath is *toppath* for a given testsuite area
(let* ((curr-host (get-host-name))
|
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
|
-
+
|
(profile-mode (or (configf:lookup *configdat* "misc" "profilesw")
""))
(cmdln (conc (common:get-megatest-exe)
" -server " (or target-host "-") (if (equal? (configf:lookup *configdat* "server" "daemonize") "yes")
" -daemonize "
"")
;; " -log " logfile
" -m testsuite:" testsuite
" -m testsuite:"testsuite":"(server:what-type-of-invocation)
" " profile-mode
)) ;; (conc " >> " logfile " 2>&1 &")))))
(log-rotate (make-thread common:rotate-logs "server run, rotate logs thread")) ;; why are we rotating logs here? This is a sensitive location with a lot going on!?
(load-limit (configf:lookup-number *configdat* "jobtools" "max-server-start-load" default: 3.0)))
;; we want the remote server to start in *toppath* so push there
(push-directory areapath)
(debug:print 0 *default-log-port* "INFO: Trying to start server (" cmdln ") ...")
|