Index: Makefile
==================================================================
--- Makefile
+++ Makefile
@@ -6,11 +6,13 @@
            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 ezsteps.scm lock-queue.scm filedb.scm
+	   tree.scm ezsteps.scm lock-queue.scm filedb.scm \
+	   rmt.scm api.scm tdb.scm \
+	   ezsteps.scm lock-queue.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))
 (declare (uses ezsteps))
 
 (include "common_records.scm")
 (include "db_records.scm")
 (include "run_records.scm")
@@ -208,21 +209,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 db 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 db test-id state #f #f)
+								    (rmt:test-set-state-status-by-id test-id state #f #f)
 								    (db:test-set-state! testdat state)))))
 				    btn))
 				*common:std-states*))) ;; (list "COMPLETED" "NOT_STARTED" "RUNNING" "REMOTEHOSTSTART" "LAUNCHED" "KILLED" "KILLREQ"))))
 	       (vector-set! *state-status* 0
 			    (lambda (state color)
@@ -238,11 +239,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 db test-id #f status #f)
+								    (rmt:test-set-state-status-by-id test-id #f status #f)
 								    (db:test-set-status! testdat status)))))
 				    btn))
 				*common:std-statuses*))) ;; (list  "PASS" "WARN" "FAIL" "CHECK" "n/a" "WAIVED" "SKIP"))))
 	       (vector-set! *state-status* 1
 			    (lambda (status color)
@@ -286,16 +287,105 @@
     ;; (iup:button "Refresh test data"
     ;;     	#:expand "HORIZONTAL"
     ;;     	#:action (lambda (obj)
     ;;     		   (print "Refresh test data " stepname))
     )))
