Overview
Comment: | Improved results from unit tests. WIP |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v2.001 |
Files: | files | file ages | folders |
SHA1: |
e2e75e9fde382ef707c46e364c9abf78 |
User & Date: | matt on 2021-12-18 20:07:44 |
Other Links: | branch diff | manifest | tags |
Context
2021-12-18
| ||
20:09 | Improved results from unit tests. WIP check-in: bb1843a1b0 user: matt tags: v2.001 | |
20:07 | Improved results from unit tests. WIP check-in: e2e75e9fde user: matt tags: v2.001 | |
17:53 | fixed bad call check-in: 90f865fbd4 user: matt tags: v2.001 | |
Changes
Modified debugprint.scm from [b587b5fa22] to [9a1ffc1e9a].
︙ | ︙ | |||
113 114 115 116 117 118 119 | (if (debug:debug-mode n) (with-output-to-port (or e (current-error-port)) (lambda () ;; (if *logging* ;; (db:log-event (apply conc params)) (apply print params) (debug:handle-remote-logging params) | | > > | 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 | (if (debug:debug-mode n) (with-output-to-port (or e (current-error-port)) (lambda () ;; (if *logging* ;; (db:log-event (apply conc params)) (apply print params) (debug:handle-remote-logging params) ))) #t ;; only here to make remote stuff happy. It'd be nice to fix that ... ) (define (debug:print-error n e . params) ;; normal print (if (debug:debug-mode n) (with-output-to-port (if (port? e) e (current-error-port)) (lambda () (apply print "ERROR: " params) |
︙ | ︙ |
Modified rmtmod.scm from [22593ed69e] to [7039de8d85].
︙ | ︙ | |||
200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 | (define (rmt:find-main-server 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 apath viable-srvs))) ;; looks for a connection to main, returns if have and not exired ;; creates new otherwise ;; ;; connections for other servers happens by requesting from main ;; ;; TODO: This is unnecessarily re-creating the record in the hash table ;; (define (rmt:open-main-connection remdat apath) (let* ((fullpath (db:dbname->path apath "/.db/main.db")) (conns (remotedat-conns remdat)) (conn (hash-table-ref/default conns fullpath #f))) ;; TODO - create call for this (if (and conn ;; conn is NOT a socket, just saying ... (< (current-seconds) (conndat-expires conn))) | > > > > | > > > | > | > | 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 | (define (rmt:find-main-server 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 apath viable-srvs))) (define *connstart-mutex* (make-mutex)) (define *last-main-start* 0) ;; looks for a connection to main, returns if have and not exired ;; creates new otherwise ;; ;; connections for other servers happens by requesting from main ;; ;; TODO: This is unnecessarily re-creating the record in the hash table ;; (define (rmt:open-main-connection remdat apath) (let* ((fullpath (db:dbname->path apath "/.db/main.db")) (conns (remotedat-conns remdat)) (conn (hash-table-ref/default conns fullpath #f))) ;; TODO - create call for this (if (and conn ;; conn is NOT a socket, just saying ... (< (current-seconds) (conndat-expires conn))) #t ;; we are current and good to go - we'll deal elsewhere with a server that was killed or died ;; Below we will find or create and connect to main (let* ((dbname (db:run-id->dbname #f)) (the-srv (rmt:find-main-server 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))) (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)) (port (alist-ref 'port the-srv)) |
︙ | ︙ | |||
243 244 245 246 247 248 249 | ipaddr: ipaddr port: port srvpkt: the-srv srvkey: srvkey ;; generated by rmt:get-signature on the server side lastmsg: (current-seconds) expires: (+ (current-seconds) 60) ;; this needs to be gathered during the ping ))) | | > | | 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 | ipaddr: ipaddr port: port srvpkt: the-srv srvkey: srvkey ;; generated by rmt:get-signature on the server side lastmsg: (current-seconds) expires: (+ (current-seconds) 60) ;; this needs to be gathered during the ping ))) (hash-table-set! conns fullpath new-the-srv))) #t)))) ;; NB// remdat is a remotedat struct ;; (define (rmt:general-open-connection remdat apath dbname #!key (num-tries 5)) (assert (not (equal? dbname ".db/main.db")) "ERROR: general-open-connection should never be called with main as the db") (let* ((mdbname (db:run-id->dbname #f)) (fullname (db:dbname->path apath dbname)) (conns (remotedat-conns remdat)) |
︙ | ︙ | |||
303 304 305 306 307 308 309 | lastmsg: (current-seconds) expires: (+ (current-seconds) 60)))) (else (debug:print-info 0 *default-log-port* "return data from starting server did not match host port servkey pid ipaddr apath dbname " res))) res) (begin (debug:print-info 0 *default-log-port* "Unexpected result: " res) | | < < | | 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 | lastmsg: (current-seconds) expires: (+ (current-seconds) 60)))) (else (debug:print-info 0 *default-log-port* "return data from starting server did not match host port servkey pid ipaddr apath dbname " res))) res) (begin (debug:print-info 0 *default-log-port* "Unexpected result: " res) res))))))) #t)) ;;====================================================================== ;; FOR DEBUGGING SET TO #t ;; (define *localmode* #t) (define *localmode* #f) (define *dbstruct* (make-dbr:dbstruct)) |
︙ | ︙ |
Modified tests/unittests/basicserver.scm from [938c89c684] to [0bda564ab1].
︙ | ︙ | |||
43 44 45 46 47 48 49 | ;; get-viable-servers ;; get-best-candidate ;; api:run-server-process ;; rmt:run ;; rmt:try-start-server ) | | | | | | | | | | | 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 | ;; get-viable-servers ;; get-best-candidate ;; api:run-server-process ;; rmt:run ;; rmt:try-start-server ) (test #f #t (remotedat? (let ((r (make-remotedat))) (set! *remotedat* r) r))) (test #f #f (rmt:get-conn *remotedat* *toppath* ".db/main.db")) (test #f #f (rmt:find-main-server *toppath* ".db/main.db")) (test #f #t (rmt:open-main-connection *remotedat* *toppath*)) (pp (hash-table->alist (remotedat-conns *remotedat*))) (test #f #t (conndat? (rmt:get-conn *remotedat* *toppath* ".db/main.db"))) (define *main* (rmt:get-conn *remotedat* *toppath* ".db/main.db")) ;; (for-each (lambda (tdat) ;; (test #f tdat (loop-test (rmt:conn-ipaddr *main*) ;; (rmt:conn-port *main*) tdat))) ;; (list 'a ;; '(a "b" 123 1.23 ))) (test #f #t (rmt:send-receive 'ping #f 'hello)) (define *db* (db:setup ".db/main.db")) ;; these let me cut and paste from source easily (define apath *toppath*) (define dbname ".db/2.db") (define remote *remotedat*) (define keyvals '(("SYSTEM" "a")("RELEASE" "b"))) (test #f '() (string->sexpr "()")) (test #f 'server-started (api:execute-requests *db* 'get-server (list *toppath* ".db/2.db"))) (set! *dbstruct-db* #f) (exit) |
Modified tests/unittests/server.scm from [288618866d] to [1db08904e3].
︙ | ︙ | |||
50 51 52 53 54 55 56 | ) (define *db* (db:setup ".db/main.db")) ;; these let me cut and paste from source easily (define apath *toppath*) (define dbname ".db/2.db") | | | | | > | > > | | | 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 | ) (define *db* (db:setup ".db/main.db")) ;; these let me cut and paste from source easily (define apath *toppath*) (define dbname ".db/2.db") (define remote *remotedat*) (define keyvals '(("SYSTEM" "a")("RELEASE" "b"))) (test #f #t (rmt:open-main-connection remote apath)) (test #f #t (conndat? (rmt:get-conn *remotedat* *toppath* ".db/main.db"))) (test #f #t (conndat? (rmt:get-conn *remotedat* *toppath* ".db/main.db"))) (test #f ".db/2.db" (list-ref (rmt:send-receive-real *remotedat* *toppath* ".db/main.db" 'get-server `(,apath ,dbname)) 6)) (thread-sleep! 2) (test #f #t (rmt:general-open-connection *remotedat* *toppath* ".db/2.db")) (exit) (test #f '("SYSTEM" "RELEASE") (rmt:get-keys)) (test #f 1 (rmt:send-receive 'register-run #f (list keyvals "run1" "new" "n/a" "justme" #f))) (print "Got here.") (test #f 1 (rmt:send-receive 'register-run 1 (list keyvals "run1" "new" "n/a" "justme" #f))) (test #f 2 (rmt:register-run keyvals "run2" "new" "n/a" "justme" #f)) ;; (test #f 2 (rmt:deregister-server *remotedat* *toppath* iface port server-key dbname (test #f 2 (rmt:get-count-servers *remotedat* *toppath*)) (test #f "run2" (rmt:get-run-name-from-id 2)) ;; (exit) |