40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
|
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
|
+
+
+
+
-
+
-
-
+
-
-
+
-
-
-
+
-
-
-
-
-
-
+
+
+
+
+
|
;; S E R V E R
;;======================================================================
;; Call this to start the actual server
;;
;; all routes though here end in exit ...
;;
;; start_server
;;
(define (server:launch transport run-id)
(let ((server-running (server:check-if-running run-id transport)))
(if (not *toppath*)
(if server-running
(if (not (setup-for-run))
(begin
(debug:print 0 "ERROR: cannot find megatest.config, exiting")
(exit))))
(debug:print-info 2 "Starting server using " transport " transport")
(set! *transport-type* transport)
(case transport
;; ((fs) (exit)) ;; there is no "fs" server transport
((fs http) (http-transport:launch run-id))
((zmq) (zmq-transport:launch run-id))
(else
(debug:print "WARNING: unrecognised transport " transport)
(exit))))
|
143
144
145
146
147
148
149
|
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
|
+
+
+
+
+
+
+
+
+
|
(thread-sleep! 4)))
(if (< trycount 10)
(loop (open-run-close tasks:get-server tasks:open-db run-id)
(+ trycount 1))
(debug:print 0 "WARNING: Couldn't start or find a server.")))
(debug:print 2 "INFO: Server(s) running " servers)
)))
(define (server:check-if-running run-id transport)
(let loop ((server (open-run-close tasks:get-server tasks:open-db run-id))
(trycount 0))
(if server
;; note: client:start will set *runremote*. this needs to be changed
;; also, client:start will login to the server, also need to change that.
(client:start run-id transport server)
#f)))
|