59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
(debug:print 0 "INFO: client:setup remaining-tries=" remaining-tries)
(if (<= remaining-tries 0)
(begin
(debug:print 0 "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)))
(if host-info
(let ((start-res (http-transport:client-connect run-id ;; NB// confusion over host-info and connection result!
(car host-info)
(cadr host-info))))
(if start-res ;; sucessful login?
start-res
(if (member remaining-tries '(3 4 6))
(begin ;; login failed
(debug:print 25 "INFO: client:setup start-res=" start-res ", run-id=" run-id ", server-dat=" host-info)
(hash-table-delete! *runremote* run-id)
(open-run-close tasks:server-force-clean-run-record
tasks:open-db
run-id
(car host-info)
(cadr host-info)
" client:setup (host-info=#t)")
(thread-sleep! 5)
(client:setup run-id remaining-tries: 10)) ;; (- remaining-tries 1)))
(begin
(debug:print 25 "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)))
(if server-dat
(let ((start-res (http-transport:client-connect run-id
(tasks:hostinfo-get-interface server-dat)
(tasks:hostinfo-get-port server-dat))))
(if start-res
start-res
(if (member remaining-tries '(2 5))
(begin ;; login failed
(debug:print 25 "INFO: client:setup start-res=" start-res ", run-id=" run-id ", server-dat=" server-dat)
(hash-table-delete! *runremote* run-id)
(open-run-close tasks:server-force-clean-run-record
tasks:open-db
run-id
|
<
|
|
>
>
|
>
>
|
<
|
|
>
>
>
>
|
|
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
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
|
(debug:print 0 "INFO: client:setup remaining-tries=" remaining-tries)
(if (<= remaining-tries 0)
(begin
(debug:print 0 "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)))
(if host-info
(let* ((iface (car host-info))
(port (cadr host-info))
(start-res (http-transport:client-connect iface port))
(ping-res (server:ping-server run-id iface port)))
(if ping-res ;; sucessful login?
(begin
(hash-table-set! *runremote* run-id start-res)
start-res) ;; return the server info
(if (member remaining-tries '(3 4 6))
(begin ;; login failed
(debug:print 25 "INFO: client:setup start-res=" start-res ", run-id=" run-id ", server-dat=" host-info)
(hash-table-delete! *runremote* run-id)
(open-run-close tasks:server-force-clean-run-record
tasks:open-db
run-id
(car host-info)
(cadr host-info)
" client:setup (host-info=#t)")
(thread-sleep! 5)
(client:setup run-id remaining-tries: 10)) ;; (- remaining-tries 1)))
(begin
(debug:print 25 "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)))
(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)))
(if start-res
(begin
(hash-table-set! *runremote* run-id start-res)
start-res)
(if (member remaining-tries '(2 5))
(begin ;; login failed
(debug:print 25 "INFO: client:setup start-res=" start-res ", run-id=" run-id ", server-dat=" server-dat)
(hash-table-delete! *runremote* run-id)
(open-run-close tasks:server-force-clean-run-record
tasks:open-db
run-id
|
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
;; (open-run-close tasks:server-clean-out-old-records-for-run-id tasks:open-db run-id " client:setup (server-dat=#f)")
(server:try-running run-id)))
(thread-sleep! 10) ;; give server a little time to start up
(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 run-id
(tasks:hostinfo-get-interface server-info)
(tasks:hostinfo-get-port server-info)))
;; client:signal-handler
(define (client:signal-handler signum)
(handle-exceptions
exn
(debug:print " ... exiting ...")
|
|
<
|
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
|
;; (open-run-close tasks:server-clean-out-old-records-for-run-id tasks:open-db run-id " client:setup (server-dat=#f)")
(server:try-running run-id)))
(thread-sleep! 10) ;; give server a little time to start up
(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)
(handle-exceptions
exn
(debug:print " ... exiting ...")
|