Overview
| Comment: | Merged fix for server gating |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.65 | v1.6578 |
| Files: | files | file ages | folders |
| SHA1: |
a1ae1509c19f0967227fdc36aee4addd |
| User & Date: | mrwellan on 2020-11-25 12:57:36 |
| Other Links: | branch diff | manifest | tags |
Context
|
2020-11-25
| ||
| 14:12 | Merged the reload configs feature for Robert check-in: 3436dd042e user: mrwellan tags: v1.65 | |
| 12:57 | Merged fix for server gating check-in: a1ae1509c1 user: mrwellan tags: v1.65, v1.6578 | |
| 12:00 | Fixed issues in server gating code Leaf check-in: 063273e8cb user: mrwellan tags: v1.6569-server-gate-fix | |
|
2020-11-24
| ||
| 21:21 | Added dep for whodunit. check-in: cd7bf0e858 user: mrwellan tags: v1.65 | |
Changes
Modified server.scm from [ddd07fa32f] to [8697088094].
| ︙ | ︙ | |||
320 321 322 323 324 325 326 327 328 329 |
(let ((sig (server:mk-signature)))
(set! *my-client-signature* sig)
*my-client-signature*)))
;; wait for server=start-last to be three seconds old
;;
(define (server:wait-for-server-start-last-flag areapath)
(let* ((start-flag (conc areapath "/logs/server-start-last"))
;;; THIS INTERACTS WITH [server] timeout. Suggest using 0.1 or above for timeout (6 seconds)
(reftime (configf:lookup-number *configdat* "server" "idletime" default: 4))
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > > > > > > > > < < | < < | < | 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 |
(let ((sig (server:mk-signature)))
(set! *my-client-signature* sig)
*my-client-signature*)))
;; wait for server=start-last to be three seconds old
;;
(define (server:wait-for-server-start-last-flag areapath)
(let* ((flag-dir (conc areapath "/logs"))
(start-flag (conc flag-dir "/server-start-last"))
;;; THIS INTERACTS WITH [server] timeout. Suggest using 0.1 or above for timeout (6 seconds)
(reftime (configf:lookup-number *configdat* "server" "idletime" default: 4))
(server-key (conc (get-host-name) "-" (current-process-id)))
(create-key-file (lambda ()
(with-output-to-file start-flag
(lambda ()
(print server-key)))))
(check-key-file (lambda ()
(let ((res (with-input-from-file start-flag
(lambda ()
(read-line)))))
(equal? server-key res))))
(get-file-age (lambda ()
(let* ((fmodtime (file-modification-time start-flag)))
(- (current-seconds) fmodtime)))))
(if (not (directory-exists? flag-dir))
(begin
(debug:print-info 0 *default-log-port* "Directory " flag-dir " does not exist! Cannot gate.")
#f)
(if (file-exists? start-flag)
(if (check-key-file) ;; is it me?
#t ;; yes, it is me, proceed
(let* ((file-age (get-file-age)))
(if (> file-age reftime) ;; let the previous guy have at least 4 seconds to do their thing
(begin ;; file is old enough, we can try to take it
(create-key-file) ;; take the file and try again
(server:wait-for-server-start-last-flag areapath))
(let* ((remtime (max 1 (min file-age reftime))))
(debug:print-info 0 *default-log-port* "Gating server start, waiting remtime="remtime)
(thread-sleep! remtime)
(server:wait-for-server-start-last-flag areapath)))))
(begin
(create-key-file)
(server:wait-for-server-start-last-flag areapath))))))
;; wait for server=start-last to be three seconds old
;;
(define (server:wait-for-server-start-last-flag-old areapath)
(let* ((start-flag (conc areapath "/logs/server-start-last"))
;;; THIS INTERACTS WITH [server] timeout. Suggest using 0.1 or above for timeout (6 seconds)
(reftime (configf:lookup-number *configdat* "server" "idletime" default: 4))
(server-key (conc (get-host-name) "-" (current-process-id)))
(create-key-file (lambda ()
(with-output-to-file start-flag
(lambda ()
(print server-key)))))
(check-key-file (lambda ()
(let ((res (with-input-from-file start-flag
(lambda ()
(read-line)))))
(equal? server-key res)))))
;; (thread-sleep! (/ (random 500) 1000)) ;; I don't think this made a difference
(if (file-exists? start-flag)
(let* ((fmodtime (file-modification-time start-flag))
(delta (- (current-seconds) fmodtime))
(all-go (> delta reftime)))
(if (and all-go
(begin
(create-key-file)
(thread-sleep! 0.25)
(check-key-file)))
#t ;; (system (conc "touch " start-flag)) ;; lazy but safe
(begin
(debug:print-info 0 *default-log-port* "Gating server start, last start: "
fmodtime ", delta: " delta ", reftime: " reftime ", all-go=" all-go)
(thread-sleep! reftime)
(server:wait-for-server-start-last-flag areapath)))))))
|
| ︙ | ︙ |