Overview
Comment: | short and fast server start implemented (just needs extensive testing) |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.80-revolution |
Files: | files | file ages | folders |
SHA1: |
c5f14c055ab25cc86c9e808d78c2cd39 |
User & Date: | matt on 2023-11-27 18:40:41 |
Other Links: | branch diff | manifest | tags |
Context
2023-11-27
| ||
18:56 | Bump version check-in: bca03ac0a6 user: matt tags: v1.80-revolution | |
18:40 | short and fast server start implemented (just needs extensive testing) check-in: c5f14c055a user: matt tags: v1.80-revolution | |
17:06 | new start up process implemented (but not tested) for main.db check-in: af90c933ed user: mrwellan tags: v1.80-revolution | |
Changes
Modified tcp-transportmod.scm from [1701bddb00] to [2aca24dc6e].
︙ | ︙ | |||
149 150 151 152 153 154 155 | testsuite ;; (dbfile:testsuite-name) (common:find-local-megatest) run-id))))) (if conn (begin (debug:print-info 2 *default-log-port* "already connected to a server") conn) ;; we are already connected to the server | | > > > | 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 | testsuite ;; (dbfile:testsuite-name) (common:find-local-megatest) run-id))))) (if conn (begin (debug:print-info 2 *default-log-port* "already connected to a server") conn) ;; we are already connected to the server (let* ((sdats (tt:get-server-info-sorted ttdat dbfname)) (sdat (if (null? sdats) #f (car sdats)))) (match sdat ((host port start-time server-id pid dbfname2 servinffile) (assert (equal? dbfname dbfname2) "FATAL: read server info from wrong file.") (debug:print-info 2 *default-log-port* "no conn - in match servinffile:" servinffile) (let* ((host-port (conc host":"port)) (conn (make-tt-conn host: host |
︙ | ︙ | |||
186 187 188 189 190 191 192 | (let* ((curr-secs (current-seconds))) ;; rm the (last server) would go here (if (> (- curr-secs (tt-last-serv-start ttdat)) 10) (begin (tt-last-serv-start-set! ttdat curr-secs) (server-start-proc))) ;; start server if 10 sec since last attempt (thread-sleep! 1) | | | 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 | (let* ((curr-secs (current-seconds))) ;; rm the (last server) would go here (if (> (- curr-secs (tt-last-serv-start ttdat)) 10) (begin (tt-last-serv-start-set! ttdat curr-secs) (server-start-proc))) ;; start server if 10 sec since last attempt (thread-sleep! 1) (debug:print-info 0 *default-log-port* "server ping result was neither running nor starting. Retrying connect") (tt:client-connect-to-server ttdat dbfname run-id testsuite server-start-proc))))))) (else ;; no good server found, if haven't started server in > 5 secs, start another (if (> (- (current-seconds) (tt-last-serv-start ttdat)) 3) ;; BUG - grow this number really do not want to swamp the machine with servers (begin (debug:print-info 0 *default-log-port* "Starting server for "dbfname) (server-start-proc) (tt-last-serv-start-set! ttdat (current-seconds)) |
︙ | ︙ | |||
311 312 313 314 315 316 317 | ;; (debug:print 0 *default-log-port* "INFO: got corrupt data from server "host":"port", "res", for "dbfname", will try again.") ;; (tt:handler ttdat cmd run-id params (+ attemptnum 1) readonly-mode dbfname testsuite mtexe) ))))) (begin (thread-sleep! 1) ;; no conn yet set up, give it a rest and try again (tt:handler ttdat cmd run-id params attemptnum readonly-mode dbfname testsuite mtexe server-start-proc))))) | < < < | 314 315 316 317 318 319 320 321 322 323 324 325 326 327 | ;; (debug:print 0 *default-log-port* "INFO: got corrupt data from server "host":"port", "res", for "dbfname", will try again.") ;; (tt:handler ttdat cmd run-id params (+ attemptnum 1) readonly-mode dbfname testsuite mtexe) ))))) (begin (thread-sleep! 1) ;; no conn yet set up, give it a rest and try again (tt:handler ttdat cmd run-id params attemptnum readonly-mode dbfname testsuite mtexe server-start-proc))))) ;; gets server info and appends path to server file ;; sorts by age, oldest first ;; ;; returns list of (host port startseconds server-id servinfofile) ;; (define (tt:get-server-info-sorted ttdat dbfname) (let* ((areapath (tt-areapath ttdat)) |
︙ | ︙ | |||
339 340 341 342 343 344 345 | (if (or (> (length sorted) 1) (common:low-noise-print 120 "server info sorted")) (debug:print 2 *default-log-port* "SERVER #"count": "(string-intersperse (map conc sorted) ", "))) (set! count (+ count 1))) sorted) sorted)) | < < < < < < < < < < < < < < | 339 340 341 342 343 344 345 346 347 348 349 350 351 352 | (if (or (> (length sorted) 1) (common:low-noise-print 120 "server info sorted")) (debug:print 2 *default-log-port* "SERVER #"count": "(string-intersperse (map conc sorted) ", "))) (set! count (+ count 1))) sorted) sorted)) (define (tt:send-receive ttdat conn cmd run-id params) (let* ((host-port (tt-conn-host-port conn)) ;; (conc (tt-conn-host conn)":"(tt-conn-port conn))) (host (tt-conn-host conn)) (port (tt-conn-port conn)) (dat (list cmd run-id params #f))) ;; no meta data yet (tt:send-receive-direct host port dat))) |
︙ | ︙ | |||
479 480 481 482 483 484 485 486 487 488 489 490 491 492 | ;; ;; Server viability is checked in keep-running. Blindly start and run here. ;; (define (tt:start-server areapath run-id dbfname-in handler keys) (assert areapath "FATAL: areapath not provided for tt:start-server") (let* ((ttdat (make-tt areapath: areapath)) (dbfname (or dbfname-in (dbmod:run-id->dbfname run-id)))) (let* ((dbstruct (dbmod:open-dbmoddb areapath run-id dbfname (dbfile:db-init-proc) keys))) (tt-handler-set! ttdat (handler dbstruct)) (let* ((servinf-created #f) (tcp-thread (make-thread (lambda () ;; NOTE: tt-port and tt-host are set in connect-listener which is called under tt:start-tcp-server (tt:start-tcp-server ttdat)) ;; start the tcp-server which applies handler to incoming data | > | 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 | ;; ;; Server viability is checked in keep-running. Blindly start and run here. ;; (define (tt:start-server areapath run-id dbfname-in handler keys) (assert areapath "FATAL: areapath not provided for tt:start-server") (let* ((ttdat (make-tt areapath: areapath)) (dbfname (or dbfname-in (dbmod:run-id->dbfname run-id)))) (set! *server-info* ttdat) (let* ((dbstruct (dbmod:open-dbmoddb areapath run-id dbfname (dbfile:db-init-proc) keys))) (tt-handler-set! ttdat (handler dbstruct)) (let* ((servinf-created #f) (tcp-thread (make-thread (lambda () ;; NOTE: tt-port and tt-host are set in connect-listener which is called under tt:start-tcp-server (tt:start-tcp-server ttdat)) ;; start the tcp-server which applies handler to incoming data |
︙ | ︙ | |||
568 569 570 571 572 573 574 575 576 577 578 579 580 581 | (begin (debug:print 0 *default-log-port* "ERROR: (tt-port ttdat) no port set! Exiting.") (exit))))) ;; create a servinfo file start keep-running (tt:create-server-registration-file ttdat dbfname) (procinf-status-set! *procinf* "running") (dbfile:with-no-sync-db nosyncdbpath (lambda (nsdb) (dbfile:insert-or-update-process nsdb *procinf*))) (thread-start! run-thread) (thread-join! run-thread) ;; run thread will exit on timeout or other conditions | > | 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 | (begin (debug:print 0 *default-log-port* "ERROR: (tt-port ttdat) no port set! Exiting.") (exit))))) ;; create a servinfo file start keep-running (tt:create-server-registration-file ttdat dbfname) (procinf-status-set! *procinf* "running") (tt-state-set! ttdat 'running) (dbfile:with-no-sync-db nosyncdbpath (lambda (nsdb) (dbfile:insert-or-update-process nsdb *procinf*))) (thread-start! run-thread) (thread-join! run-thread) ;; run thread will exit on timeout or other conditions |
︙ | ︙ |