Index: Makefile
==================================================================
--- Makefile
+++ Makefile
@@ -28,40 +28,45 @@
            ezsteps.scm lock-queue.scm sdb.scm rmt.scm api.scm		\
            subrun.scm portlogger.scm archive.scm env.scm		\
            diff-report.scm cgisetup/models/pgdb.scm
 
 # module source files
-MSRCFILES = 
+MSRCFILES = dbmod.scm servermod.scm apimod.scm commonmod.scm rmtmod.scm 
+MOFILES = $(addprefix mofiles/,$(MSRCFILES:%.scm=%.o))
+MOIMPFILES = $(MSRCFILES:%.scm=%.import.o)
 # ftail.scm rmtmod.scm commonmod.scm removed
 # MSRCFILES = ducttape-lib.scm pkts.scm stml2.scm cookie.scm mutils.scm	\
 #             mtargs.scm commonmod.scm dbmod.scm adjutant.scm ulex.scm	\
 #             rmtmod.scm apimod.scm
 
+DMSRCFILES = dcommonmod.scm
+DMOFILES = $(addprefix mofiles/,$(DMSRCFILES:%.scm=%.o))
+DMOIMPFILES = $(DMSRCFILES:%.scm=%.import.o)
+
 GUISRCF = dashboard-context-menu.scm dashboard-tests.scm		\
           dashboard-guimonitor.scm gutils.scm dcommon.scm tree.scm	\
           vg.scm
 
 OFILES   = $(SRCFILES:%.scm=%.o)
 GOFILES  = $(GUISRCF:%.scm=%.o)
 
-MOFILES = $(addprefix mofiles/,$(MSRCFILES:%.scm=%.o))
-# compiled import files
-MOIMPFILES = $(MSRCFILES:%.scm=%.import.o)
 
-%.import.o : %.import.scm
+%.import.o : %.import.scm mofiles/%.o
 	csc $(CSCOPTS) -unit $*.import -c $*.import.scm -o $*.import.o
 
 # I'm not sure the cp is a good idea, changed a lot of things and it may not have been necessary...
 # mofiles/%.o  %.import.scm : %.scm megatest-fossil-hash.scm
 #	@[ -e mofiles ] || mkdir -p mofiles
 #	csc $(CSCOPTS) -I mofiles -I $* -J -c $< -o $*.o
 #	cp $*.o mofiles/$*.o
-#	@touch $*.import.scm # ensure it is touched after the .o is made
 
-mofiles/%.o : %.scm
-	mkdir -p mofiles
+
+# ensure import.scm is touched after the .o is made
+#
+mofiles/%.o %.import.scm : %.scm
 	csc $(CSCOPTS) -J -c $< -o mofiles/$*.o
+	@touch $*.import.scm
 
 ADTLSCR=mt_laststep mt_runstep mt_ezstep
 HELPERS=$(addprefix $(PREFIX)/bin/,$(ADTLSCR))
 DEPLOYHELPERS=$(addprefix deploytarg/,$(ADTLSCR))
 MTESTHASH=$(shell fossil info|grep checkout:| awk '{print $$2}')
@@ -87,12 +92,12 @@
 	csc $(CSCOPTS) $(OFILES) $(MOFILES) $(MOIMPFILES) megatest.o -o mtest
 
 showmtesthash:
 	@echo $(MTESTHASH)
 
-dboard : $(OFILES) $(GOFILES) dashboard.scm $(MOFILES) $(MOIMPFILES) megatest-version.scm megatest-fossil-hash.scm
-	csc $(CSCOPTS) $(OFILES) dashboard.scm $(GOFILES) $(MOFILES) $(MOIMPFILES) -o dboard
+dboard : $(OFILES) $(GOFILES) dashboard.scm $(MOFILES) $(MOIMPFILES) $(DMOFILES) $(DMOIMPFILES) megatest-version.scm megatest-fossil-hash.scm
+	csc $(CSCOPTS) $(OFILES) dashboard.scm $(GOFILES) $(MOFILES) $(MOIMPFILES) $(DMOFILES) $(DMOIMPFILES) -o dboard
 
 mtut: $(OFILES) $(MOFILES) megatest-fossil-hash.scm mtut.scm megatest-version.scm
 	csc $(CSCOPTS) $(OFILES) $(MOFILES) mtut.scm -o mtut
 
 # include makefile.inc
@@ -127,11 +132,11 @@
         ezsteps.o
 
 #        mofiles/rmtmod.o \
 #        mofiles/commonmod.o \
 
-tcmt : $(TCMTOBJS) tcmt.scm megatest-version.scm
+tcmt : $(TCMTOBJS) tcmt.scm megatest-version.scm $(MOIMPFILES) $(MOFILES)
 	csc $(CSCOPTS) $(TCMTOBJS) $(MOFILES) $(MOIMPFILES) tcmt.scm -o tcmt
 
 # install documentation to $(PREFIX)/docs
 # DOES NOT REBUILD DOCS
 #
@@ -147,15 +152,17 @@
 
 $(PREFIX)/share/db/mt-pg.sql : mt-pg.sql
 	mkdir -p $(PREFIX)/share/db
 	$(INSTALL) mt-pg.sql $(PREFIX)/share/db/mt-pg.sql
 
-# Special dependencies for the includes
+# Special dependencies for the module includes
 $(MOFILE) $(MOIMPFILES) : megatest-fossil-hash.scm
-
-# common.o : mofiles/commonmod.o megatest-fossil-hash.scm
-
+megatest.o : $(MOIMPFILES)
+mofiles/commonmod.o : megatest-fossil-hash.scm
+mofiles/dbmod.o mofiles/servermod.o mofiles/apimod.o mofiles/dcommonmod.o : mofiles/commonmod.o
+mofiles/rmtmod.o : mofiles/apimod.o
+common.o : mofiles/commonmod.o
 # commonmod.o dashboard.o megatest.o tcmt.o apimod.o : megatest-fossil-hash.scm
 
 tests.o db.o launch.o runs.o dashboard-tests.o				\
 dashboard-context-menu.o dashboard-guimonitor.o dashboard-main.o	\
 monitor.o dashboard.o archive.o megatest.o : db_records.scm megatest-fossil-hash.scm
@@ -177,11 +184,11 @@
 # mofiles/stml2.o : mofiles/cookie.o
 # configf.o : mofiles/commonmod.o
 
 vg.o dashboard.o : vg_records.scm megatest-version.scm
 
-dcommon.o : run_records.scm
+dcommon.o : mofiles/dcommonmod.o run_records.scm
 
 mofiles/stml2.o : mofiles/cookie.o
 
 # # special include based modules
 # mofiles/pkts.o      : pkts/pkts.scm

Index: api.scm
==================================================================
--- api.scm
+++ api.scm
@@ -24,10 +24,13 @@
 
 (declare (unit api))
 (declare (uses rmt))
 (declare (uses db))
 (declare (uses tasks))
