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
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
|
)
(defstruct rmt:conn
(apath #f)
(dbname #f)
(fullname #f)
(hostport #f)
(lastmsg 0)
(expires 0))
;; replaces *runremote*
(define *rmt:remote* (make-rmt:remote))
;; set up the api proc, seems like there should be a better place for this?
(api-proc api:process-request)
;; do we have a connection to apath dbname and
;; is it not expired? then return it
;;
;; else setup a connection
;;
;; if that fails, return '(#f "some reason") ;; NB// convert to raising an exception
;;
(define (rmt:get-connection remote apath dbname)
(let* ((fullname (db:dbname->path apath dbname))
(conn (hash-table-ref/default (rmt:remote-conns remote) fullname #f)))
(if (and conn
(> (current-seconds) (rmt:conn-expires conn)))
conn
#f)))
(define (rmt:find-main-server apath dbname)
(let* ((pktsdir (get-pkts-dir apath))
(all-srvpkts (get-all-server-pkts pktsdir *srvpktspec*))
(dbpath (conc apath "/" dbname))
(viable-srvs (get-viable-servers all-srvpkts dbpath)))
(get-the-server viable-srvs)))
;; looks for a connection to main
;; connections for other servers happens by requesting from main
;;
(define (rmt:open-main-connection remote apath)
(let* ((dbname (db:run-id->dbname #f))
(the-srv (rmt:find-main-server apath dbname))
(start-main-srv (lambda ()
;; srv not ready, delay a little and try again
(system (conc "nbfake megatest -server - -area "apath
" -db "dbname))
(thread-sleep! 1.5)
(rmt:open-main-connection remote apath) ;; TODO: Add limit to number of tries
)))
(if the-srv ;; yes, we have a server, now try connecting to it
(let* ((srv-addr (server-address the-srv))
(ipaddr (alist-ref 'ipaddr the-srv))
(port (alist-ref 'port the-srv))
(fullpath (db:dbname->path apath dbname))
(srvready (server-ready? ipaddr port fullpath)))
(if srvready
(begin
(hash-table-set! (rmt:remote-conns remote)
fullpath
(make-rmt:conn
apath: apath
dbname: dbname
fullname: fullpath
hostport: srv-addr
lastmsg: (current-seconds)
expires: (+ (current-seconds) 60) ;; this needs to be gathered during the ping
))
#t)
(start-main-srv)))
(start-main-srv))))
|
>
>
>
|
|
|
|
|
>
>
>
|
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
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
|
)
(defstruct rmt:conn
(apath #f)
(dbname #f)
(fullname #f)
(hostport #f)
(ipaddr #f)
(port #f)
(srvpkt #f)
(lastmsg 0)
(expires 0))
;; replaces *runremote*
(define *rmt:remote* (make-rmt:remote))
;; set up the api proc, seems like there should be a better place for this?
(api-proc api:process-request)
;; do we have a connection to apath dbname and
;; is it not expired? then return it
;;
;; else setup a connection
;;
;; if that fails, return '(#f "some reason") ;; NB// convert to raising an exception
;;
(define (rmt:get-connection remote apath dbname)
(let* ((fullname (db:dbname->path apath dbname)) ;; we'll switch to full name later
(conn (hash-table-ref/default (rmt:remote-conns remote) dbname #f)))
(if (and conn
(< (current-seconds) (rmt:conn-expires conn)))
conn
#f)))
(define (rmt:find-main-server apath dbname)
(let* ((pktsdir (get-pkts-dir apath))
(all-srvpkts (get-all-server-pkts pktsdir *srvpktspec*))
(dbpath (conc apath "/" dbname))
(viable-srvs (get-viable-servers all-srvpkts dbpath)))
(get-the-server viable-srvs)))
;; looks for a connection to main
;; connections for other servers happens by requesting from main
;;
(define (rmt:open-main-connection remote apath)
(let* ((dbname (db:run-id->dbname #f))
(the-srv (rmt:find-main-server apath dbname))
(start-main-srv (lambda ()
;; srv not ready, delay a little and try again
(system (conc "nbfake megatest -server - -area "apath
" -db "dbname))
(thread-sleep! 2)
(rmt:open-main-connection remote apath) ;; TODO: Add limit to number of tries
)))
(if the-srv ;; yes, we have a server, now try connecting to it
(let* ((srv-addr (server-address the-srv))
(ipaddr (alist-ref 'ipaddr the-srv))
(port (alist-ref 'port the-srv))
(fullpath (db:dbname->path apath dbname))
(srvready (server-ready? ipaddr port fullpath)))
(if srvready
(begin
(hash-table-set! (rmt:remote-conns remote)
dbname ;; fullpath ;; yes, I'd prefer it to be fullpath - FIXME later
(make-rmt:conn
apath: apath
dbname: dbname
fullname: fullpath
hostport: srv-addr
ipaddr: ipaddr
port: port
srvpkt: the-srv
lastmsg: (current-seconds)
expires: (+ (current-seconds) 60) ;; this needs to be gathered during the ping
))
#t)
(start-main-srv)))
(start-main-srv))))
|