Index: dashboard.scm
==================================================================
--- dashboard.scm
+++ dashboard.scm
@@ -16,11 +16,10 @@
 (use canvas-draw)
 (import canvas-draw-iup)
 
 (use sqlite3 srfi-1 posix regex regex-case srfi-69)
 (import (prefix sqlite3 sqlite3:))
-(use trace)
 
 (declare (uses common))
 (declare (uses margs))
 (declare (uses keys))
 (declare (uses items))

ADDED   datashare-testing/.datashare.config
Index: datashare-testing/.datashare.config
==================================================================
--- /dev/null
+++ datashare-testing/.datashare.config
@@ -0,0 +1,4 @@
+[datastores]
+1 eng /tmp/datastore/eng
+
+

ADDED   datashare.scm
Index: datashare.scm
==================================================================
--- /dev/null
+++ datashare.scm
@@ -0,0 +1,199 @@
+
+;; 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 ssax)
+(use sxml-serializer)
+(use sxml-modifications)
+(use regex)
+(use srfi-69)
+(use regex-case)
+(use posix)
+(use json)
+(use csv)
+(use srfi-18)
+(use format)
+
+(require-library iup)
+(import (prefix iup iup:))
+(require-library ini-file)
+(import (prefix ini-file ini:))
+
+(use canvas-draw)
+(import canvas-draw-iup)
+
+(use sqlite3 srfi-1 posix regex regex-case srfi-69)
+(import (prefix sqlite3 sqlite3:))
+
+(include "megatest-fossil-hash.scm")
+
+;;
+;; GLOBALS
+;;
+(define *datashare:current-tab-number* 0)
+(define datashare:help (conc "Usage: datashare [action [params ...]]
+
+Note: run datashare without parameters to start the gui.
+
+  publish <area> <key> [group]        : Publish data to share, use group to protect (i)
+  get <area> <key> [destpath]         : Get a link to data, put the link in destpath (ii)
+  update <area> <key>                 : Update the link to data to the latest iteration.
+
+(i)  Uses group ownership of files to be published for group if not specified
+(ii) Uses local path or looks up script to find path in configs
+
+Part of the Megatest tool suite. Learn more at http://www.kiatoa.com/fossils/megatest
+
+Version: " megatest-fossil-hash)) ;; "
+
+;;======================================================================
+;; DB
+;;======================================================================
+
+(define (datashare:initialize-db db)
+  (for-each
+   (lambda (qry)
+     (sqlite3:execute db qry))
+   (list 
+    "CREATE TABLE pkgs 
+         (id        INTEGER PRIMARY KEY,
+          area      TEXT,
+          key       TEXT,
+          iteration INTEGER,
+          submitter TEXT,
+          datetime  TEXT,
+          storegrp  TEXT,
+          disk_id   INTEGER,
+          comment   TEXT);"
+    "CREATE TABLE refs
+         (id        INTEGER PRIMARY KEY,
+          pkg_id    INTEGER,
+          destlink  TEXT);"
+    "CREATE TABLE disks
+         (id         INTEGER PRIMARY KEY,
+          storegrp   TEXT,
+          path       TEXT);")))
+
+;; Create the sqlite db
+(define (datashare:open-db path) 
+  (if (and path
+	   (directory? path)
+	   (file-read-access? path))
+      (let* ((dbpath    (conc path "/datashare.db"))
+	     (writeable (file-write-access? dbpath))
+	     (dbexists  (file-exists? dbpath))
+	     (handler   (make-busy-timeout 136000)))
+	(handle-exceptions
+	 exn
+	 (begin
+	   (debug:print 2 "ERROR: problem accessing db " dbpath
+			((condition-property-accessor 'exn 'message) exn))
+	   (exit))
+	 (set! db (sqlite3:open-database dbpath)))
+	(if *db-write-access* (sqlite3:set-busy-handler! db handler))
+	(if (not dbexists)
+	    (begin
+	      (datashare:initialize-db db)))
+	db)))
+
+;;======================================================================
+;; GUI
+;;======================================================================
+
+;; The main menu 
+(define (datashare:main-menu)
+  (iup:menu ;; a menu is a special attribute to a dialog (think Gnome putting the menu at screen top)
+   (iup:menu-item "Files" (iup:menu   ;; Note that you can use either #:action or action: for options
+		       (iup:menu-item "Open"  action: (lambda (obj)
+							(iup:show (iup:file-dialog))
+							(print "File->open " obj)))
+		       (iup:menu-item "Save"  #:action (lambda (obj)(print "File->save " obj)))
+		       (iup:menu-item "Exit"  #:action (lambda (obj)(exit)))))
+   (iup:menu-item "Tools" (iup:menu
+		       (iup:menu-item "Create new blah" #:action (lambda (obj)(print "Tools->new blah")))
+		       ;; (iup:menu-item "Show dialog"     #:action (lambda (obj)
+		       ;;  					   (show message-window
+		       ;;  					     #:modal? #t
+		       ;;  					     ;; set positon using coordinates or center, start, top, left, end, bottom, right, parent-center, current
+		       ;;  					     ;; #:x 'mouse
+		       ;;  					     ;; #:y 'mouse
+		       ;;  )					     
+		       ))))
+
+(define (datashare:publish-view)
+  (iup:vbox
+   (iup:hbox 
+    (iup:button "Pushme" 
+		#:expand "YES"
+		))))
+
+(define (datashare:get-view)
+  (iup:vbox
+   (iup:hbox 
+    (iup:button "Pushme"
+		#:expand "YES"
+		))))
+
+(define (datashare:manage-view)
+  (iup:vbox
+   (iup:hbox 
+    (iup:button "Pushme"
+		#:expand "YES"
+		))))
+
+(define (datashare:gui)
+  (iup:show
+   (iup:dialog 
+    #:title (conc "DataShare dashboard " (current-user-name) ":" (current-directory))
+    #:menu (datashare:main-menu)
+    (let* ((tabs (iup:tabs
+		  #:tabchangepos-cb (lambda (obj curr prev)
+				      (set! *datashare:current-tab-number* curr))
+		  (datashare:publish-view)
+		  (datashare:get-view)
+		  (datashare:manage-view)
+		  )))
+	;; (set! (iup:callback tabs tabchange-cb:) (lambda (a b c)(print "SWITCHED TO TAB: " a " " b " " c)))
+	(iup:attribute-set! tabs "TABTITLE0" "Publish")
+	(iup:attribute-set! tabs "TABTITLE1" "Get")
+	(iup:attribute-set! tabs "TABTITLE2" "Manage")
+	;; (iup:attribute-set! tabs "BGCOLOR" "190 190 190")
+	tabs)))
+  (iup:main-loop))
+
+;;======================================================================
+;; MAIN
+;;======================================================================
+
+(define (datashare:load-config path)
+  (let ((fname (conc path "/.datashare.config")))
+    (ini:property-separator-patt " *  *")
+    (ini:property-separator #\space)
+    (if (file-exists? fname)
+	(ini:read fname)
+	'())))
+
+(define (main)
+  (let* ((args (argv))
+	 (prog (car args))
+	 (rema (cdr args))
+	 (conf (datashare:load-config (pathname-directory prog))))
+    (cond
+     ((eq? (length rema) 1)
+      (case (string->symbol (car rema))
+	((help -h -help --h --help)
+	 (print datashare:help))
+	(else
+	 (print "ERROR: Unrecognised command. Try \"datashare help\""))))
+     ((null? rema)(datashare:gui))
+     ((>= (length rema) 2)
+      (apply process-action (car rema)(cdr rema)))
+     (else (print "ERROR: Unrecognised command. Try \"datashare help\"")))))
+
+(main)

Index: runs.scm
==================================================================
--- runs.scm
+++ runs.scm
@@ -1040,28 +1040,37 @@
 	 ((not (null? reg)) ;; could we get here with leftovers?
 	  (debug:print-info 0 "Have leftovers!")
 	  (loop (car reg)(cdr reg) '() reruns))
 	 (else
 	  (debug:print-info 4 "Exiting loop with...\n  hed=" hed "\n  tal=" tal "\n  reruns=" reruns))
-	 ))
-	;; now *if* -run-wait we wait for all tests to be done
-      (let loop ((num-running      (cdb:remote-run db:get-count-tests-running-for-run-id #f run-id #f))
-		 (prev-num-running 0))
-	(if (and (args:get-arg "-run-wait")
-		 (> num-running 0))
-	    (begin
-	      ;; Here we mark any old defunct tests as incomplete. Do this every fifteen minutes
-	      (if (> (current-seconds)(+ last-time-incomplete 900))
-		  (begin
-		    (debug:print-info 0 "Marking stuck tests as INCOMPLETE while waiting for run " run-id ". Running as pid " (current-process-id) " on " (get-host-name))
-		    (set! last-time-incomplete (current-seconds))
-		    (cdb:remote-run db:find-and-mark-incomplete #f)))
-	      (if (not (eq? num-running prev-num-running))
-		  (debug:print-info 0 "run-wait specified, waiting on " num-running " tests in RUNNING, REMOTEHOSTSTART or LAUNCHED state at " (time->string (seconds->local-time (current-seconds)))))
-	      (thread-sleep! 15)
-	      (loop (cdb:remote-run db:get-count-tests-running-for-run-id #f run-id #f) num-running))))
-      ) ;; LET* ((test-record
+	 )))
+    ;; now *if* -run-wait we wait for all tests to be done
+    
+    ;; if run-wait mode then wait 15 seconds for db to stabilize
+    (if (or (args:get-arg "-run-wait")
+	    (equal? (configf:lookup *configdat* "setup" "run-wait") "yes"))
+	(thread-sleep! 15))
+    ;; Now wait for any RUNNING tests to complete (if in run-wait mode)
+    (let wait-loop ((num-running      (cdb:remote-run db:get-count-tests-running-for-run-id #f run-id #f))
+		    (prev-num-running 0))
+      ;; (debug:print 0 "num-running=" num-running ", prev-num-running=" prev-num-running)
+      (if (and (or (args:get-arg "-run-wait")
+		   (equal? (configf:lookup *configdat* "setup" "run-wait") "yes"))
+	       (> num-running 0))
+	  (begin
+	    ;; Here we mark any old defunct tests as incomplete. Do this every fifteen minutes
+	    ;; (debug:print 0 "Got here eh! num-running=" num-running " (> num-running 0) " (> num-running 0))
+	    (if (> (current-seconds)(+ last-time-incomplete 900))
+		(begin
+		  (debug:print-info 0 "Marking stuck tests as INCOMPLETE while waiting for run " run-id ". Running as pid " (current-process-id) " on " (get-host-name))
+		  (set! last-time-incomplete (current-seconds))
+		  (cdb:remote-run db:find-and-mark-incomplete #f)))
+	    (if (not (eq? num-running prev-num-running))
+		(debug:print-info 0 "run-wait specified, waiting on " num-running " tests in RUNNING, REMOTEHOSTSTART or LAUNCHED state at " (time->string (seconds->local-time (current-seconds)))))
+	    (thread-sleep! 15)
+	    (wait-loop (cdb:remote-run db:get-count-tests-running-for-run-id #f run-id #f) num-running))))
+    ;; LET* ((test-record
     ;; we get here on "drop through". All done!
     (debug:print-info 1 "All tests launched")))
 
 (define (runs:calc-fails prereqs-not-met)
   (filter (lambda (test)
@@ -1121,10 +1130,11 @@
 	 (itemdat      (tests:testqueue-get-itemdat    test-record))
 	 (test-path    (hash-table-ref all-tests-registry test-name)) ;; (conc *toppath* "/tests/" test-name)) ;; could use tests:get-testconfig here ...
 	 (force        (hash-table-ref/default flags "-force" #f))
 	 (rerun        (hash-table-ref/default flags "-rerun" #f))
 	 (keepgoing    (hash-table-ref/default flags "-keepgoing" #f))
+	 (incomplete-timeout (string->number (or (configf:lookup *configdat* "setup" "incomplete-timeout") "x")))
 	 (item-path     "")
 	 (db           #f)
 	 (full-test-name #f))
 
     ;; setting itemdat to a list if it is #f
@@ -1267,11 +1277,12 @@
 	 (debug:print 1 "NOTE: " full-test-name " is already running or was explictly killed, use -force to launch it.")
 	 (hash-table-set! test-registry (runs:make-full-test-name test-name test-path) 'DONOTRUN)) ;; KILLED))
 	((LAUNCHED REMOTEHOSTSTART RUNNING)  
 	 (if (> (- (current-seconds)(+ (db:test-get-event_time testdat)
 				       (db:test-get-run_duration testdat)))
-		600) ;; i.e. no update for more than 600 seconds
+		(or incomplete-timeout
+		    6000)) ;; i.e. no update for more than 6000 seconds
 	     (begin
 	       (debug:print 0 "WARNING: Test " test-name " appears to be dead. Forcing it to state INCOMPLETE and status STUCK/DEAD")
 	       (tests:test-set-status! test-id "INCOMPLETE" "STUCK/DEAD" "" #f))
 	     (debug:print 2 "NOTE: " test-name " is already running")))
 	(else      

Index: tests/fullrun/megatest.config
==================================================================
--- tests/fullrun/megatest.config
+++ tests/fullrun/megatest.config
@@ -25,10 +25,15 @@
 [setup]
 # Set launchwait to no to use the more agressive code that does not wait for the launch to complete before proceeding
 # this may save a few milliseconds on launching tests
 # launchwait no
 waivercommentpatt ^WW\d+ [a-z].*
+incomplete-timeout 1
+
+# yes, anything else is no
+run-wait yes
+
 
 # Use http instead of direct filesystem access
 # transport http
 transport fs
 

Index: utils/Makefile_latest.installall
==================================================================
--- utils/Makefile_latest.installall
+++ utils/Makefile_latest.installall
@@ -43,11 +43,11 @@
 # Eggs to install (straightforward ones)
 EGGS=matchable readline apropos base64 regex-literals format regex-case test coops trace csv \
      dot-locking posix-utils posix-extras directory-utils hostinfo tcp-server rpc csv-xml fmt \
      json md5 awful http-client spiffy uri-common intarweb spiffy-request-vars \
      spiffy-directory-listing ssax sxml-serializer sxml-modifications sql-de-lite \
-     srfi-19 refdb
+     srfi-19 refdb ini-file
 
 #
 # Derived variables
 #