Overview
| Comment: | fixed readonly watchdog |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.63-readonly |
| Files: | files | file ages | folders |
| SHA1: |
8c83a08f461de6c84ebad8df89f64ed6 |
| User & Date: | bjbarcla on 2017-02-21 21:44:01 |
| Other Links: | branch diff | manifest | tags |
Context
|
2017-02-21
| ||
| 22:18 | fixed bug with waive dialog in dashboard check-in: bc5d8b0c1b user: bjbarcla tags: v1.63-readonly | |
| 21:44 | fixed readonly watchdog check-in: 8c83a08f46 user: bjbarcla tags: v1.63-readonly | |
| 21:06 | wip; readonly watchdog not properly starting. check-in: 1ae7e02473 user: bjbarcla tags: v1.63-readonly | |
Changes
Modified common.scm from [dd5b90ba4c] to [a00194b355].
| ︙ | ︙ | |||
603 604 605 606 607 608 609 | ;; (define (common:readonly-watchdog dbstruct) (thread-sleep! 0.05) ;; delay for startup (BB> "common:readonly-watchdog entered.") ;; sync megatest.db to /tmp/.../megatst.db | | | | | | | | 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 |
;;
(define (common:readonly-watchdog dbstruct)
(thread-sleep! 0.05) ;; delay for startup
(BB> "common:readonly-watchdog entered.")
;; sync megatest.db to /tmp/.../megatst.db
(let* ((sync-cool-off-duration 3)
(golden-mtdb (dbr:dbstruct-mtdb dbstruct))
(golden-mtpath (db:dbdat-get-path golden-mtdb))
(tmp-mtdb (dbr:dbstruct-tmpdb dbstruct))
(tmp-mtpath (db:dbdat-get-path tmp-mtdb)))
(debug:print-info 0 *default-log-port* "Read-only periodic sync thread started.")
(let loop ((last-sync-time 0))
(BB> "loop top tmp-mtpath="tmp-mtpath" golden-mtpath="golden-mtpath)
(let* ((duration-since-last-sync (- (current-seconds) last-sync-time)))
(BB> "duration-since-last-sync="duration-since-last-sync)
(if (and (not *time-to-exit*)
(< duration-since-last-sync sync-cool-off-duration))
(thread-sleep! (- sync-cool-off-duration duration-since-last-sync)))
(if (not *time-to-exit*)
(let ((golden-mtdb-mtime (file-modification-time golden-mtpath))
(tmp-mtdb-mtime (file-modification-time tmp-mtpath)))
(if (> golden-mtdb-mtime tmp-mtdb-mtime)
(let ((res (db:multi-db-sync dbstruct 'old2new)))
(debug:print-info 0 *default-log-port* "rosync called, " res " records transferred.")))
(loop (current-seconds)))
#t)))
(debug:print-info 0 *default-log-port* "Exiting readonly-watchdog timer, *time-to-exit* = " *time-to-exit*" pid="(current-process-id)" mtpath="golden-mtpath)))
(define (common:writable-watchdog dbstruct)
(thread-sleep! 0.05) ;; delay for startup
(let ((legacy-sync (common:run-sync?))
|
| ︙ | ︙ | |||
703 704 705 706 707 708 709 |
;;#t)
(BB> "common:watchdog entered.")
(let ((dbstruct (db:setup)))
(cond
((dbr:dbstruct-read-only dbstruct)
(BB> "loading read-only watchdog")
| | | 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 |
;;#t)
(BB> "common:watchdog entered.")
(let ((dbstruct (db:setup)))
(cond
((dbr:dbstruct-read-only dbstruct)
(BB> "loading read-only watchdog")
(common:readonly-watchdog dbstruct))
(else
(BB> "loading writable-watchdog.")
(common:writable-watchdog dbstruct))))
(BB> "watchdog done.");;)
)
|
| ︙ | ︙ |
Modified db.scm from [728a319e47] to [d266ac8ea7].
| ︙ | ︙ | |||
281 282 283 284 285 286 287 |
(dbfexists (file-exists? (conc dbpath "/megatest.db")))
(tmpdb (db:open-megatest-db path: dbpath)) ;; lock-create-open dbpath db:initialize-main-db))
(mtdb (db:open-megatest-db))
(mtdbpath (db:dbdat-get-path mtdb))
(mtdbexists (file-exists? mtdbpath))
(refndb (db:open-megatest-db path: dbpath name: "megatest_ref.db"))
(write-access (file-write-access? mtdbpath)))
| | | 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 |
(dbfexists (file-exists? (conc dbpath "/megatest.db")))
(tmpdb (db:open-megatest-db path: dbpath)) ;; lock-create-open dbpath db:initialize-main-db))
(mtdb (db:open-megatest-db))
(mtdbpath (db:dbdat-get-path mtdb))
(mtdbexists (file-exists? mtdbpath))
(refndb (db:open-megatest-db path: dbpath name: "megatest_ref.db"))
(write-access (file-write-access? mtdbpath)))
;;(BB> "db:open-db>> mtdbpath="mtdbpath" mtdbexists="mtdbexists" and write-access="write-access)
(if (and dbexists (not write-access))
(begin (set! *db-write-access* #f)
(dbr:dbstruct-read-only-set! dbstruct #t)))
(dbr:dbstruct-mtdb-set! dbstruct mtdb)
(dbr:dbstruct-tmpdb-set! dbstruct tmpdb)
(dbr:dbstruct-dbstack-set! dbstruct (make-stack)) ;; BB: why a stack? Why would the number of db's be indeterminate? Is this a legacy of 1.db 2.db .. ?
(stack-push! (dbr:dbstruct-dbstack dbstruct) tmpdb) ;; olddb is already a (cons db path)
|
| ︙ | ︙ | |||
313 314 315 316 317 318 319 |
(cond
(*dbstruct-db* *dbstruct-db*);; TODO: when multiple areas are supported, this optimization will be a hazard
(else ;;(common:on-homehost?)
(let* ((dbstruct (make-dbr:dbstruct)))
(when (not *toppath*) (launch:setup areapath: areapath))
(db:open-db dbstruct areapath: areapath)
(set! *dbstruct-db* dbstruct)
| | | 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 |
(cond
(*dbstruct-db* *dbstruct-db*);; TODO: when multiple areas are supported, this optimization will be a hazard
(else ;;(common:on-homehost?)
(let* ((dbstruct (make-dbr:dbstruct)))
(when (not *toppath*) (launch:setup areapath: areapath))
(db:open-db dbstruct areapath: areapath)
(set! *dbstruct-db* dbstruct)
;;(BB> "new dbstruct = "(dbr:dbstruct->alist dbstruct))
dbstruct))))
;; (else
;; (debug:print 0 *default-log-port* "ERROR: attempt to open database when not on homehost. Exiting. Homehost: " (common:get-homehost))
;; (exit 1))))
;; Open the classic megatest.db file (defaults to open in toppath)
;;
|
| ︙ | ︙ |