Overview
| Comment: | fixed bug with loading area from Matt |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.63-readonly |
| Files: | files | file ages | folders |
| SHA1: |
8caaed509407bd5522d5075a7b4e05f7 |
| User & Date: | bjbarcla on 2017-02-21 17:10:38 |
| Other Links: | branch diff | manifest | tags |
Context
|
2017-02-21
| ||
| 17:54 | wip; readonly watchdog not properly starting. check-in: a7af13fe19 user: bjbarcla tags: v1.63-readonly | |
| 17:10 | fixed bug with loading area from Matt check-in: 8caaed5094 user: bjbarcla tags: v1.63-readonly | |
| 16:52 | fixed bug with loading area from Matt check-in: 6555418e4b user: bjbarcla tags: v1.63-readonly | |
Changes
Modified common.scm from [0ca3492ab6] to [3cdabe2c3a].
| ︙ | ︙ | |||
601 602 603 604 605 606 607 | ;; currently the primary job of the watchdog is to run the sync back to megatest.db from the db in /tmp ;; if we are on the homehost and we are a server (by definition we are on the homehost if we are a server) ;; (define (common:readonly-watchdog dbstruct) (thread-sleep! 0.05) ;; delay for startup | | > > | 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 |
;; currently the primary job of the watchdog is to run the sync back to megatest.db from the db in /tmp
;; if we are on the homehost and we are a server (by definition we are on the homehost if we are a server)
;;
(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 mtdb))
(tmp-mtdb (dbr:dbstruct-tmpdb dbstruct))
(tmp-mtpath (db:dbdat-get-path 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)
|
| ︙ | ︙ | |||
694 695 696 697 698 699 700 701 702 703 704 705 706 707 |
(delay-loop (+ count 1))))
(if (not *time-to-exit*) (loop))))
(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)" this-wd-num="this-wd-num)))))))
;; TODO: for multiple areas, we will have multiple watchdogs; and multiple threads to manage
(define (common:watchdog)
(let ((dbstruct (db:setup)))
(if (dbr:dbstruct-read-only dbstruct)
(common:readonly-watchdog dbstruct)
(common:writable-watchdog dbstruct))))
(define (std-exit-procedure)
| > | 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 |
(delay-loop (+ count 1))))
(if (not *time-to-exit*) (loop))))
(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)" this-wd-num="this-wd-num)))))))
;; TODO: for multiple areas, we will have multiple watchdogs; and multiple threads to manage
(define (common:watchdog)
(BB> "common:watchdog entered.")
(let ((dbstruct (db:setup)))
(if (dbr:dbstruct-read-only dbstruct)
(common:readonly-watchdog dbstruct)
(common:writable-watchdog dbstruct))))
(define (std-exit-procedure)
|
| ︙ | ︙ |
Modified dashboard.scm from [ad4ea3ee41] to [b9f4401444].
| ︙ | ︙ | |||
110 111 112 113 114 115 116 |
(if (not (launch:setup))
(begin
(print "Failed to find megatest.config, exiting")
(exit 1)))
;; create a watch dog to move changes from lt/.db/*.db to megatest.db
;;
| | | | 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 |
(if (not (launch:setup))
(begin
(print "Failed to find megatest.config, exiting")
(exit 1)))
;; create a watch dog to move changes from lt/.db/*.db to megatest.db
;;
;;;(if (file-write-access? (conc *toppath* "/megatest.db"))
(thread-start! (make-thread common:watchdog "Watchdog thread"))
(if (not (args:get-arg "-use-db-cache"))
(begin
(debug:print-info 0 *default-log-port* "Forcing db-cache mode due to read-only access to megatest.db")
(hash-table-set! args:arg-hash "-use-db-cache" #t)));;;)
;; data common to all tabs goes here
;;
(defstruct dboard:commondat
((curr-tab-num 0) : number)
please-update
tabdats
|
| ︙ | ︙ |