Overview
Comment: | Start servers for all dbs on first access of main.db. WARNING: This sometimes runs away! |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.80-start-all |
Files: | files | file ages | folders |
SHA1: |
dbfd08bd90ab386617b2e42d8b643184 |
User & Date: | matt on 2023-10-19 21:02:23 |
Other Links: | branch diff | manifest | tags |
Context
2023-10-20
| ||
04:57 | Merged fork check-in: 53900a0d02 user: mrwellan tags: v1.80-start-all | |
2023-10-19
| ||
21:02 | Start servers for all dbs on first access of main.db. WARNING: This sometimes runs away! check-in: dbfd08bd90 user: matt tags: v1.80-start-all | |
2023-10-14
| ||
20:19 | removed a bit of not-needed junk from rmt.scm Leaf check-in: ffe3df4e65 user: matt tags: v1.80-matt-fixme | |
Changes
Modified api.scm from [13a08c65d1] to [47ba07ff8b].
︙ | ︙ | |||
310 311 312 313 314 315 316 317 318 | (set! *api-process-request-count* (- *api-process-request-count* 1)) ;; (serialize payload) (api:unregister-thread (current-thread)) payload)) (else (assert #f "FATAL: failed to deserialize indat "indat)))))) (define (api:dispatch-request dbstruct cmd run-id params) | > > | | > > > > > > > > > > > > > > > > > > > > > | 310 311 312 313 314 315 316 317 318 319 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 | (set! *api-process-request-count* (- *api-process-request-count* 1)) ;; (serialize payload) (api:unregister-thread (current-thread)) payload)) (else (assert #f "FATAL: failed to deserialize indat "indat)))))) (define *last-refresh-of-dbs* 0) (define *db-starts-running* #f) (define (api:dispatch-request dbstruct cmd run-id params) (if (not *no-sync-db*)(db:open-no-sync-db)) (thread-start! (make-thread (lambda () (if (and (not *db-starts-running*) (not run-id) ;; i.e. we are mainl.db (> (- (current-seconds) *last-refresh-of-dbs*) 20)) (set! *db-starts-running* #t) (let loop ((dbnum 10)) (let* ((dbname (conc dbnum".db")) ;; Yes, this is correct, use dbnum directly (candidates (dbfile:get-process-options *no-sync-db* "server" dbname))) (if (null? candidates) ;; start a server for this dbfile (tt:server-process-run *toppath* (common:get-testsuite-name) (common:find-local-megatest) dbname))) (thread-sleep! 0.5) (if (> dbnum 0)(loop (- dbnum 1))) (set! *db-starts-running* #f) (set! *last-refresh-of-dbs* (current-seconds))))))) (case cmd ;;=============================================== ;; READ/WRITE QUERIES ;;=============================================== ((get-keys-write) (db:get-keys dbstruct)) ;; force a dummy "write" query to force server; for debug in -repl |
︙ | ︙ |
Modified dbfile.scm from [172c69b638] to [e8d739219a].
︙ | ︙ | |||
578 579 580 581 582 583 584 585 586 587 588 589 590 591 | (define (dbfile:register-process nsdb host port pid starttime endtime status purpose dbname mtversion) (sqlite3:execute nsdb "INSERT INTO processes (host,port,pid,starttime,endtime,status,purpose,dbname,mtversion) VALUES (?,?,?,?,?,?,?,?,?);" host port pid starttime endtime status purpose dbname mtversion)) (define (dbfile:set-process-status nsdb host pid newstatus) (sqlite3:execute nsdb "UPDATE processes SET status=? WHERE host=? AND pid=?;" newstatus host pid)) (define (dbfile:get-process-options nsdb purpose dbname) (sqlite3:fold-row ;; host port pid starttime status mtversion (lambda (res . row) (cons row res)) '() nsdb | > | 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 | (define (dbfile:register-process nsdb host port pid starttime endtime status purpose dbname mtversion) (sqlite3:execute nsdb "INSERT INTO processes (host,port,pid,starttime,endtime,status,purpose,dbname,mtversion) VALUES (?,?,?,?,?,?,?,?,?);" host port pid starttime endtime status purpose dbname mtversion)) (define (dbfile:set-process-status nsdb host pid newstatus) (sqlite3:execute nsdb "UPDATE processes SET status=? WHERE host=? AND pid=?;" newstatus host pid)) ;; get list of process records to examine for suitabliity of connecting to (define (dbfile:get-process-options nsdb purpose dbname) (sqlite3:fold-row ;; host port pid starttime status mtversion (lambda (res . row) (cons row res)) '() nsdb |
︙ | ︙ |
Modified tcp-transportmod.scm from [a1fcad65c5] to [ec84ec4c9e].
︙ | ︙ | |||
136 137 138 139 140 141 142 | (assert (tt:valid-run-id run-id dbfname) "FATAL: invalid run-id "run-id) (let* ((conn (hash-table-ref/default (tt-conns ttdat) dbfname #f)) (server-start-proc (lambda () (tt:server-process-run (tt-areapath ttdat) testsuite ;; (dbfile:testsuite-name) (common:find-local-megatest) | > | | 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 | (assert (tt:valid-run-id run-id dbfname) "FATAL: invalid run-id "run-id) (let* ((conn (hash-table-ref/default (tt-conns ttdat) dbfname #f)) (server-start-proc (lambda () (tt:server-process-run (tt-areapath ttdat) testsuite ;; (dbfile:testsuite-name) (common:find-local-megatest) dbfname ;; run-id )))) (if conn (begin ; (debug:print-info 0 *default-log-port* "already connected to the server") conn) ;; we are already connected to the server (let* ((sdat (tt:get-current-server-info ttdat dbfname))) (match sdat ((host port start-time server-id pid dbfname2 servinffile) |
︙ | ︙ | |||
753 754 755 756 757 758 759 | bad-dat))))))))) ;; 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. ;; | | > > | | 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 | bad-dat))))))))) ;; 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 (tt:server-process-run areapath testsuite mtexe dbfname ;; run-id #!key (profile-mode "")) ;; areapath is *toppath* for a given testsuite area (assert areapath "FATAL: tt:server-process-run called without areapath defined.") (assert testsuite "FATAL: tt:server-process-run called without testsuite defined.") (assert mtexe "FATAL: tt:server-process-run called without mtexe defined.") ;; mtest -server - -m testsuite:ext-tests -db 6.db (let* (;; (dbfname (dbmod:run-id->dbfname run-id)) (load (get-normalized-cpu-load)) (trying (length (tt:find-server areapath dbfname))) (nrun (number-of-processes-running (conc "mtest.*server.*"testsuite".*"dbfname)))) (cond ((> load 2.0) (debug:print 0 *default-log-port* "Normalized load "load" on " (get-host-name) " is over the limit of 2.0. Not starting a server.") (thread-sleep! 1)) |
︙ | ︙ |