Index: common.scm
==================================================================
--- common.scm
+++ common.scm
@@ -65,12 +65,10 @@
 (define *toptest-paths*     (make-hash-table)) ;; cache toptest path settings here
 (define *test-paths*        (make-hash-table)) ;; cache test-id to test run paths here
 (define *test-ids*          (make-hash-table)) ;; cache run-id, testname, and item-path => test-id
 (define *test-info*         (make-hash-table)) ;; cache the test info records, update the state, status, run_duration etc. from testdat.db
 
-(define *run-info-cache*    (make-hash-table)) ;; run info is stable, no need to reget
-
 ;; Awful. Please FIXME
 (define *env-vars-by-run-id* (make-hash-table))
 (define *current-run-name*   #f)
 
 (define (common:clear-caches)
@@ -79,11 +77,10 @@
   (set! *keyvals*            (make-hash-table))
   (set! *toptest-paths*      (make-hash-table))
   (set! *test-paths*         (make-hash-table))
   (set! *test-ids*           (make-hash-table))
   (set! *test-info*          (make-hash-table))
-  (set! *run-info-cache*     (make-hash-table))
   (set! *env-vars-by-run-id* (make-hash-table))
   (set! *test-id-cache*      (make-hash-table)))
 
 ;; Debugging stuff
 (define *verbosity*         1)

Index: db.scm
==================================================================
--- db.scm
+++ db.scm
@@ -898,10 +898,11 @@
 (define (db:delete-tests-for-run db run-id)
   (common:clear-caches)
   (sqlite3:execute db "DELETE FROM tests WHERE run_id=?;" run-id))
 
 (define (db:delete-old-deleted-test-records db)
+  (common:clear-caches)
   (let ((targtime (- (current-seconds)(* 30 24 60 60)))) ;; one month in the past
     (sqlite3:execute db "DELETE FROM tests WHERE state='DELETED' AND event_time<?;" targtime)))
 
 ;; set tests with state currstate and status currstatus to newstate and newstatus
 ;; use currstate = #f and or currstatus = #f to apply to any state or status respectively
@@ -937,10 +938,11 @@
 		 (lambda (th)
 		   (if th (thread-join! th)))
 		 thr)))))))
 
 (define (cdb:delete-tests-in-state serverdat run-id state)
+  (common:clear-caches)
   (cdb:client-call serverdat 'delete-tests-in-state #t *default-numtries* run-id state))
 
 (define (cdb:tests-update-cpuload-diskfree serverdat test-id cpuload diskfree)
   (cdb:client-call serverdat 'update-cpuload-diskfree #t *default-numtries* cpuload diskfree test-id))
 
@@ -972,10 +974,19 @@
      (lambda (count)
        (set! res count))
      db
      "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART');")
     res))
+
+(define (db:get-running-stats db)
+  (let ((res '()))
+    (sqlite3:for-each-row
+     (lambda (state count)
+       (set! res (cons (list state count) res)))
+     db
+     "SELECT state,count(id) FROM tests GROUP BY state ORDER BY id DESC;")
+    res))
 
 (define (db:get-count-tests-running-in-jobgroup db jobgroup)
   (if (not jobgroup)
       0 ;; 
       (let ((res 0))

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)
+(use spiffy uri-common intarweb http-client spiffy-request-vars  uri-common intarweb spiffy-directory-listing)
 
 ;; Configurations for server
 (tcp-buffer-size 2048)
 (max-connections 2048) 
 
@@ -87,24 +87,21 @@
 	 (link-tree-path (config-lookup *configdat* "setup" "linktree")))
     (set! *cache-on* #t)
     (root-path     (if link-tree-path 
 		       link-tree-path
 		       (current-directory))) ;; WARNING: SECURITY HOLE. FIX ASAP!
-
+    (handle-directory spiffy-directory-listing)
+    ;; http-transport:handle-directory) ;; simple-directory-handler)
     ;; Setup the web server and a /ctrl interface
     ;;
     (vhost-map `(((* any) . ,(lambda (continue)
 			       ;; open the db on the first call 
 			       (if (not db)(set! db (open-db)))
 			       (let* (($   (request-vars source: 'both))
 				      (dat ($ 'dat))
 				      (res #f))
 				 (cond
-				  ((equal? (uri-path (request-uri (current-request))) 
-					   '(/ "hey"))
-				   (send-response body: "hey there!\n"
-						  headers: '((content-type text/plain))))
 				  ;; 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))
@@ -122,10 +119,24 @@
 				     (debug:print-info 11 "Return value from db:process-queue-item is " res)
 				     (send-response body: (conc "<head>ctrl data</head>\n<body>"
 								res
 								"</body>")
 						    headers: '((content-type text/plain)))))
+				  ((equal? (uri-path (request-uri (current-request))) 
+					   '(/ ""))
+				   (send-response body: (http-transport:main-page)))
+				  ((equal? (uri-path (request-uri (current-request))) 
+					   '(/ "runs"))
+				   (send-response body: (http-transport:main-page)))
+				  ((equal? (uri-path (request-uri (current-request))) 
+					   '(/ any))
+				   (send-response body: "hey there!\n"
+						  headers: '((content-type text/plain))))
+				  ((equal? (uri-path (request-uri (current-request))) 
+					   '(/ "hey"))
+				   (send-response body: "hey there!\n"
+						  headers: '((content-type text/plain))))
 				  (else (continue))))))))
     (http-transport:try-start-server ipaddrstr start-port)))
 
 ;; This is recursively run by http-transport:run until sucessful
 ;;
@@ -400,5 +411,64 @@
 			     (exit 4))
 			   "exit on ^C timer")))
      (thread-start! th2)
      (thread-start! th1)
      (thread-join! th2))))
+
+;;======================================================================
+;; web pages
+;;======================================================================
+
+(define (http-transport:main-page)
+  (let ((linkpath (root-path)))
+    (conc "<head><h1>" (pathname-strip-directory *toppath*) "</h1></head>"
+	  "<body>"
+	  "Run area: " *toppath*
+	  "<h2>Server Stats</h2>"
+	  (http-transport:stats-table) 
+	  "<hr>"
+	  (http-transport:runs linkpath)
+	  "<hr>"
+	  (http-transport:run-stats)
+	  "</body>"
+	  )))
+
+(define (http-transport:stats-table)
+  (mutex-lock! *heartbeat-mutex*)
+  (let ((res 
+	 (conc "<table>"
+	       "<tr><td>Max cached queries</td>        <td>" *max-cache-size* "</td></tr>"
+	       "<tr><td>Number of cached writes</td>   <td>" *number-of-writes* "</td></tr>"
+	       "<tr><td>Average cached write time</td> <td>" (if (eq? *number-of-writes* 0)
+								 "n/a (no writes)"
+								 (/ *writes-total-delay*
+								    *number-of-writes*))
+	       " ms</td></tr>"
+	       "<tr><td>Number non-cached queries</td> <td>"  *number-non-write-queries* "</td></tr>"
+	       "<tr><td>Average non-cached time</td>   <td>" (if (eq? *number-non-write-queries* 0)
+								 "n/a (no queries)"
+								 (/ *total-non-write-delay* 
+								    *number-non-write-queries*))
+	       " ms</td></tr>"
+	       "<tr><td>Last access</td><td>"              (seconds->time-string *last-db-access*) "</td></tr>"
+	       "</table>")))
+    (mutex-unlock! *heartbeat-mutex*)
+    res))
+
+(define (http-transport:runs linkpath)
+  (conc "<h3>Runs</h3>"
+	(string-intersperse
+	 (let ((files (map pathname-strip-directory (glob (conc linkpath "/*")))))
+	   (map (lambda (p)
+		  (conc "<a href=\"" p "\">" p "</a><br>"))
+		files))
+	 " ")))
+
+(define (http-transport:run-stats)
+  (let ((stats (open-run-close db:get-running-stats #f)))
+    (conc "<table>"
+	  (string-intersperse
+	   (map (lambda (stat)
+		  (conc "<tr><td>" (car stat) "</td><td>" (cadr stat) "</td></tr>"))
+		stats)
+	   " ")
+	  "</table>")))

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.5427)
+(define megatest-version 1.5429)