+;; 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* ((db-path       (conc *toppath* "/megatest.db"))
+  (let* ((testdat       (rmt:get-test-info-by-id test-id))
 	 (db            (open-db))
 	 (testdat       (open-run-close db:get-test-info-by-id db test-id))
 	 (db-mod-time   0) ;; (file-modification-time db-path))
 	 (last-update   0) ;; (current-seconds))
 	 (request-update #t))
@@ -302,25 +392,25 @@
     (if (not testdat)
 	(begin
 	  (debug:print 2 "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 db run-id) #f))
-	       (rundat        (if testdat (open-run-close db:get-run-info db 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)
 	       (testdat-path  (conc rundir "/testdat.db")) ;; this gets recalculated until found 
-	       (teststeps     (if testdat (db:get-compressed-steps test-id work-area: rundir) '()))
+	       (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 db testname)))
+				  (let ((tm (rmt:testmeta-get-record testname)))
 				    (if tm tm (make-db:testmeta)))
 				  (make-db:testmeta)))
 
 	       (keystring  (string-intersperse 
 			    (map (lambda (keyval)
@@ -362,16 +452,17 @@
 						       (> (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 db 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    "))
 				 (if (eq? curr-mod-time db-mod-time) ;; do only once if same
@@ -536,22 +627,22 @@
 					 ;; (iup:attribute-set! steps-matrix "FIXTOTEXT" "C1")
 					 (iup:attribute-set! steps-matrix "RESIZEMATRIX" "YES")
 					 (let ((proc
 						(lambda (testdat)
 						  (let ((max-row 0))
-						  (if (not (null? teststeps))
-						      (let loop ((hed    (car teststeps))
-								 (tal    (cdr teststeps))
-								 (rownum 1)
-								 (colnum 1))
+						    (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))
+							  (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))
@@ -603,11 +694,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 db 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)

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*)

Index: db.scm
==================================================================
--- db.scm
+++ db.scm
@@ -745,12 +745,12 @@
     (reverse res)))
 
 ;; get key vals for a given run-id
 (define (db:get-key-vals dbstruct run-id)
   (let ((mykeyvals (hash-table-ref/default *keyvals* run-id #f)))
-    (if mykeyvals 
-	mykeyvals
+     (if mykeyvals 
+	 mykeyvals
 	(let* ((keys (db:get-keys dbstruct))
 	       (res  '()))
 	  (for-each 
 	   (lambda (key)
 	     (let ((qry (conc "SELECT " key " FROM runs WHERE id=?;")))
@@ -757,13 +757,13 @@
 	       (sqlite3:for-each-row 
 		(lambda (key-val)
 		  (set! res (cons key-val res)))
 		(db:get-db dbstruct #f) qry run-id)))
 	   keys)
-	  (let ((final-res (reverse res)))
-	    (hash-table-set! *keyvals* run-id final-res)
-	    final-res)))))
+	   (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 dbstruct run-id)
   (let ((mytarg (hash-table-ref/default *target* run-id #f)))
     (if mytarg
@@ -985,11 +985,12 @@
       (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))))
-    (mt:process-triggers run-id test-id newstate newstatus)))
+  (db:process-triggers test-id newstate newstatus)
+  #t) ;; retrun something to keep the remote calls happy
 
 ;; Never used
 ;; (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))
@@ -1366,10 +1367,12 @@
       (sqlite3:execute (db:get-db dbstruct run-id) 'state-status-msg state status msg-id test-id)
       (sqlite3:execute (db:get-db dbstruct run-id) 'state-status state status test-id)))
 
 (define (db:test-rollup-test_data-pass-fail dbstruct run-id test-id)
   (sqlite3:execute (db:get-db dbstruct run-id) 'test_data-pf-rollup test-id test-id test-id test-id))
+;;   (cdb:client-call serverdat 'set-test-start-time #t *default-numtries* test-id))
+
 
 (define (db:pass-fail-counts dbstruct run-id test-id fail-count pass-count)
   (sqlite3:execute (db:get-db dbstruct run-id) 'pass-fail-counts fail-count pass-count test-id))
 
 (define (db:tests-register-test dbstruct run-id test-name item-path)
@@ -1780,20 +1783,18 @@
 		      ", expected: " expected " tol: " tol " units: " units " status: " status " comment: " comment)
 	 (sqlite3:execute (db:get-db dbstruct run-id) "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)))
 
-;; get a list of test_data records matching categorypatt
 (define (db:read-test-data dbstruct run-id 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)))
      (db:get-db dbstruct run-id)
      "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)
     (reverse res)))
-
 ;; NOTE: Run this local with #f for db !!!
 (define (db:load-test-data dbstruct run-id test-id)
   (let loop ((lin (read-line)))
     (if (not (eof-object? lin))
 	(begin
@@ -1835,11 +1836,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 dbstruct run-id test-id)
   (let ((res '()))
 
     (sqlite3:for-each-row 
      (lambda (id test-id stepname state status event-time logfile)
@@ -1846,71 +1846,12 @@
        (set! res (cons (vector id test-id stepname state status event-time (if (string? logfile) logfile "")) res)))
      (db:get-db dbstruct run-id)
      "SELECT id,test_id,stepname,state,status,event_time,logfile_id FROM test_steps WHERE test_id=? ORDER BY id ASC;" ;; event_time DESC,id ASC;
      test-id)
     (reverse res)))
-
-;; get a pretty table to summarize steps
-;;
 (define (db:get-steps-table dbstruct run-id test-id)
   (let ((steps   (db:get-steps-for-test dbstruct run-id test-id)))
-    ;; 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 dbstruct run-id test-id #!key (work-area #f))
 ;;   (let ((steps   (db:get-steps-for-test dbstruct run-id test-id)))
 ;;     ;; organise the steps for better readability

Index: http-transport.scm
==================================================================
--- http-transport.scm
+++ http-transport.scm
@@ -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))
@@ -174,10 +181,52 @@
 ;;======================================================================
 ;; C L I E N T S
 ;;======================================================================
 
 (define *http-mutex* (make-mutex))
+(define *http-requests-in-progress* 0)
+(define *http-connections-next-cleanup* (current-seconds))
+
+(define (http-transport:get-time-to-cleanup)
+  (let ((res #f))
+    (mutex-lock! *http-mutex*)
+    (set! res (> (current-seconds) *http-connections-next-cleanup*))
+    (mutex-unlock! *http-mutex*)
+    res))
+
+(define (http-transport:inc-requests-count)
+  (mutex-lock! *http-mutex*)
+  (set! *http-requests-in-progress* (+ 1 *http-requests-in-progress*))
+  ;; Use this opportunity to slow things down iff there are too many requests in flight
+  (if (> *http-requests-in-progress* 5)
+      (begin
+	(debug:print-info 0 "Whoa there buddy, ease up...")
+	(thread-sleep! 1)))
+  (mutex-unlock! *http-mutex*))
+
+(define (http-transport:dec-requests-count proc) 
+  (mutex-lock! *http-mutex*)
+  (proc)
+  (set! *http-requests-in-progress* (- *http-requests-in-progress* 1))
+  (mutex-unlock! *http-mutex*))
+
+(define (http-transport:dec-requests-count-and-close-all-connections)
+  (set! *http-requests-in-progress* (- *http-requests-in-progress* 1))
+  (let loop ((etime (+ (current-seconds) 5))) ;; give up in five seconds
+    (if (> *http-requests-in-progress* 0)
+	(if (> etime (current-seconds))
+	    (begin
+	      (thread-sleep! 0.05)
+	      (loop etime))
+	    (debug:print 0 "ERROR: requests still in progress after 5 seconds of waiting. I'm going to pass on cleaning up http connections"))
+	(close-all-connections!)))
+  (set! *http-connections-next-cleanup* (+ (current-seconds) 10))
+  (mutex-unlock! *http-mutex*))
+
+(define (http-transport:inc-requests-and-prep-to-close-all-connections)
+  (mutex-lock! *http-mutex*)
+  (set! *http-requests-in-progress* (+ 1 *http-requests-in-progress*)))
 
 ;; (system "megatest -list-servers | grep alive || megatest -server - -daemonize && sleep 4")
 
 ;; <html>
 ;; <head></head>
@@ -209,17 +258,34 @@
        ;;  		 #t))
        ;; send the data and get the response
        ;; extract the needed info from the http data and 
        ;; process and return it.
        (let* ((send-recieve (lambda ()
-			      (mutex-lock! *http-mutex*)
-			      (set! res (with-input-from-request 
-					 fullurl 
-					 (list (cons 'dat msg)) 
-					 read-string))
-			      (close-all-connections!) 
-			      (mutex-unlock! *http-mutex*)))
+			      ;; (let ((dat #f)
+			      ;;       (cleanup (http-transport:get-time-to-cleanup)))
+			      ;;   (if cleanup 
+			      ;;       (begin
+			      ;;         (debug:print-info 0 "Running cleanup mode")
+			      ;;         (http-transport:inc-requests-and-prep-to-close-all-connections))
+			      ;;       (http-transport:inc-requests-count))
+			      ;;   ;; Do the actual data transfer
+			      (mutex-lock! *http-mutex*) ;; Hypothesis is that this was *not* the bottleneck
+			      (set! res (with-input-from-request ;; was set! dat
+					   fullurl 
+					   (list (cons 'dat msg)) 
+					   read-string))
+			      (close-all-connections!)
+			      (mutex-unlock! *http-mutex*)
+			      ))
+			      ;;(if cleanup
+			      ;;      ;; mutex already set
+			      ;;      (begin
+			      ;;        (set! res dat)
+			      ;;        (http-transport:dec-requests-count-and-close-all-connections))
+			      ;;      (http-transport:dec-requests-count
+			      ;;       (lambda ()
+			      ;;         (set! res dat)))))))
 	      (time-out     (lambda ()
 			      (thread-sleep! 45)
 			      (if (not res)
 				  (begin
 				    (debug:print 0 "WARNING: communication with the server timed out.")
@@ -239,15 +305,95 @@
 	 (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 ()
+			;;       (let ((dat #f)
+			;; 	    (cleanup (http-transport:get-time-to-cleanup)))
+			;; 	(if cleanup 
+			;; 	    (http-transport:inc-requests-and-prep-to-close-all-connections)
+			;; 	    (http-transport:inc-requests-count))
+			;; 	;; Do the actual data transfer NB// KEPP THIS IN SYNC WITH http-transport:client-send-receive
+				 (mutex-lock! *http-mutex*)
+				 (set! res (with-input-from-request ;; was dat
+					   fullurl 
+					   (list (cons 'key "thekey")
+						 (cons 'cmd cmd)
+						 (cons 'params params))
+					   read-string))
+				 ;; Shouldn't this be a call to the managed call-all-connections stuff above?
+				(close-all-connections!)
+				(mutex-unlock! *http-mutex*)
+				))
+	                          ;; (if cleanup
+				  ;;   ;; mutex already set
+				  ;;   (begin
+				  ;;     (set! res dat)
+				  ;;     (http-transport:dec-requests-count-and-close-all-connections))
+				  ;;   (http-transport:dec-requests-count
+				  ;;    (lambda ()
+				  ;;      (set! res dat)))))))
+	      (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: launch.scm
==================================================================
--- launch.scm
+++ launch.scm
@@ -141,10 +141,11 @@
 
 	  ;; (tests:test-set-status! test-id "REMOTEHOSTSTART" "n/a" (args:get-arg "-m") #f)
 	  (tests:test-force-state-status! test-id "REMOTEHOSTSTART" "n/a")
 	  (thread-sleep! 0.3) ;; NFS slowness has caused grief here
 
+	  ;; (cdb:set-test-start-time!  *runremote* test-id)
 	  (if (args:get-arg "-xterm")
 	      (set! fullrunscript "xterm")
 	      (if (and fullrunscript (not (file-execute-access? fullrunscript)))
 		  (system (conc "chmod ug+x " fullrunscript))))
 	  ;; We are about to actually kick off the test
@@ -700,10 +701,11 @@
     ;; clean out step records from previous run if they exist
     ;; (debug:print-info 4 "FIXMEEEEE!!!! This can be removed some day, perhaps move all test records to the test db?")
     ;; (open-run-close db:delete-test-step-records db test-id)
     (change-directory work-area) ;; so that log files from the launch process don't clutter the test dir
     (tests:test-set-status! test-id "LAUNCHED" "n/a" #f #f) ;; (if launch-results launch-results "FAILED"))
+    ;; (cdb:set-test-start-time!  *runremote* test-id)
     (cond
      ((and launcher hosts) ;; must be using ssh hostname
       (set! fullcmd (append launcher (car hosts)(list remote-megatest test-sig "-execute" cmdparms) debug-param)))
      ;; (set! fullcmd (append launcher (car hosts)(list remote-megatest test-sig "-execute" cmdparms))))
      (launcher

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")

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.
+;;======================================================================
+

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)))