65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
|
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
|
-
+
|
;; (define (client:setup-rpc run-id)
;; (debug:print 0 *default-log-port* "INFO: client:setup remaining-tries=" remaining-tries)
;; (if (<= remaining-tries 0)
;; (begin
;; (debug:print 0 *default-log-port* "ERROR: failed to start or connect to server for run-id " run-id)
;; (exit 1))
;; (let ((host-info (hash-table-ref/default *runremote* run-id #f)))
;; (debug:print-info 0 #f "client:setup host-info=" host-info ", remaining-tries=" remaining-tries)
;; (debug:print-info 0 *default-log-port* "client:setup host-info=" host-info ", remaining-tries=" remaining-tries)
;; (if host-info
;; (let* ((iface (car host-info))
;; (port (cadr host-info))
;; (start-res (client:connect iface port))
;; ;; (ping-res (server:ping-server run-id iface port))
;; (ping-res (client:login-no-auto-setup start-res run-id)))
;; (if ping-res ;; sucessful login?
|
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
-
+
|
;; (client:setup run-id remaining-tries: 10)) ;; (- remaining-tries 1)))
;; (begin
;; (debug:print 25 *default-log-port* "INFO: client:setup failed to connect, start-res=" start-res ", run-id=" run-id ", host-info=" host-info)
;; (thread-sleep! 5)
;; (client:setup run-id remaining-tries: (- remaining-tries 1))))))
;; ;; YUK: rename server-dat here
;; (let* ((server-dat (open-run-close tasks:get-server tasks:open-db run-id)))
;; (debug:print-info 0 #f "client:setup server-dat=" server-dat ", remaining-tries=" remaining-tries)
;; (debug:print-info 0 *default-log-port* "client:setup server-dat=" server-dat ", remaining-tries=" remaining-tries)
;; (if server-dat
;; (let* ((iface (tasks:hostinfo-get-interface server-dat))
;; (port (tasks:hostinfo-get-port server-dat))
;; (start-res (http-transport:client-connect iface port))
;; ;; (ping-res (server:ping-server run-id iface port))
;; (ping-res (rmt:login-no-auto-client-setup start-res run-id)))
;; (if start-res
|
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
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
|
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
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
|
-
+
-
+
-
+
-
+
-
+
|
;; *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 #f "client:setup remaining-tries=" remaining-tries)
(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 0 *default-log-port* "ERROR: 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 #f "client:setup server-dat=" server-dat ", remaining-tries=" remaining-tries)
(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 run-id))
((nmsg)(let ((logininfo (rmt:login-no-auto-client-setup start-res run-id)))
(if logininfo
(car (vector-ref logininfo 1))
#f))))))
(if (and start-res
ping-res)
(begin
(hash-table-set! *runremote* run-id start-res)
(debug:print-info 2 #f "connected to " (http-transport:server-dat-make-url 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
(debug:print-info 0 #f "client:setup, login failed, will attempt to start server ... start-res=" start-res ", run-id=" run-id ", server-dat=" server-dat)
(debug:print-info 0 *default-log-port* "client:setup, login failed, will attempt to start server ... start-res=" start-res ", run-id=" run-id ", server-dat=" server-dat)
(case *transport-type*
((http)(http-transport:close-connections run-id)))
(hash-table-delete! *runremote* run-id)
(tasks:kill-server-run-id run-id)
(tasks:server-force-clean-run-record (db:delay-if-busy tdbdat)
run-id
(tasks:hostinfo-get-interface server-dat)
(tasks:hostinfo-get-port server-dat)
" client:setup (server-dat = #t)")
(if (> remaining-tries 8)
(thread-sleep! (+ 1 (random 5))) ;; spread out the starts a little
(thread-sleep! (+ 15 (random 20)))) ;; it isn't going well. give it plenty of time
(server:try-running run-id)
(thread-sleep! 5) ;; give server a little time to start up
(client:setup run-id remaining-tries: (- remaining-tries 1))
)))
(begin ;; no server registered
(let ((num-available (tasks:num-in-available-state (db:dbdat-get-db tdbdat) run-id)))
(debug:print-info 0 #f "client:setup, no server registered, remaining-tries=" remaining-tries " num-available=" num-available)
(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)
|
237
238
239
240
241
242
243
244
245
246
247
248
|
237
238
239
240
241
242
243
244
245
246
247
248
|
-
+
|
;; ;; Need to set the signal handler somewhere other than here as this
;; ;; routine will go away.
;; ;;
;; (define (client:launch run-id)
;; (set-signal-handler! signal/int client:signal-handler)
;; (set-signal-handler! signal/term client:signal-handler)
;; (if (client:setup run-id)
;; (debug:print-info 2 #f "connected as client")
;; (debug:print-info 2 *default-log-port* "connected as client")
;; (begin
;; (debug:print 0 *default-log-port* "ERROR: Failed to connect as client")
;; (exit))))
;;
|