Overview
Comment: | Fixed db running bug |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.60 |
Files: | files | file ages | folders |
SHA1: |
6eef552c2e9f85bb401cb0993a7c347b |
User & Date: | matt on 2014-12-15 00:16:32 |
Other Links: | branch diff | manifest | tags |
Context
2014-12-15
| ||
22:51 | Flattened unnecessary hierarchy from paths in bup repositories check-in: 4aa76fc692 user: matt tags: v1.60 | |
00:16 | Fixed db running bug check-in: 6eef552c2e user: matt tags: v1.60 | |
2014-12-14
| ||
21:47 | Added unit test to exercise server cycle check-in: 004afb0916 user: matt tags: v1.60 | |
Changes
Modified db.scm from [4fc536addb] to [3172f4a26d].
︙ | ︙ | |||
232 233 234 235 236 237 238 | ;; (dbr:dbstruct-set-run-id! dbstruct run-id) (if local (begin (dbr:dbstruct-set-localdb! dbstruct run-id db) ;; (dbr:dbstruct-set-inmem! dbstruct db) ;; direct access ... db) (begin (dbr:dbstruct-set-inmem! dbstruct inmem) | > | | | | | | | 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 | ;; (dbr:dbstruct-set-run-id! dbstruct run-id) (if local (begin (dbr:dbstruct-set-localdb! dbstruct run-id db) ;; (dbr:dbstruct-set-inmem! dbstruct db) ;; direct access ... db) (begin (dbr:dbstruct-set-inmem! dbstruct inmem) ;; dec 14, 2014 - keep deleted records available. hunch is that they are needed for id placeholders ;; (sqlite3:execute db "DELETE FROM tests WHERE state='DELETED';") ;; they just slow us down in this context (db:sync-tables db:sync-tests-only db inmem) (db:delay-if-busy refdb) ;; dbpath: (db:dbdat-get-path refdb)) ;; What does delaying here achieve? (dbr:dbstruct-set-refdb! dbstruct refdb) (db:sync-tables db:sync-tests-only inmem refdb) ;; use inmem as the reference, don't read again from db ;; sync once more to deal with delays? ;; (db:sync-tables db:sync-tests-only db inmem) ;; (db:sync-tables db:sync-tests-only inmem refdb) inmem)))))) ;; This routine creates the db. It is only called if the db is not already ls opened ;; (define (db:open-main dbstruct) ;; (conc *toppath* "/megatest.db") (car *configinfo*))) (let ((mdb (dbr:dbstruct-get-main dbstruct))) (if mdb |
︙ | ︙ | |||
548 549 550 551 552 553 554 555 556 557 558 559 560 561 | (if (> (length fromdat) batch-len) (begin (set! fromdats (cons fromdat fromdats)) (set! fromdat '()) (set! totrecords (+ totrecords 1))))) (db:dbdat-get-db fromdb) full-sel) (debug:print-info 2 "found " totrecords " records to sync") ;; read the target table (sqlite3:for-each-row (lambda (a . b) (hash-table-set! todat a (apply vector a b))) | > > > > | 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 | (if (> (length fromdat) batch-len) (begin (set! fromdats (cons fromdat fromdats)) (set! fromdat '()) (set! totrecords (+ totrecords 1))))) (db:dbdat-get-db fromdb) full-sel) ;; tack on remaining records in fromdat (if (not (null? fromdat)) (set! fromdats (cons fromdat fromdats))) (debug:print-info 2 "found " totrecords " records to sync") ;; read the target table (sqlite3:for-each-row (lambda (a . b) (hash-table-set! todat a (apply vector a b))) |
︙ | ︙ |
Modified http-transport.scm from [30e3275ed4] to [c3c2fc0fe7].
︙ | ︙ | |||
435 436 437 438 439 440 441 442 443 444 445 446 447 448 | (if (eq? server-state 'available) (let ((new-server-id (tasks:server-am-i-the-server? (db:delay-if-busy tdbdat) run-id))) ;; try to ensure no double registering of servers (if (equal? new-server-id server-id) (begin (tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "dbprep") (thread-sleep! 0.5) ;; give some margin for queries to complete before switching from file based access to server based access (set! *inmemdb* (db:setup run-id)) (tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "running")) (begin ;; gotta exit nicely (tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "collision") (http-transport:server-shutdown server-id port)))))) (if (< count 1) ;; 3x3 = 9 secs aprox (loop (+ count 1) 'running bad-sync-count)) | > > > | 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 | (if (eq? server-state 'available) (let ((new-server-id (tasks:server-am-i-the-server? (db:delay-if-busy tdbdat) run-id))) ;; try to ensure no double registering of servers (if (equal? new-server-id server-id) (begin (tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "dbprep") (thread-sleep! 0.5) ;; give some margin for queries to complete before switching from file based access to server based access (set! *inmemdb* (db:setup run-id)) ;; force initialization ;; (db:get-db *inmemdb* #t) (db:get-db *inmemdb* run-id) (tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "running")) (begin ;; gotta exit nicely (tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "collision") (http-transport:server-shutdown server-id port)))))) (if (< count 1) ;; 3x3 = 9 secs aprox (loop (+ count 1) 'running bad-sync-count)) |
︙ | ︙ |
Modified rmt.scm from [40211cab4f] to [26510b9ee8].
︙ | ︙ | |||
65 66 67 68 69 70 71 72 73 74 75 76 77 78 | (if (and (> count 10) (> queries-per-second 10)) (begin (debug:print-info 1 "db write rate too high, starting a server, count=" count " start=" start " run-id=" run-id " queries-per-second=" queries-per-second) #t) #f)))) (define (rmt:get-connection-info run-id) (let ((cinfo (hash-table-ref/default *runremote* run-id #f))) (if cinfo cinfo ;; NB// can cache the answer for server running for 10 seconds ... ;; ;; (and (not (rmt:write-frequency-over-limit? cmd run-id)) (if (tasks:server-running-or-starting? (db:delay-if-busy (tasks:open-db)) run-id) | > > > | 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 | (if (and (> count 10) (> queries-per-second 10)) (begin (debug:print-info 1 "db write rate too high, starting a server, count=" count " start=" start " run-id=" run-id " queries-per-second=" queries-per-second) #t) #f)))) ;; if a server is either running or in the process of starting call client:setup ;; else return #f to let the calling proc know that there is no server available ;; (define (rmt:get-connection-info run-id) (let ((cinfo (hash-table-ref/default *runremote* run-id #f))) (if cinfo cinfo ;; NB// can cache the answer for server running for 10 seconds ... ;; ;; (and (not (rmt:write-frequency-over-limit? cmd run-id)) (if (tasks:server-running-or-starting? (db:delay-if-busy (tasks:open-db)) run-id) |
︙ | ︙ | |||
136 137 138 139 140 141 142 | ;; no longer killing the server in http-transport:client-api-send-receive ;; may kill it here but what are the criteria? ;; start with three calls then kill server ;; (if (eq? attemptnum 3)(tasks:kill-server-run-id run-id)) ;; (thread-sleep! 2) (rmt:send-receive cmd run-id params attemptnum: (+ attemptnum 1))))) | | > > > > | 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 | ;; no longer killing the server in http-transport:client-api-send-receive ;; may kill it here but what are the criteria? ;; start with three calls then kill server ;; (if (eq? attemptnum 3)(tasks:kill-server-run-id run-id)) ;; (thread-sleep! 2) (rmt:send-receive cmd run-id params attemptnum: (+ attemptnum 1))))) ;; no connection info? try to start a server, or access locally if no ;; server and the query is read-only ;; ;; Note: The tasks db was checked for a server in starting mode in the rmt:get-connection-info call ;; (if (and (< attemptnum 15) (member cmd api:write-queries)) (begin (hash-table-delete! *runremote* run-id) ;; (mutex-unlock! *send-receive-mutex*) (tasks:start-and-wait-for-server (db:delay-if-busy (tasks:open-db)) run-id 10) ;; (client:setup run-id) ;; client setup happens in rmt:get-connection-info |
︙ | ︙ |
Modified tests/unittests/server.scm from [c4b3b05ca3] to [d45af24828].
︙ | ︙ | |||
21 22 23 24 25 26 27 | (define keyvals '(("SYSTEM" "abc")("RELEASE" "def"))) (define header (list "SYSTEM" "RELEASE" "id" "runname" "state" "status" "owner" "event_time")) (test #f 1 (rmt:register-run keyvals runname "new" "n/a" user)) ;; (test #f #f (rmt:get-runs-by-patt keys runname)) (test #f #t (rmt:general-call 'register-test run-id run-id "test-one" "")) (define test-one-id #f) | | | | | < > | 21 22 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 | (define keyvals '(("SYSTEM" "abc")("RELEASE" "def"))) (define header (list "SYSTEM" "RELEASE" "id" "runname" "state" "status" "owner" "event_time")) (test #f 1 (rmt:register-run keyvals runname "new" "n/a" user)) ;; (test #f #f (rmt:get-runs-by-patt keys runname)) (test #f #t (rmt:general-call 'register-test run-id run-id "test-one" "")) (define test-one-id #f) (test #f 30001 (let ((test-id (rmt:get-test-id run-id "test-one" ""))) (set! test-one-id test-id) test-id)) (define test-one-rec #f) (test #f "test-one" (let ((test-rec (rmt:get-test-info-by-id run-id test-one-id))) (set! test-one-rec test-rec) (vector-ref test-rec 2))) (use trace) (import trace) ;; (trace ;; rmt:send-receive ;; rmt:open-qry-close-locally ;; ) ;; Tests to assess reading/writing while servers are starting/stopping (define start-time (current-seconds)) (let loop ((test-state 'start)) (let* ((server-dats (tasks:get-server-records (db:delay-if-busy (tasks:open-db)) run-id)) (first-dat (if (not (null? server-dats)) (car server-dats) |
︙ | ︙ | |||
61 62 63 64 65 66 67 68 69 70 71 72 73 74 | (server:kind-run run-id) (loop 'server-started)) ((server-started) (case server-state ((running) (print "Server appears to be running. Now ask it to shutdown") (rmt:kill-server run-id) (loop 'shutdown-started)) ((available) (loop test-state)) ((shutting-down) (loop test-state)) ((no-dat) (loop test-state)) | > | 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 | (server:kind-run run-id) (loop 'server-started)) ((server-started) (case server-state ((running) (print "Server appears to be running. Now ask it to shutdown") (rmt:kill-server run-id) ;; (trace rmt:open-qry-close-locally rmt:send-receive) (loop 'shutdown-started)) ((available) (loop test-state)) ((shutting-down) (loop test-state)) ((no-dat) (loop test-state)) |
︙ | ︙ |