Overview
| Comment: | Fixed several places where an attempt was being made to open databases in spite on NOT being on homehost. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | db-only-on-homehost |
| Files: | files | file ages | folders |
| SHA1: |
6e46d4a93e1eb8ca0ec08183d62a77ae |
| User & Date: | matt on 2017-03-22 13:29:01 |
| Other Links: | branch diff | manifest | tags |
Context
|
2017-03-22
| ||
| 14:44 | applied patches for db init on non-homehost protection & no-cache mode check-in: 9ffefc583c user: bjbarcla tags: v1.63 | |
| 13:29 | Merged in db-only-on-homehost fix check-in: 0044c7f04a user: matt tags: v1.64 | |
| 13:29 | Fixed several places where an attempt was being made to open databases in spite on NOT being on homehost. Closed-Leaf check-in: 6e46d4a93e user: matt tags: db-only-on-homehost | |
|
2017-03-21
| ||
| 11:46 | Added defence against bad sqlite3 handles to the finalizer check-in: 79058725e7 user: matt tags: v1.63 | |
Changes
Modified common.scm from [31405ca571] to [288525016a].
| ︙ | ︙ | |||
271 272 273 274 275 276 277 278 279 |
exn
#f
(delete-file fullname)))))))
'()
"logs"))
;; Force a megatest cleanup-db if version is changed and skip-version-check not specified
;;
(define (common:exit-on-version-changed)
| > < | > | 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 |
exn
#f
(delete-file fullname)))))))
'()
"logs"))
;; Force a megatest cleanup-db if version is changed and skip-version-check not specified
;; Do NOT check if not on homehost!
;;
(define (common:exit-on-version-changed)
(if (common:on-homehost?)
(if (common:version-changed?)
(let* ((mtconf (conc (get-environment-variable "MT_RUN_AREA_HOME") "/megatest.config"))
(dbfile (conc (get-environment-variable "MT_RUN_AREA_HOME") "/megatest.db"))
(read-only (not (file-write-access? dbfile)))
(dbstruct (db:setup)))
(debug:print 0 *default-log-port*
"WARNING: Version mismatch!\n"
" expected: " (common:version-signature) "\n"
|
| ︙ | ︙ | |||
310 311 312 313 314 315 316 |
(debug:print 0 *default-log-port* " You do not own megatest.db in this area. Cannot proceed with megatest version migration.")
(exit 1))
(read-only
(debug:print 0 *default-log-port* " You have read-only access to this area. Cannot proceed with megatest version migration.")
(exit 1))
(else
(debug:print 0 *default-log-port* " to switch versions you can run: \"megatest -cleanup-db\"")
| | | | | | 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 |
(debug:print 0 *default-log-port* " You do not own megatest.db in this area. Cannot proceed with megatest version migration.")
(exit 1))
(read-only
(debug:print 0 *default-log-port* " You have read-only access to this area. Cannot proceed with megatest version migration.")
(exit 1))
(else
(debug:print 0 *default-log-port* " to switch versions you can run: \"megatest -cleanup-db\"")
(exit 1)))))
(begin
(debug:print 0 *default-log-port* "ERROR: cannot migrate version unless on homehost. Exiting.")
(exit 1))))
;;======================================================================
;; S P A R S E A R R A Y S
;;======================================================================
(define (make-sparse-array)
(let ((a (make-sparse-vector)))
|
| ︙ | ︙ | |||
703 704 705 706 707 708 709 | (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) | < | | | | | | | | | | | < > | 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 |
(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)
(debug:print-info 13 *default-log-port* "common:watchdog entered.")
(if (common:on-homehost?)
(let ((dbstruct (db:setup)))
(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.")
(common:writable-watchdog dbstruct)))
(debug:print-info 13 *default-log-port* "watchdog done."))
(debug:print-info 13 *default-log-port* "no need for watchdog on non-homehost")))
(define (std-exit-procedure)
(on-exit (lambda () 0))
;;(debug:print-info 13 *default-log-port* "std-exit-procedure called; *time-to-exit*="*time-to-exit*)
(let ((no-hurry (if *time-to-exit* ;; hurry up
#f
|
| ︙ | ︙ |