58
59
60
61
62
63
64
65
66
67
68
69
70
71
|
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
+
+
+
+
+
|
)
(define (server:make-server-url hostport)
(if (not hostport)
#f
(conc "http://" (car hostport) ":" (cadr hostport))))
(define (make-and-init-remote)
(make-remote hh-dat: (common:get-homehost)
server-info: (if *toppath* (server:check-if-running *toppath*) #f)
server-timeout: (server:expiration-timeout)))
;;======================================================================
;; logic for getting homehost. Returns (host . at-home)
;; IF *toppath* is not set, wait up to five seconds trying every two seconds
;; (this is to accomodate the watchdog)
;;
(define (common:get-homehost #!key (trynum 5))
(assert *toppath* "ERROR: common:get-homehost called before launch:setup. This is fatal.")
|
289
290
291
292
293
294
295
296
297
298
|
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
#t ;; (system (conc "touch " start-flag)) ;; lazy but safe
(begin
(debug:print-info 0 *default-log-port* "Gating server start, last start: "
fmodtime ", delta: " delta ", reftime: " reftime ", all-go=" all-go)
(thread-sleep! reftime)
(server:wait-for-server-start-last-flag areapath)))))))
;; this one seems to be the general entry point
;;
(define (server:start-and-wait areapath #!key (timeout 60))
(let ((give-up-time (+ (current-seconds) timeout)))
(let loop ((server-info (server:check-if-running areapath))
(try-num 0))
(if (or server-info
(> (current-seconds) give-up-time)) ;; server-url will be #f if no server available.
(server:record->url server-info)
(let ((num-ok (length (server:get-best (server:get-list areapath)))))
(if (and (> try-num 0) ;; first time through simply wait a little while then try again
(< num-ok 1)) ;; if there are no decent candidates for servers then try starting a new one
(server:kind-run areapath))
(thread-sleep! 5)
(loop (server:check-if-running areapath)
(+ try-num 1)))))))
)
|