Overview
| Comment: | resolved deadlock in db:setup; fixed read-only detection in db migration proc |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.63-readonly |
| Files: | files | file ages | folders |
| SHA1: |
ee0d52f1d2083095a76895346a4a87a5 |
| User & Date: | bjbarcla on 2017-02-21 14:28:31 |
| Other Links: | branch diff | manifest | tags |
Context
|
2017-02-21
| ||
| 16:49 | fixed bug with loading area from Matt check-in: 044051d315 user: bjbarcla tags: v1.63-readonly | |
| 14:28 | resolved deadlock in db:setup; fixed read-only detection in db migration proc check-in: ee0d52f1d2 user: bjbarcla tags: v1.63-readonly | |
| 14:03 | fixed gross bugs; first time ovbserved read-only mode working (-list-runs) check-in: 6d7e5ab283 user: bjbarcla tags: v1.63-readonly | |
Changes
Modified common.scm from [b1fdaa9a5c] to [892351b73c].
| ︙ | ︙ | |||
270 271 272 273 274 275 276 |
"logs"))
;; Force a megatest cleanup-db if version is changed and skip-version-check not specified
;;
(define (common:exit-on-version-changed)
(if (common:version-changed?)
(if (common:on-homehost?)
| | > > | > | | < | | | | | | | | | > > > > > > > > > > > > | | | | 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 |
"logs"))
;; Force a megatest cleanup-db if version is changed and skip-version-check not specified
;;
(define (common:exit-on-version-changed)
(if (common:version-changed?)
(if (common:on-homehost?)
(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"
" got: " (common:get-last-run-version))
(cond
((and (file-exists? mtconf) (file-exists? dbfile) (not read-only)
(eq? (current-user-id)(file-owner mtconf))) ;; safe to run -cleanup-db
(debug:print 0 *default-log-port* " I see you are the owner of megatest.config, attempting to cleanup and reset to new version")
(handle-exceptions
exn
(begin
(debug:print 0 *default-log-port* "Failed to switch versions.")
(debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
(print-call-chain (current-error-port))
(exit 1))
(common:cleanup-db dbstruct)))
((not (file-exists? mtconf))
(debug:print 0 *default-log-port* " megatest.config does not exist in this area. Cannot proceed with megatest version migration.")
(exit 1))
((not (file-exists? dbfile))
(debug:print 0 *default-log-port* " megatest.db does not exist in this area. Cannot proceed with megatest version migration.")
(exit 1))
((not (eq? (current-user-id)(file-owner mtconf)))
(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
;;======================================================================
|
| ︙ | ︙ |
Modified db.scm from [5de40dea1a] to [ef6be90d9f].
| ︙ | ︙ | |||
307 308 309 310 311 312 313 |
;;
(define (db:setup #!key (areapath #f))
;;
(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)))
| | | 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 |
;;
(define (db:setup #!key (areapath #f))
;;
(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)
dbstruct))))
;; (else
;; (debug:print 0 *default-log-port* "ERROR: attempt to open database when not on homehost. Exiting. Homehost: " (common:get-homehost))
;; (exit 1))))
|
| ︙ | ︙ |