Megatest

Diff
Login

Differences From Artifact [0823c889a2]:

To Artifact [75421bb641]:


28
29
30
31
32
33
34
35

36
37
38
39
40
41
42
43
44
45





46
47
48
49
50
51
52
28
29
30
31
32
33
34

35
36
37
38
39
40
41
42
43
44

45
46
47
48
49
50
51
52
53
54
55
56







-
+









-
+
+
+
+
+







  (if (null? hostport)
      #f
      (conc "tcp://" hostname ":" port)))

(define (server:run hostn)
  (debug:print 0 "Attempting to start the server ...")
  (let* ((hostport      (open-run-close tasks:get-best-server tasks:open-db)) ;; do whe already have a server running?
	 (host:port (server:mak-server-url hostport)))
	 (host:port (server:make-server-url hostport)))
    (if host:port 
	(begin
	  (debug:print 0 "NOTE: server already running.")
	  (if (server:client-setup)
	      (begin 
		(debug:print-info 0 "Server is alive, not starting another"))
	      (begin
		(debug:print-info 0 "Server is dead, removing, deregistering it and trying again")
		(open-run-close tasks:deregister tasks:open-db (car hostport) port: (cadr port))
		(server:run hostn))))
		;; (server:run hostn)
		(debug:print 0 "WOULD NORMALLY START ANOTHER SERVER HERE")
		)
	      )
	  )
	(let* ((zmq-socket     #f)
	       (hostname       (if (string=? "-" hostn)
				   (get-host-name) 
				   hostn))
	       (ipaddrstr      (let ((ipstr (if (string=? "-" hostn)
						(string-intersperse (map number->string (u8vector->list (hostname->ip hostname))) ".")
						#f)))
149
150
151
152
153
154
155

156
157
158
159
160
161
162








163
164
165
166
167
168
169
153
154
155
156
157
158
159
160







161
162
163
164
165
166
167
168
169
170
171
172
173
174
175







+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+







		   (set! *runremote* zmq-socket)
		   #t)
		 (begin
		   (debug:print-info 2 "Failed to login or connect to " hostinfo)
		   (set! *runremote* #f)
		   #f)))))
	(begin
	  (debug:print-info 0 "NO SERVER RUNNING! PLEASE START ONE! E.g. \"megatest -server - &\"")
	  (debug:print-info 2 "No server available, attempting to start one...")
	  (system (conc "megatest -server - " (if (args:get-arg "-debug")
						  (conc "-debug " (args:get-arg "-debug"))
						  "")
			" &"))
	  (sleep 5)
	  (server:client-setup)))))
	;;   (debug:print-info 2 "No server available, attempting to start one...")
	;;   (system (conc (car (argv)) " -server - " (if (args:get-arg "-debug")
	;; 					  (conc "-debug " (args:get-arg "-debug"))
	;; 					  "")
	;; 		" &"))
	  ;; (sleep 5)
	  ;; (server:client-setup)
	  ))))

(define (server:launch)
  (let* ((toppath (setup-for-run)))
    (debug:print-info 0 "Starting the standalone server")
    (if *toppath* 
	(let* ((th2 (make-thread (lambda ()
				   (server:run (args:get-arg "-server")))))