Index: dbmod.scm ================================================================== --- dbmod.scm +++ dbmod.scm @@ -252,11 +252,11 @@ (db:get-iam-server-lock dbh dbfile)))) (define (db:with-lock-db dbfile proc) (let* ((dbh (db:open-run-db dbfile db:initialize-db)) (res (proc dbh dbfile))) - (sqlite3:finalize! dbh) + ;; (sqlite3:finalize! dbh) res)) ;; called before db is open? ;; (define (db:get-iam-server-lock dbh dbfname) @@ -656,13 +656,17 @@ #t) ;; if given a number, just use it for all fields ((and (pair? last-update) (member (car last-update) ;; last-update field name (map car fields))) #t) - ((pair? last-update) + ((and (pair? last-update) + (not (number? (cdr last-update)))) (debug:print 0 *default-log-port* "ERROR: parameter last-update malformed. last-update="last-update) #f) + ((and (pair? last-update) + (string? (car last-update))) ;; valid format, field not recognised + #f) ((number? last-update) #f) ;; if not matched first entry then ignore last-update for this table (last-update (debug:print 0 *default-log-port* "ERROR: parameter last-update for db:sync-tables must be a pair or a number, received: " last-update);; found in fields #f) (else Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -786,11 +786,11 @@ (let ((targ (or (args:get-arg "-reqtarg")(args:get-arg "-target")))) (if targ (setenv "MT_TARGET" targ))) ;; The watchdog is to keep an eye on things like db sync etc. ;; -(init-watchdog) +;; (init-watchdog) ;; (define (debug:debug-mode n) ;; (cond ;; ((and (number? *verbosity*) ;; number number ;; (number? n)) Index: rmtmod.scm ================================================================== --- rmtmod.scm +++ rmtmod.scm @@ -1466,14 +1466,23 @@ (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*)) + (apath *toppath*) + (dbdat (db:get-dbdat *dbstruct-db* apath dbfile)) + (db (dbr:dbdat-db dbdat)) + (inmem (dbr:dbdat-db dbdat)) + ) ;; 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) + ;; let's finalize here + (debug:print-info 0 *default-log-port* "Finalizing db and inmem") + (sqlite3:finalize! db) + (sqlite3:finalize! inmem) + (debug:print-info 0 *default-log-port* "Finalizing db and inmem complete") (if am-server (if (string-match ".*/main.db$" dbfile) (let ((pkt-file (conc (get-pkts-dir *toppath*) "/" (servdat-uuid *server-info*) ".pkt"))) @@ -1515,11 +1524,13 @@ (let ((th1 (make-thread (lambda () ;; thread for cleaning up, give it five seconds (let* ((start-time (current-seconds))) (if (and *server-info* *unclean-shutdown*) - (rmt:server-shutdown)) + (begin + (debug:print-info 0 *default-log-port* "Unclean server exit, calling server-shtudown") + (rmt:server-shutdown))) (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) @@ -1617,11 +1628,32 @@ (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") - (debug:print 1 *default-log-port* "INFO: server has been stopped")))) + (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*) + ;; (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 " + ;; (if (eq? *number-of-writes* 0) + ;; "n/a (no writes)" + ;; (/ *writes-total-delay* + ;; *number-of-writes*)) + ;; " ms") + ;; (debug:print-info 0 *default-log-port* "Number non-cached queries " *number-non-write-queries*) + ;; (debug:print-info 0 *default-log-port* "Average non-cached time " + ;; (if (eq? *number-non-write-queries* 0) + ;; "n/a (no queries)" + ;; (/ *total-non-write-delay* + ;; *number-non-write-queries*)) + ;; " ms") + + (db:print-current-query-stats) + (debug:print-info 0 *default-log-port* "Server shutdown complete. Exiting") + ))) (define (rmt:try-start-server ipaddrstr portnum) (if *server-info* ;; update the server info as we might be trying next port (begin (servdat-host-set! *server-info* ipaddrstr) @@ -2157,62 +2189,26 @@ (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 + (set! *unclean-shutdown* #f) + (debug:print-info 0 *default-log-port* "Starting to shutdown the server. pid="(current-process-id)) (debug:print-info 0 *default-log-port* "Server timed out. seconds since last db access: " (- (current-seconds) last-access)) - (open-send-receive-nn (conc iface":"port) ;; do this here and not in server-shutdown - (sexpr->string 'quit)) - (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)) - ;; - ;; start_shutdown - ;; - - ;; deregister the server - (rmt:server-shutdown) - (set! *unclean-shutdown* #f) - - (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 - (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 " - ;; (if (eq? *number-of-writes* 0) - ;; "n/a (no writes)" - ;; (/ *writes-total-delay* - ;; *number-of-writes*)) - ;; " ms") - ;; (debug:print-info 0 *default-log-port* "Number non-cached queries " *number-non-write-queries*) - ;; (debug:print-info 0 *default-log-port* "Average non-cached time " - ;; (if (eq? *number-non-write-queries* 0) - ;; "n/a (no queries)" - ;; (/ *total-non-write-delay* - ;; *number-non-write-queries*)) - ;; " ms") - - (db:print-current-query-stats) - #;(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))) + (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 ... ;; ;; This is the point at which servers are started ;; (define (rmt:server-launch dbname) + (debug:print-info 0 *default-log-port* "Entered rmt:server-launch") (let* ((th2 (make-thread (lambda () (debug:print-info 0 *default-log-port* "Server run thread started") (rmt:run (if (args:get-arg "-server") (args:get-arg "-server") "-") @@ -2224,12 +2220,13 @@ (thread-start! th2) (thread-sleep! 0.252) ;; give the server time to settle before starting the keep-running monitor. (thread-start! th3) (set! *didsomething* #t) (thread-join! th2) - (exit)) - + (thread-join! th3) + ;; (exit)) + ) #f ) ;; Generate a unique signature for this process, used at both client and ;; server side