Overview
Comment: | Don't start servers if not on the host selected for home or there are more than 20 servers running |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.80 |
Files: | files | file ages | folders |
SHA1: |
c1bbcec340f1588c77dd9d2a5ceca5e3 |
User & Date: | matt on 2022-12-10 21:42:37 |
Other Links: | branch diff | manifest | tags |
Context
2022-12-11
| ||
10:22 | Added periodic sync from mtrah area into tmp area to reduce chances of an issue from servers running from more than one host if NFS is super slow. check-in: e9d6ea9e8d user: matt tags: v1.80 | |
2022-12-10
| ||
21:42 | Don't start servers if not on the host selected for home or there are more than 20 servers running check-in: c1bbcec340 user: matt tags: v1.80 | |
2022-12-08
| ||
20:57 | Changed mt version to 1.8002. check-in: 1160944815 user: mmgraham tags: v1.80, v1.8002 | |
Changes
Modified dbfile.scm from [d6dced8a5a] to [13bb136850].
︙ | ︙ | |||
991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 | (define dbfile:db-init-proc (make-parameter #f)) ;; (db:with-db dbstruct run-id sqlite3:exec "select blah fgrom blaz;") ;; r/w is a flag to indicate if the db is modified by this query #t = yes, #f = no ;; (define (db:with-db dbstruct run-id r/w proc . params) (let* ((use-mutex (> *api-process-request-count* 25)) ;; risk of db corruption (have-struct (dbr:dbstruct? dbstruct)) (dbdat (if have-struct ;; this stuff just allows us to call with a db handle directly (db:open-db dbstruct run-id (dbfile:db-init-proc)) ;; (dbfile:get-subdb dbstruct run-id) #f)) (db (if have-struct ;; this stuff just allows us to call with a db handle directly (dbr:dbdat-dbh dbdat) | > | 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 | (define dbfile:db-init-proc (make-parameter #f)) ;; (db:with-db dbstruct run-id sqlite3:exec "select blah fgrom blaz;") ;; r/w is a flag to indicate if the db is modified by this query #t = yes, #f = no ;; (define (db:with-db dbstruct run-id r/w proc . params) (assert dbstruct "FATAL: db:with-db called with dbstruct "#f) (let* ((use-mutex (> *api-process-request-count* 25)) ;; risk of db corruption (have-struct (dbr:dbstruct? dbstruct)) (dbdat (if have-struct ;; this stuff just allows us to call with a db handle directly (db:open-db dbstruct run-id (dbfile:db-init-proc)) ;; (dbfile:get-subdb dbstruct run-id) #f)) (db (if have-struct ;; this stuff just allows us to call with a db handle directly (dbr:dbdat-dbh dbdat) |
︙ | ︙ |
Modified http-transport.scm from [84bebe0a7c] to [4e52ed5cac].
︙ | ︙ | |||
558 559 560 561 562 563 564 | (current-seconds))) (if (common:low-noise-print 120 "server continuing") (debug:print-info 0 *default-log-port* "Server continuing, seconds since last db access: " (- (current-seconds) last-access)) (let ((curr-time (current-seconds))) (handle-exceptions exn (debug:print 0 *default-log-port* "ERROR: Failed to change timestamp on info file " servinfofile ". Are you out of space on that disk? exn=" exn) | | | 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 | (current-seconds))) (if (common:low-noise-print 120 "server continuing") (debug:print-info 0 *default-log-port* "Server continuing, seconds since last db access: " (- (current-seconds) last-access)) (let ((curr-time (current-seconds))) (handle-exceptions exn (debug:print 0 *default-log-port* "ERROR: Failed to change timestamp on info file " servinfofile ". Are you out of space on that disk? exn=" exn) (if (and ;; (< (- (current-seconds) server-start-time) 600) ;; run for ten minutes for experiment, 3600 thereafter (not *server-overloaded*) (file-exists? servinfofile)) (change-file-times servinfofile curr-time curr-time))) (if (or (common:low-noise-print 120 "start new server") (> *api-process-request-count* 50)) ;; if this server is kind of busy start up another (begin (debug:print-info 0 *default-log-port* "Server is busy, parallel-api-count "*api-process-request-count*", start another if possible...") |
︙ | ︙ | |||
619 620 621 622 623 624 625 | (exit))) ;; all routes though here end in exit ... ;; ;; start_server? ;; (define (http-transport:launch) | | | | < < < < < < < < < < < < < < < | < < < < < < | | | | < < | | | | | | | | | | | | | | | | | | 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 | (exit))) ;; all routes though here end in exit ... ;; ;; start_server? ;; (define (http-transport:launch) ;; check the .servinfo directory, are there other servers running on this ;; or another host? (let* ((server-start-is-ok (server:minimal-check *toppath*))) (if (not server-start-is-ok) (begin (debug:print 0 *default-log-port* "ERROR: server start not ok, exiting now.") (exit 1)))) ;; check that a server start is in progress, pause or exit if so (let* ((th2 (make-thread (lambda () (debug:print-info 0 *default-log-port* "Server run thread started") (http-transport:run (if (args:get-arg "-server") (args:get-arg "-server") "-") )) "Server run")) (th3 (make-thread (lambda () (debug:print-info 0 *default-log-port* "Server monitor thread started") (http-transport:keep-running) "Keep running")))) (thread-start! th2) (thread-sleep! 0.25) ;; give the server time to settle before starting the keep-running monitor. (thread-start! th3) (set! *didsomething* #t) (thread-join! th2) (exit))) ;; (define (http-transport:server-signal-handler signum) ;; (signal-mask! signum) ;; (handle-exceptions ;; exn ;; (debug:print 0 *default-log-port* " ... exiting ...") ;; (let ((th1 (make-thread (lambda () |
︙ | ︙ |
Modified megatest.scm from [89decfdb89] to [81aaa85fa0].
︙ | ︙ | |||
932 933 934 935 936 937 938 | ;; Start the server - can be done in conjunction with -runall or -runtests (one day...) ;; we start the server if not running else start the client thread ;;====================================================================== ;; Server? Start up here. ;; (if (args:get-arg "-server") | | < | > | 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 | ;; Start the server - can be done in conjunction with -runall or -runtests (one day...) ;; we start the server if not running else start the client thread ;;====================================================================== ;; Server? Start up here. ;; (if (args:get-arg "-server") (let ((tl (launch:setup))) ;; (server:launch 0 'http) (http-transport:launch) (set! *didsomething* #t))) ;; The adjutant is a bit different, it does NOT run (launch:setup) as it is not necessarily tied to ;; a specific Megatest area. Detail are being hashed out and this may change. ;; (if (args:get-arg "-adjutant") (begin |
︙ | ︙ |
Modified server.scm from [8e8a09693f] to [52fd15527b].
︙ | ︙ | |||
63 64 65 66 67 68 69 | ;;====================================================================== ;; S E R V E R ;;====================================================================== ;; Call this to start the actual server ;; | < < < < < < < < < < < | 63 64 65 66 67 68 69 70 71 72 73 74 75 76 | ;;====================================================================== ;; S E R V E R ;;====================================================================== ;; Call this to start the actual server ;; ;;====================================================================== ;; S E R V E R U T I L I T I E S ;;====================================================================== ;; Get the transport (define (server:get-transport) (if *transport-type* |
︙ | ︙ | |||
131 132 133 134 135 136 137 | ;; Given an area path, start a server process ### NOTE ### > file 2>&1 ;; if the target-host is set ;; try running on that host ;; incidental: rotate logs in logs/ dir. ;; (define (server:run areapath) ;; areapath is *toppath* for a given testsuite area | < < < < < < < | | 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 | ;; Given an area path, start a server process ### NOTE ### > file 2>&1 ;; if the target-host is set ;; try running on that host ;; incidental: rotate logs in logs/ dir. ;; (define (server:run areapath) ;; areapath is *toppath* for a given testsuite area (let* ((testsuite (common:get-testsuite-name)) (logfile (conc areapath "/logs/server.log")) ;; -" curr-pid "-" target-host ".log")) (profile-mode (or (configf:lookup *configdat* "misc" "profilesw") "")) (cmdln (conc (common:get-megatest-exe) " -server - ";; (or target-host "-") (if (equal? (configf:lookup *configdat* "server" "daemonize") "yes") " -daemonize " |
︙ | ︙ | |||
439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 | (hash-table-set! res hostport serverdat) (debug:print-info 0 *default-log-port* "bad server info for "f": "serverdat))) (else (debug:print-info 0 *default-log-port* "bad server info for "f": "serverdat))))) allfiles) res))) ;; oldest server alive determines host then choose random of youngest ;; five servers on that host ;; ;; mode: ;; best - get best server (random of newest five) ;; home - get home host based on oldest server ;; info - print info (define (server:choose-server areapath #!optional (mode 'best)) ;; age is current-starttime ;; find oldest alive ;; 1. sort by age ascending and ping until good ;; find alive rand from youngest ;; 1. sort by age descending ;; 2. take five ;; 3. check alive, discard if not and repeat (let* ((serversdat (server:get-servers-info areapath)) (servkeys (hash-table-keys serversdat)) (by-time-asc (if (not (null? servkeys)) (sort servkeys ;; list of "host:port" (lambda (a b) (>= (list-ref (hash-table-ref serversdat a) 2) (list-ref (hash-table-ref serversdat b) 2)))) | > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 | (hash-table-set! res hostport serverdat) (debug:print-info 0 *default-log-port* "bad server info for "f": "serverdat))) (else (debug:print-info 0 *default-log-port* "bad server info for "f": "serverdat))))) allfiles) res))) ;; check the .servinfo directory, are there other servers running on this ;; 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")) (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 ", numservers: "(length thisservrs)) (cond ((not havehome) #t) ;; no homehost yet, go for it ((and havehome wearehome (< (length thisservrs) 20)) #t) ;; we are home and less than 20 servers, ok to start another ((and havehome (not wearehome)) #f) ;; we are not the home host ((and havehome wearehome (>= (length thisservrs) 20)) #f) ;; have enough running (else (debug:print 0 *default-log-port* "WARNING: Unrecognised scenario, servrs="servrs", thishostip="thishostip", thisservrs="thisservrs) #t)))) ;; oldest server alive determines host then choose random of youngest ;; five servers on that host ;; ;; mode: ;; best - get best server (random of newest five) ;; home - get home host based on oldest server ;; info - print info (define (server:choose-server areapath #!optional (mode 'best)) ;; age is current-starttime ;; find oldest alive ;; 1. sort by age ascending and ping until good ;; find alive rand from youngest ;; 1. sort by age descending ;; 2. take five ;; 3. check alive, discard if not and repeat ;; first we clean up old server files (server:clean-up-old areapath) (let* ((serversdat (server:get-servers-info areapath)) (servkeys (hash-table-keys serversdat)) (by-time-asc (if (not (null? servkeys)) (sort servkeys ;; list of "host:port" (lambda (a b) (>= (list-ref (hash-table-ref serversdat a) 2) (list-ref (hash-table-ref serversdat b) 2)))) |
︙ | ︙ | |||
504 505 506 507 508 509 510 511 512 513 514 515 516 517 | #f))) (begin (server:run areapath) (thread-sleep! 3) (case mode ((homehost) (cons #f #f)) (else #f)))))) ;; would like to eventually get rid of this ;; (define (common:on-homehost?) (server:choose-server *toppath* 'home?)) ;; kind start up of server, wait before allowing another server for a given | > > > > > > > > > > > > > > > > > > > > > > | 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 | #f))) (begin (server:run areapath) (thread-sleep! 3) (case mode ((homehost) (cons #f #f)) (else #f)))))) (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/*")))) (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)) (file-modification-time sfile)))) (if (and (number? modtime) (> (- (current-seconds) modtime) 600)) (begin (debug:print 0 *default-log-port* "WARNING: found old server info file "sfile", removing it.") (handle-exceptions exn (debug:print 0 *default-log-port* "WARNING: failed to delete old server info file "sfile) (delete-file sfile)))))) sfiles))) ;; would like to eventually get rid of this ;; (define (common:on-homehost?) (server:choose-server *toppath* 'home?)) ;; kind start up of server, wait before allowing another server for a given |
︙ | ︙ |