Index: Makefile
==================================================================
--- Makefile
+++ Makefile
@@ -6,11 +6,11 @@
            ods.scm runconfig.scm server.scm configf.scm \
            db.scm keys.scm margs.scm megatest-version.scm \
            process.scm runs.scm tasks.scm tests.scm genexample.scm \
 	   fs-transport.scm http-transport.scm \
            client.scm gutils.scm synchash.scm daemon.scm mt.scm dcommon.scm \
-	   tree.scm
+	   tree.scm rmt.scm api.scm tdb.scm
 
 GUISRCF  = dashboard-tests.scm dashboard-guimonitor.scm 
 
 OFILES   = $(SRCFILES:%.scm=%.o)
 GOFILES  = $(GUISRCF:%.scm=%.o)

ADDED   api.scm
Index: api.scm
==================================================================
--- /dev/null
+++ api.scm
@@ -0,0 +1,55 @@
+;;======================================================================
+;; Copyright 2006-2013, 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.
+;;======================================================================
+
+(declare (unit api))
+(declare (uses rmt))
+(declare (uses db))
+
+;; These are called by the server on recipt of /api calls
+
+(define (api:execute-requests db cmd params)
+  (debug:print-info 1 "api:execute-requests cmd=" cmd " params=" params)
+  (db:process-cached-writes db)
+  (case (string->symbol cmd)
+    ;; KEYS
+    ((get-key-val-pairs)            (apply db:get-key-val-pairs db params))
+    ;; TESTS
+    ;; json doesn't do vectors, convert to list
+    ((get-test-info-by-id)	    (vector->list (apply db:get-test-info-by-id db params)))
+    ((test-get-rundir-from-test-id) (apply db:test-get-rundir-from-test-id db params))
+    ((testmeta-get-record)          (vector->list (apply db:testmeta-get-record db params)))
+    ((test-set-state-status-by-id)  (apply db:test-set-state-status-by-id db params))
+    ;; RUNS
+    ((get-run-info)                 (let ((res (apply db:get-run-info db params)))
+				      (list (vector-ref res 0)
+					    (vector->list (vector-ref res 1)))))
+    (else
+     (list "ERROR" 0))))
+
+;; http-server  send-response
+;;                 api:process-request
+;;                    db:*
+;;
+;; NB// Runs on the server as part of the server loop
+;;
+(define (api:process-request db $) ;; the $ is the request vars proc
+  (let* ((cmd     ($ 'cmd))
+	 (paramsj ($ 'params))
+	 (params  (rmt:json-str->dat paramsj))
+	 (res     (api:execute-requests db cmd params)))
+    (rmt:dat->json-str
+     (if (or (string? res)
+	     (list?   res)
+	     (number? res)
+	     (boolean? res))
+	 res 
+	 (list "ERROR" 1 cmd params res)))))
+

Index: dashboard-tests.scm
==================================================================
--- dashboard-tests.scm
+++ dashboard-tests.scm
@@ -24,10 +24,11 @@
 
 (declare (unit dashboard-tests))
 (declare (uses common))
 (declare (uses db))
 (declare (uses gutils))
+(declare (uses rmt))
 
 (include "common_records.scm")
 (include "db_records.scm")
 (include "run_records.scm")
 
@@ -205,21 +206,21 @@
     (iup:frame
      #:title "Set fields"
      (iup:vbox
       (iup:hbox (iup:label "Comment:")
 		(iup:textbox #:action (lambda (val a b)
-					(open-run-close db:test-set-state-status-by-id #f test-id #f #f b)
+					(rmt:test-set-state-status-by-id test-id #f #f b)
 					(set! newcomment b))
 			     #:value (db:test-get-comment testdat)
 			     #:expand "HORIZONTAL"))
       (apply iup:hbox
 	     (iup:label "STATE:" #:size "30x")
 	     (let* ((btns  (map (lambda (state)
 				  (let ((btn (iup:button state
 							 #:expand "HORIZONTAL" #:size "50x" #:font "Courier New, -10"
 							 #:action (lambda (x)
-								    (open-run-close db:test-set-state-status-by-id #f test-id state #f #f)
+								    (rmt:test-set-state-status-by-id test-id state #f #f)
 								    (db:test-set-state! testdat state)))))
 				    btn))
 				(list "COMPLETED" "NOT_STARTED" "RUNNING" "REMOTEHOSTSTART" "KILLED" "KILLREQ"))))
 	       (vector-set! *state-status* 0
 			    (lambda (state color)
@@ -235,11 +236,11 @@
 	     (iup:label "STATUS:" #:size "30x")
 	     (let* ((btns  (map (lambda (status)
 				  (let ((btn (iup:button status
 							 #:expand "HORIZONTAL" #:size "50x" #:font "Courier New, -10"
 							 #:action (lambda (x)
-								    (open-run-close db:test-set-state-status-by-id #f test-id #f status #f)
+								    (rmt:test-set-state-status-by-id test-id #f status #f)
 								    (db:test-set-status! testdat status)))))
 				    btn))
 				(list  "PASS" "WARN" "FAIL" "CHECK" "n/a" "WAIVED" "SKIP"))))
 	       (vector-set! *state-status* 1
 			    (lambda (status color)
@@ -250,16 +251,105 @@
 				   (if (not (colors-similar? newcolor (iup:attribute btn "BGCOLOR")))
 				       (iup:attribute-set! btn "BGCOLOR" newcolor))))
 			       btns)))
 	       btns))))))
 
+;; get a pretty table to summarize steps
+;;
+(define (dashboard-tests:process-steps-table steps);; 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)
+	 (let ((record (hash-table-ref/default 
+			res 
+			(db:step-get-stepname step) 
+			;;        stepname                start end status Duration  Logfile 
+			(vector (db:step-get-stepname step) ""   "" ""     ""        ""))))
+	   (debug:print 6 "record(before) = " record 
+			"\nid:       " (db:step-get-id step)
+			"\nstepname: " (db:step-get-stepname step)
+			"\nstate:    " (db:step-get-state step)
+			"\nstatus:   " (db:step-get-status step)
+			"\ntime:     " (db:step-get-event_time step))
+	   (case (string->symbol (db:step-get-state step))
+	     ((start)(vector-set! record 1 (db:step-get-event_time step))
+	      (vector-set! record 3 (if (equal? (vector-ref record 3) "")
+					(db:step-get-status step)))
+	      (if (> (string-length (db:step-get-logfile step))
+		     0)
+		  (vector-set! record 5 (db:step-get-logfile step))))
+	     ((end)  
+	      (vector-set! record 2 (any->number (db:step-get-event_time step)))
+	      (vector-set! record 3 (db:step-get-status step))
+	      (vector-set! record 4 (let ((startt (any->number (vector-ref record 1)))
+					  (endt   (any->number (vector-ref record 2))))
+				      (debug:print 4 "record[1]=" (vector-ref record 1) 
+						   ", startt=" startt ", endt=" endt
+						   ", get-status: " (db:step-get-status step))
+				      (if (and (number? startt)(number? endt))
+					  (seconds->hr-min-sec (- endt startt)) "-1")))
+	      (if (> (string-length (db:step-get-logfile step))
+		     0)
+		  (vector-set! record 5 (db:step-get-logfile step))))
+	     (else
+	      (vector-set! record 2 (db:step-get-state step))
+	      (vector-set! record 3 (db:step-get-status step))
+	      (vector-set! record 4 (db:step-get-event_time step))))
+	   (hash-table-set! res (db:step-get-stepname step) record)
+	   (debug:print 6 "record(after)  = " record 
+			"\nid:       " (db:step-get-id step)
+			"\nstepname: " (db:step-get-stepname step)
+			"\nstate:    " (db:step-get-state step)
+			"\nstatus:   " (db:step-get-status step)
+			"\ntime:     " (db:step-get-event_time step))))
+       ;; (else   (vector-set! record 1 (db:step-get-event_time step)))
+       (sort steps (lambda (a b)
+		     (cond
+		      ((<   (db:step-get-event_time a)(db:step-get-event_time b)) #t)
+		      ((eq? (db:step-get-event_time a)(db:step-get-event_time b)) 
+		       (<   (db:step-get-id a)        (db:step-get-id b)))
+		      (else #f)))))
+      res))
+
+(define (dashboard-tests:get-compressed-steps test-id #!key (work-area #f))
+  (if (or (not work-area)
+	  (file-exists? (conc work-area "/testdat.db")))
+      (let* ((steps-data  (rmt:get-steps-for-test test-id work-area))
+	     (comprsteps  (dashboard-tests:process-steps-table steps-data))) ;; (open-run-close db:get-steps-table #f test-id work-area: work-area)))
+	(map (lambda (x)
+	       ;; take advantage of the \n on time->string
+	       (vector
+		(vector-ref x 0)
+		(let ((s (vector-ref x 1)))
+		  (if (number? s)(seconds->time-string s) s))
+		(let ((s (vector-ref x 2)))
+		  (if (number? s)(seconds->time-string s) s))
+		(vector-ref x 3)    ;; status
+		(vector-ref x 4)
+		(vector-ref x 5)))  ;; time delta
+	     (sort (hash-table-values comprsteps)
+		   (lambda (a b)
+		     (let ((time-a (vector-ref a 1))
+			   (time-b (vector-ref b 1)))
+		       (if (and (number? time-a)(number? time-b))
+			   (if (< time-a time-b)
+			       #t
+			       (if (eq? time-a time-b)
+				   (string<? (conc (vector-ref a 2))
+					     (conc (vector-ref b 2)))
+				   #f))
+			   (string<? (conc time-a)(conc time-b))))))))
+      '()))
 
 ;;======================================================================
 ;;
 ;;======================================================================
 (define (examine-test test-id) ;; run-id run-key origtest)
-  (let* ((testdat       (open-run-close db:get-test-info-by-id #f test-id))
+  (let* ((testdat       (rmt:get-test-info-by-id test-id))
 	 (db-path       (conc *toppath* "/megatest.db"))
 	 (db-mod-time   0) ;; (file-modification-time db-path))
 	 (last-update   0) ;; (current-seconds))
 	 (request-update #t)
 	 (db             #f))
@@ -266,24 +356,25 @@
     (if (not testdat)
 	(begin
 	  (debug:print 0 "ERROR: No test data found for test " test-id ", exiting")
 	  (exit 1))
 	(let* ((run-id        (if testdat (db:test-get-run_id testdat) #f))
-	       (keydat        (if testdat (open-run-close db:get-key-val-pairs #f run-id) #f))
-	       (rundat        (if testdat (open-run-close db:get-run-info #f run-id) #f))
+	       (keydat        (if testdat (rmt:get-key-val-pairs run-id) #f))
+	       (rundat        (if testdat (rmt:get-run-info run-id) #f))
 	       (runname       (if testdat (db:get-value-by-header (db:get-row rundat)
 								  (db:get-header rundat)
 								  "runname") #f))
 	       ;; These next two are intentional bad values to ensure errors if they should not
 	       ;; get filled in properly.
 	       (logfile       "/this/dir/better/not/exist")
 	       (rundir        logfile)
-	       (teststeps     (if testdat (db:get-compressed-steps test-id work-area: rundir) '()))
+	       (testdat-path  (conc rundir "/testdat.db")) ;; this gets recalculated until found       
+	       (teststeps     (if testdat (dashboard-tests:get-compressed-steps test-id work-area: rundir) '()))
 	       (testfullname  (if testdat (db:test-get-fullname testdat) "Gathering data ..."))
 	       (testname      (if testdat (db:test-get-testname testdat) "n/a"))
 	       (testmeta      (if testdat 
-				  (let ((tm (open-run-close db:testmeta-get-record #f testname)))
+				  (let ((tm (rmt:testmeta-get-record testname)))
 				    (if tm tm (make-db:testmeta)))
 				  (make-db:testmeta)))
 
 	       (keystring  (string-intersperse 
 			    (map (lambda (keyval)
@@ -310,32 +401,53 @@
 						  (conc "-e " (get-environment-variable "SHELL"))
 						  "")))
 				   (system (conc "cd " rundir 
 						 ";xterm -T \"" (string-translate testfullname "()" "  ") "\" " shell "&")))
 				 (message-window  (conc "Directory " rundir " not found")))))
+	       (widgets    (make-hash-table))
 	       (refreshdat (lambda ()
-			     (let* ((curr-mod-time (file-modification-time db-path))
+			     (let* ((curr-mod-time (max (file-modification-time db-path)
+							(if (file-exists? testdat-path)
+							    (file-modification-time testdat-path)
+							    (begin
+							      (set! testdat-path (conc rundir "/testdat.db"))
+							      0))))
 				    (need-update   (or (and (> curr-mod-time db-mod-time)
-							    (> (current-seconds) (+ last-update 2))) ;; every two seconds if db touched
+							    (> (current-milliseconds)(+ last-update 250))) ;; every half seconds if db touched
+						       (> (current-milliseconds)(+ last-update 10000))     ;; force update even 10 seconds
 						       request-update))
 				    (newtestdat (if need-update 
 						    (handle-exceptions
 						     exn 
-						     (debug:print-info 2 "test db access issue: " ((condition-property-accessor 'exn 'message) exn))
-						     (open-run-close db:get-test-info-by-id #f test-id )))))
+						     (debug:print-info 0 "test db access issue: " ((condition-property-accessor 'exn 'message) exn))
+						     (rmt:get-test-info-by-id test-id )))))
+			       ;; (debug:print-info 0 "need-update= " need-update " curr-mod-time = " curr-mod-time)
 			       (cond
 				((and need-update newtestdat)
 				 (set! testdat newtestdat)
-				 (set! teststeps    (db:get-compressed-steps test-id work-area: rundir))
+				 (set! teststeps    (dashboard-tests:get-compressed-steps test-id work-area: rundir))
 				 (set! logfile      (conc (db:test-get-rundir testdat) "/" (db:test-get-final_logf testdat)))
 				 (set! rundir       (db:test-get-rundir testdat))
 				 (set! testfullname (db:test-get-fullname testdat))
 				 ;; (debug:print 0 "INFO: teststeps=" (intersperse teststeps "\n    "))
+				 (set! db-mod-time curr-mod-time)
+				 (set! last-update (current-milliseconds))
+				 (set! request-update #f) ;; met the need ...
 				 )
 				(need-update ;; if this was true and yet there is no data ....
-				 (db:test-set-testname! testdat "DEAD OR DELETED TEST"))))))
-	       (widgets      (make-hash-table))
+				 (db:test-set-testname! testdat "DEAD OR DELETED TEST")))
+			       (if need-update
+				   (begin
+				     ;; update the gui elements here
+				     (for-each 
+				      (lambda (key)
+					;; (print "Updating " key)
+					((hash-table-ref widgets key) testdat))
+				      (hash-table-keys widgets))
+				     (update-state-status-buttons testdat)))
+			       ;; (iup:refresh self)
+			       )))
 	       (meta-widgets (make-hash-table))
 	       (self         #f)
 	       (store-label  (lambda (name lbl cmd)
 			       (hash-table-set! widgets name 
 						(lambda (testdat)
@@ -450,23 +562,45 @@
 					 (iup:attribute-set! steps-matrix "ALIGNMENT1" "ALEFT")
 					 ;; (iup:attribute-set! steps-matrix "FIXTOTEXT" "C1")
 					 (iup:attribute-set! steps-matrix "RESIZEMATRIX" "YES")
 					 (let ((proc
 						(lambda (testdat)
-						  (if (not (null? teststeps))
-						      (let loop ((hed    (car teststeps))
-								 (tal    (cdr teststeps))
-								 (rownum 1)
-								 (colnum 1))
-							(let ((val     (vector-ref hed (- colnum 1)))
-							      (mtrx-rc (conc rownum ":" colnum)))
-							  (iup:attribute-set! steps-matrix  mtrx-rc (if val (conc val) ""))
-							  (if (< colnum 6)
-							      (loop hed tal rownum (+ colnum 1))
-							      (if (not (null? tal))
-								  (loop (car tal)(cdr tal)(+ rownum 1) 1))))
-							(iup:attribute-set! steps-matrix "REDRAW" "ALL"))))))
+						  (let ((max-row 0))
+						    (if (not (null? teststeps))
+							(let loop ((hed    (car teststeps))
+								   (tal    (cdr teststeps))
+								   (rownum 1)
+								   (colnum 1))
+							  (if (> rownum max-row)(set! max-row rownum))
+							  (let ((val     (vector-ref hed (- colnum 1)))
+								(mtrx-rc (conc rownum ":" colnum)))
+							    (iup:attribute-set! steps-matrix  mtrx-rc (if val (conc val) ""))
+							    (if (< colnum 6)
+								(loop hed tal rownum (+ colnum 1))
+								(if (not (null? tal))
+								    (loop (car tal)(cdr tal)(+ rownum 1) 1))))))
+						    (if (> max-row 0)
+							(begin
+							  ;; we are going to speculatively clear rows until we find a row that is already cleared
+							  (let loop ((rownum  (+ max-row 1))
+								     (colnum  0)
+								     (deleted #f))
+							    ;; (debug:print-info 0 "cleaning " rownum ":" colnum)
+							    (let* ((next-row (if (eq? colnum 6) (+ rownum 1) rownum))
+								   (next-col (if (eq? colnum 6) 1 (+ colnum 1)))
+								   (mtrx-rc  (conc rownum ":" colnum))
+								   (curr-val (iup:attribute steps-matrix mtrx-rc)))
+							      ;; (debug:print-info 0 "cleaning " rownum ":" colnum " currval= " curr-val)
+							      (if (and (string? curr-val)
+								       (not (equal? curr-val "")))
+								  (begin
+								    (iup:attribute-set! steps-matrix mtrx-rc "")
+								    (loop next-row next-col #t))
+								  (if (eq? colnum 6) ;; not done, didn't get a full blank row
+								      (if deleted (loop next-row next-col #f)) ;; exit on this not met
+								      (loop next-row next-col deleted)))))
+							  (iup:attribute-set! steps-matrix "REDRAW" "ALL")))))))
 					   (hash-table-set! widgets "StepsMatrix" proc)
 					   (proc testdat))
 					 steps-matrix)
 				       ;; populate the Test Data panel
 				       (iup:frame
@@ -496,11 +630,11 @@
 											      (db:test-data-get-tol      x)
 											      (db:test-data-get-status   x)
 											      (db:test-data-get-units    x)
 											      (db:test-data-get-type     x)
 											      (db:test-data-get-comment  x)))
-										    (open-run-close db:read-test-data #f test-id "%")))
+										    (rmt:read-test-data test-id "%")))
 									      "\n")))
 							       (if (not (equal? currval newval))
 								   (iup:attribute-set! test-data "VALUE" newval ))))) ;; "TITLE" newval)))))
 					  test-data))
 				       ;;(dashboard:run-controls)
@@ -512,16 +646,8 @@
 	    (iup:callback-set! *tim* "ACTION_CB"
 			       (lambda (x)
 				 ;; Now start keeping the gui updated from the db
 				 (refreshdat) ;; update from the db here
 					;(thread-suspend! other-thread)
-				 ;; update the gui elements here
-				 (for-each 
-				  (lambda (key)
-				    ;; (print "Updating " key)
-				    ((hash-table-ref widgets key) testdat))
-				  (hash-table-keys widgets))
-				 (update-state-status-buttons testdat)
-					; (iup:refresh self)
 				 (if *exit-started*
 				     (set! *exit-started* 'ok))))))))))
 

Index: dashboard.scm
==================================================================
--- dashboard.scm
+++ dashboard.scm
@@ -39,10 +39,11 @@
 (declare (uses mt))
 
 (include "common_records.scm")
 (include "db_records.scm")
 (include "run_records.scm")
+(include "megatest-fossil-hash.scm")
 
 (define help (conc 
 "Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest
   version " megatest-version "
   license GPL, Copyright (C) Matt Welland 2013
@@ -63,10 +64,11 @@
 		 (list  "-rows"
 			"-run"
 			"-test"
 			"-debug"
 			"-host" 
+			"-transport"
 			) 
 		 (list  "-h"
 			"-use-server"
 			"-guimonitor"
 			"-main"
@@ -90,12 +92,14 @@
 
 (if (args:get-arg "-host")
     (begin
       (set! *runremote* (string-split (args:get-arg "-host" ":")))
       (client:launch))
-    (if (not (args:get-arg "-use-server"))
-	(set! *transport-type* 'fs) ;; force fs access
+    (if (args:get-arg "-transport")
+	(begin
+	  (set! *transport-type* (string->symbol (args:get-arg "-transport"))) ;; force fs access
+	  (client:launch))
 	(client:launch)))
 
 ;; HACK ALERT: this is a hack, please fix.
 (define *read-only* (not (file-read-access? (conc *toppath* "/megatest.db"))))
 ;; (client:setup *db*)
@@ -118,14 +122,19 @@
 (define *alltestnamelst* '())
 (define *searchpatts*  (make-hash-table))
 (define *num-runs*      8)
 (define *tot-run-count* (cdb:remote-run db:get-num-runs #f "%"))
 ;; (define *tot-run-count* (db:get-num-runs *db* "%"))
+
+;; Update management
+;;
 (define *last-update*   (current-seconds))
 (define *last-db-update-time* 0)
 (define *please-update-buttons* #t)
 (define *delayed-update* 0)
+(define *update-is-running* #f)
+(define *update-mutex* (make-mutex))
 
 (define *num-tests*     15)
 (define *start-run-offset*  0)
 (define *start-test-offset* 0)
 (define *examine-test-dat* (make-hash-table))
@@ -1334,12 +1343,12 @@
 
 ;;======================================================================
 ;; The heavy lifting starts here
 ;;======================================================================
 
-;; ease debugging by loading ~/.megatestrc
-(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.megatestrc")))
+;; ease debugging by loading ~/.dashboardrc
+(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
   (if (file-exists? debugcontrolf)
       (load debugcontrolf)))
 
 (cond 
  ((args:get-arg "-run")
@@ -1365,9 +1374,20 @@
  (else
   (set! uidat (make-dashboard-buttons *num-runs* *num-tests* *dbkeys*))
   (iup:callback-set! *tim*
 		     "ACTION_CB"
 		     (lambda (x)
-		       (dashboard:run-update x)
+		       (let ((update-is-running #f))
+			 (mutex-lock! *update-mutex*)
+			 (set! update-is-running *update-is-running*)
+			 (if (not update-is-running)
+			     (set! *update-is-running* #t))
+			 (mutex-unlock! *update-mutex*)
+			 (if (not update-is-running)
+			   (begin
+			     (dashboard:run-update x)
+			     (mutex-lock! *update-mutex*)
+			     (set! *update-is-running* #f)
+			     (mutex-unlock! *update-mutex*))))
 		       1))))
 
 (iup:main-loop)

Index: db.scm
==================================================================
--- db.scm
+++ db.scm
@@ -868,28 +868,28 @@
     (reverse res)))
 
 ;; get key vals for a given run-id
 (define (db:get-key-vals db run-id)
    (let ((mykeyvals (hash-table-ref/default *keyvals* run-id #f)))
-    (if mykeyvals 
-	mykeyvals
-    (let* ((keys (db:get-keys db))
-	 (res  '()))
-    (debug:print-info 11 "db:get-key-vals START keys: " keys " run-id: " run-id)
-    (for-each 
-     (lambda (key)
-       (let ((qry (conc "SELECT " key " FROM runs WHERE id=?;")))
-	 ;; (debug:print 0 "qry: " qry)
-	 (sqlite3:for-each-row 
-	  (lambda (key-val)
-	    (set! res (cons key-val res)))
-	  db qry run-id)))
-     keys)
-    (debug:print-info 11 "db:get-key-vals END keys: " keys " run-id: " run-id)
-	  (let ((final-res (reverse res)))
-	    (hash-table-set! *keyvals* run-id final-res)
-	    final-res)))))
+     (if mykeyvals 
+	 mykeyvals
+	 (let* ((keys (db:get-keys db))
+		(res  '()))
+	   (debug:print-info 11 "db:get-key-vals START keys: " keys " run-id: " run-id)
+	   (for-each 
+	    (lambda (key)
+	      (let ((qry (conc "SELECT " key " FROM runs WHERE id=?;")))
+		;; (debug:print 0 "qry: " qry)
+		(sqlite3:for-each-row 
+		 (lambda (key-val)
+		   (set! res (cons key-val res)))
+		 db qry run-id)))
+	    keys)
+	   (debug:print-info 11 "db:get-key-vals END keys: " keys " run-id: " run-id)
+	   (let ((final-res (reverse res)))
+	     (hash-table-set! *keyvals* run-id final-res)
+	     final-res)))))
 
 ;; The target is keyval1/keyval2..., cached in *target* as it is used often
 (define (db:get-target db run-id)
   (let ((mytarg (hash-table-ref/default *target* run-id #f)))
     (if mytarg
@@ -1117,11 +1117,13 @@
    ((and newstate newstatus)
     (sqlite3:execute db "UPDATE tests SET state=?,status=? WHERE id=?;" newstate newstatus test-id))
    (else
     (if newstate   (sqlite3:execute db "UPDATE tests SET state=?   WHERE id=?;" newstate   test-id))
     (if newstatus  (sqlite3:execute db "UPDATE tests SET status=?  WHERE id=?;" newstatus  test-id))
-    (if newcomment (sqlite3:execute db "UPDATE tests SET comment=? WHERE id=?;" newcomment test-id)))))
+    (if newcomment (sqlite3:execute db "UPDATE tests SET comment=? WHERE id=?;" newcomment test-id))
+    ))
+  #t) ;; retrun something to keep the remote calls happy
 
 (define (db:test-set-state-status-by-run-id-testname db run-id test-name item-path status state)
   (sqlite3:execute db "UPDATE tests SET state=?,status=?,event_time=strftime('%s','now') WHERE run_id=? AND testname=? AND item_path=?;" 
 		   state status run-id test-name item-path))
 
@@ -1290,22 +1292,18 @@
 
 (define (cdb:test-set-rundir-by-test-id serverdat test-id rundir)
   (cdb:client-call serverdat 'test-set-rundir-by-test-id #t *default-numtries* rundir test-id))
 
 (define (db:test-get-rundir-from-test-id db test-id)
-  (let ((res #f)) ;; (hash-table-ref/default *test-paths* test-id #f)))
-    ;; (if res
-    ;;     res
-    ;;     (begin
+  (let ((res #f))
     (sqlite3:for-each-row
      (lambda (tpath)
        (set! res tpath))
      db 
      "SELECT rundir FROM tests WHERE id=?;"
      test-id)
-    ;; (hash-table-set! *test-paths* test-id res)
-    res)) ;; ))
+    res))
 
 (define (cdb:test-set-log! serverdat test-id logf)
   (if (string? logf)(cdb:client-call serverdat 'test-set-log #f *default-numtries* logf test-id)))
 
 ;;======================================================================
@@ -1919,24 +1917,10 @@
 	       (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)))
 	   csvlist)
 	  (sqlite3:finalize! tdb)))))
 
-;; get a list of test_data records matching categorypatt
-(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)))
-	   tdb
-	   "SELECT id,test_id,category,variable,value,expected,tol,units,comment,status,type FROM test_data WHERE test_id=? AND category LIKE ? ORDER BY category,variable;" test-id categorypatt)
-	  (sqlite3:finalize! tdb)
-	  (reverse res))
-	'())))
-
 ;; NOTE: Run this local with #f for db !!!
 (define (db:load-test-data db test-id #!key (work-area #f))
   (let loop ((lin (read-line)))
     (if (not (eof-object? lin))
 	(begin
@@ -2003,86 +1987,10 @@
 ;;======================================================================
 
 (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 #!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)
-	     (set! res (cons (vector id test-id stepname state status event-time (if (string? logfile) logfile "")) res)))
-	   tdb
-	   "SELECT id,test_id,stepname,state,status,event_time,logfile FROM test_steps WHERE test_id=? ORDER BY id ASC;" ;; event_time DESC,id ASC;
-	   test-id)
-	  (sqlite3:finalize! tdb)
-	  (reverse res))
-	'())))
-
-;; get a pretty table to summarize steps
-;;
-(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)
-	 (let ((record (hash-table-ref/default 
-			res 
-			(db:step-get-stepname step) 
-			;;        stepname                start end status Duration  Logfile 
-			(vector (db:step-get-stepname step) ""   "" ""     ""        ""))))
-	   (debug:print 6 "record(before) = " record 
-			"\nid:       " (db:step-get-id step)
-			"\nstepname: " (db:step-get-stepname step)
-			"\nstate:    " (db:step-get-state step)
-			"\nstatus:   " (db:step-get-status step)
-			"\ntime:     " (db:step-get-event_time step))
-	   (case (string->symbol (db:step-get-state step))
-	     ((start)(vector-set! record 1 (db:step-get-event_time step))
-	      (vector-set! record 3 (if (equal? (vector-ref record 3) "")
-					(db:step-get-status step)))
-	      (if (> (string-length (db:step-get-logfile step))
-		     0)
-		  (vector-set! record 5 (db:step-get-logfile step))))
-	     ((end)  
-	      (vector-set! record 2 (any->number (db:step-get-event_time step)))
-	      (vector-set! record 3 (db:step-get-status step))
-	      (vector-set! record 4 (let ((startt (any->number (vector-ref record 1)))
-					  (endt   (any->number (vector-ref record 2))))
-				      (debug:print 4 "record[1]=" (vector-ref record 1) 
-						   ", startt=" startt ", endt=" endt
-						   ", get-status: " (db:step-get-status step))
-				      (if (and (number? startt)(number? endt))
-					  (seconds->hr-min-sec (- endt startt)) "-1")))
-	      (if (> (string-length (db:step-get-logfile step))
-		     0)
-		  (vector-set! record 5 (db:step-get-logfile step))))
-	     (else
-	      (vector-set! record 2 (db:step-get-state step))
-	      (vector-set! record 3 (db:step-get-status step))
-	      (vector-set! record 4 (db:step-get-event_time step))))
-	   (hash-table-set! res (db:step-get-stepname step) record)
-	   (debug:print 6 "record(after)  = " record 
-			"\nid:       " (db:step-get-id step)
-			"\nstepname: " (db:step-get-stepname step)
-			"\nstate:    " (db:step-get-state step)
-			"\nstatus:   " (db:step-get-status step)
-			"\ntime:     " (db:step-get-event_time step))))
-       ;; (else   (vector-set! record 1 (db:step-get-event_time step)))
-       (sort steps (lambda (a b)
-		     (cond
-		      ((<   (db:step-get-event_time a)(db:step-get-event_time b)) #t)
-		      ((eq? (db:step-get-event_time a)(db:step-get-event_time b)) 
-		       (<   (db:step-get-id a)        (db:step-get-id b)))
-		      (else #f)))))
-      res)))
-
 ;; get a pretty table to summarize steps
 ;;
 (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
@@ -2139,38 +2047,10 @@
 		      ((eq? (db:step-get-event_time a)(db:step-get-event_time b)) 
 		       (<   (db:step-get-id a)        (db:step-get-id b)))
 		      (else #f)))))
       res)))
 
-(define (db:get-compressed-steps test-id #!key (work-area #f))
-  (if (or (not work-area)
-	  (file-exists? (conc work-area "/testdat.db")))
-      (let* ((comprsteps (open-run-close db:get-steps-table #f test-id work-area: work-area)))
-	(map (lambda (x)
-	       ;; take advantage of the \n on time->string
-	       (vector
-		(vector-ref x 0)
-		(let ((s (vector-ref x 1)))
-		  (if (number? s)(seconds->time-string s) s))
-		(let ((s (vector-ref x 2)))
-		  (if (number? s)(seconds->time-string s) s))
-		(vector-ref x 3)    ;; status
-		(vector-ref x 4)
-		(vector-ref x 5)))  ;; time delta
-	     (sort (hash-table-values comprsteps)
-		   (lambda (a b)
-		     (let ((time-a (vector-ref a 1))
-			   (time-b (vector-ref b 1)))
-		       (if (and (number? time-a)(number? time-b))
-			   (if (< time-a time-b)
-			       #t
-			       (if (eq? time-a time-b)
-				   (string<? (conc (vector-ref a 2))
-					     (conc (vector-ref b 2)))
-				   #f))
-			   (string<? (conc time-a)(conc time-b))))))))
-      '()))
 
 ;;======================================================================
 ;; M I S C   M A N A G E M E N T   I T E M S 
 ;;======================================================================
 

Index: http-transport.scm
==================================================================
--- http-transport.scm
+++ http-transport.scm
@@ -11,11 +11,11 @@
 (require-extension (srfi 18) extras tcp s11n)
 
 (use sqlite3 srfi-1 posix regex regex-case srfi-69 hostinfo md5 message-digest)
 (import (prefix sqlite3 sqlite3:))
 
-(use spiffy uri-common intarweb http-client spiffy-request-vars  uri-common intarweb spiffy-directory-listing)
+(use spiffy uri-common intarweb http-client spiffy-request-vars intarweb spiffy-directory-listing)
 
 ;; Configurations for server
 (tcp-buffer-size 2048)
 (max-connections 2048) 
 
@@ -98,10 +98,17 @@
 			       (if (not db)(set! db (open-db)))
 			       (let* (($   (request-vars source: 'both))
 				      (dat ($ 'dat))
 				      (res #f))
 				 (cond
+				  ((equal? (uri-path (request-uri (current-request)))
+					   '(/ "api"))
+				   (send-response body:    (api:process-request db $) ;; the $ is the request vars proc
+						  headers: '((content-type text/plain)))
+				   (mutex-lock! *heartbeat-mutex*)
+				   (set! *last-db-access* (current-seconds))
+				   (mutex-unlock! *heartbeat-mutex*))
 				  ;; This is the /ctrl path where data is handed to the server and
 				  ;; responses 
 				  ((equal? (uri-path (request-uri (current-request)))
 					   '(/ "ctrl"))
 				   (let* ((packet (db:string->obj dat))
@@ -239,15 +246,79 @@
 	 (let ((match (string-search (regexp "<body>(.*)<.body>") res)))
 	   (debug:print-info 11 "match=" match)
 	   (let ((final (cadr match)))
 	     (debug:print-info 11 "final=" final)
 	     final)))))))
+
+;; Send "cmd" with json payload "params" to serverdat and receive result
+;;
+(define (http-transport:client-api-send-receive serverdat cmd params #!key (numretries 30))
+  (let* ((fullurl    (if (list? serverdat)
+			 (cadddr serverdat) ;; this is the uri for /api
+			 (begin
+			   (debug:print 0 "FATAL ERROR: http-transport:client-send-receive called with no server info")
+			   (exit 1))))
+	 (res        #f))
+    (handle-exceptions
+     exn
+     (begin
+       ;; TODO: Send this output to a log file so it isn't lost when running as daemon
+       (print "ERROR IN http-transport:client-send-receive " ((condition-property-accessor 'exn 'message) exn))
+       (thread-sleep! 2)
+       (if (> numretries 0)
+	   (http-transport:client-api-send-receive serverdat cmd params numretries: (- numretries 1))))
+     (begin
+       (debug:print-info 11 "fullurl=" fullurl "\n")
+       ;; set up the http-client here
+       (max-retry-attempts 5)
+       ;; consider all requests indempotent
+       (retry-request? (lambda (request)
+			 #t))   ;;  		 (thread-sleep! (/ (if (> numretries 100) 100 numretries) 10))
+       ;; (set! numretries (- numretries 1))
+       ;;  		 #t))
+       ;; send the data and get the response
+       ;; extract the needed info from the http data and 
+       ;; process and return it.
+
+       ;; (with-input-from-request "http://localhost/echo-service"
+       ;;                  '((test . "value")) read-string)
+
+       (let* ((send-recieve (lambda ()
+			      (mutex-lock! *http-mutex*)
+			      (set! res (with-input-from-request 
+					 fullurl 
+					 (list (cons 'key "thekey")
+					       (cons 'cmd cmd)
+					       (cons 'params params))
+					 read-string))
+			      (close-all-connections!) 
+			      (mutex-unlock! *http-mutex*)))
+	      (time-out     (lambda ()
+			      (thread-sleep! 45)
+			      (if (not res)
+				  (begin
+				    (debug:print 0 "WARNING: communication with the server timed out.")
+				    (mutex-unlock! *http-mutex*)
+				    (http-transport:client-api-send-receive serverdat cmd params numretries: (- numretries 1))
+				    (if (< numretries 3) ;; on last try just exit
+					(begin
+					  (debug:print 0 "ERROR: communication with the server timed out. Giving up.")
+					  (exit 1)))))))
+	      (th1 (make-thread send-recieve "with-input-from-request"))
+	      (th2 (make-thread time-out     "time out")))
+	 (thread-start! th1)
+	 (thread-start! th2)
+	 (thread-join! th1)
+	 (thread-terminate! th2)
+	 (debug:print-info 11 "got res=" res)
+	 res)))))
 
 (define (http-transport:client-connect iface port)
   (let* ((login-res   #f)
 	 (uri-dat     (make-request method: 'POST uri: (uri-reference (conc "http://" iface ":" port "/ctrl"))))
-	 (serverdat   (list iface port uri-dat)))
+	 (uri-api-dat (make-request method: 'POST uri: (uri-reference (conc "http://" iface ":" port "/api"))))
+	 (serverdat   (list iface port uri-dat uri-api-dat)))
     (set! login-res (client:login serverdat))
     (if (and (not (null? login-res))
 	     (car login-res))
 	(begin
 	  (debug:print-info 2 "Logged in and connected to " iface ":" port)

Index: megatest-version.scm
==================================================================
--- megatest-version.scm
+++ megatest-version.scm
@@ -1,7 +1,7 @@
 ;; Always use two digit decimal
 ;; 1.01, 1.02...1.10,1.11 ... 1.99,2.00..
 
 (declare (unit megatest-version))
 
-(define megatest-version 1.5509)
+(define megatest-version 1.5511)
 

Index: megatest.scm
==================================================================
--- megatest.scm
+++ megatest.scm
@@ -25,10 +25,12 @@
 (declare (uses client))
 (declare (uses tests))
 (declare (uses genexample))
 (declare (uses daemon))
 (declare (uses db))
+(declare (uses mt))
+(declare (uses api))
 
 (define *db* #f) ;; this is only for the repl, do not use in general!!!!
 
 (include "common_records.scm")
 (include "key_records.scm")

Index: mt.scm
==================================================================
--- mt.scm
+++ mt.scm
@@ -43,16 +43,16 @@
 (define (mt:get-runs-by-patt keys runnamepatt targpatt)
   (let loop ((runsdat  (cdb:remote-run db:get-runs-by-patt #f keys runnamepatt targpatt 0 500))
 	     (res      '())
 	     (offset   0)
 	     (limit    500))
-    (print "runsdat: " runsdat)
+    ;; (print "runsdat: " runsdat)
     (let* ((header    (vector-ref runsdat 0))
 	   (runslst   (vector-ref runsdat 1))
 	   (full-list (append res runslst))
 	   (have-more (eq? (length runslst) limit)))
-      (debug:print 0 "header: " header " runslst: " runslst " have-more: " have-more)
+      ;; (debug:print 0 "header: " header " runslst: " runslst " have-more: " have-more)
       (if have-more 
 	  (let ((new-offset (+ offset limit))
 		(next-batch (cdb:remote-run db:get-runs-by-patt #f keys runnamepatt targpatt offset limit)))
 	    (debug:print-info 4 "More than " limit " runs, have " (length full-list) " runs so far.")
 	    (debug:print-info 0 "next-batch: " next-batch)
@@ -85,5 +85,10 @@
 (define (mt:get-prereqs-not-met run-id waitons ref-item-path #!key (mode 'normal))
   (db:get-prereqs-not-met run-id waitons ref-item-path mode: mode))
 
 (define (mt:get-run-stats)
   (cdb:remote-run db:get-run-stats #f))
+
+;;======================================================================
+;;  S T E P S
+;;======================================================================
+

ADDED   rmt.scm
Index: rmt.scm
==================================================================
--- /dev/null
+++ rmt.scm
@@ -0,0 +1,134 @@
+;;======================================================================
+;; Copyright 2006-2013, 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.
+;;======================================================================
+
+(use json)
+
+(declare (unit rmt))
+(declare (uses api))
+(declare (uses tdb))
+(declare (uses http-transport))
+
+;;
+;; THESE ARE ALL CALLED ON THE CLIENT SIDE!!!
+;;
+
+;;======================================================================
+;;  S U P P O R T   F U N C T I O N S
+;;======================================================================
+
+;; cmd is a symbol
+;; vars is a json string encoding the parameters for the call
+;;
+(define (rmt:send-receive cmd params)
+  (case *transport-type* 
+    ((fs)
+     (debug:print 0 "ERROR: Not yet (re)supported")
+     (exit 1))
+    ((http)
+     (let* ((jparams (rmt:dat->json-str params))
+	    (res (http-transport:client-api-send-receive *runremote* cmd jparams)))
+       (if res
+	   (rmt:json-str->dat res)
+	   (begin
+	     (debug:print 0 "ERROR: Bad value from http-transport:client-api-send-receive " res)
+	     #f))
+     ))
+    (else
+     (debug:print 0 "ERROR: Transport not yet (re)supported")
+     (exit 1))))
+
+;; Wrap json library for strings (why the ports crap in the first place?)
+(define (rmt:dat->json-str dat)
+  (with-output-to-string 
+    (lambda ()
+      (json-write dat))))
+
+(define (rmt:json-str->dat json-str)
+  (with-input-from-string json-str
+    (lambda ()
+      (json-read))))
+
+;;======================================================================
+;;
+;; A C T U A L   A P I   C A L L S  
+;;
+;;======================================================================
+
+;;======================================================================
+;;  K E Y S 
+;;======================================================================
+
+(define (rmt:get-key-val-pairs run-id)
+  (rmt:send-receive 'get-key-val-pairs (list run-id)))
+
+;;======================================================================
+;;  T E S T S
+;;======================================================================
+
+(define (rmt:get-test-info-by-id test-id)
+  (list->vector
+   (rmt:send-receive 'get-test-info-by-id (list test-id))))
+
+(define (rmt:test-get-rundir-from-test-id test-id)
+  (rmt:send-receive 'test-get-rundir-from-test-id (list test-id)))
+
+(define (rmt:open-test-db-by-test-id test-id #!key (work-area #f))
+  (let* ((test-path (if (string? work-area)
+			work-area
+			(rmt:test-get-rundir-from-test-id test-id))))
+    (debug:print 3 "TEST PATH: " test-path)
+    (open-test-db test-path)))
+
+(define (rmt:testmeta-get-record testname)
+  (list->vector
+   (rmt:send-receive 'testmeta-get-record (list testname))))
+
+;; WARNING: This currently bypasses the transaction wrapped writes system
+(define (rmt:test-set-state-status-by-id test-id newstate newstatus newcomment)
+  (rmt:send-receive 'test-set-state-status-by-id (list test-id newstate newstatus newcomment)))
+
+;;======================================================================
+;;  R U N S
+;;======================================================================
+
+(define (rmt:get-run-info run-id)
+  (let ((res (rmt:send-receive 'get-run-info (list run-id))))
+    (vector (car res)
+	    (list->vector (cadr res)))))
+
+;;======================================================================
+;;  S T E P S
+;;======================================================================
+
+;; Getting steps is more complicated.
+;;
+;; If given work area 
+;;  1. Find the testdat.db file
+;;  2. Open the testdat.db file and do the query
+;; If not given the work area
+;;  1. Do a remote call to get the test path
+;;  2. Continue as above
+;; 
+(define (rmt:get-steps-for-test test-id #!key (work-area #f))
+  (let* ((tdb (rmt:open-test-db-by-test-id test-id work-area: work-area)))
+    (if tdb
+	(tdb:get-steps-data tdb test-id)
+	'())))
+
+;;======================================================================
+;;  T E S T   D A T A 
+;;======================================================================
+
+(define (rmt:read-test-data test-id categorypatt #!key (work-area #f)) 
+  (let ((tdb  (rmt:open-test-db-by-test-id test-id work-area: work-area)))
+    (if tdb
+	(tdb:read-test-data tdb test-id categorypatt)
+	'())))

ADDED   rmtdb.scm
Index: rmtdb.scm
==================================================================
--- /dev/null
+++ rmtdb.scm
@@ -0,0 +1,11 @@
+;;======================================================================
+;; Copyright 2006-2013, 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.
+;;======================================================================
+

Index: runs.scm
==================================================================
--- runs.scm
+++ runs.scm
@@ -908,10 +908,34 @@
   (let ((dparts  (string-split dir "/"))
 	(count   (if (null? params) 1 (car params))))
     (conc "/" (string-intersperse 
 	       (take dparts (- (length dparts) count))
 	       "/"))))
+
+(define (runs:recursive-delete-with-error-msg real-dir)
+  (if (> (system (conc "rm -rf " real-dir)) 0)
+      (debug:print 0 "ERROR: There was a problem removing " real-dir " with rm -f")))
+
+(define (runs:safe-delete-test-dir real-dir)
+  ;; first delete all sub-directories
+  (directory-fold 
+   (lambda (f x)
+     (let ((fullname (conc real-dir "/" f)))
+       (if (directory? fullname)(runs:recursive-delete-with-error-msg fullname)))
+     (+ 1 x))
+   0 real-dir)
+  ;; then files other than *testdat.db*
+  (directory-fold 
+   (lambda (f x)
+     (let ((fullname (conc real-dir "/" f)))
+       (if (not (string-search (regexp "testdat.db") f))
+	   (runs:recursive-delete-with-error-msg fullname)))
+     (+ 1 x))
+   0 real-dir)
+  ;; then the entire directory
+  (runs:recursive-delete-with-error-msg real-dir))
+
 ;; Remove runs
 ;; fields are passing in through 
 ;; action:
 ;;    'remove-runs
 ;;    'set-state-status
@@ -989,11 +1013,13 @@
 			     ((remove-runs)
 			      (debug:print-info 0 "test: " test-name " itest-state: " test-state)
 			      (if (member test-state (list "RUNNING" "LAUNCHED" "REMOTEHOSTSTART" "KILLREQ"))
 				  (begin
 				    (if (not (hash-table-ref/default test-retry-time test-fulln #f))
-					(hash-table-set! test-retry-time test-fulln (current-seconds)))
+					(begin
+					  ;; want to set to REMOVING BUT CANNOT do it here?
+					  (hash-table-set! test-retry-time test-fulln (current-seconds))))
 				    (if (> (- (current-seconds)(hash-table-ref test-retry-time test-fulln)) allow-run-time)
 				      ;; This test is not in a correct state for cleaning up. Let's try some graceful shutdown steps first
 				      ;; Set the test to "KILLREQ" and wait five seconds then try again. Repeat up to five times then give
 				      ;; up and blow it away.
 				      (begin
@@ -1006,20 +1032,19 @@
 				    ;; NOTE: This is suboptimal as the testdata will be used later and the state/status may have changed ...
 				    (if (null? tal)
 					(loop new-test-dat tal)
 					(loop (car tal)(append tal (list new-test-dat)))))
 				  (begin
-				    (cdb:remote-run db:delete-test-records db #f (db:test-get-id test))
+				    (cdb:remote-run db:test-set-state-status-by-id db (db:test-get-id test) "REMOVING" "LOCKED" #f)
 				    (debug:print-info 1 "Attempting to remove " (if real-dir (conc " dir " real-dir " and ") "") " link " run-dir)
 				    (if (and real-dir 
 					     (> (string-length real-dir) 5)
 					     (file-exists? real-dir)) ;; bad heuristic but should prevent /tmp /home etc.
 					(begin ;; let* ((realpath (resolve-pathname run-dir)))
 					  (debug:print-info 1 "Recursively removing " real-dir)
 					  (if (file-exists? real-dir)
-					      (if (> (system (conc "rm -rf " real-dir)) 0)
-						  (debug:print 0 "ERROR: There was a problem removing " real-dir " with rm -f"))
+					      (runs:safe-delete-test-dir real-dir)
 					      (debug:print 0 "WARNING: test dir " real-dir " appears to not exist or is not readable")))
 					(if real-dir 
 					    (debug:print 0 "WARNING: directory " real-dir " does not exist")
 					    (debug:print 0 "WARNING: no real directory corrosponding to link " run-dir ", nothing done")))
 				    (if (symbolic-link? run-dir)
@@ -1038,10 +1063,12 @@
 						 (delete-directory run-dir)))
 					    (if run-dir
 						(debug:print 0 "WARNING: not removing " run-dir " as it either doesn't exist or is not a symlink")
 						(debug:print 0 "NOTE: the run dir for this test is undefined. Test may have already been deleted."))
 					    ))
+				    ;; Only delete the records *after* removing the directory. If things fail we have a record 
+				    (cdb:remote-run db:delete-test-records db #f (db:test-get-id test))
 				    (if (not (null? tal))
 					(loop (car tal)(cdr tal))))))
 			     ((set-state-status)
 			      (debug:print-info 2 "new state " (car state-status) ", new status " (cadr state-status))
 			      (cdb:remote-run db:test-set-state-status-by-id db (db:test-get-id test) (car state-status)(cadr state-status) #f)

ADDED   tdb.scm
Index: tdb.scm
==================================================================
--- /dev/null
+++ tdb.scm
@@ -0,0 +1,64 @@
+;;======================================================================
+;; Copyright 2006-2013, 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.
+;;======================================================================
+
+;;======================================================================
+;; Database access
+;;======================================================================
+
+(require-extension (srfi 18) extras tcp) ;;  rpc)
+;; (import (prefix rpc rpc:))
+
+(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)
+
+(declare (unit tdb))
+(declare (uses common))
+(declare (uses keys))
+(declare (uses ods))
+(declare (uses fs-transport))
+(declare (uses client))
+(declare (uses mt))
+
+(include "common_records.scm")
+(include "db_records.scm")
+(include "key_records.scm")
+(include "run_records.scm")
+
+;;======================================================================
+;;
+;; T E S T   D A T A B A S E S
+;;
+;;======================================================================
+
+(define (tdb:get-steps-data tdb test-id)
+  (let ((res '()))
+    (sqlite3:for-each-row 
+     (lambda (id test-id stepname state status event-time logfile)
+       (set! res (cons (vector id test-id stepname state status event-time (if (string? logfile) logfile "")) res)))
+     tdb
+     "SELECT id,test_id,stepname,state,status,event_time,logfile FROM test_steps WHERE test_id=? ORDER BY id ASC;" ;; event_time DESC,id ASC;
+     test-id)
+    (sqlite3:finalize! tdb)
+    (reverse res)))
+
+(define (tdb:read-test-data tdb test-id categorypatt)
+  (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)))
+     tdb
+     "SELECT id,test_id,category,variable,value,expected,tol,units,comment,status,type FROM test_data WHERE test_id=? AND category LIKE ? ORDER BY category,variable;" test-id categorypatt)
+    (sqlite3:finalize! tdb)
+    (reverse res)))