Index: rmtmod.scm ================================================================== --- rmtmod.scm +++ rmtmod.scm @@ -251,11 +251,10 @@ (mconn (rmt:get-conn remote apath mdbname))) (cond ((or (not mconn) ;; no channel open to main? (< (rmt:conn-expires mconn)(+ (current-seconds) 2))) ;; restablish connection if less than 2 seconds on the lease (rmt:open-main-connection remote apath) - (thread-sleep! 2) (rmt:general-open-connection remote apath mdbname)) ((not (rmt:get-conn remote apath dbname)) ;; no channel open to dbname? (let* ((res (rmt:send-receive-real remote apath mdbname 'get-server `(,apath ,dbname)))) (case res ((server-started) @@ -274,11 +273,13 @@ ;; "/home/matt/data/megatest/tests/simplerun" ;; ".db/1.db") (match res ((host port servkey pid ipaddr apath dbname) + (debug:print-info 0 *default-log-port* "got "res) (hash-table-set! (rmt:remote-conns remote) + dbname (make-rmt:conn apath: apath dbname: dbname hostport: (conc host":"port) ipaddr: ipaddr @@ -1471,64 +1472,56 @@ (bdat-time-to-exit-set! *bdat* #t) #t)))) (debug:print-info 4 *default-log-port* "starting exit process, finalizing databases.") (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 - (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)) - (db:sync-inmem->disk *dbstruct-db* apath dbfile) - (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) - (debug:print-info 0 *default-log-port* "Releasing lock for "dbfile) - (db:with-lock-db (servdat-dbfile *server-info*) - (lambda (dbh dbfile) - (db:release-lock dbh dbfile)))) - (let* ((sdat *server-info*) ;; we have a run-id server - (host (servdat-host sdat)) - (port (servdat-port sdat)) - (uuid (servdat-uuid sdat))) - (debug:print-info 0 *default-log-port* "deregistering server "host":"port" with uuid "uuid) - #;(rmt:send-receive-real *rmt:remote* *toppath* - (db:run-id->dbname #f) - 'deregister-server - `(,(servdat-uuid sdat) - ,(current-process-id) - ,(servdat-host sdat) ;; iface - ,(servdat-port sdat))) - (rmt:send-receive 'deregister-server #f - `(,(servdat-uuid sdat) - ,(current-process-id) - ,(servdat-host sdat) ;; iface - ,(servdat-port sdat))) - ))))))) - ;; (if *dbstruct-db* (db:close-all *dbstruct-db*)) ;; one second allocated - #;(if (bdat-task-db *bdat*) ;; TODO: Check that this is correct for task db - (let ((db (cdr (bdat-task-db *bdat*)))) - (if (sqlite3:database? db) - (begin - (debug:print-info 0 *default-log-port* "Closing down task db "db) - (sqlite3:interrupt! db) - (sqlite3:finalize! db #t) - (bdat-task-db-set! *bdat* #f))))) - #;(http-client#close-idle-connections!) - (if (not (eq? *default-log-port* (current-error-port))) - (close-output-port *default-log-port*)) - (set! *default-log-port* (current-error-port))) "Cleanup db exit thread")) + (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)) + (db:sync-inmem->disk *dbstruct-db* apath dbfile) + (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) + (debug:print-info 0 *default-log-port* "Releasing lock for "dbfile) + (db:with-lock-db (servdat-dbfile *server-info*) + (lambda (dbh dbfile) + (db:release-lock dbh dbfile)))) + (let* ((sdat *server-info*) ;; we have a run-id server + (host (servdat-host sdat)) + (port (servdat-port sdat)) + (uuid (servdat-uuid sdat))) + (debug:print-info 0 *default-log-port* "deregistering server "host":"port" with uuid "uuid) + ))))))) + (debug:print-info 0 *default-log-port* "Shutdown activities completed in "(- (current-seconds) start-time)" seconds")) + ;; (if *dbstruct-db* (db:close-all *dbstruct-db*)) ;; one second allocated + #;(if (bdat-task-db *bdat*) ;; TODO: Check that this is correct for task db + (let ((db (cdr (bdat-task-db *bdat*)))) + (if (sqlite3:database? db) + (begin + (debug:print-info 0 *default-log-port* "Closing down task db "db) + (sqlite3:interrupt! db) + (sqlite3:finalize! db #t) + (bdat-task-db-set! *bdat* #f))))) + #;(http-client#close-idle-connections!) + (if (not (eq? *default-log-port* (current-error-port))) + (close-output-port *default-log-port*)) + (set! *default-log-port* (current-error-port))) "Cleanup db exit thread")) (th2 (make-thread (lambda () - (debug:print 4 *default-log-port* "Attempting clean exit. Please be patient and wait a few seconds...") + (debug:print 4 *default-log-port* "Attempting clean exit. Mode="(if no-hurry "no-hurry" "normal") + " Please be patient and wait a few seconds...") (if no-hurry (begin (thread-sleep! 5)) ;; give the clean up few seconds to do it's stuff (begin (thread-sleep! 2))) @@ -2125,10 +2118,17 @@ (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:send-receive 'deregister-server #f + `(,(servdat-uuid sdat) + ,(current-process-id) + ,(servdat-host sdat) ;; iface + ,(servdat-port sdat))))) + (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") @@ -2139,11 +2139,11 @@ ;; deregister the server (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") + ;; (portlogger:open-run-close portlogger:set-port port "released") ;; done in rmt:run (thread-sleep! 1) ;; (debug:print-info 0 *default-log-port* "Max cached queries was " *max-cache-size*) ;; (debug:print-info 0 *default-log-port* "Number of cached writes " *number-of-writes*) ;; (debug:print-info 0 *default-log-port* "Average cached write time " @@ -2159,11 +2159,11 @@ ;; (/ *total-non-write-delay* ;; *number-non-write-queries*)) ;; " ms") (db:print-current-query-stats) - (common:save-pkt `((action . exit) + #;(common:save-pkt `((action . exit) (T . server) (pid . ,(current-process-id))) *configdat* #t) (debug:print-info 0 *default-log-port* "Server shutdown complete. Exiting") (exit)))