253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
|
(hash-table-set! *api-exec-ht* '(iface . port) res)
res))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; this client-side procedure makes rpc call to server and returns result
;;
(define (rpc-transport:client-api-send-receive run-id serverdat cmd params #!key (numretries 3))
(if (not (vector? serverdat))
(begin
(BB> "WHAT?? for run-id="run-id", serverdat="serverdat)
(print-call-chain)
(exit 1)))
(let* ((iface (rpc-transport:server-dat-get-iface serverdat))
(port (rpc-transport:server-dat-get-port serverdat))
(res #f)
(api-exec (rpc-transport:get-api-exec iface port))
(send-receive (lambda ()
(tcp-buffer-size 0)
(set! res (retry-thunk
(lambda ()
(condition-case
;;(vector #t (run-remote cmd params))
(vector 'success (api-exec cmd params))
[x (exn i/o net) (vector 'comms-fail (conc "communications fail ["(->string x)"]") x)]
[x () (vector 'other-fail "other fail ["(->string x)"]" x)]))
chatty: #f
accept-result?: (lambda(x)
(and (vector? x) (vector-ref x 0)))
retries: 4
back-off-factor: 1.5
random-wait: 0.2
retry-delay: 0.1
final-failure-returns-actual: #t))
res
))
(th1 (make-thread send-receive "send-receive"))
(time-out-reached #f)
(time-out (lambda ()
(thread-sleep! 45)
(set! time-out-reached #t)
(thread-terminate! th1)
#f))
(th2 (make-thread time-out "time out")))
(thread-start! th1)
(thread-start! th2)
(thread-join! th1)
(thread-terminate! th2)
(debug:print-info 11 *default-log-port* "got res=" res)
(if (vector? res)
(case (vector-ref res 0)
((success) (vector #t (vector-ref res 1)))
((comms-fail)
(debug:print 0 *default-log-port* "WARNING: comms failure for rpc request")
;;(debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
|
>
|
>
>
|
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
|
(hash-table-set! *api-exec-ht* '(iface . port) res)
res))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; this client-side procedure makes rpc call to server and returns result
;;
(define (rpc-transport:client-api-send-receive run-id serverdat cmd params #!key (numretries 3))
(BB> "entered nsport:client-api-send-receive with run-id="run-id " serverdat="serverdat" cmd="cmd" params="params" numretries="numretries)
(if (not (vector? serverdat))
(begin
(BB> "WHAT?? for run-id="run-id", serverdat="serverdat)
(print-call-chain)
(exit 1)))
(let* ((iface (rpc-transport:server-dat-get-iface serverdat))
(port (rpc-transport:server-dat-get-port serverdat))
(res #f)
(api-exec (rpc-transport:get-api-exec iface port))
(send-receive (lambda ()
(tcp-buffer-size 0)
(set! res (retry-thunk
(lambda ()
(condition-case
;;(vector #t (run-remote cmd params))
(vector 'success (api-exec cmd params))
[x (exn i/o net) (vector 'comms-fail (conc "communications fail ["(->string x)"]") x)]
[x () (vector 'other-fail "other fail ["(->string x)"]" x)]))
chatty: #t
accept-result?: (lambda(x)
(and (vector? x) (vector-ref x 0)))
retries: 4
back-off-factor: 1.5
random-wait: 0.2
retry-delay: 0.1
final-failure-returns-actual: #t))
(BB> "HEY res="res)
res
))
(th1 (make-thread send-receive "send-receive"))
(time-out-reached #f)
(time-out (lambda ()
(thread-sleep! 45)
(set! time-out-reached #t)
(thread-terminate! th1)
#f))
(th2 (make-thread time-out "time out")))
(thread-start! th1)
(thread-start! th2)
(thread-join! th1)
(thread-terminate! th2)
(BB> "alt got res="res)
(debug:print-info 11 *default-log-port* "got res=" res)
(if (vector? res)
(case (vector-ref res 0)
((success) (vector #t (vector-ref res 1)))
((comms-fail)
(debug:print 0 *default-log-port* "WARNING: comms failure for rpc request")
;;(debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
|
583
584
585
586
587
588
589
590
591
|
(tasks:bb-server-force-clean-run-record run-id iface port
" rpc-transport:client-setup (server-dat = #t)")
(if (> remtries 2)
(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: (sub1 remtries))
" rpc-transport:client-setup (server-dat = #t)"))))
|
|
<
|
586
587
588
589
590
591
592
593
|
(tasks:bb-server-force-clean-run-record run-id iface port
" rpc-transport:client-setup (server-dat = #t)")
(if (> remtries 2)
(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: (sub1 remtries))))))
|