Megatest

Diff
Login

Differences From Artifact [7ef7342bb9]:

To Artifact [c71df3eef9]:


49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
;; There are two scenarios. 
;;   1. We are a test manager and we received *transport-type* and *runremote* via cmdline
;;   2. We are a run tests, list runs or other interactive process and we must figure out
;;      *transport-type* and *runremote* from the monitor.db
;;
;; client:setup
;;
;; lookup_server, 
;;
(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))))







|







49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
;; There are two scenarios. 
;;   1. We are a test manager and we received *transport-type* and *runremote* via cmdline
;;   2. We are a run tests, list runs or other interactive process and we must figure out
;;      *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))))
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
		  (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) ""))



		(case *transport-type* 
		  ;; ((fs)(if (not *megatest-db*)(set! *megatest-db* (open-db))))
		  ((http)
		   ;; this saves the hostinfo in the *runremote* hash and returns it
		   (http-transport:client-connect run-id 
						  (tasks:hostinfo-get-interface hostinfo)
						  (tasks:hostinfo-get-port hostinfo)))
		  ((zmq)
		   (zmq-transport:client-connect (tasks:hostinfo-get-interface hostinfo)
						 (tasks:hostinfo-get-port      hostinfo)
						 (tasks:hostinfo-get-pubport   hostinfo)))
		  (else  ;; default to fs
		   (debug:print 0 "ERROR: unrecognised transport type " *transport-type* " exiting now.")
		   (exit)))))))))
    ;;	  (pop-directory)))

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







>
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<







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
		  (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 server-info)))))))

(define (client:start run-id transport 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)))
    ((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 ()