Overview
| Comment: | wip (still broke) |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.81-multi-server |
| Files: | files | file ages | folders |
| SHA1: |
00c25a6b539a7ef3fa67469e2ce9cffc |
| User & Date: | matt on 2024-07-08 06:01:01 |
| Other Links: | branch diff | manifest | tags |
Context
|
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 | |
| 03:00 | Getting close on gating runs from starting new tests on server load high. check-in: 6a90d15b55 user: matt tags: v1.81-multi-server | |
Changes
Modified tcp-transportmod.scm from [494ffa0754] to [571bf1ec6b].
| ︙ | ︙ | |||
294 295 296 297 298 299 300 | (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)) | | | | > | | | | | | | | | | | | | | 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 |
(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)
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)))
(if dat (car dat) #f))))
(meta (get-meta)))
(if (and (not meta)
do-ping)
(begin
(tt:timed-ping host port #f)
(get-meta))
meta)))
(define (tt:wait-on-server-load run-id ttdat)
(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))))
(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
(thread-sleep! 1)
|
| ︙ | ︙ |