106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
|
;;
(define (server:run run-id area-dat)
(let* ((configdat (megatest:area-configdat area-dat))
(toppath (megatest:area-path area-dat))
(curr-host (get-host-name))
(curr-ip (server:get-best-guess-address curr-host))
(target-host (configf:lookup configdat "server" "homehost" ))
(testsuite (common:get-testsuite-name))
(logfile (conc toppath "/logs/" run-id ".log"))
(cmdln (conc (common:get-megatest-exe)
" -server " (or target-host "-") " -run-id " run-id (if (equal? (configf:lookup configdat "server" "daemonize") "yes")
(conc " -daemonize -log " logfile)
"")
" -debug 4 testsuite:" testsuite))) ;; (conc " >> " logfile " 2>&1 &")))))
(debug:print 0 "INFO: Starting server (" cmdln ") as none running ...")
|
|
|
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
|
;;
(define (server:run run-id area-dat)
(let* ((configdat (megatest:area-configdat area-dat))
(toppath (megatest:area-path area-dat))
(curr-host (get-host-name))
(curr-ip (server:get-best-guess-address curr-host))
(target-host (configf:lookup configdat "server" "homehost" ))
(testsuite (common:get-testsuite-name area-dat))
(logfile (conc toppath "/logs/" run-id ".log"))
(cmdln (conc (common:get-megatest-exe)
" -server " (or target-host "-") " -run-id " run-id (if (equal? (configf:lookup configdat "server" "daemonize") "yes")
(conc " -daemonize -log " logfile)
"")
" -debug 4 testsuite:" testsuite))) ;; (conc " >> " logfile " 2>&1 &")))))
(debug:print 0 "INFO: Starting server (" cmdln ") as none running ...")
|
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
|
(if *my-client-signature* *my-client-signature*
(let ((sig (server:mk-signature)))
(set! *my-client-signature* sig)
*my-client-signature*)))
;; kind start up of servers, wait 40 seconds before allowing another server for a given
;; run-id to be launched
(define (server:kind-run run-id)
(let ((last-run-time (hash-table-ref/default *server-kind-run* run-id #f)))
(if (or (not last-run-time)
(> (- (current-seconds) last-run-time) 30))
(begin
(server:run run-id)
(hash-table-set! *server-kind-run* run-id (current-seconds))))))
;; The generic run a server command. Dispatches the call to server 0 if run-id != 0
;;
(define (server:try-running run-id)
(if (eq? run-id 0)
(server:run run-id)
(rmt:start-server run-id)))
(define (server:check-if-running run-id)
(let ((tdbdat (tasks:open-db)))
(let loop ((server (tasks:get-server (db:delay-if-busy tdbdat) run-id))
(trycount 0))
(if server
|
|
|
|
|
|
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
|
(if *my-client-signature* *my-client-signature*
(let ((sig (server:mk-signature)))
(set! *my-client-signature* sig)
*my-client-signature*)))
;; kind start up of servers, wait 40 seconds before allowing another server for a given
;; run-id to be launched
(define (server:kind-run run-id area-dat)
(let ((last-run-time (hash-table-ref/default *server-kind-run* run-id #f)))
(if (or (not last-run-time)
(> (- (current-seconds) last-run-time) 30))
(begin
(server:run run-id area-dat)
(hash-table-set! *server-kind-run* run-id (current-seconds))))))
;; The generic run a server command. Dispatches the call to server 0 if run-id != 0
;;
(define (server:try-running run-id area-dat)
(if (eq? run-id 0)
(server:run run-id area-dat)
(rmt:start-server run-id)))
(define (server:check-if-running run-id)
(let ((tdbdat (tasks:open-db)))
(let loop ((server (tasks:get-server (db:delay-if-busy tdbdat) run-id))
(trycount 0))
(if server
|