50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
|
(set! *last-db-access* (current-seconds)) ;; bump *last-db-access*; this will renew keep-running thread's lease on life for another (server:get-timeout) seconds
;;(BB> "in api-exec; last-db-access updated to "*last-db-access*)
(mutex-unlock! *heartbeat-mutex*)
res))
;; (handle-exceptions
;; exn
;; (begin
;; (debug:print 0 *default-log-port* "Remote failed for " proc " " params " exn="exn)
;; (apply (eval (string->symbol procstr)) params))
;; ;; (if *runremote*
;; ;; (apply (eval (string->symbol (conc "remote:" procstr))) params)
;; (apply (eval (string->symbol procstr)) params)))
|
<
<
<
<
<
<
<
<
<
|
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
(set! *last-db-access* (current-seconds)) ;; bump *last-db-access*; this will renew keep-running thread's lease on life for another (server:get-timeout) seconds
;;(BB> "in api-exec; last-db-access updated to "*last-db-access*)
(mutex-unlock! *heartbeat-mutex*)
res))
;; retry an operation (depends on srfi-18)
;; ==================
;; idea here is to avoid spending time on coding retrying something. Trying to be generic here.
;;
;; Exception handling:
;; -------------------
;; if evaluating the thunk results in exception, it will be retried.
|
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
|
#t)
(begin
(BB> "Self test fail. login-res="login-res" testing-res="testing-res" *toppath*="*toppath*)
#f))
res))
(define (rpc-transport:client-setup run-id server-dat #!key (remtries 10))
;;(BB> "entered rpc-transport:client-setup with run-id="run-id" and server-dat="server-dat" and retries="remtries)
(tcp-buffer-size 0)
(debug:print-info 0 *default-log-port* "rpc-transport:client-setup run-id="run-id" server-dat=" server-dat ", remaining-tries=" remtries)
(let* ((iface (tasks:hostinfo-get-interface server-dat))
(hostname (tasks:hostinfo-get-hostname server-dat))
(port (tasks:hostinfo-get-port server-dat))
(runremote-server-dat (vector iface port #f #f #f (current-seconds) 'rpc)) ;; http version := (vector iface port api-uri api-url api-req (current-seconds) 'http )
(ping-res (retry-thunk (lambda () ;; make 3 attempts to ping.
((rpc:procedure 'server:login iface port) *toppath*))
chatty: #f
retries: 3)))
;; we got here from rmt:get-connection-info on the condition that *runremote* has no entry for run-id...
(if ping-res
(begin
(debug:print-info 0 *default-log-port* "rpc-transport:client-setup CONNECTION ESTABLISHED run-id="run-id" server-dat=" server-dat)
(rmt:set-cinfo run-id runremote-server-dat) ;; (hash-table-set! *runremote* run-id runremote-server-dat) ;; side-effect - *runremote* cache init fpr rmt:*
(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))))))
|
|
|
|
<
|
|
|
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
|
#t)
(begin
(BB> "Self test fail. login-res="login-res" testing-res="testing-res" *toppath*="*toppath*)
#f))
res))
(define (rpc-transport:client-setup run-id server-dat #!key (remaining-tries 10))
;;(BB> "entered rpc-transport:client-setup with run-id="run-id" and server-dat="server-dat" and retries="remaining-tries)
(tcp-buffer-size 0)
(debug:print-info 0 *default-log-port* "rpc-transport:client-setup run-id="run-id" server-dat=" server-dat ", remaining-tries=" remaining-tries)
(let* ((iface (tasks:hostinfo-get-interface server-dat))
(hostname (tasks:hostinfo-get-hostname server-dat))
(port (tasks:hostinfo-get-port server-dat))
(runremote-server-dat (vector iface port #f #f #f (current-seconds) 'rpc)) ;; http version := (vector iface port api-uri api-url api-req (current-seconds) 'http )
(ping-res (retry-thunk (lambda () ;; make 3 attempts to ping.
((rpc:procedure 'server:login iface port) *toppath*))
chatty: #f
retries: 3)))
;; we got here from rmt:get-connection-info on the condition that *runremote* has no entry for run-id...
(if ping-res
(begin
(debug:print-info 0 *default-log-port* "rpc-transport:client-setup CONNECTION ESTABLISHED run-id="run-id" server-dat=" server-dat)
runremote-server-dat)
(begin ;; login failed but have a server record, clean out the record and try again
(debug:print-info 0 *default-log-port* "rpc-transport:client-setup UNABLE TO CONNECT run-id="run-id" server-dat=" server-dat)
(tasks:kill-server-run-id run-id)
(tasks:server-force-clean-run-record (db:delay-if-busy (tasks:open-db)) run-id iface port
" rpc-transport:client-setup (server-dat = #t)")
(if (> remaining-tries 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 remaining-tries))))))
|