Megatest

Diff
Login

Differences From Artifact [52a055740a]:

To Artifact [20000f46f9]:


52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74

75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90

91
92

93
94
95
96
97
98
99




100
101
102
103
104
105
106
107
108
109
110
111
112
113
52
53
54
55
56
57
58











59

60
61

62



63
64
65
66
67
68
69
70
71
72
73


74
75

76







77
78
79
80







81
82
83
84
85
86
87







-
-
-
-
-
-
-
-
-
-
-

-


-
+
-
-
-











-
-
+

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







;;      *transport-type* and *runremote* from the monitor.db
;;
;; client:setup
;;
;; lookup_server, need to remove *runremote* stuff
;;
(define (client:setup run-id #!key (remaining-tries 3))
  (if (not *toppath*)
      (if (not (setup-for-run))
	  (begin
	    (debug:print 0 "ERROR: failed to find megatest.config, exiting")
	    (exit))))
  ;; (push-directory *toppath*) ;; This is probably NOT needed 
  ;; clients get the sdb:qry proc created here
  ;; (if (not sdb:qry)
  ;;     (begin
  ;;       (set! sdb:qry (make-sdb:qry (conc *toppath* "/db/strings.db"))) ;; we open the normalization helpers here
  ;;       (sdb:qry 'setup #f)))
  (let ((hostinfo (and run-id (hash-table-ref/default *runremote* run-id #f))))
    (debug:print-info 11 "for run-id=" run-id ", *transport-type* is " *transport-type*)
    (if hostinfo
	hostinfo ;; have hostinfo - just return it
	(let* ((hostinfo  (open-run-close tasks:get-server tasks:open-db run-id))
	(let* ((hostinfo  (open-run-close tasks:get-server tasks:open-db run-id)))
	       (transport (if hostinfo 
			      (string->symbol (tasks:hostinfo-get-transport hostinfo))
			      'http)))
	  (if (not hostinfo)
	      (if (> remaining-tries 0)
		  (begin
		    (server:ensure-running run-id)
		    (client:setup run-id remaining-tries: (- remaining-tries 1)))
		  (begin
		    (debug:print 0 "ERROR: Expected to be able to connect to a server by now. No server available for run-id = " run-id)
		    (exit 1)))
	      (begin
		(hash-table-set! *runremote* run-id hostinfo)
		(debug:print-info 11 "CLIENT SETUP, hostinfo=" hostinfo)
		(debug:print-info 11 "Using transport type of " transport (if hostinfo (conc " to connect to " hostinfo) ""))
		(client:start run-id transport hostinfo)))))))
		(client:start run-id hostinfo)))))))

(define (client:start run-id transport server-info)
(define (client:start run-id server-info)
  (case transport
    ;; ((fs)(if (not *megatest-db*)(set! *megatest-db* (open-db))))
    ((http)
     ;; this saves the server-info in the *runremote* hash and returns it
     (http-transport:client-connect run-id 
				    (tasks:hostinfo-get-interface server-info)
				    (tasks:hostinfo-get-port server-info)))
  ;; this saves the server-info in the *runremote* hash and returns it
  (http-transport:client-connect run-id 
				 (tasks:hostinfo-get-interface server-info)
				 (tasks:hostinfo-get-port server-info)))
    ((zmq)
     (zmq-transport:client-connect (tasks:hostinfo-get-interface server-info)
				   (tasks:hostinfo-get-port      server-info)
				   (tasks:hostinfo-get-pubport   server-info)))
    (else  ;; default to fs
     (debug:print 0 "ERROR: unrecognised transport type " transport )
     #f)))

;; client:signal-handler
(define (client:signal-handler signum)
  (handle-exceptions
   exn
   (debug:print " ... exiting ...")
   (let ((th1 (make-thread (lambda ()