Overview
| Comment: | Merged in db-only-on-homehost fix |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.64 |
| Files: | files | file ages | folders |
| SHA1: |
0044c7f04a56ede11222b59918a61533 |
| User & Date: | matt on 2017-03-22 13:29:57 |
| Other Links: | branch diff | manifest | tags |
Context
|
2017-03-24
| ||
| 22:39 | Merged v1.63 changes into v1.64 check-in: b2e6452e2f user: matt tags: v1.64 | |
| 22:18 | non-good commit of merge multi-server-hack into v1.64 Leaf check-in: 42e2fcd1c8 user: matt tags: private (unpublished) | |
|
2017-03-22
| ||
| 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 | |
| 12:53 | Cleaned out handful of not used globals and added exception handler for dealing with problems when switching log file output port check-in: f61cc5eb98 user: matt tags: v1.64 | |
Changes
Modified common.scm from [3ce2c22c8f] to [0b58394952].
| ︙ | ︙ | |||
276 277 278 279 280 281 282 283 284 |
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)
| > < | > | 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 |
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"
|
| ︙ | ︙ | |||
315 316 317 318 319 320 321 |
(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\"")
| | | | | | 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 |
(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)))
|
| ︙ | ︙ | |||
716 717 718 719 720 721 722 | (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) | < | | | | | | | | | | | < > | 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 |
(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
|
| ︙ | ︙ |