Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -3218,11 +3218,11 @@ ;; ;; (define (db:get-running-stats dbstruct run-id) (define (db:get-count-tests-running-for-run-id dbstruct run-id fastmode) (let* ((qry (if fastmode "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND run_id=? LIMIT 1;" - "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND run_id=?;"))) + "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND run_id=?;"))) (db:with-db dbstruct run-id #f (lambda (db) @@ -3236,14 +3236,14 @@ (db:with-db dbstruct run-id #f (lambda (db) - (sqlite3:first-result - db - "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND run_id=? AND NOT (uname = 'n/a' AND item_path = '') AND testname=?;" run-id testname)))) - + (let* ((stmt "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND run_id=? AND NOT (uname = 'n/a' AND item_path = '') AND testname=?;") + (stmth (db:get-cache-stmth dbstruct db stmt))) + (sqlite3:first-result + stmth run-id testname))))) (define (db:get-not-completed-cnt dbstruct run-id) (db:with-db dbstruct run-id @@ -4080,10 +4080,13 @@ run-id ))))) test-count-recs)) ;; BBnote: db:get-all-state-status-counts-for-test returns dbr:counts object aggregating state and status of items of a given test, *not including rollup state/status* +;; +;; NOTE: This is called within a transaction +;; (define (db:get-all-state-status-counts-for-test dbstruct run-id test-name item-path item-state-in item-status-in) (let* ((test-info (db:get-test-info dbstruct run-id test-name item-path)) (item-state (or item-state-in (db:test-get-state test-info))) (item-status (or item-status-in (db:test-get-status test-info))) (other-items-count-recs (db:with-db Index: genexample.scm ================================================================== --- genexample.scm +++ genexample.scm @@ -364,12 +364,31 @@ ;; generate a skeleton Megatest area from a current area with runs ;; ;; specify target, runname etc to use specific runs for the template ;; (define (genexample:extract-skeleton-area dest-path) - (let* ((target (args:get-arg "-target")) - (runname (args:get-arg "-runname"))) + (let* ((target (args:get-arg "-target")) + (runname (args:get-arg "-runname")) + (obtuse (make-hash-table)) + (obtusef (args:get-arg "-obfuscate")) + (letters (string-split-fields "\\S" "abcdefghijklmnopqrstuvwxyz")) + (maxletter (- (length letters) 1)) + (lastlet 0) + (lastnum 1) + (obfuscate (lambda (instr) + (or (hash-table-ref/default obtuse instr #f) + (if obtusef + (let* ((letter (list-ref letters lastlet)) + (val (conc letter lastnum))) + (if (>= lastlet maxletter) + (begin + (set! lastlet 0) + (set! lastnum (+ lastnum 1))) + (set! lastlet (+ lastlet 1))) + (hash-table-set! obtuse instr val) + val) + instr))))) (if (not (and target runname)) (debug:print 0 *default-log-port* "WARNING: For best results please specifiy -target and -runname for a good run to use as a template.")) (if (not (and (file-exists? "megatest.config") (file-exists? "megatest.db"))) (begin @@ -385,10 +404,12 @@ (begin (debug:print 0 *default-log-port* "ERROR: destination path already has megatest.config, stopping now.") (exit)))) ;; dump the config files from this area to the dest area + (if (args:get-arg "-obfuscate") + (debug:print 0 *default-log-port* "WARNING: obfuscation is NOT done on megatest.config and runconfigs.config. Please edit those files to remove any sensitive information!")) (system (conc "megatest -show-config > " dest-path "/megatest.config")) (system (conc "megatest -show-runconfig > " dest-path "/runconfigs.config")) ;; create stepsinfo and items refdbs, some stuff has to be done due to refdb not initing area ;; @@ -429,13 +450,13 @@ (testconfig (tests:get-testconfig testname item-path testreg #f))) (if (not (hash-table-exists? fullt tfullname)) ;; do the work for this test if not previously done - (let* ((new-test-dir (conc dest-path "/tests/" testname)) + (let* ((new-test-dir (conc dest-path "/tests/" (obfuscate testname))) (tconfigf (conc new-test-dir "/testconfig"))) - (print "Analyzing and extracting info for " tfullname) + (print "Analyzing and extracting info for " tfullname " as " (obfuscate testname)) (print " toplevel: " (if tlevel "yes" "no")) (hash-table-set! fullt tfullname #t) ;; track that this one has been seen (if (not (directory-exists? new-test-dir)) (create-directory new-test-dir #t)) @@ -448,42 +469,50 @@ ;; first the ezsteps (print "[ezsteps]") (for-each (lambda (teststep) (let* ((step-name (vector-ref teststep 0))) - (print step-name " sleep [refdb lookup #{getenv MT_RUN_AREA_HOME}/" stepsrdb " " testname " $MT_ITEM_PATH " step-name "]"))) + (print (obfuscate step-name) + " sleep [refdb lookup #{getenv MT_RUN_AREA_HOME}/stepsinfo " + (obfuscate testname) " $MT_ITEMPATH " + (obfuscate step-name) "]"))) test-steps) ;; now the requirements section (if testconfig (begin (print "\n[requirements]") (for-each (lambda (entry) - (print (car entry) " " (cadr entry))) ;; it is not an alist + (let* ((key (car entry)) + (val (cadr entry))) + (case (string->symbol key) + ((waiton) (print "waiton " (obfuscate val))) + (else (print key " " val))))) (configf:get-section testconfig "requirements"))) (print "WARNING: No testconfig data for " testname ", " item-path)) - (print "[items]") - (print "THE_ITEM [refdb getrow #{getenv MT_RUN_AREA_HOME}/miscinfo itemsinfo #{getenv MT_TESTNAME}| awk '{print $1}'") + (print "\n[items]") + (print "THE_ITEM [refdb getrow #{getenv MT_RUN_AREA_HOME}/miscinfo itemsinfo " (obfuscate testname)" | awk '{print $1}']") ))) ;; fill the stepsrdb (for-each (lambda (teststep) (let* ((step-name (vector-ref teststep 0)) (step-duration (hrs-min-sec->seconds (vector-ref teststep 4)))) - (system (conc "refdb set " stepsrdb " " testname " '" (if (equal? item-path "") - "no-item-path" - item-path) - "' " step-name " " step-duration)))) + (system (conc "refdb set " stepsrdb " " (obfuscate testname) + " '" (if (equal? item-path "") + "no-item-path" + (obfuscate item-path)) + "' " (obfuscate step-name) " " step-duration)))) test-steps) ;; miscinfo "itemsinfo" testname itempath "x" (if (not (equal? item-path "")) - (system (conc "refdb set " miscrdb " itemsinfo " testname " " item-path " x"))) + (system (conc "refdb set " miscrdb " itemsinfo " (obfuscate testname) " " (obfuscate item-path) " x"))) )))) tests-data))) (map (lambda (runrec)(simple-run-id runrec)) runs))) )) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -447,10 +447,11 @@ "-v" ;; verbose 2, more than normal (normal is 1) "-q" ;; quiet 0, errors/warnings only "-diff-rep" + "-obfuscate" ;; junk placeholder ;; "-:p" ) args:arg-hash