Megatest

Check-in [6d7e5ab283]
Login
Overview
Comment:fixed gross bugs; first time ovbserved read-only mode working (-list-runs)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.63-readonly
Files: files | file ages | folders
SHA1: 6d7e5ab283a2129e97f04b1d2298faaf986f59e4
User & Date: bjbarcla on 2017-02-21 14:03:33
Other Links: branch diff | manifest | tags
Context
2017-02-21
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
2017-02-17
17:46
opened db:setup to non-homehost check-in: f2bcff013a user: bjbarcla tags: v1.63-readonly
Changes

Modified common.scm from [55464285e8] to [b1fdaa9a5c].

680
681
682
683
684
685
686
687

688
689
690
691
692
693
694
680
681
682
683
684
685
686

687
688
689
690
691
692
693
694







-
+







		  (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 (dbstruct-readonly dbstruct)
    (if (dbr:dbstruct-read-only dbstruct)
        (common:readonly-watchdog dbstruct)
        (common:writable-watchdog dbstruct))))


(define (std-exit-procedure)
  (on-exit (lambda () 0))
  ;;(BB> "std-exit-procedure called; *time-to-exit*="*time-to-exit*)

Modified db.scm from [0e0ff10fa7] to [5de40dea1a].

302
303
304
305
306
307
308

309
310
311
312

313
314
315
316
317
318
319
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321







+




+







          tmpdb))))

;; Make the dbstruct, setup up auxillary db's and call for main db at least once
;;
;; called in http-transport and replicated in rmt.scm for *local* access. 
;;
(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)))
      (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))))

Modified launch.scm from [fb952635f4] to [2637c367a8].

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
744
745
746
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
744
745
746







-
+







-
+



-
-
+
+







;;   returns:
;;     *toppath*
;;   side effects:
;;     sets; *configdat*    (megatest.config info)
;;           *runconfigdat* (runconfigs.config info)
;;           *configstatus* (status of the read data)
;;
(define (launch:setup #!key (force #f))
(define (launch:setup #!key (force #f) (areapath #f))
  (mutex-lock! *launch-setup-mutex*)
  (if (and *toppath*
	   (eq? *configstatus* 'fulldata)) ;; got it all
      (begin
	(debug:print 0 *default-log-port* "NOTE: skipping launch:setup-body call since we have fulldata")
	(mutex-unlock! *launch-setup-mutex*)
	*toppath*)
      (let ((res (launch:setup-body force: force)))
      (let ((res (launch:setup-body force: force areapath: areapath)))
	(mutex-unlock! *launch-setup-mutex*)
	res)))

(define (launch:setup-body #!key (force #f))
  (let* ((toppath  (or *toppath* (getenv "MT_RUN_AREA_HOME"))) ;; preserve toppath
(define (launch:setup-body #!key (force #f) (areapath #f))
  (let* ((toppath  (or *toppath* areapath (getenv "MT_RUN_AREA_HOME"))) ;; preserve toppath
	 (runname  (common:args-get-runname))
	 (target   (common:args-get-target))
	 (linktree (common:get-linktree))
	 (sections (if target (list "default" target) #f)) ;; for runconfigs
	 (mtconfig (or (args:get-arg "-config") "megatest.config")) ;; allow overriding megatest.config 
	 (rundir   (if (and runname target linktree)(conc linktree "/" target "/" runname) #f))
	 (mtcachef (and rundir (conc rundir "/" ".megatest.cfg-"  megatest-version "-" megatest-fossil-hash)))

Modified rmt.scm from [6da0373e5e] to [ebacc63386].

54
55
56
57
58
59
60

61

62

63
64
65
66
67
68
69
54
55
56
57
58
59
60
61

62
63
64
65
66
67
68
69
70
71







+
-
+

+








  ;; 1. check if server is started IFF cmd is a write OR if we are not on the homehost, store in runremote
  ;; 2. check the age of the connections. refresh the connection if it is older than timeout-20 seconds.
  ;; 3. do the query, if on homehost use local access
  ;;
  (let* ((start-time (current-seconds)) ;; snapshot time so all use cases get same value
         (areapath *toppath*);; TODO - resolve from dbstruct to be compatible with multiple areas
         (dbfile (conc *toppath* "/megatest.db"))
         (readonly-mode (file-write-access? (conc *toppath* "/megatest.db")  )) ;; TODO: use dbstruct or runremote to figure this out in future
         (readonly-mode (not (file-write-access? dbfile))) ;; TODO: use dbstruct or runremote to figure this out in future
	 (runremote  (or area-dat *runremote*)))
    ;;(print "BB> readonly-mode is "readonly-mode" dbfile is "dbfile)
    (cond
     ;; give up if more than 15 attempts
     ((> attemptnum 15)
      (debug:print 0 *default-log-port* "ERROR: 15 tries to start/connect to server. Giving up.")
      (exit 1))

     ;; readonly mode, read request-  handle it - case 20