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
|
;; try running on that host
;; incidental: rotate logs in logs/ dir.
;;
(define (server:run areapath) ;; areapath is ignored for now.
(let* ((curr-host (get-host-name))
(curr-ip (server:get-best-guess-address curr-host))
(curr-pid (current-process-id))
(target-host (configf:lookup *configdat* "server" "homehost" ))
(testsuite (common:get-testsuite-name))
(logfile (conc *toppath* "/logs/server-" curr-pid ".log"))
(cmdln (conc (common:get-megatest-exe)
" -server " (or target-host "-") " -run-id " 0 (if (equal? (configf:lookup *configdat* "server" "daemonize") "yes")
(conc " -daemonize -log " logfile)
"")
" -m testsuite:" testsuite)) ;; (conc " >> " logfile " 2>&1 &")))))
(log-rotate (make-thread common:rotate-logs "server run, rotate logs thread")))
;; we want the remote server to start in *toppath* so push there
(push-directory *toppath*)
(debug:print 0 *default-log-port* "INFO: Starting server (" cmdln ") as none running ...")
(thread-start! log-rotate)
;; host.domain.tld match host?
(if (and target-host
;; look at target host, is it host.domain.tld or ip address and does it
;; match current ip or hostname
(not (string-match (conc "("curr-host "|" curr-host"\\..*)") target-host))
|
|
>
|
|
|
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
131
|
;; try running on that host
;; incidental: rotate logs in logs/ dir.
;;
(define (server:run areapath) ;; areapath is ignored for now.
(let* ((curr-host (get-host-name))
(curr-ip (server:get-best-guess-address curr-host))
(curr-pid (current-process-id))
(homehost (common:get-homehost)) ;; configf:lookup *configdat* "server" "homehost" ))
(target-host (car homehost))
(testsuite (common:get-testsuite-name))
(logfile (conc *toppath* "/logs/server.log"))
(cmdln (conc (common:get-megatest-exe)
" -server " (or target-host "-") " -run-id " 0 (if (equal? (configf:lookup *configdat* "server" "daemonize") "yes")
(conc " -daemonize -log " logfile)
"")
" -m testsuite:" testsuite)) ;; (conc " >> " logfile " 2>&1 &")))))
(log-rotate (make-thread common:rotate-logs "server run, rotate logs thread")))
;; we want the remote server to start in *toppath* so push there
(push-directory *toppath*)
(debug:print 0 *default-log-port* "INFO: Trying to start server (" cmdln ") ...")
(thread-start! log-rotate)
;; host.domain.tld match host?
(if (and target-host
;; look at target host, is it host.domain.tld or ip address and does it
;; match current ip or hostname
(not (string-match (conc "("curr-host "|" curr-host"\\..*)") target-host))
|
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
|
(> (- (current-seconds) last-run-time) 30))
(begin
(server:run areapath)
(hash-table-set! *server-kind-run* areapath (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:read-dotserver areapath)
(let ((dotfile (conc areapath "/.server")))
(if (and (file-exists? dotfile)
(file-read-access? dotfile))
(with-input-from-file
dotfile
(lambda ()
|
|
|
|
|
>
>
>
>
>
>
>
>
|
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
|
(> (- (current-seconds) last-run-time) 30))
(begin
(server:run areapath)
(hash-table-set! *server-kind-run* areapath (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:try-running server:run) ;; there is no more per-run servers ;; REMOVE ME. BUG.
(define (server:start-attempted? areapath)
(let ((flagfile (conc areapath "/.starting-server")))
(and (file-exists? flagfile)
(< (- (current-seconds)
(file-modification-time flagfile))
15)))) ;; exists and less than 15 seconds old
(define (server:read-dotserver areapath)
(let ((dotfile (conc areapath "/.server")))
(if (and (file-exists? dotfile)
(file-read-access? dotfile))
(with-input-from-file
dotfile
(lambda ()
|