44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
|
ok))
(define (client:connect iface port)
(case (server:get-transport)
((rpc) (rpc:client-connect iface port))
((http) (http:client-connect iface port))
((zmq) (zmq:client-connect iface port))
(else (rpc:client-connect iface port))))
(define (client:setup run-id #!key (remaining-tries 10) (failed-connects 0))
(case (server:get-transport)
((rpc) (rpc-transport:client-setup run-id remaining-tries: remaining-tries failed-connects: failed-connects)) ;;(client:setup-rpc run-id))
((http)(client:setup-http run-id remaining-tries: remaining-tries failed-connects: failed-connects))
(else (rpc-transport:client-setup run-id remaining-tries: remaining-tries failed-connects: failed-connects)))) ;; (client:setup-rpc run-id))))
;; (define (client:login-no-auto-setup server-info run-id)
;; (case (server:get-transport)
;; ((rpc) (rpc:login-no-auto-client-setup server-info run-id))
;; ((http) (rmt:login-no-auto-client-setup server-info run-id))
;; (else (rpc:login-no-auto-client-setup server-info run-id))))
;;
|
|
>
>
|
>
>
>
>
|
|
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
69
70
|
ok))
(define (client:connect iface port)
(case (server:get-transport)
((rpc) (rpc:client-connect iface port))
((http) (http:client-connect iface port))
((zmq) (zmq:client-connect iface port))
(else
(debug:print 0 *default-log-port* "ERROR: transport " (remote-transport *runremote*) " not supported (5)")
(exit))))
(define (client:setup run-id #!key (remaining-tries 10) (failed-connects 0))
(case (server:get-transport)
((rpc) (let ((res (client:setup-rpc run-id remaining-tries: remaining-tries)))
(remote-conndat-set! *runremote* res)
res))
((http)(client:setup-http run-id remaining-tries: remaining-tries failed-connects: failed-connects))
(else
(debug:print 0 *default-log-port* "ERROR: transport " (remote-transport *runremote*) " not supported (6)")
(exit)))) ;; (client:setup-rpc run-id))))
;; (define (client:login-no-auto-setup server-info run-id)
;; (case (server:get-transport)
;; ((rpc) (rpc:login-no-auto-client-setup server-info run-id))
;; ((http) (rmt:login-no-auto-client-setup server-info run-id))
;; (else (rpc:login-no-auto-client-setup server-info run-id))))
;;
|
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
|
;; 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-http run-id #!key (remaining-tries 10) (failed-connects 0))
(debug:print-info 2 *default-log-port* "client:setup remaining-tries=" remaining-tries)
(let* ((tdbdat (tasks:open-db)))
(if (<= remaining-tries 0)
(begin
(debug:print-error 0 *default-log-port* "failed to start or connect to server for run-id " run-id)
(exit 1))
(let* ((server-dat (tasks:get-server (db:delay-if-busy tdbdat) run-id)))
(debug:print-info 4 *default-log-port* "client:setup server-dat=" server-dat ", remaining-tries=" remaining-tries)
(if server-dat
(let* ((iface (tasks:hostinfo-get-interface server-dat))
(hostname (tasks:hostinfo-get-hostname server-dat))
(port (tasks:hostinfo-get-port server-dat))
(start-res (case *transport-type*
((http)(http-transport:client-connect iface port))
;;((nmsg)(nmsg-transport:client-connect hostname port))
))
(ping-res (case *transport-type*
((http)(rmt:login-no-auto-client-setup start-res))
;; ((nmsg)(let ((logininfo (rmt:login-no-auto-client-setup start-res run-id)))
;; (if logininfo
;; (car (vector-ref logininfo 1))
;; #f)))
)))
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
<
|
<
<
<
|
<
<
<
<
<
<
|
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
|
;; 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-rpc run-id #!key (remaining-tries 10) (failed-connects 0))
(debug:print-info 2 *default-log-port* "client:setup-rpc remaining-tries=" remaining-tries)
(let* ((server-dat (tasks:get-server (db:delay-if-busy (tasks:open-db)) run-id))
(num-available (tasks:num-in-available-state (db:delay-if-busy (tasks:open-db)) run-id)))
(cond
((<= remaining-tries 0)
(debug:print-error 0 *default-log-port* "failed to start or connect to server for run-id " run-id)
(exit 1))
(server-dat
(debug:print-info 4 *default-log-port* "client:setup-rpc server-dat=" server-dat ", remaining-tries=" remaining-tries)
(rpc-transport:client-setup run-id server-dat remaining-tries: remaining-tries))
(else
(if (< num-available 2)
(server:try-running run-id))
(thread-sleep! (+ 2 (random (- 20 remaining-tries)))) ;; give server a little time to start up, randomize a little to avoid start storms.
(client:setup run-id remaining-tries: (- remaining-tries 1))))))
(define (client:setup-http run-id #!key (remaining-tries 10) (failed-connects 0))
(debug:print-info 2 *default-log-port* "client:setup remaining-tries=" remaining-tries)
(let* ((tdbdat (tasks:open-db)))
(if (<= remaining-tries 0)
(begin
(debug:print-error 0 *default-log-port* "failed to start or connect to server for run-id " run-id)
(exit 1))
(let* ((server-dat (tasks:get-server (db:delay-if-busy tdbdat) run-id)))
(debug:print-info 4 *default-log-port* "client:setup server-dat=" server-dat ", remaining-tries=" remaining-tries)
(if server-dat
(let* ((iface (tasks:hostinfo-get-interface server-dat))
(hostname (tasks:hostinfo-get-hostname server-dat))
(port (tasks:hostinfo-get-port server-dat))
(start-res (http-transport:client-connect iface port))
(ping-res (rmt:login-no-auto-client-setup start-res)))
(if (and start-res
ping-res)
(begin
(remote-conndat-set! *runremote* start-res) ;; (hash-table-set! *runremote* run-id start-res)
(debug:print-info 2 *default-log-port* "connected to " (http-transport:server-dat-make-url start-res))
start-res)
(begin ;; login failed but have a server record, clean out the record and try again
|
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
|
(let ((num-available (tasks:num-in-available-state (db:dbdat-get-db tdbdat) run-id)))
(debug:print-info 0 *default-log-port* "client:setup, no server registered, remaining-tries=" remaining-tries " num-available=" num-available)
(if (< num-available 2)
(server:try-running run-id))
(thread-sleep! (+ 5 (random (- 20 remaining-tries)))) ;; give server a little time to start up, randomize a little to avoid start storms.
(client:setup run-id remaining-tries: (- remaining-tries 1)))))))))
;; keep this as a function to ease future
(define (client:start run-id server-info)
(http-transport:client-connect (tasks:hostinfo-get-interface server-info)
(tasks:hostinfo-get-port server-info)))
;; ;; client:signal-handler
;; (define (client:signal-handler signum)
;; (signal-mask! signum)
|
|
|
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
|
(let ((num-available (tasks:num-in-available-state (db:dbdat-get-db tdbdat) run-id)))
(debug:print-info 0 *default-log-port* "client:setup, no server registered, remaining-tries=" remaining-tries " num-available=" num-available)
(if (< num-available 2)
(server:try-running run-id))
(thread-sleep! (+ 5 (random (- 20 remaining-tries)))) ;; give server a little time to start up, randomize a little to avoid start storms.
(client:setup run-id remaining-tries: (- remaining-tries 1)))))))))
;; keep this as a function to ease future ;; this is unused, not porting for rpc -BB
(define (client:start run-id server-info)
(http-transport:client-connect (tasks:hostinfo-get-interface server-info)
(tasks:hostinfo-get-port server-info)))
;; ;; client:signal-handler
;; (define (client:signal-handler signum)
;; (signal-mask! signum)
|