| ︙ | | |
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
|
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
|
-
+
|
(server:wait-for-server-start-last-flag areapath)))))))
;; oldest server alive determines host then choose random of youngest
;; five servers on that host
;;
(define (server:get-servers-info areapath)
(assert *toppath* "FATAL: server:get-servers-info called before *toppath* has been set.")
(let* ((servinfodir (conc *toppath*"/.servinfo")))
(let* ((servinfodir (server:get-servinfo-dir areapath))) ;; (conc *toppath*"/.servinfo")))
(if (not (file-exists? servinfodir))
(create-directory servinfodir))
(let* ((allfiles (glob (conc servinfodir"/*")))
(res (make-hash-table)))
(for-each
(lambda (f)
(let* ((hostport (pathname-strip-directory f))
|
| ︙ | | |
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
|
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
|
-
+
|
;; or another host?
;;
;; returns #t => ok to start another server
;; #f => not ok to start another server
;;
(define (server:minimal-check areapath)
(server:clean-up-old areapath)
(let* ((srvdir (conc areapath"/.servinfo"))
(let* ((srvdir (server:get-servinfo-dir areapath)) ;; (conc areapath"/.servinfo"))
(servrs (glob (conc srvdir"/*")))
(thishostip (server:get-best-guess-address (get-host-name)))
(thisservrs (glob (conc srvdir"/"thishostip":*")))
(homehostinf (server:choose-server areapath 'homehost))
(havehome (car homehostinf))
(wearehome (cdr homehostinf)))
(debug:print-info 0 *default-log-port* thishostip", have homehost: "havehome", we are homehost: "wearehome
|
| ︙ | | |
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
|
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
|
+
+
+
+
+
+
-
+
|
#f)))
(begin
(server:run areapath)
(thread-sleep! 3)
(case mode
((homehost) (cons #f #f))
(else #f))))))
(define (server:get-servinfo-dir areapath)
(let* ((spath (conc areapath"/.servinfo")))
(if (not (file-exists? spath))
(create-directory spath #t))
spath))
(define (server:clean-up-old areapath)
;; any server file that has not been touched in ten minutes is effectively dead
(let* ((sfiles (glob (conc areapath"/.servinfo/*"))))
(let* ((sfiles (glob (conc (server:get-servinfo-dir areapath)"/*"))))
(for-each
(lambda (sfile)
(let* ((modtime (handle-exceptions
exn
(begin
(debug:print 0 *default-log-port* "WARNING: failed to get modification file for "sfile)
(current-seconds))
|
| ︙ | | |
551
552
553
554
555
556
557
558
559
560
561
562
563
564
|
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
|
+
+
+
+
+
+
|
;; 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)
(let loop ()
(if (> (alist-ref 'adj-proc-load (common:get-normalized-cpu-load #f)) 2)
(begin
(if (common:low-noise-print 30 "our-host-load")
(debug:print 0 *default-log-port* "WARNING: system load is high, waiting to start server."))
(loop))))
(if (< (server:choose-server areapath 'count) 20)
(server:run 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 2 *default-log-port* "server:kind-run: touching " start-flag)
|
| ︙ | | |