Overview
Comment: | main not to exit if sub-servers running |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.6584-nanomsg |
Files: | files | file ages | folders |
SHA1: |
47774f526e3bd8062b24741fcc6a9829 |
User & Date: | matt on 2021-06-20 16:06:31 |
Other Links: | branch diff | manifest | tags |
Context
2021-06-20
| ||
23:37 | wip check-in: 5fe1888afd user: matt tags: v1.6584-nanomsg | |
16:06 | main not to exit if sub-servers running check-in: 47774f526e user: matt tags: v1.6584-nanomsg | |
2021-06-19
| ||
05:00 | More trimming, clean up etc. but stil finalizer bug continues check-in: 3a56e7f78c user: matt tags: v1.6584-nanomsg | |
Changes
Modified apimod.scm from [f3c5575922] to [f9cc46260e].
︙ | ︙ | |||
199 200 201 202 203 204 205 206 207 208 209 210 211 212 | ;; SERVERS ;; ((start-server) (apply server:kind-run params)) ((kill-server) (set! *server-run* #f)) ((get-server) (api:start-server dbstruct params)) ((register-server) (apply db:register-server dbstruct params) );; dbstruct host port servkey pid ipaddr dbpath) ((deregister-server) (apply db:deregister-server dbstruct params) );; dbstruct host port servkey pid ipaddr dbpath) ;; TESTS ;;((test-set-state-status-by-id) (apply mt:test-set-state-status-by-id dbstruct params)) ;;BB - commented out above because it was calling below, eventually, incorrectly (dbstruct passed to mt:test-set-state-status-by-id, which previosly did more, but now only passes thru to db:set-state-status-and-roll-up-items. ((test-set-state-status-by-id) | > | 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 | ;; SERVERS ;; ((start-server) (apply server:kind-run params)) ((kill-server) (set! *server-run* #f)) ((get-server) (api:start-server dbstruct params)) ((register-server) (apply db:register-server dbstruct params) );; dbstruct host port servkey pid ipaddr dbpath) ((deregister-server) (apply db:deregister-server dbstruct params) );; dbstruct host port servkey pid ipaddr dbpath) ((get-count-servers) (apply db:get-count-servers dbstruct params)) ;; TESTS ;;((test-set-state-status-by-id) (apply mt:test-set-state-status-by-id dbstruct params)) ;;BB - commented out above because it was calling below, eventually, incorrectly (dbstruct passed to mt:test-set-state-status-by-id, which previosly did more, but now only passes thru to db:set-state-status-and-roll-up-items. ((test-set-state-status-by-id) |
︙ | ︙ |
Modified dbmod.scm from [5f7c49b44c] to [90aaabb4fa].
︙ | ︙ | |||
200 201 202 203 204 205 206 | (let* ((parent-dir (pathname-directory dbfile))) (if (not (directory-exists? parent-dir)) (create-directory parent-dir #t)) (let* ((exists (file-exists? dbfile)) (db (sqlite3:open-database dbfile)) (handler (sqlite3:make-busy-timeout 3600))) (sqlite3:set-busy-handler! db handler) | | | 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 | (let* ((parent-dir (pathname-directory dbfile))) (if (not (directory-exists? parent-dir)) (create-directory parent-dir #t)) (let* ((exists (file-exists? dbfile)) (db (sqlite3:open-database dbfile)) (handler (sqlite3:make-busy-timeout 3600))) (sqlite3:set-busy-handler! db handler) ;; (db:set-sync db) ;; we don't mind that this is slow? (if (not exists) (dbinit-proc db)) db))) ;; open and initialize the inmem db ;; NOTE: Does NOT sync in the data from the disk db ;; |
︙ | ︙ | |||
5575 5576 5577 5578 5579 5580 5581 5582 | (sqlite3:fold-row (lambda (res host port servkey pid ipaddr apath dbpath) (list host port servkey pid ipaddr apath dbpath)) #f db "SELECT host,port,servkey,pid,ipaddr,apath,dbname FROM servers WHERE apath=? AND dbname=?;" apath dbname)))) | > > > > > > > > > > > > | > | 5575 5576 5577 5578 5579 5580 5581 5582 5583 5584 5585 5586 5587 5588 5589 5590 5591 5592 5593 5594 5595 5596 | (sqlite3:fold-row (lambda (res host port servkey pid ipaddr apath dbpath) (list host port servkey pid ipaddr apath dbpath)) #f db "SELECT host,port,servkey,pid,ipaddr,apath,dbname FROM servers WHERE apath=? AND dbname=?;" apath dbname)))) (define (db:get-count-servers dbstruct apath) (db:with-db dbstruct #f #f (lambda (db) (sqlite3:fold-row (lambda (res count) (max res count)) 0 db "SELECT count(*) FROM servers WHERE apath=?;" apath)))) ) |
Modified megatest.scm from [1f0e5a3ef0] to [8b7ce4750f].
︙ | ︙ | |||
911 912 913 914 915 916 917 | (debug:print 0 *default-log-port* "WARNING: -itempatt has been deprecated, please use -testpatt testpatt/itempatt method, new testpatt is "newval) (hash-table-set! args:arg-hash "-testpatt" newval) (hash-table-delete! args:arg-hash "-itempatt"))) (if (args:get-arg "-runtests") (debug:print 0 *default-log-port* "WARNING: \"-runtests\" is deprecated. Use \"-run\" with \"-testpatt\" instead")) | > | | 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 | (debug:print 0 *default-log-port* "WARNING: -itempatt has been deprecated, please use -testpatt testpatt/itempatt method, new testpatt is "newval) (hash-table-set! args:arg-hash "-testpatt" newval) (hash-table-delete! args:arg-hash "-itempatt"))) (if (args:get-arg "-runtests") (debug:print 0 *default-log-port* "WARNING: \"-runtests\" is deprecated. Use \"-run\" with \"-testpatt\" instead")) (debug:print 0 *default-log-port* "on-exit disabled. Please re-enable") ;; (on-exit std-exit-procedure) ;;====================================================================== ;; Misc general calls ;;====================================================================== ;; TODO: Restore this functionality |
︙ | ︙ |
Modified rmtmod.scm from [431c525d1f] to [7f8aa4ba9f].
︙ | ︙ | |||
1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 | (else (api:process-request *dbstruct-db* data)))) (resdat (sexpr->string res))) (if (not (eq? res 'quit)) (begin (set! *db-last-access* (current-seconds)) (nn-send rep resdat) (loop (nn-recv rep))))))) ;; server exit stuff here (let* ((portnum (servdat-port *server-info*))) (portlogger:open-run-close portlogger:set-port portnum "released") (rmt:server-shutdown) ;; (bdat-time-to-exit-set! *bdat* #t) ;; tell on-exit to be fast as we've already cleaned up (portlogger:open-run-close portlogger:set-port port "released") ;; done in rmt:run ;; (debug:print-info 0 *default-log-port* "Max cached queries was " *max-cache-size*) | > | 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 | (else (api:process-request *dbstruct-db* data)))) (resdat (sexpr->string res))) (if (not (eq? res 'quit)) (begin (set! *db-last-access* (current-seconds)) (nn-send rep resdat) (loop (nn-recv rep))))))) (debug:print-info 0 *default-log-port* "After server, should never see this") ;; server exit stuff here (let* ((portnum (servdat-port *server-info*))) (portlogger:open-run-close portlogger:set-port portnum "released") (rmt:server-shutdown) ;; (bdat-time-to-exit-set! *bdat* #t) ;; tell on-exit to be fast as we've already cleaned up (portlogger:open-run-close portlogger:set-port port "released") ;; done in rmt:run ;; (debug:print-info 0 *default-log-port* "Max cached queries was " *max-cache-size*) |
︙ | ︙ | |||
2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 | 'register-server `(,iface ,port ,server-key ,(current-process-id) ,iface ,apath ,dbname))) (define (rmt:deregister-server remote apath iface port server-key dbname) (rmt:open-main-connection remote apath) ;; we need a channel to main.db (rmt:send-receive-real remote apath ;; params: host port servkey pid ipaddr dbpath (db:run-id->dbname #f) 'deregister-server `(,iface ,port | > > > > > > > | 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 | 'register-server `(,iface ,port ,server-key ,(current-process-id) ,iface ,apath ,dbname))) (define (rmt:get-count-servers remote apath) (rmt:open-main-connection remote apath) ;; we need a channel to main.db (rmt:send-receive-real remote apath ;; params: host port servkey pid ipaddr dbpath (db:run-id->dbname #f) 'get-count-servers `(,apath ))) (define (rmt:deregister-server remote apath iface port server-key dbname) (rmt:open-main-connection remote apath) ;; we need a channel to main.db (rmt:send-receive-real remote apath ;; params: host port servkey pid ipaddr dbpath (db:run-id->dbname #f) 'deregister-server `(,iface ,port |
︙ | ︙ | |||
2182 2183 2184 2185 2186 2187 2188 | (begin (debug:print 0 *default-log-port* "Server stats:") (db:print-current-query-stats))) (let* ((hrs-since-start (/ (- (current-seconds) server-start-time) 3600))) (cond ((and *server-run* (> (+ last-access server-timeout) | | > > > < > > > > | | 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 | (begin (debug:print 0 *default-log-port* "Server stats:") (db:print-current-query-stats))) (let* ((hrs-since-start (/ (- (current-seconds) server-start-time) 3600))) (cond ((and *server-run* (> (+ last-access server-timeout) (current-seconds)) (if is-main (> (rmt:get-count-servers *rmt:remote* *toppath*) 1) #t)) (if (common:low-noise-print 120 "server continuing") (debug:print-info 0 *default-log-port* "Server continuing, seconds since last db access: " (- (current-seconds) last-access))) (loop 0 bad-sync-count (current-milliseconds))) (else (set! *unclean-shutdown* #f) (debug:print-info 0 *default-log-port* "Server timed out. seconds since last db access: " (- (current-seconds) last-access)) (debug:print-info 0 *default-log-port* "Starting to shutdown the server. pid="(current-process-id)) (rmt:server-shutdown) (portlogger:open-run-close portlogger:set-port port "released") (exit) #;(debug:print-info 0 *default-log-port* "Sending 'quit to server, received: " (open-send-receive-nn (conc iface":"port) ;; do this here and not in server-shutdown (sexpr->string 'quit))) ))))))) ;; Call this to start the actual server ;; ;; all routes though here end in exit ... |
︙ | ︙ | |||
2317 2318 2319 2320 2321 2322 2323 | ;; (contacts (alist-ref 'contact attrib)) ;; (mode (alist-ref 'mode attrib)) ) (handle-exceptions exn (let ((emsg ((condition-property-accessor 'exn 'message) exn))) ;; Send notification | | | 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 | ;; (contacts (alist-ref 'contact attrib)) ;; (mode (alist-ref 'mode attrib)) ) (handle-exceptions exn (let ((emsg ((condition-property-accessor 'exn 'message) exn))) ;; Send notification (debug:print 0 *default-log-port* "ERROR: Failed to connect / send to " uri " message was \"" emsg "\", exn=" exn) #f) (nn-connect req uri) ;; (print "Connected to the server " ) (nn-send req msg) ;; (print "Request Sent") ;; receive code here ;;(print (nn-recv req)) |
︙ | ︙ |
Modified tests/unittests/server.scm from [8206b10fe4] to [d241188a2b].
︙ | ︙ | |||
30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 | ;; db:get-dbdat ;; rmt:find-main-server ;; rmt:send-receive-real ;; rmt:send-receive ;; sexpr->string ;; server-ready? ;; rmt:register-server ;; rmt:open-main-connection ;; rmt:general-open-connection ;; rmt:get-conn ;; 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 ) (define *db* (db:setup #f)) ;; these let me cut and paste from source easily | > > | 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 | ;; db:get-dbdat ;; rmt:find-main-server ;; rmt:send-receive-real ;; rmt:send-receive ;; sexpr->string ;; server-ready? ;; rmt:register-server ;; rmt:deregister-server ;; rmt:open-main-connection ;; rmt:general-open-connection ;; rmt:get-conn ;; common:watchdog ;; rmt:find-main-server ;; get-all-server-pkts ;; get-viable-servers ;; get-best-candidate ;; api:run-server-process api:process-request ;; rmt:run ;; rmt:try-start-server ) (define *db* (db:setup #f)) ;; these let me cut and paste from source easily |
︙ | ︙ | |||
65 66 67 68 69 70 71 | (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))) | | > > | | 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 | (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 *rmt:remote* *toppath* iface port server-key dbname (test #f 2 (rmt:get-count-servers *rmt:remote* *toppath*)) (exit) ;; (delete-file* "logs/1.log") ;; (define run-id 1) ;; (test "setup for run" #t (begin (launch:setup) |
︙ | ︙ |