Overview
| Comment: | Implemented server thread count throttling of launches, miminally tested. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.81-multi-server |
| Files: | files | file ages | folders |
| SHA1: |
6fed2d60a68968459638abf3eabc40c8 |
| User & Date: | mrwellan on 2024-07-08 10:24:18 |
| Other Links: | branch diff | manifest | tags |
Context
|
2024-07-09
| ||
| 08:53 | Merged from v1.81 and fixed conflicts Leaf check-in: dbc22912d1 user: mrwellan tags: v1.81-multi-server | |
|
2024-07-08
| ||
| 10:24 | Implemented server thread count throttling of launches, miminally tested. check-in: 6fed2d60a6 user: mrwellan tags: v1.81-multi-server | |
| 06:01 | wip (still broke) check-in: 00c25a6b53 user: matt tags: v1.81-multi-server | |
Changes
Modified tcp-transportmod.scm from [571bf1ec6b] to [f03b836e05].
| ︙ | ︙ | |||
218 219 220 221 222 223 224 | (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))))) | | | 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)
(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 | (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)) | | | | | | 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)))
;; (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 |
(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
| | > | | | | > | | 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 ((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
|
| ︙ | ︙ |