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 ;; |
︙ | ︙ | |||
5562 5563 5564 5565 5566 5567 5568 | (debug:print-info 0 *default-log-port* "Server already removed for "apath", "dbname) ;; at "sinfo ", while trying to register server " host":"port) #f) ;; server already deregistered (begin (sqlite3:execute db "DELETE FROM servers WHERE apath=? AND dbname=?;" ;; (host,port,servkey,pid,ipaddr,apath,dbname) VALUES (?,?,?,?,?,?,?);" ;; host port servkey pid ipaddr apath dbname) #;(db:get-server-info dbstruct apath dbname))))))))) | | > > > > > > > > > > > > | > | 5562 5563 5564 5565 5566 5567 5568 5569 5570 5571 5572 5573 5574 5575 5576 5577 5578 5579 5580 5581 5582 5583 5584 5585 5586 5587 5588 5589 5590 5591 5592 5593 5594 5595 5596 | (debug:print-info 0 *default-log-port* "Server already removed for "apath", "dbname) ;; at "sinfo ", while trying to register server " host":"port) #f) ;; server already deregistered (begin (sqlite3:execute db "DELETE FROM servers WHERE apath=? AND dbname=?;" ;; (host,port,servkey,pid,ipaddr,apath,dbname) VALUES (?,?,?,?,?,?,?);" ;; host port servkey pid ipaddr apath dbname) #;(db:get-server-info dbstruct apath dbname))))))))) (define (db:get-server-info dbstruct apath dbname) (db:with-db dbstruct #f #f (lambda (db) (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].
︙ | ︙ | |||
910 911 912 913 914 915 916 | (let ((newval (conc (args:get-arg "-testpatt") "/" (args:get-arg "-itempatt")))) (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")) | | > | | 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 | (let ((newval (conc (args:get-arg "-testpatt") "/" (args:get-arg "-itempatt")))) (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*) |
︙ | ︙ | |||
2037 2038 2039 2040 2041 2042 2043 | ,port ,server-key ,(current-process-id) ,iface ,apath ,dbname))) | | > > > > > > > | | | | | | | | 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 | ,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 ,server-key ,(current-process-id) ,iface ,apath ,dbname))) (define (http-transport:wait-for-stable-interface #!optional (num-tries-allowed 100)) ;; wait until *server-info* stops changing (let* ((stime (current-seconds))) (let loop ((last-host #f) (last-port #f) (tries 0)) |
︙ | ︙ | |||
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) |
︙ | ︙ |