Megatest

;; ;;======================================================================
;; ;; 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/>.
;; 
;; ;;======================================================================
;; 
;; (define *eval-string* "")
;; (define (add-eval-string str)
;;   (if (not (string-contains *eval-string* str))
;;       (set! *eval-string* (conc *eval-string* " " str))))
;; 
;; ;;======================================================================
;; ;; Config file handling
;; ;;======================================================================
;; 
;; ;; return list (path fullpath configname)
;; (define (find-config configname #!key (toppath #f))
;;   (if toppath
;;       (let ((cfname (conc toppath "/" configname)))
;; 	(if (common: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 (common: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 (config: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 (configf:section-var-set! cfgdat section-name var value #!key (metadata #f))
;;   (hash-table-set! cfgdat section-name
;; 		   (config:assoc-safe-add
;; 		    (hash-table-ref/default cfgdat section-name '())
;; 		    var value metadata: metadata)))
;; 
;; (define (config:eval-string-in-environment str)
;;   ;; (if (or (string-null? str)
;;   ;;	  (equal? "!" (substring str 0 1))) ;; null string or starts with ! are preserved but NOT set in the environment
;;       str
;;       (handle-exceptions
;;        exn
;;        (begin
;; 	 (debug:print-error 0 *default-log-port* "problem evaluating \"" str "\" in the shell environment")
;; 	 #f)
;;        (let ((cmdres (process:cmd-run->list (conc "echo " str))))
;; 	 (if (null? cmdres) ""
;; 	     (caar cmdres))))) ;; )
;; 
;; ;;======================================================================
;; ;; 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*$"))
;; 
;; ;; 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)

;;   )
;; 
;; (define (configf:process-line l ht allow-system #!key (linenum #f))
;;   (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-seconds))
;; 		     (cmdsym  (string->symbol cmdtype))
;; 		     (fullcmd (case cmdsym
;; 				((scheme scm) (conc "(lambda (ht)" cmd ")"))
;; 				((system)     (conc "(lambda (ht)(configf:system ht \"" cmd "\"))"))
;; 				((shell sh)   (conc "(lambda (ht)(string-translate (shell \""  cmd "\") \"\n\" \" \"))"))
;; 				((realpath rp)(conc "(lambda (ht)(common:nice-path \"" cmd "\"))"))
;; 				((getenv gv)  (conc "(lambda (ht)(get-environment-variable \"" cmd "\"))"))
;; 				((mtrah)      (conc "(lambda (ht)"
;;                                                     "    (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)(runconfigs-get ht \"" cmd "\"))"))
;; 				;; ((rget)           (conc "(lambda (ht)(runconfigs-get ht \"" cmd "\"))"))
;; 				(else "(lambda (ht)(print \"ERROR\") \"ERROR\")"))))
;; 		;; (print "fullcmd=" fullcmd)
;; 		(handle-exceptions
;; 		 exn
;; 		 (begin
;; 		   (debug:print 0 *default-log-port* "WARNING: failed to process config input \"" l "\"")
;; 		   (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
;; 		   ;; (print "exn=" (condition->list exn))
;; 		   (set! result (conc "#{( " cmdtype ") " cmd "}, full expansion: " fullcmd)))
;; 		 (if (or allow-system
;; 			 (not (member cmdtype '("system" "shell" "sh"))))
;; 		     (with-input-from-string fullcmd
;; 		       (lambda ()
;; 			 (set! result ((eval (read)) ht))))
;; 		     (set! result (conc "#{(" cmdtype ") "  cmd "}"))))
;; 		(case cmdsym
;; 		  ((system shell scheme)
;; 		   (let ((delta (- (current-seconds) start-time)))
;; 		     (if (> delta 2)
;; 			 (debug:print-info 0 *default-log-port* "for line \"" l "\"\n command:  " cmd " took " delta " seconds to run with output:\n   " result)
;; 			 (debug:print-info 9 *default-log-port* "for line \"" l "\"\n command:  " cmd " took " delta " 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 (process: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)
;;   (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)
;; 			(configf:process-line inl ht allow-processing))
;; 		       ((return-string)
;; 			inl)
;; 		       (else
;; 			(configf:process-line inl ht allow-processing)))))
;; 	    (if (and (string? res)
;; 		     (not (equal? (hash-table-ref/default settings "trim-trailing-spaces" "no") "no")))
;; 		(string-substitute "\\s+$" "" res)
;; 		res))))))
;; 
;; (define (configf: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 (configf: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 (config:assoc-safe-add (hash-table-ref ht section) key val metadata: meta))))
;; 		      vars)))))
;;          (hash-table-keys ht))))
;;   ht)
;; 
;; ;; 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
;; ;;
;; (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-wildcards #t) )
;;   (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 (common: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 ((inp        (if (string? path)
;; 			    (open-input-file path)
;; 			      path)) ;; we can be handed a port
;; 	    (res        (if (not ht)(make-hash-table) ht))
;; 	    (metapath   (if (or (debug:debug-mode 9)
;; 				keep-filenames)
;; 			    path #f))
;;             (process-wildcards  (lambda (res curr-section-name)
;;                                   (if (and apply-wildcards
;;                                            (or (string-contains curr-section-name "%")   ;; wildcard
;;                                                (string-match "/.*/" curr-section-name))) ;; regex
;;                                       (begin
;;                                         (configf: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 (string? path) ;; 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: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
;;                                                              (common:nice-path 
;;                                                               (conc (if curr-conf-dir
;;                                                                         curr-conf-dir
;;                                                                         ".")








;;                                                                     "/" include-file)))))
;; 				     (let ((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 (common:file-exists? include-script)(file-execute-access? include-script))
;;                                       (let* ((local-allow-system  (calc-allow-system allow-system curr-section-name sections))
;;                                              (env-delta  (configf:cfgdat->env-alist curr-section-name res local-allow-system))
;;                                              (new-inp-port
;;                                               (common: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  (configf:cfgdat->env-alist curr-section-name res local-allow-system))
;;                                                                 (cmdres     (process: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 
;;                                                           (config: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 
;;                                                       (config: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) ;; does the section match the envionpatt?
;; 							(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
;;                                                        (config: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 
;;                                                       (config: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 
;;                                                         (configf: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 
;;                                                             (config: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
;;         )))
;;   
;; ;; 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))
;;   (let* ((curr-dir   (current-directory))
;;          (configinfo (find-config fname toppath: given-toppath))
;; 	 (toppath    (car configinfo))
;; 	 (configfile (cadr configinfo))
;; 	 (set-fields (lambda (curr-section next-section ht path)
;; 		       (let ((field-names (if ht (common:get-fields ht) '()))
;; 			     (target      (or (getenv "MT_TARGET")(args:get-arg "-reqtarg")(args:get-arg "-target"))))
;; 			 (debug:print-info 9 *default-log-port* "set-fields with field-names=" field-names " target=" target " curr-section=" curr-section " next-section=" next-section " path=" path " ht=" ht)
;; 			 (if (not (null? field-names))(keys:target-set-args field-names target #f))))))
;;     (if toppath (change-directory toppath)) 
;;     (if (and toppath pathenvvar)(setenv pathenvvar toppath))
;;     (let ((configdat  (if configfile 
;; 			  (read-config configfile #f #t environ-patt: environ-patt post-section-procs: (list (cons "^fields$" set-fields)) #f))))
;;       (if toppath (change-directory curr-dir))
;;       (list configdat toppath configfile fname))))
;; 
;; #;(define (configf: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
;; ;;
;; ;;  (configf:var-is? cfgdat "foo" "var" "yes") => #t
;; ;;
;; (define (configf:var-is? cfgdat section var expected-val)
;;   (equal? (configf:lookup cfgdat section var) expected-val))
;; 
;; (define configf:read-file read-config)
;; 
;; ;; safely look up a value that is expected to be a number, return
;; ;; a default (#f unless provided)
;; ;;
;; #;(define (configf:lookup-number cfdat section varname #!key (default #f))
;;   (let* ((val (configf:lookup *configdat* 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 (configf:section-vars cfgdat section)
;;   (let ((sectdat (hash-table-ref/default cfgdat section '())))
;;     (if (null? sectdat)
;; 	'()
;; 	(map car sectdat))))
;; 
;; #;(define (configf:get-section cfgdat section)
;;   (hash-table-ref/default cfgdat section '()))
;; 
;; (define (configf:set-section-var cfgdat section var val)
;;   (let ((sectdat (configf:get-section cfgdat section)))
;;     (hash-table-set! cfgdat section
;;                      (config:assoc-safe-add sectdat var val))))
;; 
;;     ;;(append (filter (lambda (x)(not (assoc var sectdat))) sectdat)
;;     ;;	    (list var val))))
;; 
;; (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 (configf: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 (configf: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 (configf:file->list fname)
;;   (if (common: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)))))
;;       '()))
;; 
;; ;;======================================================================
;; ;; 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 (configf:write-config indat fname #!key (required-sections '()))
;;   (let* (;; step 1: Open the output file and read it into a list
;; 	 (fdat       (configf: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 (configf: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) ;; was refhash - not sure that refdat is correct here
;; 						  (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 (configf:lookup indat secname key))) ;; was sec, bug or correct?
;; 			 ;; 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  (configf:section-vars indat section)))
;; 	 (for-each 
;; 	  (lambda (var)
;; 	    (let ((val (configf: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))
;; 	 (configf:expand-multi-lines fdat))))))
;; 
;; ;;======================================================================
;; ;; refdb
;; ;;======================================================================
;; 
;; ;; reads a refdb into an assoc array of assoc arrays
;; ;;   returns (list dat msg)
;; (define (configf:read-refdb refdb-path)
;;   (let ((sheets-file  (conc refdb-path "/sheet-names.cfg")))
;;     (if (not (common:file-exists? sheets-file))
;; 	(list #f (conc "ERROR: no refdb found at " refdb-path))
;; 	(if (not (file-read-access? 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   (configf:read-file 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 (configf: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 (configf:config->alist cfgdat)
;;   (hash-table->alist cfgdat))
;; 
;; (define (configf:alist->config adat)
;;   (let ((ht (make-hash-table)))
;;     (for-each
;;      (lambda (section)
;;        (hash-table-set! ht (car section)(cdr section)))
;;      adat)
;;     ht))
;; 
;; ;; if 
;; (define (configf:read-alist fname)
;;   (handle-exceptions
;;    exn
;;    #f
;;    (configf:alist->config
;;     (with-input-from-file fname read))))
;; 
;; (define (configf:write-alist cdat fname)
;;   (if (not (common:faux-lock fname))
;;       (debug:print 0 *default-log-port* "INFO: Could not get lock on " fname))
;;   (let* ((dat  (configf:config->alist cdat))
;;          (res
;;           (begin
;;             (with-output-to-file fname ;; first write out the file
;;               (lambda ()
;;                 (pp dat)))
;;             
;;             (if (common:file-exists? fname)   ;; now verify it is readable
;;                 (if (configf: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))))
;;     (common:faux-unlock fname)
;;     res))
;;   
;; ;; convert hierarchial list to ini format
;; ;;
;; (define (configf: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)))
;; 

(require-library iup)
(import (prefix iup iup:))

(use canvas-draw)
(import canvas-draw-iup)
(use ducttape-lib)
(use sqlite3 srfi-1 posix regex regex-case srfi-69 typed-records
     sparse-vectors
     (prefix mtconfigf configf:)) 
(import (prefix sqlite3 sqlite3:))

;; (declare (uses common))
;; (declare (uses margs))
;; (declare (uses keys))
;; (declare (uses items))
;; (declare (uses db))

 typed-records
 udp
 uri-common
 z3
 )

(use (prefix mtconfigf configf:))
(define read-config configf:read-config)
(define find-and-read-config configf:find-and-read-config)
(define config:eval-string-in-environment configf:eval-string-in-environment)

(import canvas-draw-iup spiffy)


;; (import apimod)
;; (import archivemod)
;; (import clientmod)

			(common:watchdog)))
		    "Watchdog thread"))

(include "api-inc.scm")
(include "archive-inc.scm")
(include "client-inc.scm")
(include "common-inc.scm")
;; (include "configf-inc.scm")
(include "db-inc.scm")
(include "dcommon-inc.scm")
(include "dashboard-tests-inc.scm")
(include "env-inc.scm")
(include "ezsteps-inc.scm")
(include "gutils-inc.scm")
(include "http-transport-inc.scm")