Megatest

Diff
Login

Differences From Artifact [e114506d72]:

To Artifact [e69c41a548]:


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
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))
	 (conn     (hash-table-ref/default (rmt:remote-conns remote) fullname #f)))
  (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)))
	     (< (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)
			   (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)
				 fullpath
				 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))))