Index: configf.scm ================================================================== --- configf.scm +++ configf.scm @@ -54,27 +54,42 @@ (define configf:comment-rx (regexp "^\\s*#.*")) (define configf:cont-ln-rx (regexp "^(\\s+)(\\S+.*)$")) ;; read a line and process any #{ ... } constructs -(define configf:var-expand-regex (regexp "^(.*)#\\{([^\\}\\{]*)\\}(.*)")) -(define (configf:process-line l) +(define configf:var-expand-regex (regexp "^(.*)#\\{(scheme|system|shell|getenv|get|runconfigs-get)\\s+([^\\}\\{]*)\\}(.*)")) +(define (configf:process-line l ht) (let loop ((res l)) (if (string? res) (let ((matchdat (string-search configf:var-expand-regex res))) (if matchdat - (let ((prestr (cadr matchdat)) - (cmd (caddr matchdat)) - (poststr (cadddr matchdat)) - (result #f)) - (with-input-from-string (conc "(" cmd ")") + (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) + (fullcmd (case (string->symbol cmdtype) + ((scheme)(conc "(lambda (ht)" cmd ")")) + ((system)(conc "(lambda (ht)(system \"" cmd "\"))")) + ((shell) (conc "(lambda (ht)(shell \"" cmd "\"))")) + ((getenv)(conc "(lambda (ht)(get-environment-variable \"" cmd "\"))")) + ((get) + (let* ((parts (string-split cmd)) + (sect (car parts)) + (var (cadr parts))) + (conc "(lambda (ht)(config-lookup ht \"" sect "\" \"" var "\"))"))) + ((runconfigs-get) (conc "(lambda (ht)(runconfigs-get ht \"" cmd "\"))")) + (else "(lambda (ht)(print \"ERROR\") \"ERROR\")")))) + (print "fullcmd=" fullcmd) + (with-input-from-string fullcmd (lambda () - (set! result (eval (read))))) + (set! result ((eval (read)) ht)))) (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) @@ -84,12 +99,19 @@ (begin (with-output-to-port (current-error-port) (print "ERROR: " cmd " returned bad exit code " status)) "")))) -(define-inline (configf:read-line p) - (configf:process-line (read-line p))) +;; Lookup a value in runconfigs based on -reqtarg or -target +(define (runconfigs-get config var) + (let ((targ (or (args:get-arg "-reqtarg")(args:get-arg "-target")))) + (if targ + (config-lookup config targ var) + #f))) + +(define-inline (configf:read-line p ht) + (configf:process-line (read-line p) 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) @@ -100,26 +122,26 @@ (debug:print 4 "INFO: read-config " path " allow-system " allow-system " environ-patt " environ-patt) (if (not (file-exists? path)) (if (not ht)(make-hash-table) ht) (let ((inp (open-input-file path)) (res (if (not ht)(make-hash-table) ht))) - (let loop ((inl (configf:read-line inp)) ;; (read-line inp)) + (let loop ((inl (configf:read-line inp res)) ;; (read-line inp)) (curr-section-name "default") (var-flag #f);; turn on for key-var-pr and cont-ln-rx, turn off elsewhere (lead #f)) (if (eof-object? inl) (begin (close-input-port inp) res) (regex-case inl - (configf:comment-rx _ (loop (configf:read-line inp) curr-section-name #f #f)) - (configf:blank-l-rx _ (loop (configf:read-line inp) curr-section-name #f #f)) + (configf:comment-rx _ (loop (configf:read-line inp res) curr-section-name #f #f)) + (configf:blank-l-rx _ (loop (configf:read-line inp res) curr-section-name #f #f)) (configf:include-rx ( x include-file ) (begin (read-config include-file res allow-system environ-patt: environ-patt) - (loop (configf:read-line inp) curr-section-name #f #f))) - (configf:section-rx ( x section-name ) (loop (configf:read-line inp) section-name #f #f)) + (loop (configf:read-line inp res) curr-section-name #f #f))) + (configf:section-rx ( x section-name ) (loop (configf:read-line inp res) section-name #f #f)) (configf:key-sys-pr ( x key cmd ) (if allow-system (let ((alist (hash-table-ref/default res curr-section-name '())) (val-proc (lambda () (let* ((cmdres (cmd-run->list cmd)) (status (cadr cmdres)) @@ -136,12 +158,12 @@ key (case allow-system ((return-procs) val-proc) ((return-string) cmd) (else (val-proc))))) - (loop (configf:read-line inp) curr-section-name #f #f)) - (loop (configf:read-line inp) curr-section-name #f #f))) + (loop (configf:read-line inp res) curr-section-name #f #f)) + (loop (configf:read-line inp res) curr-section-name #f #f))) (configf:key-val-pr ( x key val ) (let* ((alist (hash-table-ref/default res curr-section-name '())) (envar (and environ-patt (string-match (regexp environ-patt) curr-section-name))) (realval (if envar (config:eval-string-in-environment val) val))) @@ -149,11 +171,11 @@ (begin (debug:print 4 "INFO: read-config key=" key ", val=" val ", realval=" realval) (setenv key realval))) (hash-table-set! res curr-section-name (config:assoc-safe-add alist key realval)) - (loop (configf:read-line inp) curr-section-name key #f))) + (loop (configf:read-line inp res) 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 (config-lookup res curr-section-name var-flag) "\n" @@ -163,15 +185,15 @@ "") val))) ;; (print "val: " val "\nnewval: \"" newval "\"\nvarflag: " var-flag) (hash-table-set! res curr-section-name (config:assoc-safe-add alist var-flag newval)) - (loop (configf:read-line inp) curr-section-name var-flag (if lead lead whsp))) - (loop (configf:read-line inp) curr-section-name #f #f)))) + (loop (configf:read-line inp res) curr-section-name var-flag (if lead lead whsp))) + (loop (configf:read-line inp res) curr-section-name #f #f)))) (else (debug:print 0 "ERROR: problem parsing " path ",\n \"" inl "\"") (set! var-flag #f) - (loop (configf:read-line inp) curr-section-name #f #f)))))))) + (loop (configf:read-line inp res) curr-section-name #f #f)))))))) (define (find-and-read-config fname #!key (environ-patt #f)) (let* ((curr-dir (current-directory)) (configinfo (find-config fname)) (toppath (car configinfo)) Index: tests/megatest.config ================================================================== --- tests/megatest.config +++ tests/megatest.config @@ -30,11 +30,16 @@ [env-override] SPECIAL_ENV_VARS overide them here - should be seen at launch and in the runs TESTVAR [system realpath .] DEADVAR [system ls] VARWITHDOLLAR $HOME/.zshrc -WACKYVAR #{system "ls"} +WACKYVAR #{system ls} +WACKYVAR2 #{get validvalues state} +WACKYVAR3 #{getenv USER} +WACKYVAR4 #{scheme (+ 5 6 7)} +WACKYVAR5 #{getenv sysname}/#{getenv fsname}/#{getenv datapath} +WACKYVAR6 #{scheme (args:get-arg "-target")} # XTERM [system xterm] # RUNDEAD [system exit 56] ## disks are: @@ -41,5 +46,7 @@ ## name host:/path/to/area ## -or- ## name /path/to/area [disks] 1 /tmp/mt_runs + +[include #{getenv USER}_testing.config] Index: tests/runconfigs.config ================================================================== --- tests/runconfigs.config +++ tests/runconfigs.config @@ -1,1 +1,6 @@ [include common_runconfigs.config] + +WACKYVAR0 #{get ubuntu/nfs/none CURRENT} +WACKYVAR1 #{scheme (args:get-arg "-target")} +WACKYVAR2 #{runconfigs-get CURRENT} +