+
+(declare (uses commonmod))
+(import commonmod)
 
 ;; allow these queries through without starting a server
 ;;
 (define api:read-only-queries
   '(get-key-val-pairs

Index: apimod.scm
==================================================================
--- apimod.scm
+++ apimod.scm
@@ -18,19 +18,19 @@
 
 ;;======================================================================
 
 (declare (unit apimod))
 (declare (uses commonmod))
-(declare (uses ulex))
+;; (declare (uses ulex))
 
 (module apimod
 	*
 	
 (import scheme chicken data-structures extras)
 (import (prefix sqlite3 sqlite3:) posix typed-records srfi-18)
 (import commonmod)
-(import (prefix ulex ulex:))
+;; (import (prefix ulex ulex:))
 
 
 (define (api:execute-requests params)
   #f)
 

Index: archive.scm
==================================================================
--- archive.scm
+++ archive.scm
@@ -21,10 +21,13 @@
 (use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 format md5 message-digest srfi-18)
 
 (declare (unit archive))
 (declare (uses db))
 (declare (uses common))
+
+(declare (uses commonmod))
+(import commonmod)
 
 (include "common_records.scm")
 (include "db_records.scm")
 
 ;;======================================================================

Index: client.scm
==================================================================
--- client.scm
+++ client.scm
@@ -27,10 +27,13 @@
 (declare (unit client))
 
 (declare (uses common))
 (declare (uses db))
 (declare (uses tasks)) ;; tasks are where stuff is maintained about what is running.
+
+(declare (uses commonmod))
+(import commonmod)
 
 (include "common_records.scm")
 (include "db_records.scm")
 
 ;; client:get-signature

Index: common.scm
==================================================================
--- common.scm
+++ common.scm
@@ -26,12 +26,12 @@
      (prefix sqlite3 sqlite3:)
      pkts (prefix dbi dbi:)
      )
 
 (declare (unit common))
-;; (declare (uses commonmod))
-;; (import commonmod)
+(declare (uses commonmod))
+(import commonmod)
 
 (include "common_records.scm")
 
 
 ;; (require-library margs)
@@ -42,10 +42,19 @@
 ;; (define (exit . code)
 ;;   (if (null? code)
 ;;       (old-exit)
 ;;       (old-exit code)))
 
+(define (common:debug-setup)
+  (debug:setup (cond ;; debug arg
+		((args:get-arg "-debug-noprop") 'noprop)
+		((args:get-arg "-debug")         #t)
+		(else #f))
+	       (cond ;; verbosity arg
+		((args:get-arg "-q") 'v)
+		((args:get-arg "-q") 'q)
+		(else #f))))
 
 ;; execute thunk, return value.  If exception thrown, trap exception, return #f, and emit nonfatal condition note to *default-log-port* .
 ;; arguments - thunk, message
 (define (common:fail-safe thunk warning-message-on-exception)
   (handle-exceptions
@@ -803,10 +812,16 @@
     (8 "DEAD")
     (9 "FAIL")
     (10 "PREQ_FAIL")
     (11 "PREQ_DISCARDED")
     (12 "ABORT")))
+
+(define (common:status>? s1 s2)
+  (let* ((munged (map (lambda (x) `(,(cadr x) . ,(car x))) *common:std-statuses*))
+	 (v1     (alist-ref s1 munged equal?))
+	 (v2     (alist-ref s2 munged equal?)))
+    (> v1 v2)))
 
 (define *common:ended-states*       ;; states which indicate the test is stopped and will not proceed
   '("COMPLETED" "ARCHIVED" "KILLED" "KILLREQ" "STUCK" "INCOMPLETE" ))
 
 (define *common:badly-ended-states* ;; these roll up as CHECK, i.e. results need to be checked

Index: common_records.scm
==================================================================
--- common_records.scm
+++ common_records.scm
@@ -77,177 +77,176 @@
   (mutex-lock! mtx)
   (let ((res (apply accessor record val)))
     (mutex-unlock! mtx)
     res))
 
-;; this was cached based on results from profiling but it turned out the profiling
-;; somehow went wrong - perhaps too many processes writing to it. Leaving the caching
-;; in for now but can probably take it out later.
-;;
-(define (debug:calc-verbosity vstr)
-  (or (hash-table-ref/default *verbosity-cache* vstr #f)
-      (let ((res (cond
-                  ((number? vstr) vstr)
-                  ((not (string?  vstr))   1)
-                  ;; ((string-match  "^\\s*$" vstr) 1)
-                  (vstr           (let ((debugvals  (filter number? (map string->number (string-split vstr ",")))))
-                                    (cond
-                                     ((> (length debugvals) 1) debugvals)
-                                     ((> (length debugvals) 0)(car debugvals))
-                                     (else 1))))
-                  ((args:get-arg "-v")   2)
-                  ((args:get-arg "-q")    0)
-                  (else                   1))))
-        (hash-table-set! *verbosity-cache* vstr res)
-        res)))
-
-;; check verbosity, #t is ok
-(define (debug:check-verbosity verbosity vstr)
-  (if (not (or (number? verbosity)
-	       (list?   verbosity)))
-      (begin
-	(print "ERROR: Invalid debug value \"" vstr "\"")
-	#f)
-      #t))
-
-(define (debug:debug-mode n)
-  (cond
-   ((and (number? *verbosity*)   ;; number number
-	 (number? n))
-    (<= n *verbosity*))
-   ((and (list? *verbosity*)     ;; list   number
-	 (number? n))
-    (member n *verbosity*))
-   ((and (list? *verbosity*)     ;; list   list
-	 (list? n))
-    (not (null? (lset-intersection! eq? *verbosity* n))))
-   ((and (number? *verbosity*)
-	 (list? n))
-    (member *verbosity* n))))
-
-(define (debug:setup)
-  (let ((debugstr (or (args:get-arg "-debug")
-		      (args:get-arg "-debug-noprop")
-		      (getenv "MT_DEBUG_MODE"))))
-    (set! *verbosity* (debug:calc-verbosity debugstr))
-    (debug:check-verbosity *verbosity* debugstr)
-    ;; if we were handed a bad verbosity rule then we will override it with 1 and continue
-    (if (not *verbosity*)(set! *verbosity* 1))
-    (if (and (not (args:get-arg "-debug-noprop"))
-	     (or (args:get-arg "-debug")
-		 (not (getenv "MT_DEBUG_MODE"))))
-	(setenv "MT_DEBUG_MODE" (if (list? *verbosity*)
-				    (string-intersperse (map conc *verbosity*) ",")
-				    (conc *verbosity*))))))
-  
-(define (debug:print n e . params)
-  (if (debug:debug-mode n)
-      (with-output-to-port (or e (current-error-port))
-	(lambda ()
-	  (if *logging*
-	      (db:log-event (apply conc params))
-	      (apply print params)
-	      )))))
-
-;; Brandon's debug printer shortcut (indulge me :)
-(define *BB-process-starttime* (current-milliseconds))
-(define (BB> . in-args)
-  (let* ((stack (get-call-chain))
-         (location "??"))
-    (for-each
-     (lambda (frame)
-       (let* ((this-loc (vector-ref frame 0))
-              (temp     (string-split (->string this-loc) " "))
-              (this-func (if (and (list? temp) (> (length temp) 1)) (cadr temp) "???")))
-         (if (equal? this-func "BB>")
-             (set! location this-loc))))
-     stack)
-    (let* ((color-on "\x1b[1m")
-           (color-off "\x1b[0m")
-           (dp-args
-            (append
-             (list 0 *default-log-port*
-                   (conc color-on location "@"(/ (- (current-milliseconds) *BB-process-starttime*) 1000) color-off "   ")  )
-             in-args)))
-      (apply debug:print dp-args))))
-
-(define *BBpp_custom_expanders_list* (make-hash-table))
-
-
-
-;; register hash tables with BBpp.
-(hash-table-set! *BBpp_custom_expanders_list* HASH_TABLE:
-                 (cons hash-table? hash-table->alist))
-
-;; test name converter
-(define (BBpp_custom_converter arg)
-  (let ((res #f))
-    (for-each
-     (lambda (custom-type-name)
-       (let* ((custom-type-info      (hash-table-ref *BBpp_custom_expanders_list* custom-type-name))
-              (custom-type-test      (car custom-type-info))
-              (custom-type-converter (cdr custom-type-info)))
-         (when (and (not res) (custom-type-test arg))
-           (set! res (custom-type-converter arg)))))
-     (hash-table-keys *BBpp_custom_expanders_list*))
-    (if res (BBpp_ res) arg)))
-
-(define (BBpp_ arg)
-  (cond
-   ;;((SOMESTRUCT? arg) (cons SOMESTRUCT: (SOMESTRUCT->alist arg)))
-   ;;((dboard:tabdat? arg) (cons dboard:tabdat: (dboard:tabdat->alist arg)))
-   ((hash-table? arg)
-    (let ((al (hash-table->alist arg)))
-      (BBpp_ (cons HASH_TABLE: al))))
-   ((null? arg) '())
-   ;;((list? arg) (cons (BBpp_ (car arg)) (BBpp_ (cdr arg))))
-   ((pair? arg) (cons (BBpp_ (car arg)) (BBpp_ (cdr arg))))
-   (else (BBpp_custom_converter arg))))
-
-;; Brandon's pretty printer.  It expands hashes and custom types in addition to regular pp
-(define (BBpp arg)
-  (pp (BBpp_ arg)))
-
-;(use define-macro)
-(define-syntax inspect
-  (syntax-rules ()
-    [(_ x)
-    ;; (with-output-to-port (current-error-port)
-       (printf "~a is: ~a\n" 'x (with-output-to-string (lambda () (BBpp x))))
-     ;;  )
-     ]
-    [(_ x y ...) (begin (inspect x) (inspect y ...))]))
-
-(define (debug:print-error n e . params)
-  ;; normal print
-  (if (debug:debug-mode n)
-      (with-output-to-port (if (port? e) e (current-error-port))
-	(lambda ()
-	  (if *logging*
-	      (db:log-event (apply conc params))
-	      ;; (apply print "pid:" (current-process-id) " " params)
-	      (apply print "ERROR: " params)
-	      ))))
-  ;; pass important messages to stderr
-  (if (and (eq? n 0)(not (eq? e (current-error-port)))) 
-      (with-output-to-port (current-error-port)
-	(lambda ()
-	  (apply print "ERROR: " params)
-	  ))))
-
-(define (debug:print-info n e . params)
-  (if (debug:debug-mode n)
-      (with-output-to-port (if (port? e) e (current-error-port))
-	(lambda ()
-	  (if *logging*
-	      (let ((res (format#format #f "INFO: (~a) ~a" n (apply conc params))))
-		(db:log-event res))
-	      ;; (apply print "pid:" (current-process-id) " " "INFO: (" n ") " params) ;; res)
-	      (apply print "INFO: (" n ") " params) ;; res)
-	      )))))
-
-
+;; ;; this was cached based on results from profiling but it turned out the profiling
+;; ;; somehow went wrong - perhaps too many processes writing to it. Leaving the caching
+;; ;; in for now but can probably take it out later.
+;; ;;
+;; (define (debug:calc-verbosity vstr)
+;;   (or (hash-table-ref/default *verbosity-cache* vstr #f)
+;;       (let ((res (cond
+;;                   ((number? vstr) vstr)
+;;                   ((not (string?  vstr))   1)
+;;                   ;; ((string-match  "^\\s*$" vstr) 1)
+;;                   (vstr           (let ((debugvals  (filter number? (map string->number (string-split vstr ",")))))
+;;                                     (cond
+;;                                      ((> (length debugvals) 1) debugvals)
+;;                                      ((> (length debugvals) 0)(car debugvals))
+;;                                      (else 1))))
+;;                   ((args:get-arg "-v")   2)
+;;                   ((args:get-arg "-q")    0)
+;;                   (else                   1))))
+;;         (hash-table-set! *verbosity-cache* vstr res)
+;;         res)))
+;; 
+;; ;; check verbosity, #t is ok
+;; (define (debug:check-verbosity verbosity vstr)
+;;   (if (not (or (number? verbosity)
+;; 	       (list?   verbosity)))
+;;       (begin
+;; 	(print "ERROR: Invalid debug value \"" vstr "\"")
+;; 	#f)
+;;       #t))
+;; 
+;; (define (debug:debug-mode n)
+;;   (cond
+;;    ((and (number? *verbosity*)   ;; number number
+;; 	 (number? n))
+;;     (<= n *verbosity*))
+;;    ((and (list? *verbosity*)     ;; list   number
+;; 	 (number? n))
+;;     (member n *verbosity*))
+;;    ((and (list? *verbosity*)     ;; list   list
+;; 	 (list? n))
+;;     (not (null? (lset-intersection! eq? *verbosity* n))))
+;;    ((and (number? *verbosity*)
+;; 	 (list? n))
+;;     (member *verbosity* n))))
+;; 
+;; (define (debug:setup)
+;;   (let ((debugstr (or (args:get-arg "-debug")
+;; 		      (args:get-arg "-debug-noprop")
+;; 		      (getenv "MT_DEBUG_MODE"))))
+;;     (set! *verbosity* (debug:calc-verbosity debugstr))
+;;     (debug:check-verbosity *verbosity* debugstr)
+;;     ;; if we were handed a bad verbosity rule then we will override it with 1 and continue
+;;     (if (not *verbosity*)(set! *verbosity* 1))
+;;     (if (and (not (args:get-arg "-debug-noprop"))
+;; 	     (or (args:get-arg "-debug")
+;; 		 (not (getenv "MT_DEBUG_MODE"))))
+;; 	(setenv "MT_DEBUG_MODE" (if (list? *verbosity*)
+;; 				    (string-intersperse (map conc *verbosity*) ",")
+;; 				    (conc *verbosity*))))))
+;;   
+;; (define (debug:print n e . params)
+;;   (if (debug:debug-mode n)
+;;       (with-output-to-port (or e (current-error-port))
+;; 	(lambda ()
+;; 	  (if *logging*
+;; 	      (db:log-event (apply conc params))
+;; 	      (apply print params)
+;; 	      )))))
+;; 
+;; ;; Brandon's debug printer shortcut (indulge me :)
+;; (define *BB-process-starttime* (current-milliseconds))
+;; (define (BB> . in-args)
+;;   (let* ((stack (get-call-chain))
+;;          (location "??"))
+;;     (for-each
+;;      (lambda (frame)
+;;        (let* ((this-loc (vector-ref frame 0))
+;;               (temp     (string-split (->string this-loc) " "))
+;;               (this-func (if (and (list? temp) (> (length temp) 1)) (cadr temp) "???")))
+;;          (if (equal? this-func "BB>")
+;;              (set! location this-loc))))
+;;      stack)
+;;     (let* ((color-on "\x1b[1m")
+;;            (color-off "\x1b[0m")
+;;            (dp-args
+;;             (append
+;;              (list 0 *default-log-port*
+;;                    (conc color-on location "@"(/ (- (current-milliseconds) *BB-process-starttime*) 1000) color-off "   ")  )
+;;              in-args)))
+;;       (apply debug:print dp-args))))
+;; 
+;; (define *BBpp_custom_expanders_list* (make-hash-table))
+;; 
+;; 
+;; 
+;; ;; register hash tables with BBpp.
+;; (hash-table-set! *BBpp_custom_expanders_list* HASH_TABLE:
+;;                  (cons hash-table? hash-table->alist))
+;; 
+;; ;; test name converter
+;; (define (BBpp_custom_converter arg)
+;;   (let ((res #f))
+;;     (for-each
+;;      (lambda (custom-type-name)
+;;        (let* ((custom-type-info      (hash-table-ref *BBpp_custom_expanders_list* custom-type-name))
+;;               (custom-type-test      (car custom-type-info))
+;;               (custom-type-converter (cdr custom-type-info)))
+;;          (when (and (not res) (custom-type-test arg))
+;;            (set! res (custom-type-converter arg)))))
+;;      (hash-table-keys *BBpp_custom_expanders_list*))
+;;     (if res (BBpp_ res) arg)))
+;; 
+;; (define (BBpp_ arg)
+;;   (cond
+;;    ;;((SOMESTRUCT? arg) (cons SOMESTRUCT: (SOMESTRUCT->alist arg)))
+;;    ;;((dboard:tabdat? arg) (cons dboard:tabdat: (dboard:tabdat->alist arg)))
+;;    ((hash-table? arg)
+;;     (let ((al (hash-table->alist arg)))
+;;       (BBpp_ (cons HASH_TABLE: al))))
+;;    ((null? arg) '())
+;;    ;;((list? arg) (cons (BBpp_ (car arg)) (BBpp_ (cdr arg))))
+;;    ((pair? arg) (cons (BBpp_ (car arg)) (BBpp_ (cdr arg))))
+;;    (else (BBpp_custom_converter arg))))
+;; 
+;; ;; Brandon's pretty printer.  It expands hashes and custom types in addition to regular pp
+;; (define (BBpp arg)
+;;   (pp (BBpp_ arg)))
+;; 
+;; ;(use define-macro)
+;; (define-syntax inspect
+;;   (syntax-rules ()
+;;     [(_ x)
+;;     ;; (with-output-to-port (current-error-port)
+;;        (printf "~a is: ~a\n" 'x (with-output-to-string (lambda () (BBpp x))))
+;;      ;;  )
+;;      ]
+;;     [(_ x y ...) (begin (inspect x) (inspect y ...))]))
+;; 
+;; (define (debug:print-error n e . params)
+;;   ;; normal print
+;;   (if (debug:debug-mode n)
+;;       (with-output-to-port (if (port? e) e (current-error-port))
+;; 	(lambda ()
+;; 	  (if *logging*
+;; 	      (db:log-event (apply conc params))
+;; 	      ;; (apply print "pid:" (current-process-id) " " params)
+;; 	      (apply print "ERROR: " params)
+;; 	      ))))
+;;   ;; pass important messages to stderr
+;;   (if (and (eq? n 0)(not (eq? e (current-error-port)))) 
+;;       (with-output-to-port (current-error-port)
+;; 	(lambda ()
+;; 	  (apply print "ERROR: " params)
+;; 	  ))))
+;; 
+;; (define (debug:print-info n e . params)
+;;   (if (debug:debug-mode n)
+;;       (with-output-to-port (if (port? e) e (current-error-port))
+;; 	(lambda ()
+;; 	  (if *logging*
+;; 	      (let ((res (format#format #f "INFO: (~a) ~a" n (apply conc params))))
+;; 		(db:log-event res))
+;; 	      ;; (apply print "pid:" (current-process-id) " " "INFO: (" n ") " params) ;; res)
+;; 	      (apply print "INFO: (" n ") " params) ;; res)
+;; 	      )))))
+;; 
 
 ;; if a value is printable (i.e. string or number) return the value
 ;; else return an empty string
 (define-inline (printable val)
   (if (or (number? val)(string? val)) val ""))

Index: commonmod.scm
==================================================================
--- commonmod.scm
+++ commonmod.scm
@@ -21,14 +21,15 @@
 (declare (unit commonmod))
 
 (module commonmod
 	*
 	
-(import scheme chicken data-structures extras files)
+(import scheme chicken data-structures extras files ports)
 (import (prefix sqlite3 sqlite3:) posix typed-records srfi-18 srfi-69
 	md5 message-digest
-	regex srfi-1)
+	regex srfi-1
+	format)
 
 ;;======================================================================
 ;; CONTENTS
 ;;
 ;;  config file utils
@@ -149,14 +150,110 @@
   (let ((adat (get-section cfgdat "areas")))
     (map (lambda (entry)
 	   `(,(car entry) . 
 	     ,(val->alist (cadr entry))))
 	 adat)))
+
+;;======================================================================
+;; debug stuff
+;;======================================================================
+
+(define verbosity (make-parameter '()))
 	 
 ;; (define (debug:print . params) #f)
 ;; (define (debug:print-info . params) #f)
 ;; 
 ;; (define (set-functions dbgp dbgpinfo)
 ;;   (set! debug:print dbgp)
 ;;   (set! debug:print-info dbgpinfo))
+
+;; this was cached based on results from profiling but it turned out the profiling
+;; somehow went wrong - perhaps too many processes writing to it. Leaving the caching
+;; in for now but can probably take it out later.
+;;
+(define (debug:calc-verbosity vstr arg) ;; arg is 'v (verbose) or 'q (quiet)
+  (let* ((res (cond
+	       ((number? vstr) vstr)
+	       ((not (string?  vstr))   1)
+	       ;; ((string-match  "^\\s*$" vstr) 1)
+	       (vstr           (let ((debugvals  (filter number? (map string->number (string-split vstr ",")))))
+				 (cond
+				  ((> (length debugvals) 1) debugvals)
+				  ((> (length debugvals) 0)(car debugvals))
+				  (else 1))))
+	       ((eq? arg 'v)   2) ;; verbose
+	       ((eq? arg 'q)   0) ;; quiet
+	       (else                   1))))
+    (verbosity res)
+    res))
+
+;; check verbosity, #t is ok
+#;(define (debug-check-verbosity verbosity vstr)
+  (if (not (or (number? verbosity)
+	       (list?   verbosity)))
+      (begin
+	(print "ERROR: Invalid debug value \"" vstr "\"")
+	#f)
+      #t))
+
+(define (debug:debug-mode n)
+  (let* ((vb (verbosity)))
+    (cond
+   ((and (number? vb)   ;; number number
+	 (number? n))
+    (<= n vb))
+   ((and (list? vb)     ;; list   number
+	 (number? n))
+    (member n vb))
+   ((and (list? vb)     ;; list   list
+	 (list? n))
+    (not (null? (lset-intersection! eq? vb n))))
+   ((and (number? vb)
+	 (list? n))
+    (member vb n)))))
+
+(define (debug:setup debug-arg verbose-arg) ;; debug-arg= #f, #t or 'noprop
+  (let ((debugstr (or debug-arg ;; (args:get-arg "-debug")
+		      ;; (args:get-arg "-debug-noprop")
+		      (get-environment-variable "MT_DEBUG_MODE"))))
+    (debug:calc-verbosity debugstr verbose-arg)
+    ;; (debug:check-verbosity *verbosity* debugstr)
+    ;; if we were handed a bad verbosity rule then we will override it with 1 and continue
+    (if (not (verbosity))(set! (verbosity) 1))
+    (if (and (not (eq? debug-arg 'noprop))
+	     (or debug-arg
+		 (not (get-environment-variable "MT_DEBUG_MODE"))))
+	(setenv "MT_DEBUG_MODE" (if (list? (verbosity))
+				    (string-intersperse (map conc (verbosity)) ",")
+				    (conc (verbosity)))))))
+
+(define (debug:print n e . params)
+  (if (debug:debug-mode n)
+      (with-output-to-port (or e (current-error-port))
+	(lambda ()
+	  ;; (if *logging*
+	      ;; (db:log-event (apply conc params))
+	  (apply print params)
+	  )))) ;; )
+
+(define (debug:print-error n e . params)
+  ;; normal print
+  (if (debug:debug-mode n)
+      (with-output-to-port (if (port? e) e (current-error-port))
+	(lambda ()
+	  (apply print "ERROR: " params)
+	  )))
+  ;; pass important messages to stderr
+  (if (and (eq? n 0)(not (eq? e (current-error-port)))) 
+      (with-output-to-port (current-error-port)
+	(lambda ()
+	  (apply print "ERROR: " params)
+	  ))))
+
+(define (debug:print-info n e . params)
+  (if (debug:debug-mode n)
+      (with-output-to-port (if (port? e) e (current-error-port))
+	(lambda ()
+	  (apply print "INFO: (" n ") " params) ;; res)
+	  ))))
 
 )

Index: configf.scm
==================================================================
--- configf.scm
+++ configf.scm
@@ -25,10 +25,13 @@
 (use regex regex-case matchable) ;;  directory-utils)
 (declare (unit configf))
 (declare (uses process))
 (declare (uses env))
 (declare (uses keys))
+
+(declare (uses commonmod))
+(import commonmod)
 
 (include "common_records.scm")
 
 ;; return list (path fullpath configname)
 (define (find-config configname #!key (toppath #f))

Index: dashboard-context-menu.scm
==================================================================
--- dashboard-context-menu.scm
+++ dashboard-context-menu.scm
@@ -39,10 +39,13 @@
 (declare (uses rmt))
 (declare (uses ezsteps))
 ;; (declare (uses sdb))
 ;; (declare (uses filedb))
 (declare (uses subrun))
+
+(declare (uses commonmod))
+(import commonmod)
 
 (include "common_records.scm")
 (include "db_records.scm")
 (include "run_records.scm")
 

Index: dashboard-guimonitor.scm
==================================================================
--- dashboard-guimonitor.scm
+++ dashboard-guimonitor.scm
@@ -34,10 +34,13 @@
 (declare (unit dashboard-guimonitor))
 (declare (uses common))
 (declare (uses keys))
 (declare (uses db))
 (declare (uses tasks))
+
+(declare (uses commonmod))
+(import commonmod)
 
 (include "common_records.scm")
 (include "db_records.scm")
 (include "run_records.scm")
 (include "task_records.scm")

Index: dashboard-tests.scm
==================================================================
--- dashboard-tests.scm
+++ dashboard-tests.scm
@@ -38,10 +38,13 @@
 (declare (uses rmt))
 (declare (uses ezsteps))
 ;; (declare (uses sdb))
 ;; (declare (uses filedb))
 (declare (uses subrun))
+
+(declare (uses commonmod))
+(import commonmod)
 
 (include "common_records.scm")
 (include "db_records.scm")
 (include "run_records.scm")
 

Index: dashboard.scm
==================================================================
--- dashboard.scm
+++ dashboard.scm
@@ -46,16 +46,24 @@
 (declare (uses vg))
 (declare (uses subrun))
 ;; (declare (uses dashboard-main))
 (declare (uses mt))
 
+(declare (uses commonmod))
+(import commonmod)
+(declare (uses commonmod.import))
+
+(declare (uses dcommonmod))
+(import dcommonmod)
+(declare (uses dcommonmod.import))
+
 (include "common_records.scm")
 (include "db_records.scm")
 (include "run_records.scm")
 (include "task_records.scm")
 (include "megatest-version.scm")
-(include "megatest-fossil-hash.scm")
+;; (include "megatest-fossil-hash.scm")
 (include "vg_records.scm")
 
 (define help (conc 
 	      "Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest
   version " megatest-version "
@@ -167,33 +175,11 @@
 ;;     (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
-  update-mutex
-  updaters 
-  updating
-  uidat ;; needs to move to tabdat at some time
-  hide-not-hide-tabs
-  )
-
-(define (dboard:commondat-make)
-  (make-dboard:commondat
-   curr-tab-num:         0
-   tabdats:              (make-hash-table)
-   please-update:        #t
-   update-mutex:         (make-mutex)
-   updaters:             (make-hash-table)
-   updating:             #f
-   hide-not-hide-tabs:   #f
-   ))
+;; data common to all tabs in dboard:commondat struct moved to dcommonmod
 
 ;; RA => returns the tabdat stored at hashkey passed in commondat-tabdats table (e.g. 0 gives summary)
 ;;
 (define (dboard:common-get-tabdat commondat #!key (tab-num #f))
   (let* ((tnum (or tab-num
@@ -238,13 +224,13 @@
 	 (curr-updaters (hash-table-ref/default (dboard:commondat-updaters commondat) tnum '())))
     (hash-table-set! (dboard:commondat-updaters commondat)
 		     tnum
 		     (cons updater curr-updaters))))
 
-;; data for each specific tab goes here
+;; data for each specific tab goes here - moved into dcommonmod
 ;;
-(defstruct dboard:tabdat 
+#;(defstruct dboard:tabdat 
   ;; runs
   ((allruns         '())                 : list)        ;; list of dboard:rundat records
   ((allruns-by-id    (make-hash-table))  : hash-table)  ;; hash of run-id -> dboard:rundat records
   ((done-runs       '())                 : list)        ;; list of runs already drawn
   ((not-done-runs   '())                 : list)        ;; list of runs not yet drawn
@@ -351,18 +337,18 @@
   tests-tree       ;; used in newdashboard
   )
 
 ;; register tabdat with BBpp
 ;; this is used by BBpp (Brandon's pretty printer) to convert dboard:tabdat into a composition of lists that pp will handle
-(hash-table-set! *BBpp_custom_expanders_list* TABDAT:
-                 (cons dboard:tabdat?
-                       (lambda (tabdat-item)
-                         (filter
-                          (lambda (alist-entry)
-                            (member (car alist-entry)
-                                    '(allruns-by-id allruns))) ;; FIELDS OF INTEREST
-                          (dboard:tabdat->alist tabdat-item)))))
+;; (hash-table-set! *BBpp_custom_expanders_list* TABDAT:
+;;                  (cons dboard:tabdat?
+;;                        (lambda (tabdat-item)
+;;                          (filter
+;;                           (lambda (alist-entry)
+;;                             (member (car alist-entry)
+;;                                     '(allruns-by-id allruns))) ;; FIELDS OF INTEREST
+;;                           (dboard:tabdat->alist tabdat-item)))))
 
 
 
 (define (dboard:tabdat-target-string vec)
   (let ((targ (dboard:tabdat-target vec)))
@@ -375,10 +361,17 @@
 (define (dboard:tabdat-test-patts-set!-use    vec val)
   (dboard:tabdat-test-patts-set! vec (if (equal? val "") #f val)))
 
 (define (dboard:tabdat-make-data)
   (let ((dat (make-dboard:tabdat)))
+    (dboard:tabdat-runs-btn-height-set! dat (or (configf:lookup *configdat* "dashboard" "btn-height") "x16")) ;; was 12
+    (dboard:tabdat-runs-btn-fontsz-set! dat (or (configf:lookup *configdat* "dashboard" "btn-fontsz") "10"))  ;; was 8
+    (dboard:tabdat-runs-cell-width-set! dat (or (configf:lookup *configdat* "dashboard" "cell-width") "50"))  ;; was 50
+    (dboard:tabdat-numruns-set!         dat (string->number (or (args:get-arg "-cols")
+								(configf:lookup *configdat* "dashboard" "cols")
+								"8")))
+    (dboard:tabdat-access-mode-set!     dat (db:get-access-mode))             ;; use cached db or not
     (dboard:setup-tabdat dat)
     (dboard:setup-num-rows dat)
     dat))
 
 (define (dboard:setup-tabdat tabdat)
@@ -393,20 +386,20 @@
   (dboard:tabdat-dbkeys-set! tabdat (append (dboard:tabdat-keys tabdat) (list "runname")))
   (dboard:tabdat-tot-runs-set! tabdat (rmt:get-num-runs "%"))
   )
 
 ;; RADT => Matrix defstruct addition
-(defstruct dboard:graph-dat
+#;(defstruct dboard:graph-dat
     ((id           #f) : string)
     ((color        #f) : vector)
     ((flag         #t) : boolean)
     ((cell         #f) : number)
     )
 
 ;; data for runs, tests etc. was used in run summary?
 ;;
-(defstruct dboard:runsdat
+#;(defstruct dboard:runsdat
   ;; new system
   runs-index    ;; target/runname => colnum
   tests-index   ;; testname/itempath => rownum
   matrix-dat    ;; vector of vectors rows/cols
   )
@@ -418,11 +411,11 @@
    matrix-dat: (make-sparse-array)))
 
 ;; used to keep the rundata from rmt:get-tests-for-run
 ;; in sync. 
 ;;
-(defstruct dboard:rundat
+#;(defstruct dboard:rundat
   run
   tests-drawn    ;; list of id's already drawn on screen
   tests-notdrawn ;; list of id's NOT already drawn
   rowsused       ;; hash of lists covering what areas used - replace with quadtree
   hierdat        ;; put hierarchial sorted list here
@@ -501,18 +494,18 @@
   duration
   )
 
 ;; register dboard:rundat with BBpp
 ;; this is used by BBpp (Brandon's pretty printer) to convert dboard:rundat into a composition of lists that pp will handle
-(hash-table-set! *BBpp_custom_expanders_list* RUNDAT:
-                 (cons dboard:rundat?
-                       (lambda (tabdat-item)
-                         (filter
-                          (lambda (alist-entry)
-                            (member (car alist-entry)
-                                    '(run run-data-offset ))) ;; FIELDS OF INTEREST
-                          (dboard:rundat->alist tabdat-item)))))
+;; (hash-table-set! *BBpp_custom_expanders_list* RUNDAT:
+;;                  (cons dboard:rundat?
+;;                        (lambda (tabdat-item)
+;;                          (filter
+;;                           (lambda (alist-entry)
+;;                             (member (car alist-entry)
+;;                                     '(run run-data-offset ))) ;; FIELDS OF INTEREST
+;;                           (dboard:rundat->alist tabdat-item)))))
 
 
 
 
 (define (dboard:rundat-make-init #!key (run #f)(key-vals #f)(tests #f));; -100 is before time began
@@ -578,11 +571,11 @@
 	3)))
 
 (define (get-curr-sort)
   (vector-ref *tests-sort-options* *tests-sort-reverse*))
 
-(debug:setup)
+(common:debug-setup)
 
 ;; (define uidat #f)
 
 (define-inline (dboard:uidat-get-keycol  vec)(vector-ref vec 0))
 (define-inline (dboard:uidat-get-lftcol  vec)(vector-ref vec 1))

Index: db.scm
==================================================================
--- db.scm
+++ db.scm
@@ -33,10 +33,13 @@
 (declare (uses common))
 (declare (uses keys))
 (declare (uses ods))
 (declare (uses client))
 (declare (uses mt))
+
+(declare (uses commonmod))
+(import commonmod)
 
 (include "common_records.scm")
 (include "db_records.scm")
 (include "key_records.scm")
 (include "run_records.scm")

Index: dcommon.scm
==================================================================
--- dcommon.scm
+++ dcommon.scm
@@ -27,10 +27,17 @@
 
 (declare (unit dcommon))
 
 (declare (uses gutils))
 (declare (uses db))
+
+(declare (uses commonmod))
+(import commonmod)
+
+(declare (uses dcommonmod))
+(import dcommonmod)
+
 ;; (declare (uses synchash))
 
 (include "megatest-version.scm")
 (include "common_records.scm")
 (include "db_records.scm")

ADDED   dcommonmod.scm
Index: dcommonmod.scm
==================================================================
--- /dev/null
+++ dcommonmod.scm
@@ -0,0 +1,220 @@
+;;======================================================================
+;; Copyright 2017, Matthew Welland.
+;; 
+;; This file is part of Megatest.
+;; 
+;;     Megatest is free software: you can redistribute it and/or modify
+;;     it under the terms of the GNU General Public License as published by
+;;     the Free Software Foundation, either version 3 of the License, or
+;;     (at your option) any later version.
+;; 
+;;     Megatest is distributed in the hope that it will be useful,
+;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;     GNU General Public License for more details.
+;; 
+;;     You should have received a copy of the GNU General Public License
+;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
+
+;;======================================================================
+
+(declare (unit dcommonmod))
+(declare (uses commonmod))
+;; (declare (uses ulex))
+
+(module dcommonmod
+	*
+	
+(import scheme chicken data-structures extras)
+(import (prefix sqlite3 sqlite3:)
+	posix typed-records srfi-18
+	srfi-69)
+(import commonmod)
+;; (import (prefix ulex ulex:))
+
+;;======================================================================
+;; COMMONDAT
+;;======================================================================
+
+;; data common to all tabs goes here
+;;
+(defstruct dboard:commondat
+  ((curr-tab-num 0) : number)
+  please-update  
+  tabdats
+  update-mutex
+  updaters 
+  updating
+  uidat ;; needs to move to tabdat at some time
+  hide-not-hide-tabs
+  )
+
+(define (dboard:commondat-make)
+  (make-dboard:commondat
+   curr-tab-num:         0
+   tabdats:              (make-hash-table)
+   please-update:        #t
+   update-mutex:         (make-mutex)
+   updaters:             (make-hash-table)
+   updating:             #f
+   hide-not-hide-tabs:   #f
+   ))
+
+;;======================================================================
+;; TABDAT
+;;======================================================================
+
+;; data for each specific tab goes here
+;;
+(defstruct dboard:tabdat 
+  ;; runs
+  ((allruns         '())                 : list)        ;; list of dboard:rundat records
+  ((allruns-by-id    (make-hash-table))  : hash-table)  ;; hash of run-id -> dboard:rundat records
+  ((done-runs       '())                 : list)        ;; list of runs already drawn
+  ((not-done-runs   '())                 : list)        ;; list of runs not yet drawn
+  (header            #f)                                ;; header for decoding the run records
+  (keys              #f)                                ;; keys for this run (i.e. target components)
+  ((numruns          8)                  : number) 
+  ((tot-runs          0)                 : number)
+  ((last-data-update  0)                 : number)      ;; last time the data in allruns was updated
+  ((last-runs-update  0)                 : number)      ;; last time we pulled the runs info to update the tree
+  (runs-mutex         (make-mutex))                     ;; use to prevent parallel access to draw objects
+  ((run-update-times  (make-hash-table)) : hash-table)  ;; update times indexed by run-id
+  ((last-test-dat      (make-hash-table)) : hash-table)  ;; cache last tests dat by run-id
+  ((run-db-paths      (make-hash-table)) : hash-table)  ;; cache the paths to the run db files
+
+  ;; Runs view
+  ((buttondat         (make-hash-table)) : hash-table)  ;;     
+  ((item-test-names  '())                : list)        ;; list of itemized tests
+  ((run-keys          (make-hash-table)) : hash-table)
+  (runs-matrix        #f)                               ;; used in newdashboard
+  ((start-run-offset   0)                : number)      ;; left-right slider value
+  ((start-test-offset  0)                : number)      ;; up-down slider value
+  ((runs-btn-height     "x16") : string) ;; (or (configf:lookup *configdat* "dashboard" "btn-height") "x16")) : string)  ;; was 12
+  ((runs-btn-fontsz     "10")  : string) ;; (or (configf:lookup *configdat* "dashboard" "btn-fontsz") "10")) : string)   ;; was 8
+  ((runs-cell-width     "50")  : string) ;; (or (configf:lookup *configdat* "dashboard" "cell-width") "50")) : string)   ;; was 50
+  ((all-test-names     '())              : list)
+  
+  ;; Canvas and drawing data
+  (cnv                #f)
+  (cnv-obj            #f)
+  (drawing            #f)
+  ((run-start-row     0)                 : number)
+  ((max-row           0)                 : number)
+  ((running-layout    #f)                : boolean)
+  (originx            #f)
+  (originy            #f)
+  ((layout-update-ok  #t)                : boolean)
+  ((compact-layout    #t)                : boolean)
+
+  ;; Run times layout
+  ;; (graph-button-box #f) ;; RA => Think it is not referenced anywhere
+  (graph-matrix     #f)
+  ((graph-matrix-table (make-hash-table)) : hash-table) ;; graph-dats referenced thru graph name info
+  ((graph-cell-table (make-hash-table)) : hash-table) ;; graph-dats referenced thru matrix cell info
+  ((graph-matrix-row 1) : number)
+  ((graph-matrix-col 1) : number)
+
+  ;; Controls used to launch runs etc.
+  ((command          "")                 : string)      ;; for run control this is the command being built up
+  (command-tb        #f)	                        ;; widget for the type of command; run, remove-runs etc.
+  (test-patterns-textbox #f)                            ;; text box widget for editing a list of test patterns
+  (key-listboxes     #f)			         
+  (key-lbs           #f)			         
+  run-name                                              ;; from run name setting widget
+  states                                                ;; states for -state s1,s2 ...
+  statuses                                              ;; statuses for -status s1,s2 ...
+						         
+  ;; Selector variables				         
+  curr-run-id                                           ;; current row to display in Run summary view
+  prev-run-id                                           ;; previous runid selected before current runid was selected (used in xor-two-runs runs summary mode
+  curr-test-ids                                         ;; used only in dcommon:run-update which is used in newdashboard
+  ((filters-changed  #t)                  : boolean)    ;; to indicate that the user changed filters for this tab
+  ((last-filter-str  "")                  : string)      ;; conc the target runname and testpatt for a signature of changed filters
+  ((hide-empty-runs  #f)                  : boolean)     
+  ((hide-not-hide    #t)                  : boolean)     ;; toggle for hide/not hide empty runs
+  (hide-not-hide-button #f)
+  ((searchpatts        (make-hash-table)) : hash-table)  ;;
+  ((state-ignore-hash  (make-hash-table)) : hash-table)  ;; hash of  STATE => #t/#f for display control
+  ((status-ignore-hash (make-hash-table)) : hash-table)  ;; hash of STATUS => #t/#f
+  (target              #f)
+  (test-patts          #f)
+
+  ;; db info to file the .db files for the area
+  (access-mode         #f)
+  (dbdir               #f)
+  (dbfpath             #f)
+  (dbkeys              #f)
+  ((last-db-update     (make-hash-table)) : hash-table) ;; last db file timestamp
+  (monitor-db-path     #f)                              ;; where to find monitor.db
+  ro                                                    ;; is the database read-only?
+
+  ;; tests data
+  ((num-tests          10)               : number)      ;; total number of tests to show (used in the old runs display)
+
+  ;; runs tree
+  ((path-run-ids       (make-hash-table)) : hash-table) ;; path (target / runname) => id
+  (runs-tree           #f)
+  ((runs-tree-ht       (make-hash-table)) : hash-table) ;; track which targets added to tree (merge functionality with path-run-ids?)
+
+  ;; tab data
+  ((view-changed       #t)                : boolean)   
+  ((xadj               0)                 : number)     ;; x slider number (if using canvas)
+  ((yadj               0)                 : number)     ;; y slider number (if using canvas)
+  ;; runs-summary tab state
+  ((runs-summary-modes '((one-run . "Show One Run") (xor-two-runs . "XOR Two Runs") (xor-two-runs-hide-clean . "XOR; Hide Clean")) )   : list)
+  ((runs-summary-mode-buttons '())               : list)
+  ((runs-summary-mode  'one-run)            : symbol)
+  ((runs-summary-mode-change-callbacks '()) : list)
+  (runs-summary-source-runname-label #f)
+  (runs-summary-dest-runname-label #f)
+  ;; runs summary view
+  
+  tests-tree       ;; used in newdashboard
+  )
+
+;;======================================================================
+;; GRAPHDAT
+;;======================================================================
+
+;; RADT => Matrix defstruct addition
+(defstruct dboard:graph-dat
+    ((id           #f) : string)
+    ((color        #f) : vector)
+    ((flag         #t) : boolean)
+    ((cell         #f) : number)
+    )
+
+;;======================================================================
+;; RUNSDAT
+;;======================================================================
+
+;; data for runs, tests etc. was used in run summary?
+;;
+(defstruct dboard:runsdat
+  ;; new system
+  runs-index    ;; target/runname => colnum
+  tests-index   ;; testname/itempath => rownum
+  matrix-dat    ;; vector of vectors rows/cols
+  )
+
+;; used to keep the rundata from rmt:get-tests-for-run
+;; in sync. 
+;;
+(defstruct dboard:rundat
+  run
+  tests-drawn    ;; list of id's already drawn on screen
+  tests-notdrawn ;; list of id's NOT already drawn
+  rowsused       ;; hash of lists covering what areas used - replace with quadtree
+  hierdat        ;; put hierarchial sorted list here
+  tests          ;; hash of id => testdat
+  ((tests-by-name (make-hash-table)) : hash-table) ;; hash of testfullname => testdat
+  key-vals
+  ((last-update   0)                 : number)    ;; last query to db got records from before last-update
+  ((last-db-time  0)                 : number)    ;; last timestamp on megatest.db
+  ((data-changed  #f)                : boolean)   
+  ((run-data-offset  0)              : number)      ;; get only 100 items per call, set back to zero when received less than 100 items
+  (db-path #f))
+
+
+)

Index: diff-report.scm
==================================================================
--- diff-report.scm
+++ diff-report.scm
@@ -18,10 +18,13 @@
 
 (declare (unit diff-report))
 (declare (uses common))
 (declare (uses rmt))
          
+(declare (uses commonmod))
+(import commonmod)
+
 (include "common_records.scm")
 (use matchable)
 (use fmt)
 (use ducttape-lib)
 (define css "")

Index: docs/manual/Makefile
==================================================================
--- docs/manual/Makefile
+++ docs/manual/Makefile
@@ -34,13 +34,16 @@
 
 megatest_manual.html : megatest_manual.txt  *.txt installation.txt *png
 	asciidoc  -b html5 -a icons -a iconsdir=$(DISPATH)/images/icons -a toc2 megatest_manual.txt
 #	dos2unix megatest_manual.html
 
-megatest_manual.pdf : megatest_manual.txt *.txt *png
+megatest_manual.pdf : megatest_manual.txt *.txt *png *.ps
 	a2x -a toc -f pdf megatest_manual.txt
 
+server.pdf : server.dot
+	dot -Tpdf server.dot > server.pdf
+
 server.ps : server.dot
 	dot -Tps server.dot > server.ps
 
 client.ps : client.dot
 	dot -Tps client.dot > client.ps

Index: docs/manual/megatest_manual.html
==================================================================
--- docs/manual/megatest_manual.html
+++ docs/manual/megatest_manual.html
@@ -1,10 +1,10 @@
 <!DOCTYPE html>
 <html lang="en">
 <head>
 <meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
-<meta name="generator" content="AsciiDoc 8.6.7">
+<meta name="generator" content="AsciiDoc 8.6.10">
 <title>The Megatest Users Manual</title>
 <style type="text/css">
 /* Shared CSS for AsciiDoc xhtml11 and html5 backends */
 
 /* Default font. */
@@ -84,14 +84,20 @@
   margin-top: 0;
 }
 ul > li     { color: #aaa; }
 ul > li > * { color: black; }
 
-pre {
+.monospaced, code, pre {
+  font-family: "Courier New", Courier, monospace;
+  font-size: inherit;
+  color: navy;
   padding: 0;
   margin: 0;
 }
+pre {
+  white-space: pre-wrap;
+}
 
 #author {
   color: #527bbd;
   font-weight: bold;
   font-size: 1.1em;
@@ -216,11 +222,11 @@
   border-left: 3px solid #dddddd;
   padding-left: 0.5em;
 }
 
 div.imageblock div.content { padding-left: 0; }
-span.image img { border-style: none; }
+span.image img { border-style: none; vertical-align: text-bottom; }
 a.image:visited { color: white; }
 
 dl {
   margin-top: 0.8em;
   margin-bottom: 0.8em;
@@ -412,16 +418,10 @@
 /*
  * xhtml11 specific
  *
  * */
 
-tt {
-  font-family: "Courier New", Courier, monospace;
-  font-size: inherit;
-  color: navy;
-}
-
 div.tableblock {
   margin-top: 1.0em;
   margin-bottom: 1.5em;
 }
 div.tableblock > table {
@@ -451,16 +451,10 @@
 /*
  * html5 specific
  *
  * */
 
-.monospaced {
-  font-family: "Courier New", Courier, monospace;
-  font-size: inherit;
-  color: navy;
-}
-
 table.tableblock {
   margin-top: 1.0em;
   margin-bottom: 1.5em;
 }
 thead, p.tableblock.header {
@@ -536,10 +530,12 @@
 }
 
 @media print {
   body.manpage div#toc { display: none; }
 }
+
+
 @media screen {
   body {
     max-width: 50em; /* approximately 80 characters wide */
     margin-left: 16em;
   }
@@ -2340,11 +2336,11 @@
 <div class="sect2">
 <h3 id="_trim_trailing_spaces">Trim trailing spaces</h3>
 <div class="admonitionblock">
 <table><tr>
 <td class="icon">
-<img src="/nfs/pdx/disks/ice.disk.002/icfadm/pkgs/asciidoc/8.6.7/images/icons/note.png" alt="Note">
+<img src="/usr/images/icons/note.png" alt="Note">
 </td>
 <td class="content">As of Megatest version v1.6548 trim-trailing-spaces defaults to yes.</td>
 </tr></table>
 </div>
 <div class="listingblock">
@@ -2642,11 +2638,11 @@
 waiton test1 test2</pre>
 </div></div>
 <div class="admonitionblock">
 <table><tr>
 <td class="icon">
-<img src="/nfs/pdx/disks/ice.disk.002/icfadm/pkgs/asciidoc/8.6.7/images/icons/note.png" alt="Note">
+<img src="/usr/images/icons/note.png" alt="Note">
 </td>
 <td class="content">Dynamic waiton lists must be capable of being calculated at the
 beginning of a run. This is because Megatest walks the tree of waitons
 to create the list of tests to execute.</td>
 </tr></table>
@@ -3147,11 +3143,11 @@
 COMPLETED/ xterm -e bash -s --</pre>
 </div></div>
 <div class="admonitionblock">
 <table><tr>
 <td class="icon">
-<img src="/nfs/pdx/disks/ice.disk.002/icfadm/pkgs/asciidoc/8.6.7/images/icons/note.png" alt="Note">
+<img src="/usr/images/icons/note.png" alt="Note">
 </td>
 <td class="content">There is a trailing space after the double-dash</td>
 </tr></table>
 </div>
 <div class="paragraph"><p>There are a number of environment variables available to the trigger script
@@ -3484,10 +3480,11 @@
 </div>
 <div id="footnotes"><hr></div>
 <div id="footer">
 <div id="footer-text">
 Version 1.5<br>
-Last updated 2020-09-08 08:39:29 PDT
+Last updated
+ 2021-01-25 11:33:16 MST
 </div>
 </div>
 </body>
 </html>

Index: docs/manual/server.dot
==================================================================
--- docs/manual/server.dot
+++ docs/manual/server.dot
@@ -14,65 +14,130 @@
 // 
 //     You should have received a copy of the GNU General Public License
 //     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
 digraph G {
 
-    subgraph cluster_1 {
-        node [style=filled,shape=box];
-
-	check_available_queue       -> remove_entries_over_10s_old;
-	remove_entries_over_10s_old -> set_available [label="num_avail < 3"];
-	remove_entries_over_10s_old -> exit [label="num_avail > 2"];
-
-	set_available               -> delay_2s;
-	delay_2s          -> check_place_in_queue;
-
-	check_place_in_queue        -> "http:transport-launch" [label="at head"];
-	check_place_in_queue        -> exit [label="not at head"];
-
-	"client:login"              -> "server:shutdown" [label="login failed"];
-	"server:shutdown"           -> exit;	
-
-	subgraph cluster_2 {
-		"http:transport-launch"       -> "http:transport-run";
-		"http:transport-launch"       -> "http:transport-keep-running";
-
-		"http:transport-keep-running" -> "tests running?";
-		"tests running?"              -> "client:login" [label=yes];
-		"tests running?"              -> "server:shutdown" [label=no];
-		"client:login"                -> delay_5s [label="login ok"];
-		delay_5s                      -> "http:transport-keep-running";
-	}
-
-	// start_server -> "server_running?";
-	// "server_running?" -> set_available [label="no"];
-	// "server_running?" -> delay_2s [label="yes"];
-	// delay_2s -> "still_running?";
-	// "still_running?" -> ping_server [label=yes];
-	// "still_running?" -> set_available [label=no];
-	// ping_server -> exit [label=alive];
-	// ping_server -> remove_server_record [label=dead];
-	// remove_server_record -> set_available;
-	// set_available -> avail_delay [label="delay 3s"];
-	// avail_delay -> "first_in_queue?";
-	// 
-	// "first_in_queue?" -> set_running [label=yes];
-	// set_running -> get_next_port -> handle_requests;
-	// "first_in_queue?" -> "dead_entry_in_queue?" [label=no];
-	// "dead_entry_in_queue?" -> "server_running?" [label=no];
-	// "dead_entry_in_queue?" -> "remove_dead_entries" [label=yes];
-	// remove_dead_entries -> "server_running?";
-	// 
-	// handle_requests -> start_shutdown [label="no traffic\nno running tests"];
-	// handle_requests -> shutdown_request;
-	// start_shutdown -> shutdown_delay;
-	// shutdown_request -> shutdown_delay;
-	// shutdown_delay -> exit;
-	
-        label = "server:launch";
-        color=brown;
-    }
+// connecting to server
+subgraph cluster_1 {
+  label="Connect";
+  
+  node [style=filled,shape=box];
+  dotserver [label="Have .server file?"];
+  connect [label="Connect to server"];
+  // startserver [label="Start Server"];
+  connected [label="Connection Successful"];
+  anylive [label="Any live servers?"];
+  askstart [label="Ask existing server to start a new server"];
+  anydboard [label="Any live dashboards"];
+  askdboard [label="Ask dashboard to start server"];
+  serverlaunch [label="User server launch to start server process"];
+  wait5sec [label="Wait 5 seconds"];
+  
+  dotserver -> connect [label="yes"];
+  connect -> connected [label="yes"];
+  connect -> anylive [label="no"];
+
+  // startserver -> anylive;
+  anylive -> askstart [label="yes"];
+  anylive -> anydboard [label="no"];
+  anydboard -> askdboard [label="yes"];
+  anydboard -> serverlaunch [label="no"];
+  serverlaunch -> wait5sec;
+  askdboard -> wait5sec;
+  askstart -> wait5sec;
+  wait5sec -> dotserver;
+
+}
+
+// server bootstrap
+subgraph cluster_2 {
+  label="Startup";
+  node [style=filled,shape=box];
+  getlock [label="Get file lock"];
+  starthttpcpdb [label="Start http server/copy db to /tmp"];
+  createsrvfile [label="Create .nnn.server file containing host:port"];
+  releaselock [label="Release file lock"];
+  chksrv [label="Check if server already exists"];
+  exitstartup [label="exit/stop"];
+  sleep1 [label="Sleep few seconds"];
+  
+  getlock -> starthttpcpdb [label="yes"];
+  getlock -> chksrv [label="no"];
+  starthttpcpdb -> createsrvfile -> releaselock;
+  chksrv -> exitstartup [label="yes"];
+  chksrv -> sleep1 [label="no"];
+  sleep1 -> getlock;
+}
+
+// shutting down server
+subgraph cluster_3 {
+  label="Shutdown";
+  node [style=filled,shape=box];
+  shutdown [label="Start Shutdown"];
+  rejectmode [label="Put http server into reject requests mode"];
+  syncback [label="Sync db back"];
+  removesrvfile [label="Remove server file containing host:port"];
+  exit [label="Exit process"];
+
+  shutdown -> rejectmode -> syncback -> removesrvfile -> exit;
+}
+
+//     subgraph cluster_1 {
+//         node [style=filled,shape=box];
+// 
+// 	check_available_queue       -> remove_entries_over_10s_old;
+// 	remove_entries_over_10s_old -> set_available [label="num_avail < 3"];
+// 	remove_entries_over_10s_old -> exit [label="num_avail > 2"];
+// 
+// 	set_available               -> delay_2s;
+// 	delay_2s          -> check_place_in_queue;
+// 
+// 	check_place_in_queue        -> "http:transport-launch" [label="at head"];
+// 	check_place_in_queue        -> exit [label="not at head"];
+// 
+// 	"client:login"              -> "server:shutdown" [label="login failed"];
+// 	"server:shutdown"           -> exit;	
+// 
+// 	subgraph cluster_2 {
+// 		"http:transport-launch"       -> "http:transport-run";
+// 		"http:transport-launch"       -> "http:transport-keep-running";
+// 
+// 		"http:transport-keep-running" -> "tests running?";
+// 		"tests running?"              -> "client:login" [label=yes];
+// 		"tests running?"              -> "server:shutdown" [label=no];
+// 		"client:login"                -> delay_5s [label="login ok"];
+// 		delay_5s                      -> "http:transport-keep-running";
+// 	}
+// 
+// 	// start_server -> "server_running?";
+// 	// "server_running?" -> set_available [label="no"];
+// 	// "server_running?" -> delay_2s [label="yes"];
+// 	// delay_2s -> "still_running?";
+// 	// "still_running?" -> ping_server [label=yes];
+// 	// "still_running?" -> set_available [label=no];
+// 	// ping_server -> exit [label=alive];
+// 	// ping_server -> remove_server_record [label=dead];
+// 	// remove_server_record -> set_available;
+// 	// set_available -> avail_delay [label="delay 3s"];
+// 	// avail_delay -> "first_in_queue?";
+// 	// 
+// 	// "first_in_queue?" -> set_running [label=yes];
+// 	// set_running -> get_next_port -> handle_requests;
+// 	// "first_in_queue?" -> "dead_entry_in_queue?" [label=no];
+// 	// "dead_entry_in_queue?" -> "server_running?" [label=no];
+// 	// "dead_entry_in_queue?" -> "remove_dead_entries" [label=yes];
+// 	// remove_dead_entries -> "server_running?";
+// 	// 
+// 	// handle_requests -> start_shutdown [label="no traffic\nno running tests"];
+// 	// handle_requests -> shutdown_request;
+// 	// start_shutdown -> shutdown_delay;
+// 	// shutdown_request -> shutdown_delay;
+// 	// shutdown_delay -> exit;
+// 	
+//         label = "server:launch";
+//         color=brown;
+//     }
 
 //     client_start_server -> start_server;
 //     handle_requests -> read_write;
 //     read_write -> handle_requests;
 }

Index: docs/manual/server.png
==================================================================
--- docs/manual/server.png
+++ docs/manual/server.png
cannot compute difference between binary files

Index: env.scm
==================================================================
--- env.scm
+++ env.scm
@@ -17,10 +17,13 @@
 ;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;======================================================================
 
 (declare (unit env))
+
+(declare (uses commonmod))
+(import commonmod)
 
 (use sql-de-lite) ;; srfi-1 posix regex regex-case srfi-69 srfi-18 call-with-environment-variables)
 
 (define (env:open-db fname)
   (let* ((db-exists (common:file-exists? fname))

Index: ezsteps.scm
==================================================================
--- ezsteps.scm
+++ ezsteps.scm
@@ -27,10 +27,13 @@
 (declare (uses common))
 (declare (uses items))
 (declare (uses runconfig))
 ;; (declare (uses sdb))
 ;; (declare (uses filedb))
+
+(declare (uses commonmod))
+(import commonmod)
 
 (include "common_records.scm")
 (include "key_records.scm")
 (include "db_records.scm")
 (include "run_records.scm")

Index: fs-transport.scm
==================================================================
--- fs-transport.scm
+++ fs-transport.scm
@@ -29,10 +29,13 @@
 
 (declare (uses common))
 (declare (uses db))
 (declare (uses tests))
 (declare (uses tasks)) ;; tasks are where stuff is maintained about what is running.
+
+(declare (uses commonmod))
+(import commonmod)
 
 (include "common_records.scm")
 (include "db_records.scm")
 
 

Index: genexample.scm
==================================================================
--- genexample.scm
+++ genexample.scm
@@ -18,10 +18,13 @@
 
 ;;======================================================================
 
 (declare (unit genexample))
 (use posix regex matchable)
+
+(declare (uses commonmod))
+(import commonmod)
 
 (include "db_records.scm")
 
 (define genexample:example-logpro
 #<<EOF

Index: http-transport.scm
==================================================================
--- http-transport.scm
+++ http-transport.scm
@@ -35,10 +35,13 @@
 (declare (uses tasks)) ;; tasks are where stuff is maintained about what is running.
 (declare (uses server))
 ;; (declare (uses daemon))
 (declare (uses portlogger))
 (declare (uses rmt))
+
+(declare (uses commonmod))
+(import commonmod)
 
 (include "common_records.scm")
 (include "db_records.scm")
 (include "js-path.scm")
 

Index: index-tree.scm
==================================================================
--- index-tree.scm
+++ index-tree.scm
@@ -29,10 +29,13 @@
 (declare (uses lock-queue))
 (declare (uses db))
 (declare (uses common))
 (declare (uses items))
 (declare (uses runconfig))
+
+(declare (uses commonmod))
+(import commonmod)
 
 (include "common_records.scm")
 (include "key_records.scm")
 (include "db_records.scm")
 (include "run_records.scm")

Index: items.scm
==================================================================
--- items.scm
+++ items.scm
@@ -21,10 +21,13 @@
 ;; 		     (temperature "cool medium hot")
 ;; 		     (season      "summer winter fall spring")))
 
 (declare (unit items))
 (declare (uses common))
+
+(declare (uses commonmod))
+(import commonmod)
 
 (include "common_records.scm")
 
 ;; Puts out all combinations
 (define (process-itemlist hierdepth curritemkey itemlist)

Index: keys.scm
==================================================================
--- keys.scm
+++ keys.scm
@@ -24,10 +24,13 @@
 (use sqlite3 srfi-1 posix regex regex-case srfi-69)
 (import (prefix sqlite3 sqlite3:))
 
 (declare (unit keys))
 (declare (uses common))
+
+(declare (uses commonmod))
+(import commonmod)
 
 (include "key_records.scm")
 (include "common_records.scm")
 
 (define (keys->keystr keys) ;; => key1,key2,key3,additiona1, ...

Index: launch.scm
==================================================================
--- launch.scm
+++ launch.scm
@@ -32,10 +32,13 @@
 (declare (uses subrun))
 (declare (uses common))
 (declare (uses configf))
 (declare (uses db))
 (declare (uses ezsteps))
+
+(declare (uses commonmod))
+(import commonmod)
 
 (include "common_records.scm")
 (include "key_records.scm")
 (include "db_records.scm")
 (include "megatest-fossil-hash.scm")

Index: lock-queue.scm
==================================================================
--- lock-queue.scm
+++ lock-queue.scm
@@ -20,10 +20,12 @@
 
 (declare (unit lock-queue))
 (declare (uses common))
 (declare (uses tasks))
 
+(declare (uses commonmod))
+(import commonmod)
 ;;======================================================================
 ;; attempt to prevent overlapping updates of rollup files by queueing
 ;; update requests in an sqlite db
 ;;======================================================================
 

Index: megatest.scm
==================================================================
--- megatest.scm
+++ megatest.scm
@@ -41,10 +41,27 @@
 (declare (uses tasks)) ;; only used for debugging.
 (declare (uses env))
 (declare (uses diff-report))
 ;; (declare (uses ftail))
 ;; (import ftail)
+
+;; Needed for repl even if not used here in megatest.scm
+(declare (uses commonmod))
+(import commonmod)
+(declare (uses commonmod.import))
+
+(declare (uses dbmod))
+(import dbmod)
+(declare (uses dbmod.import))
+
+(declare (uses servermod))
+(import servermod)
+(declare (uses servermod.import))
+
+(declare (uses apimod))
+(import apimod)
+(declare (uses apimod.import))
 
 (define *db* #f) ;; this is only for the repl, do not use in general!!!!
 
 (include "common_records.scm")
 (include "key_records.scm")
@@ -448,11 +465,11 @@
 			"-convert-to-norm"
 			"-convert-to-old"
 			"-import-megatest.db"
 			"-sync-to-megatest.db"
                         "-sync-brute-force"
-			"-logging"
+			;; "-logging"
 			"-v" ;; verbose 2, more than normal (normal is 1)
 			"-q" ;; quiet 0, errors/warnings only
 
                         "-diff-rep"
 
@@ -640,13 +657,13 @@
 
 ;;======================================================================
 ;; Misc setup stuff
 ;;======================================================================
 
-(debug:setup)
+(common:debug-setup)
 
-(if (args:get-arg "-logging")(set! *logging* #t))
+;; (if (args:get-arg "-logging")(set! *logging* #t))
 
 ;;(if (debug:debug-mode 3) ;; we are obviously debugging
 ;;    (set! open-run-close open-run-close-no-exception-handling))
 
 (if (args:get-arg "-itempatt")

ADDED   mofiles/README
Index: mofiles/README
==================================================================
--- /dev/null
+++ mofiles/README
@@ -0,0 +1,1 @@
+Built modules go here - an attempt to minimize clutter.

Index: mt.scm
==================================================================
--- mt.scm
+++ mt.scm
@@ -28,10 +28,13 @@
 (declare (uses tests))
 (declare (uses server))
 (declare (uses runs))
 (declare (uses rmt))
 ;; (declare (uses filedb))
+
+(declare (uses commonmod))
+(import commonmod)
 
 (include "common_records.scm")
 (include "key_records.scm")
 (include "db_records.scm")
 (include "run_records.scm")

ADDED   mtconfigf.scm
Index: mtconfigf.scm
==================================================================
--- /dev/null
+++ mtconfigf.scm
@@ -0,0 +1,23 @@
+;;======================================================================
+;; Copyright 2019, Matthew Welland.
+;; 
+;; This file is part of Megatest.
+;; 
+;;     Megatest is free software: you can redistribute it and/or modify
+;;     it under the terms of the GNU General Public License as published by
+;;     the Free Software Foundation, either version 3 of the License, or
+;;     (at your option) any later version.
+;; 
+;;     Megatest is distributed in the hope that it will be useful,
+;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;     GNU General Public License for more details.
+;; 
+;;     You should have received a copy of the GNU General Public License
+;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
+
+;;======================================================================
+
+(declare (unit mtconfigf))
+
+(include "mtconfigf/mtconfigf.scm")

ADDED   mtconfigf/Makefile
Index: mtconfigf/Makefile
==================================================================
--- /dev/null
+++ mtconfigf/Makefile
@@ -0,0 +1,2 @@
+test:
+	 env CHICKEN_REPOSITORY=../../../megatest/tmpinstall/eggs/lib/chicken/7 csi -s tests/run.scm

ADDED   mtconfigf/mtconfigf.meta
Index: mtconfigf/mtconfigf.meta
==================================================================
--- /dev/null
+++ mtconfigf/mtconfigf.meta
@@ -0,0 +1,20 @@
+(
+; Your egg's license:
+(license "LGPL")
+
+; Pick one from the list of categories (see below) for your egg and enter it
+; here.
+(category misc)
+
+; A list of eggs mpeg3 depends on.  If none, you can omit this declaration
+; altogether. If you are making an egg for chicken 3 and you need to use
+; procedures from the `files' unit, be sure to include the `files' egg in the
+; `needs' section (chicken versions < 3.4.0 don't provide the `files' unit).
+; `depends' is an alias to `needs'.
+(needs srfi-1 srfi-69 regex regex-case directory-utils extras srfi-13 posix typed-records)
+
+; A list of eggs required for TESTING ONLY.  See the `Tests' section.
+(test-depends test)
+
+(author "Matt Welland")
+(synopsis "Megatest config file (ini-space format) with many enhancements."))

ADDED   mtconfigf/mtconfigf.scm
Index: mtconfigf/mtconfigf.scm
==================================================================
--- /dev/null
+++ mtconfigf/mtconfigf.scm
@@ -0,0 +1,1171 @@
+;;======================================================================
+;; Copyright 2006-2018, Matthew Welland.
+;; 
+;; This file is part of Megatest.
+;; 
+;;     Megatest is free software: you can redistribute it and/or modify
+;;     it under the terms of the GNU General Public License as published by
+;;     the Free Software Foundation, either version 3 of the License, or
+;;     (at your option) any later version.
+;; 
+;;     Megatest is distributed in the hope that it will be useful,
+;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;     GNU General Public License for more details.
+;; 
+;;     You should have received a copy of the GNU General Public License
+;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
+;;
+;;======================================================================
+
+;; NOTE: This is the configf module, long term it will replace configf.scm.
+
+(module mtconfigf
+        (
+	 set-debug-printers
+	 lazy-convert
+	 assoc-safe-add
+	 section-var-set!
+	 safe-file-exists?
+	 read-link-f
+	 nice-path
+	 eval-string-in-environment
+	 safe-setenv
+	 with-env-vars
+	 cmd-run->list
+	 port->list
+	 configf:system
+	 process-line
+	 shell
+	 configf:read-line
+	 cfgdat->env-alist
+	 calc-allow-system
+	 apply-wildcards
+	 val->alist
+	 section->val-alist
+	 read-config
+	 find-config
+	 find-and-read-config
+	 lookup
+	 var-is?
+	 lookup-number
+	 section-vars
+	 get-section
+	 set-section-var
+	 compress-multi-lines
+	 expand-multi-lines
+	 file->list
+	 write-config
+	 write-merge-config
+	 read-refdb
+	 map-all-hier-alist
+	 config->alist
+	 alist->config
+	 read-alist
+	 write-alist
+	 config->ini
+	 ;;set-verbosity
+         add-eval-string
+	 get-eval-string
+         squelch-debug-prints
+	 ;; misc
+	 realpath
+	 find-chicken-lib
+         )
+
+(import scheme (chicken base) (chicken string) (chicken file) (chicken port))
+(import typed-records srfi-18 pathname-expand)
+(import regex regex-case srfi-69 srfi-1 directory-utils srfi-13 )
+(import (chicken io) (chicken condition) (chicken process-context))
+(import (chicken process) (chicken pathname) (chicken pretty-print) (chicken time))
+(import srfi-69 (chicken platform) (chicken sort))
+
+;; stub debug printers overridden by set-debug-printers
+(define (debug:print n e . args)
+  (apply print args))
+(define (debug:print-info n e . args)
+  (apply print "INFO: " args))
+(define (debug:print-error n e . args)
+  (apply print "ERROR: " args))
+
+;;(import (prefix mtdebug debug:))
+;;(define args:any? args:any-defined?) ;; cannot name it any? in mtargs module
+
+
+;; FROM common.scm
+;;
+;; this plugs a hole in posix-extras in recent chicken versions > 4.9)
+;;;(let-values (( (chicken-release-number chicken-major-version)
+;;;               (apply values
+;;;                      (map string->number
+;;;                           (take
+;;;                            (string-split (chicken-version) ".")
+;;;                            2)))))
+;;;  (if (or (> chicken-release-number 4)
+;;;	  (and (eq? 4 chicken-release-number) (> chicken-major-version 9)))
+;;;      (define ##sys#expand-home-path pathname-expand)))
+
+
+ ;;(define (set-verbosity v)(debug:set-verbosity v))
+
+ (define *default-log-port* (current-error-port))
+
+ (define (debug:print-error n . args) ;;; n available to end-users but ignored for
+   ;; default provided function
+  (with-output-to-port (current-error-port)
+    (lambda ()
+      (apply print "ERROR: "args))))
+
+(define (set-debug-printers normal-fn info-fn error-fn default-port)
+  (if error-fn  (set! debug:print-error error-fn))
+  (if info-fn   (set! debug:print-info  info-fn))
+  (if normal-fn (set! debug:print       normal-fn))
+  (if default-port (set! *default-log-port* default-port)))
+
+(define (squelch-debug-prints)
+  (let ((noop (lambda x #f)))
+    (set! debug:print noop)
+    (set! debug:print-info noop)))
+
+
+;; if it looks like a number -> convert it to a number, else return it
+;;
+(define (lazy-convert inval)
+  (let* ((as-num (if (string? inval)(string->number inval) #f)))
+    (or as-num inval)))
+
+
+(define *eval-string* "")
+(define (add-eval-string str)
+  (if (not (string-contains *eval-string* str))
+      (set! *eval-string* (conc *eval-string* " " str))))
+(define (get-eval-string) *eval-string*)
+
+;; Moved to common
+;;
+;; return list (path fullpath configname)
+(define (find-config configname #!key (toppath #f))
+  (if toppath
+      (let ((cfname (conc toppath "/" configname)))
+	(if (safe-file-exists? cfname)
+	    (list toppath cfname configname)
+	    (list #f      #f     #f)))
+      (let* ((cwd (string-split (current-directory) "/")))
+	(let loop ((dir cwd))
+	  (let* ((path     (conc "/" (string-intersperse dir "/")))
+		 (fullpath (conc path "/" configname)))
+	    (if (safe-file-exists? fullpath)
+		(list path fullpath configname)
+		(let ((remcwd (take dir (- (length dir) 1))))
+		  (if (null? remcwd)
+		      (list #f #f #f) ;;  #f #f) 
+		  (loop remcwd)))))))))
+
+(define (assoc-safe-add alist key val #!key (metadata #f))
+  (let ((newalist (filter (lambda (x)(not (equal? key (car x)))) alist)))
+    (append newalist (list (if metadata
+			       (list key val metadata)
+			       (list key val))))))
+
+(define (section-var-set! cfgdat section-name var value #!key (metadata #f))
+  (hash-table-set! cfgdat section-name
+		   (assoc-safe-add
+		    (hash-table-ref/default cfgdat section-name '())
+		    var value metadata: metadata)))
+;;======================================================================
+;; Environment handling stuff
+;;======================================================================
+
+(define (safe-file-exists? path)
+  (handle-exceptions exn #f (file-exists? path)))
+
+(define (read-link-f path)
+  (handle-exceptions
+      exn
+      (begin
+	(debug:print-error 0 *default-log-port* "command \"/bin/readlink -f " path "\" failed.")
+	path) ;; just give up
+    (with-input-from-pipe
+	(conc "/bin/readlink -f " path)
+      (lambda ()
+	(read-line)))))
+
+;; return a nice clean pathname made absolute
+(define (nice-path dir)
+  (let ((match (string-match "^(~[^\\/]*)(\\/.*|)$" dir)))
+    (if match ;; using ~ for home?
+	(nice-path (conc #;(read-link-f (cadr match))
+		    (realpath (cadr match))
+		    "/" (caddr match)))
+	(normalize-pathname (if (absolute-pathname? dir)
+				dir
+				(conc (current-directory) "/" dir))))))
+
+(define (eval-string-in-environment str)
+  (handle-exceptions
+   exn
+   (begin
+     (debug:print-error 0 *default-log-port* "problem evaluating \"" str "\" in the shell environment")
+     #f)
+   (let ((cmdres (cmd-run->list (conc "echo " str))))
+     (if (null? cmdres) ""
+	 (caar cmdres)))))
+
+(define (safe-setenv key val)
+  (if (substring-index ":" key) ;; variables containing : are for internal use and cannot be environment variables.
+      (debug:print-error 4 *default-log-port* "skip setting internal use only variables containing \":\"")
+      (if (and (string? val)
+	       (string? key))
+	  (handle-exceptions
+	      exn
+	      (debug:print-error 0 *default-log-port* "bad value for setenv, key=" key ", value=" val)
+	    (set-environment-variable! key val))
+	  (debug:print-error 0 *default-log-port* "bad value for setenv, key=" key ", value=" val))))
+
+;; accept an alist or hash table containing envvar/env value pairs (value of #f causes unset) 
+;;   execute thunk in context of environment modified as per this list
+;;   restore env to prior state then return value of eval'd thunk.
+;;   ** this is not thread safe **
+(define (with-env-vars delta-env-alist-or-hash-table thunk)
+  (let* ((delta-env-alist (if (hash-table? delta-env-alist-or-hash-table)
+                              (hash-table->alist delta-env-alist-or-hash-table)
+                              delta-env-alist-or-hash-table))
+         (restore-thunks
+          (filter
+           identity
+           (map (lambda (env-pair)
+                  (let* ((env-var     (car env-pair))
+                         (new-val     (let ((tmp (cdr env-pair)))
+                                        (if (list? tmp) (car tmp) tmp)))
+                         (current-val (get-environment-variable env-var))
+                         (restore-thunk
+                          (cond
+                           ((not current-val) (lambda () (unset-environment-variable! env-var)))
+                           ((not (string? new-val)) #f)
+                           ((eq? current-val new-val) #f)
+                           (else 
+                            (lambda () (set-environment-variable! env-var current-val))))))
+                    ;;(when (not (string? new-val))
+                    ;;    (debug:print 0 *default-log-port* " PROBLEM: not a string: "new-val"\n from env-alist:\n"delta-env-alist)
+                    ;;    (pp delta-env-alist)
+                    ;;    (exit 1))
+                        
+                    
+                    (cond
+                     ((not new-val)  ;; modify env here
+                      (unset-environment-variable! env-var))
+                     ((string? new-val)
+                      (set-environment-variable! env-var new-val)))
+                    restore-thunk))
+                delta-env-alist))))
+    (let ((rv (thunk)))
+      (for-each (lambda (x) (x)) restore-thunks) ;; restore env to original state
+      rv)))
+
+(define (cmd-run->list cmd #!key (delta-env-alist-or-hash-table '()))
+  (with-env-vars
+   delta-env-alist-or-hash-table
+   (lambda ()
+     (let* ((fh (open-input-pipe cmd))
+            (res (port->list fh))
+            (status (close-input-pipe fh)))
+       (list res status)))))
+   
+(define (port->list fh)
+  (if (eof-object? fh) #f
+      (let loop ((curr (read-line fh))
+                 (result '()))
+        (if (not (eof-object? curr))
+            (loop (read-line fh)
+                  (append result (list curr)))
+            result))))
+
+;;======================================================================
+;; Make the regexp's needed globally available
+;;======================================================================
+
+(define configf:include-rx (regexp "^\\[include\\s+(.*)\\]\\s*$"))
+(define configf:script-rx  (regexp "^\\[scriptinc\\s+(\\S+)([^\\]]*)\\]\\s*$")) ;; include output from a script
+(define configf:section-rx (regexp "^\\[(.*)\\]\\s*$"))
+(define configf:blank-l-rx (regexp "^\\s*$"))
+(define configf:key-sys-pr (regexp "^(\\S+)\\s+\\[system\\s+(\\S+.*)\\]\\s*$"))
+(define configf:key-val-pr (regexp "^(\\S+)(\\s+(.*)|())$"))
+(define configf:key-no-val (regexp "^(\\S+)(\\s*)$"))
+(define configf:comment-rx (regexp "^\\s*#.*"))
+(define configf:cont-ln-rx (regexp "^(\\s+)(\\S+.*)$"))
+(define configf:settings   (regexp "^\\[configf:settings\\s+(\\S+)\\s+(\\S+)]\\s*$"))
+(define configf:initstr-rx (regexp "^\\[configf:initstr\\s+(.*)\\]\\s*$"))
+
+;; read a line and process any #{ ... } constructs
+
+(define configf:var-expand-regex (regexp "^(.*)#\\{(scheme|system|shell|getenv|get|runconfigs-get|rget|scm|sh|rp|gv|g|mtrah)\\s+([^\\}\\{]*)\\}(.*)"))
+
+(define (configf:system ht cmd)
+  (system cmd)
+  )
+
+;; Lookup a value in runconfigs based on -reqtarg or -target
+;; 
+(define (runconfigs-get config var) ;; .dvars is a special bin for storing metadata such as target
+  (let ((targ (lookup config ".dvars" "target"))) ;; (common:args-get-target))) ;; (or (args:get-arg "-reqtarg")(args:get-arg "-target")(getenv "MT_TARGET"))))
+    (if targ
+	(or (lookup config targ var)
+	    (lookup config "default" var))
+	(lookup config "default" var))))
+
+(define (realpath x)
+  (let ((currdir (current-directory)))
+    (handle-exceptions
+	exn
+	(begin
+	  (change-directory currdir)
+	  x) ;; anything goes wrong - return given path
+      (change-directory x)
+      (let ((result (current-directory)))
+	(change-directory currdir)
+	result))))
+
+;;  (resolve-pathname  (pathname-expand (or x "/dev/null")) ))
+
+(define (common:get-this-exe-fullpath #!key (argv (argv)))
+  (let* ((this-script
+          (cond
+           ((and (> (length argv) 2)
+                 (string-match "^(.*/csi|csi)$" (car argv))
+                 (string-match "^-(s|ss|sx|script)$" (cadr argv)))
+            (caddr argv))
+           (else (car argv))))
+         (fullpath (realpath this-script)))
+    fullpath))
+
+;; (use trace)
+;; (trace-call-sites #t)
+;; (trace realpath common:get-this-exe-fullpath)
+
+(define *common:this-exe-fullpath* (common:get-this-exe-fullpath))
+(define *common:this-exe-dir*      (pathname-directory *common:this-exe-fullpath*))
+(define *common:this-exe-name*     (pathname-strip-directory *common:this-exe-fullpath*))
+
+(define (find-chicken-lib)
+  (let* ((ckhome         (chicken-home))
+	 (libpath-number (car (reverse (string-split  (repository-path) "/"))))
+	 (libpath        (conc *common:this-exe-dir* "/../../eggs/lib/chicken/" libpath-number)))
+    (if (and (not (get-environment-variable "CHICKEN_REPOSITORY"))
+	     (directory-exists? libpath))
+	(conc "(repository-path \""libpath"\") ")
+	"")))
+  
+(define (process-line l ht allow-system #!key (linenum #f)(extend-eval ""))
+  (let loop ((res l))
+    (if (string? res)
+	(let ((matchdat (string-search configf:var-expand-regex res)))
+	  (if matchdat
+	      (let* ((prestr  (list-ref matchdat 1))
+		     (cmdtype (list-ref matchdat 2)) ;; eval, system, shell, getenv
+		     (cmd     (list-ref matchdat 3))
+		     (poststr (list-ref matchdat 4))
+		     (result  #f)
+		     (start-time (current-milliseconds))
+		     (cmdsym  (string->symbol cmdtype))
+		     (presnip (conc "(import posix)(import directory-utils)"
+				    "(set! getenv get-environment-variable)"
+                                    ))
+		     (allsnip (conc "(import posix)(import directory-utils)"
+				    "(set! getenv get-environment-variable)"
+				    (find-chicken-lib)
+                                    "(import (prefix mtconfigf configf:))"
+				    "(import mtconfigf)"
+                                    *eval-string*))
+		     (fullcmd (case cmdsym
+				((scheme scm) (conc "(lambda (ht)" allsnip "" cmd "))"))
+				((system)     (conc "(lambda (ht)" allsnip "(configf:system ht \"" cmd "\"))"))
+				((shell sh)   (conc "(lambda (ht)" allsnip "(string-translate (shell \""  cmd "\") \"\n\" \" \"))"))
+				((realpath rp)(conc "(lambda (ht)" allsnip "(configf:nice-path \"" cmd "\"))"))
+				((getenv gv)  (conc "(lambda (ht)(get-environment-variable \"" cmd "\"))"))
+				((mtrah)      (conc "(lambda (ht)"
+						    allsnip
+                                                    "  (let ((extra \"" cmd "\"))"
+						    "     (conc (or *toppath* (get-environment-variable \"MT_RUN_AREA_HOME\"))"
+						    "        (if (string-null? extra) \"\" \"/\")"
+						    "     extra)))"))
+				((get g)   
+				 (let* ((parts (string-split cmd))
+					(sect  (car parts))
+					(var   (cadr parts)))
+				   (conc "(lambda (ht)(configf:lookup ht \"" sect "\" \"" var "\"))")))
+				;;((runconfigs-get rget) (conc "(lambda (ht)" allsnip "(configf:runconfigs-get ht \"" cmd "\"))"))
+                                ((runconfigs-get rget)
+                                 (runconfigs-get ht cmd))
+				(else "(lambda (ht)(print \"ERROR\") \"ERROR\")"))))
+
+		(handle-exceptions
+		    exn
+		    (let ((arguments ((condition-property-accessor 'exn 'arguments) exn))
+			  (message    ((condition-property-accessor 'exn 'message) exn))
+			  (allstr     (conc "#{( " cmdtype ") " cmd "}, full expansion: " fullcmd)))
+		      (debug:print 0 *default-log-port* "WARNING: failed to process config input \"" l "\"")
+		      (debug:print 0 *default-log-port* " message: " message 
+				   (if arguments
+				       (conc "; " (string-intersperse (map conc arguments) ", "))
+				       ""))
+		      (debug:print 0 *default-log-port* "INFO: allstr is\n" allstr)
+		      ;; (debug:print 0 *default-log-port* "exn=" (condition->list exn))
+		      (set! result allstr))
+		  (if (or allow-system
+			  (not (member cmdtype '("system" "shell" "sh"))))
+                      (if (member cmdsym '(runconfigs-get rget))
+                          (begin
+                            (set! result fullcmd)
+                            fullcmd)
+		          (with-input-from-string fullcmd
+			    (lambda ()
+			      (set! result ((eval (read)
+						  ;;(module-environment 'mtconfigf)
+						  ) ht)))))
+		      (set! result (conc "#{(" cmdtype ") "  cmd "}"))))
+		(case cmdsym
+		  ((system shell scheme scm sh)
+		   (let ((delta (- (current-milliseconds) start-time)))
+		     (if (> delta 2000)
+			 (debug:print-info 0 *default-log-port* "for line \"" l "\"\n command:  " cmd " took " (/ delta 1000) " seconds to run with output:\n   " result)
+			 (debug:print-info 9 *default-log-port* "for line \"" l "\"\n command:  " cmd " took " (/ delta 1000) " seconds to run with output:\n   " result)))))
+		(loop (conc prestr result poststr)))
+	      res))
+	res)))
+
+;; Run a shell command and return the output as a string
+(define (shell cmd)
+  (let* ((output (cmd-run->list cmd))
+	 (res    (car output))
+	 (status (cadr output)))
+    (if (equal? status 0)
+	(let ((outres (string-intersperse 
+		       res
+		       "\n")))
+	  (debug:print-info 4 *default-log-port* "shell result:\n" outres)
+	  outres)
+	(begin
+	  (with-output-to-port (current-error-port)
+	    (lambda ()
+	      (print "ERROR: " cmd " returned bad exit code " status)))
+	  ""))))
+
+;; this was inline but I'm pretty sure that is a hold over from when it was *very* simple ...
+;;
+(define (configf:read-line p ht allow-processing settings #!key ....)
+  (let loop ((inl (read-line p)))
+    (let ((cont-line (and (string? inl)
+			  (not (string-null? inl))
+			  (equal? "\\" (string-take-right inl 1)))))
+      (if cont-line ;; last character is \ 
+	  (let ((nextl (read-line p)))
+	    (if (not (eof-object? nextl))
+		(loop (string-append (if cont-line 
+					 (string-take inl (- (string-length inl) 1))
+					 inl)
+				     nextl))))
+	  (let ((res (case allow-processing ;; if (and allow-processing 
+		       ;;	   (not (eq? allow-processing 'return-string)))
+		       ((#t #f)
+			(process-line inl ht allow-processing))
+		       ((return-string)
+			inl)
+		       (else
+			(process-line inl ht allow-processing)))))
+	    (if (string? res)
+		(let* ((r1 (if (not (equal? (hash-table-ref/default settings "trim-trailing-spaces" "no") "no"))
+			       (string-substitute "\\s+$" "" res)
+			       res))
+		       (r2 (if (not (equal? (hash-table-ref/default settings "line-end-comments" "no") "no"))
+			      (string-substitute "\\s*#+[^\\{]*.*$" "" r1)
+			      r1)))
+		  r2)
+		res))))))
+
+(define (cfgdat->env-alist section cfgdat-ht allow-system)
+  (filter
+   (lambda (pair)
+     (let* ((var (car pair))
+            (val (cdr pair)))
+       (cons var
+             (cond
+              ((and allow-system (procedure? val)) ;; if we decided to use something other than #t or #f for allow-system ('return-procs or 'return-string) , this may become problematic
+               (val))
+              ((procedure? val) #f)
+              ((string? val) val)
+              (else "#f")))))
+   (append
+    (hash-table-ref/default cfgdat-ht "default" '())
+    (if (equal? section "default") '() (hash-table-ref/default cfgdat-ht section '())))))
+
+(define (calc-allow-system allow-system section sections)
+  (if sections
+      (and (or (equal? "default" section)
+	       (member section sections))
+	   allow-system) ;; account for sections and return allow-system as it might be a symbol such as return-strings
+      allow-system))
+    
+;; given a config hash and a section name, apply that section to all matching sections (using wildcard % or regex if /..../)
+;; remove the section when done so that there is no downstream clobbering
+;;
+(define (apply-wildcards ht section-name)
+  (if (hash-table-exists? ht section-name)
+      (let* ((vars  (hash-table-ref ht section-name))
+	     (rxstr (if (string-contains section-name "%")
+			(string-substitute (regexp "%") ".*" section-name)
+			(string-substitute (regexp "^/(.*)/$") "\\1" section-name)))
+	     (rx    (regexp rxstr)))
+	;; (print "\nsection-name: " section-name " rxstr: " rxstr)
+        (for-each
+         (lambda (section)
+	   (if section
+	       (let ((same-section (string=? section-name section))
+		     (rx-match     (string-match rx section)))
+		 ;; (print "section: " section " vars: " vars " same-section: " same-section " rx-match: " rx-match)
+		 (if (and (not same-section) rx-match)
+		     (for-each
+		      (lambda (bundle)
+			;; (print "bundle: " bundle)
+			(let ((key  (car bundle))
+			      (val  (cadr bundle))
+			      (meta (if (> (length bundle) 2)(caddr bundle) #f)))
+			  (hash-table-set! ht section (assoc-safe-add (hash-table-ref ht section) key val metadata: meta))))
+		      vars)))))
+         (hash-table-keys ht))))
+  ht)
+
+;;======================================================================
+;; Extended config lines, allows storing more hierarchial data in the config lines
+;;   ABC a=1; b=hello world; c=a
+;;
+;; NOTE: implementation is quite limited. You currently cannot have
+;;       semicolons in your string values.
+;;======================================================================
+
+;; convert string a=1; b=2; c=a silly thing; d=
+;; to '((a . 1)(b . 2)(c . "a silly thing")(d . ""))
+;;
+(define (val->alist val #!key (convert #f))
+  (let ((val-list (string-split-fields ";\\s*" val #:infix)))
+    (if val-list
+	(map (lambda (x)
+	       (let ((f (string-split-fields "\\s*=\\s*" x #:infix)))
+		 (case (length f)
+		   ((0) `(,#f))  ;; null string case
+		   ((1) `(,(string->symbol (car f))))
+		   ((2) `(,(string->symbol (car f)) . ,(let ((inval (cadr f)))
+							 (if convert (lazy-convert inval) inval))))
+		   (else f))))
+	     val-list)
+	'())))
+
+;; I don't want configf to turn into a weak yaml format but this extention is really useful
+;;
+(define (section->val-alist cfgdat section-name #!key (convert #f))
+  (let ((section (get-section cfgdat section-name)))
+    (map (lambda (item)
+           (let ((key (car item))
+                 (val (cadr item))) ;; BUG IN WAIT. sections are not returned as proper alists, should fix this.
+             (cons key (val->alist val convert: convert))))
+         section)))
+  
+;; read a config file, returns hash table of alists
+
+;; read a config file, returns hash table of alists
+;; adds to ht if given (must be #f otherwise)
+;; allow-system:
+;;    #f - do not evaluate [system
+;;    #t - immediately evaluate [system and store result as string
+;;    'return-procs -- return a proc taking ht as an argument that may be evaulated at some future time
+;;    'return-string -- return a string representing a proc taking ht as an argument that may be evaulated at some future time
+;; envion-patt is a regex spec that identifies sections that will be eval'd
+;; in the environment on the fly
+;; sections: #f => get all, else list of sections to gather
+;; post-section-procs alist of section-pattern => proc, where: (proc section-name next-section-name ht curr-path)
+;; apply-wildcards: #t/#f - apply vars from targets with % wildcards to all matching sections
+;;
+;; NOTE: apply-wild variable is intentional (but a better name would be good)
+;;
+(define (read-config path ht allow-system #!key (environ-patt #f)            (curr-section #f)   
+		     (sections #f)              (settings (make-hash-table)) (keep-filenames #f)
+		     (post-section-procs '())   (apply-wild #t) )
+  (debug:print 9 *default-log-port* "BB> read-config > keep-filenames: " keep-filenames)
+  (debug:print 9 *default-log-port* "START: " path)
+;; (if *configdat*
+;;     (common:save-pkt `((action . read-config)
+;;       		 (f      . ,(cond ((string? path) path)
+;;       				  ((port?   path) "port")
+;;       				  (else (conc path))))
+;;                        (T      . configf))
+;;       	       *configdat* #t add-only: #t))
+  (if (and (not (port? path))
+	   (not (safe-file-exists? path))) ;; for case where we are handed a port
+      (begin 
+	(debug:print-info 1 *default-log-port* "read-config - file not found " path " current path: " (current-directory))
+	;; WARNING: This is a risky change but really, we should not return an empty hash table if no file read?
+	#f) ;; (if (not ht)(make-hash-table) ht))
+      (let* ((have-file  (string? path))
+	     (inp        (if have-file
+			     (open-input-file path)
+			     path)) ;; we can be handed a port
+	     (res        (if (not ht)(make-hash-table) ht))
+	     (metapath   (if keep-filenames
+			     path #f))
+	     (process-wildcards  (lambda (res curr-section-name)
+				   (if (and apply-wild
+					    (or (string-contains curr-section-name "%")   ;; wildcard
+						(string-match "/.*/" curr-section-name))) ;; regex
+				       (begin
+					 (apply-wildcards res curr-section-name)
+					 (hash-table-delete! res curr-section-name))))))  ;; NOTE: if the section is a wild card it will be REMOVED from res 
+	(let loop ((inl               (configf:read-line inp res (calc-allow-system allow-system curr-section sections) settings)) ;; (read-line inp))
+		   (curr-section-name (if curr-section curr-section "default"))
+		   (var-flag #f);; turn on for key-var-pr and cont-ln-rx, turn off elsewhere
+		   (lead     #f))
+	  (debug:print-info 8 *default-log-port* "curr-section-name: " curr-section-name " var-flag: " var-flag "\n   inl: \"" inl "\"")
+	  (if (eof-object? inl) 
+	      (begin
+                ;; process last section for wildcards
+                (process-wildcards res curr-section-name)
+		(if have-file ;; we received a path, not a port, thus we are responsible for closing it.
+		    (close-input-port inp))
+		(if (list? sections) ;; delete all sections except given when sections is provided
+		    (for-each
+		     (lambda (section)
+		       (if (not (member section sections))
+			   (hash-table-delete! res section))) ;; we are using "" as a dumping ground and must remove it before returning the ht
+		     (hash-table-keys res)))
+		(debug:print 9 *default-log-port* "END: " path)
+                res
+                ) ;; retval
+	      (regex-case 
+	       inl 
+	       (configf:comment-rx _                  (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings)
+                                                            curr-section-name #f #f))
+               
+	       (configf:blank-l-rx _                  (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings)
+                                                            curr-section-name #f #f))
+	       (configf:settings   ( x setting val  )
+                                   (begin
+                                     (hash-table-set! settings setting val)
+                                     (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings)
+                                           curr-section-name #f #f)))
+	       
+	       (configf:initstr-rx ( x initstr  )
+                                   (begin
+				     (add-eval-string initstr)
+                                     (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings)
+                                           curr-section-name #f #f)))
+               
+	       (configf:include-rx ( x include-file )
+                                   (let* ((curr-conf-dir (pathname-directory path))
+                                          (full-conf     (if (and (absolute-pathname? include-file) (file-exists? include-file))
+                                                             include-file
+                                                             (nice-path 
+                                                              (conc (if curr-conf-dir
+                                                                        curr-conf-dir
+                                                                        ".")
+                                                                    "/" include-file))))
+					  (all-matches (sort (handle-exceptions exn (list) (glob full-conf)) string<=?)))
+				       (if (null? all-matches)
+					   (begin
+					     (debug:print '(2 9) #f "INFO: include file(s) matching " include-file " not found (called from " path ")")
+					     (debug:print 2 *default-log-port* "        " full-conf))
+					   (for-each
+					    (lambda (fpath)
+					      ;; (push-directory conf-dir)
+					      (debug:print 9 *default-log-port* "Including: " full-conf)
+					      (read-config fpath res allow-system environ-patt: environ-patt
+							   curr-section: curr-section-name sections: sections settings: settings
+							   keep-filenames: keep-filenames))
+					    all-matches))
+				       (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings)
+					     curr-section-name #f #f)))
+	       (configf:script-rx ( x include-script params);; handle-exceptions
+                                  ;;    exn
+                                  ;;    (begin
+                                  ;;      (debug:print '(0 2 9) #f "INFO: include from script " include-script " failed.")
+                                  ;;      (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f))
+                                  (if (and (safe-file-exists? include-script)(file-executable? include-script))
+                                      (let* ((local-allow-system  (calc-allow-system allow-system curr-section-name sections))
+                                             (env-delta  (cfgdat->env-alist curr-section-name res local-allow-system))
+                                             (new-inp-port
+                                              (with-env-vars
+                                               env-delta
+                                               (lambda ()
+                                                 (open-input-pipe (conc include-script " " params))))))
+                                        (debug:print '(2 9) *default-log-port* "Including from script output: " include-script)
+                                        ;;  (print "We got here, calling read-config next. Port is: " new-inp-port)
+                                        (read-config new-inp-port res allow-system environ-patt: environ-patt curr-section: curr-section-name sections: sections settings: settings keep-filenames: keep-filenames)
+                                        (close-input-port new-inp-port)
+                                        (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f))
+                                      (begin
+                                        (debug:print 0 *default-log-port* "Script not found or not exectutable: " include-script)
+                                        (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f)))
+                                  ) ;; )
+	       (configf:section-rx ( x section-name )
+                                   (begin
+                                     ;; call post-section-procs
+                                     (for-each 
+                                      (lambda (dat)
+                                        (let ((patt (car dat))
+                                              (proc (cdr dat)))
+                                          (if (string-match patt curr-section-name)
+                                              (proc curr-section-name section-name res path))))
+                                      post-section-procs)
+                                     ;; after gathering the vars for a section and if apply-wildcards is true and if there is a wildcard in the section name process wildcards
+                                     ;; NOTE: we are processing the curr-section-name, NOT section-name.
+                                     (process-wildcards res curr-section-name)
+                                     (if (not (hash-table-ref/default res section-name #f))(hash-table-set! res section-name '())) ;; ensure that mere mention of a section is not lost
+                                     (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings)
+                                           ;; if we have the sections list then force all settings into "" and delete it later?
+                                           ;; (if (or (not sections) 
+                                           ;;	      (member section-name sections))
+                                           ;;	  section-name "") ;; stick everything into "". NOPE: We need new strategy. Put stuff in correct sections and then delete all sections later.
+                                           section-name
+                                           #f #f)))
+	       (configf:key-sys-pr ( x key cmd      )
+                                   (if (calc-allow-system allow-system curr-section-name sections)
+                                       (let ((alist    (hash-table-ref/default res curr-section-name '()))
+                                             (val-proc (lambda ()
+                                                         (let* ((start-time (current-seconds))
+                                                                (local-allow-system  (calc-allow-system allow-system curr-section-name sections))
+                                                                (env-delta  (cfgdat->env-alist curr-section-name res local-allow-system))
+                                                                (cmdres     (cmd-run->list cmd delta-env-alist-or-hash-table: env-delta)) ;; BB: here is where [system is exec'd.  needs to have env from other vars!
+                                                                (delta      (- (current-seconds) start-time))
+                                                                (status     (cadr cmdres))
+                                                                (res        (car  cmdres)))
+                                                           (debug:print-info 4 *default-log-port* "" inl "\n => " (string-intersperse res "\n"))
+                                                           (if (not (eq? status 0))
+                                                               (begin
+                                                                 (debug:print-error 0 *default-log-port* "problem with " inl ", return code " status
+                                                                                    " output: " cmdres)))
+                                                           (if (> delta 2)
+                                                               (debug:print-info 0 *default-log-port* "for line \"" inl "\"\n  command: " cmd " took " delta " seconds to run with output:\n   " res)
+                                                               (debug:print-info 9 *default-log-port* "for line \"" inl "\"\n  command: " cmd " took " delta " seconds to run with output:\n   " res))
+                                                           (if (null? res)
+                                                               ""
+                                                               (string-intersperse res " "))))))
+                                         (hash-table-set! res curr-section-name 
+                                                          (assoc-safe-add alist
+                                                                                 key 
+                                                                                 (case (calc-allow-system allow-system curr-section-name sections)
+                                                                                   ((return-procs) val-proc)
+                                                                                   ((return-string) cmd)
+                                                                                   (else (val-proc)))
+                                                                                 metadata: metapath))
+                                         (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f))
+                                       (loop (configf:read-line inp res
+                                                                (calc-allow-system allow-system curr-section-name sections)
+                                                                settings)
+                                             curr-section-name #f #f)))
+               
+	       (configf:key-no-val ( x key val)
+                                   (let* ((alist   (hash-table-ref/default res curr-section-name '()))
+                                          (fval    (or (if (string? val) val #f) ""))) ;; fval should be either "" or " " (one or more spaces)
+                                     (debug:print 10 *default-log-port* "   setting: [" curr-section-name "] " key " = #t")
+                                     (safe-setenv key fval)
+                                     (hash-table-set! res curr-section-name 
+                                                      (assoc-safe-add alist key fval metadata: metapath))
+                                     (loop (configf:read-line inp res
+                                                              (calc-allow-system allow-system curr-section-name sections)
+                                                              settings)
+                                           curr-section-name key #f)))
+               
+	       (configf:key-val-pr ( x key unk1 val unk2 )
+                                   (let* ((alist   (hash-table-ref/default res curr-section-name '()))
+                                          (envar   (and environ-patt
+							(string-search (regexp environ-patt) curr-section-name)
+							(and (not (string-null? key))
+							     (not (equal? "!" (substring key 0 1)))) ;; ! as leading character is a signature to NOT export to the environment
+							;; (string-match "^.*:.*:.*$" key) ;; ;; something:something:something reserved for triggers in runconfigs
+							)) 
+                                          (realval (if envar
+                                                       (eval-string-in-environment val)
+                                                       val)))
+                                     (debug:print-info 6 *default-log-port* "read-config env setting, envar: " envar " realval: " realval " val: " val " key: " key " curr-section-name: " curr-section-name)
+                                     (if envar (safe-setenv key realval))
+                                     (debug:print 10 *default-log-port* "   setting: [" curr-section-name "] " key " = " val)
+                                     (hash-table-set! res curr-section-name 
+                                                      (assoc-safe-add alist key realval metadata: metapath))
+                                     (loop (configf:read-line inp res
+                                                              (calc-allow-system allow-system curr-section-name sections) settings)
+                                           curr-section-name key #f)))
+	       ;; if a continued line
+	       (configf:cont-ln-rx ( x whsp val     )
+                                   (let ((alist (hash-table-ref/default res curr-section-name '())))
+                                     (if var-flag             ;; if set to a string then we have a continued var
+                                         (let ((newval (conc 
+                                                        (lookup res curr-section-name var-flag) "\n"
+                                                        ;; trim lead from the incoming whsp to support some indenting.
+                                                        (if lead
+                                                            (string-substitute (regexp lead) "" whsp)
+                                                            "")
+                                                        val)))
+                                           ;; (print "val: " val "\nnewval: \"" newval "\"\nvarflag: " var-flag)
+                                           (hash-table-set! res curr-section-name 
+                                                            (assoc-safe-add alist var-flag newval metadata: metapath))
+                                           (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name var-flag (if lead lead whsp)))
+                                         (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f))))
+	       (else (debug:print-error 0 *default-log-port* "problem parsing " path ",\n   \"" inl "\"")
+		     (set! var-flag #f)
+		     (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f))))
+          ) ;; end loop
+        )))
+
+;; look at common:set-fields for an example of how to use the set-fields proc
+;; pathenvvar will set the named var to the path of the config
+;;
+(define (find-and-read-config fname #!key (environ-patt #f)(given-toppath #f)(pathenvvar #f)(set-fields #f)(keep-filenames #f))
+  (let* ((curr-dir   (current-directory))
+         (configinfo (find-config fname toppath: given-toppath))
+	 (toppath    (car configinfo))
+	 (configfile (cadr configinfo)))
+    (if toppath (change-directory toppath)) 
+    (if (and toppath pathenvvar)(set-environment-variable! pathenvvar toppath))
+    (let ((configdat  (if configfile 
+			  (read-config configfile #f #t environ-patt: environ-patt
+				       post-section-procs: (if set-fields (list (cons "^fields$" set-fields)   ) '())
+				       #f
+                                       keep-filenames: keep-filenames))))
+      (if toppath (change-directory curr-dir))
+      (list configdat toppath configfile fname))))
+
+(define (lookup cfgdat section var)
+  (if (hash-table? cfgdat)
+      (let ((sectdat (hash-table-ref/default cfgdat section '())))
+	(if (null? sectdat)
+	    #f
+	    (let ((match (assoc var sectdat)))
+	      (if match ;; (and match (list? match)(> (length match) 1))
+		  (cadr match)
+		  #f))
+	    ))
+      #f))
+
+;; use to have definitive setting:
+;;  [foo]
+;;  var yes
+;;
+;;  (var-is? cfgdat "foo" "var" "yes") => #t
+;;
+(define (var-is? cfgdat section var expected-val)
+  (equal? (lookup cfgdat section var) expected-val))
+
+;; safely look up a value that is expected to be a number, return
+;; a default (#f unless provided)
+;;
+(define (lookup-number cfgdat section varname #!key (default #f))
+  (let* ((val (lookup cfgdat section varname))
+         (res (if val
+                  (string->number (string-substitute "\\s+" "" val #t))
+                  #f)))
+    (cond
+     (res  res)
+     (val  (debug:print 0 *default-log-port* "ERROR: no number found for [" section "], " varname ", got: " val))
+     (else default))))
+
+(define (section-vars cfgdat section)
+  (let ((sectdat (hash-table-ref/default cfgdat section '())))
+    (if (null? sectdat)
+	'()
+	(map car sectdat))))
+
+(define (get-section cfgdat section)
+  (hash-table-ref/default cfgdat section '()))
+
+(define (set-section-var cfgdat section var val)
+  (let ((sectdat (get-section cfgdat section)))
+    (hash-table-set! cfgdat section
+                     (assoc-safe-add sectdat var val))))
+
+    ;;(append (filter (lambda (x)(not (assoc var sectdat))) sectdat)
+    ;;	    (list var val))))
+
+;; moved to common
+;; (define (setup)
+;;   (let* ((configf (find-config "megatest.config"))
+;; 	 (config  (if configf (read-config configf #f #t) #f)))
+;;     (if config
+;; 	(setenv "RUN_AREA_HOME" (pathname-directory configf)))
+;;     config))
+
+;;======================================================================
+;; Non destructive writing of config file
+;;======================================================================
+
+(define (compress-multi-lines fdat)
+  ;; step 1.5 - compress any continued lines
+  (if (null? fdat) fdat
+	(let loop ((hed (car fdat))
+		   (tal (cdr fdat))
+		   (cur "")
+		   (led #f)
+		   (res '()))
+	  ;; ALL WHITESPACE LEADING LINES ARE TACKED ON!!
+	  ;;  1. remove led whitespace
+	  ;;  2. tack on to hed with "\n"
+	  (let ((match (string-match configf:cont-ln-rx hed)))
+	    (if match ;; blast! have to deal with a multiline
+		(let* ((lead (cadr match))
+		       (lval (caddr match))
+		       (newl (conc cur "\n" lval)))
+		  (if (not led)(set! led lead))
+		  (if (null? tal) 
+		      (set! fdat (append fdat (list newl)))
+		      (loop (car tal)(cdr tal) newl led res))) ;; NB// not tacking newl onto res
+		(let ((newres (if led 
+				  (append res (list cur hed))
+				  (append res (list hed)))))
+		  ;; prev was a multiline
+		  (if (null? tal)
+		      newres
+		      (loop (car tal)(cdr tal) "" #f newres))))))))
+
+;; note: I'm cheating a little here. I merely replace "\n" with "\n         "
+(define (expand-multi-lines fdat)
+  ;; step 1.5 - compress any continued lines
+  (if (null? fdat) fdat
+      (let loop ((hed (car fdat))
+		 (tal (cdr fdat))
+		 (res '()))
+	(let ((newres (append res (list (string-substitute (regexp "\n") "\n         " hed #t)))))
+	  (if (null? tal)
+	      newres
+	      (loop (car tal)(cdr tal) newres))))))
+
+(define (file->list fname)
+  (if (safe-file-exists? fname)
+      (let ((inp (open-input-file fname)))
+	(let loop ((inl (read-line inp))
+		   (res '()))
+	  (if (eof-object? inl)
+	      (begin
+		(close-input-port inp)
+		(reverse res))
+	      (loop (read-line inp)(cons inl res)))))
+      '()))
+
+;; raw basic write config in ini format
+;;
+(define (write-config cfgdat fname)
+  (with-output-to-file fname
+    (lambda ()
+      (config->ini cfgdat))))
+
+;;       (for-each
+;;        (lambda (section)
+;; 	 (let ((sec-dat (hash-table-ref cfgdat section)))
+;; 	   (for-each (lambda (entry)(print (car entry) " " (cadr entry))) sec-dat)))
+;;        (sort (hash-table-keys cfgdat) (lambda (a b)(string<= a b)))))))
+
+;;======================================================================
+;; Write a config
+;;   0. Given a refererence data structure "indat"
+;;   1. Open the output file and read it into a list
+;;   2. Flatten any multiline entries
+;;   3. Modify values per contents of "indat" and remove absent values
+;;   4. Append new values to the section (immediately after last legit entry)
+;;   5. Write out the new list 
+;;======================================================================
+
+(define (write-merge-config indat fname #!key (required-sections '()))
+  (let* (;; step 1: Open the output file and read it into a list
+	 (fdat    (file->list fname))
+	 (refdat  (make-hash-table))
+	 (sechash (make-hash-table)) ;; current section hash, init with hash for "default" section
+	 (new     #f) ;; put the line to be used in new, if it is to be deleted the set new to #f
+	 (secname #f))
+
+    ;; step 2: Flatten multiline entries
+    (if (not (null? fdat))(set! fdat (compress-multi-lines fdat)))
+
+    ;; step 3: Modify values per contents of "indat" and remove absent values
+    (if (not (null? fdat))
+	(let loop ((hed  (car fdat))
+		   (tal  (cadr fdat))
+		   (res  '())
+		   (lnum 0))
+	  (regex-case 
+	   hed
+	   (configf:comment-rx _                  (set! res (append res (list hed)))) ;; (loop (read-line inp) curr-section-name #f #f))
+	   (configf:blank-l-rx _                  (set! res (append res (list hed)))) ;; (loop (read-line inp) curr-section-name #f #f))
+	   (configf:section-rx ( x section-name ) (let ((section-hash (hash-table-ref/default refdat section-name #f)))
+						    (if (not section-hash)
+							(let ((newhash (make-hash-table)))
+							  (hash-table-set! refdat section-name newhash)
+							  (set! sechash newhash))
+							(set! sechash section-hash))
+						    (set! new hed) ;; will append this at the bottom of the loop
+						    (set! secname section-name)
+						    ))
+	   ;; No need to process key cmd, let it fall though to key val
+	   (configf:key-val-pr ( x key val      )
+		       (let ((newval (lookup indat secname key))) ;; secname was sec. I think that was a bug
+			 ;; can handle newval == #f here => that means key is removed
+			 (cond 
+			  ((equal? newval val)
+			   (set! res (append res (list hed))))
+			  ((not newval) ;; key has been removed
+			   (set! new #f))
+			  ((not (equal? newval val))
+			     (hash-table-set! sechash key newval)
+			     (set! new (conc key " " newval)))
+			  (else
+			   (debug:print-error 0 *default-log-port* "problem parsing line number " lnum "\"" hed "\"")))))
+	   (else
+	    (debug:print-error 0 *default-log-port* "Problem parsing line num " lnum " :\n   " hed )))
+	  (if (not (null? tal)) 
+	      (loop (car tal)(cdr tal)(if new (append res (list new)) res)(+ lnum 1)))
+	  ;; drop to here when done processing, res contains modified list of lines
+	  (set! fdat res)))
+
+    ;; step 4: Append new values to the section
+    (for-each 
+     (lambda (section)
+       (let ((sdat   '()) ;; append needed bits here
+	     (svars  (section-vars indat section)))
+	 (for-each 
+	  (lambda (var)
+	    (let ((val (lookup refdat section var)))
+	      (if (not val) ;; this one is new
+		  (begin
+		    (if (null? sdat)(set! sdat (list (conc "[" section "]"))))
+		    (set! sdat (append sdat (list (conc var " " val))))))))
+	  svars)
+	 (set! fdat (append fdat sdat))))
+     (delete-duplicates (append required-sections (hash-table-keys indat))))
+
+    ;; step 5: Write out new file
+    (with-output-to-file fname 
+      (lambda ()
+	(for-each 
+	 (lambda (line)
+	   (print line))
+	 (expand-multi-lines fdat))))))
+
+;;======================================================================
+;; refdb
+;;======================================================================
+
+;; reads a refdb into an assoc array of assoc arrays
+;;   returns (list dat msg)
+(define (read-refdb refdb-path)
+  (let ((sheets-file  (conc refdb-path "/sheet-names.cfg")))
+    (if (not (safe-file-exists? sheets-file))
+	(list #f (conc "ERROR: no refdb found at " refdb-path))
+	(if (not (file-readable? sheets-file))
+	    (list #f (conc "ERROR: refdb file not readable at " refdb-path))
+	    (let* ((sheets (with-input-from-file sheets-file
+			     (lambda ()
+			       (let loop ((inl (read-line))
+					  (res '()))
+				 (if (eof-object? inl)
+				     (reverse res)
+				     (loop (read-line)(cons inl res)))))))
+		   (data   '()))
+	      (for-each 
+	       (lambda (sheet-name)
+		 (let* ((dat-path  (conc refdb-path "/" sheet-name ".dat"))
+			(ref-dat   (read-config dat-path #f #t))
+			(ref-assoc (map (lambda (key)
+					  (list key (hash-table-ref ref-dat key)))
+					(hash-table-keys ref-dat))))
+				   ;; (hash-table->alist ref-dat)))
+		   ;; (set! data (append data (list (list sheet-name ref-assoc))))))
+		   (set! data (cons (list sheet-name ref-assoc) data))))
+	       sheets)
+	      (list data "NO ERRORS"))))))
+
+;; map over all pairs in a three level hierarchial alist and apply a function to the keys/val
+;;
+(define (map-all-hier-alist data proc #!key (initproc1 #f)(initproc2 #f)(initproc3 #f))
+  (for-each 
+   (lambda (sheetname)
+     (let* ((sheettmp  (assoc sheetname data))
+	    (sheetdat  (if sheettmp (cadr sheettmp) '())))
+       (if initproc1 (initproc1 sheetname))
+       (for-each 
+	(lambda (sectionname)
+	  (let* ((sectiontmp  (assoc sectionname sheetdat))
+		 (sectiondat  (if sectiontmp (cadr sectiontmp) '())))
+	    (if initproc2 (initproc2 sheetname sectionname))
+	    (for-each
+	     (lambda (varname)
+	       (let* ((valtmp (assoc varname sectiondat))
+		      (val    (if valtmp (cadr valtmp) "")))
+		 (proc sheetname sectionname varname val)))
+	     (map car sectiondat))))
+	(map car sheetdat))))
+   (map car data))
+  data)
+
+;;======================================================================
+;;  C O N F I G   T O / F R O M   A L I S T
+;;======================================================================
+
+(define (config->alist cfgdat)
+  (hash-table->alist cfgdat))
+
+(define (alist->config adat)
+  (let ((ht (make-hash-table)))
+    (for-each
+     (lambda (section)
+       (hash-table-set! ht (car section)(cdr section)))
+     adat)
+    ht))
+
+;; if 
+(define (read-alist fname)
+  (handle-exceptions
+      exn
+      #f
+    (alist->config
+     (with-input-from-file fname read))))
+
+(define (write-alist cdat fname #!key (locker #f)(unlocker #f))
+  (if (and locker (not (locker fname)))
+      (debug:print 0 *default-log-port* "INFO: Could not get lock on " fname))
+  (let* ((dat  (config->alist cdat))
+         (res
+          (begin
+            (with-output-to-file fname ;; first write out the file
+              (lambda ()
+                (pp dat)))
+            
+            (if (file-exists? fname)   ;; now verify it is readable
+                (if (read-alist fname)
+                    #t ;; data is good.
+                    (begin
+                      (handle-exceptions
+                       exn
+                       #f
+                       (debug:print 0 *default-log-port* "WARNING: content " dat " for cache " fname " is not readable. Deleting generated file.")
+                       (delete-file fname))
+                      #f))
+                #f))))
+    (if unlocker (unlocker fname))
+    res))
+  
+;; convert config hash-table/list data to ini format
+;;
+(define (config->ini data)
+  (map 
+   (lambda (section)
+     (let ((section-name (car section))
+	   (section-dat  (cdr section)))
+       (print "\n[" section-name "]")
+       (map (lambda (dat-pair)
+	      (let* ((var (car dat-pair))
+		     (val (cadr dat-pair))
+		     (fname (if (> (length dat-pair) 2)(caddr dat-pair) #f)))
+		(if fname (print "# " var "=>" fname))
+		(print var " " val)))
+	    section-dat))) ;;       (print "section-dat: " section-dat))
+   (hash-table->alist data)))
+
+;(use trace)
+;(trace-call-sites #t)
+;(trace read-config)
+
+)

ADDED   mtconfigf/mtconfigf.setup
Index: mtconfigf/mtconfigf.setup
==================================================================
--- /dev/null
+++ mtconfigf/mtconfigf.setup
@@ -0,0 +1,16 @@
+;; Copyright 2007-2010, Matthew Welland.
+;;
+;;  This program is made available under the GNU GPL version 2.0 or
+;;  greater. See the accompanying file COPYING for details.
+;;
+;;  This program is distributed WITHOUT ANY WARRANTY; without even the
+;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+;;  PURPOSE.
+
+;;;; mtconfig.setup
+
+;; compile the code into dynamically loadable shared objects
+;; and install as modules
+
+(compile -s mtconfigf.scm)
+(standard-extension 'mtconfigf "mtconfigf.so")

ADDED   mtconfigf/tests/run.scm
Index: mtconfigf/tests/run.scm
==================================================================
--- /dev/null
+++ mtconfigf/tests/run.scm
@@ -0,0 +1,48 @@
+(load "../mtdebug/mtdebug.scm")
+(import mtdebug)
+(load "mtconfigf.scm")
+(import (prefix mtconfigf config:))
+
+(use mtdebug)
+;; configure mtconfigf
+(let* ((normal-fn debug:print)
+       (info-fn   debug:print-info)
+       (error-fn  debug:print-error)
+       (default-port (current-output-port)))
+  (config:set-debug-printers normal-fn info-fn error-fn default-port))
+
+
+(use test)
+
+(let* ((cfgdat
+        (config:read-config "tests/test.config" #f #f)))
+
+  
+  (test #f "value" (config:lookup cfgdat "basic" "key"))
+  (test #f 2 (config:lookup-number cfgdat "basic" "two"))
+  
+  )
+
+(config:add-eval-string "(define (customfunc) \"hello\")")
+(let* ((cfgdat
+        (config:read-config "tests/test2.config" #f #f)))
+  (test #f "bar" (config:lookup cfgdat "schemy" "rgetreftarget"))
+  (test #f "baz" (config:lookup cfgdat "schemy" "rgetrefdefault"))
+  (test #f "2" (config:lookup cfgdat "schemy" "addup"))
+  (test #f 2 (config:lookup-number cfgdat "schemy" "addup"))
+  (test #f "hello" (config:lookup cfgdat "schemy" "custom"))
+  )
+
+(test #f
+      (conc "hello " (get-environment-variable "USER"))
+      (config:eval-string-in-environment "hello $USER"))
+
+(let* ((cfgdat
+        (config:read-config "tests/test3.config" #f #t)))
+  (test #f "hello" (config:lookup cfgdat "systemic" "hello"))
+  (test #f
+        (conc "hello " (get-environment-variable "USER"))
+        (config:lookup cfgdat "systemic" "hellouser"))
+
+  )
+

ADDED   mtconfigf/tests/test.config
Index: mtconfigf/tests/test.config
==================================================================
--- /dev/null
+++ mtconfigf/tests/test.config
@@ -0,0 +1,3 @@
+[basic]
+key value
+two 2

ADDED   mtconfigf/tests/test2.config
Index: mtconfigf/tests/test2.config
==================================================================
--- /dev/null
+++ mtconfigf/tests/test2.config
@@ -0,0 +1,15 @@
+[default]
+deffoo baz
+
+[a-target]
+foo bar
+
+[.dvars]
+target a-target
+
+
+[schemy]
+addup #{scheme (+ 1 1)}
+custom #{scheme (customfunc)}
+rgetreftarget #{rget foo}
+rgetrefdefault #{rget deffoo}

ADDED   mtconfigf/tests/test3.config
Index: mtconfigf/tests/test3.config
==================================================================
--- /dev/null
+++ mtconfigf/tests/test3.config
@@ -0,0 +1,3 @@
+[systemic]
+hello [system echo hello]
+hellouser [system echo hello $USER]

Index: mtut.scm
==================================================================
--- mtut.scm
+++ mtut.scm
@@ -30,10 +30,13 @@
 
 (declare (uses common))
 (declare (uses margs))
 (declare (uses configf))
 ;; (declare (uses rmt))
+
+(declare (uses commonmod))
+(import commonmod)
 
 (use ducttape-lib)
 
 (include "megatest-fossil-hash.scm")
 

Index: newdashboard.scm
==================================================================
--- newdashboard.scm
+++ newdashboard.scm
@@ -29,10 +29,13 @@
      (prefix dbi dbi:))
 
 (declare (uses common))
 (declare (uses megatest-version))
 (declare (uses margs))
+
+(declare (uses commonmod))
+(import commonmod)
 
 ;; (declare (uses launch))
 ;; (declare (uses gutils))
 ;; (declare (uses db))
 ;; (declare (uses server))

Index: ods.scm
==================================================================
--- ods.scm
+++ ods.scm
@@ -17,10 +17,12 @@
 ;;
 
 (use csv-xml regex)
 (declare (unit ods))
 (declare (uses common))
+(declare (uses commonmod))
+(import commonmod)
 
 (define ods:dirs
   '("Configurations2"
     "Configurations2/toolpanel"
     "Configurations2/menubar"

Index: portlogger.scm
==================================================================
--- portlogger.scm
+++ portlogger.scm
@@ -22,10 +22,13 @@
 (use sqlite3 srfi-1 posix srfi-69 hostinfo dot-locking z3)
 (import (prefix sqlite3 sqlite3:))
 
 (declare (unit portlogger))
 (declare (uses db))
+
+(declare (uses commonmod))
+(import commonmod)
 
 ;; lsof -i
 
 (define (portlogger:open-db fname)
   (let* ((avail    (tasks:wait-on-journal fname 5 remove: #t)) ;; wait up to about 10 seconds for the journal to go away

Index: process.scm
==================================================================
--- process.scm
+++ process.scm
@@ -22,10 +22,13 @@
 ;; Process convience utils
 ;;======================================================================
 
 (use regex directory-utils)
 (declare (unit process))
+
+(declare (uses commonmod))
+(import commonmod)
 
 (define (process:conservative-read port)
   (let loop ((res ""))
     (if (not (eof-object? (peek-char port)))
 	(loop (conc res (read-char port)))

Index: rmt.scm
==================================================================
--- rmt.scm
+++ rmt.scm
@@ -21,10 +21,13 @@
 (use format typed-records) ;; RADT => purpose of json format??
 
 (declare (unit rmt))
 (declare (uses api))
 (declare (uses http-transport))
+
+(declare (uses commonmod))
+(import commonmod)
 (include "common_records.scm")
 ;; (declare (uses rmtmod))
 
 ;; (import rmtmod)
 

Index: rmtmod.scm
==================================================================
--- rmtmod.scm
+++ rmtmod.scm
@@ -20,11 +20,11 @@
 
 (declare (unit rmtmod))
 (declare (uses commonmod))
 (declare (uses apimod))
 ;; (declare (uses apimod.import))
-(declare (uses ulex))
+;; (declare (uses ulex))
 
 ;; (include "ulex/ulex.scm")
 
 (module rmtmod
 	*
@@ -31,11 +31,11 @@
 	
 (import scheme chicken data-structures extras)
 (import (prefix sqlite3 sqlite3:) posix typed-records srfi-18)
 (import (prefix commonmod cmod:))
 (import apimod)
-(import (prefix ulex ulex:))
+;; (import (prefix ulex ulex:))
 
 (defstruct alldat
   (areapath #f)
   (ulexdat  #f)
   )

Index: runconfig.scm
==================================================================
--- runconfig.scm
+++ runconfig.scm
@@ -22,10 +22,13 @@
 
 (use format directory-utils)
 
 (declare (unit runconfig))
 (declare (uses common))
+
+(declare (uses commonmod))
+(import commonmod)
 
 (include "common_records.scm")
 
 (define (runconfig:read fname target environ-patt)
   (let ((ht (make-hash-table)))

Index: runs.scm
==================================================================
--- runs.scm
+++ runs.scm
@@ -29,10 +29,13 @@
 (declare (uses tests))
 (declare (uses server))
 (declare (uses mt))
 (declare (uses archive))
 ;; (declare (uses filedb))
+
+(declare (uses commonmod))
+(import commonmod)
 
 (include "common_records.scm")
 (include "key_records.scm")
 (include "db_records.scm")
 (include "run_records.scm")

Index: server.scm
==================================================================
--- server.scm
+++ server.scm
@@ -31,10 +31,13 @@
 ;; (declare (uses synchash))
 (declare (uses http-transport))
 ;;(declare (uses rpc-transport))
 (declare (uses launch))
 ;; (declare (uses daemon))
+
+(declare (uses commonmod))
+(import commonmod)
 
 (include "common_records.scm")
 (include "db_records.scm")
 
 (define (server:make-server-url hostport)

ADDED   servermod.scm
Index: servermod.scm
==================================================================
--- /dev/null
+++ servermod.scm
@@ -0,0 +1,39 @@
+;;======================================================================
+;; Copyright 2017, Matthew Welland.
+;; 
+;; This file is part of Megatest.
+;; 
+;;     Megatest is free software: you can redistribute it and/or modify
+;;     it under the terms of the GNU General Public License as published by
+;;     the Free Software Foundation, either version 3 of the License, or
+;;     (at your option) any later version.
+;; 
+;;     Megatest is distributed in the hope that it will be useful,
+;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;     GNU General Public License for more details.
+;; 
+;;     You should have received a copy of the GNU General Public License
+;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
+
+;;======================================================================
+
+(declare (unit servermod))
+
+(module servermod
+	*
+	
+(import scheme chicken data-structures extras)
+(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18)
+
+(define (just-testing)
+  (print "JUST TESTING"))
+
+;; (define (debug:print . params) #f)
+;; (define (debug:print-info . params) #f)
+;; 
+;; (define (set-functions dbgp dbgpinfo)
+;;   (set! debug:print dbgp)
+;;   (set! debug:print-info dbgpinfo))
+
+)

Index: subrun.scm
==================================================================
--- subrun.scm
+++ subrun.scm
@@ -31,11 +31,14 @@
 ;;(declare (uses server))
 (declare (uses mt))
 ;;(declare (uses archive))
 ;; (declare (uses filedb))
 
-;(include "common_records.scm")
+(declare (uses commonmod))
+(import commonmod)
+
+;;(include "common_records.scm")
 ;;(include "key_records.scm")
 (include "db_records.scm") ;; provides db:test-get-id
 ;;(include "run_records.scm")
 ;;(include "test_records.scm")
 

Index: tasks.scm
==================================================================
--- tasks.scm
+++ tasks.scm
@@ -26,10 +26,13 @@
 (declare (uses rmt))
 (declare (uses common))
 (declare (uses pgdb))
 
 ;; (import pgdb) ;; pgdb is a module
+
+(declare (uses commonmod))
+(import commonmod)
 
 (include "task_records.scm")
 (include "db_records.scm")
 
 ;;======================================================================

Index: tcmt.scm
==================================================================
--- tcmt.scm
+++ tcmt.scm
@@ -30,10 +30,13 @@
 
 (declare (uses margs))
 (declare (uses rmt))
 (declare (uses common))
 ;; (declare (uses megatest-version))
+
+(declare (uses commonmod))
+(import commonmod)
 
 (include "megatest-version.scm")
 (include "megatest-fossil-hash.scm")
 (include "db_records.scm")
 

Index: tdb.scm
==================================================================
--- tdb.scm
+++ tdb.scm
@@ -32,10 +32,13 @@
 (declare (uses keys))
 (declare (uses ods))
 (declare (uses client))
 (declare (uses mt))
 (declare (uses db))
+
+(declare (uses commonmod))
+(import commonmod)
 
 (include "common_records.scm")
 (include "db_records.scm")
 (include "key_records.scm")
 (include "run_records.scm")

Index: tests.scm
==================================================================
--- tests.scm
+++ tests.scm
@@ -35,10 +35,13 @@
 ;;(declare (uses stml2))
 
 (use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking tcp directory-utils)
 (import (prefix sqlite3 sqlite3:))
 (require-library stml)
+
+(declare (uses commonmod))
+(import commonmod)
 
 (include "common_records.scm")
 (include "key_records.scm")
 (include "db_records.scm")
 (include "run_records.scm")

Index: tree.scm
==================================================================
--- tree.scm
+++ tree.scm
@@ -33,10 +33,14 @@
 (declare (uses gutils))
 (declare (uses db))
 (declare (uses server))
 ;; (declare (uses synchash))
 (declare (uses dcommon))
+
+(declare (uses commonmod))
+(import commonmod)
+
 
 (include "megatest-version.scm")
 (include "common_records.scm")
 (include "db_records.scm")
 (include "key_records.scm")