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
428
|
(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, overwrite it. Otherwise loop recursively until it is old enough.
(all-go (> delta idletime))
(old-server-key (with-input-from-file start-flag (lambda () (read-line))))
)
;; write a new start-flag file, wait 0.25s, then if the previous 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 all-go
(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 ;; (system (conc "touch " start-flag)) ;; lazy but safe
;; If either of the above conditions are 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 all-go "server key does not match" "too soon to start another server"))
(debug:print-info 0 *default-log-port* "server keys: from file: " old-server-key " needed: " server-key)
(thread-sleep! idletime)
(server:wait-for-server-start-last-flag areapath)))))))
;; kind start up of servers, 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: 15)
(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.")
|
|
>
>
>
|
<
|
|
|
<
<
|
<
<
<
>
|
|
<
>
>
|
|
|
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.")
|