5006
5007
5008
5009
5010
5011
5012
5013
5014
5015
5016
5017
5018
5019
5020
5021
5022
5023
5024
5025
|
5006
5007
5008
5009
5010
5011
5012
5013
5014
5015
5016
5017
5018
5019
5020
5021
5022
5023
5024
5025
5026
5027
|
-
+
+
+
|
(debug:print-info 13 *default-log-port* "after db:setup with dbstruct=" dbstruct)
(cond
((dbr:dbstruct-read-only dbstruct)
(debug:print-info 13 *default-log-port* "loading read-only watchdog")
(common:readonly-watchdog dbstruct))
(else
(debug:print-info 13 *default-log-port* "loading writable-watchdog.")
(let* ((syncer (or (configf:lookup *configdat* "server" "sync-method") "delta-sync"))) ;; "brute-force-sync")))
(let* ((syncer (or (configf:lookup *configdat* "server" "sync-method") "copy-sync"))) ;; "delta-sync"))) ;; "brute-force-sync")))
(cond
((equal? syncer "brute-force-sync")
(server:writable-watchdog-bruteforce dbstruct))
((equal? syncer "delta-sync")
(server:writable-watchdog-deltasync dbstruct))
((equal? syncer "copy-sync")
(server:writable-watchdog-copysync dbstruct))
(else
(debug:print-error 0 *default-log-port* "Unknown server/sync-method specified ("syncer") - valid values are brute-force-sync and delta-sync.")
(exit 1)))
;;(debug:print 1 *default-log-port* "INFO: ["(common:human-time)"] Syncer started (method="syncer")")
)))
(debug:print-info 13 *default-log-port* "watchdog done."))
(debug:print-info 13 *default-log-port* "no need for watchdog on non-homehost"))))
|
5038
5039
5040
5041
5042
5043
5044
5045
5046
5047
5048
5049
5050
5051
|
5040
5041
5042
5043
5044
5045
5046
5047
5048
5049
5050
5051
5052
5053
5054
5055
5056
5057
5058
5059
5060
5061
5062
5063
5064
5065
5066
5067
5068
5069
5070
5071
5072
5073
5074
5075
5076
5077
5078
5079
5080
5081
5082
5083
5084
5085
5086
5087
5088
5089
5090
5091
5092
5093
5094
5095
5096
5097
5098
5099
5100
5101
5102
5103
5104
5105
5106
5107
5108
5109
5110
5111
5112
5113
5114
5115
5116
5117
5118
5119
5120
5121
5122
5123
5124
5125
5126
5127
5128
5129
5130
5131
5132
5133
5134
5135
5136
5137
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
;; time to exit, close the no-sync db here
(final-sync)
(if (common:low-noise-print 30)
(debug:print-info 0 *default-log-port* "Exiting watchdog timer, *time-to-exit* = " *time-to-exit*" pid="(current-process-id)
)))))
(define (db:lock-and-sync no-sync-db from-db to-db)
(assert (not *db-sync-in-progress*) "FATAL: db:lock-and-sync called while a sync is in progress.")
(let* ((lockdat (db:no-sync-get-lock no-sync-db from-db))
(gotlock (car lockdat))
(locktime (cdr lockdat)))
(if gotlock
(begin
(file-copy from-db to-db)
(db:no-sync-del! no-sync-db keyname)
#t)
#f)))
;; straight forward copy based sync
;; 1. for each .db file
;; 2. next if file changed since last sync cycle
;; 2. next if time delta /tmp file to MTRA less than 3 seconds
;; 3. get a lock for the file in nosyncdb
;; 4. copy the file
;; 5. when copy is done release the lock
;;
;; DONE
(define (server:writable-watchdog-copysync dbstruct)
(thread-sleep! 0.05) ;; delay for startup
(let ((legacy-sync (common:run-sync?))
(sync-stale-seconds (configf:lookup-number *configdat* "server" "sync-stale-seconds" default: 300))
(debug-mode (debug:debug-mode 1))
(last-time (current-seconds)) ;; last time through the sync loop
(no-sync-db (db:open-no-sync-db))
(sync-duration 0) ;; run time of the sync in milliseconds
(tmp-area (common:get-db-tmp-area)))
(set! *no-sync-db* no-sync-db) ;; make the no sync db available to api calls
(debug:print-info 2 *default-log-port* "Periodic sync thread started.")
(debug:print-info 3 *default-log-port* "watchdog starting. legacy-sync is "legacy-sync" pid="(current-process-id));; " this-wd-num="this-wd-num)
(if (and legacy-sync (not *time-to-exit*))
(begin
(debug:print-info 0 *default-log-port* "Server running, periodic sync started.")
(let loop ()
;; sync for filesystem local db writes
;;
(let* ((dbfiles (glob (conc tmp-area"/.db/*.db"))))
(for-each
(lambda (file)
(let* ((fname (pathname-file file))
(fulln (conc *top-level*"/.db/"fname))
(time1 (file-modification-time fname))
(time2 (file-modification-time fulln))
(changed (>= time1 time2))
(do-cp (cond
((not (file-exists? fulln)) ;; shouldn't happen, but this might recover
(debug:print-info 0 "File "fulln" not found! Copying "fname" to "fulln)
#t)
((and changed
(> (- (current-seconds) time1) 3)) ;; if file is changed and three seconds have passed.
#t)
((and changed *time-to-exit*) ;; last copy
#t)
(else
#f))))
(if do-cp
(let* ((start-time (current-milliseconds)))
(db:lock-and-sync no-sync-db fname fulln)
(set! sync-duration (- (current-milliseconds) start-time))))))
dbfile))
;; keep going unless time to exit
;;
(if (not *time-to-exit*)
(let delay-loop ((count 0))
;;(debug:print-info 13 *default-log-port* "delay-loop top; count="count" pid="(current-process-id)" this-wd-num="this-wd-num" *time-to-exit*="*time-to-exit*)
(if (and (not *time-to-exit*)
(< count 6)) ;; was 11, changing to 4.
(begin
(thread-sleep! 1)
(delay-loop (+ count 1))))
(if (not *time-to-exit*) (loop))))
;; ==> ;; time to exit, close the no-sync db here
;; ==> (db:no-sync-close-db no-sync-db stmt-cache)
(if (common:low-noise-print 30)
(debug:print-info 0 *default-log-port* "Exiting watchdog timer, *time-to-exit* = "
*time-to-exit*" pid="(current-process-id) )))))))
(define (server:writable-watchdog-deltasync dbstruct)
;; This is awful complex and convoluted. Plan to redo?
;; for now ... skip it.
;; ==>
;; ==> (thread-sleep! 0.05) ;; delay for startup
;; ==> (let ((legacy-sync (common:run-sync?))
;; ==> (sync-stale-seconds (configf:lookup-number *configdat* "server" "sync-stale-seconds" default: 300))
|