Overview
| Comment: | wip |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.6584-nanomsg |
| Files: | files | file ages | folders |
| SHA1: |
17e7810cad9e71cf595b9a6ce5008d9c |
| User & Date: | matt on 2021-06-15 05:19:06 |
| Other Links: | branch diff | manifest | tags |
Context
|
2021-06-15
| ||
| 05:37 | sync-inmem fixes check-in: 38fe57c824 user: matt tags: v1.6584-nanomsg | |
| 05:19 | wip check-in: 17e7810cad user: matt tags: v1.6584-nanomsg | |
|
2021-06-14
| ||
| 05:50 | wip check-in: 07e285fe2b user: matt tags: v1.6584-nanomsg | |
Changes
Modified apimod.scm from [f4ca251106] to [f3c5575922].
| ︙ | ︙ | |||
198 199 200 201 202 203 204 205 206 207 208 209 210 211 |
((get-keys-write) (db:get-keys dbstruct)) ;; force a dummy "write" query to force server; for debug in -repl
;; 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)
;; 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)
| > | 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 |
((get-keys-write) (db:get-keys dbstruct)) ;; force a dummy "write" query to force server; for debug in -repl
;; 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)
|
| ︙ | ︙ |
Modified dbmod.scm from [2aad81d989] to [b18980d578].
| ︙ | ︙ | |||
419 420 421 422 423 424 425 | (define (db:sync-inmem->disk dbstruct apath dbfile #!key (force-sync #f)) (let* ((dbdat (db:get-dbdat dbstruct apath dbfile)) (db (dbr:dbdat-db dbdat)) (inmem (dbr:dbdat-inmem dbdat)) (start-t (current-seconds)) (last-update (dbr:dbdat-last-write dbdat)) (last-sync (dbr:dbdat-last-sync dbdat))) | | > | > < | 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 |
(define (db:sync-inmem->disk dbstruct apath dbfile #!key (force-sync #f))
(let* ((dbdat (db:get-dbdat dbstruct apath dbfile))
(db (dbr:dbdat-db dbdat))
(inmem (dbr:dbdat-inmem dbdat))
(start-t (current-seconds))
(last-update (dbr:dbdat-last-write dbdat))
(last-sync (dbr:dbdat-last-sync dbdat)))
(debug:print-info 0 *default-log-port* "Syncing for dbfile: "dbfile", last-update: "last-update", last-sync: "last-sync)
(mutex-lock! *db-multi-sync-mutex*)
(let* ((update_info (cons (if force-sync 0 last-update) "last_update"))
(need-sync (or force-sync (>= last-update last-sync))))
(if need-sync
(begin
(db:sync-tables (db:sync-all-tables-list) update_info inmem db)
(dbr:dbdat-last-sync-set! dbdat start-t))
(debug:print 0 *default-log-port* "Skipping sync as nothing touched.")))
(mutex-unlock! *db-multi-sync-mutex*)))
;; TODO: Add final sync to this
;;
(define (db:safely-close-sqlite3-db db stmt-cache #!key (try-num 3))
(if (<= try-num 0)
#f
|
| ︙ | ︙ | |||
796 797 798 799 800 801 802 |
(if should-print (debug:print 3 *default-log-port* "INFO: db sync, total run time " runtime " ms"))
(for-each
(lambda (dat)
(let ((tblname (car dat))
(count (cdr dat)))
(set! tot-count (+ tot-count count))
(if (> count 0)
| | | 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 |
(if should-print (debug:print 3 *default-log-port* "INFO: db sync, total run time " runtime " ms"))
(for-each
(lambda (dat)
(let ((tblname (car dat))
(count (cdr dat)))
(set! tot-count (+ tot-count count))
(if (> count 0)
(if should-print (debug:print 0 *default-log-port* " "tblname" "count))))) ;; (format #f " ~10a ~5a" tblname count))))))
(sort (hash-table->alist numrecs)(lambda (a b)(> (cdr a)(cdr b))))))
tot-count))
(define (db:patch-schema-rundb frundb)
;;
;; remove this some time after September 2016 (added in version v1.6031
;;
|
| ︙ | ︙ | |||
5534 5535 5536 5537 5538 5539 5540 5541 5542 5543 5544 5545 5546 5547 |
(begin
(debug:print-info 0 *default-log-port* "Server already running at "sinfo ", while trying to register server " host":"port)
#f) ;; server already registered
(begin
(sqlite3:execute db "INSERT INTO servers (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
| > > > > > > > > > > > > > > > > > > > > | 5535 5536 5537 5538 5539 5540 5541 5542 5543 5544 5545 5546 5547 5548 5549 5550 5551 5552 5553 5554 5555 5556 5557 5558 5559 5560 5561 5562 5563 5564 5565 5566 5567 5568 |
(begin
(debug:print-info 0 *default-log-port* "Server already running at "sinfo ", while trying to register server " host":"port)
#f) ;; server already registered
(begin
(sqlite3:execute db "INSERT INTO servers (host,port,servkey,pid,ipaddr,apath,dbname) VALUES (?,?,?,?,?,?,?);"
host port servkey pid ipaddr apath dbname)
(db:get-server-info dbstruct apath dbname)))))))))
;; run this one in a transaction where first check if host:port is taken
(define (db:deregister-server dbstruct host port servkey pid ipaddr apath dbname)
(db:with-db
dbstruct
#f #f
(lambda (db)
(sqlite3:with-transaction
db
(lambda ()
(let* ((sinfo (db:get-server-info dbstruct apath dbname)))
(if (not sinfo)
(begin
(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
|
| ︙ | ︙ |
Modified rmtmod.scm from [7976b7c5ac] to [4daf554596].
| ︙ | ︙ | |||
1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 |
(if (and no-hurry (debug:debug-mode 18))
(rmt:print-db-stats))
(let ((th1 (make-thread
(lambda () ;; thread for cleaning up, give it five seconds
(let* ((start-time (current-seconds)))
(if *server-info*
(let ((dbfile (servdat-dbfile *server-info*)))
(if dbfile
(let* ((am-server (args:get-arg "-server"))
(dbfile (args:get-arg "-db"))
(apath *toppath*))
;; do a final sync here
(debug:print-info 0 *default-log-port* "Doing final sync for "apath" "dbfile" at "(current-seconds))
| > | | 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 |
(if (and no-hurry (debug:debug-mode 18))
(rmt:print-db-stats))
(let ((th1 (make-thread
(lambda () ;; thread for cleaning up, give it five seconds
(let* ((start-time (current-seconds)))
(if *server-info*
(let ((dbfile (servdat-dbfile *server-info*)))
(debug:print-info 0 *default-log-port* "dbfile is "dbfile)
(if dbfile
(let* ((am-server (args:get-arg "-server"))
(dbfile (args:get-arg "-db"))
(apath *toppath*))
;; do a final sync here
(debug:print-info 0 *default-log-port* "Doing final sync for "apath" "dbfile" at "(current-seconds))
(db:sync-inmem->disk *dbstruct-db* apath dbfile force-sync: #t)
(if am-server
(if (string-match ".*/main.db$" dbfile)
(let ((pkt-file (conc (get-pkts-dir *toppath*)
"/" (servdat-uuid *server-info*)
".pkt")))
(debug:print-info 0 *default-log-port* "removing pkt "pkt-file)
(delete-file* pkt-file)
|
| ︙ | ︙ | |||
1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 |
'register-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))
| > > > > > > > > > > > > | 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 |
'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
,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))
|
| ︙ | ︙ | |||
2117 2118 2119 2120 2121 2122 2123 | (current-seconds))) (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 (debug:print-info 0 *default-log-port* "Server timed out. seconds since last db access: " (- (current-seconds) last-access)) (if (not (string-match ".db/main.db" (args:get-arg "-db"))) | | > > > | | < | | | 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 |
(current-seconds)))
(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
(debug:print-info 0 *default-log-port* "Server timed out. seconds since last db access: " (- (current-seconds) last-access))
(if (not (string-match ".db/main.db" (args:get-arg "-db")))
(let* ((res (rmt:deregister-server *rmt:remote* ;; TODO/BUG: why is this requiring *rmt:remote*?
*toppath*
(servdat-host *server-info*) ;; iface
(servdat-port *server-info*)
(servdat-uuid *server-info*)
(current-process-id)
)))
(debug:print-info 0 *default-log-port* "deregistered-server, res="res)))
(http-transport:server-shutdown port))))))))
(define (http-transport:server-shutdown port)
(begin
;;(BB> "http-transport:server-shutdown called")
(debug:print-info 0 *default-log-port* "Starting to shutdown the server. pid="(current-process-id))
;;
|
| ︙ | ︙ |
Modified tests/unittests/server.scm from [e73368a0f2] to [8206b10fe4].
| ︙ | ︙ | |||
30 31 32 33 34 35 36 | ;; db:get-dbdat ;; rmt:find-main-server ;; rmt:send-receive-real ;; rmt:send-receive ;; sexpr->string ;; server-ready? ;; rmt:register-server | | | | | 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 | ;; 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 |
| ︙ | ︙ |