Overview
| Comment: | changed server start lock file expire-time from 15 to 25 seconds |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.65 | v1.6584 |
| Files: | files | file ages | folders |
| SHA1: |
169d94de4e37967aae42ad0f063f1de6 |
| User & Date: | mmgraham on 2021-03-25 17:35:14 |
| Other Links: | branch diff | manifest | tags |
Context
|
2021-04-06
| ||
| 13:30 | made the sourcing of cfg.sh not dependent on LD_LIBRARY_PATH being set check-in: 38a8d8c4ea user: mmgraham tags: v1.65 | |
|
2021-03-25
| ||
| 17:35 | changed server start lock file expire-time from 15 to 25 seconds check-in: 169d94de4e user: mmgraham tags: v1.65, v1.6584 | |
| 11:26 | Changed sleep in kind-run from 2 to 18 seconds to allow server to come up to the point where get-list will find it. Cleaned up messages and comments. check-in: 2f8513eec5 user: mmgraham tags: v1.65 | |
Changes
Modified server.scm from [c7b3629e26] to [bb2f7cfc15].
| ︙ | ︙ | |||
364 365 366 367 368 369 370 |
(define (server:get-client-signature) ;; BB> why is this proc named "get-"? it returns nothing -- set! has not return value.
(if *my-client-signature* *my-client-signature*
(let ((sig (server:mk-signature)))
(set! *my-client-signature* sig)
*my-client-signature*)))
| | > > > | < | | | < < | < < < > | | < > > | | | 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 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 |
(define (server:get-client-signature) ;; BB> why is this proc named "get-"? it returns nothing -- set! has not return value.
(if *my-client-signature* *my-client-signature*
(let ((sig (server:mk-signature)))
(set! *my-client-signature* sig)
*my-client-signature*)))
;; if server-start-last exists, and wasn't old enough, wait <idle time>, then call this function recursively until it is old enough.
;; if it is old enough, overwrite it and wait 0.25 seconds.
;; if it then has the wrong server key, wait <idle time> and call this function recursively.
;;
(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)
(idletime (configf:lookup-number *configdat* "server" "idletime" default: 4))
(server-key (conc (get-host-name) "-" (current-process-id))))
(if (file-exists? start-flag)
(let* ((fmodtime (file-modification-time start-flag))
(delta (- (current-seconds) fmodtime))
(old-enough (> delta idletime))
)
;; write start-flag file, wait 0.25s, then if previously the start-flag file was older than <idletime> seconds, and the new file still has the same server key as you just wrote, return #t.
;;
(if (and old-enough
(begin
(debug:print-info 0 *default-log-port* "Writing " start-flag)
(with-output-to-file start-flag (lambda () (print server-key)))
(thread-sleep! 0.25)
(let ((res (with-input-from-file start-flag (lambda () (read-line)))))
(equal? server-key res)))
)
#t
;; If either of the above conditions is not true, print a "Gating server start" message, wait <idle-time>, then call this function recursively.
(begin
(debug:print-info 0 *default-log-port* "Gating server start, last start: "
(seconds->time-string fmodtime) ", time since last start: " delta ", required idletime: " idletime ", gating reason:" (if old-enough "server key does not match" "too soon to start another server"))
(thread-sleep! idletime)
(server:wait-for-server-start-last-flag areapath)))))))
;; kind start up of server, wait before allowing another server for a given
;; area to be launched
;;
(define (server:kind-run areapath)
;; look for $MT_RUN_AREA_HOME/logs/server-start-last
;; and wait for it to be at least <server idletime> seconds old
(server:wait-for-server-start-last-flag areapath)
(if (not (server:check-if-running areapath)) ;; why try if there is already a server running?
(let* (
(lock-file (conc areapath "/logs/server-start.lock")))
(let* ((start-flag (conc areapath "/logs/server-start-last")))
(common:simple-file-lock-and-wait lock-file expire-time: 25)
(debug:print-info 0 *default-log-port* "server:kind-run: touching " start-flag)
(system (conc "touch " start-flag)) ;; lazy but safe
(server:run areapath)
(thread-sleep! 18) ;; don't release the lock for at least a few seconds. And allow time for the server startup to get to "SERVER STARTED".
(common:simple-file-release-lock lock-file)))
(debug:print-info 0 *default-log-port* "Found server already running. NOT trying to start another.")
|
| ︙ | ︙ |