218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
|
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
|
-
+
|
(lambda (a b)
(let* ((load-a (tt:get-server-threads a))
(load-b (tt:get-server-threads b)))
(< load-a load-b))))))))
;; (let ((indx (max (random (- (length sdats) 1)) 0)))
;; (list-ref sdats indx)))))
(debug:print-info 1 *default-log-port* "found sdat " sdat" from sdats: "sdats)
;; (debug:print-info 1 *default-log-port* "found sdat " sdat" from sdats: "sdats)
(match sdat
((host port start-time server-id pid dbfname2 servinffile)
(assert (equal? dbfname dbfname2) "FATAL: read server info from wrong file.")
(debug:print-info 2 *default-log-port* "no conn - in match servinffile:" servinffile)
(let* ((host-port (conc host":"port))
(conn (make-tt-conn
host: host
|
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
|
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
|
-
-
-
-
+
+
+
+
|
(define (tt:save-server-meta host port meta)
(hash-table-set! *server-load* (conc host":"port) (cons meta (current-seconds))))
(define (tt:get-server-threads dat)
(let* ((host (car dat))
(port (cadr dat))
(dat (tt:get-server-meta host port #t))
(meta (if dat (car dat) #f)))
(if (list? meta)
(or (alist-ref 'sload meta) 99998)
(dat (tt:get-server-meta host port #t)))
;; (debug:print 0 *default-log-port* "host: "host" port: "port" dat: "dat)
(if (list? dat)
(or (alist-ref 'sload dat) 99998)
99999))) ;; absurd number means don't use this one
;; lazy get, does not auto-refresh meta, this might be a problem
;;
(define (tt:get-server-meta host port #!optional (do-ping #f))
(let* ((get-meta (lambda ()
(let* ((dat (hash-table-ref/default *server-load* (conc host":"port) #f)))
|
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
|
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
|
-
-
-
-
-
-
+
+
+
+
+
+
+
+
|
(if ttdat ;; if no server yet just pass on through
(let* ((dbfname (dbmod:run-id->dbfname run-id))
(get-lowest-thread-load
(lambda ()
(let* ((sdats (tt:get-server-info-sorted ttdat dbfname)))
(car (map tt:get-server-threads sdats))))))
(if ttdat
(let loop ()
(if (> (get-lowest-thread-load) 5) ;; load is pretty high
(begin
(debug:print 0 *default-log-port* "Servers appear overloaded, waiting...")
(thread-sleep! 1)
(loop))))
(let loop ((count 0))
(let* ((lowestload (get-lowest-thread-load)))
(if (> lowestload 5) ;; load is pretty high
(begin
(debug:print 0 *default-log-port* "Servers appear overloaded with "lowestload" threads, waiting...")
(thread-sleep! 1)
(if (< count 10)
(loop (+ count 1)))))))
(debug:print 0 *default-log-port* "Can't wait on server load, *ttdat* not set")))))
(define (tt:ping host port server-id #!optional (tries-left 5))
(let* ((res (tt:send-receive-direct host port `(ping #f #f #f) ping-mode: #t)) ;; please send me your server-id
(try-again (lambda ()
(if (> tries-left 0)
(begin
|