Overview
Comment: | Added simple copy-sync method (not yet working) |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.7001-multi-db-rb01 |
Files: | files | file ages | folders |
SHA1: |
b439dea6cd3f65eccb0fac8cd926c04a |
User & Date: | matt on 2022-04-06 20:32:09 |
Other Links: | branch diff | manifest | tags |
Context
2022-04-07
| ||
05:16 | wip check-in: ad6bc47730 user: matt tags: v1.7001-multi-db-rb01 | |
2022-04-06
| ||
20:32 | Added simple copy-sync method (not yet working) check-in: b439dea6cd user: matt tags: v1.7001-multi-db-rb01 | |
18:21 | fixed readonly detection check-in: 51deb29dc4 user: mmgraham tags: v1.7001-multi-db-rb01 | |
Changes
Modified db.scm from [5b6dbaca58] to [21e7872cdd].
︙ | |||
5006 5007 5008 5009 5010 5011 5012 | 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.") |
︙ | |||
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)) |
︙ |