@@ -19,11 +19,11 @@
 (use sqlite3 srfi-1 posix regex regex-case srfi-69 csv-xml s11n md5 message-digest base64)
 (import (prefix sqlite3 sqlite3:))
 (import (prefix base64 base64:))
 
 ;; Note, try to remove this dependency 
-(use zmq)
+;; (use zmq)
 
 (declare (unit db))
 (declare (uses common))
 (declare (uses keys))
 (declare (uses ods))
@@ -241,24 +241,24 @@
 ;;======================================================================
 ;; T E S T   S P E C I F I C   D B 
 ;;======================================================================
 
 ;; Create the sqlite db for the individual test(s)
-(define (open-test-db testpath) 
-  (debug:print-info 11 "open-test-db " testpath)
-  (if (and testpath 
-	   (directory? testpath)
-	   (file-read-access? testpath))
-      (let* ((dbpath    (conc testpath "/testdat.db"))
+(define (open-test-db work-area) 
+  (debug:print-info 11 "open-test-db " work-area)
+  (if (and work-area 
+	   (directory? work-area)
+	   (file-read-access? work-area))
+      (let* ((dbpath    (conc work-area "/testdat.db"))
 	     (dbexists  (file-exists? dbpath))
 	     (handler   (make-busy-timeout (if (args:get-arg "-override-timeout")
 					       (string->number (args:get-arg "-override-timeout"))
 					       136000))))
 	(handle-exceptions
 	 exn
 	 (begin
-	   (debug:print 0 "ERROR: problem accessing test db " testpath ", you probably should clean and re-run this test"
+	   (debug:print 0 "ERROR: problem accessing test db " work-area ", you probably should clean and re-run this test"
 			((condition-property-accessor 'exn 'message) exn))
 	   #f)
 	 (set! db (sqlite3:open-database dbpath)))
 	(sqlite3:set-busy-handler! db handler)
 	(if (not dbexists)
@@ -265,29 +265,31 @@
 	    (begin
 	      (sqlite3:execute db "PRAGMA synchronous = FULL;")
 	      (debug:print-info 11 "Initialized test database " dbpath)
 	      (db:testdb-initialize db)))
 	;; (sqlite3:execute db "PRAGMA synchronous = 0;")
-	(debug:print-info 11 "open-test-db END (sucessful)" testpath)
+	(debug:print-info 11 "open-test-db END (sucessful)" work-area)
 	;; now let's test that everything is correct
 	(handle-exceptions
 	 exn
 	 (begin
-	   (debug:print 0 "ERROR: problem accessing test db " testpath ", you probably should clean and re-run this test"
+	   (debug:print 0 "ERROR: problem accessing test db " work-area ", you probably should clean and re-run this test"
 			((condition-property-accessor 'exn 'message) exn))
 	   #f)
 	 ;; Is there a cheaper single line operation that will check for existance of a table
 	 ;; and raise an exception ?
 	 (sqlite3:execute db "SELECT id FROM test_data LIMIT 1;"))
 	db)
       (begin
-	(debug:print-info 11 "open-test-db END (unsucessful)" testpath)
+	(debug:print-info 11 "open-test-db END (unsucessful)" work-area)
 	#f)))
 
 ;; find and open the testdat.db file for an existing test
-(define (db:open-test-db-by-test-id db test-id)
-  (let* ((test-path (cdb:remote-run db:test-get-rundir-from-test-id db test-id)))
+(define (db:open-test-db-by-test-id db test-id #!key (work-area #f))
+  (let* ((test-path (if work-area
+			work-area
+			(cdb:remote-run db:test-get-rundir-from-test-id db test-id))))
     (debug:print 3 "TEST PATH: " test-path)
     (open-test-db test-path)))
 
 (define (db:testdb-initialize db)
   (debug:print 11 "db:testdb-initialize START")
@@ -541,10 +543,43 @@
 				 (conc fieldname " " wildtype " '" patt "'")))
 			     (if (null? patts)
 				 '("")
 				 patts))
 			comparator)))
+
+
+;; register a test run with the db
+(define (db:register-run db keys keyvallst runname state status user)
+  (debug:print 3 "runs:register-run, keys: " keys " keyvallst: " keyvallst " runname: " runname " state: " state " status: " status " user: " user)
+  (let* ((keystr    (keys->keystr keys))
+	 (comma     (if (> (length keys) 0) "," ""))
+	 (andstr    (if (> (length keys) 0) " AND " ""))
+	 (valslots  (keys->valslots keys)) ;; ?,?,? ...
+	 (keyvals   (map cadr keyvallst))
+	 (allvals   (append (list runname state status user) keyvals))
+	 (qryvals   (append (list runname) keyvals))
+	 (key=?str  (string-intersperse (map (lambda (k)(conc (key:get-fieldname k) "=?")) keys) " AND ")))
+    (debug:print 3 "keys: " keys " allvals: " allvals " keyvals: " keyvals)
+    (debug:print 2 "NOTE: using target " (string-intersperse keyvals "/") " for this run")
+    (if (and runname (null? (filter (lambda (x)(not x)) keyvals))) ;; there must be a better way to "apply and"
+	(let ((res #f))
+	  (apply sqlite3:execute db (conc "INSERT OR IGNORE INTO runs (runname,state,status,owner,event_time" comma keystr ") VALUES (?,?,?,?,strftime('%s','now')" comma valslots ");")
+		 allvals)
+	  (apply sqlite3:for-each-row 
+	   (lambda (id)
+	     (set! res id))
+	   db
+	   (let ((qry (conc "SELECT id FROM runs WHERE (runname=? " andstr key=?str ");")))
+	     ;(debug:print 4 "qry: " qry) 
+	     qry)
+	   qryvals)
+	  (sqlite3:execute db "UPDATE runs SET state=?,status=? WHERE id=?;" state status res)
+	  res) 
+	(begin
+	  (debug:print 0 "ERROR: Called without all necessary keys")
+	  #f))))
+
 
 ;; replace header and keystr with a call to runs:get-std-run-fields
 ;;
 ;; keypatts: ( (KEY1 "abc%def")(KEY2 "%") )
 ;; runpatts: patt1,patt2 ...
@@ -723,25 +758,10 @@
 
 ;;======================================================================
 ;;  T E S T S
 ;;======================================================================
 
-(define (db:tests-register-test db run-id test-name item-path)
-  (debug:print-info 11 "db:tests-register-test START db=" db ", run-id=" run-id ", test-name=" test-name ", item-path=\"" item-path "\"")
-  (let ((item-paths (if (equal? item-path "")
-			(list item-path)
-			(list item-path ""))))
-    (for-each 
-     (lambda (pth)
-       (sqlite3:execute db "INSERT OR IGNORE INTO tests (run_id,testname,event_time,item_path,state,status) VALUES (?,?,strftime('%s','now'),?,'NOT_STARTED','n/a');" 
-			run-id 
-			test-name
-			pth))
-     item-paths)
-  (debug:print-info 11 "db:tests-register-test END db=" db ", run-id=" run-id ", test-name=" test-name ", item-path=\"" item-path "\"")
-    #f))
-
 ;; states and statuses are lists, turn them into ("PASS","FAIL"...) and use NOT IN
 ;; i.e. these lists define what to NOT show.
 ;; states and statuses are required to be lists, empty is ok
 ;; not-in #t = above behaviour, #f = must match
 (define (db:get-tests-for-run db run-id testpatt states statuses 
@@ -846,13 +866,13 @@
      )
     (debug:print-info 11 "db:get-tests-for-run START run-ids=" run-ids ", testpatt=" testpatt ", states=" states ", statuses=" statuses ", not-in=" not-in ", sort-by=" sort-by)
     res))
 
 ;; this one is a bit broken BUG FIXME
-(define (db:delete-test-step-records db test-id)
+(define (db:delete-test-step-records db test-id #!key (work-area #f))
   ;; Breaking it into two queries for better file access interleaving
-  (let* ((tdb (db:open-test-db-by-test-id db test-id)))
+  (let* ((tdb (db:open-test-db-by-test-id db test-id work-area: work-area)))
     ;; test db's can go away - must check every time
     (if tdb
 	(begin
 	  (sqlite3:execute tdb "DELETE FROM test_steps;")
 	  (sqlite3:execute tdb "DELETE FROM test_data;")
@@ -896,10 +916,19 @@
 	    testnames))
 
 (define (cdb:delete-tests-in-state serverdat run-id state)
   (cdb:client-call serverdat 'delete-tests-in-state #t *default-numtries* run-id state))
 
+(define (cdb:tests-update-cpuload-diskfree serverdat test-id cpuload diskfree)
+  (cdb:client-call serverdat 'update-cpuload-diskfree #t *default-numtries* cpuload diskfree test-id))
+
+(define (cdb:tests-update-run-duration serverdat test-id minutes)
+  (cdb:client-call serverdat 'update-run-duration #t *default-numtries* minutes test-id))
+
+(define (cdb:tests-update-uname-host serverdat test-id uname hostname)
+  (cdb:client-call serverdat 'update-uname-host #t *default-numtries* test-id uname hostname))
+
 ;; speed up for common cases with a little logic
 (define (db:test-set-state-status-by-id db test-id newstate newstatus newcomment)
   (cond
    ((and newstate newstatus newcomment)
     (sqlite3:exectute db "UPDATE tests SET state=?,status=?,comment=? WHERE id=?;" newstate newstatus test-id))
@@ -976,12 +1005,15 @@
 
 (define db:get-test-id db:get-test-id-not-cached)
 
 ;; given a test-info record, patch in the latest data from the testdat.db file
 ;; found in the test run directory
-(define (db:patch-tdb-data-into-test-info db test-id res)
-  (let ((tdb (db:open-test-db-by-test-id db test-id)))
+;;
+;; NOT USED
+;;
+(define (db:patch-tdb-data-into-test-info db test-id res #!key (work-area #f))
+  (let ((tdb (db:open-test-db-by-test-id db test-id work-area: work-area)))
     ;; get state and status from megatest.db in real time
     ;; other fields that perhaps should be updated:
     ;;   fail_count
     ;;   pass_count
     ;;   final_logf
@@ -1161,15 +1193,15 @@
 
 ;; NOTE: Can remove the regex and base64 encoding for zmq
 (define (db:obj->string obj)
   (case *transport-type*
     ((fs) obj)
-	((http)
+    ((http)
      (string-substitute
-       (regexp "=") "_"
-         (base64:base64-encode (with-output-to-string (lambda ()(serialize obj))))
-        #t))
+      (regexp "=") "_"
+      (base64:base64-encode (with-output-to-string (lambda ()(serialize obj))))
+      #t))
     ((zmq)(with-output-to-string (lambda ()(serialize obj))))
     (else obj)))
 
 (define (db:string->obj msg)
   (case *transport-type*
@@ -1218,10 +1250,11 @@
 	 (vector-ref tmp 2))))
     ((zmq)
      (handle-exceptions
       exn
       (begin
+	(debug:print-info 0 "cdb:client-call timeout or error. Trying again in 5 seconds")
 	(thread-sleep! 5) 
 	(if (> numretries 0)(apply cdb:client-call serverdat qtype immediate (- numretries 1) params)))
       (let* ((push-socket (vector-ref serverdat 0))
 	     (sub-socket  (vector-ref serverdat 1))
 	     (client-sig  (client:get-signature))
@@ -1239,31 +1272,32 @@
 			       (receive-message* sub-socket)
 			       ;; now get the actual message
 			       (let ((myres (db:string->obj (receive-message* sub-socket))))
 				 (if (equal? query-sig (vector-ref myres 1))
 				     (set! res (vector-ref myres 2))
-				     (loop))))))
-	     (timeout (lambda ()
-			(let loop ((n numretries))
-			  (thread-sleep! 15)
-			  (if (not res)
-			      (if (> numretries 0)
-				  (begin
-				    (debug:print 2 "WARNING: no reply to query " params ", trying resend")
-				    (debug:print-info 11 "re-sending message")
-				    (send-message push-socket zdat)
-				    (debug:print-info 11 "message re-sent")
-				    (loop (- n 1)))
-				  ;; (apply cdb:client-call *runremote* qtype immediate (- numretries 1) params))
-				  (begin
-				    (debug:print 0 "ERROR: cdb:client-call timed out " params ", exiting.")
-				    (exit 5))))))))
+				     (loop)))))))
+	    ;; (timeout (lambda ()
+	    ;;     	(let loop ((n numretries))
+	    ;;     	  (thread-sleep! 15)
+	    ;;     	  (if (not res)
+	    ;;     	      (if (> numretries 0)
+	    ;;     		  (begin
+	    ;;     		    (debug:print 2 "WARNING: no reply to query " params ", trying resend")
+	    ;;     		    (debug:print-info 11 "re-sending message")
+	    ;;     		    (send-message push-socket zdat)
+	    ;;     		    (debug:print-info 11 "message re-sent")
+	    ;;     		    (loop (- n 1)))
+	    ;;     		  ;; (apply cdb:client-call *runremote* qtype immediate (- numretries 1) params))
+	    ;;     		  (begin
+	    ;;     		    (debug:print 0 "ERROR: cdb:client-call timed out " params ", exiting.")
+	    ;;     		    (exit 5))))))))
 	(debug:print-info 11 "Starting threads")
 	(let ((th1 (make-thread send-receive "send receive"))
-	      (th2 (make-thread timeout      "timeout")))
+	      ;; (th2 (make-thread timeout      "timeout"))
+	      )
 	  (thread-start! th1)
-	  (thread-start! th2)
+	  ;; (thread-start! th2)
 	  (thread-join!  th1)
 	  (debug:print-info 11 "cdb:client-call returning res=" res)
 	  res))))))
   
 (define (cdb:set-verbosity serverdat val)
@@ -1288,14 +1322,11 @@
 
 (define (cdb:pass-fail-counts serverdat test-id fail-count pass-count)
   (cdb:client-call serverdat 'pass-fail-counts #t *default-numtries* fail-count pass-count test-id))
 
 (define (cdb:tests-register-test serverdat run-id test-name item-path)
-  (let ((item-paths (if (equal? item-path "")
-			(list item-path)
-			(list item-path ""))))
-    (cdb:client-call serverdat 'register-test #t *default-numtries* run-id test-name item-path)))
+  (cdb:client-call serverdat 'register-test #t *default-numtries* run-id test-name item-path))
 
 (define (cdb:flush-queue serverdat)
   (cdb:client-call serverdat 'flush #f *default-numtries*))
 
 (define (cdb:kill-server serverdat)
@@ -1326,10 +1357,14 @@
      db
      "SELECT rundir,final_logf FROM tests WHERE run_id=? AND testname=? AND item_path='';"
      run-id test-name)
     res))
 
+;;======================================================================
+;; A G R E G A T E D   T R A N S A C T I O N   D B   W R I T E S 
+;;======================================================================
+
 (define db:queries 
   (list '(register-test          "INSERT OR IGNORE INTO tests (run_id,testname,event_time,item_path,state,status) VALUES (?,?,strftime('%s','now'),?,'NOT_STARTED','n/a');")
 	'(state-status           "UPDATE tests SET state=?,status=? WHERE id=?;")
 	'(state-status-msg       "UPDATE tests SET state=?,status=?,comment=? WHERE id=?;")
 	'(pass-fail-counts       "UPDATE tests SET fail_count=?,pass_count=? WHERE id=?;")
@@ -1345,10 +1380,13 @@
 	'(test-set-log            "UPDATE tests SET final_logf=? WHERE id=?;")
 	'(test-set-rundir-by-test-id "UPDATE tests SET rundir=? WHERE id=?")
 	'(test-set-rundir         "UPDATE tests SET rundir=? WHERE run_id=? AND testname=? AND item_path=?;")
 	'(delete-tests-in-state   "DELETE FROM tests WHERE state=? AND run_id=?;")
 	'(tests:test-set-toplog   "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path='';")
+	'(update-cpuload-diskfree "UPDATE tests SET cpuload=?,diskfree=? WHERE id=?;")
+	'(update-run-duration     "UPDATE tests SET run_duration=? WHERE id=?;")
+	'(update-uname-host       "UPDATE tests SET uname=?,host=? WHERE id=?;")
     ))
 
 ;; do not run these as part of the transaction
 (define db:special-queries   '(rollup-tests-pass-fail
 			       db:roll-up-pass-fail-counts
@@ -1464,11 +1502,11 @@
 	       (< (current-seconds) timeout))
 	  (begin
 	    (thread-sleep! 0.01)
 	    (loop))))
     (set! *number-of-writes*   (+ *number-of-writes*   1))
-    (set! *writes-total-delay* (+ *writes-total-delay* 1))
+    (set! *writes-total-delay* (+ *writes-total-delay* (- (current-milliseconds) start-time)))
     got-it))
 	  
 (define (db:process-queue-item db item)
   (let* ((stmt-key       (cdb:packet-get-qtype item))
 	 (qry-sig        (cdb:packet-get-query-sig item))
@@ -1551,19 +1589,20 @@
      "SELECT id,item_path,state,status,run_duration,final_logf,comment FROM tests WHERE run_id=? AND testname=? AND item_path != '';"
      run-id test-name)
     res))
 
 ;; Rollup the pass/fail counts from itemized tests into fail_count and pass_count
+;; NOTE: Is this duplicating (db:test-data-rollup db test-id status) ????
 (define (db:roll-up-pass-fail-counts db run-id test-name item-path status)
   ;; (cdb:flush-queue *runremote*)
   (if (and (not (equal? item-path ""))
 	   (member status '("PASS" "WARN" "FAIL" "WAIVED" "RUNNING" "CHECK" "SKIP")))
       (begin
 	(sqlite3:execute 
 	 db
 	 "UPDATE tests 
-             SET fail_count=(SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND status='FAIL'),
+             SET fail_count=(SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND status IN ('FAIL','CHECK')),
                  pass_count=(SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND status IN ('PASS','WARN','WAIVED'))
              WHERE run_id=? AND testname=? AND item_path='';"
 	 run-id test-name run-id test-name run-id test-name)
         ;; (thread-sleep! 0.1) ;; give other processes a chance here, no, better to be done ASAP?
 	(if (equal? status "RUNNING") ;; running takes priority over all other states, force the test state to RUNNING
@@ -1575,16 +1614,20 @@
                                    WHEN (SELECT count(id) FROM tests 
                                                 WHERE run_id=? AND testname=?
                                                      AND item_path != '' 
                                                      AND state in ('RUNNING','NOT_STARTED')) > 0 THEN 'RUNNING'
                                    ELSE 'COMPLETED' END,
-                                      status=CASE 
-                                            WHEN fail_count > 0 THEN 'FAIL' 
-                                            WHEN pass_count > 0 AND fail_count=0 THEN 'PASS' 
-                                            ELSE 'UNKNOWN' END
+                            status=CASE 
+                                  WHEN fail_count > 0 THEN 'FAIL' 
+                                  WHEN pass_count > 0 AND fail_count=0 THEN 'PASS' 
+                                  WHEN (SELECT count(id) FROM tests
+                                         WHERE run_id=? AND testname=?
+                                              AND item_path != ''
+                                              AND status = 'SKIP') > 0 THEN 'SKIP'
+                                  ELSE 'UNKNOWN' END
                        WHERE run_id=? AND testname=? AND item_path='';"
-	     run-id test-name run-id test-name))
+	     run-id test-name run-id test-name run-id test-name))
 	#f)
       #f))
 
 ;;======================================================================
 ;; Tests meta data
@@ -1610,13 +1653,13 @@
 
 ;;======================================================================
 ;; T E S T   D A T A 
 ;;======================================================================
 
-(define (db:csv->test-data db test-id csvdata)
+(define (db:csv->test-data db test-id csvdata #!key (work-area #f))
   (debug:print 4 "test-id " test-id ", csvdata: " csvdata)
-  (let ((tdb     (db:open-test-db-by-test-id db test-id)))
+  (let ((tdb     (db:open-test-db-by-test-id db test-id work-area: work-area)))
     (if tdb
 	(let ((csvlist (csv->list (make-csv-reader
 				   (open-input-string csvdata)
 				   '((strip-leading-whitespace? #t)
 				     (strip-trailing-whitespace? #t)) )))) ;; (csv->list csvdata)))
@@ -1666,17 +1709,17 @@
 			       ((<=) (if (<= value expected) "pass" "fail"))
 			       (else (conc "ERROR: bad tol comparator " tol))))))
 	       (debug:print 4 "AFTER2: category: " category " variable: " variable " value: " value 
 			    ", expected: " expected " tol: " tol " units: " units " status: " status " comment: " comment)
 	       (sqlite3:execute tdb "INSERT OR REPLACE INTO test_data (test_id,category,variable,value,expected,tol,units,comment,status,type) VALUES (?,?,?,?,?,?,?,?,?,?);"
-				test-id category variable value expected tol units (if comment comment "") status type)
-	       (sqlite3:finalize! tdb)))
-	   csvlist)))))
+				test-id category variable value expected tol units (if comment comment "") status type)))
+	   csvlist)
+	  (sqlite3:finalize! tdb)))))
 
 ;; get a list of test_data records matching categorypatt
-(define (db:read-test-data db test-id categorypatt)
-  (let ((tdb  (db:open-test-db-by-test-id db test-id)))
+(define (db:read-test-data db test-id categorypatt #!key (work-area #f))
+  (let ((tdb  (db:open-test-db-by-test-id db test-id work-area: work-area)))
     (if tdb
 	(let ((res '()))
 	  (sqlite3:for-each-row 
 	   (lambda (id test_id category variable value expected tol units comment status type)
 	     (set! res (cons (vector id test_id category variable value expected tol units comment status type) res)))
@@ -1685,28 +1728,28 @@
 	  (sqlite3:finalize! tdb)
 	  (reverse res))
 	'())))
 
 ;; NOTE: Run this local with #f for db !!!
-(define (db:load-test-data db test-id)
+(define (db:load-test-data db test-id #!key (work-area #f))
   (let loop ((lin (read-line)))
     (if (not (eof-object? lin))
 	(begin
 	  (debug:print 4 lin)
-	  (db:csv->test-data db test-id lin)
+	  (db:csv->test-data db test-id lin work-area: work-area)
 	  (loop (read-line)))))
   ;; roll up the current results.
   ;; FIXME: Add the status to 
-  (db:test-data-rollup db test-id #f))
+  (db:test-data-rollup db test-id #f work-area: work-area))
 
 ;; WARNING: Do NOT call this for the parent test on an iterated test
 ;; Roll up test_data pass/fail results
 ;; look at the test_data status field, 
 ;;    if all are pass (any case) and the test status is PASS or NULL or '' then set test status to PASS.
 ;;    if one or more are fail (any case) then set test status to PASS, non "pass" or "fail" are ignored
-(define (db:test-data-rollup db test-id status)
-  (let ((tdb (db:open-test-db-by-test-id db test-id))
+(define (db:test-data-rollup db test-id status #!key (work-area #f))
+  (let ((tdb (db:open-test-db-by-test-id db test-id work-area: work-area))
 	(fail-count 0)
 	(pass-count 0))
     (if tdb
 	(begin
 	  (sqlite3:for-each-row
@@ -1721,11 +1764,15 @@
 
 	  ;; Now rollup the counts to the central megatest.db
 	  (cdb:pass-fail-counts *runremote* test-id fail-count pass-count)
 	  ;; (sqlite3:execute db "UPDATE tests SET fail_count=?,pass_count=? WHERE id=?;" 
 	  ;;                     fail-count pass-count test-id)
-	  (cdb:flush-queue *runremote*)
+
+	  ;; The flush is not needed with the transaction based write agregation enabled. Remove these commented lines
+	  ;; next time you read this!
+	  ;;
+	  ;; (cdb:flush-queue *runremote*)
 	  ;; (thread-sleep! 1) ;; play nice with the queue by ensuring the rollup is at least 10ms later than the set
 	  
 	  ;; if the test is not FAIL then set status based on the fail and pass counts.
 	  (cdb:test-rollup-test_data-pass-fail *runremote* test-id)
 	  ;; (sqlite3:execute
@@ -1751,12 +1798,12 @@
 
 (define (db:step-get-time-as-string vec)
   (seconds->time-string (db:step-get-event_time vec)))
 
 ;; db-get-test-steps-for-run
-(define (db:get-steps-for-test db test-id)
-  (let* ((tdb (db:open-test-db-by-test-id db test-id))
+(define (db:get-steps-for-test db test-id #!key (work-area #f))
+  (let* ((tdb (db:open-test-db-by-test-id db test-id work-area: work-area))
 	 (res '()))
     (if tdb
 	(begin
 	  (sqlite3:for-each-row 
 	   (lambda (id test-id stepname state status event-time logfile)
@@ -1768,12 +1815,12 @@
 	  (reverse res))
 	'())))
 
 ;; get a pretty table to summarize steps
 ;;
-(define (db:get-steps-table db test-id)
-  (let ((steps   (db:get-steps-for-test db test-id)))
+(define (db:get-steps-table db test-id #!key (work-area #f))
+  (let ((steps   (db:get-steps-for-test db test-id work-area: work-area)))
     ;; organise the steps for better readability
     (let ((res (make-hash-table)))
       (for-each 
        (lambda (step)
 	 (debug:print 6 "step=" step)
@@ -1828,12 +1875,12 @@
 		      (else #f)))))
       res)))
 
 ;; get a pretty table to summarize steps
 ;;
-(define (db:get-steps-table-list db test-id)
-  (let ((steps   (db:get-steps-for-test db test-id)))
+(define (db:get-steps-table-list db test-id #!key (work-area #f))
+  (let ((steps   (db:get-steps-for-test db test-id work-area: work-area)))
     ;; organise the steps for better readability
     (let ((res (make-hash-table)))
       (for-each 
        (lambda (step)
 	 (debug:print 6 "step=" step)
@@ -1970,14 +2017,14 @@
 	     (if (not ever-seen)
 		 (set! result (append (if (null? tests)(list waitontest-name) tests) result)))))
 	 waitons)
 	(delete-duplicates result))))
 
-(define (db:teststep-set-status! db test-id teststep-name state-in status-in comment logfile)
+(define (db:teststep-set-status! db test-id teststep-name state-in status-in comment logfile #!key (work-area #f))
   (debug:print 4 "test-id: " test-id " teststep-name: " teststep-name)
   ;;                 db:open-test-db-by-test-id does cdb:remote-run
-  (let* ((tdb       (db:open-test-db-by-test-id db test-id))
+  (let* ((tdb       (db:open-test-db-by-test-id db test-id work-area: work-area))
 	 (state     (items:check-valid-items "state" state-in))
 	 (status    (items:check-valid-items "status" status-in)))
     (if (or (not state)(not status))
 	(debug:print 3 "WARNING: Invalid " (if status "status" "state")
 		     " value \"" (if status state-in status-in) "\", update your validvalues section in megatest.config"))