Overview
Comment: | wip |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v2.0001 |
Files: | files | file ages | folders |
SHA1: |
844a9d0924252f52b5a9065739c7970e |
User & Date: | matt on 2022-01-02 20:49:02 |
Other Links: | branch diff | manifest | tags |
Context
2022-01-03
| ||
09:34 | wip check-in: db564d80d9 user: matt tags: v2.0001 | |
2022-01-02
| ||
20:49 | wip check-in: 844a9d0924 user: matt tags: v2.0001 | |
18:44 | wip check-in: 9579cb5f06 user: matt tags: v2.0001 | |
Changes
Modified apimod.scm from [d0ed8f0a49] to [dab49c5a9c].
︙ | ︙ | |||
372 373 374 375 376 377 378 | ((have-incompletes?) (apply db:have-incompletes? dbstruct params)) ((login) (apply db:login dbstruct params)) ((general-call) (let ((stmtname (car params)) (run-id (cadr params)) (realparams (cddr params))) (db:general-call dbstruct stmtname run-id realparams))) ((sdb-qry) (apply sdb:qry params)) | | | 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 | ((have-incompletes?) (apply db:have-incompletes? dbstruct params)) ((login) (apply db:login dbstruct params)) ((general-call) (let ((stmtname (car params)) (run-id (cadr params)) (realparams (cddr params))) (db:general-call dbstruct stmtname run-id realparams))) ((sdb-qry) (apply sdb:qry params)) ((ping) `(#t ,(current-process-id) (cadr params))) ;; (current-process-id)) ((get-changed-record-ids) (apply db:get-changed-record-ids dbstruct params)) ((get-run-record-ids) (apply db:get-run-record-ids dbstruct params)) ;; TESTMETA ((testmeta-get-record) (apply db:testmeta-get-record dbstruct params)) ;; TASKS ((find-task-queue-records) (apply tasks:find-task-queue-records dbstruct params)) |
︙ | ︙ |
Modified rmtmod.scm from [fb260a632c] to [622fc59774].
︙ | ︙ | |||
157 158 159 160 161 162 163 | ;; S U P P O R T F U N C T I O N S ;;====================================================================== ;; set up the api proc, seems like there should be a better place for this? ;; ;; IS THIS NEEDED ANYMORE? TODO - REMOVE IF POSSIBLE ;; | | | > | | 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 | ;; S U P P O R T F U N C T I O N S ;;====================================================================== ;; set up the api proc, seems like there should be a better place for this? ;; ;; IS THIS NEEDED ANYMORE? TODO - REMOVE IF POSSIBLE ;; ;; (define api-proc (make-parameter conc)) ;; (api-proc api:execute-requests) ;; do we have a connection to apath dbname and ;; is it not expired? then return it ;; ;; else setup a connection ;; ;; if that fails, return '(#f "some reason") ;; NB// convert to raising an exception ;; (define (rmt:get-conn remdat apath dbname) (let* ((fullname (db:dbname->path apath dbname)) (conn (hash-table-ref/default (servdat-conns remdat) fullname #f))) (if (and conn (< (current-seconds) (conndat-expires conn))) conn #f ;; TODO - convert this to a refresh for the given db? (server could have moved) ))) (define (rmt:find-main-server uconn apath dbname) (let* ((pktsdir (get-pkts-dir apath)) (all-srvpkts (get-all-server-pkts pktsdir *srvpktspec*)) ;; (dbpath (conc apath "/" dbname)) (viable-srvs (get-viable-servers all-srvpkts dbname))) (get-the-server uconn apath viable-srvs))) |
︙ | ︙ | |||
229 230 231 232 233 234 235 | (the-srv (rmt:find-main-server myconn apath dbname)) (start-main-srv (lambda () ;; call IF there is no the-srv found (mutex-lock! *connstart-mutex*) (if (> (- (current-seconds) *last-main-start*) 5) ;; at least four seconds since last attempt to start main server (begin (api:run-server-process apath dbname) (set! *last-main-start* (current-seconds)) | | > | 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 | (the-srv (rmt:find-main-server myconn apath dbname)) (start-main-srv (lambda () ;; call IF there is no the-srv found (mutex-lock! *connstart-mutex*) (if (> (- (current-seconds) *last-main-start*) 5) ;; at least four seconds since last attempt to start main server (begin (api:run-server-process apath dbname) (set! *last-main-start* (current-seconds)) (thread-sleep! 1)) (thread-sleep! 0.25)) (mutex-unlock! *connstart-mutex*) (rmt:open-main-connection remdat apath) ;; TODO: Add limit to number of tries ))) (if (not the-srv) ;; have server, try connecting to it (start-main-srv) (let* ((srv-addr (server-address the-srv)) ;; need serv (ipaddr (alist-ref 'ipaddr the-srv)) |
︙ | ︙ | |||
352 353 354 355 356 357 358 | (if rid (rmt:general-open-connection sinfo apath dbname)) (rmt:send-receive-real sinfo apath dbname cmd params))))) ;; db is at apath/.db/dbname, rid is an intermediary solution and will be removed ;; sometime in the future ;; (define (rmt:send-receive-real sinfo apath dbname cmd params) | | | | > | | | 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 | (if rid (rmt:general-open-connection sinfo apath dbname)) (rmt:send-receive-real sinfo apath dbname cmd params))))) ;; db is at apath/.db/dbname, rid is an intermediary solution and will be removed ;; sometime in the future ;; (define (rmt:send-receive-real sinfo apath dbname cmd params) (let* ((cdat (rmt:get-conn sinfo apath dbname))) (assert cdat "FATAL: rmt:send-receive-real called without the needed channels opened") (let* ((key #f) (payload `((cmd . ,cmd) (key . ,(conndat-srvkey cdat)) (params . ,params))) (uconn (servdat-uconn sinfo)) (res (send-receive uconn (conndat-hostport cdat) cmd payload))) (if (member res '("#<unspecified>")) ;; TODO - fix this in string->sexpr #f res)))) ;; db is at apath/.db/dbname, rid is an intermediary solution and will be removed ;; sometime in the future. ;; ;; Purpose - call the main.db server and request a server be started ;; for the given area path and dbname ;; |
︙ | ︙ | |||
1642 1643 1644 1645 1646 1647 1648 | (debug:print 2 *default-log-port* "PID: "(current-process-id)". Attempting to start the server ...") (if (and *db-serv-info* (servdat-uconn *db-serv-info*)) (let* ((uconn (servdat-uconn *db-serv-info*))) (wait-and-close uconn)) (let* ((port (portlogger:open-run-close portlogger:find-port)) (handler-proc (lambda (rem-host-port qrykey cmd params) ;; | > | | 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 | (debug:print 2 *default-log-port* "PID: "(current-process-id)". Attempting to start the server ...") (if (and *db-serv-info* (servdat-uconn *db-serv-info*)) (let* ((uconn (servdat-uconn *db-serv-info*))) (wait-and-close uconn)) (let* ((port (portlogger:open-run-close portlogger:find-port)) (handler-proc (lambda (rem-host-port qrykey cmd params) ;; (let* ((prms (alist-ref 'params params))) (api:execute-requests *dbstruct-db* cmd prms #;params))))) ;; (api:process-request *dbstuct-db* (if (not *db-serv-info*) (set! *db-serv-info* (make-servdat host: hostn port: port))) (let* ((uconn (run-listener handler-proc port)) (rport (udat-port uconn))) ;; the real port (servdat-host-set! *db-serv-info* hostn) (servdat-port-set! *db-serv-info* rport) |
︙ | ︙ | |||
1790 1791 1792 1793 1794 1795 1796 | (define (server-ready? uconn host-port key) ;; server-address is host:port (let* ((data (sexpr->string `((cmd . ping) (key . ,key) (params . ())))) (res (send-receive uconn host-port 'ping data))) (if res | | | 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 | (define (server-ready? uconn host-port key) ;; server-address is host:port (let* ((data (sexpr->string `((cmd . ping) (key . ,key) (params . ())))) (res (send-receive uconn host-port 'ping data))) (if res (car res) res))) ; from the pkts return servers associated with dbpath ;; NOTE: Only one can be alive - have to check on each ;; in the list of pkts returned ;; (define (get-viable-servers serv-pkts dbpath) |
︙ | ︙ |
Modified tests/unittests/basicserver.scm from [621aa95c92] to [eb62de6943].
︙ | ︙ | |||
23 24 25 26 27 28 29 | ;; ./rununittest.sh server 1;(cd simplerun;megatest -stop-server 0) (import rmtmod trace http-client apimod dbmod launchmod srfi-69 ulex system-information) (trace-call-sites #t) (trace | | | | | > > > > > > > > > > > | | 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 | ;; ./rununittest.sh server 1;(cd simplerun;megatest -stop-server 0) (import rmtmod trace http-client apimod dbmod launchmod srfi-69 ulex system-information) (trace-call-sites #t) (trace ;; get-the-server ;; db:get-dbdat rmt:find-main-server ;; rmt:send-receive-real ;; rmt:send-receive ;; sexpr->string server-ready? ;; rmt:register-server api:run-server-process rmt:open-main-connection ;; rmt:general-open-connection ;; rmt:get-conny ;; common:watchdog ;; rmt:find-main-server ;; get-all-server-pkts ;; get-viable-servers ;; get-best-candidate ;; api:run-server-process ;; rmt:run ;; rmt:try-start-server ;; ;; ulex ;; ;; wait-and-close ;; run-listener ) (define-syntax run-in-thread (syntax-rules () ((_ body ...) (let ((th1 (make-thread (lambda () body ...) "the thread"))) (thread-start! th1) (thread-join! th1))))) (test #f #t (servdat? (let ((s (make-servdat))) (set! *servdat* s) s))) (test #f #f (rmt:get-conn *servdat* *toppath* ".db/main.db")) (test #f #f (rmt:find-main-server *servdat* *toppath* ".db/main.db")) (define th1 (make-thread (lambda () (rmt:run (get-host-name))) "rmt:run thread")) (thread-start! th1) (thread-sleep! 0.5) ;; give things some time to get going ;; switch to *db-serv-info* instead of *servdat* (define *uconn* (servdat-uconn *db-serv-info*)) (print "*uconn*: " *uconn*) (test #f #t (ulex-listener? (servdat-uconn *db-serv-info*))) (test #f #t (string? (udat-host-port *uconn*))) (run-in-thread (test #f #t (server-ready? *uconn* (udat-host-port *uconn*) (servdat-uuid *db-serv-info*)))) (test #f #t (rmt:open-main-connection *db-serv-info* *toppath*)) ;; (pp (hash-table->alist (remotedat-conns *db-serv-info*))) (test #f #t (conndat? (rmt:get-conn *db-serv-info* *toppath* ".db/main.db"))) (exit) (define *main* (rmt:get-conn *db-serv-info* *toppath* ".db/main.db")) |
︙ | ︙ |
Modified ulex/ulex.scm from [f7e86349bb] to [afccb56e89].
︙ | ︙ | |||
23 24 25 26 27 28 29 30 31 32 33 34 35 36 | ;; NOTES: ;; Why sql-de-lite and not say, dbi? - performance mostly, then simplicity. ;; ;;====================================================================== (module ulex ( run-listener ;; (run-listener handler-proc [port]) => uconn ;; NOTE: handler-proc params; ;; (handler-proc rem-host-port qrykey cmd params) send-receive ;; (send-receive uconn host-port cmd data) | > > | 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 | ;; NOTES: ;; Why sql-de-lite and not say, dbi? - performance mostly, then simplicity. ;; ;;====================================================================== (module ulex ( ;; NOTE: looking for the handler proc - find the run-listener :) run-listener ;; (run-listener handler-proc [port]) => uconn ;; NOTE: handler-proc params; ;; (handler-proc rem-host-port qrykey cmd params) send-receive ;; (send-receive uconn host-port cmd data) |
︙ | ︙ |