Overview
| Comment: | Fixed issues in server gating code |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.6569-server-gate-fix |
| Files: | files | file ages | folders |
| SHA1: |
063273e8cbb9dd3246ca6455f957745c |
| User & Date: | mrwellan on 2020-11-25 12:00:38 |
| Other Links: | branch diff | manifest | tags |
Context
|
2020-11-25
| ||
| 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-09-18
| ||
| 17:30 | added check for file existence before file delete ==/14/1.9/WARN/orion,mars/== NOTE: This is the last v1.65 before the split off. I.e code from before this point IS in the far future v1.65 branch. Code from this point to that branch might NOT be in the branch. check-in: 2769e4b7c9 user: mmgraham tags: v1.65, v1.6569 | |
Changes
Modified server.scm from [7b2af2dc7e] to [cb47413a40].
| ︙ | |||
320 321 322 323 324 325 326 327 328 329 | 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 | + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + + + + + + + + + + - - - + - - - + - |
(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))
|
| ︙ |