96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
(thread #f)
(host-port #f)
(cmd-thread #f)
(ro-mode #f)
(ro-mode-checked #f)
(last-access (current-seconds))
(servinf-file #f)
)
(define (tt:make-remote areapath)
(make-tt areapath: areapath))
;; do all the busy work of finding and setting up conn for
;; connecting to a server
|
>
|
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
|
(thread #f)
(host-port #f)
(cmd-thread #f)
(ro-mode #f)
(ro-mode-checked #f)
(last-access (current-seconds))
(servinf-file #f)
(last-serv-start 0)
)
(define (tt:make-remote areapath)
(make-tt areapath: areapath))
;; do all the busy work of finding and setting up conn for
;; connecting to a server
|
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
server-id: server-id
server-start: start-time
pid: pid)))
(hash-table-set! (tt-conns ttdat) dbfname conn)
;; verify we can talk to this server
(if (tt:ping host port server-id)
conn
(begin
;; rm the (last server) would go here
(server-start-proc)
(thread-sleep! 1)
(tt:client-connect-to-server ttdat dbfname run-id testsuite)))))
(else
(debug:print-info 0 *default-log-port* "Number of records did not match expected. Bad server info?")
(server-start-proc)
(thread-sleep! 1)
(tt:client-connect-to-server ttdat dbfname run-id testsuite)))))))
(define (tt:ping host port server-id)
(let* ((res (tt:send-receive-direct host port `(ping #f #f #f)))) ;; please send me your server-id
;;
|
>
>
>
|
|
|
|
>
|
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
|
server-id: server-id
server-start: start-time
pid: pid)))
(hash-table-set! (tt-conns ttdat) dbfname conn)
;; verify we can talk to this server
(if (tt:ping host port server-id)
conn
(let* ((curr-secs (current-seconds)))
;; rm the (last server) would go here
(if (> (- curr-secs (tt-last-serv-start ttdat)) 30)
(begin
(tt-last-serv-start-set! ttdat curr-secs)
(server-start-proc))) ;; don't try and start server unless 30 sec has gone by since last attempt
(thread-sleep! 1)
(tt:client-connect-to-server ttdat dbfname run-id testsuite)))))
(else
(debug:print-info 0 *default-log-port* "No server found. Starting one for run-id "run-id" in dbfile "dbfname)
(tt-last-serv-start-set! ttdat (current-seconds))
(server-start-proc)
(thread-sleep! 1)
(tt:client-connect-to-server ttdat dbfname run-id testsuite)))))))
(define (tt:ping host port server-id)
(let* ((res (tt:send-receive-direct host port `(ping #f #f #f)))) ;; please send me your server-id
;;
|
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
|
(debug:print 0 *default-log-port* "WARNING: server is loaded, will try again in a second.")
(thread-sleep! 1)
(tt:handler ttdat cmd run-id params attemptnum area-dat areapath readonly-mode dbfname testsuite mtexe))
(else
result)))
(else
(if (not res)
(begin ;; server likely died
(hash-table-set! (tt-conns ttdat) dbfname #f)
(debug:print 0 *default-log-port* "INFO: connection to server broken, reconnecting.")
(tt:handler ttdat cmd run-id params attemptnum area-dat areapath readonly-mode dbfname testsuite mtexe))
(assert #f "FATAL: tt:handler received bad data "res)))))
(begin
(thread-sleep! 1) ;; give it a rest and try again
(tt:handler ttdat cmd run-id params attemptnum area-dat areapath readonly-mode dbfname testsuite mtexe)))))
|
|
|
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
|
(debug:print 0 *default-log-port* "WARNING: server is loaded, will try again in a second.")
(thread-sleep! 1)
(tt:handler ttdat cmd run-id params attemptnum area-dat areapath readonly-mode dbfname testsuite mtexe))
(else
result)))
(else
(if (not res)
(begin ;; let* ((srvfile (tt-conn-servinf-file ))) ;; server likely died
(hash-table-set! (tt-conns ttdat) dbfname #f)
(debug:print 0 *default-log-port* "INFO: connection to server broken, reconnecting.")
(tt:handler ttdat cmd run-id params attemptnum area-dat areapath readonly-mode dbfname testsuite mtexe))
(assert #f "FATAL: tt:handler received bad data "res)))))
(begin
(thread-sleep! 1) ;; give it a rest and try again
(tt:handler ttdat cmd run-id params attemptnum area-dat areapath readonly-mode dbfname testsuite mtexe)))))
|