ADDED   DONE
Index: DONE
==================================================================
--- /dev/null
+++ DONE
@@ -0,0 +1,36 @@
+#  Copyright 2006-2017, Matthew Welland.
+# 
+# This file is part of Megatest.
+# 
+#     Megatest is free software: you can redistribute it and/or modify
+#     it under the terms of the GNU General Public License as published by
+#     the Free Software Foundation, either version 3 of the License, or
+#     (at your option) any later version.
+# 
+#     Megatest is distributed in the hope that it will be useful,
+#     but WITHOUT ANY WARRANTY; without even the implied warranty of
+#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#     GNU General Public License for more details.
+# 
+#     You should have received a copy of the GNU General Public License
+#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
+
+NOTE: This file gets copied occasionally into the wiki as "Roadmap DONE".
+      Do not make changes in the wiki, they will be lost!
+
+DONE
+====
+
+WW14
+. Streamline compilation - DONE, all non-official egg modules are now bundled.
+
+WW15
+. syscheck; touch file in home, tmp, runs, links and start xterm [DONE]
+
+WW16
+. archiving improvements/extentions [DONE]
+.. -get-data, -put-data [DONE]
+.. use MT_ vars if defined and no switch present [DONE]
+.. fix archive "first run" bug [DONE]
+.. areas path1 path2 ... -> search path for archives [NOT NEEDED - use -start-dir]
+.. -propagate -> move archive data forward when it is found in older bundles [NOT NEEDED - simply repost the data]

Index: Makefile
==================================================================
--- Makefile
+++ Makefile
@@ -19,36 +19,45 @@
 # rm <files>.o ; make install CSCOPTS='-profile' ; ... ;  chicken-profile | less
 SHELL=/bin/bash
 PREFIX=$(PWD)
 CSCOPTS=
 INSTALL=install
-SRCFILES = common.scm items.scm launch.scm \
-   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 \
-   http-transport.scm filedb.scm tdb.scm \
-   client.scm mt.scm \
-   ezsteps.scm lock-queue.scm sdb.scm \
-   rmt.scm api.scm subrun.scm \
-   portlogger.scm archive.scm env.scm diff-report.scm cgisetup/models/pgdb.scm 
+SRCFILES = common.scm items.scm launch.scm ods.scm runconfig.scm	\
+           server.scm configf.scm db.scm keys.scm margs.scm		\
+           process.scm runs.scm tasks.scm tests.scm genexample.scm	\
+           http-transport.scm filedb.scm tdb.scm client.scm mt.scm	\
+           ezsteps.scm lock-queue.scm sdb.scm rmt.scm api.scm		\
+           subrun.scm portlogger.scm archive.scm env.scm		\
+           diff-report.scm cgisetup/models/pgdb.scm
 
 # module source files
-MSRCFILES = ftail.scm rmtmod.scm commonmod.scm
-
-
-# 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 iup canvas-draw sqlite3
-
-GUISRCF  = dashboard-context-menu.scm dashboard-tests.scm dashboard-guimonitor.scm gutils.scm dcommon.scm tree.scm vg.scm
+MSRCFILES = adjutant.scm mutils.scm mttop.scm
+# ftail.scm rmtmod.scm commonmod.scm removed
+# MSRCFILES = ducttape-lib.scm pkts.scm stml2.scm cookie.scm mutils.scm	\
+#             mtargs.scm commonmod.scm dbmod.scm adjutant.scm ulex.scm	\
+#             rmtmod.scm apimod.scm
+
+GUISRCF = dashboard-context-menu.scm dashboard-tests.scm		\
+          dashboard-guimonitor.scm gutils.scm dcommon.scm tree.scm	\
+          vg.scm
 
 OFILES   = $(SRCFILES:%.scm=%.o)
 GOFILES  = $(GUISRCF:%.scm=%.o)
 
 MOFILES = $(addprefix mofiles/,$(MSRCFILES:%.scm=%.o))
+# compiled import files
+MOIMPFILES = $(MSRCFILES:%.scm=%.import.o)
+
+%.import.o : %.import.scm
+	csc $(CSCOPTS) -unit $*.import -c $*.import.scm -o $*.import.o
+
+# I'm not sure the cp is a good idea, changed a lot of things and it may not have been necessary...
+# mofiles/%.o  %.import.scm : %.scm megatest-fossil-hash.scm
+#	@[ -e mofiles ] || mkdir -p mofiles
+#	csc $(CSCOPTS) -I mofiles -I $* -J -c $< -o $*.o
+#	cp $*.o mofiles/$*.o
+#	@touch $*.import.scm # ensure it is touched after the .o is made
 
 mofiles/%.o : %.scm
 	mkdir -p mofiles
 	csc $(CSCOPTS) -J -c $< -o mofiles/$*.o
 
@@ -59,38 +68,37 @@
 
 ifeq ($(MTESTHASH),)
 $(error MTESTHASH is broken!)
 endif
 
-CSIPATH=$(shell which csi)
-CKPATH=$(shell dirname $(shell dirname $(CSIPATH)))
+# CSIPATH=$(shell which csi)
+# CKPATH=$(shell dirname $(shell dirname $(CSIPATH)))
 # ARCHSTR=$(shell uname -m)_$(shell uname -r)
 # BASH_MACHTYPE=$(shell bash -c "echo \$$MACHTYPE")
 # ARCHSTR=$(BASH_MACHTYPE)_$(shell lsb_release -sr)
 ARCHSTR=$(shell if [[ -e /usr/bin/sw_vers ]]; then /usr/bin/sw_vers -productVersion; else lsb_release -sr; fi)
 # ARCHSTR=$(shell bash -c "echo \$$MACHTYPE")
 
 PNGFILES = $(shell cd docs/manual;ls *png)
 
-#all : $(PREFIX)/bin/.$(ARCHSTR) mtest dboard mtut ndboard
+# all : $(PREFIX)/bin/.$(ARCHSTR) mtest dboard mtut ndboard
 all : $(PREFIX)/bin/.$(ARCHSTR) mtest dboard mtut tcmt
 
-mtest: $(OFILES) readline-fix.scm megatest.o $(MOFILES) mofiles/ftail.o mofiles/rmtmod.o mofiles/commonmod.o
-	csc $(CSCOPTS) $(OFILES) $(MOFILES) megatest.o -o mtest
+mtest: $(OFILES) readline-fix.scm megatest.o $(MOFILES) $(MOIMPFILES)  megatest-version.scm
+	csc $(CSCOPTS) $(OFILES) $(MOFILES) $(MOIMPFILES) megatest.o -o mtest
 
 showmtesthash:
 	@echo $(MTESTHASH)
 
-dboard : $(OFILES) $(GOFILES) dashboard.scm $(MOFILES)
-	csc $(CSCOPTS) $(OFILES) dashboard.scm $(GOFILES) $(MOFILES) -o dboard
+dboard : $(OFILES) $(GOFILES) dashboard.scm $(MOFILES) $(MOIMPFILES) megatest-version.scm megatest-fossil-hash.scm
+	csc $(CSCOPTS) $(OFILES) dashboard.scm $(GOFILES) $(MOFILES) $(MOIMPFILES) -o dboard
 
-ndboard : newdashboard.scm $(OFILES) $(GOFILES)
-	csc $(CSCOPTS) $(OFILES) $(GOFILES) newdashboard.scm -o ndboard
-
-mtut: $(OFILES) $(MOFILES) megatest-fossil-hash.scm mtut.scm
+mtut: $(OFILES) $(MOFILES) megatest-fossil-hash.scm mtut.scm megatest-version.scm
 	csc $(CSCOPTS) $(OFILES) $(MOFILES) mtut.scm -o mtut
 
+include makefile.inc
+include chicken.makefile
 
 TCMTOBJS = \
 	api.o \
 	archive.o \
 	cgisetup/models/pgdb.o \
@@ -104,29 +112,28 @@
 	keys.o \
 	launch.o \
 	lock-queue.o \
 	margs.o \
 	mt.o \
-	megatest-version.o \
 	ods.o \
 	portlogger.o \
 	process.o \
 	rmt.o \
-        mofiles/rmtmod.o \
-        mofiles/commonmod.o \
-        rpc-transport.o \
 	runconfig.o \
 	runs.o \
 	server.o \
 	tasks.o \
 	tdb.o \
 	tests.o \
 	subrun.o \
+        ezsteps.o
 
+#        mofiles/rmtmod.o \
+#        mofiles/commonmod.o \
 
-tcmt : $(TCMTOBJS) tcmt.scm
-	csc $(CSCOPTS) $(TCMTOBJS) tcmt.scm -o tcmt
+tcmt : $(TCMTOBJS) tcmt.scm megatest-version.scm
+	csc $(CSCOPTS) $(TCMTOBJS) $(MOFILES) $(MOIMPFILES) tcmt.scm -o tcmt
 
 # install documentation to $(PREFIX)/docs
 # DOES NOT REBUILD DOCS
 #
 $(PREFIX)/share/docs/megatest_manual.html : docs/manual/megatest_manual.html
@@ -141,29 +148,54 @@
 
 $(PREFIX)/share/db/mt-pg.sql : mt-pg.sql
 	mkdir -p $(PREFIX)/share/db
 	$(INSTALL) mt-pg.sql $(PREFIX)/share/db/mt-pg.sql
 
-#multi-dboard : multi-dboard.scm $(OFILES) $(GOFILES)
-#	csc $(CSCOPTS) $(OFILES) $(GOFILES) multi-dboard.scm -o multi-dboard
-
-# 
-# $(PREFIX)/bin/revtagfsl : utils/revtagfsl.scm
-#	csc utils/revtagfsl.scm -o $(PREFIX)/bin/revtagfsl
-
 # Special dependencies for the includes
-tests.o db.o launch.o runs.o dashboard-tests.o dashboard-context-menu.o dashboard-guimonitor.o dashboard-main.o monitor.o dashboard.o  \
-archive.o megatest.o : db_records.scm
+$(MOFILE) $(MOIMPFILES) : megatest-fossil-hash.scm
+
+# common.o : mofiles/commonmod.o megatest-fossil-hash.scm
+
+# commonmod.o dashboard.o megatest.o tcmt.o apimod.o : megatest-fossil-hash.scm
+
+tests.o db.o launch.o runs.o dashboard-tests.o				\
+dashboard-context-menu.o dashboard-guimonitor.o dashboard-main.o	\
+monitor.o dashboard.o archive.o megatest.o : db_records.scm megatest-fossil-hash.scm
+
 tests.o runs.o dashboard.o dashboard-tests.o dashboard-context-menu.o dashboard-main.o  : run_records.scm
+
 db.o ezsteps.o keys.o launch.o megatest.o monitor.o runs-for-ref.o runs.o tests.o : key_records.scm
+
 tests.o tasks.o dashboard-tasks.o : task_records.scm
+
 runs.o : test_records.scm
-megatest.o : megatest-fossil-hash.scm
-rmt.scm client.scm common.scm configf.scm dashboard-guimonitor.scm dashboard-tests.scm dashboard.scm db.scm dcommon.scm ezsteps.scm fs-transport.scm http-transport.scm index-tree.scm items.scm keys.scm launch.scm megatest.scm monitor.scm mt.scm newdashboard.scm runconfig.scm runs.scm server.scm tdb.scm tests.scm tree.scm : common_records.scm
+
+megatest.o : megatest-fossil-hash.scm megatest-version.scm
+
+rmt.scm client.scm common.scm configf.scm dashboard-guimonitor.scm dashboard-tests.scm dashboard.scm db.scm dcommon.scm ezsteps.scm fs-transport.scm http-transport.scm index-tree.scm items.scm keys.scm launch.scm megatest.scm monitor.scm mt.scm newdashboard.scm runconfig.scm runs.scm server.scm tdb.scm tests.scm tree.scm : common_records.scm megatest-version.scm
+
 common_records.scm : altdb.scm
-vg.o dashboard.o : vg_records.scm
+
+# mofiles/stml2.o : mofiles/cookie.o
+# configf.o : mofiles/commonmod.o
+
+vg.o dashboard.o : vg_records.scm megatest-version.scm
+
 dcommon.o : run_records.scm
+
+mofiles/stml2.o : mofiles/cookie.o
+
+# # special include based modules
+# mofiles/pkts.o      : pkts/pkts.scm
+# mofiles/stml2.o     : cookie.o
+# # mofiles/mtargs.o    : mtargs/mtargs.scm
+# # mofiles/mtconfigf.o : mtconfigf/mtconfigf.scm
+# mofiles/ulex.o      : ulex/ulex.scm
+# mofiles/mutils.o    : mutils/mutils.scm
+# mofiles/cookie.o    : stml2/cookie.scm
+# mofiles/stml2.o     : stml2/stml2.scm
+
 # Temporary while transitioning to new routine
 # runs.o : run-tests-queue-classic.scm  run-tests-queue-new.scm
 
 # for the modularized stuff
 mofiles/rmtmod.o : mofiles/commonmod.o
@@ -221,21 +253,10 @@
 
 $(PREFIX)/bin/tcmt : $(PREFIX)/bin/.$(ARCHSTR)/tcmt utils/mk_wrapper
 	utils/mk_wrapper $(PREFIX) tcmt $(PREFIX)/bin/tcmt
 	chmod a+x $(PREFIX)/bin/tcmt
 
-# $(PREFIX)/bin/.$(ARCHSTR)/mdboard : multi-dboard
-#	$(INSTALL) multi-dboard $(PREFIX)/bin/.$(ARCHSTR)/mdboard
-
-# $(PREFIX)/bin/mdboard : $(PREFIX)/bin/.$(ARCHSTR)/mdboard  utils/mk_wrapper
-# 	utils/mk_wrapper $(PREFIX) mdboard $(PREFIX)/bin/mdboard
-# 	chmod a+x $(PREFIX)/bin/mdboard
-
-# $(HELPERS) : utils/%
-# 	$(INSTALL) $< $@
-# 	chmod a+x $@
-
 $(PREFIX)/bin/mt_laststep : utils/mt_laststep
 	$(INSTALL) $< $@
 	chmod a+x $@
 
 $(PREFIX)/bin/mt_runstep : utils/mt_runstep
@@ -272,14 +293,10 @@
 
 $(PREFIX)/bin/mtrunner : utils/mtrunner
 	$(INSTALL) $< $@
 	chmod a+x $@
 
-# $(PREFIX)/bin/refdb : refdb
-# 	$(INSTALL) $< $@
-# 	chmod a+x $@
-
 deploytarg/nbfake : utils/nbfake
 	$(INSTALL) $< $@
 	chmod a+x $@
 
 deploytarg/viewscreen : utils/viewscreen
@@ -298,20 +315,39 @@
 # install dashboard as dboard so wrapper script can be called dashboard
 $(PREFIX)/bin/.$(ARCHSTR)/dboard : dboard $(FILES) utils/mk_wrapper
 	utils/mk_wrapper $(PREFIX) dboard $(PREFIX)/bin/dashboard
 	chmod a+x $(PREFIX)/bin/dashboard
 	$(INSTALL) dboard $(PREFIX)/bin/.$(ARCHSTR)/dboard
+
+# Work around missing libraries on crappy corporate compute farm (hearafter known as CCCF)
+ifeq ($(ARCHSTR),12.5)
+EXTRALIBS_HACK=$(PREFIX)/bin/.$(ARCHSTR)/lib/libpangox-1.0.so $(PREFIX)/bin/.$(ARCHSTR)/lib/libpangox-1.0.so.0 $(PREFIX)/bin/.$(ARCHSTR)/lib/libxcb-xlib.so.0
+else
+EXTRALIBS_HACK=
+endif
+
+$(PREFIX)/bin/.$(ARCHSTR)/lib/libpangox-1.0.so : lib/libpangox-1.0.so
+	mkdir -p $(PREFIX)/bin/.$(ARCHSTR)/lib
+	$(INSTALL) lib/libpangox-1.0.so $(PREFIX)/bin/.$(ARCHSTR)/lib/libpangox-1.0.so
+
+$(PREFIX)/bin/.$(ARCHSTR)/lib/libpangox-1.0.so.0 : lib/libpangox-1.0.so.0
+	mkdir -p $(PREFIX)/bin/.$(ARCHSTR)/lib
+	$(INSTALL) lib/libpangox-1.0.so.0 $(PREFIX)/bin/.$(ARCHSTR)/lib/libpangox-1.0.so.0
+
+$(PREFIX)/bin/.$(ARCHSTR)/lib/libxcb-xlib.so.0 : lib/libxcb-xlib.so.0
+	mkdir -p $(PREFIX)/bin/.$(ARCHSTR)/lib
+	$(INSTALL) lib/libxcb-xlib.so.0 $(PREFIX)/bin/.$(ARCHSTR)/lib/libxcb-xlib.so.0
 
 install : $(PREFIX)/bin/.$(ARCHSTR) $(PREFIX)/bin/.$(ARCHSTR)/mtest $(PREFIX)/bin/megatest \
           $(PREFIX)/bin/.$(ARCHSTR)/dboard $(PREFIX)/bin/dashboard $(HELPERS) $(PREFIX)/bin/nbfake \
           $(PREFIX)/bin/.$(ARCHSTR)/mtexec $(PREFIX)/bin/mtexec $(PREFIX)/bin/serialize-env \
 	  $(PREFIX)/bin/nbfind $(PREFIX)/bin/mtrunner $(PREFIX)/bin/viewscreen $(PREFIX)/bin/mt_xterm \
 	  $(PREFIX)/share/docs/megatest_manual.html $(PREFIX)/bin/remrun \
 	  $(PREFIX)/share/docs/megatest_manual.html $(PREFIX)/bin/remrun $(PREFIX)/bin/mtutil \
 	  $(PREFIX)/bin/tcmt $(PREFIX)/share/db/mt-pg.sql \
-          $(PREFIX)/share/js/jquery-3.1.0.slim.min.js 
-#         $(PREFIX)/bin/.$(ARCHSTR)/ndboard
+          $(PREFIX)/share/js/jquery-3.1.0.slim.min.js \
+	  $(EXTRALIBS_HACK)
 
 # $(PREFIX)/bin/newdashboard
 
 $(PREFIX)/bin/.$(ARCHSTR) : 
 	mkdir -p $(PREFIX)/bin/.$(ARCHSTR)
@@ -326,11 +362,22 @@
 
 $(MTQA_FOSSIL) :
 	fossil clone https://www.kiatoa.com/fossils/megatest_qa $(MTQA_FOSSIL)
 
 clean : 
-	rm -f $(OFILES) $(GOFILES) $(MOFILES) $(TCMTOBJS) $(PREFIX)/megatest $(PREFIX)/dashboard mtest mtutil mtut tcmt ftail.import.scm readline-fix.scm serialize-env dboard dboard.o megatest.o dashboard.o megatest-fossil-hash.* altdb.scm mofiles/*.o vg.o
+	rm -f $(OFILES) $(GOFILES) $(MOFILES) $(TCMTOBJS)		\
+            $(PREFIX)/megatest $(PREFIX)/dashboard mtest mtutil mtut	\
+            tcmt readline-fix.scm serialize-env dboard *.o		\
+            megatest-fossil-hash.* altdb.scm mofiles/*.o                \
+            mofiles/*.o vg.o cookie.o dashboard-main.o	                \
+            ducttape-lib.o ftail.o mutils.o pkts.o rmtmod.o stml2.o	\
+            tcmt.o *.import.scm *.import.o
+	rm -f $(OFILES) $(GOFILES) $(MOFILES) $(TCMTOBJS)		\
+            $(PREFIX)/megatest $(PREFIX)/dashboard mtest mtutil mtut	\
+            tcmt ftail.import.scm readline-fix.scm serialize-env	\
+            dboard dboard.o megatest.o dashboard.o			\
+            megatest-fossil-hash.* altdb.scm mofiles/*.o vg.o
 	rm -rf share
 
 #======================================================================
 # Make the records files
 #======================================================================
@@ -347,35 +394,21 @@
 	chmod a+X $@
 
 deploytarg/apropos.so : Makefile
 	chicken-install -p deploytarg -deploy -keep-installed $(EGGS)
 
-#	for i in apropos base64 canvas-draw csv-xml directory-utils dot-locking extras fmt format hostinfo http-client intarweb json md5 message-digest posix posix-extras readline regex regex-case s11n spiffy spiffy-request-vars sqlite3 srfi-1 srfi-18 srfi-69 tcp test uri-common check-errors synch matchable sql-null tcp-server rpc blob-utils string-utils variable-item defstruct uri-generic sendfile opensll openssl lookup-table list-utils stack; do \
-#	chicken-install -prefix deploytarg -deploy $$i;done
-
-# deploytarg/libsqlite3.so : 
-# 	CSC_OPTIONS="-Ideploytarg -Ldeploytarg" $CHICKEN_INSTALL -prefix deploytarg -deploy sqlite3
-
 deploy : deploytarg/mtest deploytarg/dboard $(DEPLOYHELPERS) deploytarg/nbfake deploytarg/remrun deploytarg/viewsceen deploytarg/nbfind deploytarg/apropos.so
 
-# deploytarg/libiupcd.so : $(CKPATH)/lib/libiupcd.so
-# 	for i in iup im cd av call sqlite; do \
-# 	  cp $(CKPATH)/lib/lib$$i* deploytarg/ ; \
-# 	done
-# 	cp $(CKPATH)/include/*.h deploytarg
-
 # puts deployed megatest in directory "megatest"
 deploytarg/mtest : $(OFILES) megatest.o deploytarg/apropos.so
 	csc -deploy $(CSCOPTS) $(OFILES) megatest.scm -o deploytarg
 	mv deploytarg/deploytarg deploytarg/mtest
 
 deploytarg/dboard :  $(OFILES) $(GOFILES) dashboard.scm deploytarg/apropos.so
 	csc -deploy $(OFILES) $(GOFILES) dashboard.scm -o deploytarg
 	mv deploytarg/deploytarg deploytarg/dboard
 
-# DATASHAREO=configf.o common.o process.o tree.o dcommon.o margs.o launch.o gutils.o db.o synchash.o server.o \
-#            megatest-version.o tdb.o ods.o mt.o keys.o
 datashare-testing/sd : datashare.scm $(OFILES)
 	csc $(CSCOPTS) datashare.scm $(OFILES) -o datashare-testing/sd
 
 datashare-testing/sdat: sharedat.scm $(OFILES)
 	csc $(CSCOPTS) sharedat.scm $(OFILES) -o datashare-testing/sdat
@@ -384,35 +417,28 @@
 	mkdir -p /tmp/$(USER)/datashare/disk1 /tmp/$(USER)/basepath
 
 xterm : sd
 	(export BASEPATH=/tmp/$(USER)/basepath ; export PATH="$(PWD)/datashare-testing:$(PATH)" ; xterm &)
 
-datashare-testing/spublish : spublish.scm $(OFILES)
-	csc $(CSCOPTS) spublish.scm  megatest-version.o margs.o process.o common.o  -o datashare-testing/spublish
+datashare-testing/spublish : spublish.scm $(OFILES) megatest-version.scm
+	csc $(CSCOPTS) spublish.scm margs.o process.o common.o  -o datashare-testing/spublish
 
-datashare-testing/sretrieve : sretrieve.scm $(OFILES)
-	csc $(CSCOPTS) sretrieve.scm  megatest-version.o margs.o process.o common.o  -o datashare-testing/sretrieve
+datashare-testing/sretrieve : sretrieve.scm $(OFILES) megatest-version.scm
+	csc $(CSCOPTS) sretrieve.scm margs.o process.o common.o  -o datashare-testing/sretrieve
 
 
-datashare-testing/sauthorize : sauthorize.scm $(OFILES)
-	 csc $(CSCOPTS) sauthorize.scm  megatest-version.o margs.o process.o common.o  -o datashare-testing/sauthorize
+datashare-testing/sauthorize : sauthorize.scm $(OFILES) megatest-version.scm
+	 csc $(CSCOPTS) sauthorize.scm margs.o process.o common.o  -o datashare-testing/sauthorize
 
 sauth-init:
 	mkdir -p  datashare-testing
 	rm  datashare-testing/sauthorize
 	rm  datashare-testing/sretrieve 
 	rm  datashare-testing/spublish
 
 sauth : sauth-init datashare-testing/sauthorize datashare-testing/sretrieve datashare-testing/spublish 
 
-
-# base64 dot-locking \
-#             csv-xml z3
-
-#  "(define (toplevel-command . a) #f)"
-# if egrep 'version.*3.0' $(shell dirname $(shell dirname $(shell which csi)))/lib/chicken/7/readline.setup-info;then \
-
 readline-fix.scm :
 	if [[ $(shell chicken-status | grep readline | awk '{print $4}' | cut -d. -f1) -gt 3 ]];then \
 	   echo "(define *use-new-readline* #f)" > readline-fix.scm; \
 	else \
 	   echo "(define *use-new-readline* #t)" > readline-fix.scm;\
@@ -426,12 +452,12 @@
 	fi
 	if csi -ne '(use postgresql)';then \
 	   echo "(use postgresql)(hash-table-set! *available-db* 'postgresql #t)" >> altdb.scm;\
 	fi
 
-portlogger-example : portlogger-example.scm api.o archive.o client.o common.o configf.o dashboard-tests.o dashboard-context-menu.o db.o dcommon.o ezsteps.o filedb.o genexample.o gutils.o http-transport.o items.o keys.o launch.o lock-queue.o margs.o megatest-version.o mt.o ods.o portlogger.o process.o rmt.o rpc-transport.o runconfig.o runs.o sdb.o server.o synchash.o tasks.o tdb.o tests.o tree.o
-	csc $(CSCOPTS) portlogger-example.scm api.o archive.o client.o common.o configf.o dashboard-tests.o dashboard-context-menu.o db.o dcommon.o ezsteps.o filedb.o genexample.o gutils.o http-transport.o items.o keys.o launch.o lock-queue.o margs.o megatest-version.o mt.o ods.o portlogger.o process.o rmt.o rpc-transport.o runconfig.o runs.o sdb.o server.o synchash.o tasks.o tdb.o tests.o tree.o
+portlogger-example : portlogger-example.scm api.o archive.o client.o common.o configf.o dashboard-tests.o dashboard-context-menu.o db.o dcommon.o ezsteps.o filedb.o genexample.o gutils.o http-transport.o items.o keys.o launch.o lock-queue.o margs.o mt.o ods.o portlogger.o process.o rmt.o runconfig.o runs.o sdb.o server.o synchash.o tasks.o tdb.o tests.o tree.o
+	csc $(CSCOPTS) portlogger-example.scm api.o archive.o client.o common.o configf.o dashboard-tests.o dashboard-context-menu.o db.o dcommon.o ezsteps.o filedb.o genexample.o gutils.o http-transport.o items.o keys.o launch.o lock-queue.o margs.o mt.o ods.o portlogger.o process.o rmt.o runconfig.o runs.o sdb.o server.o synchash.o tasks.o tdb.o tests.o tree.o
 
 # create a pdf dot graphviz diagram from notations in rmt.scm
 rmt.pdf : rmt.scm
 	grep ';;DOT' rmt.scm | sed -e 's/.*;;DOT //' > rmt.dot;dot -Tpdf rmt.dot -o rmt.pdf
 

Index: NOTES
==================================================================
--- NOTES
+++ NOTES
@@ -12,10 +12,15 @@
 #     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 #     GNU General Public License for more details.
 # 
 #     You should have received a copy of the GNU General Public License
 #     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
+
+(server:writable-watchdog-bruteforce dbstruct)
+
+(server:writable-watchdog-deltasync dbstruct)
+
 
 =====================================================================
 NOTES from looking at branch v1.62-rpc
 =====================================================================
 

Index: TODO
==================================================================
--- TODO
+++ TODO
@@ -1,6 +1,6 @@
-#  Copyright 2006-2017, Matthew Welland.
+#  Copyright 2006-2020, Matthew Welland.
 # 
 # This file is part of Megatest.
 # 
 #     Megatest is free software: you can redistribute it and/or modify
 #     it under the terms of the GNU General Public License as published by
@@ -16,13 +16,43 @@
 #     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
 
 TODO
 ====
 
-. Dashboard should resist running from non-homehost
+WW38
+. Add test_rundat to no-sync ==> correction, put in <testdir>/.meta/test-run.dat
+. Add STATE/STATUS transitions to .meta/test-run.dat or similar
+. Swizzle update-test-rundat to operate on no-sync
+. Swizzle update-run-duration, -uname-host and cpuload-diskfree to no-sync
+. On state/status change update tests table with duration
+
+WW15
+. fill newview matrix with data, filter pipeline gui elements
+. improve [script], especially indent handling
+
+WW16
+. split db into megatest.db (runs etc.) db/<something>.db
+. release basic newview implementation
+
+WW18
+. release split db implementation
+. mtutil calls from dashboard (for remote control)
+. logs browser (esp. for surfacing mtutil related activities)
+
+WW19
+. break command line into sections; all, run control, queries, utilities etc.
+. pull in ftfplan (not integrated, just code pulled in)
+
+WW20
+. ./configure => ubuntu, sles11, sles12, rh7
+. Add output flushing in teamcity support
+. Switch to using simple runs query everywhere
+. Add end_time to runs and add a rollup call that sets state, status and end_time
 
-
+Future
+. Switch to scsh-process pipeline management for job execution/control
+. Use call-with-environment-variables more.
 
 Migration to inmem db plus per run db
 -------------------------------------
 
 . Re-work the dbstruct data structure?

ADDED   adjutant.scm
Index: adjutant.scm
==================================================================
--- /dev/null
+++ adjutant.scm
@@ -0,0 +1,44 @@
+;;======================================================================
+;; Copyright 2017, Matthew Welland.
+;; 
+;; This file is part of Megatest.
+;; 
+;;     Megatest is free software: you can redistribute it and/or modify
+;;     it under the terms of the GNU General Public License as published by
+;;     the Free Software Foundation, either version 3 of the License, or
+;;     (at your option) any later version.
+;; 
+;;     Megatest is distributed in the hope that it will be useful,
+;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;     GNU General Public License for more details.
+;; 
+;;     You should have received a copy of the GNU General Public License
+;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
+
+;;======================================================================
+
+(declare (unit adjutant))
+
+(module adjutant *
+
+(import scheme chicken data-structures extras files)
+(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18 srfi-69
+	md5 message-digest matchable
+	regex srfi-1)
+
+(define (adjutant-run host-type rmt:no-sync-take-job)
+  (print "Running the adjutant!")
+  (let loop ((wait-count 0))
+    (if (< wait-count 10) ;; 6 x 10 seconds = one minute
+	(let* ((dat (rmt:no-sync-take-job host-type)))
+	  (match dat
+	    ((id ht vars exekey cmdline state event-time last-update)
+	     (system cmdline)
+	     (loop 0))
+	    (else
+	     (thread-sleep! 10)
+	     (loop (+ wait-count 1)))))
+	(print "I'm bored. Exiting."))))
+
+)

Index: api.scm
==================================================================
--- api.scm
+++ api.scm
@@ -58,10 +58,11 @@
     get-target
     ;; register-run
     get-tests-tags
     get-test-times
     get-tests-for-run
+    get-tests-for-run-state-status
     get-test-id
     get-tests-for-runs-mindata
     get-tests-for-run-mindata
     get-run-name-from-id
     get-runs
@@ -80,11 +81,11 @@
     tasks-get-last
     testmeta-get-record
     have-incompletes?
     ;; synchash-get
     get-changed-record-ids
-		get-run-record-ids 
+    get-run-record-ids 
     get-not-completed-cnt))
 
 (define api:write-queries
   '(
     get-keys-write ;; dummy "write" query to force server start
@@ -98,11 +99,11 @@
     delete-test-records
     delete-old-deleted-test-records
     test-set-state-status
     test-set-top-process-pid
     set-state-status-and-roll-up-items
-     
+    
     update-pass-fail-counts
     top-test-set-per-pf-counts ;; (db:top-test-set-per-pf-counts (db:get-db *db* 5) 5 "runfirst")
 
     ;; RUNS
     register-run
@@ -119,10 +120,13 @@
     test-data-rollup
     csv->test-data
 
     ;; MISC
     sync-inmem->db
+    drop-all-triggers
+    create-all-triggers
+    update-tesdata-on-repilcate-db 
 
     ;; TESTMETA
     testmeta-add-record
     testmeta-update-field
 
@@ -138,11 +142,11 @@
 ;;
 (define (api:execute-requests dbstruct dat)
   (handle-exceptions
    exn
    (let ((call-chain (get-call-chain)))
-     (debug:print 0 *default-log-port* "WARNING: api:execute-requests received an exception from peer, dat=" dat)
+     (debug:print 0 *default-log-port* "WARNING: api:execute-requests received an exception from peer, dat=" dat ", exn=" exn)
      (print-call-chain (current-error-port))
      (debug:print 0 *default-log-port* " message: "  ((condition-property-accessor 'exn 'message) exn))       
      (vector #f (vector exn call-chain dat))) ;; return some stuff for debug if an exception happens
    (cond
     ((not (vector? dat))                    ;; it is an error to not receive a vector
@@ -150,21 +154,21 @@
     ((> *api-process-request-count* 20) ;; 20)
      (debug:print 0 *default-log-port* "WARNING: api:execute-requests received an overloaded message.")
      (set! *server-overloaded* #t)
      (vector #f (vector #f 'overloaded))) ;; the inner vector is what gets returned. nope, don't know why. please refactor!
     (else  
-     (let* ((cmd-in            (vector-ref dat 0))
+     (let* ((cmd-in            (common:safe-vector-ref dat 0 'nocmd))
             (cmd               (if (symbol? cmd-in)
 				   cmd-in
 				   (string->symbol cmd-in)))
-            (params            (vector-ref dat 1))
+            (params            (common:safe-vector-ref dat 1 '()))
             (start-t           (current-milliseconds))
             (readonly-mode     (dbr:dbstruct-read-only dbstruct))
             (readonly-command  (member cmd api:read-only-queries))
             (writecmd-in-readonly-mode (and readonly-mode (not readonly-command)))
             (foo               (begin
-                                 (common:telemetry-log (conc "api-in:"(->string cmd))
+                                 #;(common:telemetry-log (conc "api-in:"(->string cmd))
                                                        payload: `((params . ,params)))
                                  
                                  #t))
             (res    
              (if writecmd-in-readonly-mode
@@ -171,10 +175,12 @@
                  (conc "attempt to run write command "cmd" on a read-only database")
                  (case cmd
                    ;;===============================================
                    ;; READ/WRITE QUERIES
                    ;;===============================================
+
+		   ((nocmd)                         '(#f "All broken!"))
 
                    ((get-keys-write)                        (db:get-keys dbstruct)) ;; force a dummy "write" query to force server; for debug in -repl
                    
                    ;; SERVERS
                    ((start-server)                    (apply server:kind-run params))
@@ -212,11 +218,14 @@
                    ((delete-run)                   (apply db:delete-run dbstruct params))
                    ((lock/unlock-run)              (apply db:lock/unlock-run dbstruct params))
                    ((update-run-event_time)        (apply db:update-run-event_time dbstruct params))
                    ((update-run-stats)             (apply db:update-run-stats dbstruct params))
                    ((set-var)                      (apply db:set-var dbstruct params))
+                   ((inc-var)                      (apply db:inc-var dbstruct params))
+		   ((dec-var)                      (apply db:dec-var dbstruct params))
                    ((del-var)                      (apply db:del-var dbstruct params))
+		   ((add-var)                      (apply db:add-var dbstruct params))
 
                    ;; STEPS
                    ((teststep-set-status!)         (apply db:teststep-set-status! dbstruct params))
                    ((delete-steps-for-test!)        (apply db:delete-steps-for-test! dbstruct params))
                    
@@ -226,10 +235,12 @@
 
                    ;; MISC
                    ((sync-inmem->db)               (let ((run-id (car params)))
                                                      (db:sync-touched dbstruct run-id force-sync: #t)))
                    ((mark-incomplete)              (apply db:find-and-mark-incomplete dbstruct params))
+                   ((create-all-triggers)          (db:create-all-triggers dbstruct))
+                   ((drop-all-triggers)            (db:drop-all-triggers dbstruct)) 
 
                    ;; TESTMETA
                    ((testmeta-add-record)       (apply db:testmeta-add-record dbstruct params))
                    ((testmeta-update-field)     (apply db:testmeta-update-field dbstruct params))
                    ((get-tests-tags)            (db:get-tests-tags dbstruct))
@@ -242,17 +253,20 @@
 		   ;; NO SYNC DB
 		   ((no-sync-set)               (apply db:no-sync-set         *no-sync-db* params))
 		   ((no-sync-get/default)       (apply db:no-sync-get/default *no-sync-db* params))
 		   ((no-sync-del!)              (apply db:no-sync-del!        *no-sync-db* params))
 		   ((no-sync-get-lock)          (apply db:no-sync-get-lock    *no-sync-db* params))
-		 
+		   ((no-sync-add-job)           (apply db:no-sync-add-job     *no-sync-db* params))
+		   ((no-sync-take-job)          (apply db:no-sync-take-job    *no-sync-db* params))
+		   ((no-sync-job-records-clean) (apply db:no-sync-job-records-clean *no-sync-db* params))
+		   
                    ;; ARCHIVES
                    ;; ((archive-get-allocations)   
                    ((archive-register-disk)     (apply db:archive-register-disk dbstruct params))
                    ((archive-register-block-name)(apply db:archive-register-block-name dbstruct params))
                    ;; ((archive-allocate-testsuite/area-to-block)(apply db:archive-allocate-testsuite/area-to-block dbstruct block-id testsuite-name areakey))
-
+		   
                    ;;======================================================================
                    ;; READ ONLY QUERIES
                    ;;======================================================================
 
                    ;; KEYS
@@ -291,11 +305,13 @@
                    ((get-run-info)                 (apply db:get-run-info dbstruct params))
                    ((get-run-status)               (apply db:get-run-status dbstruct params))
                    ((get-run-state)                (apply db:get-run-state dbstruct params))
                    ((set-run-status)               (apply db:set-run-status dbstruct params))
                    ((set-run-state-status)  			 (apply db:set-run-state-status dbstruct params))
+                   ((update-tesdata-on-repilcate-db) (apply db:update-tesdata-on-repilcate-db  dbstruct params)) 
                    ((get-tests-for-run)            (apply db:get-tests-for-run dbstruct params))
+                   ((get-tests-for-run-state-status) (apply db:get-tests-for-run-state-status dbstruct params))
                    ((get-test-id)                  (apply db:get-test-id dbstruct params))
                    ((get-tests-for-run-mindata)    (apply db:get-tests-for-run-mindata dbstruct params))
                    ;; ((get-tests-for-runs-mindata)   (apply db:get-tests-for-runs-mindata dbstruct params))
                    ((get-runs)                     (apply db:get-runs dbstruct params))
                    ((simple-get-runs)              (apply db:simple-get-runs dbstruct params))
@@ -348,16 +364,16 @@
 			 start-t)))
 	 (hash-table-set! *db-api-call-time* cmd
 			  (cons delta-t (hash-table-ref/default *db-api-call-time* cmd '()))))
        (if writecmd-in-readonly-mode
            (begin
-             (common:telemetry-log (conc "api-out:"(->string cmd))
+             #;(common:telemetry-log (conc "api-out:"(->string cmd))
                                    payload: `((params . ,params)
                                               (ok-res . #t)))
 	     (vector #f res))
            (begin
-             (common:telemetry-log (conc "api-out:"(->string cmd))
+             #;(common:telemetry-log (conc "api-out:"(->string cmd))
                                    payload: `((params . ,params)
                                               (ok-res . #f)))
              (vector #t res))))))))
 
 ;; http-server  send-response
@@ -370,12 +386,12 @@
   (set! *api-process-request-count* (+ *api-process-request-count* 1))
   (let* ((cmd     ($ 'cmd))
 	 (paramsj ($ 'params))
 	 (params  (db:string->obj paramsj transport: 'http)) ;; incoming data from the POST (or is it a GET?)
 	 (resdat  (api:execute-requests dbstruct (vector cmd params))) ;; process the request, resdat = #( flag result )
-	 (success (vector-ref resdat 0))
-	 (res     (vector-ref resdat 1))) ;; (vector flag payload), get the payload, ignore the flag (why?)
+	 (success (common:safe-vector-ref resdat 0 #f))
+	 (res     (common:safe-vector-ref resdat 1 #f))) ;; (vector flag payload), get the payload, ignore the flag (why?)
     (if (not success)
 	(debug:print 0 *default-log-port* "ERROR: success flag is #f for " cmd " with params " params))
     (if (> *api-process-request-count* *max-api-process-requests*)
 	(set! *max-api-process-requests* *api-process-request-count*))
     (set! *api-process-request-count* (- *api-process-request-count* 1))

ADDED   apimod.scm
Index: apimod.scm
==================================================================
--- /dev/null
+++ apimod.scm
@@ -0,0 +1,37 @@
+;;======================================================================
+;; Copyright 2017, Matthew Welland.
+;; 
+;; This file is part of Megatest.
+;; 
+;;     Megatest is free software: you can redistribute it and/or modify
+;;     it under the terms of the GNU General Public License as published by
+;;     the Free Software Foundation, either version 3 of the License, or
+;;     (at your option) any later version.
+;; 
+;;     Megatest is distributed in the hope that it will be useful,
+;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;     GNU General Public License for more details.
+;; 
+;;     You should have received a copy of the GNU General Public License
+;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
+
+;;======================================================================
+
+(declare (unit apimod))
+(declare (uses commonmod))
+(declare (uses ulex))
+
+(module apimod
+	*
+	
+(import scheme chicken data-structures extras)
+(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18)
+(import commonmod)
+(import (prefix ulex ulex:))
+
+
+(define (api:execute-requests params)
+  #f)
+
+)

Index: archive.scm
==================================================================
--- archive.scm
+++ archive.scm
@@ -90,11 +90,11 @@
 	       (pscript-cmd (conc pscript " " testsuite-name " " target " " run-name " " test-name))
 	       (apath       (if pscript
 				(handle-exceptions
 				 exn
 				 (begin
-				   (debug:print 0 *default-log-port* "ERROR: script \"" pscript-cmd "\" failed to run properly.")
+				   (debug:print 0 *default-log-port* "ERROR: script \"" pscript-cmd "\" failed to run properly. exn=" exn)
 				   (exit 1))
 				 (with-input-from-pipe
 				  pscript-cmd
 				  read-line))
 				#f)) ;; this is the user-calculated archive path
@@ -120,11 +120,11 @@
 		      res)
 		    (begin
 		      (debug:print 0 *default-log-port* "WARNING: no disk found for " target ", " run-name ", " test-name ",  archive-path=" archive-path)
 		      #f)))
 	      (begin
-		(debug:print 0 *default-log-port* "WARNING: no disk found for " target ", " run-name ", " test-name ", block-id=" block-id)
+		(debug:print 0 *default-log-port* "WARNING: no disk found for " target ", " run-name ", " test-name )
 		#f)))))) ;; no best disk found
 
 ;; archive - run bup
 ;;
 ;; 1. create the bup dir if not exists
@@ -136,10 +136,11 @@
   ;; move the getting of archive space down into the below block so that a single run can 
   ;; allocate as needed should a disk fill up
   ;;
   (let* ((blockid-cache  (make-hash-table))
 	 (tsname         (common:get-testsuite-name))
+         (target         (string-intersperse (map cadr (rmt:get-key-val-pairs run-id)) "/"))
 	 (min-space      (string->number (or (configf:lookup *configdat* "archive" "minspace") "1000")))
 	 (arch-groups    (make-hash-table)) ;; archive groups, each corrosponds to a bup area
 	 (disk-groups    (make-hash-table)) ;; 
 	 (test-groups    (make-hash-table)) ;; these two (disk and test groups) could be combined nicely
 	 (test-dirs      (make-hash-table))
@@ -150,13 +151,16 @@
 			   (if s (string->symbol s) 'bup)))
 	 (archiver-cmd   (case archiver
 			   ((tar) "tar cfj ARCHIVE_NAME.tar.bz2 ")
 			   ((7z)  " 7z u -t7z -m0=lzma -mx=9 -mfb=64 -md=32m -ms=on ARCHIVE_NAME.7z ")
 			   (else #f)))
+         (src-archive-linktree (rmt:get-var "src-archive-linktree"))  
 	 (print-prefix      "Running: ") ;; change to #f to turn off printing
 	 (preclean-spec  (configf:get-section *configdat* "archive-preclean")))
 
+     (if (or (not src-archive-linktree) (not (equal? src-archive-linktree linktree)))      
+         (rmt:set-var "src-archive-linktree"  linktree))
     ;;     (tests:match patt testname itempath)
     
     ;; from the test info bin the path to the test by stem
     ;;
     (for-each
@@ -163,12 +167,11 @@
      (lambda (test-dat)
        (let* ((item-path         (db:test-get-item-path test-dat))
 	      (test-name         (db:test-get-testname  test-dat))
 	      (test-id           (db:test-get-id        test-dat))
 	      (run-id            (db:test-get-run_id    test-dat))
-	      (target            (string-intersperse (map cadr (rmt:get-key-val-pairs run-id)) "/"))
-	      
+	      	      
 	      (toplevel/children (and (db:test-get-is-toplevel test-dat)
 				      (> (rmt:test-toplevel-num-items run-id test-name) 0)))
 	      (test-partial-path (conc target "/" run-name "/" (db:test-make-full-name test-name item-path)))
 	      ;; note the trailing slash to get the dir inspite of it being a link
 	      (test-path         (conc linktree "/" test-partial-path))
@@ -221,11 +224,11 @@
 			" as it is a toplevel test with children"))
 	  ((not (common:file-exists? test-path))
 	   (debug:print 0 *default-log-port* "WARNING: Cannot archive " test-name "/" item-path
 			" as path " test-path " does not exist"))
 	  (else
-	   (debug:print 0 *default-log-port*
+	   (debug:print 2 *default-log-port*
 			"From test-dat=" test-dat " derived the following:\n"
 			"test-partial-path  = " test-partial-path "\n"
 			"test-path          = " test-path "\n"
 			"test-physical-path = " test-physical-path "\n"
 			"partial-path-index = " partial-path-index "\n"
@@ -265,27 +268,39 @@
 	     ((bup) ;; Archive using bup
 	      (let* ((bup-init-params  (list "-d" archive-dir "init"))
 		     (bup-index-params (append (list "-d" archive-dir "index") test-paths))
 		     (bup-save-params  (append (list "-d" archive-dir "save" ;; (conc "--strip-path=" linktree)
 						     (conc "-" compress) ;; or (conc "--compress=" compress)
-						     "-n" (conc (common:get-testsuite-name) "-" run-id)
-						     (conc "--strip-path=" test-base) ;; if we push to the directory do we need this?
+						     "-n" (conc (common:get-testsuite-name) "-"(string-substitute "/" "-" target " "))
+						     (conc "--strip-path=" (conc test-base target "/" )) ;; if we push to the directory do we need this?
 						     )
 					       test-paths)))
 		(if (not (common:file-exists? (conc archive-dir "/HEAD")))
 		    (begin
 		      ;; replace this with jobrunner stuff enventually
-		      (debug:print-info 0 *default-log-port* "Init bup in " archive-dir)
+		      (debug:print-info 2 *default-log-port* "Init bup in " archive-dir)
 		      ;; (mutex-lock! bup-mutex)
-		      (run-n-wait bup-exe params: bup-init-params print-cmd: print-prefix)
+		      (let-values (((pid-val exit-status exit-code) (run-n-wait bup-exe params: bup-init-params print-cmd: print-prefix)))
+                        (if (not (eq? exit-code 0))
+                              (begin    
+                              (debug:print-error 0 *default-log-port* "There was an error initializing bup. Archive failed.")
+                              (exit 1))))
 		      ;; (mutex-unlock! bup-mutex)
 		      ))
-		(debug:print-info 0 *default-log-port* "Indexing data to be archived")
+		(debug:print-info 2 *default-log-port* "Indexing data to be archived")
 		;; (mutex-lock! bup-mutex)
-		(run-n-wait bup-exe params: bup-index-params print-cmd: print-prefix)
-		(debug:print-info 0 *default-log-port* "Archiving data with bup")
-		(run-n-wait bup-exe params: bup-save-params print-cmd: print-prefix)))
+		(let-values (((pid-val exit-status exit-code) (run-n-wait bup-exe params: bup-index-params print-cmd: print-prefix)))
+                   (if (not (eq? exit-code 0))
+                              (begin    
+                              (debug:print-error 0 *default-log-port* "There was an error Indexing bup. Archive failed.")
+                              (exit 1))))
+		(debug:print-info 2 *default-log-port* "Archiving data with bup")
+		(let-values (((pid-val exit-status exit-code) (run-n-wait bup-exe params: bup-save-params print-cmd: print-prefix)))
+                     (if (not (eq? exit-code 0))
+                              (begin    
+                              (debug:print-error 0 *default-log-port* "There was an archiving data with bup. Archive failed.")
+                              (exit 1))))))
 	     ((7z tar)
 	      (for-each
 	       (lambda (test-dat)
 		 (let* ((test-id           (db:test-get-id        test-dat))
 			(test-name         (db:test-get-testname  test-dat))
@@ -318,10 +333,136 @@
 		    (runs:remove-test-directory test-dat 'archive-remove)))))
 	    (hash-table-ref test-groups test-base)))))
        (hash-table-keys disk-groups))
     #t))
 
+(define (archive:megatest-db target-patt run-patt)
+ (let* ((blockid-cache  (make-hash-table))
+        (tsname         (common:get-testsuite-name))
+        (min-space      (string->number (or (configf:lookup *configdat* "archive" "minspace") "1000")))
+        (bup-exe        (or (configf:lookup *configdat* "archive" "bup") "bup"))
+	(compress       (or (configf:lookup *configdat* "archive" "compress") "9"))
+        (archiver       (let ((s (configf:lookup *configdat* "archive" "archiver")))
+			   (if s (string->symbol s) 'bup)))
+        (rsync-exe (or (configf:lookup *configdat* "archive" "rsync") "rsync"))   
+        (print-prefix      "Running: ") 
+        (archive-info (archive:allocate-new-archive-block blockid-cache *toppath* tsname min-space target-patt run-patt "megatest-db"))
+	(archive-dir  (if archive-info (cdr archive-info) #f))
+	(archive-id   (if archive-info (car archive-info) -1))
+        (home-host (common:get-homehost))
+        (archive-time (seconds->std-time-str (current-seconds)))
+        (archive-staging-db (conc *toppath* "/.db-snapshot/archive_" archive-time))
+        (tmp-db-path (conc (common:get-db-tmp-area) "/megatest.db"))
+        (dbfile             (conc  archive-staging-db "/megatest.db"))) 
+        (create-directory archive-staging-db #t)
+        (let-values (((pid-val exit-status exit-code) (run-n-wait rsync-exe params: (list "-v" (conc (car home-host) ":"tmp-db-path) archive-staging-db) print-cmd: print-prefix)))
+            (if (eq? exit-code 0)   
+              (case archiver
+	        ((bup) ;; Archive using bup
+	          (let* ((bup-init-params  (list "-d" archive-dir "init"))
+		         (bup-index-params (list "-d" archive-dir "index" archive-staging-db))
+		         (bup-save-params  (list "-d" archive-dir "save" ;; (conc "--strip-path=" linktree)
+						     (conc "-" compress) ;; or (conc "--compress=" compress)
+						     "-n" (conc tsname "-megatest-db" )
+						     (conc "--strip-path=" archive-staging-db ) ;; if we push to the directory do we need this?
+						     dbfile)))
+                    (if (not (common:file-exists? (conc archive-dir "/HEAD")))
+		      (begin
+		        ;; replace this with jobrunner stuff enventually
+		        (debug:print-info 2 *default-log-port* "Init bup in " archive-dir)
+		         (let-values (((pid-val exit-status exit-code)(run-n-wait bup-exe params: bup-init-params print-cmd: print-prefix)))
+                          (if (not (eq? exit-code 0))
+                              (begin    
+                              (debug:print-error 0 *default-log-port* "There was an error initializing bup. Archive failed.")
+                              (exit 1))))))
+		     (debug:print-info 2 *default-log-port* "Indexing data to be archived")
+		     (let-values (((pid-val exit-status exit-code) (run-n-wait bup-exe params: bup-index-params print-cmd: print-prefix)))
+                        (if (not (eq? exit-code 0))
+                              (begin    
+                              (debug:print-error 0 *default-log-port* "There was an error Indexing bup. Archive failed.")
+                              (exit 1))))
+		     (debug:print-info 2 *default-log-port* "Archiving data with bup")
+		     (let-values (((pid-val exit-status exit-code) (run-n-wait bup-exe params: bup-save-params print-cmd: print-prefix)))
+                         (if (not (eq? exit-code 0))
+                              (begin    
+                              (debug:print-error 0 *default-log-port* "There was an error archiving data with bup. Archive failed.")
+                              (exit 1))
+                             (debug:print-info 2 *default-log-port* "To restore megatest.db run megatest -archive replicacte-db -source archive-dir -time-stamp <ts>. Current timestamp: " (seconds->std-time-str (current-seconds))))))) 
+               (else
+                   (debug:print-info 0 *default-log-port* "No support for databse archiving with " archiver)))
+               (debug:print-error 0 *default-log-port* "There was an error rsyncing tmp database")))))
+
+(define (archive:restore-db archive-path ts)
+   (let* ((bup-exe               (or (configf:lookup *configdat* "archive" "bup") "bup"))
+         (archive-internal-path (conc (common:get-testsuite-name) "-megatest-db/" ts "/megatest.db" ))
+         (bup-restore-params  (list "-d" archive-path "restore" "-C" *toppath* archive-internal-path)))
+		 (debug:print-info 0 *default-log-port* "Restoring archived data to " *toppath* " from archive in " archive-path " ... " archive-internal-path)
+		 (run-n-wait bup-exe params: bup-restore-params print-cmd: #f))
+      (db:multi-db-sync 
+       (db:setup #f)
+       'killservers
+       ;'dejunk
+       ;'adj-testids
+       'old2new
+       )
+      (debug:print-info 1 *default-log-port* "dropping trigerrs to update linktree")   
+      (rmt:drop-all-triggers)
+  
+    (let* ((linktree       (common:get-linktree)) ;; (configf:lookup *configdat* "setup" "linktree")))
+	  (src-archive-linktree (rmt:get-var "src-archive-linktree")))
+        (if (not (equal? src-archive-linktree linktree))
+           (rmt:update-tesdata-on-repilcate-db src-archive-linktree linktree))
+              (debug:print-info 1 *default-log-port* "creating triggers after updating linktree")   
+       (rmt:create-all-triggers)
+))  
+
+(define (archive:ls->list  bup-exe archive-dir internal-path)
+  (let ((cmd (conc bup-exe " -d " archive-dir  " ls -l " internal-path "| awk '{print $6}' | sort"))
+        (res '()))
+    (handle-exceptions
+     exn
+     #f ;; anything goes wrong - assume the process in NOT running.
+     (with-input-from-pipe 
+      cmd
+      (lambda ()
+	(let* ((inl (read-lines)))
+	  (reverse inl)))))))
+
+(define (time-string->seconds tstr ds-flag)
+ (let* ((atime (string->time tstr "%Y-%m-%d-%H%M%S")))
+       (vector-set! atime 8 ds-flag)
+     (local-time->seconds atime)))
+
+(define (seconds->std-time-str sec)
+  (time->string 
+   (seconds->local-time sec)
+   "%Y-%m-%d-%H%M%S"))
+ 
+
+(define (archive:get-timestamp-dir bup-exe archive-dir testsuite-name target test-partial-path test-last-update)
+    (print (seconds->std-time-str test-last-update)) 
+    (let* ((internal-path (conc testsuite-name "-" target))
+           (ts-list (archive:ls->list  bup-exe archive-dir internal-path))
+           (ds-flag (vector-ref (seconds->local-time) 8)))
+           (let loop ((hed (car ts-list))
+                       (tail (cdr ts-list)))
+                   (if (and (null? tail) (equal? hed "latest"))
+                        #f
+                    (if (and (not (null? tail)) (equal? hed "latest"))
+                        (loop (car tail) (cdr tail))
+                  (let* ((archive-seconds (time-string->seconds hed ds-flag)))
+                    (if (< (abs (- archive-seconds test-last-update)) 120)
+                    (let* ((test-list (archive:ls->list  bup-exe archive-dir (conc internal-path "/" hed "/" test-partial-path))))
+                           (if (> (length test-list) 0)
+                               hed
+                               (if (not (null? tail)) 
+                                 (loop (car tail) (cdr tail))
+                                 #f)))
+                       (if (null? tail)
+                          #f
+                          (loop (car tail) (cdr tail))))))))))
+
 (define (archive:bup-restore archive-command run-id run-name tests rp-mutex bup-mutex)  ;; move the getting of archive space down into the below block so that a single run can 
   ;; allocate as needed should a disk fill up
   ;;
   (let* ((bup-exe      (or (configf:lookup *configdat* "archive" "bup") "bup"))
 	 (linktree     (common:get-linktree))) ;; (configf:lookup *configdat* "setup" "linktree")))
@@ -339,11 +480,11 @@
 	      (keyvals           (rmt:get-key-val-pairs run-id))
 	      (target            (string-intersperse (map cadr keyvals) "/"))
 	      
 	      (toplevel/children (and (db:test-get-is-toplevel test-dat)
 				      (> (rmt:test-toplevel-num-items run-id test-name) 0)))
-	      (test-partial-path (conc target "/" run-name "/" (db:test-make-full-name test-name item-path)))
+	      (test-partial-path (conc  run-name "/" (db:test-make-full-name test-name item-path)))
 	      ;; note the trailing slash to get the dir inspite of it being a link
 	      (test-path         (conc linktree "/" test-partial-path))
 	      ;; if the old path was not deleted then prev-test-physical-path will end up pointing to a real directory
 	      (mutex-lock! rp-mutex)
 	      (prev-test-physical-path (if (common:file-exists? test-path)
@@ -351,21 +492,24 @@
 					   (common:real-path test-path)
 					   #f))
 	      (mutex-unlock! rp-mutex)
 	      (new-test-physical-path  (conc best-disk "/" test-partial-path))
 	      (archive-block-id        (db:test-get-archived test-dat))
+              (test-last-update        (db:test-get-last_update test-dat))
 	      (archive-block-info      (rmt:test-get-archive-block-info archive-block-id))
 	      (archive-path            (if (vector? archive-block-info)
 					   (vector-ref archive-block-info 2) ;; look in db.scm for test-get-archive-block-info for the vector record info
 					   #f)) ;; no archive found?
-	      (archive-internal-path   (conc (common:get-testsuite-name) "-" run-id "/latest/" test-partial-path))
+              (archive-timestamp-dir   (if archive-path (archive:get-timestamp-dir bup-exe archive-path (common:get-testsuite-name) (string-substitute "/" "-" target " ") test-partial-path test-last-update) #f))  
+	      (archive-internal-path   (conc (common:get-testsuite-name) "-" (string-substitute "/" "-" target " ") "/" archive-timestamp-dir "/" test-partial-path))
 	      (include-paths           (args:get-arg "-include"))
 	      (exclude-pattern         (args:get-arg "-exclude-rx"))
 	      (exclude-file            (args:get-arg "-exclude-rx-from")))
-	 
+	 (if (not archive-timestamp-dir)
+               (debug:print-error 0 *default-log-port* "Archive not found for testsuite" (common:get-testsuite-name) " run/test/itempath" test-partial-path)
+         (begin    
 	 ;; some sanity checks, move an existing path out of the way - iif it is not a toplevel with children
-	 ;;
 	 (if (and (not toplevel/children)  ;; special handling needed for toplevel with children
 		  prev-test-physical-path
 		  (common:file-exists? prev-test-physical-path)) ;; what to do? abort or clean up or link it in?
 	     (let* ((base (pathname-directory prev-test-physical-path))
 		    (dirn (pathname-file      prev-test-physical-path))
@@ -378,17 +522,14 @@
 	     (begin
 	       ;; CREATE WORK AREA
 	       ;; test-src-path == #f     ==> don't copy in data from tests directory
 	       ;; itemdat       == string ==> use directly
 	       (create-work-area run-id run-name keyvals test-id #f best-disk test-name item-path) ;; #!key (remtries 2))
-
 	       ;; 1. Get the block id from the test info
 	       ;; 2. Get the block data given the block id
 	       ;; 3. Construct the paths etc. for the following command:
-	       ;; 
 	       ;; bup -d /tmp/matt/adisk1/2015_q1/fullrun_e1a40/ restore -C /tmp/seeme fullrun-30/latest/ubuntu/nfs/none/w02.1.20.54_b/
-
 	       ;; DO BUP RESTORE
 	       (let* ((new-test-dat        (rmt:get-test-info-by-id run-id test-id))
 		      (new-test-path       (if (vector? new-test-dat )
 					       (db:test-get-rundir new-test-dat)
 					       (begin
@@ -395,15 +536,16 @@
 						 (debug:print-error 0 *default-log-port* "unable to get data for run-id=" run-id ", test-id=" test-id)
 						 (exit 1))))
 		      ;; new-test-path won't work - must use best-disk instead? Nope, new-test-path but tack on /..
 		      (bup-restore-params  (list "-d" archive-path "restore" "-C" (conc new-test-path "/..") archive-internal-path)))
 		 (debug:print-info 0 *default-log-port* "Restoring archived data to " new-test-physical-path " from archive in " archive-path " ... " archive-internal-path)
+                 (debug:print-info 0 *default-log-port* bup-exe " " (string-join  bup-restore-params " "))
 		 ;; (mutex-lock! bup-mutex)
 		 (run-n-wait bup-exe params: bup-restore-params print-cmd: #f)
 		 ;; (mutex-unlock! bup-mutex)
 		 (mt:test-set-state-status-by-id run-id test-id "COMPLETED" #f #f)))
-	     (debug:print-error 0 *default-log-port* "No archive path in the record for run-id=" run-id " test-id=" test-id))))
+	     (debug:print-error 0 *default-log-port* "No archive path in the record for run-id=" run-id " test-id=" test-id))))))
      (filter vector? tests))))
 
 (define (common:get-youngest-test tests)
   (if (null? tests)
       #f

Index: cgisetup/models/pgdb.scm
==================================================================
--- cgisetup/models/pgdb.scm
+++ cgisetup/models/pgdb.scm
@@ -177,15 +177,15 @@
    state status owner event-time comment fail-count pass-count last_update publish-time run-id area-id ))
 
 ;; given all needed info create run record
 ;;
 (define (pgdb:insert-run dbh ttype-id target run-name state status owner event-time comment fail-count pass-count area-id last-update publish-time)
-    (dbi:exec
+  (dbi:exec
    dbh
    "INSERT INTO runs (ttype_id,target,run_name,state,status,owner,event_time,comment,fail_count,pass_count,area_id,last_update,publish_time)
       VALUES (?,?,?,?,?,?,?,?,?,?,?,?, ?);"
-    ttype-id target run-name state status owner event-time comment fail-count pass-count area-id last-update publish-time))
+   ttype-id target run-name state status owner event-time comment fail-count pass-count area-id last-update publish-time))
 
 ;;======================================================================
 ;;  T E S T - S T E P S
 ;;======================================================================
 

ADDED   chicken.makefile
Index: chicken.makefile
==================================================================
--- /dev/null
+++ chicken.makefile
@@ -0,0 +1,179 @@
+
+#  Copyright 2006-2017, Matthew Welland.
+# 
+# This file is part of Megatest.
+# 
+#     Megatest is free software: you can redistribute it and/or modify
+#     it under the terms of the GNU General Public License as published by
+#     the Free Software Foundation, either version 3 of the License, or
+#     (at your option) any later version.
+# 
+#     Megatest is distributed in the hope that it will be useful,
+#     but WITHOUT ANY WARRANTY; without even the implied warranty of
+#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#     GNU General Public License for more details.
+# 
+#     You should have received a copy of the GNU General Public License
+#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
+
+
+#======================================================================
+# Chicken build
+#======================================================================
+
+# CHICKEN_BIN_DIR=$(shell dirname $(shell which csi))
+# if have csi on path use that, else use default
+# CSIPATH=$(shell which csi)
+# CKPATH=$(shell dirname $(shell dirname $(CSIPATH)))
+CHICKEN_PREFIX=$(or $(CKPATH),$(PREFIX)/bin/.$(ARCHSTR))
+
+whatever :
+	@echo "CHICKEN_PREFIX=$(CHICKEN_PREFIX)"
+
+tgz-$(USER)/postgresql-9.6.4.tar.gz :
+	mkdir -p tgz-$(USER)
+	wget -c https://ftp.postgresql.org/pub/source/v9.6.4/postgresql-9.6.4.tar.gz
+	mv postgresql-9.6.4.tar.gz tgz-$(USER)/
+
+tgz-$(USER)/sqlite-autoconf-3090200.tar.gz :
+	mkdir -p tgz-$(USER)
+	curl http://www.sqlite.org/2015/sqlite-autoconf-3090200.tar.gz > tgz-$(USER)/sqlite-autoconf-3090200.tar.gz 
+
+tgz-$(USER)/nanomsg-1.0.0.tar.gz :
+	wget --no-check-certificate https://github.com/nanomsg/nanomsg/archive/1.0.0.tar.gz
+	mv 1.0.0.tar.gz tgz-$(USER)/nanomsg-1.0.0.tar.gz	
+
+tgz-$(USER)/chicken-4.13.0.tar.gz :
+	mkdir -p tgz-$(USER)
+	curl https://code.call-cc.org/releases/4.13.0/chicken-4.13.0.tar.gz > tgz-$(USER)/chicken-4.13.0.tar.gz
+
+tgz-$(USER)/ffcall.tar.gz :
+	wget -c -O tgz-$(USER)/ffcall.tar.gz 'http://www.kiatoa.com/fossils/ffcall/tarball?name=ffcall&uuid=trunk'
+
+$(CHICKEN_PREFIX)/bin/pg_config : tgz-$(USER)/postgresql-9.6.4.tar.gz
+	mkdir -p build-$(USER)/
+	tar xfz tgz-$(USER)/postgresql-9.6.4.tar.gz -C build-$(USER)
+	cd build-$(USER)/postgresql-9.6.4; ./configure --prefix=$(CHICKEN_PREFIX) --with-openssl; make; make install
+
+build-$(USER)/sqlite-autoconf-3090200/configure : tgz-$(USER)/sqlite-autoconf-3090200.tar.gz
+	mkdir -p build-$(USER);
+	cd build-$(USER); tar xf ../tgz-$(USER)/sqlite-autoconf-3090200.tar.gz
+
+$(CHICKEN_PREFIX)/lib/libnanomsg.so : tgz-$(USER)/nanomsg-1.0.0.tar.gz
+	cd tgz-$(USER); tar -xzvf nanomsg-1.0.0.tar.gz
+	cd tgz-$(USER)/nanomsg-1.0.0; mkdir build-$(USER); cd build-$(USER);
+	cd tgz-$(USER)/nanomsg-1.0.0/build-$(USER); cmake ../ -DCMAKE_INSTALL_PREFIX=$(CHICKEN_PREFIX)
+	cd tgz-$(USER)/nanomsg-1.0.0/build-$(USER); make; make install
+
+$(CHICKEN_PREFIX)/chicken-4.13.0/LICENSE : tgz-$(USER)/chicken-4.13.0.tar.gz
+	mkdir -p build-$(USER)/eggs-installed
+	cd build-$(USER);tar xf ../tgz-$(USER)/chicken-4.13.0.tar.gz
+	if [[ -e $(CHICKEN_PREFIX)/chicken-4.13.0/LICENSE ]];then touch $(CHICKEN_PREFIX)/chicken-4.13.0/LICENSE;fi
+
+tgz-$(USER)/opensrc.fossil :
+	cd tgz-$(USER); fossil clone http://www.kiatoa.com/fossils/opensrc opensrc.fossil
+	mkdir tgz-$(USER)/opensrc
+	cd tgz-$(USER)/opensrc; fossil open --nested ../opensrc.fossil; fossil up; fossil uv sync
+
+$(CHICKEN_PREFIX)/lib/libiupweb.so : tgz-$(USER)/opensrc.fossil
+	cd tgz-$(USER)/opensrc; fossil unversioned cat libs/cd/cd-5.10_Linux26g4_64_lib.tar.gz > ../cd.tgz
+	cd tgz-$(USER)/opensrc; fossil unversioned cat libs/im/im-3.11_Linux26g4_64_lib.tar.gz > ../im.tgz
+	cd tgz-$(USER)/opensrc; fossil unversioned cat libs/iup/iup-3.19.1_Linux26g4_64_lib.tar.gz > ../iup.tgz
+	cd tgz-$(USER); tar -xzf cd.tgz;
+	cd tgz-$(USER); tar -xzf im.tgz;
+	cd tgz-$(USER); tar -xzf iup.tgz;
+	cp tgz-$(USER)/include/* $(CHICKEN_PREFIX)/include/
+	cp tgz-$(USER)/*.so $(CHICKEN_PREFIX)/lib/
+	cp tgz-$(USER)/*.a  $(CHICKEN_PREFIX)/lib/
+	cp tgz-$(USER)/ftgl/lib/*/* $(CHICKEN_PREFIX)/lib/
+
+EGGS=srfi-69 srfi-42 sqlite3 iup canvas-draw typed-records md5 regex-case base64 \
+format dot-locking csv-xml z3 udp hostinfo directory-utils stack dbi crypt sha1 \
+posix-extras pathname-expand csv call-with-environment-variables s11n spiffy \
+uri-common intarweb http-client spiffy-request-vars spiffy-directory-listing \
+ansi-escape-sequences test slice rfc3339 uuid-lib filepath srfi-19 sparse-vectors \
+sql-de-lite fmt readline apropos json simple-exceptions rpc trace logpro refdb postgresql nanomsg
+EGGSTARG=$(addsuffix .done,$(addprefix build-$(USER)/eggs-installed/,$(EGGS)))
+EGGSTARG2=$(addsuffix .done, $(EGGS))
+
+$(CHICKEN_PREFIX)/lib/libcallback.a : tgz-$(USER)/ffcall.tar.gz
+	cd tgz-$(USER); tar -xzvf ffcall.tar.gz 
+	cd tgz-$(USER)/ffcall; ./configure --prefix=$(CHICKEN_PREFIX) --enable-shared
+	cd tgz-$(USER)/ffcall; make CC="gcc -fPIC"; make install	
+
+$(CHICKEN_PREFIX)/bin/sqlite3 : build-$(USER)/sqlite-autoconf-3090200/configure 
+	cd build-$(USER)/sqlite-autoconf-3090200; ./configure --prefix=$(CHICKEN_PREFIX); make; make install
+
+$(CHICKEN_PREFIX)/bin/csi : $(SQLITE3_DEP) $(CHICKEN_PREFIX)/lib/libiupweb.so $(CHICKEN_PREFIX)/chicken-4.13.0/LICENSE
+	cd build-$(USER)/chicken-4.13.0;make PLATFORM=linux PREFIX=$(CHICKEN_PREFIX) 
+	cd build-$(USER)/chicken-4.13.0;make PLATFORM=linux PREFIX=$(CHICKEN_PREFIX) install
+
+ALL_CKBIN=chicken chicken-bind chicken-bug chicken-dump			\
+chicken-install chicken-profile chicken-sqlite3 chicken-status		\
+chicken-uninstall csc csi feathers nanocat sqlite3 vacuumdb logpro	\
+refdb
+
+CKBIN_WRAPPERS=$(addprefix $(PREFIX)/bin/,$(ALL_CKBIN))
+
+$(PREFIX)/bin/% : $(CHICKEN_PREFIX)/bin/% $(CHICKEN_PREFIX)/bin/csi
+	utils/mk_wrapper_tool $(PREFIX) $* $(PREFIX)/bin/$*
+	chmod a+x $(PREFIX)/bin/$*
+
+$(PREFIX)/bin :
+	mkdir -p $(PREFIX)/bin $(CHICKEN_PREFIX)/bin
+
+# For the future -   binwrappers
+chicken : $(PREFIX)/bin $(CHICKEN_PREFIX)/bin/csi  postgresql.done nanomsg.done iup.done canvas-draw.done sqlite3.done sql-de-lite.done dbi.done  $(EGGSTARG2)
+	@echo "Fake target to build prefix chicken"
+
+binwrappers : $(CKBIN_WRAPPERS)
+
+# make the dep a dummy if not requiring our own build of postgres
+ifeq ($(BUILD_POSTGRES),yes)
+PG_DEP=$(CHICKEN_PREFIX)/bin/pg_config
+else
+PG_DEP=$(CHICKEN_PREFIX)/bin/csi
+endif
+
+postgresql.done : $(PG_DEP)
+	CSC_OPTIONS="-I$(CHICKEN_PREFIX)/include -L$(CHICKEN_PREFIX)/lib -L$(CHICKEN_PREFIX)/lib64" $(CHICKEN_PREFIX)/bin/chicken-install postgresql > postgresql.done
+
+ifeq ($(BUILD_NANOMSG),yes)
+NMSG_DEP=$(CHICKEN_PREFIX)/lib/libnanomsg.so
+else
+NMSG_DEP=$(CHICKEN_PREFIX)/bin/csi
+endif
+
+nanomsg.done : $(NMSG_DEP)
+	CSC_OPTIONS="-I$(CHICKEN_PREFIX)/include -L$(CHICKEN_PREFIX)/lib -L$(CHICKEN_PREFIX)/lib64" $(CHICKEN_PREFIX)/bin/chicken-install nanomsg > nanomsg.done
+
+iup.done : $(CHICKEN_PREFIX)/lib/libcallback.a
+	CSC_OPTIONS="-I$(CHICKEN_PREFIX)/include -L$(CHICKEN_PREFIX)/lib" $(CHICKEN_PREFIX)/bin/chicken-install -D no-library-checks -feature disable-iup-web -feature disable-iup-pplot -feature disable-iup-matrixex iup > iup.done
+
+canvas-draw.done :
+	CSC_OPTIONS="-I$(CHICKEN_PREFIX)/include -L$(CHICKEN_PREFIX)/lib" $(CHICKEN_PREFIX)/bin/chicken-install -D no-library-checks canvas-draw > canvas-draw.done
+
+# make the dep a dummy if not requiring our own build of postgres
+ifeq ($(BUILD_SQLITE3),yes)
+SQLITE3_DEP=$(CHICKEN_PREFIX)/bin/sqlite3
+else
+SQLITE3_DEP=$(CHICKEN_PREFIX)/bin/csi
+endif
+
+sqlite3.done : $(SQLITE3_DEP)
+	CSC_OPTIONS="-I$(CHICKEN_PREFIX)/include -L$(CHICKEN_PREFIX)/lib" $(CHICKEN_PREFIX)/bin/chicken-install sqlite3 > sqlite3.done
+
+sql-de-lite.done :
+	CSC_OPTIONS="-I$(CHICKEN_PREFIX)/include -L$(CHICKEN_PREFIX)/lib" $(CHICKEN_PREFIX)/bin/chicken-install sql-de-lite > sql-de-lite.done
+
+dbi.done : postgresql.done sqlite3.done sql-de-lite.done
+	CSC_OPTIONS="-I$(CHICKEN_PREFIX)/include -L$(CHICKEN_PREFIX)/lib" $(CHICKEN_PREFIX)/bin/chicken-install dbi > dbi.done
+
+%.done :
+	$(CHICKEN_PREFIX)/bin/chicken-install $* > $*.done
+
+build-$(USER)/eggs-installed/%.done : $(CHICKEN_PREFIX)/bin/csi $(EGGS)
+	$(CHICKEN_PREFIX)/bin/chicken-install $* > build-$(USER)/eggs-installed/$*.done
+
+build-clean :
+	rm -rf build-$(USER) bin

Index: common.scm
==================================================================
--- common.scm
+++ common.scm
@@ -26,12 +26,12 @@
      (prefix sqlite3 sqlite3:)
      pkts (prefix dbi dbi:)
      )
 
 (declare (unit common))
-(declare (uses commonmod))
-(import commonmod)
+;; (declare (uses commonmod))
+;; (import commonmod)
 
 (include "common_records.scm")
 
 
 ;; (require-library margs)
@@ -49,11 +49,11 @@
 ;; arguments - thunk, message
 (define (common:fail-safe thunk warning-message-on-exception)
   (handle-exceptions
    exn
    (begin
-     (debug:print-info 0 *default-log-port* "notable but nonfatal condition - "warning-message-on-exception)
+     (debug:print-info 0 *default-log-port* "notable but nonfatal condition - "warning-message-on-exception", exn=" exn)
      (debug:print-info 0 *default-log-port*
                        (string-substitute "\n?Error:" "nonfatal condition:"
                                           (with-output-to-string
                                             (lambda ()
                                               (print-error-message exn) ))))
@@ -61,17 +61,19 @@
      #f)
    (thunk)))
 
 (define getenv get-environment-variable)
 (define (safe-setenv key val)
-  (if (or (substring-index "!" key) (substring-index ":" key)) ;; variables containing : are for internal use and cannot be environment variables.
+  (if (or (substring-index "!" key)
+	  (substring-index ":" key)  ;; variables containing : are for internal use and cannot be environment variables.
+	  (substring-index "." key)) ;; periods are not allowed in environment variables
       (debug:print-error 4 *default-log-port* "skip setting internal use only variables containing \":\" or starting with \"!\"")
       (if (and (string? val)
 	       (string? key))
 	  (handle-exceptions
 	      exn
-	      (debug:print-error 0 *default-log-port* "bad value for setenv, key=" key ", value=" val)
+	      (debug:print-error 0 *default-log-port* "bad value for setenv, key=" key ", value=" val ", exn=" exn)
 	    (setenv key val))
 	  (debug:print-error 0 *default-log-port* "bad value for setenv, key=" key ", value=" val))))
 
 (define home (getenv "HOME"))
 (define user (getenv "USER"))
@@ -226,10 +228,32 @@
          (fullpath (realpath this-script)))
     fullpath))
 (define *common:this-exe-fullpath* (common:get-this-exe-fullpath))
 (define *common:this-exe-dir*      (pathname-directory *common:this-exe-fullpath*))
 (define *common:this-exe-name*     (pathname-strip-directory *common:this-exe-fullpath*))
+
+;; when called from a wrapper I need sometimes to find the calling
+;; wrapper, this is for dashboard to find the correct megatest.
+;;
+(define (common:find-local-megatest #!optional (progname "megatest"))
+  (let ((res (filter file-exists?
+		     (map (lambda (updir)
+			    (let* ((lm  (car (argv)))
+				   (dir (pathname-directory lm))
+				   (exe (pathname-strip-directory lm)))
+			      (conc (if dir (conc dir "/") "")
+				    (case (string->symbol exe)
+				      ((dboard)    (conc updir progname))
+				      ((mtest)     (conc updir progname))
+				      ((dashboard) progname)
+				      (else exe)))))
+			  '("../../" "../")))))
+    (if (null? res)
+	(begin
+	  (debug:print 0 *current-log-port* "Failed to find this executable! Using what can be found on the path")
+	  progname)
+	(car res))))
 
 (define *common:logpro-exit-code->status-sym-alist*
   '( ( 0 . pass )
      ( 1 . fail )
      ( 2 . warn )
@@ -464,11 +488,20 @@
           (copy daysfile wksfile)
           (copy hrsfile daysfile))
         #t)
       #f))
   
-        
+(define (common:safe-vector-ref vec indx default)
+  (if (vector? vec)
+      (handle-exceptions
+	  exn
+	(begin
+	  (debug:print-info 0 *default-log-port* "remote data issue: exn=" exn)
+	  default)
+	(vector-ref vec indx))
+      default))
+
         
 ;; Rotate logs, logic: 
 ;;                 if > 500k and older than 1 week:
 ;;                     remove previous compressed log and compress this log
 ;; WARNING: This proc operates assuming that it is in the directory above the
@@ -484,23 +517,25 @@
     (directory-fold 
      (lambda (file rem)
        (handle-exceptions
 	exn
 	(begin
-	  (debug:print-info 2 *default-log-port* "unable to rotate log " file ", probably handled by another process, this is safe to ignore.")
+	  (debug:print-info 2 *default-log-port* "unable to rotate log " file ", probably handled by another process, this is safe to ignore. exn=" exn)
 	  (debug:print 2 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
 	  ;; (print-call-chain (current-error-port)) ;; 
 	  )
 	(let* ((fullname  (conc "logs/" file))
 	       (mod-time  (file-modification-time fullname))
-	       (file-age  (- (current-seconds) mod-time)))
+	       (file-age  (- (current-seconds) mod-time))
+	       (file-old  (> file-age (* 48 60 60)))
+	       (file-big  (> (file-size fullname) 200000)))
 	  (hash-table-set! all-files file mod-time)
 	  (if (or (and (string-match "^.*.log" file)
-		       (> (file-size fullname) 200000))
+		       file-old
+		       file-big)
 		  (and (string-match "^server-.*.log" file)
-		       (> (- (current-seconds) (file-modification-time fullname))
-			  (* 8 60 60))))
+		       file-old))
 	      (let ((gzfile (conc fullname ".gz")))
 		(if (common:file-exists? gzfile)
 		    (begin
 		      (debug:print-info 0 *default-log-port* "removing " gzfile)
 		      (delete-file* gzfile)
@@ -510,17 +545,18 @@
 		(system (conc "gzip " fullname))
 		(inc-stat "gzipped")
 		(hash-table-set! all-files (conc file ".gz") file-age)  ;; add the .gz file and remove the base file
 		(hash-table-delete! all-files file)
 		)
-	      (if (> file-age (* (string->number (or (configf:lookup *configdat* "setup" "log-expire-days") "30")) 24 3600))
+	      (if (and (> file-age (* (string->number (or (configf:lookup *configdat* "setup" "log-expire-days") "30")) 24 3600))
+		       (file-exists? fullname)) ;; just in case it was gzipped - will get it next time
 		  (handle-exceptions
 		   exn
 		   #f
 		   (if (directory? fullname)
 		       (begin
-			 (debug:print-error 0 *default-log-port* fullname " in logs directory is a directory! Cannot rotate it, it is best to not put subdirectories in the logs dir.")
+			 (debug:print-info 0 *default-log-port* fullname " in logs directory is a directory! Cannot rotate it, it is best to not put subdirectories in the logs dir.")
 			 (inc-stat "directories"))
 		       (begin
 			 (delete-file* fullname)
 			 (inc-stat "deleted")))
 		   (hash-table-delete! all-files file)))))))
@@ -540,14 +576,14 @@
 			     (- num-logs max-allowed))))
 	    (for-each
 	     (lambda (file)
 	       (let* ((fullname (conc "logs/" file)))
 		 (if (directory? fullname)
-		     (debug:print-error 0 *default-log-port* fullname " in logs directory is a directory! Cannot rotate it, it is best to not put subdirectories in the logs dir.")
+		     (debug:print-info 0 *default-log-port* fullname " in logs directory is a directory! Cannot rotate it, it is best to not put subdirectories in the logs dir.")
 		     (handle-exceptions
 		      exn
-		      (debug:print-error 0 *default-log-port* "failed to remove " fullname)
+		      (debug:print-error 0 *default-log-port* "failed to remove " fullname ", exn=" exn)
 		      (delete-file* fullname)))))
 	     files)
 	    (debug:print-info 0 *default-log-port* "Deleted " (length files) " files from logs, keeping " max-allowed " files."))))))
   
 ;; Force a megatest cleanup-db if version is changed and skip-version-check not specified
@@ -570,11 +606,11 @@
                    (eq? (current-user-id)(file-owner mtconf))) ;; safe to run -cleanup-db
               (debug:print 0 *default-log-port* "   I see you are the owner of megatest.config, attempting to cleanup and reset to new version")
               (handle-exceptions
                exn
                (begin
-                 (debug:print 0 *default-log-port* "Failed to switch versions.")
+                 (debug:print 0 *default-log-port* "Failed to switch versions. exn=" exn)
                  (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
                  (print-call-chain (current-error-port))
                  (exit 1))
                (common:cleanup-db dbstruct)))
              ((not (common:file-exists? mtconf))
@@ -681,11 +717,11 @@
   (handle-exceptions
    exn
    (handle-exceptions
     exn
     (begin
-      (debug:print-error 0 *default-log-port* "received bad encoded string \"" instr "\", message: " ((condition-property-accessor 'exn 'message) exn))
+      (debug:print-error 0 *default-log-port* "received bad encoded string \"" instr "\", message: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn)
       (print-call-chain (current-error-port))
       #f)
     (read (open-input-string (base64:base64-decode instr))))
    (read (open-input-string (z3:decode-buffer (base64:base64-decode instr))))))
 
@@ -881,13 +917,15 @@
 
 (define (common:get-testsuite-name)
   (or (configf:lookup *configdat* "setup" "area-name") ;; megatest is a flexible tool, testsuite is too limiting a description.
       (configf:lookup *configdat* "setup" "testsuite" )
       (getenv "MT_TESTSUITE_NAME")
-      (if (string? *toppath* )
-          (pathname-file *toppath*)
-          #f))) ;; (pathname-file (current-directory)))))
+      (pathname-file (or (if (string? *toppath* )
+			     (pathname-file *toppath*)
+			     #f)
+			 (common:get-topath #f)))
+      "please-set-setup-area-name")) ;; (pathname-file (current-directory)))))
 
 ;; safe getting of toppath
 (define (common:get-toppath areapath)
   (or *toppath*
       (if areapath
@@ -919,19 +957,25 @@
       *db-cache-path*
       (if *toppath* ;; common:get-create-writeable-dir
 	  (handle-exceptions
 	      exn
 	      (begin
-		(debug:print-error 0 *default-log-port* "Couldn't create path to " *db-cache-path*)
+		(debug:print-error 0 *default-log-port* "Couldn't create path to " *db-cache-path* ", exn=" exn)
 		(exit 1))
-	    (let ((dbpath (common:get-create-writeable-dir
-			   (list (conc "/tmp/" (current-user-name)
-				       "/megatest_localdb/"
-				       (common:get-testsuite-name) "/"
-				       (string-translate *toppath* "/" ".")))))) ;;  #t))))
-	      (set! *db-cache-path* dbpath)
-	      dbpath))
+	      (let* ((tsname (common:get-testsuite-name))
+		     (dbpath (common:get-create-writeable-dir
+			      (list (conc "/tmp/" (current-user-name)
+					  "/megatest_localdb/"
+					  tsname "/"
+					  (string-translate *toppath* "/" "."))
+				    (conc "/tmp/" (current-process-id) ;; just in case we have an issue with the dir by own user name
+					  "/megatest_localdb/"
+					  tsname
+					  (string-translate *toppath* "/" "."))
+				    ))))
+		(set! *db-cache-path* dbpath)
+		dbpath))
 	  #f)))
 
 (define (common:get-area-path-signature)
   (message-digest-string (md5-primitive) *toppath*))
 
@@ -1003,11 +1047,11 @@
 	     ((dbr:dbstruct-read-only dbstruct)
 	      (debug:print-info 13 *default-log-port* "loading read-only watchdog")
 	      (common:readonly-watchdog dbstruct))
 	     (else
 	      (debug:print-info 13 *default-log-port* "loading writable-watchdog.")
-              (let* ((syncer (or (configf:lookup *configdat* "server" "sync-method") "brute-force-sync")))
+              (let* ((syncer (or (configf:lookup *configdat* "server" "sync-method") "delta-sync"))) ;; "brute-force-sync")))
                 (cond
                  ((equal? syncer "brute-force-sync")
                   (server:writable-watchdog-bruteforce dbstruct))
                  ((equal? syncer "delta-sync")
                   (server:writable-watchdog-deltasync dbstruct))
@@ -1164,11 +1208,12 @@
 			    (file-write-access? hed)
 			    hed)
 		       (handle-exceptions
 			   exn
 			   (begin
-			     (debug:print-info 0 *default-log-port* "could not create " hed ", this might cause problems down the road.")
+			     (debug:print-info 0 *default-log-port* "could not create " hed
+					       ", this might cause problems down the road. exn=" exn)
 			     #f)
 			(create-directory hed #t)))))
 	  (if (and (string? res)
 		   (directory? res))
 	      res
@@ -1308,12 +1353,14 @@
 ;;
 ;;    returns the directory or #f
 ;;
 (define (common:directory-writable? path-string)
   (handle-exceptions
-   exn
-   #f
+      exn
+    (begin
+      (debug:print 0 *default-log-port* "Failed to identify access to " path-string ", exn=" exn)
+      #f)
    (if (and (directory-exists? path-string)
             (file-write-access? path-string))
        path-string
        #f)))
 
@@ -1402,16 +1449,20 @@
 			 (handle-exceptions
 			     exn
 			     (if (> trynum 0)
 				 (let ((delay-time (* (- 5 trynum) 5)))
 				   (mutex-unlock! *homehost-mutex*)
-				   (debug:print 0 *default-log-port* "ERROR: ["(common:human-time)"] Failed to read .homehost file, delaying " delay-time " seconds and trying again, message: "  ((condition-property-accessor 'exn 'message) exn))
+				   (debug:print 0 *default-log-port* "ERROR: ["(common:human-time)"] Failed to read .homehost file, delaying "
+						delay-time " seconds and trying again, message: "  ((condition-property-accessor 'exn 'message) exn)
+						", exn=" exn)
 				   (thread-sleep! delay-time)
 				   (common:get-homehost trynum: (- trynum 1)))
 				 (begin
 				   (mutex-unlock! *homehost-mutex*)
-				   (debug:print 0 *default-log-port* "ERROR: ["(common:human-time)"] Failed to read .homehost file after trying five times. Giving up and exiting, message: "  ((condition-property-accessor 'exn 'message) exn))
+				   (debug:print 0 *default-log-port* "ERROR: ["(common:human-time)
+						"] Failed to read .homehost file after trying five times. Giving up and exiting, message: "
+						((condition-property-accessor 'exn 'message) exn))
 				   (exit 1)))
 			   (let ((hhf (conc *toppath* "/.homehost")))
 			     (if (common:file-exists? hhf)
 				 (with-input-from-file hhf read-line)
 				 (if (file-write-access? *toppath*)
@@ -1662,26 +1713,32 @@
 ;; lazy-safe get file mod time. on any error (file not existing etc.) return 0
 ;;
 (define (common:lazy-modification-time fpath)
   (handle-exceptions
       exn
-      0
-    (file-modification-time fpath)))
+    (begin
+      (debug:print 0 *default-log-port* "Failed to get modifcation time for " fpath ", treating it as zero. exn=" exn)
+      0)
+    (if (file-exists? fpath)
+	(file-modification-time fpath)
+	0)))
 
 ;; find timestamp of newest file associated with a sqlite db file
 (define (common:lazy-sqlite-db-modification-time fpath)
   (let* ((glob-list (handle-exceptions
 			exn
-			`(,(conc "/no/such/file, message: " ((condition-property-accessor 'exn 'message) exn)))
+		      (begin
+			(debug:print 0 *default-log-port* "Failed to glob " fpath "*, exn=" exn)
+			`(,(conc "/no/such/file, message: " ((condition-property-accessor 'exn 'message) exn))))
 		      (glob (conc fpath "*"))))
          (file-list (if (eq? 0 (length glob-list))
 			'("/no/such/file")
 			glob-list)))
   (apply max
-   (map
-    common:lazy-modification-time 
-    file-list))))
+	 (map
+	  common:lazy-modification-time 
+	  file-list))))
 
 ;; return a nice clean pathname made absolute
 (define (common:nice-path dir)
   (let ((match (string-match "^(~[^\\/]*)(\\/.*|)$" dir)))
     (if match ;; using ~ for home?
@@ -1695,16 +1752,60 @@
 
 (define (common:read-link-f path)
   (handle-exceptions
       exn
       (begin
-	(debug:print-error 0 *default-log-port* "command \"/bin/readlink -f " path "\" failed.")
+	(debug:print-error 0 *default-log-port* "command \"/bin/readlink -f " path "\" failed. exn=" exn)
 	path) ;; just give up
     (with-input-from-pipe
 	(conc "/bin/readlink -f " path)
       (lambda ()
 	(read-line)))))
+
+;; returns *effective load* (not normalized)
+;;
+(define (common:get-intercept onemin fivemin)
+  (if (< onemin fivemin) ;; load is decreasing, just use the onemin load
+      onemin
+      (let* ((load-change (- onemin fivemin))
+	     (tchange     (- 300 60)))
+	(max (+ onemin (* 60 (/ load-change tchange))) 0))))
+
+;; calculate a delay number based on a droop curve
+;;    inputs are:
+;;      - load-in, load as from uptime, NOT normalized
+;;      - numcpus, number of cpus, ideally use the real cpus, not threads
+;;
+(define (common:get-delay load-in numcpus)
+  (let* ((ratio (/ load-in numcpus))
+         (new-option (configf:lookup *configdat* "load" "new-load-method"))
+	 (paramstr   (or (configf:lookup *configdat* "load" "exp-params")
+			 "15 12 1281453987.9543 0.75")) ;; 5 4 10 1"))
+	 (paramlst   (map string->number (string-split paramstr))))
+    (if new-option
+	(begin
+          (cond ((and (>= ratio 0) (< ratio .5))
+		 0)
+		((and (>= ratio 0.5) (<= ratio .9))
+		 (* ratio (/ 5 .9)))
+		((and (> ratio .9) (<= ratio 1.1))
+		 (+ 5 (* (- ratio .9) (/ 55 .2)))) 
+		((> ratio 1.1)
+		 60)))
+	(match paramlst
+	  ((r1 r2 s1 s2)
+	   (debug:print 3 *default-log-port* "Using params r1=" r1 " r2=" r2 " s1=" s1 " s2=" s2)
+	   (min (max (/ (expt r1 (* r2 s2 ratio)) s1) 0) 30))
+	  (else
+	   (debug:print 0 *default-log-port* "BAD exp-params, should be \"r1 r2 s1 s2\" but got " paramstr)
+	   30)))))
+
+(define (common:print-delay-table)
+  (let loop ((x 0))
+    (print x "," (common:get-delay x 1))
+    (if (< x 2)
+	(loop (+ x 0.1)))))
 
 (define (get-cpu-load #!key (remote-host #f))
   (car (common:get-cpu-load remote-host)))
 ;;   (let* ((load-res (process:cmd-run->list "uptime"))
 ;; 	 (load-rx  (regexp "load average:\\s+(\\d+)"))
@@ -1721,28 +1822,44 @@
 ;; get values from cached info from dropping file in logs dir
 ;;  e.g. key is host and dtype is normalized-load
 ;;
 (define (common:get-cached-info key dtype #!key (age 10))
   (if *toppath*
-      (let* ((fullpath (conc *toppath* "/.sysdata/" key "-" dtype ".log")))
+      (let* ((fullpath (conc *toppath* "/.sysdata/" key "-" dtype ".log"))
+	     (delfile  (lambda ()
+			 (debug:print-info 1 *default-log-port* " removing bad file " fullpath ", exn=" exn)
+			 (delete-file* fullpath)
+			 #f)))
 	(if (and (file-exists? fullpath)
 		 (file-read-access? fullpath))
 	    (handle-exceptions
-	     exn
-	     #f
+		exn
+	      (begin
+		(debug:print 0 *default-log-port* "failed to get cached info from " fullpath ", exn=" exn)
+		#f)
 	     (debug:print 2 *default-log-port* "reading file " fullpath)
-	     (let ((real-age (- (current-seconds)(file-change-time fullpath)))) 
+	     (let ((real-age (- (current-seconds)
+				(handle-exceptions
+				    exn
+				  (begin
+				    (debug:print 1 *default-log-port* "Failed to read mod time on file "
+						 fullpath ", using 0, exn=" exn)
+				    0)
+				  (file-change-time fullpath)))))
 	       (if (< real-age age)
 		   (handle-exceptions
 		       exn
-		     (begin
-		       (debug:print-info 1 *default-log-port* " removing bad file " fullpath)
-		       (delete-file* fullpath)
-		       #f)
-		     (with-input-from-file fullpath read))
+		     (delfile)
+		     (let* ((res (with-input-from-file fullpath read)))
+		       (if (eof-object? res)
+			   (begin
+			     (delfile)
+			     #f)
+			   res)))
 		   (begin
-		     (debug:print-info 2 *default-log-port* "file " fullpath " is too old (" real-age" seconds) to trust, skipping reading it")
+		     (debug:print-info 2 *default-log-port* "file " fullpath
+				       " is too old (" real-age" seconds) to trust, skipping reading it")
 		     #f))))
 	    (begin
 	      (debug:print 2 *default-log-port* "not reading file " fullpath)
 	      #f)))
       #f))
@@ -1751,33 +1868,56 @@
   (if *toppath*
       (let* ((fulldir  (conc *toppath* "/.sysdata"))
 	     (fullpath (conc fulldir "/" key "-" dtype ".log")))
 	(if (not (file-exists? fulldir))(create-directory fulldir #t))
 	(handle-exceptions
-	 exn
-	 #f
-	 (with-output-to-file fullpath (lambda ()(pp dat)))))
+	    exn
+	  (begin
+	    (debug:print 0 *default-log-path* "failed to write file " fullpath ", exn=" exn)
+	    #f)
+	  (with-output-to-file fullpath (lambda ()(pp dat)))))
       #f))
-  
+
+(define (common:raw-get-remote-host-load remote-host)
+  (handle-exceptions
+      exn
+    (begin
+      (debug:print 0 *default-log-port* "failed to ssh to " remote-host " and get loadavg. exn=" exn)
+      #f) ;; more specific handling of errors needed
+    (with-input-from-pipe 
+     (conc "ssh " remote-host " cat /proc/loadavg")
+     (lambda ()(list (read)(read)(read))))))
+
 ;; get cpu load by reading from /proc/loadavg, return all three values
 ;;
 (define (common:get-cpu-load remote-host)
   (handle-exceptions
-   exn
-   '(99 99 99)
-   (let* ((actual-hostname (or remote-host (get-host-name) "localhost")))
-     (or (common:get-cached-info actual-hostname "cpu-load")
-	 (let ((result (if remote-host
-			   (map (lambda (res)
-				  (if (eof-object? res) 9e99 res))
-			        (with-input-from-pipe 
-				 (conc "ssh " remote-host " cat /proc/loadavg")
-				 (lambda ()(list (read)(read)(read)))))
-			   (with-input-from-file "/proc/loadavg" 
-			     (lambda ()(list (read)(read)(read)))))))
-	   (common:write-cached-info actual-hostname "cpu-load" result)
-	                     result)))))
+      exn
+    (begin
+      (debug:print 0 *default-log-port* "failed to ssh or read loadavg from host " remote-host ", exn=" exn)
+      '(-99 -99 -99))
+    (let* ((actual-hostname (or remote-host (get-host-name) "localhost")))
+      (or (common:get-cached-info actual-hostname "cpu-load")
+	  (let ((result (if remote-host
+			    (map (lambda (res)
+				   (if (eof-object? res) 9e99 res))
+			         (with-input-from-pipe 
+				  (conc "ssh " remote-host " cat /proc/loadavg")
+				  (lambda ()(list (read)(read)(read)))))
+			    (with-input-from-file "/proc/loadavg" 
+			      (lambda ()(list (read)(read)(read)))))))
+	    (match
+		result
+	      ((l1 l2 l3)
+	       (if (and (number? l1)
+		      (number? l2)
+		      (number? l3))
+		   (begin
+		     (common:write-cached-info actual-hostname "cpu-load" result)
+		     result)
+		   '(-1 -1 -1))) ;; -1 is bad result
+	      (else '(-2 -2 -2))))))))
 
 ;; get normalized cpu load by reading from /proc/loadavg and /proc/cpuinfo return all three values and the number of real cpus and the number of threads
 ;; returns alist '((adj-cpu-load . normalized-proc-load) ... etc.
 ;;  keys: adj-proc-load, adj-core-load, 1m-load, 5m-load, 15m-load
 ;;
@@ -1978,86 +2118,218 @@
 		    (debug:print 0 *default-log-port* "INFO: Found host: " new-best " load: " load " last-used: " delta " seconds ago, with job-rate: " job-rate)
 		    (host-last-used-set! rec curr-time)
 		    new-best)
 		  (if (null? tal) #f (loop (car tal)(cdr tal) best-host)))))))))
 
-(define (common:wait-for-homehost-load maxload msg)
+(define (common:wait-for-homehost-load maxnormload msg)
   (let* ((hh-dat (if (common:on-homehost?) ;; if we are on the homehost then pass in #f so the calls are local.
                      #f
                      (common:get-homehost)))
          (hh     (if hh-dat (car hh-dat) #f)))
-    (common:wait-for-normalized-load maxload msg hh)))
+    (common:wait-for-normalized-load maxnormload msg hh)))
 
+(define *numcpus-cache* (make-hash-table))
 (define (common:get-num-cpus remote-host)
   (let* ((actual-host (or remote-host (get-host-name))))
-    (or (common:get-cached-info actual-host "num-cpus" age: (+ 2592000 (random 3600))) ;; hosts had better not be changing the number of cpus too often!
-	(let* ((proc   (lambda ()
-			 (let loop ((numcpu 0)
-				    (inl    (read-line)))
-			   (if (eof-object? inl)
-			       (if (> numcpu 0)
-				   numcpu
-				   #f) ;; if zero return #f so caller knows that things are not working
-			       (loop (if (string-match "^processor\\s+:\\s+\\d+$" inl)
-					 (+ numcpu 1)
-					 numcpu)
-				     (read-line))))))
-	       (result (if remote-host
-			   (with-input-from-pipe 
-			       (conc "ssh " remote-host " cat /proc/cpuinfo")
-			     proc)
-			   (with-input-from-file "/proc/cpuinfo" proc))))
-	  (if (and (number? result)
-		   (> result 0))
-	      (common:write-cached-info actual-host "num-cpus" result))
-	  result))))
+    ;; hosts had better not be changing the number of cpus too often!
+    (or (hash-table-ref/default *numcpus-cache* actual-host #f)
+	(let* ((numcpus (or (common:get-cached-info actual-host "num-cpus" age: (+ 2592000 (random 3600)))
+			    (let* ((proc   (lambda ()
+					     (let loop ((numcpu 0)
+							(inl    (read-line)))
+					       (if (eof-object? inl)
+						   (if (> numcpu 0)
+						       numcpu
+						       #f) ;; if zero return #f so caller knows that things are not working
+						   (loop (if (string-match "^processor\\s+:\\s+\\d+$" inl)
+							     (+ numcpu 1)
+							     numcpu)
+							 (read-line))))))
+				   (result (if remote-host
+					       (with-input-from-pipe 
+						(conc "ssh " remote-host " cat /proc/cpuinfo")
+						proc)
+					       (with-input-from-file "/proc/cpuinfo" proc))))
+			      (if (and (number? result)
+				       (> result 0))
+				  (common:write-cached-info actual-host "num-cpus" result))
+			      result))))
+	  (hash-table-set! *numcpus-cache* actual-host numcpus)
+	  numcpus))))
 
 ;; wait for normalized cpu load to drop below maxload
 ;;
-(define (common:wait-for-normalized-load maxload msg remote-host #!optional (rem-tries 5))
+(define (common:wait-for-normalized-load maxnormload msg remote-host #!optional (rem-tries 5))
   (let ((num-cpus (common:get-num-cpus remote-host)))
     (if num-cpus
-	(common:wait-for-cpuload maxload num-cpus 15 msg: msg remote-host: remote-host)
+	(common:wait-for-cpuload maxnormload num-cpus 15 msg: msg remote-host: remote-host)
 	(begin
 	  (thread-sleep! (random 60)) ;; we failed to get num cpus. wait a bit and try again
 	  (if (> rem-tries 0)
-	      (common:wait-for-normalized-load maxload msg remote-host (- rem-tries 1))
+	      (common:wait-for-normalized-load maxnormload msg remote-host (- rem-tries 1))
 	      #f)))))
 
 ;; DO NOT CALL THIS DIRECTLY. It is called from common:wait-for-normalized-load
+;;   count     - count down to zero, at some point we'd give up if the load never drops
+;;   num-tries - count down to zero number tries to get numcpus
 ;;
-(define (common:wait-for-cpuload maxload-in numcpus-in waitdelay #!key (count 1000) (msg #f)(remote-host #f)(force-maxload #f))
-  (let* ((loadavg (common:get-cpu-load remote-host))
-	 (numcpus (if (<= 1 numcpus-in) ;; not possible to have zero.  If we get 1, it's possible that we got the previous default, and we should check again
-		      (common:get-num-cpus remote-host)
-		      numcpus-in))
-	 (maxload (if force-maxload
-		      maxload-in
-		      (if (number? maxload-in)
-			  (max maxload-in 0.5)
-			  0.5))) ;; so maxload must be greater than 0.5 for now BUG - FIXME?
-	 (first   (car loadavg))
-	 (next    (cadr loadavg))
-	 (adjload (* maxload (max 1 numcpus))) ;; possible bug where numcpus (or could be maxload) is zero, crude fallback is to at least use 1
-	 (loadjmp (- first next))
-         (adjwait (min (+ 300 (random 10)) (abs (* (+ (random 10)(/ (- 1000 count) 10) waitdelay) (- first adjload) ))  )));; add some randomness to the time to break any alignment where netbatch dumps many jobs to machines simultaneously
-    ;; let's let the user know once in a long while that load checking is happening but not constantly report it
-    (if (> (random 100) 75) ;; about 25% of the time
-	(debug:print-info 1 *default-log-port* "Checking cpuload on " (or remote-host "localhost") ", maxload: " maxload
-			  ", load: " first ", adjload: " adjload ", loadjmp: " loadjmp))
+(define (common:wait-for-cpuload maxnormload numcpus-in
+				 #!key (count 1000)
+				 (msg #f)(remote-host #f)(num-tries 5))
+  (let* ((loadavg     (common:get-cpu-load remote-host))
+	  ;; not possible to have zero.  If we get 1, it's possible that we got the previous default, and we should check again
+	 (numcpus     (if (<= 1 numcpus-in)
+			  (common:get-num-cpus remote-host)
+			  numcpus-in))
+	 (first       (car loadavg))
+	 (next        (cadr loadavg))
+	 (adjmaxload  (* maxnormload (max 1 numcpus))) ;; possible bug
+						   ;; where numcpus
+						   ;; (or could be
+						   ;; maxload) is
+						   ;; zero, crude
+						   ;; fallback is to
+						   ;; at least use 1
+	 ;; effective load accounts for load jumps, this should elminate all the first-next-avg, adjwait, load-jump-limit
+	 ;; etc.
+	 (effective-load    (common:get-intercept first next))
+	 (recommended-delay (common:get-delay effective-load numcpus))
+	 (effective-host    (or remote-host "localhost"))
+	 (normalized-effective-load (/ effective-load numcpus))
+	 (will-wait                 (> normalized-effective-load maxnormload)))
+    (if (> recommended-delay 0)
+	(let* ((actual-delay (min recommended-delay 30)))
+	  (if (common:low-noise-print 30 (conc (round actual-delay) "-safe-load"))
+	      (debug:print-info 0 *default-log-port* "Load control, delaying "
+				actual-delay " seconds to maintain safe load. current normalized effective load is "
+				normalized-effective-load"."))
+	  (thread-sleep! actual-delay)))
+    
     (cond
-     ((and (> first adjload)
-	   (> count 0))
-      (debug:print-info 0 *default-log-port* "server start delayed " adjwait " seconds due to load " first " exceeding max of " adjload " on server " (or remote-host (get-host-name)) " (normalized load-limit: " maxload ") " (if msg msg ""))
-      (thread-sleep! adjwait)
-      (common:wait-for-cpuload maxload numcpus waitdelay count: (- count 1) msg: msg remote-host: remote-host))
-     ((and (> loadjmp numcpus)
-	   (> count 0))
-      (debug:print-info 0 *default-log-port* "waiting " adjwait " seconds due to load jump " loadjmp " > numcpus " numcpus (if msg msg ""))
-      (thread-sleep! adjwait)
-      (common:wait-for-cpuload maxload numcpus waitdelay count: (- count 1) msg: msg remote-host: remote-host)))))
-
+     ;; bad data, try again to get the data
+     ((not will-wait)
+      (if (common:low-noise-print 30 (conc (round normalized-effective-load) "-load-acceptable-" effective-host))
+	  (debug:print 0 *default-log-port* "Effective load on " effective-host " is acceptable at " effective-load " continuing.")))
+     ((and (< first 0) ;; this indicates the loadavg data is bad - machine may not be reachable
+	   (> num-tries 0))
+      (debug:print 0 *default-log-port* "WARNING: received bad data from get-cpu-load "
+		   first ", we'll sleep 10s and try " num-tries " more times.")
+      (thread-sleep! 10)
+      (common:wait-for-cpuload maxnormload numcpus-in
+			       count: count remote-host: remote-host num-tries: (- num-tries 1)))
+     ;; need to wait for load to drop
+     ((and will-wait ;; (> first adjmaxload)
+	   (> count 0))
+      (debug:print-info 0 *default-log-port*
+			"Delaying 15" ;; adjwait
+			" seconds due to normalized effective load " normalized-effective-load ;; first
+			" exceeding max of " adjmaxload
+			" on server " (or remote-host (get-host-name))
+			" (normalized load-limit: " maxnormload ") " (if msg msg ""))
+      (thread-sleep! 15) ;; adjwait)
+      (common:wait-for-cpuload maxnormload numcpus count: (- count 1) msg: msg remote-host: remote-host)
+      ;; put the message here to indicate came out of waiting
+      (debug:print-info 1 *default-log-port*
+			"On host: " effective-host
+			", effective load: " effective-load
+			", numcpus: " numcpus
+			", normalized effective load: " normalized-effective-load
+			))
+     ;; overloaded and count expired (i.e. went to zero)
+     (else
+      (if (> num-tries 0) ;; should be "num-tries-left". 
+	  (if (common:low-noise-print 30 (conc (round effective-load) "-load-acceptable-" effective-host))
+	      (debug:print 0 *default-log-port* "Load on " effective-host " is acceptable at effective normalized load of "
+			   effective-normalized-load "  continuing."))
+	  (debug:print 0 *default-log-port* "Load on " effective-host ", "
+		       first" could not be retrieved. Giving up and continuing."))))))
+
+;; DO NOT CALL THIS DIRECTLY. It is called from common:wait-for-normalized-load
+;;
+;; (define (common:wait-for-cpuload maxload-in numcpus-in waitdelay #!key (count 1000) (msg #f)(remote-host #f)(force-maxload #f)(num-tries 5))
+;;   (let* ((loadavg (common:get-cpu-load remote-host))
+;; 	 (numcpus (if (<= 1 numcpus-in) ;; not possible to have zero.  If we get 1, it's possible that we got the previous default, and we should check again
+;; 		      (common:get-num-cpus remote-host)
+;; 		      numcpus-in))
+;; 	 (maxload (if force-maxload
+;; 		      maxload-in
+;; 		      (if (number? maxload-in)
+;; 			  (max maxload-in 0.5)
+;; 			  0.5))) ;; so maxload must be greater than 0.5 for now BUG - FIXME?
+;; 	 (first   (car loadavg))
+;; 	 (next    (cadr loadavg))
+;; 	 (adjmaxload (* maxload (max 1 numcpus))) ;; possible bug where
+;; 					       ;; numcpus (or could be
+;; 					       ;; maxload) is zero,
+;; 					       ;; crude fallback is to
+;; 					       ;; at least use 1
+;; 	 (loadjmp (- first (if (> next (* numcpus 0.7)) ;; could do something with average of first and next?
+;; 			       0
+;; 			       next))) ;; we will force a conservative calculation any time next is large.
+;; 	 (first-next-avg    (/ (+ first next) 2))
+;; 	 ;; add some randomness to the time to break any alignment
+;; 	 ;; where netbatch dumps many jobs to machines simultaneously
+;;          (adjwait           (min (+ 300 (random 10)) (abs (* (+ (random 10)
+;; 								(/ (- 1000 count) 10)
+;; 								waitdelay)
+;; 							     (- first adjmaxload) ))))
+;; 	 (load-jump-limit   (configf:lookup-number *configdat* "setup" "load-jump-limit"))
+;; 	 ;; effective load accounts for load jumps, this should elminate all the first-next-avg, adjwait, load-jump-limit
+;; 	 ;; etc.
+;; 	 (effective-load    (common:get-intercept first next))
+;; 	 (effective-host    (or remote-host "localhost"))
+;; 	 (normalized-effective-load (/ effective-load numcpus))
+;; 	 (will-wait                 (> normalized-effective-load maxload)))
+;; 	 
+;;     ;; let's let the user know once in a long while that load checking
+;;     ;; is happening but not constantly report it
+;;     #;(if (common:low-noise-print 30 (conc "cpuload" (or remote-host "localhost"))) ;; (> (random 100) 75) ;; about 25% of the time
+;; 	(debug:print-info 1 *default-log-port* "Checking cpuload on " (or remote-host "localhost") ", maxload: " maxload
+;;     ", load: " first ", adjmaxload: " adjmaxload ", loadjmp: " loadjmp))
+;; 
+;;     (debug:print-info 1 *default-log-port*
+;; 		      "On host: " effective-host
+;; 		      ", effective load: " effective-load
+;; 		      ", numcpus: " numcpus
+;; 		      ", normalized effective load: " normalized-effective-load
+;; 		      )
+;;     
+;;     (cond
+;;      ;; bad data, try again to get the data
+;;      ((and (< first 0) ;; this indicates the loadavg data is bad - machine may not be reachable
+;; 	   (> num-tries 0))
+;;       (debug:print 0 *default-log-port* "WARNING: received bad data from get-cpu-load " first ", we'll sleep 10s and try " num-tries " more times.")
+;;       (thread-sleep! 10)
+;;       (common:wait-for-cpuload maxload-in numcpus-in waitdelay
+;; 			       count: count remote-host: remote-host force-maxload: force-maxload num-tries: (- num-tries 1)))
+;;      ;; need to wait for load to drop
+;;      ((and will-wait ;; (> first adjmaxload)
+;; 	   (> count 0))
+;;       (debug:print-info 0 *default-log-port*
+;; 			"Delaying " 15 ;; adjwait
+;; 			" seconds due to normalized effective load " normalized-effective-load ;; first
+;; 			" exceeding max of " adjmaxload
+;; 			" on server " (or remote-host (get-host-name))
+;; 			" (normalized load-limit: " maxload ") " (if msg msg ""))
+;;       (thread-sleep! 15) ;; adjwait)
+;;       (common:wait-for-cpuload maxload numcpus waitdelay count: (- count 1) msg: msg remote-host: remote-host))
+;;      ((and (> loadjmp (cond
+;; 		       (load-jump-limit load-jump-limit)
+;; 		       ((> numcpus 8)(/ numcpus 2))
+;; 		       ((> numcpus 4)(/ numcpus 1.2))
+;; 		       (else 0.5)))
+;; 	   (> count 0))
+;;       (debug:print-info 0 *default-log-port* "waiting " adjwait " seconds due to possible load jump " loadjmp ". "
+;; 			(if msg msg ""))
+;;       (thread-sleep! adjwait)
+;;       (common:wait-for-cpuload maxload numcpus waitdelay count: (- count 1) msg: msg remote-host: remote-host))
+;;      (else
+;;       (if (> num-tries 0)
+;; 	  (if (common:low-noise-print 30 (conc (round first) "-load-acceptable-" (or remote-host "localhost")))
+;; 	      (debug:print 0 *default-log-port* "Load on " (or remote-host "localhost") " is acceptable at " first " continuing."))
+;; 	  (debug:print 0 *default-log-port* "Load on " (or remote-host "localhost") ", "first" could not be retrieved. Giving up and continuing."))))))
+;; 
 (define (get-uname . params)
   (let* ((uname-res (process:cmd-run->list (conc "uname " (if (null? params) "-a" (car params)))))
 	 (uname #f))
     (if (null? (car uname-res))
 	"unknown"
@@ -2366,10 +2638,12 @@
                    ("mode-patt" . "-modepatt")
                    ("run-name"  . "-runname")
                    ("contour"   . "-contour")
                    ("target"    . "-target")
                    ("test-patt" . "-testpatt")
+		   ("rerun"     . "-rerun")
+		   ("setvars"   . "-setvars")
                    ("msg"       . "-m")
                    ("log"       . "-log")
                    ("start-dir" . "-start-dir")
                    ("new"       . "-set-state-status"))))
     (if (eq? flavor 'switch-symbol)
@@ -2444,10 +2718,39 @@
     (hash-table-for-each
      vars
      (lambda (var val)
        (setenv var val)))
     vars))
+
+(define (common:propogate-mt-vars-to-subrun proc propogate-vars)
+  (let ((vars      (make-hash-table))
+        (var-patt  "^MT_.*"))
+    (for-each
+     (lambda (vardat) ;; each env var
+       ;(for-each
+      ;(lambda (var-patt)
+	  (if (string-match var-patt (car vardat))
+	      (let ((var (car vardat))
+		    (val (cdr vardat)))
+		(hash-table-set! vars var val)
+                 (if (member var propogate-vars)
+                  (begin
+                  (print var "  " (string-substitute "MT_" "PARENT_" var))
+                  (setenv (string-substitute "MT_" "PARENT_"  var) val)))
+		(unsetenv var))))
+;	var-patts))
+     (get-environment-variables))
+    (cond
+     ((string? proc)(system proc))
+     (proc          (proc)))
+    (hash-table-for-each
+     vars
+     (lambda (var val)
+         (if (member var propogate-vars)
+         (unsetenv (string-substitute "MT_" "PARENT_" var)))  
+       (setenv var val)))
+    vars))
 
 
 (define (common:run-a-command cmd #!key (with-vars #f) (with-orig-env #f))
   (let* ((pre-cmd  (dtests:get-pre-command))
          (post-cmd (dtests:get-post-command))
@@ -2907,31 +3210,39 @@
 ;; arm cubie01 cubie02
 ;; x86_64 zeus xena myth01
 ;; allhosts #{g hosts arm} #{g hosts x86_64}
 ;; 
 ;; [host-types]
+;; C/M/A      lets megatest know this launcher provides C cores, M bytes memory for architecture A 
+;; 2/2G/arm   smart -cores 2 -memory 2G -arch arm
 ;; general #MTLOWESTLOAD #{g hosts allhosts}
 ;; arm     #MTLOWESTLOAD #{g hosts arm}
 ;; nbgeneral nbjob run JOBCOMMAND -log $MT_LINKTREE/$MT_TARGET/$MT_RUNNAME.$MT_TESTNAME-$MT_ITEM_PATH.lgo
+;;
+;; NOTE: host-rules is ONLY used for MTLOWESTLOAD
 ;;
 ;; [host-rules]
 ;; # maxnload   => max normalized load
 ;; # maxnjobs   => max jobs per cpu
 ;; # maxjobrate => max jobs per second
 ;; general maxnload=1.1; maxnjobs=1.2; maxjobrate=0.1 
 ;; 
 ;; [launchers]
 ;; envsetup general
-;; xor/%/n 4C16G
+;; xor/%/n 2/2G/arm
 ;; % nbgeneral
 ;; 
 ;; [jobtools]
 ;; # if defined and not "no" flexi-launcher will bypass "launcher" unless no match.
 ;; flexi-launcher yes  
 ;; launcher nbfake
+;; mode adjutant|normal (default is normal)
+;; 
+;;
+;; mode is 'normal (i.e. directly use launcher) or 'adjutant (i.e. use adjutant)
 ;;
-(define (common:get-launcher configdat testname itempath)
+(define (common:get-launcher configdat testname itempath mode)
   (let ((fallback-launcher (configf:lookup configdat "jobtools" "launcher")))
     (if (and (configf:lookup configdat "jobtools" "flexi-launcher") ;; overrides launcher
 	     (not (equal? (configf:lookup configdat "jobtools" "flexi-launcher") "no")))
 	(let* ((launchers         (hash-table-ref/default configdat "launchers" '())))
 	  (if (null? launchers)
@@ -2938,32 +3249,36 @@
 	      fallback-launcher
 	      (let loop ((hed (car launchers))
 			 (tal (cdr launchers)))
 		(let ((patt      (car hed))
 		      (host-type (cadr hed)))
-		  (if (tests:match patt testname itempath)
+		  (if (tests:match patt testname itempath) ;; have a launcher match for this test
 		      (begin
 			(debug:print-info 2 *default-log-port* "Have flexi-launcher match for " testname "/" itempath " = " host-type)
-			(let ((launcher (configf:lookup configdat "host-types" host-type)))
+			(let ((launcher (configf:lookup configdat "host-types" host-type))) ;; find the actual launcher from the host-types table
+			  ;; if we are in adjutant mode then we want to return both host-type and launcher
 			  (if launcher
 			      (let* ((launcher-parts (string-split launcher))
 				     (launcher-exe   (car launcher-parts)))
 				(if (equal? launcher-exe "#MTLOWESTLOAD") ;; this is our special case, we will find the lowest load and craft a nbfake commandline
 				    (let host-loop ((targ-host (common:get-least-loaded-host (cdr launcher-parts) host-type configdat))
 						    (count     100))
 				      (if targ-host
 					  (conc "remrun " targ-host)
 					  (if (> count 0)
+					      
 					      (begin
 						(debug:print 0 *default-log-port* "INFO: Waiting for a host for host-type " host-type)
 						(thread-sleep! (- 101 count))
 						(host-loop (common:get-least-loaded-host (cdr launcher-parts) host-type configdat)
 							   (- count 1)))
 					      (begin
 						(debug:print 0 *default-log-port* "FATAL: Failed to find a host from #MTLOWESTLOAD for host-type " host-type)
 						(exit)))))
-				    launcher))
+				    (case mode
+				      ((adjutant) (list host-type launcher))
+				      (else       launcher))))
 			      (begin
 				(debug:print-info 0 *default-log-port* "WARNING: no launcher found for host-type " host-type)
 				(if (null? tal)
 				    fallback-launcher
 				    (loop (car tal)(cdr tal)))))))
@@ -3128,11 +3443,11 @@
 				    (pktsdir   (car pktsdirs))) ;; assume it is there
 			       (hash-table-set! *pkts-info* 'pkts-dir pktsdir)
 			       pktsdir))))
             (handle-exceptions
              exn
-             (debug:print-info 0 "failed to write out packet to " pktsdir) ;; don't care if this failed for now but MUST FIX - BUG!!
+             (debug:print-info 0 "failed to write out packet to " pktsdir ", exn=" exn) ;; don't care if this failed for now but MUST FIX - BUG!!
              (if (not (file-exists? pktsdir))
                  (create-directory pktsdir #t))
              (with-output-to-file
                  (conc pktsdir "/" uuid ".pkt")
                (lambda ()
@@ -3275,13 +3590,15 @@
   (for-each
    (lambda (thread-name)
      (let* ((thread (hash-table-ref/default *common:thread-punchlist* thread-name #f)))
        (if thread
            (handle-exceptions
-           exn
-           #t ;; just ignore it, it might have died in the meantime so joining it will throw an exception
-           (thread-join! thread))
+               exn
+	     (begin
+	       (debug:print 0 *default-log-port* "joining threads failed. exn=" exn)
+               #t) ;; just ignore it, it might have died in the meantime so joining it will throw an exception
+             (thread-join! thread))
            )))
    (hash-table-keys *common:thread-punchlist*)))
 
 (define *common:telemetry-log-state* 'startup)
 (define *common:telemetry-log-socket* #f)

Index: common_records.scm
==================================================================
--- common_records.scm
+++ common_records.scm
@@ -39,10 +39,11 @@
 
 ;; (define-syntax common:handle-exceptions
 ;;   (syntax-rules ()
 ;;     ((_ exn-in errstmt ...)(handle-exceptions exn-in errstmt ...))))
 
+;; this works, why didn't I use it more?
 (define-syntax common:debug-handle-exceptions
   (syntax-rules ()
     ((_ debug exn errstmt body ...)
      (if debug
 	 (begin body ...)
@@ -123,17 +124,19 @@
 	 (list? n))
     (member *verbosity* n))))
 
 (define (debug:setup)
   (let ((debugstr (or (args:get-arg "-debug")
+		      (args:get-arg "-debug-noprop")
 		      (getenv "MT_DEBUG_MODE"))))
     (set! *verbosity* (debug:calc-verbosity debugstr))
     (debug:check-verbosity *verbosity* debugstr)
     ;; if we were handed a bad verbosity rule then we will override it with 1 and continue
     (if (not *verbosity*)(set! *verbosity* 1))
-    (if (or (args:get-arg "-debug")
-	    (not (getenv "MT_DEBUG_MODE")))
+    (if (and (not (args:get-arg "-debug-noprop"))
+	     (or (args:get-arg "-debug")
+		 (not (getenv "MT_DEBUG_MODE"))))
 	(setenv "MT_DEBUG_MODE" (if (list? *verbosity*)
 				    (string-intersperse (map conc *verbosity*) ",")
 				    (conc *verbosity*))))))
   
 (define (debug:print n e . params)

Index: commonmod.scm
==================================================================
--- commonmod.scm
+++ commonmod.scm
@@ -21,13 +21,139 @@
 (declare (unit commonmod))
 
 (module commonmod
 	*
 	
-(import scheme chicken data-structures extras)
-(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18)
+(import scheme chicken data-structures extras files)
+(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18 srfi-69
+	md5 message-digest
+	regex srfi-1)
+
+;;======================================================================
+;; CONTENTS
+;;
+;;  config file utils
+;;  misc conversion, data manipulation functions
+;;  testsuite and area utilites
+;;
+;;======================================================================
+
+(include "megatest-version.scm")
+(include "megatest-fossil-hash.scm")
+
+(define (get-full-version)
+  (conc megatest-version "-" megatest-fossil-hash))
+
+(define (version-signature)
+  (conc megatest-version "-" (substring megatest-fossil-hash 0 4)))
+
+
+;;======================================================================
+;; config file utils
+;;======================================================================
+
+(define (lookup cfgdat section var)
+  (if (hash-table? cfgdat)
+      (let ((sectdat (hash-table-ref/default cfgdat section '())))
+	(if (null? sectdat)
+	    #f
+	    (let ((match (assoc var sectdat)))
+	      (if match ;; (and match (list? match)(> (length match) 1))
+		  (cadr match)
+		  #f))
+	    ))
+      #f))
+
+;; returns var key1=val1; key2=val2 ... as alist
+(define (get-key-list cfgdat section var)
+  ;; convert string a=1; b=2; c=a silly thing; d=
+  (let ((valstr (lookup cfgdat section var)))
+    (if valstr
+	(val->alist valstr)
+	'()))) ;; should it return empty list or #f to indicate not set?
+
+
+(define (get-section cfgdat section)
+  (hash-table-ref/default cfgdat section '()))
+
+;;======================================================================
+;; misc conversion, data manipulation functions
+;;======================================================================
+
+;; if it looks like a number -> convert it to a number, else return it
+;;
+(define (lazy-convert inval)
+  (let* ((as-num (if (string? inval)(string->number inval) #f)))
+    (or as-num inval)))
+
+;; to '((a . 1)(b . 2)(c . "a silly thing")(d . ""))
+;;
+(define (val->alist val #!key (convert #f))
+  (let ((val-list (string-split-fields ";\\s*" val #:infix)))
+    (if val-list
+	(map (lambda (x)
+	       (let ((f (string-split-fields "\\s*=\\s*" x #:infix)))
+		 (case (length f)
+		   ((0) `(,#f))  ;; null string case
+		   ((1) `(,(string->symbol (car f))))
+		   ((2) `(,(string->symbol (car f)) .
+			  ,(let ((inval (cadr f)))
+			     (if convert (lazy-convert inval) inval))))
+		   (else f))))
+	     (filter (lambda (x)
+		       (not (string-match "^\\s*" x)))
+		     val-list))
+	'())))
+
+;;======================================================================
+;; testsuite and area utilites
+;;======================================================================
+
+(define (get-testsuite-name toppath configdat)
+  (or (lookup configdat "setup" "area-name")
+      (lookup configdat "setup" "testsuite")
+      (get-environment-variable "MT_TESTSUITE_NAME")
+      (if (string? toppath)
+          (pathname-file toppath)
+          #f)))
+
+(define (get-area-path-signature toppath #!optional (short #f))
+  (let ((res (message-digest-string (md5-primitive) toppath)))
+    (if short
+	(substring res 0 4)
+	res)))
+
+(define (get-area-name configdat toppath #!optional (short #f))
+  ;; look up my area name in areas table (future)
+  ;; generate auto name
+  (conc (get-area-path-signature toppath short)
+	"-"
+	(get-testsuite-name toppath configdat)))
+
+;; need generic find-record-with-var-nmatching-val
+;;
+(define (path->area-record cfgdat path)
+  (let* ((areadat (get-cfg-areas cfgdat))
+	 (all     (filter (lambda (x)
+			    (let* ((keyvals (cdr x))
+				   (pth     (alist-ref 'path keyvals)))
+			      (equal? path pth)))
+			  areadat)))
+    (if (null? all)
+	#f
+	(car all)))) ;; return first match
 
+;; given a config return an alist of alists
+;;   area-name => data
+;;
+(define (get-cfg-areas cfgdat)
+  (let ((adat (get-section cfgdat "areas")))
+    (map (lambda (entry)
+	   `(,(car entry) . 
+	     ,(val->alist (cadr entry))))
+	 adat)))
+	 
 ;; (define (debug:print . params) #f)
 ;; (define (debug:print-info . params) #f)
 ;; 
 ;; (define (set-functions dbgp dbgpinfo)
 ;;   (set! debug:print dbgp)

Index: configf.scm
==================================================================
--- configf.scm
+++ configf.scm
@@ -65,11 +65,11 @@
   ;;	  (equal? "!" (substring str 0 1))) ;; null string or starts with ! are preserved but NOT set in the environment
       str
       (handle-exceptions
        exn
        (begin
-	 (debug:print-error 0 *default-log-port* "problem evaluating \"" str "\" in the shell environment")
+	 (debug:print-error 0 *default-log-port* "problem evaluating \"" str "\" in the shell environment, exn=" exn)
 	 #f)
        (let ((cmdres (process:cmd-run->list (conc "echo " str))))
 	 (if (null? cmdres) ""
 	     (caar cmdres))))) ;; )
 
@@ -130,11 +130,11 @@
 				(else "(lambda (ht)(print \"ERROR\") \"ERROR\")"))))
 		;; (print "fullcmd=" fullcmd)
 		(handle-exceptions
 		 exn
 		 (begin
-		   (debug:print 0 *default-log-port* "WARNING: failed to process config input \"" l "\"")
+		   (debug:print 0 *default-log-port* "WARNING: failed to process config input \"" l "\", exn=" exn)
 		   (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
 		   ;; (print "exn=" (condition->list exn))
 		   (set! result (conc "#{( " cmdtype ") " cmd "}, full expansion: " fullcmd)))
 		 (if (or allow-system
 			 (not (member cmdtype '("system" "shell" "sh"))))
@@ -189,12 +189,12 @@
 			(configf:process-line inl ht allow-processing))
 		       ((return-string)
 			inl)
 		       (else
 			(configf:process-line inl ht allow-processing)))))
-	    (if (and (string? res)
-		     (not (equal? (hash-table-ref/default settings "trim-trailing-spaces" "no") "no")))
+	    (if (and (string? res)  ;; must set to "no" to force NOT trimming trailing spaces
+		     (not (equal? (hash-table-ref/default settings "trim-trailing-spaces" "yes") "no")))
 		(string-substitute "\\s+$" "" res)
 		res))))))
 
 (define (configf:cfgdat->env-alist section cfgdat-ht allow-system)
   (filter
@@ -334,11 +334,15 @@
                                                              (common:nice-path 
                                                               (conc (if curr-conf-dir
                                                                         curr-conf-dir
                                                                         ".")
                                                                     "/" include-file)))))
-				     (let ((all-matches (sort (handle-exceptions exn (list) (glob full-conf)) string<=?)))
+				     (let ((all-matches (sort (handle-exceptions exn
+								(begin
+								 (debug:print '(2 9) *default-log-port* "glob of " full-conf " gave no match. , exn=" exn)
+								 (list))
+								(glob full-conf)) string<=?)))
 				       (if (null? all-matches)
 					   (begin
 					     (debug:print '(2 9) #f "INFO: include file(s) matching " include-file " not found (called from " path ")")
 					     (debug:print 2 *default-log-port* "        " full-conf))
 					   (for-each
@@ -526,12 +530,12 @@
 (define configf:read-file read-config)
 
 ;; safely look up a value that is expected to be a number, return
 ;; a default (#f unless provided)
 ;;
-(define (configf:lookup-number cfdat section varname #!key (default #f))
-  (let* ((val (configf:lookup *configdat* section varname))
+(define (configf:lookup-number cfgdat section varname #!key (default #f))
+  (let* ((val (configf:lookup cfgdat section varname))
          (res (if val
                   (string->number (string-substitute "\\s+" "" val #t))
                   #f)))
     (cond
      (res  res)
@@ -775,14 +779,16 @@
     ht))
 
 ;; if 
 (define (configf:read-alist fname)
   (handle-exceptions
-   exn
-   #f
-   (configf:alist->config
-    (with-input-from-file fname read))))
+      exn
+    (begin
+      (debug:print-info 0 *default-log-port* "unable to read alist " fname ". exn=" exn)
+      #f)
+    (configf:alist->config
+     (with-input-from-file fname read))))
 
 (define (configf:write-alist cdat fname)
   (if (not (common:faux-lock fname))
       (debug:print 0 *default-log-port* "INFO: Could not get lock on " fname))
   (let* ((dat  (configf:config->alist cdat))
@@ -795,14 +801,16 @@
             (if (common:file-exists? fname)   ;; now verify it is readable
                 (if (configf:read-alist fname)
                     #t ;; data is good.
                     (begin
                       (handle-exceptions
-                       exn
-                       #f
-                       (debug:print 0 *default-log-port* "WARNING: content " dat " for cache " fname " is not readable. Deleting generated file.")
-                       (delete-file fname))
+			  exn
+			(begin
+			  (debug:print 0 *default-log-port* "deleting " fname " failed, exn=" exn)
+			  #f)
+			(debug:print 0 *default-log-port* "WARNING: content " dat " for cache " fname " is not readable. Deleting generated file.")
+			(delete-file fname))
                       #f))
                 #f))))
     (common:faux-unlock fname)
     res))
   

ADDED   configure
Index: configure
==================================================================
--- /dev/null
+++ configure
@@ -0,0 +1,101 @@
+#!/bin/bash
+
+#  Copyright 2006-2017, Matthew Welland.
+# 
+# This file is part of Megatest.
+# 
+#     Megatest is free software: you can redistribute it and/or modify
+#     it under the terms of the GNU General Public License as published by
+#     the Free Software Foundation, either version 3 of the License, or
+#     (at your option) any later version.
+# 
+#     Megatest is distributed in the hope that it will be useful,
+#     but WITHOUT ANY WARRANTY; without even the implied warranty of
+#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#     GNU General Public License for more details.
+# 
+#     You should have received a copy of the GNU General Public License
+#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
+
+# Configure the build
+
+if [[ "$1"x == "x" ]];then
+    PREFIX=$PWD
+else
+    PREFIX=$1
+fi
+
+
+#======================================================================
+# Configure stuff needed for eggs
+#======================================================================
+
+function configure_dependencies () {
+
+    #======================================================================
+    # libnanomsg
+    #======================================================================
+
+    if [[ ! $(ls /usr/lib/*/libnanomsg*) ]];then
+	echo "libnanomsg build needed."
+	echo "BUILD_NANOMSG=yes" >> makefile.inc
+    fi
+
+    #======================================================================
+    # postgresql libraries
+    #======================================================================
+
+    if [[ ! $(ls /usr/lib/*/libpq.*) ]];then
+	echo "Postgresql build needed."
+	echo "BUILD_POSTGRES=yes" >> makefile.inc
+    fi
+
+    if [[ ! $(ls /usr/lib/*/libsqlite3.*) ]];then
+    echo "Sqlite3 build needed."
+	echo "BUILD_SQLITE3=yes" >> makefile.inc
+    fi
+
+}
+
+#======================================================================
+# Initialize makefile.inc
+#======================================================================
+
+echo "" > makefile.inc
+
+#======================================================================
+# Do we need Chicken?
+#======================================================================
+
+if [[ -e /usr/bin/sw_vers ]]; then
+    ARCHSTR=$(/usr/bin/sw_vers -productVersion)
+else
+    ARCHSTR=$(lsb_release -sr)
+fi
+
+echo "CKPATH=$PREFIX/.$ARCHSTR" >> makefile.inc
+CHICKEN_PREFIX=$PREFIX/bin/.$ARCHSTR
+
+if [[ ! $(type csi) ]];then
+    echo "Chicken build needed."
+    echo "BUILD_CHICKEN=yes" >> makefile.inc
+    configure_dependencies
+    echo "include chicken.makefile" >> makefile.inc
+else
+    echo "CSIPATH=$(which csi)" >> makefile.inc
+    CSIPATH=$(which csi)
+    echo "CKPATH=$(dirname $(dirname $CSIPATH))" >> makefile.inc
+fi
+
+# Make setup scripts
+echo "#!/bin/bash" > setup.sh
+echo "export PATH=$CHICKEN_PREFIX/bin:\$PATH" >> setup.sh
+echo "export LD_LIBRARY_PATH=$CHICKEN_PREFIX/lib" >> setup.sh
+echo 'exec "$@"' >> setup.sh
+chmod a+x setup.sh
+
+echo "setenv PATH $CHICKEN_PREFIX/bin:\$PATH" > setup.csh
+echo "setenv LD_LIBRARY_PATH $CHICKEN_PREFIX/lib" >> setup.csh
+
+echo "All done creating makefile.inc, feel free to edit it!"
+echo "run \"setup.sh bash\" or source setup.csh to get PATH and LD_LIBRARY_PATH adjusted"

ADDED   cookie.scm
Index: cookie.scm
==================================================================
--- /dev/null
+++ cookie.scm
@@ -0,0 +1,23 @@
+;;======================================================================
+;; Copyright 2019, Matthew Welland.
+;; 
+;; This file is part of Megatest.
+;; 
+;;     Megatest is free software: you can redistribute it and/or modify
+;;     it under the terms of the GNU General Public License as published by
+;;     the Free Software Foundation, either version 3 of the License, or
+;;     (at your option) any later version.
+;; 
+;;     Megatest is distributed in the hope that it will be useful,
+;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;     GNU General Public License for more details.
+;; 
+;;     You should have received a copy of the GNU General Public License
+;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
+
+;;======================================================================
+
+(declare (unit cookie))
+
+(include "stml2/cookie.scm")

Index: dashboard-context-menu.scm
==================================================================
--- dashboard-context-menu.scm
+++ dashboard-context-menu.scm
@@ -45,20 +45,13 @@
 (include "common_records.scm")
 (include "db_records.scm")
 (include "run_records.scm")
 
 (define (dboard:launch-testpanel run-id test-id)
-  (let* (;; (cfg-sh  (conc *common:this-exe-dir* "/cfg.sh"))
-         ;; (cmd (conc
-         ;;       (if (common:file-exists? cfg-sh)
-         ;;           (conc "source "cfg-sh" && ")
-         ;;           "")
-         ;;       *common:this-exe-fullpath*
-         ;;       " -test " run-id "," test-id
-         ;;       " &"))
-         (cmd (conc *common:this-exe-dir*"/../dashboard "
-                    "-test " run-id "," test-id
+  (let* ((dboardexe (common:find-local-megatest "dashboard"))
+         (cmd (conc dboardexe
+                    " -test " run-id "," test-id
                     " &")))
     (system cmd)))
 
 
 (define (dashboard:run-menu-items  run-id test-id target runname test-name testpatt item-test-path test-info)
@@ -326,11 +319,11 @@
                      (lambda ()
                        (if scheme-match
                            (begin
                              (handle-exceptions
                               exn
-                              (print "error with custom menu scheme")
+                              (print "error with custom menu scheme, exn=" exn)
                               (begin
                                 ;;(BB> "gonna eval it!")
                                 (eval (with-input-from-string (cadr scheme-match) read)))))
                            (common:run-a-command command-line with-vars: #t))))))))
              #f)))

Index: dashboard-tests.scm
==================================================================
--- dashboard-tests.scm
+++ dashboard-tests.scm
@@ -261,19 +261,34 @@
 ;; if there is a submegatest create a button to launch dashboard in that area
 ;;
 (define (submegatest-panel dbstruct keydat testdat runname testconfig)
   (let* ((test-run-dir      (db:test-get-rundir testdat))
 	 (subarea           (subrun:get-runarea test-run-dir))
-	 (area-exists       (and subarea (common:file-exists? subarea silent: #t))))
-    (if subarea
-	(iup:frame 
-	 #:title "Megatest Run Info" ; #:expand "YES"
-	 (iup:button
-	  "Launch Dashboard"
-	  #:action (lambda (obj)
-                     (subrun:launch-dashboard test-run-dir))))
-	(iup:vbox))))
+	 (area-exists       (and subarea (common:file-exists? subarea silent: #t)))
+	 (target            #f)
+	 (runname           #f)
+	 (cmd-parts-file (conc test-run-dir "/subrun-command-parts.sexp")))
+    (if (file-exists? cmd-parts-file) ;; existance of this file is sufficient to *try* opening a dashboard
+	(let* ((cmd-parts      (if (file-exists? cmd-parts-file)
+				   (with-input-from-file cmd-parts-file
+				     read)
+				   '()))
+	       (target         (alist-ref "-target" cmd-parts equal?))
+	       (runname        (alist-ref "-runname" cmd-parts equal?))
+	       (run-area       (alist-ref "-startdir" cmd-parts equal?)))
+	  (iup:frame 
+	   #:title "Megatest Run Info" ; #:expand "YES"
+	   (iup:vbox
+	    (iup:button
+	     "Launch Dashboard"
+	     #:action (lambda (obj)
+			(subrun:launch-dashboard test-run-dir)))
+	    (iup:button
+	     "Launch Dashboard+Filter"
+	     #:action (lambda (obj)
+			(subrun:launch-dashboard test-run-dir target: target runname: runname))))))
+	(iup:vbox ))))
 
 ;; use a global for setting the buttons colors
 ;;                           state status teststeps
 (define *state-status* (vector #f #f #f))
 (define (update-state-status-buttons testdat)
@@ -324,12 +339,12 @@
 			    (lambda (state color)
 			      (for-each 
 			       (lambda (btn)
 				 (let* ((name     (iup:attribute btn "TITLE"))
 					(newcolor (if (equal? name state) color "192 192 192")))
-				   (if (not (colors-similar? newcolor (iup:attribute btn "BGCOLOR")))
-				       (iup:attribute-set! btn "BGCOLOR" newcolor))))
+				   (if (not (colors-similar? newcolor (iup:attribute btn "FGCOLOR")))
+				       (iup:attribute-set! btn "FGCOLOR" newcolor))))
 			       btns)))
 	       btns))
       (apply iup:hbox
 	     (iup:label "STATUS:" #:size "30x")
 	     (let* ((btns  (map (lambda (status)
@@ -358,12 +373,12 @@
 			    (lambda (status color)
 			      (for-each 
 			       (lambda (btn)
 				 (let* ((name     (iup:attribute btn "TITLE"))
 					(newcolor (if (equal? name status) color "192 192 192")))
-				   (if (not (colors-similar? newcolor (iup:attribute btn "BGCOLOR")))
-				       (iup:attribute-set! btn "BGCOLOR" newcolor))))
+				   (if (not (colors-similar? newcolor (iup:attribute btn "FGCOLOR")))
+				       (iup:attribute-set! btn "FGCOLOR" newcolor))))
 			       btns)))
 	       btns))))))
 
 (define (dashboard-tests:run-a-step info)
   #t)
@@ -513,21 +528,25 @@
 	       ;; this next block was added to fix a bug where variables were
                ;; needed. Revisit this.
 	       (runconfig  (let ((runconfigf (conc  *toppath* "/runconfigs.config"))) ;; no rush but it would be good to convert this call to use runconfig:read
 	 		     (if (common:file-exists? runconfigf)
 	 			 (handle-exceptions
-                                   exn
-                                   #f  ;; do nothing, just keep on trucking ....
+                                     exn
+				   (begin
+				     (debug:print 0 *default-log-port* "failed to set up environment for " runconfigf ", exn=" exn)
+                                     #f)  ;; do nothing, just keep on trucking ....
                                    (setup-env-defaults runconfigf run-id (make-hash-table) keydat environ-patt: keystring))
 	 			 (make-hash-table))))
 	       (testconfig    (begin
 				;; (runs:set-megatest-env-vars run-id inrunname: runname testname: test-name itempath: item-path)
 				(runs:set-megatest-env-vars run-id inkeyvals: keydat inrunname: runname intarget: keystring testname: testname itempath: item-path) ;; these may be needed by the launching process
 				(handle-exceptions
-				 exn  ;; NOTE: I've no idea why this was written this way. Research, study and fix needed!
-				 (tests:get-testconfig (db:test-get-testname testdat) (db:test-get-item-path testdat) test-registry #f allow-write-cache: #f)
-				 (tests:get-testconfig (db:test-get-testname testdat) item-path test-registry #t allow-write-cache: #f))))
+				    exn  ;; NOTE: I've no idea why this was written this way. Research, study and fix needed!
+				  (begin
+				    (debug:print 0 *default-log-port* "testconfig load using " item-path " failed, trying " (db:test-get-item-path testdat) ", exn=" exn)
+				    (tests:get-testconfig (db:test-get-testname testdat) (db:test-get-item-path testdat) test-registry #f allow-write-cache: #f))
+				  (tests:get-testconfig (db:test-get-testname testdat) item-path test-registry #t allow-write-cache: #f))))
 	       (viewlog    (lambda (x)
 			     (if (common:file-exists? logfile)
 					;(system (conc "firefox " logfile "&"))
 				 (dcommon:run-html-viewer logfile)
 				 (message-window (conc "File " logfile " not found")))))
@@ -561,13 +580,16 @@
 						       (> (current-milliseconds)(+ last-update 10000))     ;; force update even 10 seconds
 						       request-update))
 				    (newtestdat (if need-update 
 						    ;; NOTE: BUG HIDER, try to eliminate this exception handler
 						    (handle-exceptions
-						     exn 
-						     (debug:print-info 0 *default-log-port* "test db access issue in examine test for run-id " run-id ", test-id " test-id ": " ((condition-property-accessor 'exn 'message) exn))
-						     (rmt:get-test-info-by-id run-id test-id )))))
+							exn
+						      (begin
+							(debug:print-info 0 *default-log-port* "test db access issue in examine test for run-id " run-id
+									  ", test-id " test-id ": " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn)
+							#f)
+						      (rmt:get-test-info-by-id run-id test-id)))))
 			       ;; (print "INFO: need-update= " need-update " curr-mod-time = " curr-mod-time)
 			       (cond
 				((and need-update newtestdat)
 				 (set! testdat newtestdat)
 				 (set! teststeps    (augment-teststeps (tests:get-compressed-steps run-id test-id)))

Index: dashboard.scm
==================================================================
--- dashboard.scm
+++ dashboard.scm
@@ -44,17 +44,17 @@
 (declare (uses dcommon))
 (declare (uses dashboard-context-menu))
 (declare (uses vg))
 (declare (uses subrun))
 ;; (declare (uses dashboard-main))
-(declare (uses megatest-version))
 (declare (uses mt))
 
 (include "common_records.scm")
 (include "db_records.scm")
 (include "run_records.scm")
 (include "task_records.scm")
+(include "megatest-version.scm")
 (include "megatest-fossil-hash.scm")
 (include "vg_records.scm")
 
 (define help (conc 
 	      "Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest
@@ -64,10 +64,13 @@
 Usage: dashboard [options]
   -h                    : this help
   -test run-id,test-id  : control test identified by testid
   -skip-version-check   : skip the version check
   -use-db-cache         : access database via cache 
+  -target T             : prefill target filter with given target pattern
+  -runname R            : prefill runname filter with given runname pattern
+  -testpatt P           : prefill testpatt filter with given testpatt              
 
 Misc
   -rows R         : set number of rows
   -cols C         : set number of columns
 "))
@@ -86,10 +89,13 @@
                         "-xterm"
 			"-debug"
 			"-host" 
 			"-transport"
                         "-start-dir"
+			"-target"   ;; use as filter
+			"-runname"  ;; use as filter
+			"-testpatt" ;; use as filter
 			) 
 		 (list  "-h"
 			"-use-server"
 			"-guimonitor"
 			"-main"
@@ -97,10 +103,11 @@
 			"-q"
 			"-use-db-cache"
 			"-skip-version-check"
 			"-repl"
                         "-rh5.11" ;; fix to allow running on rh5.11
+			"-:p"     ;; ignore the built in chicken profiling switch
 			)
 		 args:arg-hash
 		 0))
 
 ;; check for MT_* environment variables and exit if found
@@ -431,10 +438,76 @@
   ((last-update   0)                 : number)    ;; last query to db got records from before last-update
   ((last-db-time  0)                 : number)    ;; last timestamp on megatest.db
   ((data-changed  #f)                : boolean)   
   ((run-data-offset  0)              : number)      ;; get only 100 items per call, set back to zero when received less than 100 items
   (db-path #f))
+
+;; for the new runs view lets build up a few new record types and then consolidate later
+;;
+;; this is a two level deep pipeline for the incoming data:
+;;   sql query data ==> filters ==> data for display
+;;
+(defstruct dboard:rdat
+  ;; view related items
+  (runnum    0) ;; which column we are processing, index into runsbynum, we sweep across all these runs then start over
+  (leftcol   0) ;; number of the leftmost visible column
+  (toprow    0) ;; topmost visible row
+  (numcols  24) ;; number of columns visible
+  (numrows  20) ;; number of rows visible
+  
+  ;; data from sql db
+  (keys       (rmt:get-keys))         ;; to be removed when targets handling is refactored
+  (runs       (make-sparse-vector))   ;; id => runrec
+  (runsbynum  (make-vector 100 #f))   ;; vector num => runrec 
+  (targ-runid (make-hash-table))      ;; area/target/runname => run-id  ;; not sure this will be needed
+  (tests      (make-hash-table))      ;; test[/itempath] => list of test rec
+
+  ;; run sql filters 
+  (targ-sql-filt        "%")
+  (runname-sql-filt     "%")
+  (run-state-sql-filt   "%")
+  (run-status-sql-filt  "%")
+
+  ;; test sql filter
+  (testname-sql-filt    "%")
+  (itempath-sql-filt    "%")
+  (test-state-sql-filt  "%")
+  (test-status-sql-filt "%")
+
+  ;; other sql related fields
+  (last-updates (make-sparse-vector 0))  ;; run-id -> timestamp of the last update from sql db, set to zero on any field changes
+
+  ;; filtered data
+  (cols  (make-sparse-vector))   ;; columnnum => run-id
+  (tests (make-hash-table))      ;; test[/itempath] => (vector columnnum => test rec)
+
+  ;; various
+  (prev-run-ids  '())            ;; push previously looked at runs on this
+  (view-changed #f)
+
+  ;; widgets
+  (runs-tree #f)                 ;; 
+  )
+
+(define (dboard:rdat-push-run-id rdat run-id)
+  (dboard:rdat-prev-run-ids-set! rdat (cons run-id (dboard:rdat-prev-run-ids rdat))))
+
+(defstruct dboard:runrec
+  id
+  target  ;; a/b/c...
+  tdef    ;; for future use
+  )
+     
+(defstruct dboard:testrec
+  id
+  runid
+  testname  ;; test[/itempath]
+  state
+  status
+  start-time
+  duration
+  )
 
 ;; register dboard:rundat with BBpp
 ;; this is used by BBpp (Brandon's pretty printer) to convert dboard:rundat into a composition of lists that pp will handle
 (hash-table-set! *BBpp_custom_expanders_list* RUNDAT:
                  (cons dboard:rundat?
@@ -1102,13 +1175,14 @@
 			   (button     (vector-ref columndat rown))
 			   (color      (car (gutils:get-color-for-state-status teststate teststatus)))
 			   (curr-color (vector-ref buttondat 1)) ;; (iup:attribute button "BGCOLOR"))
 			   (curr-title (vector-ref buttondat 2))) ;; (iup:attribute button "TITLE")))
 		      (if (not (equal? curr-color color))
-			  (iup:attribute-set! button "BGCOLOR" color))
+			  #;(iup:attribute-set! button "BGCOLOR" color)
+			  (iup:attribute-set! button "FGCOLOR" color))
 		      (if (not (equal? curr-title buttontxt))
-			  (iup:attribute-set! button "TITLE"   buttontxt))
+			  (iup:attribute-set! button "TITLE" (conc "<span weight=\"bold\">"  buttontxt "</span>")))
 		      (vector-set! buttondat 0 run-id)
 		      (vector-set! buttondat 1 color)
 		      (vector-set! buttondat 2 buttontxt)
 		      (vector-set! buttondat 3 testdat)
 		      (vector-set! buttondat 4 run-key)))
@@ -1451,45 +1525,56 @@
  ;; #:title "Logs" ;; To be replaced with tabs
  ;; (let ((logs-tb (iup:textbox #:expand "YES"
  ;;				   #:multiline "YES")))
  ;;	 (dboard:tabdat-logs-textbox-set! tabdat logs-tb)
  ;;	 logs-tb))
+
+(define (dboard:runs-tree-txtbox-change tabdat val a b)
+  (if b (dboard:tabdat-target-set! tabdat (string-split b "/")))
+  (dashboard:update-run-command tabdat))
 
 ;; browse runs as a tree. Used in both "Runs" tab and
 ;; in the runs control panel.
 ;;
 (define (dboard:runs-tree-browser commondat tabdat)
-  (let* (
-	 (txtbox (iup:textbox #:action (lambda (val a b)
-					 (debug:catch-and-dump
-					  (lambda ()
-					    ;; for the Runs view we put the list of keyvals into tabdat target
-					    ;; for the Run Controls we put then update the run-command
-					    (if b (dboard:tabdat-target-set! tabdat (string-split b "/")))
-					    (dashboard:update-run-command tabdat))
-					  "command-testname-selector tb action"))
-			      #:value (dboard:test-patt->lines
-				       (dboard:tabdat-test-patts-use tabdat))
-			      #:expand "HORIZONTAL"
-			      ;; #:size "10x30"
-			      ))
+  (let* ((txtbox (iup:textbox
+		  #:action (lambda (val a b)
+			     (debug:catch-and-dump
+			      (lambda ()
+				(dboard:runs-tree-txtbox-change tabdat val a b))
+			      "command-testname-selector tb action"))
+		  #:value (dboard:test-patt->lines
+			       (dboard:tabdat-test-patts-use tabdat))
+		  #:expand "HORIZONTAL"
+		  ;; #:size "10x30"
+		  ))
 	 (tb
           (iup:treebox
            #:value 0
-           #:title "Runs" ;;  was #:name -- iup 3.19 changed this... "Changed: [DEPRECATED REMOVED] removed the old attribute NAMEid from IupTree to avoid conflict with the common attribute NAME. Use the TITLEid attribute."
+           #:title "Runs"     ;;  was #:name -- iup 3.19 changed
+			      ;;  this... "Changed: [DEPRECATED
+			      ;;  REMOVED] removed the old attribute
+			      ;;  NAMEid from IupTree to avoid
+			      ;;  conflict with the common attribute
+			      ;;  NAME. Use the TITLEid attribute."
            #:expand "YES"
            #:addexpanded "YES"
            #:size "10x"
            #:selection-cb
            (lambda (obj id state)
              (debug:catch-and-dump
               (lambda ()
                 (let* ((run-path (tree:node->path obj id))
                        (run-id    (tree-path->run-id tabdat (cdr run-path))))
-                  ;; (dboard:tabdat-view-changed-set! tabdat #t) ;; ?? done below when run-id is a number
-                  (dboard:tabdat-target-set! tabdat (cdr run-path)) ;; (print "run-path: " run-path)
-		  (iup:attribute-set! txtbox "VALUE" (string-intersperse (cdr run-path) "/"))
+                  ;; (dboard:tabdat-view-changed-set! tabdat #t) ;; ??
+                  ;; done below when run-id is a number
+                  (dboard:tabdat-target-set! tabdat (cdr run-path)) ;; (print
+								    ;; "run-path:
+								    ;; "
+								    ;; run-path)
+		  (iup:attribute-set! txtbox "VALUE"
+				      (string-intersperse (cdr run-path) "/"))
 		  (dashboard:update-run-command tabdat)
                   (dboard:tabdat-layout-update-ok-set! tabdat #f)
                   (if (number? run-id)
                       (begin
                         ;; capture last two in tabdat.
@@ -1501,14 +1586,90 @@
                       (debug:print-error 5 *default-log-port* "tree-path->run-id returned non-number " run-id))))
               "treebox"))
            ;; (print "path: " (tree:node->path obj id) " run-id: " run-id)
            )))
     (dboard:tabdat-runs-tree-set! tabdat tb)
+    (if (args:get-arg "-runname")
+	(let ((runname (args:get-arg "-runname")))
+	  (update-search commondat tabdat "runname" runname)
+	  #;(hash-table-set! (dboard:tabdat-searchpatts tabdat) "runname" runname)))
+    (if (args:get-arg "-target") ;; 
+	(let ((target (args:get-arg "-target")))
+	  (iup:attribute-set! txtbox value: target)
+	  (dboard:runs-tree-txtbox-change tabdat #f #f target)))
+    (iup:detachbox
+     (iup:vbox 
+      txtbox
+      tb
+      ))))
+
+;; browse runs as a tree. Used in both "Runs" tab and
+;; in the runs control panel.
+;;
+;;  THIS IS THE NEW ONE
+;;
+(define (dboard:runs-tree-new-browser commondat rdat)
+  (let* ((txtbox (iup:textbox
+		  #:action (lambda (val a b)
+			     (debug:catch-and-dump
+			      (lambda ()
+				;; for the Runs view we put the list
+				;; of keyvals into tabdat target for
+				;; the Run Controls we put then update
+				;; the run-command
+				(if b (dboard:rdat-targ-sql-filt-set! rdat
+								 (string-split b "/")))
+				#;(dashboard:update-run-command tabdat))
+			      "command-testname-selector tb action"))
+		  ;; #:value (dboard:test-patt->lines  ;; This seems like it was wrong, BUG in code where it was copied from?
+	          ;;		   (dboard:tabdat-test-patts-use tabdat))
+		  #:expand "HORIZONTAL"
+		  ;; #:size "10x30"
+		  ))
+	 (tb
+          (iup:treebox
+           #:value 0
+           #:title "Runs"     ;;  was #:name -- iup 3.19 changed
+			      ;;  this... "Changed: [DEPRECATED
+			      ;;  REMOVED] removed the old attribute
+			      ;;  NAMEid from IupTree to avoid
+			      ;;  conflict with the common attribute
+			      ;;  NAME. Use the TITLEid attribute."
+           #:expand "YES"
+           #:addexpanded "YES"
+           #:size "10x"
+           #:selection-cb
+           (lambda (obj id state)
+             (debug:catch-and-dump
+              (lambda ()
+                (let* ((run-path (tree:node->path obj id))
+                       (run-id    (new-tree-path->run-id rdat (cdr run-path))))
+                  ;; (dboard:tabdat-view-changed-set! tabdat #t) ;; ??
+                  ;; done below when run-id is a number
+                  (dboard:rdat-targ-sql-filt-set! rdat (cdr run-path)) ;; (print
+								    ;; "run-path:
+								    ;; "
+								    ;; run-path)
+		  (iup:attribute-set! txtbox "VALUE"
+				      (string-intersperse (cdr run-path) "/"))
+		  #;(dashboard:update-run-command tabdat)
+                  #;(dboard:tabdat-layout-update-ok-set! tabdat #f)
+                  (if (number? run-id)
+                      (begin
+                        ;; capture last two in tabdat.
+                        (dboard:rdat-push-run-id rdat run-id)
+			(dboard:rdat-view-changed-set! rdat #t))
+                      (debug:print-error 5 *default-log-port* "tree-path->run-id returned non-number " run-id))))
+              "treebox"))
+           ;; (print "path: " (tree:node->path obj id) " run-id: " run-id)
+           )))
+    (dboard:rdat-runs-tree-set! rdat tb)
     (iup:detachbox
      (iup:vbox 
+      txtbox
       tb
-      txtbox))))
+      ))))
 
 ;;======================================================================
 ;; R U N   C O N T R O L S
 ;;======================================================================
 ;;
@@ -1674,10 +1835,15 @@
 
 (define (tree-path->run-id tabdat path)
   (if (not (null? path))
       (hash-table-ref/default (dboard:tabdat-path-run-ids tabdat) path #f)
       #f))
+
+(define (new-tree-path->run-id rdat path)
+  (if (not (null? path))
+      (hash-table-ref/default (dboard:rdat-path-run-ids tabdat) path #f)
+      #f))
 
 ;; (define (dboard:get-tests-dat tabdat run-id last-update)
 ;;   (let* ((access-mode     (dboard:tabdat-access-mode tabdat))
 ;;          (tdat (if run-id (db:dispatch-query access-mode rmt:get-tests-for-run db:get-tests-for-run
 ;;                                              run-id 
@@ -1747,27 +1913,42 @@
                         ;; (set! colnum (+ colnum 1))
                         ))))
 	      run-ids)))
 
 (define (dashboard:tests-ht->tests-dat tests-ht)
-  (reverse
-   (sort
-    (hash-table-values tests-ht)
-    (lambda (a b) 
-      (let ((a-test-name  (db:test-get-testname a))
-            (a-item-path  (db:test-get-item-path a))
-            (b-test-name  (db:test-get-testname b))
-            (b-item-path  (db:test-get-item-path b))
-            (a-event-time (db:test-get-event_time a))
-            (b-event-time (db:test-get-event_time b)))
-        (if (not (equal? a-test-name b-test-name))
-            (> a-event-time b-event-time)
-            (cond
-             ((< 0 (string-compare3 a-test-name b-test-name)) #t)
-             ((> 0 (string-compare3 a-test-name b-test-name)) #f)
-             ((< 0 (string-compare3 a-item-path b-item-path)) #t)
-             (else #f))))))))
+  (let ((oldest-item (make-hash-table))) ;;
+    ;; populate the oldest-item table
+    (for-each
+     (lambda (tdat)
+       (let ((tname (db:test-get-testname tdat))
+	     (etime (db:test-get-event_time tdat)))
+	 (if (hash-table-exists? oldest-item tname)
+	     (if (< (hash-table-ref oldest-item tname) etime)
+		 (hash-table-set! oldest-item tname etime))
+	     (hash-table-set! oldest-item tname etime))))
+     (hash-table-values tests-ht))
+    (reverse
+     (sort
+      (hash-table-values tests-ht)
+      (lambda (a b) 
+	(let ((a-test-name  (db:test-get-testname a))
+	      (a-item-path  (db:test-get-item-path a))
+	      (b-test-name  (db:test-get-testname b))
+	      (b-item-path  (db:test-get-item-path b))
+	      (a-event-time (db:test-get-event_time a))
+	      (b-event-time (db:test-get-event_time b)))
+	  (if (equal? a-test-name b-test-name)
+	      (> a-event-time b-event-time)
+	      (> (hash-table-ref oldest-item a-test-name)
+		 (hash-table-ref oldest-item b-test-name)))))))))
+;;	  (if (not (equal? a-test-name b-test-name))
+;;	      (> a-event-time b-event-time)
+;;	      (cond
+;;	       ((< 0 (string-compare3 a-test-name b-test-name)) #t)
+;;	       ((> 0 (string-compare3 a-test-name b-test-name)) #f)
+;;	       ((< 0 (string-compare3 a-item-path b-item-path)) #t)
+;;	       (else #f)))))))))
 
 
 (define (dashboard:run-id->tests-mindat run-id tabdat runs-hash)
   (let* ((run          (hash-table-ref/default runs-hash run-id #f))
          (key-vals     (rmt:get-key-vals run-id))
@@ -1862,10 +2043,12 @@
                     (iup:attribute-set! run-matrix "NUMCOL" max-col ))
 
                 (let ((effective-max-row (if (< max-row max-visible) max-visible max-row)))
                   (if (> effective-max-row (string->number (iup:attribute run-matrix "NUMLIN")))
                       (iup:attribute-set! run-matrix "NUMLIN" effective-max-row )))
+
+		(iup:attribute-set! run-matrix "WIDTHDEF" 16)
                 
                 ;; Row labels
                 (for-each (lambda (ind)
                             (let* ((name (car ind))
                                    (num  (cadr ind))
@@ -1901,20 +2084,20 @@
                                     (iup:attribute-set! run-matrix key (cadr value))
                                     (iup:attribute-set! run-matrix (conc "BGCOLOR" key) (car value))))))
                           matrix-content)
                 
                 ;; Col labels - do after setting Cell contents so they are accounted for in the size calc.
-                
+
                 (for-each (lambda (ind)
                             (let* ((name (car ind))
                                    (num  (cadr ind))
                                    (key  (conc "0:" num)))
                               (if (not (equal? (iup:attribute run-matrix key) name))
                                   (begin
                                     (set! changed #t)
-                                    (iup:attribute-set! run-matrix key name)
-                                    (if (<= num max-col)
+                                    (iup:attribute-set! run-matrix key name) ;; (list->string (intersperse (string->list name) #\newline))) ;; name)
+				    #;(if (<= num max-col)
                                         (iup:attribute-set! run-matrix "FITTOTEXT" (conc "C" num)))))))
                           col-indices)
                 
                 (if (and (eq? pass-num 0) changed)
                     (loop 1 #t)) ;; force second pass due to column labels changing
@@ -1974,11 +2157,11 @@
 	     (file-read-access? source))
 	(handle-exceptions
 	 exn
 	 (begin
 	   (print-call-chain)
-	   (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
+	   (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn)
 	   (debug:print 0 *default-log-port* "ERROR: failed to load " source ", try loading in the repl: megatest -repl")
 	   (set! success #f))
 	 (load source))
 	(begin
 	  (debug:print 0 *default-log-port* "ERROR: cannot find file to load: \"" source "\" for user view " view-name)))
@@ -1986,11 +2169,11 @@
     (if success
 	(handle-exceptions
 	 exn
 	 (begin
 	   (print-call-chain)
-	   (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
+	   (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn)
 	   (debug:print 0 *default-log-port* "ERROR: failed call procedure " viewgen
 			", with; tab-num=" tab-num ", view-name=" view-name
 			", and views-cfgdat and megatest configdat as parameters. To debug try loading in the repl: megatest -repl")
 	   (set! success #f))
 	 (print "Adding tab " view-name " with proc " viewgen)
@@ -2003,11 +2186,11 @@
 				      (lambda ()
 					(handle-exceptions
 					 exn
 					 (begin
 					   (print-call-chain)
-					   (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
+					   (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn)
 					   (debug:print 0 *default-log-port* "ERROR: failed call procedure \"" updater
 							"\", with; tabnum=" tab-num ", view-name=" view-name
 							", and views-cfgdat and megatest configdat as parameters. To debug try loading in the repl: megatest -repl")
 					   (set! success #f))
 					 (debug:print 4 *default-log-port* "Running updater for tab " view-name " with proc " updater " and tab-num: " tab-num)
@@ -2330,22 +2513,22 @@
 	   (set! hide (iup:button "Hide"
 				  #:expand "NO" #:size "40x15" ;; #:expand "HORIZONTAL"
 				  #:action (lambda (obj)
 					     (dboard:tabdat-hide-not-hide-set! tabdat #t) ;; (not (dboard:tabdat-hide-not-hide tabdat)))
 					     ;; (iup:attribute-set! obj "TITLE" (if (dboard:tabdat-hide-not-hide tabdat) "HideTests" "NotHide"))
-					     (iup:attribute-set! hide "BGCOLOR" sel-color)
-					     (iup:attribute-set! show "BGCOLOR" nonsel-color)
+					     (iup:attribute-set! hide "FGCOLOR" sel-color)
+					     (iup:attribute-set! show "FGCOLOR" nonsel-color)
 					     (mark-for-update tabdat))))
 	   (set! show (iup:button "Show"
 				  #:expand "NO" #:size "40x15" ;; #:expand "HORIZONTAL"
 				  #:action (lambda (obj)
 					     (dboard:tabdat-hide-not-hide-set! tabdat #f) ;; (not (dboard:tabdat-hide-not-hide tabdat)))
-					     (iup:attribute-set! show "BGCOLOR" sel-color)
-					     (iup:attribute-set! hide "BGCOLOR" nonsel-color)
+					     (iup:attribute-set! show "FGCOLOR" sel-color)
+					     (iup:attribute-set! hide "FGCOLOR" nonsel-color)
 					     (mark-for-update tabdat))))
-	   (iup:attribute-set! hide "BGCOLOR" sel-color)
-	   (iup:attribute-set! show "BGCOLOR" nonsel-color)
+	   (iup:attribute-set! hide "FGCOLOR" sel-color)
+	   (iup:attribute-set! show "FGCOLOR" nonsel-color)
 	   ;; (dboard:tabdat-hide-not-hide-button-set! tabdat hideit) ;; never used, can eliminate ...
            (iup:vbox
             (iup:hbox hide show)
             sort-lb))) 
 	)
@@ -2428,14 +2611,165 @@
 		#:expand "HORIZONTAL"
 		#:max (* 10 (max (hash-table-size (dboard:tabdat-allruns-by-id tabdat)) 10))
 		#:min 0
 		#:step 0.01))
 
+;; make-simple-run                   procedure (target3772 id3773 runname3774 state3775 status3776 owner3777 event_time3778)
+;; rmt:simple-get-runs               procedure (runpatt1001 count1002 offset1003 target1004)
+;; simple-run-event_time             procedure (x3834)
+;; simple-run-event_time-set!        procedure (x3830 val3831)
+;; simple-run-id                     procedure (x3794)
+;; simple-run-id-set!                procedure (x3790 val3791)
+;; simple-run-owner                  procedure (x3826)
+;; simple-run-owner-set!             procedure (x3822 val3823)
+;; simple-run-runname                procedure (x3802)
+;; simple-run-runname-set!           procedure (x3798 val3799)
+;; simple-run-state                  procedure (x3810)
+;; simple-run-state-set!             procedure (x3806 val3807)
+;; simple-run-status                 procedure (x3818)
+;; simple-run-status-set!            procedure (x3814 val3815)
+;; simple-run-target                 procedure (x3786)
+;; simple-run-target-set!            procedure (x3782 val3783)
+;; simple-run?                       procedure (x3780)
+
+
+;;======================================================================
+;; Extracting the data to display for runs
+;;
+;; This needs to be re-entrant such that it does one column per call
+;; on the zeroeth call update runs data
+;; on each subsequent call update one run (configurable - could do two, three ... or update until tdelta exceeded
+;; on last run reset to zeroeth
+;;
+;;   1. select with run filters; area, target, runname, runstate, runstatus, starttime, duration
+;;       - put this information into two data structures:
+;;         a. hash of area/target/runname => runstruct #< ordernun, id, area, target, runname, state,
+;;                                                        status, starttime, duration, non-deleted testcount>
+;;            ordernum reflects order as received from sql query
+;;         b. sparsevec of id => runstruct
+;;   2. for each run in runshash ordered by ordernum do:
+;;         retrieve data since last update for that run
+;;         if there is a deleted test - retrieve full data
+;;         if there are non-deleted tests register this run in the columns sparsevec
+;;         if this is the zeroeth column regenerate the rows sparsevec
+;;         if this column is in the visible zone update visible cells
+;;
+;; Other factors:
+;;   1. left index handling:
+;;       - add test/itempaths to left index as discovered, re-order and
+;;         update row -> test/itempath mapping on each read run
+;;======================================================================
+
+;; runs is <vec header runs>
+;;   get ALL runs info
+;;   update rdat-targ-run-id
+;;   update rdat-runs
+;;
+(define (dashboard:update-runs-data rdat)
+  (let* ((tb               (dboard:rdat-runs-tree rdat))
+	 (targ-sql-filt    (dboard:rdat-targ-sql-filt    rdat))
+	 (runname-sql-filt (dboard:rdat-runname-sql-filt rdat))
+	 (state-sql-filt   (dboard:rdat-run-state-sql-filt   rdat))
+	 (status-sql-filt  (dboard:rdat-run-status-sql-filt  rdat))
+	 ;; Use (db:get-value-by-header (db:get-header runinfo)(db:get-rows runinfo))
+	 (data             (rmt:simple-get-runs runname-sql-filt #f #f targ-sql-filt #f))
+	 (numruns          (length data)))
+    ;; store in the runsbynum vector
+    (dboard:rdat-runsbynum-set! rdat (list->vector data))
+    ;; update runs       id              => runrec
+    ;; update targ-runid target/runname  => run-id
+    (for-each
+     (lambda (runrec)
+       (let* ((run-id (simple-run-id runrec))
+	      (full-targ-runname (conc (simple-run-target runrec) "/"
+				       (simple-run-runname runrec))))
+	 (debug:print 0 *default-log-port* "Update run  " run-id)
+	 (sparse-vector-set! (dboard:rdat-runs rdat) run-id runrec)
+	 (hash-table-set! (dboard:rdat-targ-runid rdat) full-targ-runname run-id)
+	 ))
+     data)
+    numruns))
+
+;; NOTE: runnum is NOT the run-id, it is a pointer into the runsbynum vector
+;;
+(define (dashboard:update-run-data runnum rdat)
+  (let* ((curr-time            (current-seconds))
+	 (runrec               (vector-ref (dboard:rdat-runsbynum rdat) runnum))
+	 (run-id               (simple-run-id runrec))
+	 (last-update          (sparse-vector-ref (dboard:rdat-last-updates rdat) run-id))
+	 ;; filters
+	 (testname-sql-filt    (dboard:rdat-testname-sql-filt    rdat))
+	 ;; (itempath-sql-filt    (dboard:rdat-itempath-sql-filt    rdat))
+	 (test-state-sql-filt  (dboard:rdat-test-state-sql-filt  rdat))  ;; not used yet
+	 (test-status-sql-filt (dboard:rdat-test-status-sql-filt rdat))  ;; not used yet
+	 (tests                (rmt:get-tests-for-run-state-status run-id
+						      testname-sql-filt
+						      last-update                ;; last-update
+						      )))
+    (sparse-vector-set! (dboard:rdat-last-updates rdat) run-id (- curr-time 1))
+    (debug:print 0 *default-log-port* "Got " (length tests) " tests for run-id "
+		 run-id " testname-sql-filt " testname-sql-filt " and last-update " last-update) 
+    (length tests)))
+
+(define (new-runs-updater commondat rdat)
+  (let* ((runnum           (dboard:rdat-runnum          rdat))
+	 (start-time       (current-milliseconds))
+	 (tot-runs         #f))
+    (if (eq? runnum 0)(dashboard:update-runs-data rdat))
+    (set! tot-runs (vector-length (dboard:rdat-runsbynum rdat)))
+    (let loop ((rn   runnum))
+      (if (and (< (- (current-milliseconds) start-time) 250)
+	       (< rn tot-runs))
+	  (let* ((newrn (if (>= runnum (vector-length (dboard:rdat-runsbynum rdat)))
+			    0 ;; start over
+			    (+ rn 1)))) ;; (+ runnum 1)))
+	    (dashboard:update-run-data rn rdat)
+	    (dboard:rdat-runnum-set! rdat newrn)
+	    (if (> newrn 0)
+		(loop newrn)))))
+    (if (>=  (dboard:rdat-runnum rdat) tot-runs)
+	(dboard:rdat-runnum-set! rdat 0))
+    ;; (dboard:rdat-runnum-set! rdat rn))) ;; not needed as it is set above
+    ;; (dboard:rdat-last-update-set! rdat (- (current-seconds) 10))
+    ;;    	 (tree:add-node tb "Runs" (string-split full-targ-runname "/"))
+    '()))
+
+(define (dboard:runs-new-matrix commondat rdat)
+  (iup:matrix
+   #:alignment1 "ALEFT"
+   ;; #:expand "YES" ;; "HORIZONTAL"
+   #:scrollbar "YES"
+   #:numcol 10
+   #:numlin 20
+   #:numcol-visible 5 ;; (min 8)
+   #:numlin-visible 1
+   #:click-cb
+   (lambda (obj row col status)
+     (let* ((cell (conc row ":" col)))
+       #f))
+   ))
+	 
+(define (make-runs-view commondat rdat tab-num)
+  ;; register an updater
+  (dboard:commondat-add-updater
+   commondat
+   (lambda ()
+     (new-runs-updater commondat rdat))
+   tab-num: tab-num)
+
+  (iup:vbox
+   (iup:split
+    #:orientation "VERTICAL" ;; "HORIZONTAL"
+    #:value 100
+    (dboard:runs-tree-new-browser commondat rdat)
+    (dboard:runs-new-matrix commondat rdat)
+    )))
 
 (define (make-dashboard-buttons commondat) ;;  runs-sum-dat new-view-dat)
   (let* ((stats-dat       (dboard:tabdat-make-data))
 	 (runs-dat        (dboard:tabdat-make-data))
+	 (runs2-dat       (make-dboard:rdat)) ;; (dboard:tabdat-make-data))
 	 (onerun-dat      (dboard:tabdat-make-data)) ;; name for run-summary structure 
 	 (runcontrols-dat (dboard:tabdat-make-data))
 	 (runtimes-dat    (dboard:tabdat-make-data))
 	 (nruns           (dboard:tabdat-numruns runs-dat))
 	 (ntests          (dboard:tabdat-num-tests runs-dat))
@@ -2455,60 +2789,90 @@
 	 (btn-fontsz      (dboard:tabdat-runs-btn-fontsz runs-dat))
 	 (cell-width      (dboard:tabdat-runs-cell-width runs-dat)))
     ;; controls (along bottom)
     ;; (set! controls (dboard:make-controls commondat runs-dat))
     
+    (if (args:get-arg "-runname")
+	(let ((runname (args:get-arg "-runname")))
+	  (update-search commondat runs-dat "runname" runname)
+	  #;(hash-table-set! (dboard:tabdat-searchpatts tabdat) "runname" runname)))
+
     ;; create the left most column for the run key names and the test names 
-    (set! lftlst (list (iup:hbox
-			(iup:label) ;; (iup:valuator)
-			(apply iup:vbox 
-			       (map (lambda (x)		
-				      (let ((res (iup:hbox #:expand "HORIZONTAL"
-							   (iup:label x #:size (conc 40 btn-height) #:fontsize btn-fontsz #:expand "NO") ;; "HORIZONTAL")
-							   (iup:textbox #:size (conc 35 btn-height) #:fontsize btn-fontsz #:value "%" #:expand "NO" ;; "HORIZONTAL"
-									#:action (lambda (obj unk val)
-										   ;; each field (field name is "x" var) live updates
-										   ;; the search filter as it is typed
-										   (dboard:tabdat-target-set! runs-dat #f) ;; ensure the fields text boxes are used and not the info from the tree
-										   (mark-for-update runs-dat)
-										   (update-search commondat runs-dat x val))))))
-					(set! i (+ i 1))
-					res))
-				    keynames)))))
+    (set! lftlst
+	  (list (iup:hbox
+		 (iup:label) ;; (iup:valuator)
+		 (apply iup:vbox 
+			(map (lambda (x)		
+			       (let ((res (iup:hbox
+					   #:expand "HORIZONTAL"
+					   (iup:label x
+						      #:size (conc 40 btn-height)
+						      #:fontsize btn-fontsz
+						      #:expand "NO") ;; "HORIZONTAL")
+					   (iup:textbox
+					    #:size (conc 35 btn-height)
+					    #:fontsize btn-fontsz
+					    #:value (if (and (args:get-arg "-runname")(equal? x "runname"))
+							(args:get-arg "-runname") "%")
+					    #:expand "NO" ;; "HORIZONTAL"
+					    #:action (lambda (obj unk val)
+						       ;; each field
+						       ;; (field name is "x" var) live updates
+						       ;; the search filter as it is typed
+						       (dboard:tabdat-target-set! runs-dat #f)
+						       ;; ensure fields text boxes are used
+						       ;; and not the info from the tree
+						       (mark-for-update runs-dat)
+						       (update-search commondat runs-dat x val))))))
+				 (set! i (+ i 1))
+				 res))
+			     keynames)))))
     (let loop ((testnum  0)
 	       (res      '()))
       (cond
        ((>= testnum ntests)
 	;; now lftlst will be an hbox with the test keys and the test name labels
-	(set! lftlst (append lftlst (list (iup:hbox  #:expand "HORIZONTAL"
-						     (iup:valuator #:valuechanged_cb (lambda (obj)
-										       (let ((val (string->number (iup:attribute obj "VALUE")))
-											     (oldmax  (string->number (iup:attribute obj "MAX")))
-											     (newmax  (* 10 (length (dboard:tabdat-all-test-names runs-dat)))))
-											 (dboard:commondat-please-update-set! commondat #t)
-											 (dboard:tabdat-start-test-offset-set! runs-dat (inexact->exact (round (/ val 10))))
-											 (debug:print 6 *default-log-port* "(dboard:tabdat-start-test-offset runs-dat) " (dboard:tabdat-start-test-offset runs-dat) " val: " val " newmax: " newmax " oldmax: " oldmax)
-											 (if (< val 10)
-											     (iup:attribute-set! obj "MAX" newmax))
-											 ))
-								   #:expand "VERTICAL" 
-								   #:orientation "VERTICAL"
-								   #:min 0
-								   #:step 0.01)
-						     (apply iup:vbox (reverse res)))))))
+	(set! lftlst
+	      (append
+	       lftlst
+	       (list
+		(iup:hbox
+		 #:expand "HORIZONTAL"
+		 (iup:valuator
+		  #:valuechanged_cb
+		  (lambda (obj)
+		    (let ((val (string->number (iup:attribute obj "VALUE")))
+			  (oldmax  (string->number (iup:attribute obj "MAX")))
+			  (newmax  (* 10 (length (dboard:tabdat-all-test-names runs-dat)))))
+		      (dboard:commondat-please-update-set! commondat #t)
+		      (dboard:tabdat-start-test-offset-set! runs-dat
+							    (inexact->exact (round (/ val 10))))
+		      (debug:print 6 *default-log-port*
+				   "(dboard:tabdat-start-test-offset runs-dat) "
+				   (dboard:tabdat-start-test-offset runs-dat) " val: " val
+				   " newmax: " newmax " oldmax: " oldmax)
+		      (if (< val 10)
+			  (iup:attribute-set! obj "MAX" newmax))
+		      ))
+		  #:expand "VERTICAL" 
+		  #:orientation "VERTICAL"
+		  #:min 0
+		  #:step 0.01)
+		 (apply iup:vbox (reverse res)))))))
        (else
-	(let ((labl  (iup:button "" ;; the testname labels
-				 #:flat "YES" 
-				 #:alignment "ALEFT"
+	(let ((labl  (iup:button
+		      "" ;; the testname labels
+		      #:flat "YES" 
+		      #:alignment "ALEFT"
 					; #:image img1
 					; #:impress img2
-				 #:size  (conc cell-width btn-height)
-				 #:expand  "HORIZONTAL"
-				 #:fontsize btn-fontsz
-				 #:action (lambda (obj)
-					    (mark-for-update runs-dat)
-					    (toggle-hide testnum (dboard:commondat-uidat commondat)))))) ;; (iup:attribute obj "TITLE"))))
+		      #:size  (conc cell-width btn-height)
+		      #:expand  "HORIZONTAL"
+		      #:fontsize btn-fontsz
+		      #:action (lambda (obj)
+				 (mark-for-update runs-dat)
+				 (toggle-hide testnum (dboard:commondat-uidat commondat)))))) 
 	  (vector-set! lftcol testnum labl)
 	  (loop (+ testnum 1)(cons labl res))))))
     ;; These are the headers for each row
     (let loop ((runnum  0)
 	       (keynum  0)
@@ -2539,10 +2903,11 @@
 	(let* ((button-key (mkstr runnum testnum))
 	       (butn       (iup:button
 			    "" ;; button-key 
 			    #:size (conc cell-width btn-height )
 			    #:expand "HORIZONTAL"
+			    #:MARKUP "YES"
 			    #:fontsize btn-fontsz
 			    #:button-cb
 			    (lambda (obj a pressed x y btn . rem)
 			      ;; (print "pressed= " pressed " x= " x " y= " y " rem=" rem " btn=" btn " string? " (string? btn))
 			      (if  (substring-index "3" btn)
@@ -2617,50 +2982,51 @@
 		 (lambda (view-name)
 		   (debug:print 0 *default-log-port* "Adding view " view-name)
 		   (let* ((cfgtype (configf:lookup views-cfgdat view-name "type"))) ;; what type of view?
 		     (if (not (string? cfgtype))
 			 (debug:print-info 0 *default-log-port* "WARNING: view \"" view-name
-				     "\" is missing needed sections. Please consult the documenation and update ~/.mtviews.config or " *toppath* "/.mtviews.config")
+					   "\" is missing needed sections. "
+					   "Please consult the documenation and update ~/.mtviews.config or "
+					   *toppath* "/.mtviews.config")
 			 (case (string->symbol cfgtype)
 			   ;; user supplied source for a tab
 			   ;;
-			   ((external)
-			    (let ((tab-content (dboard:add-external-tab commondat view-name views-cfgdat #f tab-num))) ;; was tabs
+			   ((external) ;; was tabs
+			    (let ((tab-content (dboard:add-external-tab commondat view-name views-cfgdat #f tab-num)))
 			      (set! additional-tabnames (cons (cons tab-num view-name) additional-tabnames))
 			      (set! tab-num (+ tab-num 1))
 			      (set! result (append result (list tab-content)))))))))
-		 (sort (hash-table-keys views-cfgdat) (lambda (a b)
-							(let ((order-a (or (any->number (configf:lookup views-cfgdat a "order")) 999))
-							      (order-b (or (any->number (configf:lookup views-cfgdat b "order")) 999)))
-							  (> order-a order-b)))))
+		 (sort (hash-table-keys views-cfgdat)
+		       (lambda (a b)
+			 (let ((order-a (or (any->number (configf:lookup views-cfgdat a "order")) 999))
+			       (order-b (or (any->number (configf:lookup views-cfgdat b "order")) 999)))
+			   (> order-a order-b)))))
 		result))
 	     (tabs (apply iup:tabs
 			  #:tabchangepos-cb (lambda (obj curr prev)
 					      (debug:catch-and-dump
 					       (lambda ()
 						 (let* ((tab-num (dboard:commondat-curr-tab-num commondat))
 							(tabdat  (dboard:common-get-tabdat commondat tab-num: tab-num)))
-                   
 						   (dboard:tabdat-layout-update-ok-set! tabdat #f))
 						 (dboard:commondat-curr-tab-num-set! commondat curr)
 						 (let* ((tab-num (dboard:commondat-curr-tab-num commondat))
 							(tabdat  (dboard:common-get-tabdat commondat tab-num: tab-num)))
-               
 						   (dboard:commondat-please-update-set! commondat #t)
 						   (dboard:tabdat-layout-update-ok-set! tabdat #t)))
 					       "tabchangepos"))
 			  (dashboard:summary commondat stats-dat tab-num: 0)
 			  runs-view
+			  ;; (make-runs-view commondat runs2-dat 2)
 			  (dashboard:runs-summary commondat onerun-dat tab-num: 2)
-			  ;; (dashboard:new-view db data new-view-dat tab-num: 3)
 			  (dashboard:run-controls commondat runcontrols-dat tab-num: 3)
 			  (dashboard:run-times commondat runtimes-dat tab-num: 4)
-			  ;; (dashboard:runs-summary commondat onerun-dat tab-num: 4)
 			  additional-views)))
 	;; (set! (iup:callback tabs tabchange-cb:) (lambda (a b c)(print "SWITCHED TO TAB: " a " " b " " c)))
 	(iup:attribute-set! tabs "TABTITLE0" "Summary")
 	(iup:attribute-set! tabs "TABTITLE1" "Runs")
+	;; (iup:attribute-set! tabs "TABTITLE2" "Runs2")
 	(iup:attribute-set! tabs "TABTITLE2" "Run Summary")
 	(iup:attribute-set! tabs "TABTITLE3" "Run Control")
 	(iup:attribute-set! tabs "TABTITLE4" "Run Times")
 	;; (iup:attribute-set! tabs "TABTITLE3" "New View")
 	;; (iup:attribute-set! tabs "TABTITLE4" "Run Control")
@@ -2675,10 +3041,11 @@
 	;; make the iup tabs object available (for changing color for example)
 	(dboard:commondat-hide-not-hide-tabs-set! commondat tabs)
 	;; now set up the tabdat lookup
 	(dboard:common-set-tabdat! commondat 0 stats-dat)
 	(dboard:common-set-tabdat! commondat 1 runs-dat)
+	;;(dboard:common-set-tabdat! commondat 2 runs2-dat)
 	(dboard:common-set-tabdat! commondat 2 onerun-dat)
 	(dboard:common-set-tabdat! commondat 3 runcontrols-dat)
 	(dboard:common-set-tabdat! commondat 4 runtimes-dat)
 
 	(iup:vbox
@@ -2714,11 +3081,12 @@
 
 (define (dashboard:get-youngest-run-db-mod-time dbdir)
   (handle-exceptions
    exn
    (begin
-     (debug:print 2 *default-log-port* "WARNING: error in accessing databases in get-youngest-run-db-mod-time: " ((condition-property-accessor 'exn 'message) exn) " db-dir="dbdir)
+     (debug:print 2 *default-log-port* "WARNING: error in accessing databases in get-youngest-run-db-mod-time: "
+		  ((condition-property-accessor 'exn 'message) exn) " db-dir="dbdir ", exn=" exn)
      (current-seconds)) ;; something went wrong - just print an error and return current-seconds
    (common:max (map (lambda (filen)
 		      (file-modification-time filen))
 		    (glob (conc dbdir "/*.db*"))))))
 
@@ -3418,20 +3786,12 @@
 (define (dashboard:runs-tab-updater commondat tab-num)
   (debug:catch-and-dump 
    (lambda ()
      (let* ((tabdat (dboard:common-get-tabdat commondat tab-num: tab-num))
 	    (dbkeys (dboard:tabdat-dbkeys tabdat)))
-       ;;(print "RA => calling runs-tab-updater with commondat " commondat " tab-num " tab-num)
-       ;;(tabdat-values tabdat) ;;RA added 
-       ;; (pp (dboard:tabdat->alist tabdat))
-       ;; (if (dashboard:database-changed? commondat tabdat context-key: 'runs-rundat)      
        (dashboard:do-update-rundat tabdat)
-       ;;(debug:print-info 13 *default-log-port* "dashboard:runs-tab-updater")
-       ;;(inspect tabdat)
-
        (let ((uidat (dboard:commondat-uidat commondat)))
-	 ;;(print "RA => Calling update-buttons with tabdat : " tabdat " uidat " uidat)
 	 (update-buttons tabdat uidat (dboard:tabdat-numruns tabdat) (dboard:tabdat-num-tests tabdat)))
        ))
    "dashboard:runs-tab-updater"))
 
 ;;======================================================================
@@ -3469,10 +3829,16 @@
 	(dboard:commondat-add-updater 
 	 commondat 
 	 (lambda ()
 	   (dashboard:runs-tab-updater commondat 1))
 	 tab-num: 1)
+        ;; may not want this alive (manually merged it from v1.66)
+	(dboard:commondat-add-updater 
+	 commondat 
+	 (lambda ()
+	   (dashboard:runs-tab-updater commondat 1))
+	 tab-num: 2)
 	(iup:callback-set! *tim*
 			   "ACTION_CB"
 			   (lambda (time-obj)
 			     (let ((update-is-running #f))
 			     (mutex-lock! (dboard:commondat-update-mutex commondat))

Index: db.scm
==================================================================
--- db.scm
+++ db.scm
@@ -39,11 +39,10 @@
 (include "common_records.scm")
 (include "db_records.scm")
 (include "key_records.scm")
 (include "run_records.scm")
 
-(define *rundb-mutex* (make-mutex)) ;; prevent problems opening/closing rundb's
 (define *number-of-writes* 0)
 (define *number-non-write-queries* 0)
 
 ;;======================================================================
 ;;  R E C O R D S
@@ -58,10 +57,11 @@
   (mtdb        #f)
   (refndb      #f)
   (homehost    #f) ;; not used yet
   (on-homehost #f) ;; not used yet
   (read-only   #f)
+  (stmt-cache  (make-hash-table))
   )                ;; goal is to converge on one struct for an area but for now it is too confusing
   
 
 ;; record for keeping state,status and count for doing roll-ups in
 ;; iterated tests
@@ -68,10 +68,43 @@
 ;;
 (defstruct dbr:counts
   (state #f)
   (status #f)
   (count  0)) 
+
+;;======================================================================
+;; alist-of-alists
+;;======================================================================
+;; 
+;; (define (db:aa-set! dat key1 key2 val)
+;;   (let loop ((
+
+;;======================================================================
+;; hash of hashs
+;;======================================================================
+
+
+(define (db:hoh-set! dat key1 key2 val)
+  (let* ((subhash (hash-table-ref/default dat key1 #f)))
+    (if subhash
+	(hash-table-set! subhash key2 val)
+	(begin
+	  (hash-table-set! dat key1 (make-hash-table))
+	  (db:hoh-set! dat key1 key2 val)))))
+
+(define (db:hoh-get dat key1 key2)
+  (let* ((subhash (hash-table-ref/default dat key1 #f)))
+    (and subhash
+	 (hash-table-ref/default subhash key2 #f))))
+
+(define (db:get-cache-stmth dbstruct db stmt)
+  (let* ((stmt-cache        (dbr:dbstruct-stmt-cache dbstruct))
+	 (stmth             (db:hoh-get stmt-cache db stmt)))
+    (or stmth
+	(let* ((newstmth (sqlite3:prepare db stmt)))
+	  (db:hoh-set! stmt-cache db stmt newstmth)
+	  newstmth))))
 
 ;;======================================================================
 ;; SQLITE3 HELPERS
 ;;======================================================================
 
@@ -90,11 +123,11 @@
    (let ((err-status ((condition-property-accessor 'sqlite3 'status #f) exn)))
      ;; check for (exn sqlite3) ((condition-property-accessor 'exn 'message) exn)
      (if (eq? err-status 'done)
 	 default
 	 (begin
-	   (debug:print-error 0 *default-log-port* " query " stmt " failed, params: " params ", error: " ((condition-property-accessor 'exn 'message) exn))
+	   (debug:print-error 0 *default-log-port* " query " stmt " failed, params: " params ", error: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn)
 	   (print-call-chain (current-error-port))
 	   default)))
    (apply sqlite3:first-result db stmt params)))
 
 ;; Get/open a database
@@ -122,56 +155,57 @@
 (define (db:dbdat-get-path dbdat)
   (if (pair? dbdat)
       (cdr dbdat)
       #f))
 
-;; mod-read:
-;;     'mod   modified data
-;;     'read  read data
-;; Locks the mutex and depending on 'mod or 'read passed, sets the last timestamp in dbstruct
-;;
-;; (define (db:done-with dbstruct run-id mod-read)
-;;   (if (not (sqlite3:database? dbstruct))
-;;       (begin
-;; 	(mutex-lock! *rundb-mutex*)
-;; 	(if (eq? mod-read 'mod)
-;; 	    (dbr:dbstruct-mtime-set! dbstruct (current-milliseconds))
-;; 	    (dbr:dbstruct-rtime-set! dbstruct (current-milliseconds)))
-;; 	(dbr:dbstruct-inuse-set! dbstruct #f)
-;; 	(mutex-unlock! *rundb-mutex*))))
+(define-inline (db:generic-error-printout exn . message)
+  (print-call-chain (current-error-port))
+  (apply debug:print-error 0 *default-log-port* message)
+  (debug:print-error 0 *default-log-port* "   params: " params
+		     ", error: "     ((condition-property-accessor 'exn 'message)   exn)
+		     ", arguments: " ((condition-property-accessor 'exn 'arguments) exn)
+		     ", location: "  ((condition-property-accessor 'exn 'location)  exn)
+		     ))
 
 ;; (db:with-db dbstruct run-id sqlite3:exec "select blah fgrom blaz;")
 ;; r/w is a flag to indicate if the db is modified by this query #t = yes, #f = no
 ;;
 (define (db:with-db dbstruct run-id r/w proc . params)
   (let* ((have-struct (dbr:dbstruct? dbstruct))
-         (dbdat (if have-struct 
-                    (db:get-db dbstruct)
-                    #f))
-	 (db    (if have-struct
-		    (db:dbdat-get-db dbdat)
-		    dbstruct))
-	 (use-mutex (> *api-process-request-count* 25)))
+         (dbdat     (if have-struct 
+			(db:get-db dbstruct)
+			#f))
+	 (db        (if have-struct
+			(db:dbdat-get-db dbdat)
+			dbstruct))
+	 (fname     (db:dbdat-get-path dbdat))
+	 (use-mutex (> *api-process-request-count* 25))) ;; was 25
     (if (and use-mutex
 	     (common:low-noise-print 120 "over-50-parallel-api-requests"))
 	(debug:print-info 0 *default-log-port* *api-process-request-count* " parallel api requests being processed in process " (current-process-id) ", throttling access"))
     (if (common:low-noise-print 600 (conc "parallel-api-requests" *max-api-process-requests*))
 	(debug:print-info 2 *default-log-port* "Parallel api request count: " *api-process-request-count* " max parallel requests: " *max-api-process-requests*))
-    (handle-exceptions
-     exn
+    (condition-case
      (begin
-       (print-call-chain (current-error-port))
-       (debug:print-error 0 *default-log-port* "sqlite3 issue in db:with-db, dbstruct=" dbstruct ", run-id=" run-id ", proc=" proc ", params=" params " error: " ((condition-property-accessor 'exn 'message) exn))
-       ;; there is no recovering at this time. exit
-       (exit 50))
-     (if use-mutex (mutex-lock! *db-with-db-mutex*))
-     (let ((res (apply proc db params)))
-       (if use-mutex (mutex-unlock! *db-with-db-mutex*))
-       ;; (if (vector? dbstruct)(db:done-with dbstruct run-id r/w))
-       (if dbdat (stack-push! (dbr:dbstruct-dbstack dbstruct) dbdat))
-       res))))
-
+       (if use-mutex (mutex-lock! *db-with-db-mutex*))
+       (let ((res (apply proc db params)))
+	 (if use-mutex (mutex-unlock! *db-with-db-mutex*))
+	 ;; (if (vector? dbstruct)(db:done-with dbstruct run-id r/w))
+	 (if dbdat (stack-push! (dbr:dbstruct-dbstack dbstruct) dbdat))
+	 res))
+     (exn (io-error)
+	  (db:generic-error-printout exn "ERROR: i/o error with " fname ". Check permissions, disk space etc. and try again."))
+     (exn (corrupt)
+	  (db:generic-error-printout exn "ERROR: database " fname " is corrupt. Repair it to proceed."))
+     (exn (busy)
+	  (db:generic-error-printout exn "ERROR: database " fname
+				     " is locked. Try copying to another location, remove original and copy back."))
+     (exn (permission)(db:generic-error-printout exn "ERROR: database " fname " has some permissions problem."))
+     (exn ()
+	  (db:generic-error-printout exn "ERROR: Unknown error with database " fname " message: "
+		       ((condition-property-accessor 'exn 'message) exn))))))
+      
 ;;======================================================================
 ;; K E E P   F I L E D B   I N   dbstruct
 ;;======================================================================
 
 ;; (define (db:get-filedb dbstruct run-id)
@@ -321,11 +355,10 @@
           (dbr:dbstruct-mtdb-set!   dbstruct mtdb)
           (dbr:dbstruct-tmpdb-set!  dbstruct tmpdb)
           (dbr:dbstruct-dbstack-set! dbstruct (make-stack)) ;; BB: why a stack?  Why would the number of db's be indeterminate?  Is this a legacy of 1.db 2.db .. ?
           (stack-push! (dbr:dbstruct-dbstack dbstruct) tmpdb) ;; olddb is already a (cons db path)
           (dbr:dbstruct-refndb-set! dbstruct refndb)
-          ;;	    (mutex-unlock! *rundb-mutex*)
           (if (and  (or (not dbfexists)
 			(and modtimedelta
 			     (> modtimedelta max-stale-tmp))) ;; if db in tmp is over ten seconds older than the file in MTRA then do a sync back
 		    do-sync)
 	      (begin
@@ -415,21 +448,23 @@
     (set! *db-last-sync* start-t)
     (set! *db-last-access* start-t)
     (mutex-unlock! *db-multi-sync-mutex*)
     (stack-push! (dbr:dbstruct-dbstack dbstruct) tmpdb)))
 
-(define (db:safely-close-sqlite3-db db #!key (try-num 3))
+(define (db:safely-close-sqlite3-db db stmt-cache #!key (try-num 3))
   (if (<= try-num 0)
       #f
       (handle-exceptions
 	  exn
-	  (begin
-	    (thread-sleep! 3)
-	    (sqlite3:interrupt! db)
-	    (db:safely-close-sqlite3-db db try-num: (- try-num 1)))
+	(begin
+	  (print "Attempt to safely close sqlite3 db failed. Trying again. exn=" exn)
+	  (thread-sleep! 3)
+	  (sqlite3:interrupt! db)
+	  (db:safely-close-sqlite3-db db stmtcache try-num: (- try-num 1)))
 	(if (sqlite3:database? db)
-	    (begin
+	    (let* ((stmts (and stmt-cache (hash-table-ref/default stmt-cache db #f))))
+	      (if stmts (map sqlite3:finalize! (hash-table-values stmts)))
 	      (sqlite3:finalize! db)
 	      #t)
 	    #f))))
 
 ;; close all opened run-id dbs
@@ -436,24 +471,23 @@
 (define (db:close-all dbstruct)
   (if (dbr:dbstruct? dbstruct)
       (handle-exceptions
 	  exn
 	  (begin
-	    (debug:print 0 *default-log-port* "WARNING: Finalizing failed, "  ((condition-property-accessor 'exn 'message) exn))
+	    (debug:print 0 *default-log-port* "WARNING: Finalizing failed, "  ((condition-property-accessor 'exn 'message) exn) ", note - exn=" exn)
 	    (print-call-chain *default-log-port*))
 	;; (db:sync-touched dbstruct 0 force-sync: #t) ;; NO. Do not do this here. Instead we rely on a server to be started when there are writes, even if the server itself is not going to be used as a server.
-        (let ((tdbs (map db:dbdat-get-db 
-                         (stack->list (dbr:dbstruct-dbstack dbstruct))))
-              (mdb (db:dbdat-get-db (dbr:dbstruct-mtdb   dbstruct)))
-              (rdb (db:dbdat-get-db (dbr:dbstruct-refndb dbstruct))))
+        (let ((tdbs       (map db:dbdat-get-db 
+			       (stack->list (dbr:dbstruct-dbstack dbstruct))))
+              (mdb        (db:dbdat-get-db (dbr:dbstruct-mtdb   dbstruct)))
+              (rdb        (db:dbdat-get-db (dbr:dbstruct-refndb dbstruct)))
+	      (stmt-cache (dbr:dbstruct-stmt-cache dbstruct)))
           (map (lambda (db)
-		 (db:safely-close-sqlite3-db db))
-;; 		 (if (sqlite3:database? db)
-;; 		     (sqlite3:finalize! db)))
+		 (db:safely-close-sqlite3-db db stmt-cache))
 	       tdbs)
-          (db:safely-close-sqlite3-db mdb)     ;; (if (sqlite3:database? mdb) (sqlite3:finalize! mdb))
-          (db:safely-close-sqlite3-db rdb))))) ;; (if (sqlite3:database? rdb) (sqlite3:finalize! rdb))))))
+          (db:safely-close-sqlite3-db mdb stmt-cache)     ;; (if (sqlite3:database? mdb) (sqlite3:finalize! mdb))
+          (db:safely-close-sqlite3-db rdb stmt-cache))))) ;; (if (sqlite3:database? rdb) (sqlite3:finalize! rdb))))))
 
 ;;   (let ((locdbs (dbr:dbstruct-locdbs dbstruct)))
 ;;     (if (hash-table? locdbs)
 ;; 	(for-each (lambda (run-id)
 ;; 		    (db:close-run-db dbstruct run-id))
@@ -532,10 +566,26 @@
      (append (list "runs" 
 		   '("id"  #f))
 	     (map (lambda (k)(list k #f))
 		  (append keys
 			  (list "runname" "state" "status" "owner" "event_time" "comment" "fail_count" "pass_count" "contour" "last_update"))))
+     (list "archive_disks"
+           '("id" #f)
+           '("archive_area_name" #f) 
+           '("disk_path" #f)
+           '("last_df" #f)
+           '("last_df_time" #f)
+           '("creation_time" #f)) 
+
+     (list "archive_blocks"
+           '("id" #f)
+           '("archive_disk_id" #f) 
+           '("disk_path" #f)
+           '("last_du" #f)
+           '("last_du_time" #f)
+           '("creation_time" #f)) 
+
      (list "test_meta"
 	   '("id"             #f)
 	   '("testname"       #f)
 	   '("owner"          #f)
 	   '("description"    #f)
@@ -589,10 +639,11 @@
      ;;
      (else ;; ((equal? fname "megatest.db") ;; this file can be regenerated if needed
       (handle-exceptions
        exn
        (begin
+	 (print "Problems trying to repair the db, exn=" exn)
 	 ;; (db:move-and-recreate-db dbdat)
 	 (if (> numtries 0)
 	     (db:repair-db dbdat numtries: (- numtries 1))
 	     #f)
 	 (debug:print 0 *default-log-port* "FATAL: file " dbpath " was found corrupted, an attempt to fix has been made but you must start over.")
@@ -696,13 +747,14 @@
 					  (member "last_update" fields))
 				     #t) ;; if given a number, just use it for all fields
 				    ((number? last-update) #f) ;; if not matched first entry then ignore last-update for this table
 				    ((and (pair? last-update)
 					  (member (car last-update)    ;; last-update field name
-						  (map car fields))) #t)
+						  (map car fields)))
+                                        #t)
 				    (last-update
-				     (debug:print 0 *default-log-port* "ERROR: parameter last-update for db:sync-tables must be a pair or a number, received: " last-update) ;; found in fields
+				     (debug:print 0 *default-log-port* "ERROR: parameter last-update for db:sync-tables must be a pair or a number, received: " last-update);; found in fields
 				     #f)
 				    (else
 				     #f)))
 		 (last-update-value (if use-last-update ;; no need to check for has-last-update - it is already accounted for
 					(if (number? last-update)
@@ -728,11 +780,11 @@
 		 (fromdats   '())
 		 (totrecords 0)
 		 (batch-len  (string->number (or (configf:lookup *configdat* "sync" "batchsize") "100")))
 		 (todat      (make-hash-table))
 		 (count      0)
-
+                 (field-names (map car fields))
                  (delay-handicap  (string->number (or (configf:lookup *configdat* "sync" "delay-handicap") "0")))
                  )
 
 	    ;; set up the field->num table
 	    (for-each
@@ -774,13 +826,21 @@
               )
             
 	    ;; first pass implementation, just insert all changed rows
 	    (for-each 
 	     (lambda (targdb)
-	       (let* ((db     (db:dbdat-get-db targdb))
+	       (let* ((db                 (db:dbdat-get-db targdb))
+                      (drp-trigger        (if (member "last_update" field-names)
+					      (db:drop-trigger db tablename) 
+					      #f))
+                      (is-trigger-dropped (if (member "last_update" field-names)
+                                              (db:is-trigger-dropped db tablename)
+					      #f)) 
 		      (stmth  (sqlite3:prepare db full-ins)))
-		 (db:delay-if-busy targdb) ;; NO WAITING
+		 ;; (db:delay-if-busy targdb) ;; NO WAITING
+                 (if (member "last_update" field-names)
+                     (debug:print-info 3 *default-log-port* "is-trigger-dropped: " is-trigger-dropped)) 
 		 (for-each
 		  (lambda (fromdat-lst)
 		    (sqlite3:with-transaction
 		     db
 		     (lambda ()
@@ -798,14 +858,15 @@
 				  (loop (+ i 1))))
 			    (if (not same)
 				(begin
 				  (apply sqlite3:execute stmth (vector->list fromrow))
 				  (hash-table-set! numrecs tablename (+ 1 (hash-table-ref/default numrecs tablename 0)))))))
-			fromdat-lst))
-		  ))
+			fromdat-lst))))
 		  fromdats)
-		 (sqlite3:finalize! stmth)))
+		 (sqlite3:finalize! stmth)
+                 (if (member "last_update" field-names)
+                    (db:create-trigger db tablename))))
 	     (append (list todb) slave-dbs))))
 	tbls)
        (let* ((runtime      (- (current-milliseconds) start-time))
 	      (should-print (or (debug:debug-mode 12)
 				(common:low-noise-print 120 "db sync" (> runtime 500))))) ;; low and high sync times treated as separate.
@@ -1032,11 +1093,11 @@
           )
 	 
 	 ;; clear out junk records
 	 ;;
 	 ((dejunk)
-	  (db:delay-if-busy mtdb) ;; ok to delay on mtdb
+	  ;; (db:delay-if-busy mtdb) ;; ok to delay on mtdb
 	  (when (file-write-access? (db:dbdat-get-path mtdb)) (db:clean-up mtdb))
 	  (db:clean-up tmpdb)
 	  (db:clean-up refndb))
 
 	 ;; sync runs, test_meta etc.
@@ -1156,10 +1217,98 @@
 ;; (define open-run-close 
 #;(define open-run-close open-run-close-exception-handling)
 		;;	   open-run-close-no-exception-handling
 ;;			   open-run-close-exception-handling)
 ;;)
+
+(define db:trigger-list 
+     (list (list "update_runs_trigger"  "CREATE TRIGGER IF NOT EXISTS update_runs_trigger AFTER UPDATE ON runs
+                             FOR EACH ROW
+                               BEGIN 
+                                 UPDATE runs SET last_update=(strftime('%s','now'))
+                                   WHERE id=old.id;
+                               END;" ) 
+	   (list "update_run_stats_trigger"  "CREATE TRIGGER  IF NOT EXISTS update_run_stats_trigger AFTER UPDATE ON run_stats
+                             FOR EACH ROW
+                               BEGIN 
+                                 UPDATE run_stats SET last_update=(strftime('%s','now'))
+                                   WHERE id=old.id;
+                               END;" )
+	   (list "update_tests_trigger"  "CREATE TRIGGER  IF NOT EXISTS update_tests_trigger AFTER UPDATE ON tests
+                             FOR EACH ROW
+                               BEGIN 
+                                 UPDATE tests SET last_update=(strftime('%s','now'))
+                                   WHERE id=old.id;
+                               END;" )
+	   (list "update_teststeps_trigger"  "CREATE TRIGGER  IF NOT EXISTS update_teststeps_trigger AFTER UPDATE ON test_steps
+                             FOR EACH ROW
+                               BEGIN 
+                                 UPDATE test_steps SET last_update=(strftime('%s','now'))
+                                   WHERE id=old.id;
+                               END;" )
+	   (list "update_test_data_trigger"  "CREATE TRIGGER  IF NOT EXISTS update_test_data_trigger AFTER UPDATE ON test_data
+                             FOR EACH ROW
+                               BEGIN 
+                                 UPDATE test_data SET last_update=(strftime('%s','now'))
+                                   WHERE id=old.id;
+                               END;" )))
+
+(define (db:create-all-triggers dbstruct)
+(db:with-db
+   dbstruct #f #f
+   (lambda (db)
+(db:create-triggers db))))
+
+(define (db:create-triggers db)
+    (for-each (lambda (key)
+              (sqlite3:execute db (cadr key)))
+          db:trigger-list))
+
+(define (db:drop-all-triggers dbstruct)
+  (db:with-db
+   dbstruct #f #f
+   (lambda (db)
+     (db:drop-triggers db))))
+
+(define (db:is-trigger-dropped db tbl-name)
+  (let* ((trigger-name (if (equal? tbl-name "test_steps")
+			   "update_teststeps_trigger" 
+                           (conc "update_" tbl-name "_trigger")))
+	 (res          #f))
+    (sqlite3:for-each-row
+     (lambda (name)
+       (if (equal? name trigger-name)
+	   (set! res #t)))
+     db 
+     "SELECT name FROM sqlite_master WHERE type = 'trigger' ;" 
+     )))
+
+(define (db:drop-triggers db)
+  (for-each
+   (lambda (key) 
+     (sqlite3:execute db (conc "drop trigger if exists " (car key))))
+   db:trigger-list))
+
+(define  (db:drop-trigger db tbl-name)
+  (let* ((trigger-name (if (equal? tbl-name "test_steps")
+			   "update_teststeps_trigger" 
+                           (conc "update_" tbl-name "_trigger"))))
+    (for-each
+     (lambda (key) 
+       (if (equal? (car key) trigger-name)
+           (sqlite3:execute db (conc "drop trigger if exists " trigger-name))))
+     db:trigger-list)))
+
+(define  (db:create-trigger db tbl-name)
+      (let* ((trigger-name (if (equal? tbl-name "test_steps")
+                              "update_teststeps_trigger" 
+                              (conc "update_" tbl-name "_trigger"))))
+       (for-each (lambda (key) 
+             (if (equal? (car key) trigger-name)
+             (sqlite3:execute db (cadr key))))
+      db:trigger-list))) 
+
 
 (define (db:initialize-main-db dbdat)
   (when (not *configinfo*)
            (launch:setup)) ;; added because Elena was getting stack dump because *configinfo* below was #f.
   (let* ((configdat (car *configinfo*))  ;; tut tut, global warning...
@@ -1201,29 +1350,31 @@
 			 comment    TEXT DEFAULT '',
 			 fail_count INTEGER DEFAULT 0,
 			 pass_count INTEGER DEFAULT 0,
                          last_update INTEGER DEFAULT (strftime('%s','now')),
 			 CONSTRAINT runsconstraint UNIQUE (runname" (if havekeys "," "") keystr "));"))
-	(sqlite3:execute db "CREATE TRIGGER IF NOT EXISTS update_runs_trigger AFTER UPDATE ON runs
-                             FOR EACH ROW
-                               BEGIN 
-                                 UPDATE runs SET last_update=(strftime('%s','now'))
-                                   WHERE id=old.id;
-                               END;")
+        ;; All triggers created at once in end
+	;;(sqlite3:execute db "CREATE TRIGGER IF NOT EXISTS update_runs_trigger AFTER UPDATE ON runs
+        ;;                    FOR EACH ROW
+        ;;                       BEGIN 
+        ;;                         UPDATE runs SET last_update=(strftime('%s','now'))
+        ;;                           WHERE id=old.id;
+        ;;                       END;")
 	(sqlite3:execute db "CREATE TABLE IF NOT EXISTS run_stats (
                               id     INTEGER PRIMARY KEY,
                               run_id INTEGER,
                               state  TEXT,
                               status TEXT,
                               count  INTEGER,
                               last_update INTEGER DEFAULT (strftime('%s','now')))")
-	(sqlite3:execute db "CREATE TRIGGER  IF NOT EXISTS update_run_stats_trigger AFTER UPDATE ON run_stats
-                             FOR EACH ROW
-                               BEGIN 
-                                 UPDATE run_stats SET last_update=(strftime('%s','now'))
-                                   WHERE id=old.id;
-                               END;")
+         ;; All triggers created at once in end
+         ;; (sqlite3:execute db "CREATE TRIGGER  IF NOT EXISTS update_run_stats_trigger AFTER UPDATE ON run_stats
+         ;;                   FOR EACH ROW
+         ;;                     BEGIN 
+         ;;                       UPDATE run_stats SET last_update=(strftime('%s','now'))
+         ;;                         WHERE id=old.id;
+         ;;                      END;")
 	(sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_meta (
                                      id          INTEGER PRIMARY KEY,
                                      testname    TEXT DEFAULT '',
                                      author      TEXT DEFAULT '',
                                      owner       TEXT DEFAULT '',
@@ -1251,28 +1402,28 @@
                                 id INTEGER PRIMARY KEY,
                                 archive_area_name TEXT,
                                 disk_path TEXT,
                                 last_df INTEGER DEFAULT -1,
                                 last_df_time TIMESTAMP DEFAULT (strftime('%s','now')),
-                                creation_time TIMESTAMP DEFAULT (strftime('%','now')));")
+                                creation_time TIMESTAMP DEFAULT (strftime('%s','now')));")
 	;; individual bup (or tar) data chunks
 	(sqlite3:execute db "CREATE TABLE IF NOT EXISTS archive_blocks (
                                 id INTEGER PRIMARY KEY,
                                 archive_disk_id INTEGER,
                                 disk_path TEXT,
                                 last_du INTEGER DEFAULT -1,
                                 last_du_time TIMESTAMP DEFAULT (strftime('%s','now')),
-                                creation_time TIMESTAMP DEFAULT (strftime('%','now')));")
+                                creation_time TIMESTAMP DEFAULT (strftime('%s','now')));")
 	;; tests allocated to what chunks. reusing a chunk for a test/item_path is very efficient
 	;; NB// the per run/test recording of where the archive is stored is done in the test
 	;;      record. 
 	(sqlite3:execute db "CREATE TABLE IF NOT EXISTS archive_allocations (
                                 id INTEGER PRIMARY KEY,
                                 archive_block_id INTEGER,
                                 testname TEXT,
                                 item_path TEXT,
-                                creation_time TIMESTAMP DEFAULT (strftime('%','now')));")
+                                creation_time TIMESTAMP DEFAULT (strftime('%s','now')));")
 	;; move this clean up call somewhere else
 	(sqlite3:execute db "DELETE FROM tasks_queue WHERE state='done' AND creation_time < ?;" (- (current-seconds)(* 24 60 60))) ;; remove older than 24 hrs
 	(sqlite3:execute db (conc "CREATE INDEX IF NOT EXISTS runs_index ON runs (runname" (if havekeys "," "") keystr ");"))
 	;; (sqlite3:execute db "CREATE VIEW runs_tests AS SELECT * FROM runs INNER JOIN tests ON runs.id=tests.run_id;")
 	(sqlite3:execute db "CREATE TABLE IF NOT EXISTS extradat (id INTEGER PRIMARY KEY, run_id INTEGER, key TEXT, val TEXT);")
@@ -1319,17 +1470,18 @@
 	;; deprecated -- (sqlite3:execute db "CREATE INDEX IF NOT EXISTS tests_index ON tests (run_id, testname, item_path, uname);")
         
         (sqlite3:execute db "CREATE INDEX IF NOT EXISTS tests_run_id_index ON tests (run_id);")  ;; new
         (sqlite3:execute db "CREATE INDEX IF NOT EXISTS tests_testname_index ON tests (testname,item_path);") ;; new
         (sqlite3:execute db "CREATE INDEX IF NOT EXISTS tests_state_status_index ON tests (state, status); ") ;; new
-        
-	(sqlite3:execute db "CREATE TRIGGER  IF NOT EXISTS update_tests_trigger AFTER UPDATE ON tests
-                             FOR EACH ROW
-                               BEGIN 
-                                 UPDATE tests SET last_update=(strftime('%s','now'))
-                                   WHERE id=old.id;
-                               END;")
+
+         ;; All triggers created at once in end
+	;;(sqlite3:execute db "CREATE TRIGGER  IF NOT EXISTS update_tests_trigger AFTER UPDATE ON tests
+        ;;                     FOR EACH ROW
+        ;;                       BEGIN 
+        ;;                         UPDATE tests SET last_update=(strftime('%s','now'))
+        ;;                           WHERE id=old.id;
+        ;;                       END;")
 	(sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_steps 
                               (id INTEGER PRIMARY KEY,
                                test_id INTEGER, 
                                stepname TEXT, 
                                state TEXT DEFAULT 'NOT_STARTED', 
@@ -1338,16 +1490,17 @@
                                comment TEXT DEFAULT '',
                                logfile TEXT DEFAULT '',
                                last_update  INTEGER DEFAULT (strftime('%s','now')),
                                CONSTRAINT test_steps_constraint UNIQUE (test_id,stepname,state));")
 	(sqlite3:execute db "CREATE INDEX IF NOT EXISTS teststeps_index ON tests (run_id, testname, item_path);")
-	(sqlite3:execute db "CREATE TRIGGER  IF NOT EXISTS update_teststeps_trigger AFTER UPDATE ON test_steps
-                             FOR EACH ROW
-                               BEGIN 
-                                 UPDATE test_steps SET last_update=(strftime('%s','now'))
-                                   WHERE id=old.id;
-                               END;")
+        ;; All triggers created at once in end
+	;;(sqlite3:execute db "CREATE TRIGGER  IF NOT EXISTS update_teststeps_trigger AFTER UPDATE ON test_steps
+        ;;                     FOR EACH ROW
+        ;;                       BEGIN 
+        ;;                         UPDATE test_steps SET last_update=(strftime('%s','now'))
+        ;;                           WHERE id=old.id;
+        ;;                       END;")
 	(sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_data (id INTEGER PRIMARY KEY,
                                 test_id INTEGER,
                                 category TEXT DEFAULT '',
                                 variable TEXT,
 	                        value REAL,
@@ -1358,16 +1511,17 @@
                                 status TEXT DEFAULT 'n/a',
                                 type TEXT DEFAULT '',
                                 last_update  INTEGER DEFAULT (strftime('%s','now')),
                               CONSTRAINT test_data_constraint UNIQUE (test_id,category,variable));")
 	(sqlite3:execute db "CREATE INDEX IF NOT EXISTS test_data_index ON test_data (test_id);")
-	(sqlite3:execute db "CREATE TRIGGER  IF NOT EXISTS update_test_data_trigger AFTER UPDATE ON test_data
-                             FOR EACH ROW
-                               BEGIN 
-                                 UPDATE test_data SET last_update=(strftime('%s','now'))
-                                   WHERE id=old.id;
-                               END;")
+        ;; All triggers created at once in end
+	;;(sqlite3:execute db "CREATE TRIGGER  IF NOT EXISTS update_test_data_trigger AFTER UPDATE ON test_data
+        ;;                     FOR EACH ROW
+        ;;                       BEGIN 
+        ;;                         UPDATE test_data SET last_update=(strftime('%s','now'))
+        ;;                           WHERE id=old.id;
+        ;;                       END;")
 	(sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_rundat (
                               id           INTEGER PRIMARY KEY,
                               test_id      INTEGER,
                               update_time  TIMESTAMP,
                               cpuload      INTEGER DEFAULT -1,
@@ -1380,10 +1534,11 @@
                               state        TEXT DEFAULT 'new',
                               status       TEXT DEFAULT 'n/a',
                               archive_type TEXT DEFAULT 'bup',
                               du           INTEGER,
                               archive_path TEXT);")))
+        (db:create-triggers db)    
      db)) ;; )
 
 ;;======================================================================
 ;; A R C H I V E S
 ;;======================================================================
@@ -1607,36 +1762,46 @@
        (if (and (null? incompleted)
                 (null? oldlaunched)
                 (null? toplevels))
            #f
            #t)))))
-
-;; given a launch delay (minimum time from last launch) return amount of time to wait
-;;
-;; (define (db:launch-delay-left dbstruct run-id launch-delay)
-  
-
 
 (define (db:get-status-from-final-status-file run-dir)
-  (let (
-       (infile (conc run-dir "/.final-status")))
-
-       ;; first verify we are able to write the output file
-       (if (not (file-read-access? infile))
-          (begin 
-	        (debug:print 0 *default-log-port* "ERROR: cannot read " infile)
+  (let ((infile (conc run-dir "/.final-status")))
+    ;; first verify we are able to write the output file
+    (if (not (file-read-access? infile))
+        (begin 
+	  (debug:print 0 *default-log-port* "ERROR: cannot read " infile)
           (debug:print 0 *default-log-port* "ERROR: run-dir is " run-dir)
           #f
           )
-          (with-input-from-file infile read-lines)
-       )
-  )
-)
-
-
-
-
+        (with-input-from-file infile read-lines)
+	)))
+
+;; check duration against test-run.dat file if it exists and update the value in
+;; the db if necessary
+;;
+(define (db:adjust-run-duration dbstruct test-id run-dir event-time run-duration)
+  (let* ((datf             (conc run-dir ".mt_data/test-run.dat"))
+	 (modt             (if (and (file-exists? datf)
+				    (file-read-access? datf))
+			       (file-modification-time datf)
+			       #f)) ;; (+ event-time run-duration))))
+	 (alt-run-duration (if modt
+			       (- modt event-time)
+			       #f)))
+    (if (and alt-run-duration
+	     (> alt-run-duration run-duration))
+	(begin
+	  (debug:print 0 *default-log-port* "Test " test-id " run duration mismatch. Setting to " alt-run-duration)
+	  (db:with-db
+	   dbstruct #f #f
+	   (lambda (db)
+	     (sqlite3:execute db "UPDATE tests SET run_duration=? WHERE id=?;" alt-run-duration test-id)
+	     #t)))
+	#f))) ;; #f = we did NOT adjust the time
+	      
 ;;  select end_time-now from
 ;;      (select testname,item_path,event_time+run_duration as
 ;;                          end_time,strftime('%s','now') as now from tests where state in
 ;;      ('RUNNING','REMOTEHOSTSTART','LAUNCHED'));
 
@@ -1661,84 +1826,97 @@
     (debug:print-info 4  *default-log-port* "deadtime-trim = " deadtime-trim)
 
     (db:with-db 
      dbstruct #f #f
      (lambda (db)
-       ;; in RUNNING or REMOTEHOSTSTART for more than 10 minutes
-       ;;
-       ;; HOWEVER: this code in run:test seems to work fine
-       ;;              (> (- (current-seconds)(+ (db:test-get-event_time testdat)
-       ;;                     (db:test-get-run_duration testdat)))
-       ;;                    600) 
-       ;; (db:delay-if-busy dbdat)
-       (sqlite3:for-each-row 
-        (lambda (test-id run-dir uname testname item-path event-time run-duration)
-          (if (and (equal? uname "n/a")
-                   (equal? item-path "")) ;; this is a toplevel test
-              ;; what to do with toplevel? call rollup?
-              (begin
-                (set! toplevels   (cons (list test-id run-dir uname testname item-path run-id) toplevels))
-                (debug:print-info 0 *default-log-port* "Found old toplevel test in RUNNING state, test-id=" test-id))
-              (begin
-                (set! incompleted (cons (list test-id run-dir uname testname item-path run-id) incompleted))
-                (debug:print-info 0 *default-log-port* "Found old test in RUNNING state, test-id=" test-id" exceeded running-deadtime "running-deadtime" now="(current-seconds)" event-time="event-time" run-duration="run-duration))))
-        db
-        
-        "SELECT id,rundir,uname,testname,item_path,event_time,run_duration FROM tests WHERE run_id=? AND (strftime('%s','now') - event_time) > (run_duration + ?) AND state IN ('RUNNING');"
-        run-id running-deadtime) ;; default time 720 seconds
-
-       
-       (sqlite3:for-each-row 
-        (lambda (test-id run-dir uname testname item-path event-time run-duration)
-          (if (and (equal? uname "n/a")
-                   (equal? item-path "")) ;; this is a toplevel test
-              ;; what to do with toplevel? call rollup?
-              (begin
-                (set! toplevels   (cons (list test-id run-dir uname testname item-path run-id) toplevels))
-                (debug:print-info 0 *default-log-port* "Found old toplevel test in RUNNING state, test-id=" test-id))
-              (begin
-                (debug:print-info 0 *default-log-port* "Found old test in REMOTEHOSTSTART state, test-id=" test-id" exceeded running-deadtime "running-deadtime" now="(current-seconds)" event-time="event-time" run-duration="run-duration)
-                (set! incompleted (cons (list test-id run-dir uname testname item-path run-id) incompleted)))))
-        db
-        "SELECT id,rundir,uname,testname,item_path,event_time,run_duration FROM tests WHERE run_id=? AND (strftime('%s','now') - event_time) > (run_duration + ?) AND state IN ('REMOTEHOSTSTART');"
-        run-id remotehoststart-deadtime) ;; default time 230 seconds
-
-       ;; in LAUNCHED for more than one day. Could be long due to job queues TODO/BUG: Need override for this in config
-       ;;
-       ;; (db:delay-if-busy dbdat)
-       (sqlite3:for-each-row
-        (lambda (test-id run-dir uname testname item-path)
-          (if (and (equal? uname "n/a")
-                   (equal? item-path "")) ;; this is a toplevel test
-              ;; what to do with toplevel? call rollup?
-              (set! toplevels   (cons (list test-id run-dir uname testname item-path run-id) toplevels))
-              (begin
-                (debug:print-info 0 *default-log-port* "Found old test in LAUNCHED state, test-id=" test-id" 1 day since event_time marked")
+       (let* ((stmth1 (db:get-cache-stmth
+		       dbstruct db
+		       "SELECT id,rundir,uname,testname,item_path,event_time,run_duration FROM tests 
+                           WHERE run_id=? AND (strftime('%s','now') - event_time) > (run_duration + ?)
+                                          AND state IN ('RUNNING');"))
+	      (stmth2 (db:get-cache-stmth
+		       dbstruct db
+		       "SELECT id,rundir,uname,testname,item_path,event_time,run_duration FROM tests 
+                           WHERE run_id=? AND (strftime('%s','now') - event_time) > (run_duration + ?)
+                                          AND state IN ('REMOTEHOSTSTART');"))
+	      (stmth3 (db:get-cache-stmth
+		       dbstruct db
+		       "SELECT id,rundir,uname,testname,item_path FROM tests
+                           WHERE run_id=? AND (strftime('%s','now') - event_time) > 86400
+                                          AND state IN ('LAUNCHED');")))
+	 ;; in RUNNING or REMOTEHOSTSTART for more than 10 minutes
+	 ;;
+	 ;; HOWEVER: this code in run:test seems to work fine
+	 ;;              (> (- (current-seconds)(+ (db:test-get-event_time testdat)
+	 ;;                     (db:test-get-run_duration testdat)))
+	 ;;                    600) 
+	 ;; (db:delay-if-busy dbdat)
+	 (sqlite3:for-each-row 
+	  (lambda (test-id run-dir uname testname item-path event-time run-duration)
+	    (if (not (db:adjust-run-duration dbstruct test-id run-dir event-time run-duration))
+		(if (and (equal? uname "n/a")
+			 (equal? item-path "")) ;; this is a toplevel test
+		    ;; what to do with toplevel? call rollup?
+		    (begin
+		      (set! toplevels   (cons (list test-id run-dir uname testname item-path run-id) toplevels))
+		      (debug:print-info 0 *default-log-port* "Found old toplevel test in RUNNING state, test-id=" test-id))
+		    (begin
+		      (set! incompleted (cons (list test-id run-dir uname testname item-path run-id) incompleted))
+		      (debug:print-info 0 *default-log-port* "Found old test in RUNNING state, test-id="
+					test-id" exceeded running-deadtime "running-deadtime" now="(current-seconds)
+					" event-time="event-time" run-duration="run-duration)))))
+	  stmth1
+	  run-id running-deadtime) ;; default time 720 seconds
+	    
+	 (sqlite3:for-each-row 
+	  (lambda (test-id run-dir uname testname item-path event-time run-duration)
+	    (if (not (db:adjust-run-duration dbstruct test-id run-dir event-time run-duration))
+		(if (and (equal? uname "n/a")
+			 (equal? item-path "")) ;; this is a toplevel test
+		    ;; what to do with toplevel? call rollup?
+		    (begin
+		      (set! toplevels   (cons (list test-id run-dir uname testname item-path run-id) toplevels))
+		      (debug:print-info 0 *default-log-port* "Found old toplevel test in RUNNING state, test-id=" test-id))
+		    (begin
+		      (debug:print-info 0 *default-log-port* "Found old test in REMOTEHOSTSTART state, test-id=" test-id
+					" exceeded running-deadtime "running-deadtime" now="(current-seconds)" event-time="event-time
+					" run-duration="run-duration)
+		      (set! incompleted (cons (list test-id run-dir uname testname item-path run-id) incompleted))))))
+	  stmth2
+	  run-id remotehoststart-deadtime) ;; default time 230 seconds
+	 
+	 ;; in LAUNCHED for more than one day. Could be long due to job queues TODO/BUG: Need override for this in config
+	 ;;
+	 ;; (db:delay-if-busy dbdat)
+	 (sqlite3:for-each-row
+	  (lambda (test-id run-dir uname testname item-path)
+	    (if (and (equal? uname "n/a")
+		     (equal? item-path "")) ;; this is a toplevel test
+		;; what to do with toplevel? call rollup?
+		(set! toplevels   (cons (list test-id run-dir uname testname item-path run-id) toplevels))
+		(begin
+		  (debug:print-info 0 *default-log-port* "Found old test in LAUNCHED state, test-id=" test-id
+				    " 1 day since event_time marked")
                 (set! oldlaunched (cons (list test-id run-dir uname testname item-path run-id) oldlaunched)))))
-        db
-        "SELECT id,rundir,uname,testname,item_path FROM tests WHERE run_id=? AND (strftime('%s','now') - event_time) > 86400 AND state IN ('LAUNCHED');"
-        run-id)
+	  stmth3
+	  run-id)
        
-       (debug:print-info 18 *default-log-port* "Found " (length oldlaunched) " old LAUNCHED items, " (length toplevels) " old LAUNCHED toplevel tests and " (length incompleted) " tests marked RUNNING but apparently dead.")
+	 (debug:print-info 18 *default-log-port* "Found " (length oldlaunched) " old LAUNCHED items, "
+			   (length toplevels) " old LAUNCHED toplevel tests and "
+			   (length incompleted) " tests marked RUNNING but apparently dead."))
 
-       ;; These are defunct tests, do not do all the overhead of set-state-status. Force them to INCOMPLETE.
+	 ;; These are defunct tests, do not do all the overhead of set-state-status. Force them to INCOMPLETE.
        ;;
-       ;; (db:delay-if-busy dbdat)
-       (let* (;; (min-incompleted (filter (lambda (x)
-              ;;      		      (let* ((testpath (cadr x))
-              ;;      			     (tdatpath (conc testpath "/testdat.db"))
-              ;;      			     (dbexists (common:file-exists? tdatpath)))
-              ;;      			(or (not dbexists) ;; if no file then something wrong - mark as incomplete
-              ;;      			    (> (- (current-seconds)(file-modification-time tdatpath)) 600)))) ;; no change in 10 minutes to testdat.db - she's dead Jim
-              ;;      		    incompleted))
-              (min-incompleted-ids (map car incompleted)) ;; do 'em all
-              (all-ids             (append min-incompleted-ids (map car oldlaunched))))
-         (if (> (length all-ids) 0)
-             (begin
-	       ;; (launch:is-test-alive "localhost" 435)
-               (debug:print 0 *default-log-port* "WARNING: Marking test(s); " (string-intersperse (map conc all-ids) ", ") " as DEAD")
-               (for-each
+	 ;; (db:delay-if-busy dbdat)
+	 (let* ((min-incompleted-ids (map car incompleted)) ;; do 'em all
+		(all-ids             (append min-incompleted-ids (map car oldlaunched))))
+	   (if (> (length all-ids) 0)
+	       (begin
+		 ;; (launch:is-test-alive "localhost" 435)
+		 (debug:print 0 *default-log-port* "WARNING: Marking test(s); " (string-intersperse (map conc all-ids) ", ")
+			      " as DEAD")
+		 (for-each
                   (lambda (test-id)
                     (let* (;; (run-dir (db:test-get-rundir-from-test-id dbstruct run-id test-id))
 			   (tinfo   (db:get-test-info-by-id dbstruct run-id test-id))
 			   (run-dir (db:test-get-rundir     tinfo))
 			   (host    (db:test-get-host       tinfo))
@@ -1745,43 +1923,30 @@
 			   (pid     (db:test-get-process_id tinfo))
 			   (result (db:get-status-from-final-status-file run-dir)))
 		      (if (and (list? result) (> (length result) 1) (equal? "PASS" (cadr result)) (equal? "COMPLETED" (car result))) 
 			  (begin
 			    (debug:print 0 *default-log-port* "INFO: test " test-id " actually passed, so marking PASS not DEAD")
-			    (db:set-state-status-and-roll-up-items dbstruct run-id test-id 'foo "COMPLETED" "PASS"
-								   "Test stopped responding but it has PASSED; marking it PASS in the DB."))
-			  (let ((is-alive (launch:is-test-alive host pid)))
+			    (db:set-state-status-and-roll-up-items
+			     dbstruct run-id test-id 'foo "COMPLETED" "PASS"
+			     "Test stopped responding but it has PASSED; marking it PASS in the DB."))
+			  (let ((is-alive (and (not (eq? pid 0))  ;; 0 is default in re-used field "attemptnum" where pid stored.
+					       (launch:is-test-alive host pid))))
 			    (if is-alive
-				(debug:print 0 *default-log-port* "INFO: test " test-id " on host " host " has a process on pid " pid ", NOT setting to DEAD.")
+				(debug:print 0 *default-log-port* "INFO: test " test-id " on host " host
+					     " has a process on pid " pid ", NOT setting to DEAD.")
 				(begin
-				  (debug:print 0 *default-log-port* "INFO: test " test-id " final state/status is not COMPLETED/PASS. It is " result)
-				  (db:set-state-status-and-roll-up-items dbstruct run-id test-id 'foo "COMPLETED" "DEAD"
-									 "Test stopped responding while in RUNNING or REMOTEHOSTSTART; presumed dead.")))))))
+				  (debug:print 0 *default-log-port* "INFO: test " test-id
+					       " final state/status is not COMPLETED/PASS. It is " result)
+				  (db:set-state-status-and-roll-up-items
+				   dbstruct run-id test-id 'foo "COMPLETED" "DEAD"
+				   "Test stopped responding while in RUNNING or REMOTEHOSTSTART; presumed dead.")))))))
+		  ;; call end of eud of run detection for posthook - from merge, is it needed?
+		  ;; (launch:end-of-run-check run-id)
 		  all-ids)
-	       ;;call end of eud of run detection for posthook
-	       (launch:end-of-run-check run-id)
-	       )))))))
-
-
-;; ALL REPLACED BY THE BLOCK ABOVE
-;;
-;; 	    (sqlite3:execute 
-;; 	     db
-;; 	     (conc "UPDATE tests SET state='INCOMPLETE' WHERE run_id=? AND id IN (" 
-;; 		   (string-intersperse (map conc all-ids) ",")
-;; 		   ");")
-;;              run-id))))
-;; 
-;;     ;; Now do rollups for the toplevel tests
-;;     ;;
-;;     ;; (db:delay-if-busy dbdat)
-;;     (for-each
-;;      (lambda (toptest)
-;;        (let ((test-name (list-ref toptest 3)))
-;; ;;	     (run-id    (list-ref toptest 5)))
-;; 	 (db:top-test-set-per-pf-counts dbstruct run-id test-name)))
-;;      toplevels)))
+		 ;;call end of eud of run detection for posthook
+		 (launch:end-of-run-check run-id)
+		 )))))))
 
 ;; BUG: Probably broken - does not explicitly use run-id in the query
 ;;
 (define (db:top-test-set-per-pf-counts dbstruct run-id test-name)
   (db:general-call dbstruct 'top-test-set-per-pf-counts (list test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name)))
@@ -1952,10 +2117,20 @@
        (if (string? res)
            (let ((valnum (string->number res)))
              (if valnum (set! res valnum))))
        res))))
 
+(define (db:inc-var dbstruct var)
+  (db:with-db dbstruct #f #t 
+	      (lambda (db)
+		(sqlite3:execute db "UPDATE metadat SET val=val+1 WHERE var=?;" var))))
+
+(define (db:dec-var dbstruct var)
+  (db:with-db dbstruct #f #t 
+	      (lambda (db)
+		(sqlite3:execute db "UPDATE metadat SET val=val-1 WHERE var=?;" var))))
+
 ;; This was part of db:get-var. It was used to estimate the load on
 ;; the database files.
 ;;
 ;; scale by 10, average with current value.
 ;;     (set! *global-delta* (/ (+ *global-delta* (* (- (current-milliseconds) start-ms)
@@ -1969,10 +2144,15 @@
 (define (db:set-var dbstruct var val)
   (db:with-db dbstruct #f #t 
 	      (lambda (db)
 		(sqlite3:execute db "INSERT OR REPLACE INTO metadat (var,val) VALUES (?,?);" var val))))
 
+(define (db:add-var dbstruct var val)
+  (db:with-db dbstruct #f #t 
+	      (lambda (db)
+		(sqlite3:execute db "UPDATE metadat SET val=val+? WHERE var=?;" val var))))
+
 (define (db:del-var dbstruct var)
   (db:with-db dbstruct #f #t 
 	      (lambda (db)
 		(sqlite3:execute db "DELETE FROM metadat WHERE var=?;" var))))
 
@@ -1986,14 +2166,66 @@
 	 (db-exists (common:file-exists? dbname))
 	 (db     (sqlite3:open-database dbname)))
     (sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 136000))
     (if (not db-exists)
 	(begin
-	  (sqlite3:execute db "PRAGMA synchronous = 0;")
 	  (sqlite3:execute db "CREATE TABLE IF NOT EXISTS no_sync_metadat (var TEXT,val TEXT, CONSTRAINT no_sync_metadat_constraint UNIQUE (var));")
 	  (sqlite3:execute db "PRAGMA journal_mode=WAL;")))
+    ;; MOVE THIS TABLE CREATION TO THE (begin above in about six months (it is Sep 2020 right now).
+    (sqlite3:execute db "CREATE TABLE IF NOT EXISTS jobs_queue (id INTEGER PRIMARY KEY, host_type TEXT, cores INTEGER, memory TEXT, vars TEXT, exekey TEXT, cmdline TEXT, state TEXT, event_time INTEGER, last_update INTEGER);")
+    ;; not sure I'll use this next one. I prefer if tests simply append to a file:
+    ;;    last-update-seconds cpuload tmpspace rundirspace
+    (sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_extra_data (id INTEGER PRIMARY KEY, run_id INTEGER, test_id INTEGER, last_seen_running INTEGER);") 
+    (sqlite3:execute db "PRAGMA synchronous = 0;")
     db))
+
+(define (db:no-sync-add-job db-in host-type vars-list exekey cmdline)
+  (sqlite3:execute (db:no-sync-db db-in) "INSERT INTO jobs_queue (host_type,vars,exekey,cmdline,state,event_time,last_update) VALUES (?,?,?,?,?,?,?);"
+		   host-type
+		   (with-output-to-string
+		     (lambda ()
+		       (write vars-list)))
+		   exekey cmdline "waiting" (current-seconds)(current-seconds)))
+
+;; find next job (waiting longest) that matches host-type - future, we'll find jobs that fit if no exact match
+(define (db:no-sync-take-job db-in host-type)
+  (let* ((db   (db:no-sync-db db-in))
+	 (stmt1 "SELECT id,host_type,vars,exekey,cmdline,state,event_time,last_update FROM jobs_queue WHERE host_type=? AND state != 'taken' ORDER BY event_time ASC;")
+	 (stmt1h (sqlite3:prepare db stmt1))
+	 (stmt2  "UPDATE jobs_queue SET state='taken',last_update=? WHERE id=?;")
+	 (stmt2h (sqlite3:prepare db stmt2))
+	 (res    (sqlite3:with-transaction
+		  db
+		  (lambda ()
+		    (let* ((matching-jobs (sqlite3:fold-row
+					   (lambda (res . row) ;; id host-type vars exekey state event-time last-update)
+					     (cons row res))
+					   '()
+					   stmt1h
+					   host-type)))
+		      (if (null? matching-jobs)
+			  #f
+			  (let ((choosen-one  (let loop ((tal matching-jobs)
+							 (res #f)) ;; put bestest one in here
+						(if (null? tal)
+						    res
+						    (let ((curr (car tal))
+							  (rem  (cdr tal)))
+						      curr) ;; here we will compare with res, if better candidate the loop with curr else loop with res
+						    ))))
+			    (if choosen-one ;; we need to mark it as taken
+				(sqlite3:execute stmt2h (current-seconds) (car choosen-one)))
+			    choosen-one)))))))
+    (sqlite3:finalize! stmt1h) ;; it'd be nice to cache these and finalize on exit.
+    (sqlite3:finalize! stmt2h)
+    res))
+
+;; clean out old jobs in queue, i.e. taken and event_time > 24 hrs ago
+;;
+(define (db:no-sync-job-records-clean db)
+  (sqlite3:execute (db:no-sync-db db) "DELETE FROM jobs_queue WHERE state='taken' AND event_time < ?;" (- (current-seconds)(* 24 3600))))
+		 
 
 ;; if we are not a server create a db handle. this is not finalized
 ;; so watch for problems. I'm still not clear if it is needed to manually
 ;; finalize sqlite3 dbs with the sqlite3 egg.
 ;;
@@ -2011,12 +2243,13 @@
   (sqlite3:execute (db:no-sync-db db) "INSERT OR REPLACE INTO no_sync_metadat (var,val) VALUES (?,?);" var val))
 
 (define (db:no-sync-del! db var)
   (sqlite3:execute (db:no-sync-db db) "DELETE FROM no_sync_metadat WHERE var=?;" var))
 
-(define (db:no-sync-get/default db var default)
-  (let ((res default))
+(define (db:no-sync-get/default db-in var default)
+  (let ((db  (db:no-sync-db db-in))
+	(res default))
     (sqlite3:for-each-row
      (lambda (val)
        (set! res val))
      (db:no-sync-db db)
      "SELECT val FROM no_sync_metadat WHERE var=?;"
@@ -2028,12 +2261,12 @@
           (if newres
               newres
               res))
         res)))
 
-(define (db:no-sync-close-db db)
-  (db:safely-close-sqlite3-db db))
+(define (db:no-sync-close-db db stmt-cache)
+  (db:safely-close-sqlite3-db db stmt-cache))
 
 ;; transaction protected lock aquisition
 ;; either:
 ;;    fails    returns  (#f . lock-creation-time)
 ;;    succeeds (returns (#t . lock-creation-time)
@@ -2044,13 +2277,14 @@
     (sqlite3:with-transaction
      db
      (lambda ()
        (handle-exceptions
 	   exn
-	   (let ((lock-time (current-seconds)))
-	     (sqlite3:execute db "INSERT INTO no_sync_metadat (var,val) VALUES(?,?);" keyname lock-time)
-	     `(#t . ,lock-time))
+	 (let ((lock-time (current-seconds)))
+	   (debug:print-info 2 *default-log-port* "db:no-sync-get-lock keyname=" keyname ", lock-time=" lock-time ", exn=" exn)
+	   (sqlite3:execute db "INSERT INTO no_sync_metadat (var,val) VALUES(?,?);" keyname lock-time)
+	   `(#t . ,lock-time))
 	 `(#f . ,(sqlite3:first-result db "SELECT val FROM no_sync_metadat WHERE var=?;" keyname)))))))
 
 
 
 ;; use a global for some primitive caching, it is just silly to
@@ -2071,10 +2305,14 @@
 		       db
 		       "SELECT fieldname FROM keys ORDER BY id DESC;")))
 	(set! *db-keys* res)
 	res)))
 
+;; extract index number given a header/data structure
+(define (db:get-index-by-header header field)
+  (list-index (lambda (x)(equal? x field)) header))
+
 ;; look up values in a header/data structure
 (define (db:get-value-by-header row header field)
   (if (or (null? header) (not row))
       #f
       (let loop ((hed (car header))
@@ -2082,11 +2320,12 @@
                  (n   0))
         (if (equal? hed field)
             (handle-exceptions
              exn
              (begin
-               (debug:print 0 *default-log-port* "WARNING: attempt to read non-existant field, row=" row " header=" header " field=" field)
+               (debug:print 0 *default-log-port* "WARNING: attempt to read non-existant field, row="
+			    row " header=" header " field=" field ", exn=" exn)
                #f)
              (vector-ref row n))
 	    (if (null? tal) #f (loop (car tal)(cdr tal)(+ n 1)))))))
 
 ;; Accessors for the header/data structure
@@ -2257,11 +2496,11 @@
   (fprintf out "#,(simple-run ~S ~S ~S ~S)"
 	   (simple-run-target x) (simple-run-id x) (simple-run-runname x) (time->string (seconds->local-time (simple-run-event_time x) ))))
 
 ;; simple get-runs
 ;;
-(define (db:simple-get-runs dbstruct runpatt count offset target)
+(define (db:simple-get-runs dbstruct runpatt count offset target last-update)
     (let* ((res       '())
 	   (keys       (db:get-keys dbstruct))
 	   (runpattstr (db:patt->like "runname" runpatt))
 	   (remfields  (list "id" "runname" "state" "status" "owner" "event_time"))
 	   (targstr    (string-intersperse keys "||'/'||"))
@@ -2268,17 +2507,22 @@
 	   (keystr     (conc targstr " AS target,"
 			     (string-intersperse remfields ",")))
 	   (qrystr     (conc "SELECT " keystr " FROM runs WHERE (" runpattstr ") " ;; runname LIKE ? "
 			     ;; Generate: " AND x LIKE 'keypatt' ..."
 			     " AND target LIKE '" target "'"
-			     " AND state != 'deleted' ORDER BY event_time DESC "
+			     " AND state != 'deleted' "
+			     (if (number? last-update)
+				 (conc " AND last_update >= " last-update)
+				 "")
+			     " ORDER BY event_time DESC "
 			     (if (number? count)
 				 (conc " LIMIT " count)
 				 "")
 			     (if (number? offset)
 				 (conc " OFFSET " offset)
-				 ""))))
+				 "")))
+	   )
     (debug:print-info 11 *default-log-port* "db:get-runs START qrystr: " qrystr " target: " target " offset: " offset " limit: " count)
     (db:with-db dbstruct #f #f
 		(lambda (db)		
 		  (sqlite3:for-each-row
 		   (lambda (target id runname state status owner event_time)
@@ -2845,23 +3089,27 @@
 				(if limit  (conc " LIMIT " limit)   " ")
 				(if offset (conc " OFFSET " offset) " ")
 				";"
 				)))
     (debug:print-info 8 *default-log-port* "db:get-tests-for-run run-id=" run-id ", qry=" qry)
-    (db:with-db dbstruct run-id #f
-		(lambda (db)
-		  (sqlite3:for-each-row 
-		   (lambda (a . b) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment)
-		     (set! res (cons (apply vector a b) res))) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) res)))
-		   db
-		   qry
-		   (or run-id 1) ;; 1 > 0 , for the case where we are seeking tests matching criteral for all runs
-		   )))
-    (case qryvals
-      ((shortlist)(map db:test-short-record->norm res))
-      ((#f)       res)
-      (else       res))))
+    (let* ((res (db:with-db dbstruct run-id #f
+			    (lambda (db)
+			      ;; (let* ((stmth (db:get-cache-stmth dbstruct db qry))) ;; due to use of last-update we can't efficiently cache this query
+				(reverse
+				 (sqlite3:fold-row
+				  (lambda (res . row)
+				    ;; id run-id testname state status event-time host cpuload
+				    ;;     diskfree uname rundir item-path run-duration final-logf comment)
+				    (cons (list->vector row) res))
+				  '()
+				  db qry ;; stmth
+				  (or run-id 1) ;; 1 > 0 , for the case where we are seeking tests matching criteral for all runs
+				  ))))))
+      (case qryvals
+	((shortlist)(map db:test-short-record->norm res))
+	((#f)       res)
+	(else       res)))))
 
 (define (db:test-short-record->norm inrec)
   ;;  "id,run_id,testname,item_path,state,status"
   ;;  "id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment
   (vector (vector-ref inrec 0) ;; id
@@ -2871,26 +3119,58 @@
 	  (vector-ref inrec 5) ;; status
 	  -1 "" -1 -1 "" "-" 
 	  (vector-ref inrec 3) ;; item-path
 	  -1 "-" "-"))
 
+;;
+;; 1. cache tests-match-qry
+;; 2. compile qry and store in hash
+;; 3. convert for-each-row to fold
+;;
 (define (db:get-tests-for-run-state-status dbstruct run-id testpatt)
+  (db:with-db
+   dbstruct run-id #f
+   (lambda (db)
+     (let* ((res            '())
+	    (stmt-cache      (dbr:dbstruct-stmt-cache dbstruct))
+	    (stmth           (let* ((sh (db:hoh-get stmt-cache db testpatt)))
+			       (or sh
+				   (let* ((tests-match-qry (tests:match->sqlqry testpatt))
+					  (qry             (conc "SELECT id,testname,item_path,state,status FROM tests WHERE run_id=? " 
+								 (if tests-match-qry (conc " AND (" tests-match-qry ") ") "")))
+					  (newsh           (sqlite3:prepare db qry)))
+				     (debug:print-info 8 *default-log-port* "db:get-tests-for-run qry=" qry)
+				     (db:hoh-set! stmt-cache db testpatt newsh)
+				     newsh)))))
+       (reverse
+	(sqlite3:fold-row
+	 (lambda (res id testname item-path state status)
+	   ;;  id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment
+	   (cons (vector id run-id testname state status -1         ""     -1      -1       ""    "-"  item-path -1           "-"         "-") res))
+	 '()
+	 stmth
+	 run-id))))))
+
+(define (db:get-tests-for-run-state-status dbstruct run-id testpatt #!optional (last-update 0))
   (let* ((res            '())
 	 (tests-match-qry (tests:match->sqlqry testpatt))
-	 (qry             (conc "SELECT id,testname,item_path,state,status FROM tests WHERE run_id=? " 
-				(if tests-match-qry (conc " AND (" tests-match-qry ") ") ""))))
+	 (qry             (conc "SELECT id,testname,item_path,state,status,event_time,run_duration FROM tests WHERE run_id=? " 
+				" AND last_update > ? "
+				(if tests-match-qry (conc " AND (" tests-match-qry ") ") "")
+				)))
     (debug:print-info 8 *default-log-port* "db:get-tests-for-run qry=" qry)
     (db:with-db dbstruct run-id #f
 		(lambda (db)
-		  (sqlite3:for-each-row
-		   (lambda (id testname item-path state status)
-		     ;;                      id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment
-		     (set! res (cons (vector id run-id testname state status -1         ""     -1      -1       ""    "-"  item-path -1           "-"         "-") res)))
+		  (sqlite3:fold-row
+		   (lambda (res id testname item-path state status event-time run-duration)
+		     ;;            id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment
+		     (cons (vector id run-id testname state status event-time  ""     -1      -1       ""    "-"  item-path run-duration  "-"         "-") res))
+		   '()
 		   db 
 		   qry
-		   run-id)))
-    res))
+		   run-id
+		   (or last-update 0))))))
 
 (define (db:get-testinfo-state-status dbstruct run-id test-id)
   (let ((res            #f))
     (db:with-db dbstruct run-id #f
 		(lambda (db)
@@ -2935,12 +3215,13 @@
    (lambda (db)
      (sqlite3:execute db "UPDATE tests SET state='DELETED',status='n/a',comment='' WHERE id=?;" test-id))))
 
 ;; 
 (define (db:delete-old-deleted-test-records dbstruct)
-  (let (;; (run-ids  (db:get-all-run-ids dbstruct))
-	(targtime (- (current-seconds)(* 30 24 60 60)))) ;; one month in the past
+  (let ((targtime (- (current-seconds)
+		     (or (configf:lookup-number *configdat* "setup" "keep-deleted-records")
+			 (* 30 24 60 60))))) ;; one month in the past
     (db:with-db
      dbstruct
      0
      #t
      (lambda (db)
@@ -3012,22 +3293,18 @@
   (mt:process-triggers dbstruct run-id test-id newstate newstatus))
 
 ;; NEW BEHAVIOR: Count tests running in all runs!
 ;;
 (define (db:get-count-tests-running dbstruct run-id)
-  (db:with-db
-   dbstruct
-   run-id
-   #f
-   (lambda (db)
-     (sqlite3:first-result 
-      db
-      ;; WARNING BUG EDIT ME - merged from v1.55 - not sure what is right here ...
-      ;; AND run_id NOT IN (SELECT id FROM runs WHERE state='deleted')
-      "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND NOT (uname = 'n/a' AND item_path = '');"
-      ;; "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND run_id=?;" 
-      ))))
+  (let* ((qry  "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND NOT (uname = 'n/a' AND item_path = '');"))
+    (db:with-db
+     dbstruct
+     run-id
+     #f
+     (lambda (db)
+       (let* ((stmth (db:get-cache-stmth dbstruct db qry)))
+	 (sqlite3:first-result stmth))))))
 
 ;; NEW BEHAVIOR: Count tests running in only one run!
 ;;
 (define (db:get-count-tests-actually-running dbstruct run-id)
   (db:with-db
@@ -3044,43 +3321,47 @@
 
 ;; NEW BEHAVIOR: Look only at single run with run-id
 ;; 
 ;; (define (db:get-running-stats dbstruct run-id)
 (define (db:get-count-tests-running-for-run-id dbstruct run-id)
-  (db:with-db
-   dbstruct
-   run-id
-   #f
-   (lambda (db)
-     (sqlite3:first-result
-      db
-      "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND run_id=?;" run-id))))
+  (let* ((qry "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND run_id=?;"))
+    (db:with-db
+     dbstruct
+     run-id
+     #f
+     (lambda (db)
+       (let* ((stmth (db:get-cache-stmth dbstruct db qry)))
+	 (sqlite3:fold-row
+	  (lambda (res val) val)
+	  0 stmth run-id))))))
+
+;;	 (sqlite3:first-result stmth run-id))))))
 
 ;; For a given testname how many items are running? Used to determine
 ;; probability for regenerating html
-;; 
+;;
 (define (db:get-count-tests-running-for-testname dbstruct run-id testname)
   (db:with-db
    dbstruct
    run-id
    #f
    (lambda (db)
-     (sqlite3:first-result
-      db
-      "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND run_id=? AND NOT (uname = 'n/a' AND item_path = '') AND testname=?;" run-id testname))))
-
+     (let* ((stmt "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND run_id=? AND NOT (uname = 'n/a' AND item_path = '') AND testname=?;")
+	    (stmth (db:get-cache-stmth dbstruct db stmt)))
+       (sqlite3:fold-row
+	(lambda (res val) val) 0 stmth run-id testname)))))
 
 (define (db:get-not-completed-cnt dbstruct run-id)
-(db:with-db
+  (db:with-db
    dbstruct
    run-id
    #f
    (lambda (db)
-      ;(print "SELECT count(id) FROM tests WHERE state not in ('COMPLETED', 'DELETED') AND run_id=" run-id)  
-     (sqlite3:first-result
-      db
-      "SELECT count(id) FROM tests WHERE state not in ('COMPLETED', 'DELETED') AND run_id=?;" run-id))))
+     (let* ((stmt "SELECT count(id) FROM tests WHERE state not in ('COMPLETED', 'DELETED') AND run_id=?;"))
+       (sqlite3:fold-row
+	(lambda (res val) val)
+	0 (db:get-cache-stmth dbstruct db stmt) run-id)))))
 
 (define (db:get-count-tests-running-in-jobgroup dbstruct run-id jobgroup)
   (if (not jobgroup)
       0 ;; 
       (let ((testnames '()))
@@ -3180,10 +3461,16 @@
 		#f
 		(loop (car tal)(cdr tal)(+ indx 1)))))))
 
 (define db:test-record-qry-selector (string-intersperse db:test-record-fields ","))
 
+(define (db:update-tesdata-on-repilcate-db dbstruct old-lt new-lt)
+  (db:with-db
+   dbstruct   #f   #f
+   (lambda (db)
+     (sqlite3:execute db "UPDATE tests SET rundir= replace(rundir,?,?), shortdir=replace(shortdir,?,?);"
+		      old-lt new-lt  old-lt new-lt))))
 
 ;; NOTE: Use db:test-get* to access records
 ;; NOTE: This needs rundir decoding? Decide, decode here or where used? For the moment decode where used.
 (define (db:get-all-tests-info-by-run-id dbstruct run-id)
   (let* ((res '()))
@@ -3257,11 +3544,11 @@
      (lambda (run-id)
        (let ((testrecs (db:get-all-tests-info-by-run-id mtdb run-id)))
 	 (db:prep-megatest.db-adj-test-ids (db:dbdat-get-db mtdb) run-id testrecs)))
      run-ids)))
 
-;; Get test data using test_id, run-id is not used
+;; Get test data using test_id, run-id is not used - but it will be!
 ;; 
 (define (db:get-test-info-by-id dbstruct run-id test-id)
   (db:with-db
    dbstruct
    #f ;; run-id
@@ -3437,25 +3724,25 @@
 
 ;;======================================================================
 ;; T E S T  D A T A 
 ;;======================================================================
 
- (define (db:get-data-info-by-id dbstruct  test-data-id)
-   (db:with-db
-    dbstruct
-    #f 
-    #f
-    (lambda (db)
-      (let* ((res (vector #f #f #f #f #f #f #f #f #f #f #f #f)))
-        (sqlite3:for-each-row 
-       (lambda (id test-id  category variable value expected tol units comment status type last-update)
-         (set! res (vector id test-id  category variable value expected tol units comment status type last-update)))
-       db
-       "SELECT id,test_id, category, variable, value, expected, tol, units, comment, status, type, last_update FROM test_data WHERE id=? ORDER BY id ASC;" ;; event_time DESC,id ASC;
-       test-data-id)
-        res))))
-
+(define (db:get-data-info-by-id dbstruct  test-data-id)
+  (let* ((stmt        "SELECT id,test_id, category, variable, value, expected, tol, units, comment, status, type, last_update FROM test_data WHERE id=? ORDER BY id ASC;")) ;; event_time DESC,id ASC;
+    (db:with-db
+     dbstruct
+     #f 
+     #f
+     (lambda (db)
+       (let* ((stmth (db:get-cache-stmth dbstruct db stmt))
+	      (res   (sqlite3:fold-row
+		      (lambda (res id test-id  category variable value expected tol units comment status type last-update)
+			(vector id test-id  category variable value expected tol units comment status type last-update))
+		      (vector #f #f #f #f #f #f #f #f #f #f #f #f)
+		      stmth
+		      test-data-id)))
+        res)))))
 
 ;; WARNING: Do NOT call this for the parent test on an iterated test
 ;; Roll up test_data pass/fail results
 ;; look at the test_data status field, 
 ;;    if all are pass (any case) and the test status is PASS or NULL or '' then set test status to PASS.
@@ -3900,10 +4187,13 @@
                                      run-id )))))
    test-count-recs))
 
 
 ;; BBnote: db:get-all-state-status-counts-for-test returns dbr:counts object aggregating state and status of items of a given test, *not including rollup state/status*
+;;
+;; NOTE: This is called within a transaction
+;;
 (define (db:get-all-state-status-counts-for-test dbstruct run-id test-name item-path item-state-in item-status-in)
   (let* ((test-info   (db:get-test-info dbstruct run-id test-name item-path))
          (item-state  (or item-state-in (db:test-get-state test-info))) 
          (item-status (or item-status-in (db:test-get-status test-info)))
          (other-items-count-recs (db:with-db
@@ -4272,11 +4562,11 @@
 		 (db     (db:dbdat-get-db   dbdat)) ;; we'll return this so (db:delay--if-busy can be called inline
 		 (dbfj   (conc dbpath "-journal")))
 	    (if (handle-exceptions
 		 exn
 		 (begin
-		   (debug:print-info 0 *default-log-port* "WARNING: failed to test for existance of " dbfj)
+		   (debug:print-info 0 *default-log-port* "WARNING: failed to test for existance of " dbfj ", exn=" exn)
 		   (thread-sleep! 1)
 		   (db:delay-if-busy count (- count 1))) 
 		 (common:file-exists? dbfj))
 		(case count
 		  ((6)
@@ -4437,11 +4727,11 @@
 			    (begin
                               (handle-exceptions
                                exn
                                (begin
                                   (debug:print 0 *default-log-port*
-                                  "WARNING: itemmap has problem \"" itemmap "\", patt: " patt ", repl: " repl)
+                                  "WARNING: itemmap has problem \"" itemmap "\", patt: " patt ", repl: " repl ", exn=" exn)
                                  res)
                               (string-substitute patt repl res))
 
 
                               )

ADDED   dbmod.scm
Index: dbmod.scm
==================================================================
--- /dev/null
+++ dbmod.scm
@@ -0,0 +1,39 @@
+;;======================================================================
+;; Copyright 2017, Matthew Welland.
+;; 
+;; This file is part of Megatest.
+;; 
+;;     Megatest is free software: you can redistribute it and/or modify
+;;     it under the terms of the GNU General Public License as published by
+;;     the Free Software Foundation, either version 3 of the License, or
+;;     (at your option) any later version.
+;; 
+;;     Megatest is distributed in the hope that it will be useful,
+;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;     GNU General Public License for more details.
+;; 
+;;     You should have received a copy of the GNU General Public License
+;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
+
+;;======================================================================
+
+(declare (unit dbmod))
+
+(module dbmod
+	*
+	
+(import scheme chicken data-structures extras)
+(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18)
+
+(define (just-testing)
+  (print "JUST TESTING"))
+
+;; (define (debug:print . params) #f)
+;; (define (debug:print-info . params) #f)
+;; 
+;; (define (set-functions dbgp dbgpinfo)
+;;   (set! debug:print dbgp)
+;;   (set! debug:print-info dbgpinfo))
+
+)

Index: dcommon.scm
==================================================================
--- dcommon.scm
+++ dcommon.scm
@@ -25,15 +25,15 @@
 (import canvas-draw-iup)
 (use regex typed-records matchable)
 
 (declare (unit dcommon))
 
-(declare (uses megatest-version))
 (declare (uses gutils))
 (declare (uses db))
 ;; (declare (uses synchash))
 
+(include "megatest-version.scm")
 (include "common_records.scm")
 (include "db_records.scm")
 (include "key_records.scm")
 (include "run_records.scm")
 
@@ -616,70 +616,74 @@
     ;; Megatest version
     (iup:attribute-set! general-matrix "2:0" "Version")
     (iup:attribute-set! general-matrix "2:1" (conc megatest-version "-" (substring megatest-fossil-hash 0 4)))
 
     general-matrix))
+
+(define (dcommon:stats-updater commondat tabdat stats-matrix)
+  (if (and (iup:ihandle? stats-matrix)
+	   (dashboard:database-changed? commondat tabdat context-key: 'run-stats))
+      (let* ((changed      #f)
+	     (run-stats    (rmt:get-run-stats))
+	     (indices      (common:sparse-list-generate-index run-stats)) ;;  proc: set-cell))
+	     (row-indices  (car indices))
+	     (col-indices  (cadr indices))
+	     (max-row      (if (null? row-indices) 1 (common:max (map cadr row-indices))))
+	     (max-col      (if (null? col-indices) 1 
+			       (common:max (map cadr col-indices))))
+	     (max-visible  (max (- (dboard:tabdat-num-tests tabdat) 15) 3))
+	     (max-col-vis  (if (> max-col 10) 10 max-col))
+	     (numrows      1)
+	     (numcols      1))
+	(iup:attribute-set! stats-matrix "CLEARVALUE" "CONTENTS")
+	(iup:attribute-set! stats-matrix "NUMCOL" max-col )
+	(iup:attribute-set! stats-matrix "NUMLIN" (if (< max-row max-visible) max-visible max-row)) ;; min of 20
+	(iup:attribute-set! stats-matrix "NUMCOL_VISIBLE" max-col-vis)
+	(iup:attribute-set! stats-matrix "NUMLIN_VISIBLE" (if (> max-row max-visible) max-visible max-row))
+	;;(print "row-indices: " row-indices " col-indices: " col-indices)
+	;; Row labels
+	(for-each (lambda (ind)
+		    (let* ((name (car ind))
+			   (num  (cadr ind))
+			   (key  (conc num ":0")))
+		      (if (not (equal? (iup:attribute stats-matrix key) name))
+			  (begin
+			    (set! changed #t)
+			    (iup:attribute-set! stats-matrix key name)))))
+		  row-indices)
+
+	;; Col labels
+	(for-each (lambda (ind)
+		    (let* ((name (car ind))
+			   (num  (cadr ind))
+			   (key  (conc "0:" num)))
+		      (if (not (equal? (iup:attribute stats-matrix key) name))
+			  (begin
+			    (set! changed #t)
+			    (iup:attribute-set! stats-matrix key name)))))
+		  col-indices)
+
+	;; Cell contents
+	(for-each (lambda (entry)
+		    (let* ((row-name (car entry))
+			   (col-name (cadr entry))
+			   (value    (caddr entry))
+			   (row-num  (cadr (assoc row-name row-indices)))
+			   (col-num  (cadr (assoc col-name col-indices)))
+			   (key      (conc row-num ":" col-num)))
+		      (if (not (equal? (iup:attribute stats-matrix key) value))
+			  (begin
+			    (set! changed #t)
+			    (iup:attribute-set! stats-matrix key value)))))
+		  run-stats)
+	(if changed (iup:attribute-set! stats-matrix "REDRAW" "ALL")))))
+
 
 (define (dcommon:run-stats commondat tabdat #!key (tab-num #f))
   (let* ((stats-matrix (iup:matrix expand: "YES"))
-	 (changed      #f)
 	 (stats-updater (lambda ()
-			 (if (dashboard:database-changed? commondat tabdat context-key: 'run-stats)
-			     (let* ((run-stats    (rmt:get-run-stats))
-				    (indices      (common:sparse-list-generate-index run-stats)) ;;  proc: set-cell))
-				    (row-indices  (car indices))
-				    (col-indices  (cadr indices))
-				    (max-row      (if (null? row-indices) 1 (common:max (map cadr row-indices))))
-				    (max-col      (if (null? col-indices) 1 
-						      (common:max (map cadr col-indices))))
-				    (max-visible  (max (- (dboard:tabdat-num-tests tabdat) 15) 3))
-				    (max-col-vis  (if (> max-col 10) 10 max-col))
-				    (numrows      1)
-				    (numcols      1))
-			       (iup:attribute-set! stats-matrix "CLEARVALUE" "CONTENTS")
-			       (iup:attribute-set! stats-matrix "NUMCOL" max-col )
-			       (iup:attribute-set! stats-matrix "NUMLIN" (if (< max-row max-visible) max-visible max-row)) ;; min of 20
-			       (iup:attribute-set! stats-matrix "NUMCOL_VISIBLE" max-col-vis)
-			       (iup:attribute-set! stats-matrix "NUMLIN_VISIBLE" (if (> max-row max-visible) max-visible max-row))
-
-			       ;; Row labels
-			       (for-each (lambda (ind)
-					   (let* ((name (car ind))
-						  (num  (cadr ind))
-						  (key  (conc num ":0")))
-					     (if (not (equal? (iup:attribute stats-matrix key) name))
-						 (begin
-						   (set! changed #t)
-						   (iup:attribute-set! stats-matrix key name)))))
-					 row-indices)
-
-			       ;; Col labels
-			       (for-each (lambda (ind)
-					   (let* ((name (car ind))
-						  (num  (cadr ind))
-						  (key  (conc "0:" num)))
-					     (if (not (equal? (iup:attribute stats-matrix key) name))
-						 (begin
-						   (set! changed #t)
-						   (iup:attribute-set! stats-matrix key name)))))
-					 col-indices)
-
-			       ;; Cell contents
-			       (for-each (lambda (entry)
-					   (let* ((row-name (car entry))
-						  (col-name (cadr entry))
-						  (value    (caddr entry))
-						  (row-num  (cadr (assoc row-name row-indices)))
-						  (col-num  (cadr (assoc col-name col-indices)))
-						  (key      (conc row-num ":" col-num)))
-					     (if (not (equal? (iup:attribute stats-matrix key) value))
-						 (begin
-						   (set! changed #t)
-						   (iup:attribute-set! stats-matrix key value)))))
-					 run-stats)
-			       (if changed (iup:attribute-set! stats-matrix "REDRAW" "ALL")))
-                             ))))
+			  (dcommon:stats-updater commondat tabdat stats-matrix))))
     ;; (dboard:commondat-please-update-set! commondat #t) ;; force redraw on first pass 
     ;; (mark-for-update tabdat)
     ;; (stats-updater)
     (dboard:commondat-add-updater commondat stats-updater tab-num: tab-num)
     ;; (set! dashboard:update-summary-tab updater)
@@ -949,14 +953,13 @@
   (+ yoffset (* y scalef)))
 
 ;; sizex, sizey     - canvas size
 ;; originx, originy - canvas origin
 ;;
-(define (dcommon:initial-draw-tests cnv xadj yadj sizex sizey sizexmm sizeymm originx originy tests-draw-state sorted-testnames test-records)
-  (let* ((dot-data ;; (map cdr (filter
-		   ;; 	  (lambda (x)(equal? "node" (car x)))
-	  (map string-split (tests:lazy-dot test-records "plain" sizex sizey))) ;; (tests:easy-dot test-records "plain")))
+(define (dcommon:initial-draw-tests cnv xadj yadj sizex sizey sizexmm sizeymm originx originy
+				    tests-draw-state sorted-testnames test-records)
+  (let* ((dot-data       (tests:lazy-dot test-records "plain" sizex sizey 'munged))
 	 (xoffset	 (dcommon:get-xoffset tests-draw-state sizex xadj))
 	 (yoffset        (dcommon:get-yoffset tests-draw-state sizey yadj))
 	 (no-dot         (configf:lookup *configdat* "setup" "nodot"))
 	 (boxh           15)
 	 (boxw           10)
@@ -1157,11 +1160,11 @@
 				       (lambda ()
 					 ;; (print "obj: " obj " val: " val " unk: " unk)
 					 (dboard:tabdat-run-name-set! tabdat txt) ;; (iup:attribute obj "VALUE"))
 					 (dashboard:update-run-command tabdat))
 				       "command-runname-selector tb action"))
-			   #:value (or default-run-name (dboard:tabdat-run-name tabdat))))
+			   #:value (or (args:get-arg "-runname") default-run-name (dboard:tabdat-run-name tabdat))))
 	  (lb (iup:listbox #:expand "HORIZONTAL"
 			   #:dropdown "YES"
 			   #:action (lambda (obj val index lbstate)
 				      (debug:catch-and-dump
 				       (lambda ()
@@ -1430,11 +1433,12 @@
 
 (define (dashboard:get-youngest-run-db-mod-time dbdir)
   (handle-exceptions
    exn
    (begin
-     (debug:print 2 *default-log-port* "WARNING: error in accessing databases in get-youngest-run-db-mod-time: " ((condition-property-accessor 'exn 'message) exn) " db-dir="dbdir)
+     (debug:print 2 *default-log-port* "WARNING: error in accessing databases in get-youngest-run-db-mod-time: " ((condition-property-accessor 'exn 'message) exn)
+		  " db-dir="dbdir ", exn=" exn)
      (current-seconds)) ;; something went wrong - just print an error and return current-seconds
    (common:max (map (lambda (filen)
 		      (file-modification-time filen))
 		    (glob (conc dbdir "/*.db*"))))))
 

Index: docs/manual/Makefile
==================================================================
--- docs/manual/Makefile
+++ docs/manual/Makefile
@@ -30,15 +30,15 @@
 #         asciidoc -b html5 -a icons -a iconsdir=$(DISPATH)/images/icons -a toc2 design_spec.txt
 #
 
 all : server.ps megatest_manual.html client.ps complex-itemmap.png megatest_manual.pdf
 
-megatest_manual.html : megatest_manual.txt  *.txt installation.txt *png
+megatest_manual.html : megatest_manual.txt  *.txt installation.txt *png *.dot
 	asciidoc  -b html5 -a icons -a iconsdir=$(DISPATH)/images/icons -a toc2 megatest_manual.txt
 #	dos2unix megatest_manual.html
 
-megatest_manual.pdf : megatest_manual.txt *.txt *png
+megatest_manual.pdf : megatest_manual.txt *.txt *png *.dot
 	a2x -a toc -f pdf megatest_manual.txt
 
 server.ps : server.dot
 	dot -Tps server.dot > server.ps
 

ADDED   docs/manual/bisecting.dot
Index: docs/manual/bisecting.dot
==================================================================
--- /dev/null
+++ docs/manual/bisecting.dot
@@ -0,0 +1,31 @@
+//  Copyright 2021, Matthew Welland.
+// 
+// This file is part of Megatest.
+// 
+//     Megatest is free software: you can redistribute it and/or modify
+//     it under the terms of the GNU General Public License as published by
+//     the Free Software Foundation, either version 3 of the License, or
+//     (at your option) any later version.
+// 
+//     Megatest is distributed in the hope that it will be useful,
+//     but WITHOUT ANY WARRANTY; without even the implied warranty of
+//     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+//     GNU General Public License for more details.
+// 
+//     You should have received a copy of the GNU General Public License
+//     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
+//
+digraph G {
+    rankdir=LR
+    subgraph cluster_1 {
+        node [style=filled,shape=box];
+
+	B [label="B\nProblem is here"];
+	E [label="E\nProblem manifests here"];
+	A -> B;
+	B -> C;
+	C -> D;
+	D -> E;
+    }
+
+}

ADDED   docs/manual/bisecting.png
Index: docs/manual/bisecting.png
==================================================================
--- /dev/null
+++ docs/manual/bisecting.png
cannot compute difference between binary files

ADDED   docs/manual/debugging.txt
Index: docs/manual/debugging.txt
==================================================================
--- /dev/null
+++ docs/manual/debugging.txt
@@ -0,0 +1,110 @@
+//  Copyright 2021, Matthew Welland.
+// 
+// This file is part of Megatest.
+// 
+//     Megatest is free software: you can redistribute it and/or modify
+//     it under the terms of the GNU General Public License as published by
+//     the Free Software Foundation, either version 3 of the License, or
+//     (at your option) any later version.
+// 
+//     Megatest is distributed in the hope that it will be useful,
+//     but WITHOUT ANY WARRANTY; without even the implied warranty of
+//     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+//     GNU General Public License for more details.
+// 
+//     You should have received a copy of the GNU General Public License
+//     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
+
+Debugging
+---------
+
+A word on Bisecting
+~~~~~~~~~~~~~~~~~~~
+
+Bisecting is a debug strategy intended to speed up finding the root
+cause.
+
+.A complex process with a problem found in stage "E"
+["graphviz", "bisecting.png"]
+----------------------------------------------------------------------
+include::bisecting.dot[]
+----------------------------------------------------------------------
+
+It is common to start debugging where the problem was observed and
+then work back. However by inspecting the output at stage "C" in the
+example above you would potentially save a lot of debug effort, this
+is similar to the feature in source control tools like git and fossil
+called biseceting.
+
+To know where to look for problems you will want to look at the log files at various stages in the execution process.
+
+.A simplified diagram of the stages Megatest goes through to run a test.
+["graphviz", "megatest-test-stages.png"]
+----------------------------------------------------------------------
+include::megatest-test-stages.dot[]
+----------------------------------------------------------------------
+
+.How to check variable values and inspect logs at each stage
+[width="80%",cols="<,2m,2m",frame="topbot",options="header"]
+|======================
+|Stage	                    | How to inspect                               | Watch for
+|A: post config processing  | megatest -show-config -target your/target	   | #f (failed var processing)
+|B: post runconfig          | megatest -show-runconfig -target your/target | 
+|C: processing testconfigs  | inspect output from "megatest -run ..."      | Messages indicating issues process configs, dependency problems.
+|D: process testconfig for test launch | inspect output from megatest runner | Zero items (items expansion yielded no items)
+|E,F: launching test        | start test xterm, look at mt_launch.log      | Did your batch system accept the job? Has the job landed on a machine?
+|G: starting test           | look at your batch systems logs for the process | Did the megatest -execute process start and run?
+|H,H1,H2: step exectution   | look at <stepname>.log, <stepname>.html and your own internal logs | Do you have sufficiently tight logpro rules? You must always have a "required" rule! 
+|======================
+
+Examining The Test Logs and Environment
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Test Control Panel - xterm
+^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+From the dashboard click on a test PASS/FAIL button. This brings up a
+test control panel. Aproximately near the center left of the window
+there is a button "Start Xterm". Push this to get an xterm with the
+full context and environment loaded for that test. You can run scripts
+or ezsteps by copying from the testconfig (hint, load up the
+testconfig in a separate text editor window).
+
+With more recent versions of Megatest you can step through your test
+from the test control panel. Click on the cell labeled "rerun this
+step" to only rerun the step or click on "restart from here" to rerun
+that step and downstream steps.
+
+NOTE 1: visual feedback can take some time, give it a few seconds and
+you will see the step change color to blue as it starts running.
+
+NOTE 2: steping through only works if you are using ezsteps.
+
+Config File Processing
+^^^^^^^^^^^^^^^^^^^^^^
+
+As described above it is often helpful to know the content of
+variables in various contexts as Megatest works through the actions
+needed to run your tests. A handy technique is to force the startup of
+an xterm in the context being examined.
+
+For example, if an item list is not being generated as expected you
+can inject the startup of an xterm as if it were an item:
+
+.Original items table
+-----------------
+[items]
+CELLNAME [system getcellname.sh]
+-----------------
+
+.Items table modified for debug
+-----------------
+[items]
+DEBUG [system xterm]
+CELLNAME [system getcellnames.sh]
+-----------------
+
+When this test is run an xterm will pop up. In that xterm the
+environment is exactly that in which the script "getcellnames.sh"
+would run. You can now debug the script to find out why it isn't
+working as expected.

Index: docs/manual/howto.txt
==================================================================
--- docs/manual/howto.txt
+++ docs/manual/howto.txt
@@ -110,15 +110,15 @@
 # if defined and not "no" flexi-launcher will bypass launcher unless there is no
 # match.
 flexi-launcher yes
 ------------------------
 
-Tricks
-------
+Tricks and Tips
+---------------
 
-This section is a compendium of a various useful tricks for debugging,
-configuring and generally getting the most out of Megatest.
+This section is a collection of a various useful tricks for that
+didn't quite fit elsewhere.
 
 Limiting your running jobs
 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 
 The following example will limit a test in the jobgroup "group1" to no more than 10 tests simultaneously.
@@ -136,50 +136,10 @@
 [jobgroups]
 group1 10
 custdes 4
 ---------------
 
-Debugging Tricks
-----------------
-
-Examining The Environment
-~~~~~~~~~~~~~~~~~~~~~~~~~
-
-Test Control Panel - xterm
-^^^^^^^^^^^^^^^^^^^^^^^^^^
-
-From the dashboard click on a test PASS/FAIL button. This brings up a test control panel. Aproximately near the center left of the 
-window there is a button "Start Xterm". Push this to get an xterm with the full context and environment loaded for that test. You can run
-scripts or ezsteps by copying from the testconfig (hint, load up the testconfig in a separate gvim or emacs window). This is the easiest way
-to debug your tests.
-
-During Config File Processing
-^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-
-It is often helpful to know the content of variables in various
-contexts as Megatest does the actions needed to run your tests. A handy technique is to force the startup of an xterm in the context being examined.
-
-For example, if an item list is not being generated as expected you
-can inject the startup of an xterm as if it were an item:
-
-.Original items table
------------------
-[items]
-CELLNAME [system getcellname.sh]
------------------
-
-.Items table modified for debug
------------------
-[items]
-DEBUG [system xterm]
-CELLNAME [system getcellnames.sh]
------------------
-
-When this test is run an xterm will pop up. In that xterm the
-environment is exactly that in which the script "getcellnames.sh"
-would run. You can now debug the script to find out why it isn't
-working as expected.
 
 Organising Your Tests and Tasks
 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 
 The default location "tests" for storing tests can be extended by

Index: docs/manual/installation.txt
==================================================================
--- docs/manual/installation.txt
+++ docs/manual/installation.txt
@@ -24,5 +24,32 @@
 Chicken scheme and a number of "eggs" are required for building
 Megatest. See the script installall.sh in the utils directory of the
 source distribution for an automated way to install everything
 needed for building Megatest on Linux.
 
+Megatest. In the v1.66 and beyond assistance to create the build
+system is built into the Makefile.
+
+.Installation steps (overview)
+-------------------------------------
+./configure
+make chicken
+setup.sh make -j install
+-------------------------------------
+
+Or install the needed build system manually:
+
+. Chicken scheme from http://call-cc.org
+. IUP from http://webserver2.tecgraf.puc-rio.br/iup/
+. CD from http://webserver2.tecgraf.puc-rio.br/cd/
+. IM from https://webserver2.tecgraf.puc-rio.br/im/
+. ffcall from http://webserver2.tecgraf.puc-rio.br/iup/
+. Nanomsg from https://nanomsg.org/ (NOTE: Plan is to eliminate nanomsg dependency).
+. Needed eggs (look at the eggs lists in the Makefile)
+
+Then follow these steps:
+
+.Installation steps (self-built chicken scheme build system)
+-------------------------------------
+./configure
+make -j install
+-------------------------------------

ADDED   docs/manual/megatest-test-stages.dot
Index: docs/manual/megatest-test-stages.dot
==================================================================
--- /dev/null
+++ docs/manual/megatest-test-stages.dot
@@ -0,0 +1,42 @@
+//  Copyright 2021, Matthew Welland.
+// 
+// This file is part of Megatest.
+// 
+//     Megatest is free software: you can redistribute it and/or modify
+//     it under the terms of the GNU General Public License as published by
+//     the Free Software Foundation, either version 3 of the License, or
+//     (at your option) any later version.
+// 
+//     Megatest is distributed in the hope that it will be useful,
+//     but WITHOUT ANY WARRANTY; without even the implied warranty of
+//     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+//     GNU General Public License for more details.
+// 
+//     You should have received a copy of the GNU General Public License
+//     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
+//
+digraph G {
+    // rankdir=LR
+    subgraph cluster_1 {
+        node [style=filled,shape=box];
+	A [label="A: Process megatest.config"]
+	B [label="B: Process runconfig.config"]
+	A -> B [label="resolve vars"]
+	B2 [label="B2: Resolve variables"]
+	B -> B2 -> A
+	C [label="C: Process testconfigs (find tests to run)"]
+	D [label="D: Process testconfig for test of interest"]
+	E [label="E: Set vars for launching test"]
+	F [label="F: Launch into batch system, ssh, batch system\nand different hosts can all \nimpact variable values"]
+	G [label="G: Process testconfig again with all available variables"]
+	H [label="H: Start test"]
+	H1 [label="H1: Start step"]
+	H2 [label="H2: Execute step script"]
+	I [label="I: End step, process logfile with logpro"]
+	I -> H [label="Run remaining steps"]
+	H-> H1 -> H2 -> I
+	B->C->D->E->F->G->H
+	I->D
+    }
+
+}

ADDED   docs/manual/megatest-test-stages.png
Index: docs/manual/megatest-test-stages.png
==================================================================
--- /dev/null
+++ docs/manual/megatest-test-stages.png
cannot compute difference between binary files

Index: docs/manual/megatest_manual.html
==================================================================
--- docs/manual/megatest_manual.html
+++ docs/manual/megatest_manual.html
@@ -1,10 +1,10 @@
 <!DOCTYPE html>
 <html lang="en">
 <head>
 <meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
-<meta name="generator" content="AsciiDoc 8.6.7">
+<meta name="generator" content="AsciiDoc 8.6.10">
 <title>The Megatest Users Manual</title>
 <style type="text/css">
 /* Shared CSS for AsciiDoc xhtml11 and html5 backends */
 
 /* Default font. */
@@ -84,14 +84,20 @@
   margin-top: 0;
 }
 ul > li     { color: #aaa; }
 ul > li > * { color: black; }
 
-pre {
+.monospaced, code, pre {
+  font-family: "Courier New", Courier, monospace;
+  font-size: inherit;
+  color: navy;
   padding: 0;
   margin: 0;
 }
+pre {
+  white-space: pre-wrap;
+}
 
 #author {
   color: #527bbd;
   font-weight: bold;
   font-size: 1.1em;
@@ -216,11 +222,11 @@
   border-left: 3px solid #dddddd;
   padding-left: 0.5em;
 }
 
 div.imageblock div.content { padding-left: 0; }
-span.image img { border-style: none; }
+span.image img { border-style: none; vertical-align: text-bottom; }
 a.image:visited { color: white; }
 
 dl {
   margin-top: 0.8em;
   margin-bottom: 0.8em;
@@ -412,16 +418,10 @@
 /*
  * xhtml11 specific
  *
  * */
 
-tt {
-  font-family: "Courier New", Courier, monospace;
-  font-size: inherit;
-  color: navy;
-}
-
 div.tableblock {
   margin-top: 1.0em;
   margin-bottom: 1.5em;
 }
 div.tableblock > table {
@@ -451,16 +451,10 @@
 /*
  * html5 specific
  *
  * */
 
-.monospaced {
-  font-family: "Courier New", Courier, monospace;
-  font-size: inherit;
-  color: navy;
-}
-
 table.tableblock {
   margin-top: 1.0em;
   margin-bottom: 1.5em;
 }
 thead, p.tableblock.header {
@@ -536,10 +530,12 @@
 }
 
 @media print {
   body.manpage div#toc { display: none; }
 }
+
+
 @media screen {
   body {
     max-width: 50em; /* approximately 80 characters wide */
     margin-left: 16em;
   }
@@ -771,12 +767,12 @@
 <body class="book">
 <div id="header">
 <h1>The Megatest Users Manual</h1>
 <span id="author">Matt Welland</span><br>
 <span id="email" class="monospaced">&lt;<a href="mailto:matt@kiatoa.com">matt@kiatoa.com</a>&gt;</span><br>
-<span id="revnumber">version 1.0,</span>
-<span id="revdate">April 2012</span>
+<span id="revnumber">version 1.5,</span>
+<span id="revdate">June 2020</span>
 <div id="toc">
   <div id="toctitle">Table of Contents</div>
   <noscript><p><b>JavaScript must be enabled in your browser to display the table of contents.</b></p></noscript>
 </div>
 </div>
@@ -786,11 +782,11 @@
 <div class="sectionbody">
 <div class="paragraph"><p>This book is organised as three sub-books; getting started, writing tests and reference.</p></div>
 <div class="listingblock">
 <div class="title">License</div>
 <div class="content monospaced">
-<pre>    Copyright 2006-2017, Matthew Welland.
+<pre>    Copyright 2006-2020, Matthew Welland.
 
     This document is part of Megatest.
 
     Megatest is free software: you can redistribute it and/or modify
     it under the terms of the GNU General Public License as published by
@@ -808,22 +804,17 @@
 </div>
 </div>
 <div class="sect1">
 <h2 id="_why_megatest">Why Megatest?</h2>
 <div class="sectionbody">
-<div class="paragraph"><p>The Megatest project was started for two reasons, the first was an
-immediate and pressing need for a generalized tool to manage a suite
-of regression tests and the second was the fact that I had written or
-maintained several such tools at different companies over the years. I
-thought a single open source tool, flexible enough to meet the needs
-of any team doing continuous integrating and or running a complex
-suite of tests for release qualification would solve some problems for
-me and for others.</p></div>
-<div class="literalblock">
-<div class="content monospaced">
-<pre>-- Matt Welland, original author of the Megatest tool suite.</pre>
-</div></div>
+<div class="paragraph"><p>Megatest was created to provide a generalized tool for managing suites
+of regression tests and to provide a multi-host, distributed
+alternative to "make". The EDA world is littered with proprietory,
+company-specific tools for this purpose and by going open source and
+keeping the tool flexible the hope is that Megatest could be useful to
+any team at any company for continuous integration and almost any
+other general automation tasks.</p></div>
 </div>
 </div>
 <div class="sect1">
 <h2 id="_megatest_design_philosophy">Megatest Design Philosophy</h2>
 <div class="sectionbody">
@@ -959,10 +950,491 @@
 <img src="megatest-system-architecture.png" alt="Static">
 </div>
 </div>
 </div>
 </div>
+</div>
+<div class="sect1">
+<h2 id="_todo_road_map">TODO / Road Map</h2>
+<div class="sectionbody">
+<div class="paragraph"><p>Note: This road-map is a wish list and not a formal plan. Items are in
+rough priority but are subject to change. Development is driven by
+user requests, developer "itch" and bug reports. Please contact
+<a href="mailto:matt@kiatoa.com">matt@kiatoa.com</a> with requests or bug reports. Requests from inside
+Intel generally take priority.</p></div>
+<div class="paragraph"><p>Dashboard and runs</p></div>
+<div class="olist arabic"><ol class="arabic">
+<li>
+<p>
+Multi-area dashboard view
+</p>
+</li>
+</ol></div>
+<div class="paragraph"><p>Tests Support</p></div>
+<div class="olist arabic"><ol class="arabic">
+<li>
+<p>
+Add variable $MT_RUNPATH = $MT_LINKTREE/$MT_TARGET/$MT_RUNNAME
+</p>
+</li>
+<li>
+<p>
+Improve [script], especially indent handling
+</p>
+</li>
+</ol></div>
+<div class="paragraph"><p>Scalability</p></div>
+<div class="olist arabic"><ol class="arabic">
+<li>
+<p>
+Overflow database methodology - combine the best of the v1.63
+  multi-db approach and the current db-in-tmp approach (currently
+  slowness can be seen when number of tests in a db goes over 50-100k,
+  with the overflow db it will be able to handle 1000&#8217;s of runs with
+  50-100k tests per run). High priority - goal is to complete this by
+  20Q3.
+</p>
+</li>
+</ol></div>
+<div class="paragraph"><p>Mtutils/CI</p></div>
+<div class="olist arabic"><ol class="arabic">
+<li>
+<p>
+Enable mtutil calls from dashboard (for remote control)
+</p>
+</li>
+<li>
+<p>
+Logs browser (esp. for surfacing mtutil related activities)
+</p>
+</li>
+<li>
+<p>
+Embed ftfplan for distributed automation, completed activities trigger QA runs which trigger deployment etc.
+</p>
+</li>
+<li>
+<p>
+Jenkins junit XML support [DONE]
+</p>
+</li>
+<li>
+<p>
+Add output flushing in teamcity support
+</p>
+</li>
+</ol></div>
+<div class="paragraph"><p>Build system</p></div>
+<div class="olist arabic"><ol class="arabic">
+<li>
+<p>
+./configure &#8658; ubuntu, sles11, sles12, rh7 [WIP]
+</p>
+</li>
+<li>
+<p>
+Switch to using simple runs query everywhere
+</p>
+</li>
+<li>
+<p>
+Add end_time to runs and add a rollup call that sets state, status and end_time
+</p>
+</li>
+</ol></div>
+<div class="paragraph"><p>Code refactoring/quality/performance</p></div>
+<div class="olist arabic"><ol class="arabic">
+<li>
+<p>
+Switch to scsh-process pipeline management for job execution/control
+</p>
+</li>
+<li>
+<p>
+Use call-with-environment-variables where possible.
+</p>
+</li>
+</ol></div>
+<div class="paragraph"><p>Migration to inmem db and or overflow db</p></div>
+<div class="olist arabic"><ol class="arabic">
+<li>
+<p>
+Re-work the dbstruct data structure?
+</p>
+<div class="olist loweralpha"><ol class="loweralpha">
+<li>
+<p>
+[ run-id.db inmemdb last-mod last-read last-sync inuse ]
+</p>
+</li>
+</ol></div>
+</li>
+</ol></div>
+<div class="paragraph"><p>Some ideas for Megatest 2.0</p></div>
+<div class="olist arabic"><ol class="arabic">
+<li>
+<p>
+Aggressive megatest.config and runconfig.config caching.
+</p>
+<div class="olist loweralpha"><ol class="loweralpha">
+<li>
+<p>
+Cache the configs in $MT_RUNPATH
+</p>
+</li>
+<li>
+<p>
+Following invocations of –run, -rerun* will calculate the new config but only overwrite the cached file IF changed
+</p>
+</li>
+</ol></div>
+</li>
+<li>
+<p>
+If the cached file changes ALL existing tests go from COMPLETED &#8594; STALE, I’m not sure what to do about RUNNING tests
+</p>
+</li>
+<li>
+<p>
+!VARS in runconfigs are not exported to the environment. They are accessed via rget as if the ! was not there.
+</p>
+</li>
+<li>
+<p>
+Per test copy commands (example is incomplete).
+</p>
+</li>
+</ol></div>
+<div class="listingblock">
+<div class="content monospaced">
+<pre>[testcopy]
+%/iind% unison SRC DEST
+% cp –r SRC DEST</pre>
+</div></div>
+<div class="paragraph"><p>Add ability to move runs to other Areas (overlaps with overflow db system)</p></div>
+<div class="olist arabic"><ol class="arabic">
+<li>
+<p>
+allow shrinking megatest.db data by moving runs to an alternate
+  Megatest area with same keys.
+</p>
+</li>
+<li>
+<p>
+add param -destination [area|path]. when specified runs are copied to new
+  area and removed from local db.
+</p>
+</li>
+<li>
+<p>
+the data move would involve these steps
+</p>
+<div class="olist loweralpha"><ol class="loweralpha">
+<li>
+<p>
+copy the run data to destination area megatest.db
+</p>
+</li>
+<li>
+<p>
+mark the run records as deleted, do not remove the run data on disk
+</p>
+</li>
+</ol></div>
+</li>
+<li>
+<p>
+accessing the data would be by running dashboard in the satellite area
+</p>
+</li>
+<li>
+<p>
+future versions of Megatest dashboard should support displaying areas in a
+  merged way.
+</p>
+</li>
+<li>
+<p>
+some new controls would be supported in the config
+</p>
+<div class="olist loweralpha"><ol class="loweralpha">
+<li>
+<p>
+[setup] &#8658; allow-runs [no|yes]  &#8656;= used to disallow runs
+</p>
+</li>
+<li>
+<p>
+[setup] &#8658; auto-migrate=[areaname|path]  &#8656;= used to automatically
+   migrate data to a satellite area.
+</p>
+</li>
+</ol></div>
+</li>
+</ol></div>
+<div class="paragraph"><p>Eliminate ties to homehost (part of overflow db system)</p></div>
+<div class="olist arabic"><ol class="arabic">
+<li>
+<p>
+Server creates captain pkt
+</p>
+</li>
+<li>
+<p>
+Create a lock in the db
+</p>
+</li>
+<li>
+<p>
+Relinquish db when done
+</p>
+</li>
+</ol></div>
+<div class="paragraph"><p>Tasks - better management of run manager processes etc.</p></div>
+<div class="olist arabic"><ol class="arabic">
+<li>
+<p>
+adjutant queries tasks table for next action <span class="red">[Migrate into mtutil]</span>
+</p>
+<div class="olist loweralpha"><ol class="loweralpha">
+<li>
+<p>
+Task table used for tracking runner process <span class="red">[Replaced by mtutil]</span>
+</p>
+</li>
+<li>
+<p>
+Task table used for jobs to run <span class="red">[Replaced by mtutil]</span>
+</p>
+</li>
+<li>
+<p>
+Task table used for queueing runner actions (remove runs,
+   cleanRunExecute, etc)  <span class="red">[Replaced by mtutil</span>]
+</p>
+</li>
+</ol></div>
+</li>
+<li>
+<p>
+adjutant (server/task dispatch/execution manager)
+</p>
+</li>
+</ol></div>
+<div class="paragraph"><p>Stale propagation</p></div>
+<div class="olist arabic"><ol class="arabic">
+<li>
+<p>
+Mark dependent tests for clean/rerun -rerun-downstream
+</p>
+</li>
+<li>
+<p>
+On run start check for defunct tests in RUNNING, LAUNCHED or REMOTEHOSTSTART and correct or notify
+</p>
+</li>
+<li>
+<p>
+Fix: refresh of gui sometimes fails on last item (race condition?)
+</p>
+</li>
+</ol></div>
+<div class="paragraph"><p>Bin list</p></div>
+<div class="olist arabic"><ol class="arabic">
+<li>
+<p>
+Rerun step and or subsequent steps from gui [DONE?]
+</p>
+</li>
+<li>
+<p>
+Refresh test area files from gui
+</p>
+</li>
+<li>
+<p>
+Clean and re-run button
+</p>
+</li>
+<li>
+<p>
+Clean up STATE and STATUS handling.
+</p>
+<div class="olist loweralpha"><ol class="loweralpha">
+<li>
+<p>
+Dashboard and Test control panel are reverse order - choose and fix
+</p>
+</li>
+<li>
+<p>
+Move seldom used states and status to drop down selector
+</p>
+</li>
+</ol></div>
+</li>
+<li>
+<p>
+Access test control panel when clicking on Run Summary tests
+</p>
+</li>
+<li>
+<p>
+Feature: -generate-index-tree
+</p>
+</li>
+<li>
+<p>
+Change specifing of state and status to use STATE1/STATUS1,STATE2/STATUS2
+</p>
+</li>
+<li>
+<p>
+rest api available for use with Perl, Ruby etc. scripts
+</p>
+</li>
+<li>
+<p>
+megatest.config setup entries for:
+</p>
+<div class="olist loweralpha"><ol class="loweralpha">
+<li>
+<p>
+run launching (e.g. /bin/sh %CMD% &gt; /dev/null)
+</p>
+</li>
+<li>
+<p>
+browser "konqueror %FNAME%
+</p>
+</li>
+</ol></div>
+</li>
+<li>
+<p>
+refdb: Add export of csv, json and sexp
+</p>
+</li>
+<li>
+<p>
+Convert to using call-with-environment-variables where possible. Should allow handling of parallel runs in same process.
+</p>
+</li>
+<li>
+<p>
+Re-work text interface wizards. Several bugs on record. Possibly convert to gui based.
+</p>
+</li>
+<li>
+<p>
+Add to testconfig requirements section; launchlimiter scriptname, calls scriptname to check if ok to launch test
+</p>
+</li>
+<li>
+<p>
+Refactor Run Summary view, currently very clumsy
+</p>
+</li>
+<li>
+<p>
+Add option to show steps in Run Summary view
+</p>
+</li>
+<li>
+<p>
+Refactor guis for resizeablity
+</p>
+</li>
+<li>
+<p>
+Add filters to Run Summary view and Run Control view
+</p>
+</li>
+<li>
+<p>
+Add to megatest.config or testconfig; rerunok STATE/STATUS,STATE/STATUS&#8230;
+</p>
+</li>
+<li>
+<p>
+Launch gates for diskspace; /path/one&gt;1G,/path/two&gt;200M,/tmp&gt;5G,#{scheme <strong>toppath</strong>}&gt;1G
+</p>
+</li>
+<li>
+<p>
+Tool tips
+</p>
+</li>
+<li>
+<p>
+Filters on Run Summary, Summary and Run Control panel
+</p>
+</li>
+<li>
+<p>
+Built in log viewer (partially implemented)
+</p>
+</li>
+<li>
+<p>
+Refactor the test control panel
+   Help and documentation
+</p>
+</li>
+<li>
+<p>
+Complete the user manual (I’ve been working on this lately).
+</p>
+</li>
+<li>
+<p>
+Online help in the gui
+   Streamlined install
+</p>
+</li>
+<li>
+<p>
+Deployed or static build
+</p>
+</li>
+<li>
+<p>
+Added option to compile IUP (needed for VMs)
+</p>
+</li>
+<li>
+<p>
+Server side run launching
+</p>
+</li>
+<li>
+<p>
+Wizards for creating tests, regression areas (current ones are text only and limited).
+</p>
+</li>
+<li>
+<p>
+Fully functional built in web service (currently you can browse runs but it is very simplistic).
+</p>
+</li>
+<li>
+<p>
+Gui panels for editing megatest.config and runconfigs.config
+</p>
+</li>
+<li>
+<p>
+Fully isolated tests (no use of NFS to see regression area files)
+</p>
+</li>
+<li>
+<p>
+Windows version
+</p>
+</li>
+</ol></div>
+</div>
 </div>
 <div class="sect1">
 <h2 id="_installation">Installation</h2>
 <div class="sectionbody">
 <div class="sect2">
@@ -969,10 +1441,64 @@
 <h3 id="_dependencies">Dependencies</h3>
 <div class="paragraph"><p>Chicken scheme and a number of "eggs" are required for building
 Megatest. See the script installall.sh in the utils directory of the
 source distribution for an automated way to install everything
 needed for building Megatest on Linux.</p></div>
+<div class="paragraph"><p>Megatest. In the v1.66 and beyond assistance to create the build
+system is built into the Makefile.</p></div>
+<div class="listingblock">
+<div class="title">Installation steps (overview)</div>
+<div class="content monospaced">
+<pre>./configure
+make chicken
+setup.sh make -j install</pre>
+</div></div>
+<div class="paragraph"><p>Or install the needed build system manually:</p></div>
+<div class="olist arabic"><ol class="arabic">
+<li>
+<p>
+Chicken scheme from <a href="http://call-cc.org">http://call-cc.org</a>
+</p>
+</li>
+<li>
+<p>
+IUP from <a href="http://webserver2.tecgraf.puc-rio.br/iup/">http://webserver2.tecgraf.puc-rio.br/iup/</a>
+</p>
+</li>
+<li>
+<p>
+CD from <a href="http://webserver2.tecgraf.puc-rio.br/cd/">http://webserver2.tecgraf.puc-rio.br/cd/</a>
+</p>
+</li>
+<li>
+<p>
+IM from <a href="https://webserver2.tecgraf.puc-rio.br/im/">https://webserver2.tecgraf.puc-rio.br/im/</a>
+</p>
+</li>
+<li>
+<p>
+ffcall from <a href="http://webserver2.tecgraf.puc-rio.br/iup/">http://webserver2.tecgraf.puc-rio.br/iup/</a>
+</p>
+</li>
+<li>
+<p>
+Nanomsg from <a href="https://nanomsg.org/">https://nanomsg.org/</a> (NOTE: Plan is to eliminate nanomsg dependency).
+</p>
+</li>
+<li>
+<p>
+Needed eggs (look at the eggs lists in the Makefile)
+</p>
+</li>
+</ol></div>
+<div class="paragraph"><p>Then follow these steps:</p></div>
+<div class="listingblock">
+<div class="title">Installation steps (self-built chicken scheme build system)</div>
+<div class="content monospaced">
+<pre>./configure
+make -j install</pre>
+</div></div>
 </div>
 </div>
 </div>
 <div class="sect1">
 <h2 id="_getting_started">Getting Started</h2>
@@ -1401,10 +1927,136 @@
 <div class="paragraph"><p>This test runs a single step called "stepname1" which runs a script
 "stepname.sh". Note that although it is common to put the actions
 needed for a test step into a script it is not necessary.</p></div>
 </div>
 </div>
+</div>
+<div class="sect1">
+<h2 id="_debugging">Debugging</h2>
+<div class="sectionbody">
+<div class="sect2">
+<h3 id="_a_word_on_bisecting">A word on Bisecting</h3>
+<div class="paragraph"><p>Bisecting is a debug strategy intended to speed up finding the root
+cause.</p></div>
+<div class="imageblock graphviz">
+<div class="content">
+<img src="bisecting.png" alt="bisecting.png">
+</div>
+<div class="title">Figure 1. A complex process with a problem found in stage "E"</div>
+</div>
+<div class="paragraph"><p>It is common to start debugging where the problem was observed and
+then work back. However by inspecting the output at stage "C" in the
+example above you would potentially save a lot of debug effort, this
+is similar to the feature in source control tools like git and fossil
+called biseceting.</p></div>
+<div class="paragraph"><p>To know where to look for problems you will want to look at the log files at various stages in the execution process.</p></div>
+<div class="imageblock graphviz">
+<div class="content">
+<img src="megatest-test-stages.png" alt="megatest-test-stages.png">
+</div>
+<div class="title">Figure 2. A simplified diagram of the stages Megatest goes through to run a test.</div>
+</div>
+<table class="tableblock frame-topbot grid-all"
+style="
+width:80%;
+">
+<caption class="title">Table 2. How to check variable values and inspect logs at each stage</caption>
+<col style="width:20%;">
+<col style="width:40%;">
+<col style="width:40%;">
+<thead>
+<tr>
+<th class="tableblock halign-left valign-top" >Stage                      </th>
+<th class="tableblock halign-left valign-top" > How to inspect                               </th>
+<th class="tableblock halign-left valign-top" > Watch for</th>
+</tr>
+</thead>
+<tbody>
+<tr>
+<td class="tableblock halign-left valign-top" ><p class="tableblock">A: post config processing</p></td>
+<td class="tableblock halign-left valign-top" ><p class="tableblock monospaced">megatest -show-config -target your/target</p></td>
+<td class="tableblock halign-left valign-top" ><p class="tableblock monospaced">#f (failed var processing)</p></td>
+</tr>
+<tr>
+<td class="tableblock halign-left valign-top" ><p class="tableblock">B: post runconfig</p></td>
+<td class="tableblock halign-left valign-top" ><p class="tableblock monospaced">megatest -show-runconfig -target your/target</p></td>
+<td class="tableblock halign-left valign-top" ><p class="tableblock monospaced"></p></td>
+</tr>
+<tr>
+<td class="tableblock halign-left valign-top" ><p class="tableblock">C: processing testconfigs</p></td>
+<td class="tableblock halign-left valign-top" ><p class="tableblock monospaced">inspect output from "megatest -run &#8230;"</p></td>
+<td class="tableblock halign-left valign-top" ><p class="tableblock monospaced">Messages indicating issues process configs, dependency problems.</p></td>
+</tr>
+<tr>
+<td class="tableblock halign-left valign-top" ><p class="tableblock">D: process testconfig for test launch</p></td>
+<td class="tableblock halign-left valign-top" ><p class="tableblock monospaced">inspect output from megatest runner</p></td>
+<td class="tableblock halign-left valign-top" ><p class="tableblock monospaced">Zero items (items expansion yielded no items)</p></td>
+</tr>
+<tr>
+<td class="tableblock halign-left valign-top" ><p class="tableblock">E,F: launching test</p></td>
+<td class="tableblock halign-left valign-top" ><p class="tableblock monospaced">start test xterm, look at mt_launch.log</p></td>
+<td class="tableblock halign-left valign-top" ><p class="tableblock monospaced">Did your batch system accept the job? Has the job landed on a machine?</p></td>
+</tr>
+<tr>
+<td class="tableblock halign-left valign-top" ><p class="tableblock">G: starting test</p></td>
+<td class="tableblock halign-left valign-top" ><p class="tableblock monospaced">look at your batch systems logs for the process</p></td>
+<td class="tableblock halign-left valign-top" ><p class="tableblock monospaced">Did the megatest -execute process start and run?</p></td>
+</tr>
+<tr>
+<td class="tableblock halign-left valign-top" ><p class="tableblock">H,H1,H2: step exectution</p></td>
+<td class="tableblock halign-left valign-top" ><p class="tableblock monospaced">look at &lt;stepname&gt;.log, &lt;stepname&gt;.html and your own internal logs</p></td>
+<td class="tableblock halign-left valign-top" ><p class="tableblock monospaced">Do you have sufficiently tight logpro rules? You must always have a "required" rule!</p></td>
+</tr>
+</tbody>
+</table>
+</div>
+<div class="sect2">
+<h3 id="_examining_the_test_logs_and_environment">Examining The Test Logs and Environment</h3>
+<div class="sect3">
+<h4 id="_test_control_panel_xterm">Test Control Panel - xterm</h4>
+<div class="paragraph"><p>From the dashboard click on a test PASS/FAIL button. This brings up a
+test control panel. Aproximately near the center left of the window
+there is a button "Start Xterm". Push this to get an xterm with the
+full context and environment loaded for that test. You can run scripts
+or ezsteps by copying from the testconfig (hint, load up the
+testconfig in a separate text editor window).</p></div>
+<div class="paragraph"><p>With more recent versions of Megatest you can step through your test
+from the test control panel. Click on the cell labeled "rerun this
+step" to only rerun the step or click on "restart from here" to rerun
+that step and downstream steps.</p></div>
+<div class="paragraph"><p>NOTE 1: visual feedback can take some time, give it a few seconds and
+you will see the step change color to blue as it starts running.</p></div>
+<div class="paragraph"><p>NOTE 2: steping through only works if you are using ezsteps.</p></div>
+</div>
+<div class="sect3">
+<h4 id="_config_file_processing">Config File Processing</h4>
+<div class="paragraph"><p>As described above it is often helpful to know the content of
+variables in various contexts as Megatest works through the actions
+needed to run your tests. A handy technique is to force the startup of
+an xterm in the context being examined.</p></div>
+<div class="paragraph"><p>For example, if an item list is not being generated as expected you
+can inject the startup of an xterm as if it were an item:</p></div>
+<div class="listingblock">
+<div class="title">Original items table</div>
+<div class="content monospaced">
+<pre>[items]
+CELLNAME [system getcellname.sh]</pre>
+</div></div>
+<div class="listingblock">
+<div class="title">Items table modified for debug</div>
+<div class="content monospaced">
+<pre>[items]
+DEBUG [system xterm]
+CELLNAME [system getcellnames.sh]</pre>
+</div></div>
+<div class="paragraph"><p>When this test is run an xterm will pop up. In that xterm the
+environment is exactly that in which the script "getcellnames.sh"
+would run. You can now debug the script to find out why it isn&#8217;t
+working as expected.</p></div>
+</div>
+</div>
+</div>
 </div>
 <div class="sect1">
 <h2 id="_how_to_do_things">How To Do Things</h2>
 <div class="sectionbody">
 <div class="sect2">
@@ -1496,14 +2148,14 @@
 </div></div>
 </div>
 </div>
 </div>
 <div class="sect1">
-<h2 id="_tricks">Tricks</h2>
+<h2 id="_tricks_and_tips">Tricks and Tips</h2>
 <div class="sectionbody">
-<div class="paragraph"><p>This section is a compendium of a various useful tricks for debugging,
-configuring and generally getting the most out of Megatest.</p></div>
+<div class="paragraph"><p>This section is a collection of a various useful tricks for that
+didn&#8217;t quite fit elsewhere.</p></div>
 <div class="sect2">
 <h3 id="_limiting_your_running_jobs">Limiting your running jobs</h3>
 <div class="paragraph"><p>The following example will limit a test in the jobgroup "group1" to no more than 10 tests simultaneously.</p></div>
 <div class="paragraph"><p>In your testconfig:</p></div>
 <div class="listingblock">
@@ -1516,49 +2168,10 @@
 <div class="content monospaced">
 <pre>[jobgroups]
 group1 10
 custdes 4</pre>
 </div></div>
-</div>
-</div>
-</div>
-<div class="sect1">
-<h2 id="_debugging_tricks">Debugging Tricks</h2>
-<div class="sectionbody">
-<div class="sect2">
-<h3 id="_examining_the_environment">Examining The Environment</h3>
-<div class="sect3">
-<h4 id="_test_control_panel_xterm">Test Control Panel - xterm</h4>
-<div class="paragraph"><p>From the dashboard click on a test PASS/FAIL button. This brings up a test control panel. Aproximately near the center left of the
-window there is a button "Start Xterm". Push this to get an xterm with the full context and environment loaded for that test. You can run
-scripts or ezsteps by copying from the testconfig (hint, load up the testconfig in a separate gvim or emacs window). This is the easiest way
-to debug your tests.</p></div>
-</div>
-<div class="sect3">
-<h4 id="_during_config_file_processing">During Config File Processing</h4>
-<div class="paragraph"><p>It is often helpful to know the content of variables in various
-contexts as Megatest does the actions needed to run your tests. A handy technique is to force the startup of an xterm in the context being examined.</p></div>
-<div class="paragraph"><p>For example, if an item list is not being generated as expected you
-can inject the startup of an xterm as if it were an item:</p></div>
-<div class="listingblock">
-<div class="title">Original items table</div>
-<div class="content monospaced">
-<pre>[items]
-CELLNAME [system getcellname.sh]</pre>
-</div></div>
-<div class="listingblock">
-<div class="title">Items table modified for debug</div>
-<div class="content monospaced">
-<pre>[items]
-DEBUG [system xterm]
-CELLNAME [system getcellnames.sh]</pre>
-</div></div>
-<div class="paragraph"><p>When this test is run an xterm will pop up. In that xterm the
-environment is exactly that in which the script "getcellnames.sh"
-would run. You can now debug the script to find out why it isn&#8217;t
-working as expected.</p></div>
-</div>
 <div class="sect3">
 <h4 id="_organising_your_tests_and_tasks">Organising Your Tests and Tasks</h4>
 <div class="paragraph"><p>The default location "tests" for storing tests can be extended by
 adding to your tests-paths section.</p></div>
 <div class="listingblock">
@@ -1608,11 +2221,11 @@
 <h3 id="_megatest_use_modes">Megatest Use Modes</h3>
 <table class="tableblock frame-topbot grid-all"
 style="
 width:80%;
 ">
-<caption class="title">Table 2. Base commands</caption>
+<caption class="title">Table 3. Base commands</caption>
 <col style="width:20%;">
 <col style="width:40%;">
 <col style="width:40%;">
 <thead>
 <tr>
@@ -1670,11 +2283,11 @@
 <div class="paragraph"><p>Various helpers for more advanced config files.</p></div>
 <table class="tableblock frame-topbot grid-all"
 style="
 width:80%;
 ">
-<caption class="title">Table 3. Helpers</caption>
+<caption class="title">Table 4. Helpers</caption>
 <col style="width:14%;">
 <col style="width:28%;">
 <col style="width:28%;">
 <col style="width:28%;">
 <thead>
@@ -1797,14 +2410,26 @@
 free-space-script check-space.sh</pre>
 </div></div>
 </div>
 <div class="sect2">
 <h3 id="_trim_trailing_spaces">Trim trailing spaces</h3>
+<div class="admonitionblock">
+<table><tr>
+<td class="icon">
+<img src="/usr/images/icons/note.png" alt="Note">
+</td>
+<td class="content">As of Megatest version v1.6548 trim-trailing-spaces defaults to yes.</td>
+</tr></table>
+</div>
 <div class="listingblock">
 <div class="content monospaced">
-<pre>[configf:settings trim-trailing-spaces yes]</pre>
+<pre>[configf:settings trim-trailing-spaces no]
+#                 |&lt;== next line padded with spaces to here
+DEFAULT_INDENT
+[configf:settings trim-trailing-spaces no]</pre>
 </div></div>
+<div class="paragraph"><p>The variable DEFAULT_INDENT would be a string of 3 spaces</p></div>
 </div>
 <div class="sect2">
 <h3 id="_job_submission_control">Job Submission Control</h3>
 <div class="sect3">
 <h4 id="_submit_jobs_to_host_types_based_on_test_name_2">Submit jobs to Host Types based on Test Name</h4>
@@ -1867,10 +2492,25 @@
 <div class="content monospaced">
 <pre>[setup]
 # this will automatically kill the test if it runs for more than 1h 2m and 3s
 runtimelim 1h 2m 3s</pre>
 </div></div>
+</div>
+<div class="sect4">
+<h5 id="_post_run_hook">Post Run Hook</h5>
+<div class="paragraph"><p>This runs script to-run.sh after all tests have been completed. It is
+not necessary to use -run-wait as each test will check for other
+running tests on completion and if there are none it will call the
+post run hook.</p></div>
+<div class="paragraph"><p>Note that the output from the script call will be placed in a log file
+in the logs directory with a file name derived by replacing / with _
+in post-hook-&lt;target&gt;-&lt;runname&gt;.log.</p></div>
+<div class="listingblock">
+<div class="content monospaced">
+<pre>[runs]
+post-hook /path/to/script/to-run.sh</pre>
+</div></div>
 </div>
 </div>
 </div>
 <div class="sect2">
 <h3 id="_tests_browser_view">Tests browser view</h3>
@@ -1943,11 +2583,11 @@
 <h3 id="_database_settings">Database settings</h3>
 <table class="tableblock frame-topbot grid-all"
 style="
 width:70%;
 ">
-<caption class="title">Table 4. Database config settings in [setup] section of megatest.config</caption>
+<caption class="title">Table 5. Database config settings in [setup] section of megatest.config</caption>
 <col style="width:14%;">
 <col style="width:28%;">
 <col style="width:28%;">
 <col style="width:28%;">
 <thead>
@@ -2087,10 +2727,35 @@
 <div class="content monospaced">
 <pre># A normal waiton waits for the prior tests to be COMPLETED
 # and PASS, CHECK or WAIVED
 waiton test1 test2</pre>
 </div></div>
+<div class="admonitionblock">
+<table><tr>
+<td class="icon">
+<img src="/usr/images/icons/note.png" alt="Note">
+</td>
+<td class="content">Dynamic waiton lists must be capable of being calculated at the
+beginning of a run. This is because Megatest walks the tree of waitons
+to create the list of tests to execute.</td>
+</tr></table>
+</div>
+<div class="listingblock">
+<div class="title">This works</div>
+<div class="content monospaced">
+<pre>waiton [system somescript.sh]</pre>
+</div></div>
+<div class="listingblock">
+<div class="title">This does NOT work (the full context for the test is not available so #{shell &#8230;} is NOT enabled to evaluate.</div>
+<div class="content monospaced">
+<pre>waiton #{shell somescript.sh}</pre>
+</div></div>
+<div class="listingblock">
+<div class="title">This does NOT work</div>
+<div class="content monospaced">
+<pre>waiton [system somescript_that_depends_on_a_prior_test.sh]</pre>
+</div></div>
 </div>
 <div class="sect2">
 <h3 id="_mode">Mode</h3>
 <div class="paragraph"><p>The default (i.e. if mode is not specified) is normal. All pre-dependent tests
 must be COMPLETED and PASS, CHECK or WAIVED before the test will start</p></div>
@@ -2363,13 +3028,19 @@
 megatest.config. This can be used to allocate disks on a per-test or per item
 basis.</p></div>
 </div>
 <div class="sect2">
 <h3 id="_controlled_waiver_propagation">Controlled waiver propagation</h3>
-<div class="paragraph"><p>If test is FAIL and previous test in run with same MT_TARGET is WAIVED then apply the following rules from the testconfig:
-If a waiver check is specified in the testconfig apply the check and if it passes then set this FAIL to WAIVED</p></div>
-<div class="paragraph"><p>Waiver check has two parts, 1) a list of waiver, rulename, filepatterns and 2) the rulename script spec (note that "diff" and "logpro" are predefined)</p></div>
+<div class="paragraph"><p>If test is FAIL and previous test in run with same MT_TARGET is WAIVED
+or if the test/itempath is listed under the matching target in the
+waivers roll forward file (see below for file spec) then apply the
+following rules from the testconfig: If a waiver check is specified in
+the testconfig apply the check and if it passes then set this FAIL to
+WAIVED</p></div>
+<div class="paragraph"><p>Waiver check has two parts, 1) a list of waiver, rulename,
+filepatterns and 2) the rulename script spec (note that "diff" and
+"logpro" are predefined)</p></div>
 <div class="listingblock">
 <div class="content monospaced">
 <pre>###### EXAMPLE FROM testconfig #########
 # matching file(s) will be diff'd with previous run and logpro applied
 # if PASS or WARN result from logpro then WAIVER state is set
@@ -2384,13 +3055,50 @@
 # diff   diff %file1% %file2%
 
 # This builtin rule is applied if a &lt;waivername&gt;.logpro file exists
 # logpro diff %file1% %file2% | logpro %waivername%.logpro %waivername%.html</pre>
 </div></div>
+<div class="sect3">
+<h4 id="_waiver_roll_forward_files">Waiver roll-forward files</h4>
+<div class="paragraph"><p>To transfer waivers from one Megatest area to another it is possible
+to dump waivers into a file and reference that file in another area.</p></div>
+<div class="listingblock">
+<div class="title">Dumping the waivers</div>
+<div class="content monospaced">
+<pre>megatest -list-waivers -runname %-a &gt; mywaivers.dat</pre>
+</div></div>
+<div class="listingblock">
+<div class="title">Referencing the saved waivers</div>
+<div class="content monospaced">
+<pre># In megatest.config, all files listed will be loaded - recomended to use
+# variables to select directorys to minimize what gets loaded.
+[setup]
+waivers-dirs /path/to/waiver/files /another/path/to/waiver/files</pre>
+</div></div>
+<div class="listingblock">
+<div class="title">Waiver files format</div>
+<div class="content monospaced">
+<pre>[the/target/here]
+# comments are fine
+testname1/itempath A comment about why it was waived
+testname2          A comment for a non-itemized test</pre>
+</div></div>
+</div>
 </div>
 <div class="sect2">
 <h3 id="_ezsteps">Ezsteps</h3>
+<div class="paragraph"><p>Ezsteps is the recommended way to implement tests and automation in
+Megatest.</p></div>
+<div class="admonitionblock">
+<table><tr>
+<td class="icon">
+<img src="/usr/images/icons/note.png" alt="Note">
+</td>
+<td class="content">Each ezstep must be a single line. Use the [scripts] mechanism
+to create multiline scripts (see example below).</td>
+</tr></table>
+</div>
 <div class="listingblock">
 <div class="title">Example ezsteps with logpro rules</div>
 <div class="content monospaced">
 <pre>[ezsteps]
 lookittmp   ls /tmp
@@ -2398,16 +3106,72 @@
 [logpro]
 lookittmp ;; Note: config file format supports multi-line entries where leading whitespace is removed from each line
   ;;     a blank line indicates the end of the block of text
   (expect:required in "LogFileBody" &gt; 0 "A file name that should never exist!" #/This is a awfully stupid file name that should never be found in the temp dir/)</pre>
 </div></div>
-<div class="paragraph"><p>To transfer the environment to the next step you can do the following:</p></div>
+<div class="sect3">
+<h4 id="_automatic_environment_propagation_with_ezsteps">Automatic environment propagation with Ezsteps</h4>
+<div class="paragraph"><p>Turn on ezpropvars and environment variables will be propagated from
+step to step. Use this to source script files that modify the
+envionment where the modifications are needed in subsequent steps.</p></div>
+<div class="admonitionblock">
+<table><tr>
+<td class="icon">
+<img src="/usr/images/icons/note.png" alt="Note">
+</td>
+<td class="content">aliases and variables with strange whitespace or characters will
+not propagate correctly. Put in a ticket on the
+<a href="http://www.kiatoa.com/fossils/megatest">http://www.kiatoa.com/fossils/megatest</a> site if you need support for a
+specific strange character combination.</td>
+</tr></table>
+</div>
+<div class="listingblock">
+<div class="title">Turn on auto propagate for bash</div>
+<div class="content monospaced">
+<pre>[setup]
+ezpropvars sh</pre>
+</div></div>
+<div class="listingblock">
+<div class="title">Write your ezsteps. The loadenv.csh step will use /bin/csh as its shell, other steps will use bash.</div>
+<div class="content monospaced">
+<pre>[ezsteps]
+loadenv.csh source $REF/ourenviron.csh
+compile make
+install make install</pre>
+</div></div>
+<div class="paragraph"><p>Bash and csh are supported. You can override the shell binary location
+from the default /bin/bash and /bin/csh if needed.</p></div>
+<div class="listingblock">
+<div class="title">Turn on auto propagate for csh</div>
+<div class="content monospaced">
+<pre>[setup]
+ezpropvars csh /bin/csh</pre>
+</div></div>
+<div class="listingblock">
+<div class="title">Example of auto propagation using extensions</div>
+<div class="content monospaced">
+<pre>[ezsteps]
+step1.sh export SOMEVAR=$(ps -def | wc -l);ls /tmp
+# The next step will get the value of $SOMEVAR from step1.sh
+step2.sh echo $SOMEVAR</pre>
+</div></div>
 <div class="listingblock">
-<div class="title">Propagate environment to next step</div>
+<div class="title">Example of multi-line script</div>
 <div class="content monospaced">
-<pre>$MT_MEGATEST -env2file .ezsteps/${stepname}</pre>
+<pre>[scripts]
+tarresults tar cfvz $DEST/srcdir1.tar.gz srcdir1
+  tar cfvz $DEST/srcdir2.tar.gz srcdir2
+
+[setup]
+ezpropvars sh
+
+[ezsteps]
+step1 DEST=/tmp/targz;source tarresults</pre>
 </div></div>
+<div class="paragraph"><p>The above example will result in files; tarresults and ez_step1 being
+created in the test dir.</p></div>
+</div>
 </div>
 <div class="sect2">
 <h3 id="_scripts">Scripts</h3>
 <div class="listingblock">
 <div class="title">Specifying scripts inline (best used for only simple scripts)</div>
@@ -2538,11 +3302,11 @@
 COMPLETED/ xterm -e bash -s --</pre>
 </div></div>
 <div class="admonitionblock">
 <table><tr>
 <td class="icon">
-<img src="/nfs/pdx/disks/ice.disk.002/icfadm/pkgs/asciidoc/8.6.7/images/icons/note.png" alt="Note">
+<img src="/usr/images/icons/note.png" alt="Note">
 </td>
 <td class="content">There is a trailing space after the double-dash</td>
 </tr></table>
 </div>
 <div class="paragraph"><p>There are a number of environment variables available to the trigger script
@@ -2551,11 +3315,11 @@
 fail gracefully if it doesn&#8217;t exist.</p></div>
 <table class="tableblock frame-topbot grid-all"
 style="
 width:90%;
 ">
-<caption class="title">Table 5. Environment variables visible to the trigger script</caption>
+<caption class="title">Table 6. Environment variables visible to the trigger script</caption>
 <col style="width:50%;">
 <col style="width:50%;">
 <thead>
 <tr>
 <th class="tableblock halign-left valign-top" > Variable            </th>
@@ -2785,11 +3549,11 @@
 <div class="paragraph"><p>These routines can be called from the megatest repl.</p></div>
 <table class="tableblock frame-topbot grid-all"
 style="
 width:70%;
 ">
-<caption class="title">Table 6. API Keys Related Calls</caption>
+<caption class="title">Table 7. API Keys Related Calls</caption>
 <col style="width:14%;">
 <col style="width:28%;">
 <col style="width:28%;">
 <col style="width:28%;">
 <thead>
@@ -2816,372 +3580,56 @@
 <td class="tableblock halign-left valign-top" ><p class="tableblock monospaced"></p></td>
 </tr>
 </tbody>
 </table>
 </div>
+</div>
+<div class="sect1">
+<h2 id="_test_plan">Test Plan</h2>
+<div class="sectionbody">
+<div class="sect2">
+<h3 id="_tests">Tests</h3>
+<div class="paragraph"><p>itemwait|33</p></div>
+<div class="paragraph"><p>rerun-downstream-item|20</p></div>
+<div class="paragraph"><p>rerunclean|20</p></div>
+<div class="paragraph"><p>fullrun|18</p></div>
+<div class="paragraph"><p>goodtests|18</p></div>
+<div class="paragraph"><p>kill-rerun|17</p></div>
+<div class="paragraph"><p>items-runconfigvars|16</p></div>
+<div class="paragraph"><p>ro_test|16</p></div>
+<div class="paragraph"><p>runconfig-tests|16</p></div>
+<div class="paragraph"><p>env-pollution|13</p></div>
+<div class="paragraph"><p>itemmap|11</p></div>
+<div class="paragraph"><p>testpatt_envvar|10</p></div>
+<div class="paragraph"><p>toprun|10</p></div>
+<div class="paragraph"><p>chained-waiton|8</p></div>
+<div class="paragraph"><p>skip-on-fileexists|8</p></div>
+<div class="paragraph"><p>killrun_preqfail|7</p></div>
+<div class="paragraph"><p>subrun|6</p></div>
+<div class="paragraph"><p>dependencies|5</p></div>
+<div class="paragraph"><p>itemwait-simple|4</p></div>
+<div class="paragraph"><p>rollup|4</p></div>
+<div class="paragraph"><p>end-of-run|3</p></div>
+<div class="paragraph"><p>killrun|3</p></div>
+<div class="paragraph"><p>listener|3</p></div>
+<div class="paragraph"><p>test2|3</p></div>
+<div class="paragraph"><p>testpatt|3</p></div>
+<div class="paragraph"><p>env-pollution-usecacheno|2</p></div>
+<div class="paragraph"><p>set-values|2
+envvars|1
+listruns-tests|1
+subrun-usecases|1</p></div>
+</div>
+</div>
 </div>
 <div class="sect1">
 <h2 id="_megatest_internals">Megatest Internals</h2>
 <div class="sectionbody">
 <div class="imageblock graphviz">
 <div class="content">
 <img src="server.png" alt="server.png">
 </div>
-</div>
-</div>
-</div>
-<div class="sect1">
-<h2 id="_road_map">Road Map</h2>
-<div class="sectionbody">
-<div class="paragraph"><p>Note 1: This road-map continues to evolve and subject to change without notice.</p></div>
-<div class="sect2">
-<h3 id="_here_is_a_smattering_of_ideas_for_megatest_2_0">Here is a smattering of ideas for Megatest 2.0</h3>
-<div class="olist arabic"><ol class="arabic">
-<li>
-<p>
-Add variable $MT_RUNPATH = $MT_LINKTREE/$MT_TARGET/$MT_RUNNAME
-</p>
-</li>
-</ol></div>
-<div class="listingblock">
-<div class="content monospaced">
-<pre>[db]
-api legacy|new</pre>
-</div></div>
-<div class="olist arabic"><ol class="arabic">
-<li>
-<p>
-One big lesson from the 1.63-1.65 generation was that the main.db, 1.db … model was really good at scaling. I’d like to combine that model with the current also-very-good model. Obviously this is a disruptive change. I think making the old model the default and the new model an option for at least one generation would be fair.
-</p>
-</li>
-<li>
-<p>
-Rigorous megatest.config and runconfig.config caching.
-</p>
-<div class="olist loweralpha"><ol class="loweralpha">
-<li>
-<p>
-Cache the configs in $MT_RUNPATH
-</p>
-</li>
-<li>
-<p>
-Following invocations of –run, -rerun* will calculate the new config but only overwrite the cached file IF changed
-</p>
-</li>
-</ol></div>
-</li>
-<li>
-<p>
-If the cached file changes ALL existing tests go from COMPLETED &#8594; STALE, I’m not sure what to do about RUNNING tests
-</p>
-</li>
-<li>
-<p>
-!VARS in runconfigs are not exported to the environment. They are accessed via rget as if the ! was not there.
-</p>
-</li>
-<li>
-<p>
-Per test copy commands (crude example below is not correct).
-</p>
-</li>
-</ol></div>
-<div class="listingblock">
-<div class="content monospaced">
-<pre>[testcopy]
-%/iind% unison SRC DEST
-% cp –r SRC DEST</pre>
-</div></div>
-<div class="olist arabic"><ol class="arabic">
-<li>
-<p>
-Test management via pkts (optional?)
-</p>
-<div class="olist loweralpha"><ol class="loweralpha">
-<li>
-<p>
-Control pkt types: run, kill, rerunclean, clean, archive, status?
-</p>
-</li>
-<li>
-<p>
-Status pkt types: ack, step, status_change
-</p>
-</li>
-</ol></div>
-</li>
-<li>
-<p>
-Add nanomsg as a transport option
-.
-</p>
-</li>
-</ol></div>
-</div>
-<div class="sect2">
-<h3 id="_rfc_m01_add_ability_to_move_runs_to_other_areas">RFC M01: Add ability to move runs to other Areas</h3>
-<div class="paragraph"><p><strong>Purpose</strong>: allow shrinking megatest.db data by moving runs to an alternate
- Megatest area with same keys.</p></div>
-<div class="paragraph"><p><strong>Method</strong>: extend db sync to take a different megatest area as a destination.</p></div>
-<div class="paragraph"><p><strong>Design</strong>:</p></div>
-<div class="olist arabic"><ol class="arabic">
-<li>
-<p>
-add param -destination [area|path]. when specified runs are copied to new
-  area and removed from local db.
-</p>
-</li>
-<li>
-<p>
-the data move would involve these steps
-</p>
-<div class="olist loweralpha"><ol class="loweralpha">
-<li>
-<p>
-copy the run data to destination area megatest.db
-</p>
-</li>
-<li>
-<p>
-mark the run records as deleted, do not remove the run data on disk
-</p>
-</li>
-</ol></div>
-</li>
-<li>
-<p>
-accessing the data would be by running dashboard in the satellite area
-</p>
-</li>
-<li>
-<p>
-future versions of Megatest dashboard should support displaying areas in a
-  merged way.
-</p>
-</li>
-<li>
-<p>
-some new controls would be supported in the config
-</p>
-<div class="olist loweralpha"><ol class="loweralpha">
-<li>
-<p>
-[setup] &#8658; allow-runs [no|yes]  &#8656;= used to disallow runs
-</p>
-</li>
-<li>
-<p>
-[setup] &#8658; auto-migrate=[areaname|path]  &#8656;= used to automatically
-   migrate data to a satellite area.
-</p>
-</li>
-</ol></div>
-</li>
-</ol></div>
-<div class="paragraph"><p><strong>Branch</strong>: This work is taking place on branch v1.65-reduce-records</p></div>
-</div>
-<div class="sect2">
-<h3 id="_rfc_m02_move_data_into_completed_runs_db">RFC M02: Move data into completed-runs.db</h3>
-<div class="paragraph"><p><strong>Purpose</strong>: shrink megatest.db data to enable lower load and higher performance.</p></div>
-<div class="paragraph"><p><strong>Method</strong>: add a completed-runs.db and automatically move runs data from megatest.db to that db</p></div>
-<div class="paragraph"><p><strong>Design</strong>:</p></div>
-<div class="olist arabic"><ol class="arabic">
-<li>
-<p>
-completed-runs.db is a full megatest database with complete schema
-</p>
-</li>
-<li>
-<p>
-the data move would involve these steps
-</p>
-<div class="olist loweralpha"><ol class="loweralpha">
-<li>
-<p>
-copy the run data to completed-runs.db
-</p>
-</li>
-<li>
-<p>
-remove the run data, first from /tmp/…/megatest.db and /tmp/…/megatest_ref.db, followed by megatest.db
-</p>
-</li>
-</ol></div>
-</li>
-<li>
-<p>
-accessing the data would be unchanged for most operations.
-</p>
-</li>
-<li>
-<p>
-a mode -full-db will be added which when specified would attach the completed-runs.db to megatest.db before doing the query
-</p>
-</li>
-<li>
-<p>
-mechanisms for moving runs to/from the megatest.db would be added
-</p>
-<div class="olist loweralpha"><ol class="loweralpha">
-<li>
-<p>
--reduce-records &#8658; move runs to completed-runs.db
-</p>
-</li>
-<li>
-<p>
--restore-records &#8658; move runs from completed-runs.db to megatest.db
-</p>
-</li>
-</ol></div>
-</li>
-</ol></div>
-<div class="paragraph"><p><strong>Branch</strong>: This work is taking place on branch v1.65-reduce-records</p></div>
-</div>
-<div class="sect2">
-<h3 id="_rfc_m03_automatic_homehost_migrations">RFC M03: Automatic homehost migrations</h3>
-<div class="paragraph"><p><strong>Purpose</strong>: Automatically migrate homehost.</p></div>
-<div class="paragraph"><p><strong>Method</strong>: Check that there are no tests running, launched or remotehoststart in past ½ hour then if not on homehost migrate the db to current host</p></div>
-<div class="paragraph"><p><strong>Design</strong>:</p></div>
-<div class="olist arabic"><ol class="arabic">
-<li>
-<p>
-Check that the system is quiescent, i.e. that there are no runs in flight or recently run
-</p>
-</li>
-<li>
-<p>
-Create a lock
-</p>
-</li>
-<li>
-<p>
-Migrate the /tmp cache db to the current host
-</p>
-</li>
-<li>
-<p>
-Update the .homehost file
-</p>
-</li>
-<li>
-<p>
-Remove the lock
-</p>
-</li>
-</ol></div>
-<div class="paragraph"><p><strong>Branch</strong>: This work not yet started</p></div>
-</div>
-<div class="sect2">
-<h3 id="_architecture_refactor">Architecture Refactor</h3>
-<div class="sect3">
-<h4 id="_goals">Goals</h4>
-<div class="olist arabic"><ol class="arabic">
-<li>
-<p>
-Reduce load on the file system. Sqlite3 files on network filesystem can be
-  a burden. <span class="green">[DONE]</span>
-</p>
-</li>
-<li>
-<p>
-Reduce number of servers and frequency of start/stop. This is mostly an
-  issue of clutter but also a reduction in "moving parts". <span class="green">[DONE]</span>
-</p>
-</li>
-<li>
-<p>
-Coalesce activities to a single home host where possible. Give the user
-  feedback that they have started the dashboard on a host other than the
-  home host. <span class="green">[DONE]</span>
-</p>
-</li>
-<li>
-<p>
-Reduce number of processes involved in managing running tests.
-</p>
-</li>
-</ol></div>
-</div>
-<div class="sect3">
-<h4 id="_changes_needed">Changes Needed</h4>
-<div class="olist arabic"><ol class="arabic">
-<li>
-<p>
-ACID compliant db will be on /tmp and synced to megatest.db with a five
-  second max delay. <span class="green">[DONE]</span>
-</p>
-</li>
-<li>
-<p>
-Read/writes to db for processes on homehost will go direct to /tmp
-  megatest.db file. <span class="green">[DONE]</span>
-</p>
-</li>
-<li>
-<p>
-Read/wites fron non-homehost processes will go through one server. Bulk
-  reads (e.g. for dashboard or list-runs) will be cached on the current host
-  in /tmp and synced from the home megatest.db in the testsuite area. <span class="green">[DONE]</span>
-</p>
-</li>
-<li>
-<p>
-Db syncs rely on the target db file timestame minus some margin. <span class="green">[DONE]</span>
-</p>
-</li>
-<li>
-<p>
-Since bulk reads do not use the server we can switch to simple RPC for the
-  network transport. <span class="green">[DONE]</span>
-</p>
-</li>
-<li>
-<p>
-Test running manager process extended to manage multiple running tests.
-</p>
-</li>
-</ol></div>
-</div>
-</div>
-<div class="sect2">
-<h3 id="_current_items">Current Items</h3>
-<div class="sect3">
-<h4 id="_ww05_migrate_to_inmem_db">ww05 - migrate to inmem-db</h4>
-<div class="olist arabic"><ol class="arabic">
-<li>
-<p>
-Switch to inmem db with fast sync to on disk db&#8217;s <span class="green">[DONE]</span>
-</p>
-</li>
-<li>
-<p>
-Server polls tasks table for next action
-</p>
-<div class="olist loweralpha"><ol class="loweralpha">
-<li>
-<p>
-Task table used for tracking runner process <span class="red">[Replaced by mtutil]</span>
-</p>
-</li>
-<li>
-<p>
-Task table used for jobs to run <span class="red">[Replaced by mtutil]</span>
-</p>
-</li>
-<li>
-<p>
-Task table used for queueing runner actions (remove runs,
-   cleanRunExecute, etc)  <span class="red">[Replaced by mtutil</span>]
-</p>
-</li>
-</ol></div>
-</li>
-</ol></div>
-<div class="paragraph"><p>shifting, note that the preceding blank line is needed.</p></div>
-</div>
 </div>
 </div>
 </div>
 <div class="sect1">
 <h2 id="_index">Index</h2>
@@ -3190,11 +3638,12 @@
 </div>
 </div>
 <div id="footnotes"><hr></div>
 <div id="footer">
 <div id="footer-text">
-Version 1.0<br>
-Last updated 2020-07-22 14:21:46 PDT
+Version 1.5<br>
+Last updated
+ 2021-09-07 17:58:32 MST
 </div>
 </div>
 </body>
 </html>

ADDED   docs/manual/megatest_manual.pdf
Index: docs/manual/megatest_manual.pdf
==================================================================
--- /dev/null
+++ docs/manual/megatest_manual.pdf
cannot compute difference between binary files

Index: docs/manual/megatest_manual.txt
==================================================================
--- docs/manual/megatest_manual.txt
+++ docs/manual/megatest_manual.txt
@@ -1,9 +1,9 @@
 The Megatest Users Manual
 =========================
 Matt Welland <matt@kiatoa.com>
-v1.0, April 2012
+v1.5, June 2020
 :doctype: book
 
 
 [preface]
 Preface
@@ -11,11 +11,11 @@
 
 This book is organised as three sub-books; getting started, writing tests and reference.
 
 .License
 ----------------------------
-    Copyright 2006-2017, Matthew Welland.
+    Copyright 2006-2020, Matthew Welland.
 
     This document is part of Megatest.
 
     Megatest is free software: you can redistribute it and/or modify
     it under the terms of the GNU General Public License as published by
@@ -33,20 +33,17 @@
 ----------------------------
 
 Why Megatest?
 -------------
 
-The Megatest project was started for two reasons, the first was an
-immediate and pressing need for a generalized tool to manage a suite
-of regression tests and the second was the fact that I had written or
-maintained several such tools at different companies over the years. I
-thought a single open source tool, flexible enough to meet the needs
-of any team doing continuous integrating and or running a complex
-suite of tests for release qualification would solve some problems for
-me and for others.
-
- -- Matt Welland, original author of the Megatest tool suite.
+Megatest was created to provide a generalized tool for managing suites
+of regression tests and to provide a multi-host, distributed
+alternative to "make". The EDA world is littered with proprietory,
+company-specific tools for this purpose and by going open source and
+keeping the tool flexible the hope is that Megatest could be useful to
+any team at any company for continuous integration and almost any
+other general automation tasks.
 
 Megatest Design Philosophy
 --------------------------
 
 Megatest is a distributed system intended to provide the minimum needed
@@ -98,38 +95,44 @@
 which can launch jobs on local and remote Linux hosts. Currently
 megatest uses the network filesystem to call home to your master
 sqlite3 database. Megatest has been used with the Intel Netbatch and
 lsf (also known as openlava) batch systems and it should be
 straightforward to use it with other similar systems.
+
+// :leveloffset: 0
 
 include::overview.txt[]
 
+include::plan.txt[]
+ 
 include::installation.txt[]
 
 include::getting_started.txt[]
 
 include::study_plan.txt[]
 
-// :leveloffset: 0
-
 include::writing_tests.txt[]
+
+include::debugging.txt[]
+
 include::howto.txt[]
 
 include::reference.txt[]
 
+include::testplan.txt[]
 
 Megatest Internals
 ------------------
 
 ["graphviz", "server.png"]
 ----------------------------------------------------------------------
 include::server.dot[]
 ----------------------------------------------------------------------
 
-include::plan.txt[]
+// include::plan.txt[]
 // to allow the getting_started.txt to be a stand-alone document use level
-shifting, note that the preceding blank line is needed.
+// shifting, note that the preceding blank line is needed.
 // :leveloffset: 2
 
 
 // [appendix]
 // Example Appendix

Index: docs/manual/plan.txt
==================================================================
--- docs/manual/plan.txt
+++ docs/manual/plan.txt
@@ -1,8 +1,5 @@
-Road Map
---------
-
 // This file is part of Megatest.
 // 
 //     Megatest is free software: you can redistribute it and/or modify
 //     it under the terms of the GNU General Public License as published by
 //     the Free Software Foundation, either version 3 of the License, or
@@ -14,50 +11,81 @@
 //     GNU General Public License for more details.
 // 
 //     You should have received a copy of the GNU General Public License
 //     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
 
-// Copyright 2006-2012, Matthew Welland.
+// Copyright 2006-2020, Matthew Welland.
+
+TODO / Road Map
+---------------
+
+Note: This road-map is a wish list and not a formal plan. Items are in
+rough priority but are subject to change. Development is driven by
+user requests, developer "itch" and bug reports. Please contact
+matt@kiatoa.com with requests or bug reports. Requests from inside
+Intel generally take priority.
+
+Dashboard and runs
 
-Note 1: This road-map continues to evolve and subject to change without notice.
+. Multi-area dashboard view
 
-Here is a smattering of ideas for Megatest 2.0
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Tests Support
 
 . Add variable $MT_RUNPATH = $MT_LINKTREE/$MT_TARGET/$MT_RUNNAME
-----------------
-[db]
-api legacy|new
-----------------
-. One big lesson from the 1.63-1.65 generation was that the main.db, 1.db … model was really good at scaling. I’d like to combine that model with the current also-very-good model. Obviously this is a disruptive change. I think making the old model the default and the new model an option for at least one generation would be fair.
-.   Rigorous megatest.config and runconfig.config caching.
+. Improve [script], especially indent handling
+
+Scalability
+
+. Overflow database methodology - combine the best of the v1.63
+  multi-db approach and the current db-in-tmp approach (currently
+  slowness can be seen when number of tests in a db goes over 50-100k,
+  with the overflow db it will be able to handle 1000's of runs with
+  50-100k tests per run). High priority - goal is to complete this by
+  20Q3.
+
+Mtutils/CI
+
+. Enable mtutil calls from dashboard (for remote control)
+. Logs browser (esp. for surfacing mtutil related activities)
+. Embed ftfplan for distributed automation, completed activities trigger QA runs which trigger deployment etc.
+. Jenkins junit XML support [DONE]
+. Add output flushing in teamcity support
+
+Build system
+
+. ./configure => ubuntu, sles11, sles12, rh7 [WIP]
+. Switch to using simple runs query everywhere
+. Add end_time to runs and add a rollup call that sets state, status and end_time
+
+Code refactoring/quality/performance
+
+. Switch to scsh-process pipeline management for job execution/control
+. Use call-with-environment-variables where possible.
+
+Migration to inmem db and or overflow db
+
+. Re-work the dbstruct data structure?
+.. [ run-id.db inmemdb last-mod last-read last-sync inuse ]
+
+Some ideas for Megatest 2.0
+
+.   Aggressive megatest.config and runconfig.config caching.
 ..  Cache the configs in $MT_RUNPATH
 ..  Following invocations of –run, -rerun* will calculate the new config but only overwrite the cached file IF changed
 . If the cached file changes ALL existing tests go from COMPLETED -> STALE, I’m not sure what to do about RUNNING tests
 . !VARS in runconfigs are not exported to the environment. They are accessed via rget as if the ! was not there.
-. Per test copy commands (crude example below is not correct).
+. Per test copy commands (example is incomplete).
 ----------------
 [testcopy]
 %/iind% unison SRC DEST
 % cp –r SRC DEST
 ----------------
-.	Test management via pkts (optional?)
-..	Control pkt types: run, kill, rerunclean, clean, archive, status?
-..	Status pkt types: ack, step, status_change
-.	Add nanomsg as a transport option
-.	
-
-RFC M01: Add ability to move runs to other Areas
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-*Purpose*: allow shrinking megatest.db data by moving runs to an alternate
- Megatest area with same keys.
-
-*Method*: extend db sync to take a different megatest area as a destination.
-
-*Design*:
-
+
+Add ability to move runs to other Areas (overlaps with overflow db system)
+
+. allow shrinking megatest.db data by moving runs to an alternate
+  Megatest area with same keys.
 . add param -destination [area|path]. when specified runs are copied to new
   area and removed from local db.
 . the data move would involve these steps
 .. copy the run data to destination area megatest.db
 .. mark the run records as deleted, do not remove the run data on disk
@@ -67,166 +95,69 @@
 . some new controls would be supported in the config
 .. [setup] => allow-runs [no|yes]  <== used to disallow runs
 .. [setup] => auto-migrate=[areaname|path]  <== used to automatically
    migrate data to a satellite area.
 
-*Branch*: This work is taking place on branch v1.65-reduce-records
-
-RFC M02: Move data into completed-runs.db
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-*Purpose*: shrink megatest.db data to enable lower load and higher performance.
-
-*Method*: add a completed-runs.db and automatically move runs data from megatest.db to that db
-
-*Design*:
-
-. completed-runs.db is a full megatest database with complete schema
-. the data move would involve these steps
-.. copy the run data to completed-runs.db
-.. remove the run data, first from /tmp/…/megatest.db and /tmp/…/megatest_ref.db, followed by megatest.db
-. accessing the data would be unchanged for most operations.
-. a mode -full-db will be added which when specified would attach the completed-runs.db to megatest.db before doing the query
-. mechanisms for moving runs to/from the megatest.db would be added
-.. -reduce-records => move runs to completed-runs.db
-.. -restore-records => move runs from completed-runs.db to megatest.db
-
-*Branch*: This work is taking place on branch v1.65-reduce-records
-
-RFC M03: Automatic homehost migrations
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-*Purpose*: Automatically migrate homehost.
-
-*Method*: Check that there are no tests running, launched or remotehoststart in past ½ hour then if not on homehost migrate the db to current host
-
-*Design*:
-
-. Check that the system is quiescent, i.e. that there are no runs in flight or recently run
-. Create a lock
-. Migrate the /tmp cache db to the current host
-. Update the .homehost file
-. Remove the lock
-
-*Branch*: This work not yet started
-
-Architecture Refactor
-~~~~~~~~~~~~~~~~~~~~~
-
-Goals
-^^^^^
-
-. Reduce load on the file system. Sqlite3 files on network filesystem can be
-  a burden. [green]#[DONE]#
-. Reduce number of servers and frequency of start/stop. This is mostly an
-  issue of clutter but also a reduction in "moving parts". [green]#[DONE]#
-. Coalesce activities to a single home host where possible. Give the user
-  feedback that they have started the dashboard on a host other than the
-  home host. [green]#[DONE]#
-. Reduce number of processes involved in managing running tests.
-
-Changes Needed
-^^^^^^^^^^^^^^
-
-. ACID compliant db will be on /tmp and synced to megatest.db with a five
-  second max delay. [green]#[DONE]#
-. Read/writes to db for processes on homehost will go direct to /tmp
-  megatest.db file. [green]#[DONE]#
-. Read/wites fron non-homehost processes will go through one server. Bulk
-  reads (e.g. for dashboard or list-runs) will be cached on the current host
-  in /tmp and synced from the home megatest.db in the testsuite area. [green]#[DONE]#
-. Db syncs rely on the target db file timestame minus some margin. [green]#[DONE]#
-. Since bulk reads do not use the server we can switch to simple RPC for the
-  network transport. [green]#[DONE]#
-. Test running manager process extended to manage multiple running tests.
-
-Current Items
-~~~~~~~~~~~~~
-
-ww05 - migrate to inmem-db
-^^^^^^^^^^^^^^^^^^^^^^^^^^
-
-. Switch to inmem db with fast sync to on disk db's [green]#[DONE]#
-. Server polls tasks table for next action
+Eliminate ties to homehost (part of overflow db system)
+
+. Server creates captain pkt
+. Create a lock in the db
+. Relinquish db when done
+
+Tasks - better management of run manager processes etc.
+
+. adjutant queries tasks table for next action [red]#[Migrate into mtutil]#
 .. Task table used for tracking runner process [red]#[Replaced by mtutil]#
 .. Task table used for jobs to run [red]#[Replaced by mtutil]#
 .. Task table used for queueing runner actions (remove runs,
    cleanRunExecute, etc)  [red]#[Replaced by mtutil#]
-
-
-// ww32
-// ~~~~
-// 
-// . Rerun step and or subsequent steps from gui
-// . Refresh test area files from gui
-// . Clean and re-run button
-// . Clean up STATE and STATUS handling.
-// .. Dashboard and Test control panel are reverse order - choose and fix
-// .. Move seldom used states and status to drop down selector
-// . Access test control panel when clicking on Run Summary tests
-// . Feature: -generate-index-tree
-// . Change specifing of state and status to use STATE1/STATUS1,STATE2/STATUS2
-// 
-// ww33
-// ~~~~
-// 
-// . http api available for use with Perl, Ruby etc. scripts
-// . megatest.config setup entries for:
-// .. run launching (e.g. /bin/sh %CMD% > /dev/null)
-// .. browser "konqueror %FNAME%
-// 
-// ww34
-// ~~~~
-// 
-// . Mark dependent tests for clean/rerun -rerun-downstream
-// . On run start check for defunct tests in RUNNING, LAUNCHED or REMOTEHOSTSTART and correct or notify
-// . Fix: refresh of gui sometimes fails on last item (race condition?)
-// 
-// ww35
-// ~~~~
-// 
-// . refdb: Add export of csv, json and sexp
-// . Convert to using call-with-environment-variables where possible. Should allow handling of parallel runs in same process.
-// . Re-work text interface wizards. Several bugs on record. Possibly convert to gui based.
-// . Add to testconfig requirements section; launchlimiter scriptname, calls scriptname to check if ok to launch test
-// . Refactor Run Summary view, currently very clumsy
-// . Add option to show steps in Run Summary view
-// 
-// ww36
-// ~~~~
-// 
-// . Refactor guis for resizeablity
-// . Add filters to Run Summary view and Run Control view
-// . Add to megatest.config or testconfig; rerunok STATE/STATUS,STATE/STATUS...
-// . Launch gates for diskspace; /path/one>1G,/path/two>200M,/tmp>5G,#{scheme *toppath*}>1G
-// 
-// Bin List
-// ~~~~~~~~
-// 
-// .	Quality improvements
-// ..	Server stutters occasionally
-// ..	Large number of items or tests still has some issues.
-// ..	Code refactoring
-// ..	Replace remote process with true API using json (supports Web app also)
-// .	Streamline the gui
-// ..	Everything resizable
-// ..	Less clutter
-// ..	Tool tips
-// ..	Filters on Run Summary, Summary and Run Control panel
-// ..	Built in log viewer (partially implemented)
-// ..	Refactor the test control panel
-// .	Help and documentation
-// ..	Complete the user manual (I’ve been working on this lately).
-// ..	Online help in the gui
-// .	Streamlined install
-// ..	Deployed version (download a location independent ready to run binary bundle)
-// ..	Install Makefile (in progress, needed for Mike to install on VMs)
-// ..	Added option to compile IUP (needed for VMs)
-// .	Server side run launching
-// .	Support for re-running, cleaning etc. of individual steps (ezsteps makes this very easy to implement).
-// .	Launch process needs built in daemonizing (easy to do, just need to test it thoroughly).
-// .	Wizards for creating tests, regression areas (current ones are text only and limited).
-// .	Fully functional built in web service (currently you can browse runs but it is very simplistic).
-// .	Wildcards in runconfigs: e.g. [p1271/9/%/%]
-// .	Gui panels for editing megatest.config and runconfigs.config
-// .	Fully isolated tests (no use of NFS to see regression area files)
-// .	Windows version
+. adjutant (server/task dispatch/execution manager)  
+
+Stale propagation
+
+ . Mark dependent tests for clean/rerun -rerun-downstream
+ . On run start check for defunct tests in RUNNING, LAUNCHED or REMOTEHOSTSTART and correct or notify
+ . Fix: refresh of gui sometimes fails on last item (race condition?)
+ 
+Bin list
+
+ . Rerun step and or subsequent steps from gui [DONE?]
+ . Refresh test area files from gui
+ . Clean and re-run button
+ . Clean up STATE and STATUS handling.
+ .. Dashboard and Test control panel are reverse order - choose and fix
+ .. Move seldom used states and status to drop down selector
+ . Access test control panel when clicking on Run Summary tests
+ . Feature: -generate-index-tree
+ . Change specifing of state and status to use STATE1/STATUS1,STATE2/STATUS2
+ 
+ . rest api available for use with Perl, Ruby etc. scripts
+ . megatest.config setup entries for:
+ .. run launching (e.g. /bin/sh %CMD% > /dev/null)
+ .. browser "konqueror %FNAME%
+
+ . refdb: Add export of csv, json and sexp
+ . Convert to using call-with-environment-variables where possible. Should allow handling of parallel runs in same process.
+ . Re-work text interface wizards. Several bugs on record. Possibly convert to gui based.
+ . Add to testconfig requirements section; launchlimiter scriptname, calls scriptname to check if ok to launch test
+ . Refactor Run Summary view, currently very clumsy
+ . Add option to show steps in Run Summary view
+  . Refactor guis for resizeablity
+ . Add filters to Run Summary view and Run Control view
+ . Add to megatest.config or testconfig; rerunok STATE/STATUS,STATE/STATUS...
+ . Launch gates for diskspace; /path/one>1G,/path/two>200M,/tmp>5G,#{scheme *toppath*}>1G
+ . Tool tips
+ . Filters on Run Summary, Summary and Run Control panel
+ . Built in log viewer (partially implemented)
+ . Refactor the test control panel
+   Help and documentation
+ . Complete the user manual (I’ve been working on this lately).
+ . Online help in the gui
+   Streamlined install
+ . Deployed or static build
+ . Added option to compile IUP (needed for VMs)
+ . Server side run launching
+ . Wizards for creating tests, regression areas (current ones are text only and limited).
+ . Fully functional built in web service (currently you can browse runs but it is very simplistic).
+ . Gui panels for editing megatest.config and runconfigs.config
+ . Fully isolated tests (no use of NFS to see regression area files)
+ . Windows version

Index: docs/manual/reference.txt
==================================================================
--- docs/manual/reference.txt
+++ docs/manual/reference.txt
@@ -121,13 +121,20 @@
 -------------------
 
 Trim trailing spaces
 ~~~~~~~~~~~~~~~~~~~~
 
+NOTE: As of Megatest version v1.6548 trim-trailing-spaces defaults to yes.
+
 ------------------
-[configf:settings trim-trailing-spaces yes]
+[configf:settings trim-trailing-spaces no]
+#                 |<== next line padded with spaces to here
+DEFAULT_INDENT
+[configf:settings trim-trailing-spaces no]
 ------------------
+
+The variable DEFAULT_INDENT would be a string of 3 spaces
 
 Job Submission Control
 ~~~~~~~~~~~~~~~~~~~~~~
 
 Submit jobs to Host Types based on Test Name
@@ -198,10 +205,27 @@
 [setup]
 # this will automatically kill the test if it runs for more than 1h 2m and 3s
 runtimelim 1h 2m 3s
 -----------------
 
+Post Run Hook
++++++++++++++
+
+This runs script to-run.sh after all tests have been completed. It is
+not necessary to use -run-wait as each test will check for other
+running tests on completion and if there are none it will call the
+post run hook.
+
+Note that the output from the script call will be placed in a log file
+in the logs directory with a file name derived by replacing / with _
+in post-hook-<target>-<runname>.log.
+
+-------------------
+[runs]
+post-hook /path/to/script/to-run.sh
+-------------------
+
 Tests browser view
 ~~~~~~~~~~~~~~~~~~
 
 The tests browser (see the Run Control tab on the dashboard) has two views for displaying the tests. 
 
@@ -355,10 +379,29 @@
 -------------------
 # A normal waiton waits for the prior tests to be COMPLETED 
 # and PASS, CHECK or WAIVED
 waiton test1 test2
 -------------------
+
+NOTE: Dynamic waiton lists must be capable of being calculated at the
+beginning of a run. This is because Megatest walks the tree of waitons
+to create the list of tests to execute.
+
+.This works
+-------------------
+waiton [system somescript.sh]
+-------------------
+
+.This does NOT work (the full context for the test is not available so #{shell ...} is NOT enabled to evaluate.
+-------------------
+waiton #{shell somescript.sh}
+-------------------
+
+.This does NOT work
+-------------------
+waiton [system somescript_that_depends_on_a_prior_test.sh]
+-------------------
 
 Mode
 ~~~~
 
 The default (i.e. if mode is not specified) is normal. All pre-dependent tests
@@ -622,14 +665,20 @@
 basis.
 
 Controlled waiver propagation
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
-If test is FAIL and previous test in run with same MT_TARGET is WAIVED then apply the following rules from the testconfig:
-If a waiver check is specified in the testconfig apply the check and if it passes then set this FAIL to WAIVED
+If test is FAIL and previous test in run with same MT_TARGET is WAIVED
+or if the test/itempath is listed under the matching target in the
+waivers roll forward file (see below for file spec) then apply the
+following rules from the testconfig: If a waiver check is specified in
+the testconfig apply the check and if it passes then set this FAIL to
+WAIVED
 
-Waiver check has two parts, 1) a list of waiver, rulename, filepatterns and 2) the rulename script spec (note that "diff" and "logpro" are predefined)
+Waiver check has two parts, 1) a list of waiver, rulename,
+filepatterns and 2) the rulename script spec (note that "diff" and
+"logpro" are predefined)
 
 -----------------
 ###### EXAMPLE FROM testconfig #########
 # matching file(s) will be diff'd with previous run and logpro applied
 # if PASS or WARN result from logpro then WAIVER state is set
@@ -645,12 +694,45 @@
 
 # This builtin rule is applied if a <waivername>.logpro file exists
 # logpro diff %file1% %file2% | logpro %waivername%.logpro %waivername%.html
 -----------------
 
+Waiver roll-forward files
+^^^^^^^^^^^^^^^^^^^^^^^^^
+
+To transfer waivers from one Megatest area to another it is possible
+to dump waivers into a file and reference that file in another area.
+
+.Dumping the waivers
+---------------------------
+megatest -list-waivers -runname %-a > mywaivers.dat
+---------------------------
+
+.Referencing the saved waivers
+---------------------------
+# In megatest.config, all files listed will be loaded - recomended to use
+# variables to select directorys to minimize what gets loaded.
+[setup]
+waivers-dirs /path/to/waiver/files /another/path/to/waiver/files
+---------------------------
+
+.Waiver files format
+---------------------------
+[the/target/here]
+# comments are fine
+testname1/itempath A comment about why it was waived
+testname2          A comment for a non-itemized test 
+---------------------------
+
 Ezsteps
 ~~~~~~~
+
+Ezsteps is the recommended way to implement tests and automation in
+Megatest.
+
+NOTE: Each ezstep must be a single line. Use the [scripts] mechanism
+to create multiline scripts (see example below).
 
 .Example ezsteps with logpro rules
 -----------------
 [ezsteps]
 lookittmp   ls /tmp
@@ -660,16 +742,68 @@
   ;;     a blank line indicates the end of the block of text 
   (expect:required in "LogFileBody" > 0 "A file name that should never exist!" #/This is a awfully stupid file name that should never be found in the temp dir/)
 
 -----------------
 
-To transfer the environment to the next step you can do the following:
+Automatic environment propagation with Ezsteps
+^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 
-.Propagate environment to next step
-----------------------------
-$MT_MEGATEST -env2file .ezsteps/${stepname}	  
-----------------------------
+Turn on ezpropvars and environment variables will be propagated from
+step to step. Use this to source script files that modify the
+envionment where the modifications are needed in subsequent steps.
+
+NOTE: aliases and variables with strange whitespace or characters will
+not propagate correctly. Put in a ticket on the
+http://www.kiatoa.com/fossils/megatest site if you need support for a
+specific strange character combination.
+
+.Turn on auto propagate for bash
+---------------------------
+[setup]
+ezpropvars sh
+---------------------------
+
+.Write your ezsteps. The loadenv.csh step will use /bin/csh as its shell, other steps will use bash.
+---------------------------
+[ezsteps]
+loadenv.csh source $REF/ourenviron.csh
+compile make
+install make install
+---------------------------
+
+Bash and csh are supported. You can override the shell binary location
+from the default /bin/bash and /bin/csh if needed.
+
+.Turn on auto propagate for csh
+---------------------------
+[setup]
+ezpropvars csh /bin/csh
+---------------------------
+
+.Example of auto propagation using extensions
+---------------------------
+[ezsteps]
+step1.sh export SOMEVAR=$(ps -def | wc -l);ls /tmp
+# The next step will get the value of $SOMEVAR from step1.sh
+step2.sh echo $SOMEVAR
+---------------------------
+
+.Example of multi-line script
+---------------------------
+[scripts]
+tarresults tar cfvz $DEST/srcdir1.tar.gz srcdir1
+  tar cfvz $DEST/srcdir2.tar.gz srcdir2
+
+[setup]
+ezpropvars sh
+
+[ezsteps]
+step1 DEST=/tmp/targz;source tarresults
+---------------------------
+
+The above example will result in files; tarresults and ez_step1 being
+created in the test dir.
 
 Scripts
 ~~~~~~~
 
 .Specifying scripts inline (best used for only simple scripts)

Index: docs/manual/server.png
==================================================================
--- docs/manual/server.png
+++ docs/manual/server.png
cannot compute difference between binary files

ADDED   docs/manual/subrun-opt-stuff.fig
Index: docs/manual/subrun-opt-stuff.fig
==================================================================
--- /dev/null
+++ docs/manual/subrun-opt-stuff.fig
@@ -0,0 +1,128 @@
+#FIG 3.2  Produced by xfig version 3.2.5-alpha5
+Landscape
+Center
+Inches
+Letter  
+100.00
+Single
+-2
+1200 2
+6 150 5475 1650 9675
+2 2 0 1 0 7 50 -1 -1 3.000 0 0 -1 0 0 5
+	 150 5475 1650 5475 1650 9675 150 9675 150 5475
+2 2 0 1 0 7 50 -1 -1 3.000 0 0 -1 0 0 5
+	 225 5550 1575 5550 1575 6075 225 6075 225 5550
+2 2 0 1 0 7 50 -1 -1 3.000 0 0 -1 0 0 5
+	 225 6150 1575 6150 1575 6675 225 6675 225 6150
+2 2 0 1 0 7 50 -1 -1 3.000 0 0 -1 0 0 5
+	 225 6750 1575 6750 1575 7275 225 7275 225 6750
+2 2 0 1 0 7 50 -1 -1 3.000 0 0 -1 0 0 5
+	 225 7350 1575 7350 1575 7875 225 7875 225 7350
+-6
+6 3900 5550 5400 9750
+2 2 0 1 0 7 50 -1 -1 3.000 0 0 -1 0 0 5
+	 3900 5550 5400 5550 5400 9750 3900 9750 3900 5550
+2 2 0 1 0 7 50 -1 -1 3.000 0 0 -1 0 0 5
+	 3975 5625 5325 5625 5325 6150 3975 6150 3975 5625
+2 2 0 1 0 7 50 -1 -1 3.000 0 0 -1 0 0 5
+	 3975 6225 5325 6225 5325 6750 3975 6750 3975 6225
+2 2 0 1 0 7 50 -1 -1 3.000 0 0 -1 0 0 5
+	 3975 6825 5325 6825 5325 7350 3975 7350 3975 6825
+2 2 0 1 0 7 50 -1 -1 3.000 0 0 -1 0 0 5
+	 3975 7425 5325 7425 5325 7950 3975 7950 3975 7425
+-6
+6 8325 5700 9525 9825
+2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
+	 8325 6000 9525 6000 9525 6825 8325 6825 8325 6000
+2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
+	 8325 6900 9525 6900 9525 7725 8325 7725 8325 6900
+2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
+	 8325 7800 9525 7800 9525 8625 8325 8625 8325 7800
+2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
+	 8325 8700 9525 8700 9525 9525 8325 9525 8325 8700
+4 0 0 50 -1 0 12 0.0000 4 120 405 8475 5850 tests\001
+4 0 0 50 -1 0 12 0.0000 4 165 600 8400 6375 startup\001
+4 0 0 50 -1 0 12 0.0000 4 195 375 8400 7275 opt1\001
+4 0 0 50 -1 0 12 0.0000 4 195 375 8400 8025 opt2\001
+4 0 0 50 -1 0 12 0.0000 4 195 585 8400 9075 opt1v2\001
+4 0 0 50 -1 0 12 0.0000 4 15 180 8775 9825 ...\001
+-6
+2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
+	 4800 450 6000 450 6000 1275 4800 1275 4800 450
+2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
+	 1050 2100 2250 2100 2250 2925 1050 2925 1050 2100
+2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
+	 2925 2100 4125 2100 4125 2925 2925 2925 2925 2100
+2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
+	 4950 2100 6150 2100 6150 2925 4950 2925 4950 2100
+2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
+	 7200 2100 8400 2100 8400 2925 7200 2925 7200 2100
+2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
+	 9375 2100 10575 2100 10575 2925 9375 2925 9375 2100
+2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
+	 2025 4050 3225 4050 3225 4875 2025 4875 2025 4050
+2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
+	 6525 3975 7725 3975 7725 4800 6525 4800 6525 3975
+2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
+	0 0 1.00 60.00 120.00
+	 5400 1275 1500 2100
+2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
+	0 0 1.00 60.00 120.00
+	 5325 1275 3525 2100
+2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
+	0 0 1.00 60.00 120.00
+	 5325 1275 5475 2100
+2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
+	0 0 1.00 60.00 120.00
+	 5250 1275 7800 2100
+2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
+	0 0 1.00 60.00 120.00
+	 5325 1275 9900 2100
+2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
+	0 0 1.00 60.00 120.00
+	 1650 2925 2550 4050
+2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
+	0 0 1.00 60.00 120.00
+	 3525 2925 2550 4050
+2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
+	0 0 1.00 60.00 120.00
+	 3525 2925 7050 3975
+2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
+	0 0 1.00 60.00 120.00
+	 5550 2925 6975 3975
+2 2 2 1 0 7 50 -1 -1 3.000 0 0 -1 0 0 5
+	 750 1650 10875 1650 10875 3450 750 3450 750 1650
+2 1 0 1 0 7 50 -1 -1 3.000 0 0 -1 1 0 3
+	0 0 1.00 60.00 120.00
+	 1050 2700 450 2700 450 5550
+2 1 0 1 0 7 50 -1 -1 3.000 0 0 -1 1 0 3
+	0 0 1.00 60.00 120.00
+	 4125 2700 4650 2700 4650 5550
+2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
+	 2100 5475 3300 5475 3300 8700 2100 8700 2100 5475
+2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
+	 2175 6000 3225 6000 3225 6525 2175 6525 2175 6000
+2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
+	0 0 1.00 60.00 120.00
+	 1500 6375 2325 6300
+2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
+	0 0 1.00 60.00 120.00
+	 4200 6525 3000 6225
+2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
+	0 0 1.00 60.00 120.00
+	 7800 2925 7050 3975
+2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
+	0 0 1.00 60.00 120.00
+	 9975 2925 7125 3900
+4 0 0 50 -1 0 12 0.0000 4 165 600 4875 975 startup\001
+4 0 0 50 -1 0 12 0.0000 4 15 180 5325 2550 ...\001
+4 0 0 50 -1 0 12 0.0000 4 195 2100 900 675 p1278/2/cpdk_r0.5/none\001
+4 0 0 50 -1 0 12 0.0000 4 150 675 150 2475 subruns\001
+4 0 0 50 -1 0 12 0.0000 4 195 585 2175 4500 opt1v2\001
+4 0 0 50 -1 0 12 0.0000 4 195 375 1200 2625 opt1\001
+4 0 0 50 -1 0 12 0.0000 4 195 375 3150 2550 opt2\001
+4 0 0 50 -1 0 12 0.0000 4 150 2100 3075 150 SUBRUN for Multistack\001
+4 0 0 50 -1 0 12 0.0000 4 150 225 300 6375 ftc\001
+4 0 0 50 -1 0 12 0.0000 4 150 225 4050 6450 ftc\001
+4 0 0 50 -1 0 12 0.0000 4 195 2220 600 5250 p1278/2/cpdk_r0.5/x-opt1\001
+4 0 0 50 -1 0 12 0.0000 4 195 2220 4800 5325 p1278/2/cpdk_r0.5/y-opt2\001

ADDED   docs/manual/testplan.txt
Index: docs/manual/testplan.txt
==================================================================
--- /dev/null
+++ docs/manual/testplan.txt
@@ -0,0 +1,81 @@
+// This file is part of Megatest.
+// 
+//     Megatest is free software: you can redistribute it and/or modify
+//     it under the terms of the GNU General Public License as published by
+//     the Free Software Foundation, either version 3 of the License, or
+//     (at your option) any later version.
+// 
+//     Megatest is distributed in the hope that it will be useful,
+//     but WITHOUT ANY WARRANTY; without even the implied warranty of
+//     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+//     GNU General Public License for more details.
+// 
+//     You should have received a copy of the GNU General Public License
+//     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
+
+// Copyright 2006-2020, Matthew Welland.
+
+Test Plan
+---------
+
+Tests
+~~~~~
+
+itemwait|33
+
+rerun-downstream-item|20
+
+rerunclean|20
+
+fullrun|18
+
+goodtests|18
+
+kill-rerun|17
+
+items-runconfigvars|16
+
+ro_test|16
+
+runconfig-tests|16
+
+env-pollution|13
+
+itemmap|11
+
+testpatt_envvar|10
+
+toprun|10
+
+chained-waiton|8
+
+skip-on-fileexists|8
+
+killrun_preqfail|7
+
+subrun|6
+
+dependencies|5
+
+itemwait-simple|4
+
+rollup|4
+
+end-of-run|3
+
+killrun|3
+
+listener|3
+
+test2|3
+
+testpatt|3
+
+env-pollution-usecacheno|2
+
+set-values|2
+envvars|1
+listruns-tests|1
+subrun-usecases|1
+
+

ADDED   docs/megatest-debug-tutorial.odp
Index: docs/megatest-debug-tutorial.odp
==================================================================
--- /dev/null
+++ docs/megatest-debug-tutorial.odp
cannot compute difference between binary files

ADDED   ducttape-lib.scm
Index: ducttape-lib.scm
==================================================================
--- /dev/null
+++ ducttape-lib.scm
@@ -0,0 +1,23 @@
+;;======================================================================
+;; Copyright 2019, Matthew Welland.
+;; 
+;; This file is part of Megatest.
+;; 
+;;     Megatest is free software: you can redistribute it and/or modify
+;;     it under the terms of the GNU General Public License as published by
+;;     the Free Software Foundation, either version 3 of the License, or
+;;     (at your option) any later version.
+;; 
+;;     Megatest is distributed in the hope that it will be useful,
+;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;     GNU General Public License for more details.
+;; 
+;;     You should have received a copy of the GNU General Public License
+;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
+
+;;======================================================================
+
+(declare (unit ducttape-lib))
+
+(include "ducttape/ducttape-lib.scm")

ADDED   ducttape/Makefile
Index: ducttape/Makefile
==================================================================
--- /dev/null
+++ ducttape/Makefile
@@ -0,0 +1,34 @@
+help:
+	@echo ""
+	@echo "make targets:"
+	@echo "============="
+	@echo "install      - build and install general_lib egg as icfadm"
+	@echo "test         - run unit tests on ducttape-lib.scm (tests code, not egg)"
+	@echo "eggs-info     - show chicken-install commands to get eggs upon which ducttape-lib depends"
+	@echo "test_example - compile an example scm against installed general_lib egg"
+	@echo "clean        - remove binaries and other build artifacts"
+	@echo ""
+
+clean:
+	rm -f *.so *.import.scm test_ducttape test_example foo *.c *.o
+
+install:
+	chicken-install
+
+test:
+	echo '(handle-exceptions exn (begin (print-call-chain) (exit 1)) (load "ducttape-lib.scm") (inote "hello")) (exit 0)'  | csi
+	chicken-install -no-install
+	csc test_ducttape.scm
+
+	./test_ducttape
+	rm -f foo
+
+test_example:
+	@csc test_example.scm
+	@./test_example
+	@rm test_example
+
+eggs-info:
+	@echo chicken-install ansi-escape-sequences
+	@echo chicken-install slice
+	@echo chicken-install rfc3339

ADDED   ducttape/README
Index: ducttape/README
==================================================================
--- /dev/null
+++ ducttape/README
@@ -0,0 +1,8 @@
+This directory holds the "ducttape" chicken scheme egg used by megatest.
+
+Run "make test" to ensure this egg works on your system.
+
+Run "make install" as your admin user with chicken on your $PATH to install this egg.
+
+
+

ADDED   ducttape/ducttape-lib.meta
Index: ducttape/ducttape-lib.meta
==================================================================
--- /dev/null
+++ ducttape/ducttape-lib.meta
@@ -0,0 +1,13 @@
+;;; ducttape-lib.meta -*- Hen -*-
+
+((egg "ducttape-lib.egg")
+ (synopsis "Miscellaneous tool and standard print routines.")
+ (category env)
+ (author "Brandon Barclay")
+ (doc-from-wiki)
+ (license "GPL-2")
+ ;; srfi-69, posix, srfi-18
+ (depends regex)
+ (test-depends test)
+ ; suspicious - (files "ducttape-lib")
+ )

ADDED   ducttape/ducttape-lib.scm
Index: ducttape/ducttape-lib.scm
==================================================================
--- /dev/null
+++ ducttape/ducttape-lib.scm
@@ -0,0 +1,1777 @@
+(module ducttape-lib
+    (
+     runs-ok
+     ducttape-debug-level
+     ducttape-debug-regex-filter
+     ducttape-silent-mode
+     ducttape-quiet-mode
+     ducttape-log-file
+     ducttape-color-mode
+     iputs-preamble
+     script-name
+     idbg
+     ierr
+     iwarn
+     inote
+     iputs
+     re-match?
+                                        ;     launch-repl
+     keyword-skim
+     skim-cmdline-opts-noarg-by-regex
+     skim-cmdline-opts-withargs-by-regex
+     get-cli-arg
+     get-cli-switch
+     concat-lists
+     ducttape-process-command-line
+     ducttape-append-logfile
+     ducttape-activate-logfile
+     isys
+     do-or-die
+     counter-maker
+     dir-is-writable?
+     mktemp
+     get-tmpdir
+     sendmail
+     find-exe
+
+     zeropad
+     string-leftpad
+     string-rightpad
+     seconds->isodate
+     seconds->wwdate
+     seconds->wwdate-values
+     isodate->seconds
+     isodate->wwdate
+     wwdate->seconds
+     wwdate->isodate
+     current-wwdate
+     current-isodate
+     *this-exe-dir*
+     *this-exe-name*
+     *this-exe-fullpath*
+     )
+
+  (import scheme chicken extras ports data-structures )
+  (use posix regex ansi-escape-sequences test srfi-1 irregex slice srfi-13 rfc3339)
+  ;;scsh-process ;; dropping scsh-process, it was clobbering posix's process and process*
+  (use directory-utils uuid-lib filepath srfi-19 ) ; linenoise
+
+    ;; plugs a hole in posix-extras in latter chicken versions
+  (use posix-extras pathname-expand files)
+  (define ##sys#expand-home-path pathname-expand)
+  (define (realpath x) (resolve-pathname  (pathname-expand (or x "/dev/null")) ))
+
+  ;; (include "mimetypes.scm") ; provides ext->mimetype
+  ;; (include "workweekdate.scm")
+
+  ;; gathered from macosx:
+;;   cat /etc/apache2/mime.types | grep -v '^#' | perl -ne 'print "(\"$2\" . \"$1\")\n" if /(\S+)\s+(\S+)/' > mimetypes.scm
+;; + manual manipulation
+
+(define ducttape_ext2mimetype '(("ez" . "application/andrew-inset")
+("aw" . "application/applixware")
+("atom" . "application/atom+xml")
+("atomcat" . "application/atomcat+xml")
+("atomsvc" . "application/atomsvc+xml")
+("ccxml" . "application/ccxml+xml")
+("cdmia" . "application/cdmi-capability")
+("cdmic" . "application/cdmi-container")
+("cdmid" . "application/cdmi-domain")
+("cdmio" . "application/cdmi-object")
+("cdmiq" . "application/cdmi-queue")
+("cu" . "application/cu-seeme")
+("davmount" . "application/davmount+xml")
+("dbk" . "application/docbook+xml")
+("dssc" . "application/dssc+der")
+("xdssc" . "application/dssc+xml")
+("ecma" . "application/ecmascript")
+("emma" . "application/emma+xml")
+("epub" . "application/epub+zip")
+("exi" . "application/exi")
+("pfr" . "application/font-tdpfr")
+("gml" . "application/gml+xml")
+("gpx" . "application/gpx+xml")
+("gxf" . "application/gxf")
+("stk" . "application/hyperstudio")
+("ink" . "application/inkml+xml")
+("ipfix" . "application/ipfix")
+("jar" . "application/java-archive")
+("ser" . "application/java-serialized-object")
+("class" . "application/java-vm")
+("js" . "application/javascript")
+("json" . "application/json")
+("jsonml" . "application/jsonml+json")
+("lostxml" . "application/lost+xml")
+("hqx" . "application/mac-binhex40")
+("cpt" . "application/mac-compactpro")
+("mads" . "application/mads+xml")
+("mrc" . "application/marc")
+("mrcx" . "application/marcxml+xml")
+("ma" . "application/mathematica")
+("mathml" . "application/mathml+xml")
+("mbox" . "application/mbox")
+("mscml" . "application/mediaservercontrol+xml")
+("metalink" . "application/metalink+xml")
+("meta4" . "application/metalink4+xml")
+("mets" . "application/mets+xml")
+("mods" . "application/mods+xml")
+("m21" . "application/mp21")
+("mp4s" . "application/mp4")
+("doc" . "application/msword")
+("mxf" . "application/mxf")
+("bin" . "application/octet-stream")
+("oda" . "application/oda")
+("opf" . "application/oebps-package+xml")
+("ogx" . "application/ogg")
+("omdoc" . "application/omdoc+xml")
+("onetoc" . "application/onenote")
+("oxps" . "application/oxps")
+("xer" . "application/patch-ops-error+xml")
+("pdf" . "application/pdf")
+("pgp" . "application/pgp-encrypted")
+("asc" . "application/pgp-signature")
+("prf" . "application/pics-rules")
+("p10" . "application/pkcs10")
+("p7m" . "application/pkcs7-mime")
+("p7s" . "application/pkcs7-signature")
+("p8" . "application/pkcs8")
+("ac" . "application/pkix-attr-cert")
+("cer" . "application/pkix-cert")
+("crl" . "application/pkix-crl")
+("pkipath" . "application/pkix-pkipath")
+("pki" . "application/pkixcmp")
+("pls" . "application/pls+xml")
+("ai" . "application/postscript")
+("cww" . "application/prs.cww")
+("pskcxml" . "application/pskc+xml")
+("rdf" . "application/rdf+xml")
+("rif" . "application/reginfo+xml")
+("rnc" . "application/relax-ng-compact-syntax")
+("rl" . "application/resource-lists+xml")
+("rld" . "application/resource-lists-diff+xml")
+("rs" . "application/rls-services+xml")
+("gbr" . "application/rpki-ghostbusters")
+("mft" . "application/rpki-manifest")
+("roa" . "application/rpki-roa")
+("rsd" . "application/rsd+xml")
+("rss" . "application/rss+xml")
+("rtf" . "application/rtf")
+("sbml" . "application/sbml+xml")
+("scq" . "application/scvp-cv-request")
+("scs" . "application/scvp-cv-response")
+("spq" . "application/scvp-vp-request")
+("spp" . "application/scvp-vp-response")
+("sdp" . "application/sdp")
+("setpay" . "application/set-payment-initiation")
+("setreg" . "application/set-registration-initiation")
+("shf" . "application/shf+xml")
+("smi" . "application/smil+xml")
+("rq" . "application/sparql-query")
+("srx" . "application/sparql-results+xml")
+("gram" . "application/srgs")
+("grxml" . "application/srgs+xml")
+("sru" . "application/sru+xml")
+("ssdl" . "application/ssdl+xml")
+("ssml" . "application/ssml+xml")
+("tei" . "application/tei+xml")
+("tfi" . "application/thraud+xml")
+("tsd" . "application/timestamped-data")
+("plb" . "application/vnd.3gpp.pic-bw-large")
+("psb" . "application/vnd.3gpp.pic-bw-small")
+("pvb" . "application/vnd.3gpp.pic-bw-var")
+("tcap" . "application/vnd.3gpp2.tcap")
+("pwn" . "application/vnd.3m.post-it-notes")
+("aso" . "application/vnd.accpac.simply.aso")
+("imp" . "application/vnd.accpac.simply.imp")
+("acu" . "application/vnd.acucobol")
+("atc" . "application/vnd.acucorp")
+("air" . "application/vnd.adobe.air-application-installer-package+zip")
+("fcdt" . "application/vnd.adobe.formscentral.fcdt")
+("fxp" . "application/vnd.adobe.fxp")
+("xdp" . "application/vnd.adobe.xdp+xml")
+("xfdf" . "application/vnd.adobe.xfdf")
+("ahead" . "application/vnd.ahead.space")
+("azf" . "application/vnd.airzip.filesecure.azf")
+("azs" . "application/vnd.airzip.filesecure.azs")
+("azw" . "application/vnd.amazon.ebook")
+("acc" . "application/vnd.americandynamics.acc")
+("ami" . "application/vnd.amiga.ami")
+("apk" . "application/vnd.android.package-archive")
+("cii" . "application/vnd.anser-web-certificate-issue-initiation")
+("fti" . "application/vnd.anser-web-funds-transfer-initiation")
+("atx" . "application/vnd.antix.game-component")
+("mpkg" . "application/vnd.apple.installer+xml")
+("m3u8" . "application/vnd.apple.mpegurl")
+("swi" . "application/vnd.aristanetworks.swi")
+("iota" . "application/vnd.astraea-software.iota")
+("aep" . "application/vnd.audiograph")
+("mpm" . "application/vnd.blueice.multipass")
+("bmi" . "application/vnd.bmi")
+("rep" . "application/vnd.businessobjects")
+("cdxml" . "application/vnd.chemdraw+xml")
+("mmd" . "application/vnd.chipnuts.karaoke-mmd")
+("cdy" . "application/vnd.cinderella")
+("cla" . "application/vnd.claymore")
+("rp9" . "application/vnd.cloanto.rp9")
+("c4g" . "application/vnd.clonk.c4group")
+("c11amc" . "application/vnd.cluetrust.cartomobile-config")
+("c11amz" . "application/vnd.cluetrust.cartomobile-config-pkg")
+("csp" . "application/vnd.commonspace")
+("cdbcmsg" . "application/vnd.contact.cmsg")
+("cmc" . "application/vnd.cosmocaller")
+("clkx" . "application/vnd.crick.clicker")
+("clkk" . "application/vnd.crick.clicker.keyboard")
+("clkp" . "application/vnd.crick.clicker.palette")
+("clkt" . "application/vnd.crick.clicker.template")
+("clkw" . "application/vnd.crick.clicker.wordbank")
+("wbs" . "application/vnd.criticaltools.wbs+xml")
+("pml" . "application/vnd.ctc-posml")
+("ppd" . "application/vnd.cups-ppd")
+("car" . "application/vnd.curl.car")
+("pcurl" . "application/vnd.curl.pcurl")
+("dart" . "application/vnd.dart")
+("rdz" . "application/vnd.data-vision.rdz")
+("uvf" . "application/vnd.dece.data")
+("uvt" . "application/vnd.dece.ttml+xml")
+("uvx" . "application/vnd.dece.unspecified")
+("uvz" . "application/vnd.dece.zip")
+("fe_launch" . "application/vnd.denovo.fcselayout-link")
+("dna" . "application/vnd.dna")
+("mlp" . "application/vnd.dolby.mlp")
+("dpg" . "application/vnd.dpgraph")
+("dfac" . "application/vnd.dreamfactory")
+("kpxx" . "application/vnd.ds-keypoint")
+("ait" . "application/vnd.dvb.ait")
+("svc" . "application/vnd.dvb.service")
+("geo" . "application/vnd.dynageo")
+("mag" . "application/vnd.ecowin.chart")
+("nml" . "application/vnd.enliven")
+("esf" . "application/vnd.epson.esf")
+("msf" . "application/vnd.epson.msf")
+("qam" . "application/vnd.epson.quickanime")
+("slt" . "application/vnd.epson.salt")
+("ssf" . "application/vnd.epson.ssf")
+("es3" . "application/vnd.eszigno3+xml")
+("ez2" . "application/vnd.ezpix-album")
+("ez3" . "application/vnd.ezpix-package")
+("fdf" . "application/vnd.fdf")
+("mseed" . "application/vnd.fdsn.mseed")
+("seed" . "application/vnd.fdsn.seed")
+("gph" . "application/vnd.flographit")
+("ftc" . "application/vnd.fluxtime.clip")
+("fm" . "application/vnd.framemaker")
+("fnc" . "application/vnd.frogans.fnc")
+("ltf" . "application/vnd.frogans.ltf")
+("fsc" . "application/vnd.fsc.weblaunch")
+("oas" . "application/vnd.fujitsu.oasys")
+("oa2" . "application/vnd.fujitsu.oasys2")
+("oa3" . "application/vnd.fujitsu.oasys3")
+("fg5" . "application/vnd.fujitsu.oasysgp")
+("bh2" . "application/vnd.fujitsu.oasysprs")
+("ddd" . "application/vnd.fujixerox.ddd")
+("xdw" . "application/vnd.fujixerox.docuworks")
+("xbd" . "application/vnd.fujixerox.docuworks.binder")
+("fzs" . "application/vnd.fuzzysheet")
+("txd" . "application/vnd.genomatix.tuxedo")
+("ggb" . "application/vnd.geogebra.file")
+("ggt" . "application/vnd.geogebra.tool")
+("gex" . "application/vnd.geometry-explorer")
+("gxt" . "application/vnd.geonext")
+("g2w" . "application/vnd.geoplan")
+("g3w" . "application/vnd.geospace")
+("gmx" . "application/vnd.gmx")
+("kml" . "application/vnd.google-earth.kml+xml")
+("kmz" . "application/vnd.google-earth.kmz")
+("gqf" . "application/vnd.grafeq")
+("gac" . "application/vnd.groove-account")
+("ghf" . "application/vnd.groove-help")
+("gim" . "application/vnd.groove-identity-message")
+("grv" . "application/vnd.groove-injector")
+("gtm" . "application/vnd.groove-tool-message")
+("tpl" . "application/vnd.groove-tool-template")
+("vcg" . "application/vnd.groove-vcard")
+("hal" . "application/vnd.hal+xml")
+("zmm" . "application/vnd.handheld-entertainment+xml")
+("hbci" . "application/vnd.hbci")
+("les" . "application/vnd.hhe.lesson-player")
+("hpgl" . "application/vnd.hp-hpgl")
+("hpid" . "application/vnd.hp-hpid")
+("hps" . "application/vnd.hp-hps")
+("jlt" . "application/vnd.hp-jlyt")
+("pcl" . "application/vnd.hp-pcl")
+("pclxl" . "application/vnd.hp-pclxl")
+("sfd-hdstx" . "application/vnd.hydrostatix.sof-data")
+("mpy" . "application/vnd.ibm.minipay")
+("afp" . "application/vnd.ibm.modcap")
+("irm" . "application/vnd.ibm.rights-management")
+("sc" . "application/vnd.ibm.secure-container")
+("icc" . "application/vnd.iccprofile")
+("igl" . "application/vnd.igloader")
+("ivp" . "application/vnd.immervision-ivp")
+("ivu" . "application/vnd.immervision-ivu")
+("igm" . "application/vnd.insors.igm")
+("xpw" . "application/vnd.intercon.formnet")
+("i2g" . "application/vnd.intergeo")
+("qbo" . "application/vnd.intu.qbo")
+("qfx" . "application/vnd.intu.qfx")
+("rcprofile" . "application/vnd.ipunplugged.rcprofile")
+("irp" . "application/vnd.irepository.package+xml")
+("xpr" . "application/vnd.is-xpr")
+("fcs" . "application/vnd.isac.fcs")
+("jam" . "application/vnd.jam")
+("rms" . "application/vnd.jcp.javame.midlet-rms")
+("jisp" . "application/vnd.jisp")
+("joda" . "application/vnd.joost.joda-archive")
+("ktz" . "application/vnd.kahootz")
+("karbon" . "application/vnd.kde.karbon")
+("chrt" . "application/vnd.kde.kchart")
+("kfo" . "application/vnd.kde.kformula")
+("flw" . "application/vnd.kde.kivio")
+("kon" . "application/vnd.kde.kontour")
+("kpr" . "application/vnd.kde.kpresenter")
+("ksp" . "application/vnd.kde.kspread")
+("kwd" . "application/vnd.kde.kword")
+("htke" . "application/vnd.kenameaapp")
+("kia" . "application/vnd.kidspiration")
+("kne" . "application/vnd.kinar")
+("skp" . "application/vnd.koan")
+("sse" . "application/vnd.kodak-descriptor")
+("lasxml" . "application/vnd.las.las+xml")
+("lbd" . "application/vnd.llamagraphics.life-balance.desktop")
+("lbe" . "application/vnd.llamagraphics.life-balance.exchange+xml")
+("123" . "application/vnd.lotus-1-2-3")
+("apr" . "application/vnd.lotus-approach")
+("pre" . "application/vnd.lotus-freelance")
+("nsf" . "application/vnd.lotus-notes")
+("org" . "application/vnd.lotus-organizer")
+("scm" . "application/vnd.lotus-screencam")
+("lwp" . "application/vnd.lotus-wordpro")
+("portpkg" . "application/vnd.macports.portpkg")
+("mcd" . "application/vnd.mcd")
+("mc1" . "application/vnd.medcalcdata")
+("cdkey" . "application/vnd.mediastation.cdkey")
+("mwf" . "application/vnd.mfer")
+("mfm" . "application/vnd.mfmp")
+("flo" . "application/vnd.micrografx.flo")
+("igx" . "application/vnd.micrografx.igx")
+("mif" . "application/vnd.mif")
+("daf" . "application/vnd.mobius.daf")
+("dis" . "application/vnd.mobius.dis")
+("mbk" . "application/vnd.mobius.mbk")
+("mqy" . "application/vnd.mobius.mqy")
+("msl" . "application/vnd.mobius.msl")
+("plc" . "application/vnd.mobius.plc")
+("txf" . "application/vnd.mobius.txf")
+("mpn" . "application/vnd.mophun.application")
+("mpc" . "application/vnd.mophun.certificate")
+("xul" . "application/vnd.mozilla.xul+xml")
+("cil" . "application/vnd.ms-artgalry")
+("cab" . "application/vnd.ms-cab-compressed")
+("xls" . "application/vnd.ms-excel")
+("xlam" . "application/vnd.ms-excel.addin.macroenabled.12")
+("xlsb" . "application/vnd.ms-excel.sheet.binary.macroenabled.12")
+("xlsm" . "application/vnd.ms-excel.sheet.macroenabled.12")
+("xltm" . "application/vnd.ms-excel.template.macroenabled.12")
+("eot" . "application/vnd.ms-fontobject")
+("chm" . "application/vnd.ms-htmlhelp")
+("ims" . "application/vnd.ms-ims")
+("lrm" . "application/vnd.ms-lrm")
+("thmx" . "application/vnd.ms-officetheme")
+("cat" . "application/vnd.ms-pki.seccat")
+("stl" . "application/vnd.ms-pki.stl")
+("ppt" . "application/vnd.ms-powerpoint")
+("ppam" . "application/vnd.ms-powerpoint.addin.macroenabled.12")
+("pptm" . "application/vnd.ms-powerpoint.presentation.macroenabled.12")
+("sldm" . "application/vnd.ms-powerpoint.slide.macroenabled.12")
+("ppsm" . "application/vnd.ms-powerpoint.slideshow.macroenabled.12")
+("potm" . "application/vnd.ms-powerpoint.template.macroenabled.12")
+("mpp" . "application/vnd.ms-project")
+("docm" . "application/vnd.ms-word.document.macroenabled.12")
+("dotm" . "application/vnd.ms-word.template.macroenabled.12")
+("wps" . "application/vnd.ms-works")
+("wpl" . "application/vnd.ms-wpl")
+("xps" . "application/vnd.ms-xpsdocument")
+("mseq" . "application/vnd.mseq")
+("mus" . "application/vnd.musician")
+("msty" . "application/vnd.muvee.style")
+("taglet" . "application/vnd.mynfc")
+("nlu" . "application/vnd.neurolanguage.nlu")
+("ntf" . "application/vnd.nitf")
+("nnd" . "application/vnd.noblenet-directory")
+("nns" . "application/vnd.noblenet-sealer")
+("nnw" . "application/vnd.noblenet-web")
+("ngdat" . "application/vnd.nokia.n-gage.data")
+("n-gage" . "application/vnd.nokia.n-gage.symbian.install")
+("rpst" . "application/vnd.nokia.radio-preset")
+("rpss" . "application/vnd.nokia.radio-presets")
+("edm" . "application/vnd.novadigm.edm")
+("edx" . "application/vnd.novadigm.edx")
+("ext" . "application/vnd.novadigm.ext")
+("odc" . "application/vnd.oasis.opendocument.chart")
+("otc" . "application/vnd.oasis.opendocument.chart-template")
+("odb" . "application/vnd.oasis.opendocument.database")
+("odf" . "application/vnd.oasis.opendocument.formula")
+("odft" . "application/vnd.oasis.opendocument.formula-template")
+("odg" . "application/vnd.oasis.opendocument.graphics")
+("otg" . "application/vnd.oasis.opendocument.graphics-template")
+("odi" . "application/vnd.oasis.opendocument.image")
+("oti" . "application/vnd.oasis.opendocument.image-template")
+("odp" . "application/vnd.oasis.opendocument.presentation")
+("otp" . "application/vnd.oasis.opendocument.presentation-template")
+("ods" . "application/vnd.oasis.opendocument.spreadsheet")
+("ots" . "application/vnd.oasis.opendocument.spreadsheet-template")
+("odt" . "application/vnd.oasis.opendocument.text")
+("odm" . "application/vnd.oasis.opendocument.text-master")
+("ott" . "application/vnd.oasis.opendocument.text-template")
+("oth" . "application/vnd.oasis.opendocument.text-web")
+("xo" . "application/vnd.olpc-sugar")
+("dd2" . "application/vnd.oma.dd2+xml")
+("oxt" . "application/vnd.openofficeorg.extension")
+("pptx" . "application/vnd.openxmlformats-officedocument.presentationml.presentation")
+("sldx" . "application/vnd.openxmlformats-officedocument.presentationml.slide")
+("ppsx" . "application/vnd.openxmlformats-officedocument.presentationml.slideshow")
+("potx" . "application/vnd.openxmlformats-officedocument.presentationml.template")
+("xlsx" . "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet")
+("xltx" . "application/vnd.openxmlformats-officedocument.spreadsheetml.template")
+("docx" . "application/vnd.openxmlformats-officedocument.wordprocessingml.document")
+("dotx" . "application/vnd.openxmlformats-officedocument.wordprocessingml.template")
+("mgp" . "application/vnd.osgeo.mapguide.package")
+("dp" . "application/vnd.osgi.dp")
+("esa" . "application/vnd.osgi.subsystem")
+("pdb" . "application/vnd.palm")
+("paw" . "application/vnd.pawaafile")
+("str" . "application/vnd.pg.format")
+("ei6" . "application/vnd.pg.osasli")
+("efif" . "application/vnd.picsel")
+("wg" . "application/vnd.pmi.widget")
+("plf" . "application/vnd.pocketlearn")
+("pbd" . "application/vnd.powerbuilder6")
+("box" . "application/vnd.previewsystems.box")
+("mgz" . "application/vnd.proteus.magazine")
+("qps" . "application/vnd.publishare-delta-tree")
+("ptid" . "application/vnd.pvi.ptid1")
+("qxd" . "application/vnd.quark.quarkxpress")
+("bed" . "application/vnd.realvnc.bed")
+("mxl" . "application/vnd.recordare.musicxml")
+("musicxml" . "application/vnd.recordare.musicxml+xml")
+("cryptonote" . "application/vnd.rig.cryptonote")
+("cod" . "application/vnd.rim.cod")
+("rm" . "application/vnd.rn-realmedia")
+("rmvb" . "application/vnd.rn-realmedia-vbr")
+("link66" . "application/vnd.route66.link66+xml")
+("st" . "application/vnd.sailingtracker.track")
+("see" . "application/vnd.seemail")
+("sema" . "application/vnd.sema")
+("semd" . "application/vnd.semd")
+("semf" . "application/vnd.semf")
+("ifm" . "application/vnd.shana.informed.formdata")
+("itp" . "application/vnd.shana.informed.formtemplate")
+("iif" . "application/vnd.shana.informed.interchange")
+("ipk" . "application/vnd.shana.informed.package")
+("twd" . "application/vnd.simtech-mindmapper")
+("mmf" . "application/vnd.smaf")
+("teacher" . "application/vnd.smart.teacher")
+("sdkm" . "application/vnd.solent.sdkm+xml")
+("dxp" . "application/vnd.spotfire.dxp")
+("sfs" . "application/vnd.spotfire.sfs")
+("sdc" . "application/vnd.stardivision.calc")
+("sda" . "application/vnd.stardivision.draw")
+("sdd" . "application/vnd.stardivision.impress")
+("smf" . "application/vnd.stardivision.math")
+("sdw" . "application/vnd.stardivision.writer")
+("sgl" . "application/vnd.stardivision.writer-global")
+("smzip" . "application/vnd.stepmania.package")
+("sm" . "application/vnd.stepmania.stepchart")
+("sxc" . "application/vnd.sun.xml.calc")
+("stc" . "application/vnd.sun.xml.calc.template")
+("sxd" . "application/vnd.sun.xml.draw")
+("std" . "application/vnd.sun.xml.draw.template")
+("sxi" . "application/vnd.sun.xml.impress")
+("sti" . "application/vnd.sun.xml.impress.template")
+("sxm" . "application/vnd.sun.xml.math")
+("sxw" . "application/vnd.sun.xml.writer")
+("sxg" . "application/vnd.sun.xml.writer.global")
+("stw" . "application/vnd.sun.xml.writer.template")
+("sus" . "application/vnd.sus-calendar")
+("svd" . "application/vnd.svd")
+("sis" . "application/vnd.symbian.install")
+("xsm" . "application/vnd.syncml+xml")
+("bdm" . "application/vnd.syncml.dm+wbxml")
+("xdm" . "application/vnd.syncml.dm+xml")
+("tao" . "application/vnd.tao.intent-module-archive")
+("pcap" . "application/vnd.tcpdump.pcap")
+("tmo" . "application/vnd.tmobile-livetv")
+("tpt" . "application/vnd.trid.tpt")
+("mxs" . "application/vnd.triscape.mxs")
+("tra" . "application/vnd.trueapp")
+("ufd" . "application/vnd.ufdl")
+("utz" . "application/vnd.uiq.theme")
+("umj" . "application/vnd.umajin")
+("unityweb" . "application/vnd.unity")
+("uoml" . "application/vnd.uoml+xml")
+("vcx" . "application/vnd.vcx")
+("vsd" . "application/vnd.visio")
+("vis" . "application/vnd.visionary")
+("vsf" . "application/vnd.vsf")
+("wbxml" . "application/vnd.wap.wbxml")
+("wmlc" . "application/vnd.wap.wmlc")
+("wmlsc" . "application/vnd.wap.wmlscriptc")
+("wtb" . "application/vnd.webturbo")
+("nbp" . "application/vnd.wolfram.player")
+("wpd" . "application/vnd.wordperfect")
+("wqd" . "application/vnd.wqd")
+("stf" . "application/vnd.wt.stf")
+("xar" . "application/vnd.xara")
+("xfdl" . "application/vnd.xfdl")
+("hvd" . "application/vnd.yamaha.hv-dic")
+("hvs" . "application/vnd.yamaha.hv-script")
+("hvp" . "application/vnd.yamaha.hv-voice")
+("osf" . "application/vnd.yamaha.openscoreformat")
+("osfpvg" . "application/vnd.yamaha.openscoreformat.osfpvg+xml")
+("saf" . "application/vnd.yamaha.smaf-audio")
+("spf" . "application/vnd.yamaha.smaf-phrase")
+("cmp" . "application/vnd.yellowriver-custom-menu")
+("zir" . "application/vnd.zul")
+("zaz" . "application/vnd.zzazz.deck+xml")
+("vxml" . "application/voicexml+xml")
+("wgt" . "application/widget")
+("hlp" . "application/winhlp")
+("wsdl" . "application/wsdl+xml")
+("wspolicy" . "application/wspolicy+xml")
+("7z" . "application/x-7z-compressed")
+("abw" . "application/x-abiword")
+("ace" . "application/x-ace-compressed")
+("dmg" . "application/x-apple-diskimage")
+("aab" . "application/x-authorware-bin")
+("aam" . "application/x-authorware-map")
+("aas" . "application/x-authorware-seg")
+("bcpio" . "application/x-bcpio")
+("torrent" . "application/x-bittorrent")
+("blb" . "application/x-blorb")
+("bz" . "application/x-bzip")
+("bz2" . "application/x-bzip2")
+("cbr" . "application/x-cbr")
+("vcd" . "application/x-cdlink")
+("cfs" . "application/x-cfs-compressed")
+("chat" . "application/x-chat")
+("pgn" . "application/x-chess-pgn")
+("nsc" . "application/x-conference")
+("cpio" . "application/x-cpio")
+("csh" . "application/x-csh")
+("deb" . "application/x-debian-package")
+("dgc" . "application/x-dgc-compressed")
+("dir" . "application/x-director")
+("wad" . "application/x-doom")
+("ncx" . "application/x-dtbncx+xml")
+("dtb" . "application/x-dtbook+xml")
+("res" . "application/x-dtbresource+xml")
+("dvi" . "application/x-dvi")
+("evy" . "application/x-envoy")
+("eva" . "application/x-eva")
+("bdf" . "application/x-font-bdf")
+("gsf" . "application/x-font-ghostscript")
+("psf" . "application/x-font-linux-psf")
+("otf" . "application/x-font-otf")
+("pcf" . "application/x-font-pcf")
+("snf" . "application/x-font-snf")
+("ttf" . "application/x-font-ttf")
+("pfa" . "application/x-font-type1")
+("woff" . "application/x-font-woff")
+("arc" . "application/x-freearc")
+("spl" . "application/x-futuresplash")
+("gca" . "application/x-gca-compressed")
+("ulx" . "application/x-glulx")
+("gnumeric" . "application/x-gnumeric")
+("gramps" . "application/x-gramps-xml")
+("gtar" . "application/x-gtar")
+("hdf" . "application/x-hdf")
+("install" . "application/x-install-instructions")
+("iso" . "application/x-iso9660-image")
+("jnlp" . "application/x-java-jnlp-file")
+("latex" . "application/x-latex")
+("lzh" . "application/x-lzh-compressed")
+("mie" . "application/x-mie")
+("prc" . "application/x-mobipocket-ebook")
+("m3u8" . "application/x-mpegurl")
+("application" . "application/x-ms-application")
+("lnk" . "application/x-ms-shortcut")
+("wmd" . "application/x-ms-wmd")
+("wmz" . "application/x-ms-wmz")
+("xbap" . "application/x-ms-xbap")
+("mdb" . "application/x-msaccess")
+("obd" . "application/x-msbinder")
+("crd" . "application/x-mscardfile")
+("clp" . "application/x-msclip")
+("exe" . "application/x-msdownload")
+("mvb" . "application/x-msmediaview")
+("wmf" . "application/x-msmetafile")
+("mny" . "application/x-msmoney")
+("pub" . "application/x-mspublisher")
+("scd" . "application/x-msschedule")
+("trm" . "application/x-msterminal")
+("wri" . "application/x-mswrite")
+("nc" . "application/x-netcdf")
+("nzb" . "application/x-nzb")
+("p12" . "application/x-pkcs12")
+("p7b" . "application/x-pkcs7-certificates")
+("p7r" . "application/x-pkcs7-certreqresp")
+("rar" . "application/x-rar-compressed")
+("ris" . "application/x-research-info-systems")
+("sh" . "application/x-sh")
+("shar" . "application/x-shar")
+("swf" . "application/x-shockwave-flash")
+("xap" . "application/x-silverlight-app")
+("sql" . "application/x-sql")
+("sit" . "application/x-stuffit")
+("sitx" . "application/x-stuffitx")
+("srt" . "application/x-subrip")
+("sv4cpio" . "application/x-sv4cpio")
+("sv4crc" . "application/x-sv4crc")
+("t3" . "application/x-t3vm-image")
+("gam" . "application/x-tads")
+("tar" . "application/x-tar")
+("tcl" . "application/x-tcl")
+("tex" . "application/x-tex")
+("tfm" . "application/x-tex-tfm")
+("texinfo" . "application/x-texinfo")
+("obj" . "application/x-tgif")
+("ustar" . "application/x-ustar")
+("src" . "application/x-wais-source")
+("der" . "application/x-x509-ca-cert")
+("fig" . "application/x-xfig")
+("xlf" . "application/x-xliff+xml")
+("xpi" . "application/x-xpinstall")
+("xz" . "application/x-xz")
+("z1" . "application/x-zmachine")
+("xaml" . "application/xaml+xml")
+("xdf" . "application/xcap-diff+xml")
+("xenc" . "application/xenc+xml")
+("xhtml" . "application/xhtml+xml")
+("xml" . "application/xml")
+("dtd" . "application/xml-dtd")
+("xop" . "application/xop+xml")
+("xpl" . "application/xproc+xml")
+("xslt" . "application/xslt+xml")
+("xspf" . "application/xspf+xml")
+("mxml" . "application/xv+xml")
+("yang" . "application/yang")
+("yin" . "application/yin+xml")
+("zip" . "application/zip")
+("adp" . "audio/adpcm")
+("au" . "audio/basic")
+("mid" . "audio/midi")
+("mp4a" . "audio/mp4")
+("m4a" . "audio/mp4a-latm")
+("mpga" . "audio/mpeg")
+("oga" . "audio/ogg")
+("s3m" . "audio/s3m")
+("sil" . "audio/silk")
+("uva" . "audio/vnd.dece.audio")
+("eol" . "audio/vnd.digital-winds")
+("dra" . "audio/vnd.dra")
+("dts" . "audio/vnd.dts")
+("dtshd" . "audio/vnd.dts.hd")
+("lvp" . "audio/vnd.lucent.voice")
+("pya" . "audio/vnd.ms-playready.media.pya")
+("ecelp4800" . "audio/vnd.nuera.ecelp4800")
+("ecelp7470" . "audio/vnd.nuera.ecelp7470")
+("ecelp9600" . "audio/vnd.nuera.ecelp9600")
+("rip" . "audio/vnd.rip")
+("weba" . "audio/webm")
+("aac" . "audio/x-aac")
+("aif" . "audio/x-aiff")
+("caf" . "audio/x-caf")
+("flac" . "audio/x-flac")
+("mka" . "audio/x-matroska")
+("m3u" . "audio/x-mpegurl")
+("wax" . "audio/x-ms-wax")
+("wma" . "audio/x-ms-wma")
+("ram" . "audio/x-pn-realaudio")
+("rmp" . "audio/x-pn-realaudio-plugin")
+("wav" . "audio/x-wav")
+("xm" . "audio/xm")
+("cdx" . "chemical/x-cdx")
+("cif" . "chemical/x-cif")
+("cmdf" . "chemical/x-cmdf")
+("cml" . "chemical/x-cml")
+("csml" . "chemical/x-csml")
+("xyz" . "chemical/x-xyz")
+("bmp" . "image/bmp")
+("cgm" . "image/cgm")
+("g3" . "image/g3fax")
+("gif" . "image/gif")
+("ief" . "image/ief")
+("jp2" . "image/jp2")
+("jpeg" . "image/jpeg")
+("ktx" . "image/ktx")
+("pict" . "image/pict")
+("png" . "image/png")
+("btif" . "image/prs.btif")
+("sgi" . "image/sgi")
+("svg" . "image/svg+xml")
+("tiff" . "image/tiff")
+("psd" . "image/vnd.adobe.photoshop")
+("uvi" . "image/vnd.dece.graphic")
+("sub" . "image/vnd.dvb.subtitle")
+("djvu" . "image/vnd.djvu")
+("dwg" . "image/vnd.dwg")
+("dxf" . "image/vnd.dxf")
+("fbs" . "image/vnd.fastbidsheet")
+("fpx" . "image/vnd.fpx")
+("fst" . "image/vnd.fst")
+("mmr" . "image/vnd.fujixerox.edmics-mmr")
+("rlc" . "image/vnd.fujixerox.edmics-rlc")
+("mdi" . "image/vnd.ms-modi")
+("wdp" . "image/vnd.ms-photo")
+("npx" . "image/vnd.net-fpx")
+("wbmp" . "image/vnd.wap.wbmp")
+("xif" . "image/vnd.xiff")
+("webp" . "image/webp")
+("3ds" . "image/x-3ds")
+("ras" . "image/x-cmu-raster")
+("cmx" . "image/x-cmx")
+("fh" . "image/x-freehand")
+("ico" . "image/x-icon")
+("pntg" . "image/x-macpaint")
+("sid" . "image/x-mrsid-image")
+("pcx" . "image/x-pcx")
+("pic" . "image/x-pict")
+("pnm" . "image/x-portable-anymap")
+("pbm" . "image/x-portable-bitmap")
+("pgm" . "image/x-portable-graymap")
+("ppm" . "image/x-portable-pixmap")
+("qtif" . "image/x-quicktime")
+("rgb" . "image/x-rgb")
+("tga" . "image/x-tga")
+("xbm" . "image/x-xbitmap")
+("xpm" . "image/x-xpixmap")
+("xwd" . "image/x-xwindowdump")
+("eml" . "message/rfc822")
+("igs" . "model/iges")
+("msh" . "model/mesh")
+("dae" . "model/vnd.collada+xml")
+("dwf" . "model/vnd.dwf")
+("gdl" . "model/vnd.gdl")
+("gtw" . "model/vnd.gtw")
+("mts" . "model/vnd.mts")
+("vtu" . "model/vnd.vtu")
+("wrl" . "model/vrml")
+("x3db" . "model/x3d+binary")
+("x3dv" . "model/x3d+vrml")
+("x3d" . "model/x3d+xml")
+("manifest" . "text/cache-manifest")
+("appcache" . "text/cache-manifest")
+("ics" . "text/calendar")
+("css" . "text/css")
+("csv" . "text/csv")
+("html" . "text/html")
+("n3" . "text/n3")
+("txt" . "text/plain")
+("dsc" . "text/prs.lines.tag")
+("rtx" . "text/richtext")
+("sgml" . "text/sgml")
+("tsv" . "text/tab-separated-values")
+("t" . "text/troff")
+("ttl" . "text/turtle")
+("uri" . "text/uri-list")
+("vcard" . "text/vcard")
+("curl" . "text/vnd.curl")
+("dcurl" . "text/vnd.curl.dcurl")
+("scurl" . "text/vnd.curl.scurl")
+("mcurl" . "text/vnd.curl.mcurl")
+("sub" . "text/vnd.dvb.subtitle")
+("fly" . "text/vnd.fly")
+("flx" . "text/vnd.fmi.flexstor")
+("gv" . "text/vnd.graphviz")
+("3dml" . "text/vnd.in3d.3dml")
+("spot" . "text/vnd.in3d.spot")
+("jad" . "text/vnd.sun.j2me.app-descriptor")
+("wml" . "text/vnd.wap.wml")
+("wmls" . "text/vnd.wap.wmlscript")
+("s" . "text/x-asm")
+("c" . "text/x-c")
+("f" . "text/x-fortran")
+("java" . "text/x-java-source")
+("opml" . "text/x-opml")
+("p" . "text/x-pascal")
+("nfo" . "text/x-nfo")
+("etx" . "text/x-setext")
+("sfv" . "text/x-sfv")
+("uu" . "text/x-uuencode")
+("vcs" . "text/x-vcalendar")
+("vcf" . "text/x-vcard")
+("3gp" . "video/3gpp")
+("3g2" . "video/3gpp2")
+("h261" . "video/h261")
+("h263" . "video/h263")
+("h264" . "video/h264")
+("jpgv" . "video/jpeg")
+("jpm" . "video/jpm")
+("mj2" . "video/mj2")
+("ts" . "video/mp2t")
+("mp4" . "video/mp4")
+("mpeg" . "video/mpeg")
+("ogv" . "video/ogg")
+("qt" . "video/quicktime")
+("uvh" . "video/vnd.dece.hd")
+("uvm" . "video/vnd.dece.mobile")
+("uvp" . "video/vnd.dece.pd")
+("uvs" . "video/vnd.dece.sd")
+("uvv" . "video/vnd.dece.video")
+("dvb" . "video/vnd.dvb.file")
+("fvt" . "video/vnd.fvt")
+("mxu" . "video/vnd.mpegurl")
+("pyv" . "video/vnd.ms-playready.media.pyv")
+("uvu" . "video/vnd.uvvu.mp4")
+("viv" . "video/vnd.vivo")
+("dv" . "video/x-dv")
+("webm" . "video/webm")
+("f4v" . "video/x-f4v")
+("fli" . "video/x-fli")
+("flv" . "video/x-flv")
+("m4v" . "video/x-m4v")
+("mkv" . "video/x-matroska")
+("mng" . "video/x-mng")
+("asf" . "video/x-ms-asf")
+("vob" . "video/x-ms-vob")
+("wm" . "video/x-ms-wm")
+("wmv" . "video/x-ms-wmv")
+("wmx" . "video/x-ms-wmx")
+("wvx" . "video/x-ms-wvx")
+("avi" . "video/x-msvideo")
+("movie" . "video/x-sgi-movie")
+("smv" . "video/x-smv")
+("ice" . "x-conference/x-cooltalk")))
+
+(use srfi-19)
+(use test)
+;;(use format)
+(use regex)
+;(declare (unit wwdate))
+;; utility procedures to convert among
+;; different ways to express date (wwdate, seconds since epoch, isodate)
+;;
+;; samples:
+;; isodate   -> "2016-01-01"
+;; wwdate -> "16ww01.5"
+;; seconds   -> 1451631600
+
+;; procedures provided:
+;; ====================
+;; seconds->isodate
+;; seconds->wwdate
+;;
+;; isodate->seconds
+;; isodate->wwdate
+;;
+;; wwdate->seconds
+;; wwdate->isodate
+
+;; srfi-19 used extensively; this doc is better tha the eggref:
+;; http://srfi.schemers.org/srfi-19/srfi-19.html
+
+;; Author: brandon.j.barclay@intel.com 16ww18.6
+
+(define (date->seconds date)
+  (inexact->exact
+   (string->number
+    (date->string date "~s"))))
+
+(define (seconds->isodate seconds)
+  (let* ((date (seconds->date seconds))
+         (result (date->string date "~Y-~m-~d")))
+    result))
+
+(define (isodate->seconds isodate)
+  "Takes a string input of the form 'YY-MM-DD' or 'YYYY-MM-DD' and returns epoch time; for YY, assume after Y2K"
+  (let* ((numlist (map string->number (string-split isodate "-")))
+        (raw-year (car numlist))
+        (year (if (< raw-year 100) (+ raw-year 2000) raw-year))
+        (month (list-ref numlist 1))
+        (day (list-ref numlist 2))
+        (date (make-date 0 0 0 0 day month year))
+        (seconds (date->seconds date)))
+
+    seconds))
+
+;; adapted from perl Intel::WorkWeek perl module
+;; workweek year consists of numbered weeks starting from week 1
+;;   days of week are numbered starting from 0 on sunday
+;;   weeks begin on sunday- day number 0 and end saturday- day 6
+;;   week 1 is defined as the week containing jan 1 of the year
+;;   workweek year does not match calendar year in workweek 1
+;;     since workweek 1 contains jan1 and workweek begins sunday,
+;;     days prior to jan1 in workweek 1 belong to the next workweek year
+(define (seconds->wwdate-values seconds)
+  (define (date-difference->seconds d1 d2)
+    (- (date->seconds d1) (date->seconds d2)))
+
+  (let* ((thisdate (seconds->date seconds))
+         (thisdow (string->number (date->string thisdate "~w")))
+
+         (year (date-year thisdate))
+         ;; intel workweek 1 begins on sunday of week containing jan1
+         (jan1 (make-date 0 0 0 0 1 1 year))
+         (jan1dow (date-week-day jan1))
+         (ww01 (date-subtract-duration jan1 (seconds->time (* 60 60 24 jan1dow))))
+
+         (ww01_delta_seconds (date-difference->seconds thisdate ww01))
+         (wwnum_initial (inexact->exact (add1 (floor (/ ww01_delta_seconds 24 3600 7) ))))
+         
+         ;; we could be in ww1 of next year
+         (this-saturday (seconds->date
+                         (+ seconds
+                            (* 60 60 24 (- 6 thisdow)))))
+         (this-week-ends-next-year?
+          (> (date-year this-saturday) year))
+         (intelyear
+          (if this-week-ends-next-year?
+              (add1 year)
+              year))
+         (intelweek
+          (if this-week-ends-next-year?
+              1
+              wwnum_initial)))
+   (values intelyear intelweek thisdow)))
+
+(define (string-leftpad in width pad-char)
+  (let* ((unpadded-str (->string in))
+         (padlen_temp (- width (string-length unpadded-str)))
+         (padlen (if (< padlen_temp 0) 0 padlen_temp))
+         (padding (make-string padlen pad-char)))
+    (conc padding unpadded-str)))
+
+(define (string-rightpad in width pad-char)
+  (let* ((unpadded-str (->string in))
+         (padlen_temp (- width (string-length unpadded-str)))
+         (padlen (if (< padlen_temp 0) 0 padlen_temp))
+         (padding (make-string padlen pad-char)))
+    (conc unpadded-str padding)))
+
+(define (zeropad num width)
+  (string-leftpad num width #\0))
+
+(define (seconds->wwdate seconds)
+
+  (let-values (((intelyear intelweek day-of-week-num)
+                (seconds->wwdate-values seconds)))
+    (let ((intelyear-str
+           (zeropad
+            (->string
+             (if (> intelyear 1999)
+                 (- intelyear 2000) intelyear))
+            2))
+          (intelweek-str
+           (zeropad (->string intelweek) 2))
+          (dow-str (->string day-of-week-num)))
+      (conc intelyear-str "ww" intelweek-str "." dow-str))))
+
+(define (isodate->wwdate isodate)
+  (seconds->wwdate
+   (isodate->seconds isodate)))
+
+(define (wwdate->seconds wwdate)
+  (let ((match (string-match "^(\\d+)ww(\\d+).(\\d)$" wwdate)))
+    (if
+     (not match)
+     #f
+     (let* (
+            (intelyear-raw (string->number (list-ref match 1)))
+            (intelyear (if (< intelyear-raw 100)
+                           (+ intelyear-raw 2000)
+                           intelyear-raw))
+            (intelww (string->number (list-ref match 2)))
+            (dayofweek (string->number (list-ref match 3)))
+
+            (day-of-seconds (* 60 60 24 ))
+            (week-of-seconds (* day-of-seconds 7))
+            
+
+            ;; get seconds at ww1.0
+            (new-years-date (make-date 0 0 0 0 1 1 intelyear))
+            (new-years-seconds
+             (date->seconds new-years-date))
+            (new-years-dayofweek (date-week-day new-years-date))
+            (ww1.0_seconds (- new-years-seconds
+                              (* day-of-seconds
+                                 new-years-dayofweek)))
+            (workweek-adjustment (* week-of-seconds (sub1 intelww)))
+            (weekday-adjustment (* dayofweek day-of-seconds))
+
+            (result (+ ww1.0_seconds workweek-adjustment weekday-adjustment)))
+       result))))
+
+(define (wwdate->isodate wwdate)
+  (seconds->isodate (wwdate->seconds wwdate)))
+
+(define (current-wwdate)
+  (seconds->wwdate (current-seconds)))
+
+(define (current-isodate)
+  (seconds->isodate (current-seconds)))
+
+(define (wwdate-tests)
+  (test-group
+   "date conversion tests"
+   (let ((test-table
+          '(("16ww01.5" . "2016-01-01")
+            ("16ww18.5" . "2016-04-29")
+            ("1999ww33.5" . "1999-08-13")
+            ("16ww18.4" . "2016-04-28")
+            ("16ww18.3" . "2016-04-27")
+            ("13ww01.0" . "2012-12-30")
+            ("13ww52.6" . "2013-12-28")
+            ("16ww53.3" . "2016-12-28"))))
+     (for-each
+      (lambda (test-pair)
+        (let ((wwdate (car test-pair))
+              (isodate (cdr test-pair)))
+          (test
+           (conc "(isodate->wwdate "isodate ") => "wwdate)
+           wwdate
+           (isodate->wwdate isodate))
+          
+          (test
+           (conc "(wwdate->isodate "wwdate ")   => "isodate)
+           isodate
+           (wwdate->isodate wwdate))))
+      test-table))))
+
+
+(define (ext->mimetype ext)
+  (let ((x (assoc ext ducttape_ext2mimetype)))
+   (if x (cdr x) "text/plain")))
+
+  
+  (define ducttape-lib-version 1.00)
+  (define (toplevel-command sym proc) (lambda () #f))
+
+  ;; like shell "which" command
+  (define (find-exe exe)
+    (let* ((path-items
+            (string-split
+             (or
+              (get-environment-variable "PATH") "")
+             ":")))
+
+      (let loop ((rest-path-items path-items))
+        (if (null? rest-path-items)
+            #f
+            (let* ((this-dir (car rest-path-items))
+                   (next-rest (cdr rest-path-items))
+                   (candidate (conc this-dir "/" exe)))
+              (if (file-execute-access? candidate)
+                  candidate
+                  (loop next-rest)))))))
+
+
+  
+;;;; define some handy globals
+  ;; resolve fullpath to this script or binary.
+  (define (__get-this-script-fullpath #!key (argv (argv)))
+    (let* ((this-script
+            (cond
+             ((and (> (length argv) 2)
+                   (string-match "^(.*/csi|csi)$" (car argv))
+                   (string-match "^-(s|ss|sx|script)$" (cadr argv)))
+              (caddr argv))
+             (else (car argv))))
+           
+           ;;(foo (begin (print "hello "(find-exe "/bin/sh") #f)))
+           (fullpath (or (find-exe this-script) (realpath this-script))))
+      fullpath))
+  
+  (define *this-exe-fullpath* (__get-this-script-fullpath))
+  (define *this-exe-dir*      (pathname-directory *this-exe-fullpath*))
+  (define *this-exe-name*     (pathname-strip-directory *this-exe-fullpath*))
+  
+
+;;;; utility procedures
+
+
+  
+  ;; begin credit: megatest's process.scm
+  (define (port->list fh )
+    (if (eof-object? fh) #f
+        (let loop ((curr (read-line fh))
+                   (result '()))
+          (if (not (eof-object? curr))
+              (loop (read-line fh)
+                    (append result (list curr)))
+              result))))
+
+  (define (conservative-read port)
+    (let loop ((res ""))
+      (if (not (eof-object? (peek-char port)))
+          (loop (conc res (read-char port)))
+          res)))
+  ;; end credit: megatest's process.scm
+
+  (define (counter-maker)
+    (let ((acc 0))
+      (lambda ( #!optional (increment 1) )
+        (set! acc (+ increment acc))
+        acc)))
+
+  (define (port->string port #!optional ) ; todo - add newline 
+    (let ((linelist (port->list port)))
+      (if linelist
+          (string-join linelist "\n")
+          "")))
+
+
+  (define (outport->foreach outport foreach-thunk)
+    (let loop ((line (foreach-thunk)))
+      (if line
+          (begin
+            (write-line line outport)
+            (loop (foreach-thunk))
+            )
+          (begin
+            ;;http://bugs.call-cc.org/ticket/766
+            ;;close-[input|output]-port implicitly calling process-wait on process pipe ports. This leads to errors like
+            ;;Error: (process-wait) waiting for child process failed - No child processes: 10872
+            (close-output-port outport)
+            #f))))
+  
+  ;; weird - alist-ref arg order changes signature csc vs. csi... explitly defining.
+  (define (my-alist-ref key alist)
+    (let ((res (assoc key alist)))
+      (if res (cdr res) #f)))
+
+  (define (keyword-skim-alist args alist)
+    (let loop ((result-alist '()) (result-args args) (rest-alist alist))
+      (cond
+       ((null? rest-alist) (values result-alist result-args))
+       (else
+        (let ((keyword (caar rest-alist))
+              (defval (cdar rest-alist)))
+          (let-values (((kwval result-args2)
+                        (keyword-skim
+                         keyword
+                         defval
+                         result-args)))
+            (loop
+             (cons (cons keyword kwval) result-alist)
+             result-args2
+             (cdr rest-alist))))))))
+  
+  (define (isys command . rest-args)
+    (let-values
+        (((opt-alist args)
+          (keyword-skim-alist
+           rest-args
+           '( ( foreach-stdout-thunk: . #f )
+              ( foreach-stdin-thunk: . #f )
+              ( stdin-proc: . #f ) ) )))
+      (let* ((foreach-stdout-thunk
+              (my-alist-ref foreach-stdout-thunk: opt-alist))
+             (foreach-stdin-thunk
+              (my-alist-ref foreach-stdin-thunk: opt-alist))
+             (stdin-proc
+              (if foreach-stdin-thunk
+                  (lambda (port)
+                    (outport->foreach port foreach-stdin-thunk))
+                  (my-alist-ref stdin-proc: opt-alist))))
+
+        ;; TODO: support command is list.
+        
+        (let-values (((stdout stdin pid stderr)
+                      (if (null? args)
+                          (process* command)
+                          (process* command args))))
+          
+                                        ;(if foreach-stdin-thunk
+                                        ;    (set! stdin-proc
+                                        ;          (lambda (port)
+                                        ;            (outport->foreach port foreach-stdin-thunk))))
+          
+          (if stdin-proc
+              (stdin-proc stdin))
+          
+          (let ((stdout-res 
+                 (if foreach-stdout-thunk  ;; don't accumulate stdout if we have a thunk; probably doing this because stdout is BIG so lets not waste memory
+                     (begin
+                       (port-for-each foreach-stdout-thunk (lambda () (read-line stdout)))
+                       "foreach-stdout-thunk ate stdout"
+                       )
+                     (if stdin-proc
+                         "foreach-stdin-thunk/stdin-proc blocks stdout"
+                         (port->string stdout))))
+                (stderr-res
+                 (if stdin-proc
+                     "foreach-stdin-thunk/stdin-proc blocks stdout"
+                     (port->string stderr))))
+
+            ;; if we've used a stdin-proc, we've closed stdin port, which unfortunately causes a wait-pid internally, causing stdout and stderr ports to auto-close.  don't close them again.  (so sad - we lost stdout and stderr contents when we write to stdin)
+            ;; see - http://bugs.call-cc.org/ticket/766
+            (if (not stdin-proc)
+                (close-input-port stdout)
+                (close-input-port stderr))
+            
+            (let-values (((anotherpid normalexit? exitstatus)  (process-wait pid)))
+              (values exitstatus stdout-res stderr-res)))))))
+  
+  (define (do-or-die command   #!key nodie (foreach-stdout #f) (stdin-proc #f))
+    (let-values (((exit-code stdout-str stderr-str) (isys command foreach-stdout-thunk: foreach-stdout stdin-proc: stdin-proc )))
+      (if (equal? 0 exit-code)
+          stdout-str
+          (begin
+            (ierr (conc "Command  > " command " "  "< failed with " exit-code " because: \n" stderr-str) )
+            (if nodie #f (exit exit-code))))))
+
+
+  ;; runs-ok: evaluate expression while suppressing exceptions.
+                                        ;    on caught exception, returns #f
+                                        ;    otherwise, returns expression value
+  (define (runs-ok thunk)
+    (handle-exceptions exn #f (begin (thunk) #t)))
+
+  ;; concat-lists: result list = lista + listb
+  (define (concat-lists lista listb) ;; ok, I just reimplemented append...
+    (foldr cons listb lista))
+  
+
+;;; setup general_lib env var parameters
+
+  ;; show warning/note/error/debug prefixes using ansi colors
+  (define ducttape-color-mode
+    (make-parameter (get-environment-variable "DUCTTAPE_COLORIZE")))
+
+  ;; if defined, has number value.  if number value > 0, show debug messages
+  ;; value should be decremented in subshells -- idea is raising debug level will show debug messages deeper and deeper in process call stack
+  (define ducttape-debug-level
+    (make-parameter
+     (let ( (raw-debug-level (get-environment-variable "DUCTTAPE_DEBUG_LEVEL")) )
+       (if raw-debug-level
+           (let ((num-debug-level (runs-ok (string->number raw-debug-level))))
+             (if (integer? num-debug-level)
+                 (begin
+                   (let ((new-num-debug-level (- num-debug-level 1)))
+                     (if (> new-num-debug-level 0) ;; decrement
+                         (setenv "DUCTTAPE_DEBUG_LEVEL" (number->string new-num-debug-level))
+                         (unsetenv "DUCTTAPE_DEBUG_LEVEL")))
+                   num-debug-level) ; it was set and > 0, mode is value
+                 (begin
+                   (unsetenv "DUCTTAPE_DEBUG_LEVEL") ;; value was invalid, unset it
+                   #f))) ; value was invalid, mode is f
+           #f)))) ; var not set, mode is f
+
+
+  (define ducttape-debug-mode (if (ducttape-debug-level)  #t  #f))
+
+  ;; ducttape-debug-regex-filter suppresses non-matching debug messages
+  (define ducttape-debug-regex-filter
+    (make-parameter
+     (let ((raw-debug-pattern (get-environment-variable "DUCTTAPE_DEBUG_PATTERN")))
+       (if raw-debug-pattern
+           raw-debug-pattern
+           "."))))
+
+  ;; silent mode suppresses Note and Warning type messages
+  (define ducttape-silent-mode
+    (make-parameter (get-environment-variable "DUCTTAPE_SILENT_MODE")))
+
+  ;; quiet mode suppresses Note type messages
+  (define ducttape-quiet-mode
+    (make-parameter (get-environment-variable "DUCTTAPE_QUIET_MODE")))
+
+  ;; if log file is defined, warning/note/error/debug messages are appended
+  ;; to named logfile.
+  (define ducttape-log-file
+    (make-parameter (get-environment-variable "DUCTTAPE_LOG_FILE")))
+
+
+
+
+  
+  
+;;; standard messages printing implementation
+
+                                        ; get the name of the current script/binary being run
+  (define (script-name)
+    (car (reverse (string-split (car (argv)) "/"))))
+
+  (define (ducttape-timestamp)
+    (rfc3339->string (time->rfc3339 (seconds->local-time))))
+
+
+  (define (iputs-preamble msg-type #!optional (suppress-color #f))
+    (let ((do-color (and
+                     (not suppress-color)
+                     (ducttape-color-mode)
+                     (terminal-port? (current-error-port)))))
+      (case msg-type
+        ((note)
+         (if do-color
+             (set-text (list 'fg-green 'bg-black 'bold) "Note:")
+             "Note:"
+             ))
+        ((warn)
+         (if do-color
+             (set-text (list 'fg-yellow 'bg-black 'bold) "Warning:")
+             "Warning:"
+             ))
+        ((err)
+         (if do-color
+             (set-text (list 'fg-red 'bg-black 'bold) "Error:")
+             "Error:"
+             ))
+        ((dbg)
+         (if do-color
+             (set-text (list 'fg-blue 'bg-magenta) "Debug:")
+             "Debug:"
+             )))))
+
+  (define (ducttape-append-logfile msg-type message #!optional (suppress-preamble #f))
+    (let
+        ((txt 
+          (string-join 
+           (list 
+            (ducttape-timestamp) 
+            (script-name)
+            (if suppress-preamble
+                message
+                (string-join  (list (iputs-preamble msg-type #t) message) " ")))
+           " | ")))
+
+      (if (ducttape-log-file)
+          (runs-ok
+           (call-with-output-file (ducttape-log-file)
+             (lambda (output-port)
+               (format output-port "~A ~%" txt)
+               )
+             #:append))
+          #t)))
+
+  (define (ducttape-activate-logfile #!optional (logfile #f))
+    ;; from python ducttape-lib.py
+                                        ; message = "START - pid=%d ppid=%d argv=(%s) pwd=%s user=%s host=%s"%(pid,ppid," ".join("'"+x+"'" for x in sys.argv),os.environ['PWD'],os.getenv('USER','nouser'),os.getenv('HOST','nohost') )
+    (let ((pid (number->string (current-process-id)))
+          (ppid (number->string (parent-process-id)))
+          (argv 
+           (string-join 
+            (map 
+             (lambda (x) 
+               (string-join (list "\"" x "\"")  "" ))
+             (argv))
+            " "))
+          (pwd (or (get-environment-variable "PWD") "nopwd"))
+          (user (or (get-environment-variable "USER") "nouser"))
+          (host (or (get-environment-variable "HOST") "nohost")))
+      (if logfile
+          (begin
+            (ducttape-log-file logfile)
+            (setenv "DUCTTAPE_LOG_FILE" (ducttape-log-file))))
+      (ducttape-append-logfile 'note (format #f "START - pid=~A ppid=~A argv=(~A) pwd=~A user=~A host=~A" pid ppid argv pwd user host) #t)))         
+
+
+  ;; log exit code
+  (define (set-ducttape-log-exit-handler)
+    (let ((orig-exit-handler (exit-handler)))
+      (exit-handler 
+       (lambda (exitcode) 
+         (ducttape-append-logfile 'note (format #f "Exit ~A by sys.exit" exitcode) #t)
+         (orig-exit-handler exitcode)))))
+
+
+  (define (idbg first-message  . rest-args)
+    (let* ((debug-level-threshold
+            (if (> (length rest-args) 0) (car rest-args) 1))
+           (message-list
+            (if (> (length rest-args) 1)
+                (cons first-message (cdr rest-args))
+                (list first-message)) )
+           (message (apply conc
+                  (map ->string message-list))))
+
+      (ducttape-append-logfile 'dbg message)
+      (if (ducttape-debug-level)
+          (if (<= debug-level-threshold (ducttape-debug-level))
+              (if (string-search (ducttape-debug-regex-filter) message)
+                  (begin 
+                    (format (current-error-port) "~A ~A (~A)~%" (iputs-preamble 'dbg) message (script-name))))))))
+
+  (define (ierr message-first  . message-rest)
+    (let* ((message
+            (apply conc
+             (map ->string (cons message-first message-rest)))))
+      (ducttape-append-logfile 'err message)
+      (format (current-error-port) "~A ~A (~A)~%" (iputs-preamble 'err) message (script-name))))
+
+  (define (iwarn message-first  . message-rest)
+    (let* ((message
+            (apply conc
+             (map ->string (cons message-first message-rest)))))
+      (ducttape-append-logfile 'warn message)
+      (if (not (ducttape-silent-mode))
+          (begin
+            (format (current-error-port) "~A ~A (~A)~%" (iputs-preamble 'warn) message (script-name))))))
+
+  (define (inote message-first  . message-rest)
+    (let* ((message
+            (apply conc
+             (map ->string (cons message-first message-rest)))))
+      (ducttape-append-logfile 'note message)
+      (if (not (or (ducttape-silent-mode) (ducttape-quiet-mode)))
+          (begin 
+            (format (current-error-port) "~A ~A (~A)~%" (iputs-preamble 'note) message (script-name))))))
+
+  
+  (define (iputs kind message #!optional (debug-level-threshold 1))
+    (cond
+     ((member kind (string-split "NOTE/Note/note/n/N" "/")) (inote message))
+     ((member kind (string-split "Error/ERROR/error/Err/ERR/err/E/e" "/")) (ierr message))
+     ((member kind
+              (string-split "Warning/WARNING/warning/Warn/WARN/warn/W/w" "/"))
+      (iwarn message))
+     ((member kind (string-split "Debug/DEBUG/debug/Dbg/DBG/dbg/D/d" "/"))
+      (idbg message debug-level-threshold))))
+
+  (define (mkdir-recursive path-so-far hier-list-to-create)
+    (if (null? hier-list-to-create)
+        path-so-far
+        (let* ((next-hier-item (car hier-list-to-create))
+               (rest-hier-items (cdr hier-list-to-create))
+               (path-to-mkdir (string-concatenate (list path-so-far "/" next-hier-item))))
+          (if (runs-ok (lambda () (create-directory path-to-mkdir)))
+              (mkdir-recursive path-to-mkdir rest-hier-items)
+              #f))))
+
+                                        ; ::mkdir-if-not-exists::
+                                        ; make a dir recursively if it does not 
+                                        ; already exist.
+                                        ; on success - returns path
+                                        ; on fail - returns #f
+  (define (mkdirp-if-not-exists the-dir)
+    (let ( (path-list (string-split the-dir "/")))
+      (mkdir-recursive "/" path-list)))
+
+                                        ; ::mkdir-if-not-exists::
+                                        ; make a dir recursively if it does not 
+                                        ; already exist.
+                                        ; on success - returns path
+                                        ; on fail - returns #f
+
+
+  (define (mkdirp-if-not-exists the-dir)
+    (let ( (path-list (string-split the-dir "/")))
+      (mkdir-recursive "/" path-list)))
+
+  (define (dir-is-writable? the-dir)
+    (let ((dummy-file (string-concatenate (list the-dir "/.dummyfile"))))
+      (and
+       (file-exists? the-dir)
+       (cond 
+        ((runs-ok (lambda ()(with-output-to-file dummy-file (lambda () (print "foo")))))
+         (begin
+           (runs-ok (lambda () (delete-file dummy-file) ))
+           the-dir))
+        (else #f)))))
+
+
+  (define (get-tmpdir )
+    (let* ((tmproot
+            (dir-is-writable?
+             (or 
+              (get-environment-variable "TMPDIR") 
+              "/tmp")))
+
+           (user
+            (or
+             (get-environment-variable "USER")
+             "USER_Envvar_not_set"))
+           (tmppath
+            (string-concatenate 
+             (list tmproot "/env21-general-" user ))))
+
+      (dir-is-writable?
+       (mkdirp-if-not-exists
+        tmppath))))
+
+  (define (mktemp
+           #!optional
+           (prefix "general_lib_tmpfile")
+           (dir #f))
+    (let-values
+        (((fd path) 
+          (file-mkstemp 
+           (conc 
+            (if dir  dir  (get-tmpdir))
+            "/" prefix ".XXXXXX"))))
+      (close-output-port (open-output-file* fd))
+      path))
+
+
+
+  ;;http://stackoverflow.com/questions/11134857/using-sendmail-for-html-body-and-binary-attachment
+  ;; write send-email using:
+  ;;   - isys-foreach-stdin-line
+  ;;   - formatting in http://stackoverflow.com/questions/11134857/using-sendmail-for-html-body-and-binary-attachment
+  (define (sendmail to_addr subject body
+                    #!key
+                    (from_addr "admin")
+                    cc_addr
+                    bcc_addr
+                    more-headers
+                    use_html
+                    (attach-files-list '())
+                    (images-with-content-id-alist '())
+                    )
+
+    (define (sendmail-proc sendmail-port)
+      (define (wl line-str)
+        (write-line line-str sendmail-port))
+
+      (define (get-uuid)
+        (string-upcase (uuid->string (uuid-generate))))
+
+      (let ((mailpart-uuid (get-uuid))
+            (mailpart-body-uuid (get-uuid)))
+        
+        (define (boundary)
+          (wl (conc "--" mailpart-uuid)))
+
+        (define (body-boundary)
+          (wl (conc "--" mailpart-body-uuid)))
+
+
+        (define (email-mime-header)
+          (wl (conc "From: " from_addr))
+          (wl (conc "To: " to_addr))
+          (if cc_addr
+              (wl (conc "Cc: " cc_addr)))
+          (if bcc_addr
+              (wl (conc "Bcc: " bcc_addr)))
+          (if more-headers
+              (wl more-headers))
+          (wl (conc "Subject: " subject))
+          (wl "MIME-Version: 1.0")
+          (wl (conc "Content-Type: multipart/mixed; boundary=\"" mailpart-uuid "\""))
+          (wl "")
+          (boundary)
+          (wl (conc "Content-Type: multipart/alternative; boundary=\"" mailpart-body-uuid "\""))
+          (wl "")
+          )
+
+        
+        (define (email-text-body)
+          (body-boundary)
+          (wl "Content-Type: text/plain; charset=ISO-8859-1")
+          (wl "Content-Disposition: inline")
+          (wl "")
+          (wl body)
+          (body-boundary))
+        
+        (define (email-html-body)
+          (body-boundary)
+          (wl "Content-Type: text/plain; charset=ISO-8859-1")
+          (wl "")
+          (wl "You need to enable HTML option for email")
+          (body-boundary)
+          (wl "Content-Type: text/html; charset=ISO-8859-1")
+          (wl "Content-Disposition: inline")
+          (wl "")
+          (wl body)
+          (body-boundary))
+
+        (define (attach-file file #!key (content-id #f))
+          (let* ((filename
+                  (filepath:take-file-name file))
+                 (ext-with-dot
+                  (filepath:take-extension file))
+                 (ext (string-take-right
+                       ext-with-dot
+                       (- (string-length ext-with-dot) 1)))
+                 (mimetype (ext->mimetype ext))
+                 (uuencode-command (conc "uuencode " file " " filename)))
+            (boundary)
+            (wl (conc "Content-Type: " mimetype "; name=\"" filename "\""))
+            (wl "Content-Transfer-Encoding: uuencode")
+            (if content-id
+                (wl (conc "Content-Id: " content-id)))
+            (wl (conc "Content-Disposition: attachment; filename=\"" filename "\""))
+            (wl "")
+            (do-or-die
+             uuencode-command
+             foreach-stdout:
+             (lambda (line)
+               (wl line)))))
+
+        (define (embed-image file+content-id)
+          (let ((file (car file+content-id))
+                (content-id (cdr file+content-id)))
+            (attach-file file content-id: content-id)))
+        
+        ;; send the email
+        (email-mime-header)
+        (if use_html
+            (email-html-body)
+            (email-text-body))
+        (for-each attach-file attach-files-list)
+        (for-each embed-image images-with-content-id-alist)
+        (boundary)
+        (close-output-port sendmail-port)))
+    
+    (do-or-die "/usr/sbin/sendmail -t"
+               stdin-proc: sendmail-proc))
+
+
+;;;; process command line options
+
+  ;; get command line switches (have no subsequent arg; eg. [-foo])
+  ;;  assumes these are switches without arguments
+  ;;  will return list of matches
+  ;;  removes matches from command-line-arguments parameter
+  (define (skim-cmdline-opts-noarg-by-regex switch-pattern)
+    (let* (
+           (irr (irregex switch-pattern))
+           (matches (filter
+                     (lambda (x)
+                       (irregex-match irr x))
+                     (command-line-arguments)))
+           (non-matches (filter
+                         (lambda (x)
+                           (not (member x matches)))
+                         (command-line-arguments))))
+
+      (command-line-arguments non-matches)
+      matches))
+
+  (define (keyword-skim keyword default args #!optional (eqpred equal?))
+    (let loop ( (kwval default) (args-remaining args) (args-to-return '()) )
+      (cond 
+       ((null? args-remaining)
+        (values
+         (if (list? kwval) (reverse kwval) kwval)
+         (reverse args-to-return)))
+       ((and (> (length args-remaining) 1) (eqpred keyword (car args-remaining)))
+        (if (list? default)
+            (if (equal? default kwval)
+                (loop (list (cadr args-remaining)) (cddr args-remaining) args-to-return)
+                (loop (cons (cadr args-remaining) kwval) (cddr args-remaining) args-to-return))
+            (loop (cadr args-remaining) (cddr args-remaining) args-to-return)))
+       (else (loop kwval (cdr args-remaining) (cons (car args-remaining) args-to-return))))))
+
+
+  (define (get-cli-arg arg #!key (default #f) (is-list #f))
+    (let* ((temp    (skim-cmdline-opts-withargs-by-regex arg)))
+      (if (> (length temp) 0)
+          (if is-list
+              temp
+              (car temp))
+          default)))
+
+  (define (get-cli-switch arg)
+    (let ((temp (skim-cmdline-opts-noarg-by-regex arg)))
+      (if (> (length temp) 0)
+          (car temp)
+          #f)))
+  
+
+
+
+  ;; get command line switches (have a subsequent arg; eg. [-foo bar])
+  ;;  assumes these are switches without arguments
+  ;;  will return list of arguments to matches
+  ;;  removes matches from command-line-arguments parameter
+
+  (define (re-match? re str)
+    (irregex-match re str))
+
+  (define (skim-cmdline-opts-withargs-by-regex switch-pattern)
+    (let-values
+        (((result new-cmdline-args)
+          (keyword-skim switch-pattern
+                        '()
+                        (command-line-arguments)
+                        re-match?
+                        )))
+      (command-line-arguments new-cmdline-args)
+      result))
+  
+  
+
+  ;; recognize ducttape-lib command line switches (--quiet, --silent, --color, -d.., -dp.., -logfile)
+  ;;    - reset parameters; reset DUCTTAPE_* env vars to match user specified intent
+  ;;    - mutate (command-line-arguments) parameter to subtract these recognized and handled switches
+  ;;       * beware -- now (argv) and (command-line-arguments) are inconsistent... cannot mutate (argv) alas.  Use (command-line-arguments)
+  ;; WARNING: this defines command line arguments that may clash with your program.  Only call this if you
+  ;; are sure they can coexist.
+  (define (ducttape-process-command-line)
+
+    ;; --quiet
+    (let ((quiet-opts (skim-cmdline-opts-noarg-by-regex "--?quiet")))
+      (if (not (null? quiet-opts))
+          (begin
+            (setenv "DUCTTAPE_QUIET_MODE" "1")
+            (ducttape-quiet-mode "1"))))
+
+    ;; --silent
+    (let ((silent-opts (skim-cmdline-opts-noarg-by-regex "--?silent")))
+      (if (not (null? silent-opts))
+          (begin
+            (setenv "DUCTTAPE_SILENT_MODE" "1")
+            (ducttape-silent-mode "1"))))
+
+    ;; -color
+    (let ((color-opts (skim-cmdline-opts-noarg-by-regex "--?colou?r(ize)?")))
+      (if (not (null? color-opts))
+          (begin
+            (setenv "DUCTTAPE_COLORIZE" "1")
+            (ducttape-color-mode "1"))))
+
+    ;; -nocolor
+    (let ((nocolor-opts (skim-cmdline-opts-noarg-by-regex "--?nocolou?r(ize)?")))
+      (if (not (null? nocolor-opts))
+          (begin
+            (unsetenv "DUCTTAPE_COLORIZE" )
+            (ducttape-color-mode #f))))
+
+    ;; -logfile
+    (let ((logfile-opts (skim-cmdline-opts-withargs-by-regex "--?log(-?file)?")))
+      (if (not (null? logfile-opts))
+          (begin
+            (ducttape-log-file (car (reverse logfile-opts)))
+            (setenv "DUCTTAPE_LOG_FILE" (ducttape-log-file)))))
+
+    ;; -d -dd -d#
+    (let ((debug-opts (skim-cmdline-opts-noarg-by-regex "-d(d*|\\d+)"))
+          (initial-debuglevel (if (ducttape-debug-level) (ducttape-debug-level) 0) ))
+      (if (not (null? debug-opts))
+          (begin
+            (ducttape-debug-level
+             (let loop ((opts debug-opts) (debuglevel initial-debuglevel))
+               (if (null? opts)
+                   debuglevel
+                   (let*
+                       ( (curopt (car opts))
+                         (restopts (cdr opts))
+                         (ds (string-match "-(d+)" curopt))
+                         (dnum (string-match "-d(\\d+)" curopt)))
+                     (cond
+                      (ds (loop restopts (+ debuglevel (string-length (cadr ds)))))
+                      (dnum  (loop restopts (string->number (cadr dnum)))))))))
+            (setenv "DUCTTAPE_DEBUG_LEVEL" (number->string (ducttape-debug-level))))))
+
+
+    ;; -dp <pat> / --debug-pattern <pat>
+    (let ((debugpat-opts (skim-cmdline-opts-withargs-by-regex "--?(debug-pattern|dp)")))
+      (if (not (null? debugpat-opts))
+          (begin
+            (ducttape-debug-regex-filter (string-join debugpat-opts "|"))
+            (setenv "DUCTTAPE_DEBUG_PATTERN" (ducttape-debug-regex-filter)))))) 
+
+
+  ;;; following code commented out; side effects not wanted on startup
+  ;; immediately activate logfile (will be noop if logfile disabled)
+  ;;(ducttape-activate-logfile)
+  ;;(set-ducttape-log-exit-handler)
+  
+  ;; TODO: hook exception handler so we can log exception before we sign off.
+
+  ;; handle command line immediately; 
+  ;;(process-command-line)                    
+
+
+  ) ; end module

ADDED   ducttape/ducttape-lib.setup
Index: ducttape/ducttape-lib.setup
==================================================================
--- /dev/null
+++ ducttape/ducttape-lib.setup
@@ -0,0 +1,1 @@
+(standard-extension 'ducttape-lib '1.0.0)

ADDED   ducttape/mimetypes.scm
Index: ducttape/mimetypes.scm
==================================================================
--- /dev/null
+++ ducttape/mimetypes.scm
@@ -0,0 +1,782 @@
+;; gathered from macosx:
+;;   cat /etc/apache2/mime.types | grep -v '^#' | perl -ne 'print "(\"$2\" . \"$1\")\n" if /(\S+)\s+(\S+)/' > mimetypes.scm
+;; + manual manipulation
+
+(define ducttape_ext2mimetype '(("ez" . "application/andrew-inset")
+("aw" . "application/applixware")
+("atom" . "application/atom+xml")
+("atomcat" . "application/atomcat+xml")
+("atomsvc" . "application/atomsvc+xml")
+("ccxml" . "application/ccxml+xml")
+("cdmia" . "application/cdmi-capability")
+("cdmic" . "application/cdmi-container")
+("cdmid" . "application/cdmi-domain")
+("cdmio" . "application/cdmi-object")
+("cdmiq" . "application/cdmi-queue")
+("cu" . "application/cu-seeme")
+("davmount" . "application/davmount+xml")
+("dbk" . "application/docbook+xml")
+("dssc" . "application/dssc+der")
+("xdssc" . "application/dssc+xml")
+("ecma" . "application/ecmascript")
+("emma" . "application/emma+xml")
+("epub" . "application/epub+zip")
+("exi" . "application/exi")
+("pfr" . "application/font-tdpfr")
+("gml" . "application/gml+xml")
+("gpx" . "application/gpx+xml")
+("gxf" . "application/gxf")
+("stk" . "application/hyperstudio")
+("ink" . "application/inkml+xml")
+("ipfix" . "application/ipfix")
+("jar" . "application/java-archive")
+("ser" . "application/java-serialized-object")
+("class" . "application/java-vm")
+("js" . "application/javascript")
+("json" . "application/json")
+("jsonml" . "application/jsonml+json")
+("lostxml" . "application/lost+xml")
+("hqx" . "application/mac-binhex40")
+("cpt" . "application/mac-compactpro")
+("mads" . "application/mads+xml")
+("mrc" . "application/marc")
+("mrcx" . "application/marcxml+xml")
+("ma" . "application/mathematica")
+("mathml" . "application/mathml+xml")
+("mbox" . "application/mbox")
+("mscml" . "application/mediaservercontrol+xml")
+("metalink" . "application/metalink+xml")
+("meta4" . "application/metalink4+xml")
+("mets" . "application/mets+xml")
+("mods" . "application/mods+xml")
+("m21" . "application/mp21")
+("mp4s" . "application/mp4")
+("doc" . "application/msword")
+("mxf" . "application/mxf")
+("bin" . "application/octet-stream")
+("oda" . "application/oda")
+("opf" . "application/oebps-package+xml")
+("ogx" . "application/ogg")
+("omdoc" . "application/omdoc+xml")
+("onetoc" . "application/onenote")
+("oxps" . "application/oxps")
+("xer" . "application/patch-ops-error+xml")
+("pdf" . "application/pdf")
+("pgp" . "application/pgp-encrypted")
+("asc" . "application/pgp-signature")
+("prf" . "application/pics-rules")
+("p10" . "application/pkcs10")
+("p7m" . "application/pkcs7-mime")
+("p7s" . "application/pkcs7-signature")
+("p8" . "application/pkcs8")
+("ac" . "application/pkix-attr-cert")
+("cer" . "application/pkix-cert")
+("crl" . "application/pkix-crl")
+("pkipath" . "application/pkix-pkipath")
+("pki" . "application/pkixcmp")
+("pls" . "application/pls+xml")
+("ai" . "application/postscript")
+("cww" . "application/prs.cww")
+("pskcxml" . "application/pskc+xml")
+("rdf" . "application/rdf+xml")
+("rif" . "application/reginfo+xml")
+("rnc" . "application/relax-ng-compact-syntax")
+("rl" . "application/resource-lists+xml")
+("rld" . "application/resource-lists-diff+xml")
+("rs" . "application/rls-services+xml")
+("gbr" . "application/rpki-ghostbusters")
+("mft" . "application/rpki-manifest")
+("roa" . "application/rpki-roa")
+("rsd" . "application/rsd+xml")
+("rss" . "application/rss+xml")
+("rtf" . "application/rtf")
+("sbml" . "application/sbml+xml")
+("scq" . "application/scvp-cv-request")
+("scs" . "application/scvp-cv-response")
+("spq" . "application/scvp-vp-request")
+("spp" . "application/scvp-vp-response")
+("sdp" . "application/sdp")
+("setpay" . "application/set-payment-initiation")
+("setreg" . "application/set-registration-initiation")
+("shf" . "application/shf+xml")
+("smi" . "application/smil+xml")
+("rq" . "application/sparql-query")
+("srx" . "application/sparql-results+xml")
+("gram" . "application/srgs")
+("grxml" . "application/srgs+xml")
+("sru" . "application/sru+xml")
+("ssdl" . "application/ssdl+xml")
+("ssml" . "application/ssml+xml")
+("tei" . "application/tei+xml")
+("tfi" . "application/thraud+xml")
+("tsd" . "application/timestamped-data")
+("plb" . "application/vnd.3gpp.pic-bw-large")
+("psb" . "application/vnd.3gpp.pic-bw-small")
+("pvb" . "application/vnd.3gpp.pic-bw-var")
+("tcap" . "application/vnd.3gpp2.tcap")
+("pwn" . "application/vnd.3m.post-it-notes")
+("aso" . "application/vnd.accpac.simply.aso")
+("imp" . "application/vnd.accpac.simply.imp")
+("acu" . "application/vnd.acucobol")
+("atc" . "application/vnd.acucorp")
+("air" . "application/vnd.adobe.air-application-installer-package+zip")
+("fcdt" . "application/vnd.adobe.formscentral.fcdt")
+("fxp" . "application/vnd.adobe.fxp")
+("xdp" . "application/vnd.adobe.xdp+xml")
+("xfdf" . "application/vnd.adobe.xfdf")
+("ahead" . "application/vnd.ahead.space")
+("azf" . "application/vnd.airzip.filesecure.azf")
+("azs" . "application/vnd.airzip.filesecure.azs")
+("azw" . "application/vnd.amazon.ebook")
+("acc" . "application/vnd.americandynamics.acc")
+("ami" . "application/vnd.amiga.ami")
+("apk" . "application/vnd.android.package-archive")
+("cii" . "application/vnd.anser-web-certificate-issue-initiation")
+("fti" . "application/vnd.anser-web-funds-transfer-initiation")
+("atx" . "application/vnd.antix.game-component")
+("mpkg" . "application/vnd.apple.installer+xml")
+("m3u8" . "application/vnd.apple.mpegurl")
+("swi" . "application/vnd.aristanetworks.swi")
+("iota" . "application/vnd.astraea-software.iota")
+("aep" . "application/vnd.audiograph")
+("mpm" . "application/vnd.blueice.multipass")
+("bmi" . "application/vnd.bmi")
+("rep" . "application/vnd.businessobjects")
+("cdxml" . "application/vnd.chemdraw+xml")
+("mmd" . "application/vnd.chipnuts.karaoke-mmd")
+("cdy" . "application/vnd.cinderella")
+("cla" . "application/vnd.claymore")
+("rp9" . "application/vnd.cloanto.rp9")
+("c4g" . "application/vnd.clonk.c4group")
+("c11amc" . "application/vnd.cluetrust.cartomobile-config")
+("c11amz" . "application/vnd.cluetrust.cartomobile-config-pkg")
+("csp" . "application/vnd.commonspace")
+("cdbcmsg" . "application/vnd.contact.cmsg")
+("cmc" . "application/vnd.cosmocaller")
+("clkx" . "application/vnd.crick.clicker")
+("clkk" . "application/vnd.crick.clicker.keyboard")
+("clkp" . "application/vnd.crick.clicker.palette")
+("clkt" . "application/vnd.crick.clicker.template")
+("clkw" . "application/vnd.crick.clicker.wordbank")
+("wbs" . "application/vnd.criticaltools.wbs+xml")
+("pml" . "application/vnd.ctc-posml")
+("ppd" . "application/vnd.cups-ppd")
+("car" . "application/vnd.curl.car")
+("pcurl" . "application/vnd.curl.pcurl")
+("dart" . "application/vnd.dart")
+("rdz" . "application/vnd.data-vision.rdz")
+("uvf" . "application/vnd.dece.data")
+("uvt" . "application/vnd.dece.ttml+xml")
+("uvx" . "application/vnd.dece.unspecified")
+("uvz" . "application/vnd.dece.zip")
+("fe_launch" . "application/vnd.denovo.fcselayout-link")
+("dna" . "application/vnd.dna")
+("mlp" . "application/vnd.dolby.mlp")
+("dpg" . "application/vnd.dpgraph")
+("dfac" . "application/vnd.dreamfactory")
+("kpxx" . "application/vnd.ds-keypoint")
+("ait" . "application/vnd.dvb.ait")
+("svc" . "application/vnd.dvb.service")
+("geo" . "application/vnd.dynageo")
+("mag" . "application/vnd.ecowin.chart")
+("nml" . "application/vnd.enliven")
+("esf" . "application/vnd.epson.esf")
+("msf" . "application/vnd.epson.msf")
+("qam" . "application/vnd.epson.quickanime")
+("slt" . "application/vnd.epson.salt")
+("ssf" . "application/vnd.epson.ssf")
+("es3" . "application/vnd.eszigno3+xml")
+("ez2" . "application/vnd.ezpix-album")
+("ez3" . "application/vnd.ezpix-package")
+("fdf" . "application/vnd.fdf")
+("mseed" . "application/vnd.fdsn.mseed")
+("seed" . "application/vnd.fdsn.seed")
+("gph" . "application/vnd.flographit")
+("ftc" . "application/vnd.fluxtime.clip")
+("fm" . "application/vnd.framemaker")
+("fnc" . "application/vnd.frogans.fnc")
+("ltf" . "application/vnd.frogans.ltf")
+("fsc" . "application/vnd.fsc.weblaunch")
+("oas" . "application/vnd.fujitsu.oasys")
+("oa2" . "application/vnd.fujitsu.oasys2")
+("oa3" . "application/vnd.fujitsu.oasys3")
+("fg5" . "application/vnd.fujitsu.oasysgp")
+("bh2" . "application/vnd.fujitsu.oasysprs")
+("ddd" . "application/vnd.fujixerox.ddd")
+("xdw" . "application/vnd.fujixerox.docuworks")
+("xbd" . "application/vnd.fujixerox.docuworks.binder")
+("fzs" . "application/vnd.fuzzysheet")
+("txd" . "application/vnd.genomatix.tuxedo")
+("ggb" . "application/vnd.geogebra.file")
+("ggt" . "application/vnd.geogebra.tool")
+("gex" . "application/vnd.geometry-explorer")
+("gxt" . "application/vnd.geonext")
+("g2w" . "application/vnd.geoplan")
+("g3w" . "application/vnd.geospace")
+("gmx" . "application/vnd.gmx")
+("kml" . "application/vnd.google-earth.kml+xml")
+("kmz" . "application/vnd.google-earth.kmz")
+("gqf" . "application/vnd.grafeq")
+("gac" . "application/vnd.groove-account")
+("ghf" . "application/vnd.groove-help")
+("gim" . "application/vnd.groove-identity-message")
+("grv" . "application/vnd.groove-injector")
+("gtm" . "application/vnd.groove-tool-message")
+("tpl" . "application/vnd.groove-tool-template")
+("vcg" . "application/vnd.groove-vcard")
+("hal" . "application/vnd.hal+xml")
+("zmm" . "application/vnd.handheld-entertainment+xml")
+("hbci" . "application/vnd.hbci")
+("les" . "application/vnd.hhe.lesson-player")
+("hpgl" . "application/vnd.hp-hpgl")
+("hpid" . "application/vnd.hp-hpid")
+("hps" . "application/vnd.hp-hps")
+("jlt" . "application/vnd.hp-jlyt")
+("pcl" . "application/vnd.hp-pcl")
+("pclxl" . "application/vnd.hp-pclxl")
+("sfd-hdstx" . "application/vnd.hydrostatix.sof-data")
+("mpy" . "application/vnd.ibm.minipay")
+("afp" . "application/vnd.ibm.modcap")
+("irm" . "application/vnd.ibm.rights-management")
+("sc" . "application/vnd.ibm.secure-container")
+("icc" . "application/vnd.iccprofile")
+("igl" . "application/vnd.igloader")
+("ivp" . "application/vnd.immervision-ivp")
+("ivu" . "application/vnd.immervision-ivu")
+("igm" . "application/vnd.insors.igm")
+("xpw" . "application/vnd.intercon.formnet")
+("i2g" . "application/vnd.intergeo")
+("qbo" . "application/vnd.intu.qbo")
+("qfx" . "application/vnd.intu.qfx")
+("rcprofile" . "application/vnd.ipunplugged.rcprofile")
+("irp" . "application/vnd.irepository.package+xml")
+("xpr" . "application/vnd.is-xpr")
+("fcs" . "application/vnd.isac.fcs")
+("jam" . "application/vnd.jam")
+("rms" . "application/vnd.jcp.javame.midlet-rms")
+("jisp" . "application/vnd.jisp")
+("joda" . "application/vnd.joost.joda-archive")
+("ktz" . "application/vnd.kahootz")
+("karbon" . "application/vnd.kde.karbon")
+("chrt" . "application/vnd.kde.kchart")
+("kfo" . "application/vnd.kde.kformula")
+("flw" . "application/vnd.kde.kivio")
+("kon" . "application/vnd.kde.kontour")
+("kpr" . "application/vnd.kde.kpresenter")
+("ksp" . "application/vnd.kde.kspread")
+("kwd" . "application/vnd.kde.kword")
+("htke" . "application/vnd.kenameaapp")
+("kia" . "application/vnd.kidspiration")
+("kne" . "application/vnd.kinar")
+("skp" . "application/vnd.koan")
+("sse" . "application/vnd.kodak-descriptor")
+("lasxml" . "application/vnd.las.las+xml")
+("lbd" . "application/vnd.llamagraphics.life-balance.desktop")
+("lbe" . "application/vnd.llamagraphics.life-balance.exchange+xml")
+("123" . "application/vnd.lotus-1-2-3")
+("apr" . "application/vnd.lotus-approach")
+("pre" . "application/vnd.lotus-freelance")
+("nsf" . "application/vnd.lotus-notes")
+("org" . "application/vnd.lotus-organizer")
+("scm" . "application/vnd.lotus-screencam")
+("lwp" . "application/vnd.lotus-wordpro")
+("portpkg" . "application/vnd.macports.portpkg")
+("mcd" . "application/vnd.mcd")
+("mc1" . "application/vnd.medcalcdata")
+("cdkey" . "application/vnd.mediastation.cdkey")
+("mwf" . "application/vnd.mfer")
+("mfm" . "application/vnd.mfmp")
+("flo" . "application/vnd.micrografx.flo")
+("igx" . "application/vnd.micrografx.igx")
+("mif" . "application/vnd.mif")
+("daf" . "application/vnd.mobius.daf")
+("dis" . "application/vnd.mobius.dis")
+("mbk" . "application/vnd.mobius.mbk")
+("mqy" . "application/vnd.mobius.mqy")
+("msl" . "application/vnd.mobius.msl")
+("plc" . "application/vnd.mobius.plc")
+("txf" . "application/vnd.mobius.txf")
+("mpn" . "application/vnd.mophun.application")
+("mpc" . "application/vnd.mophun.certificate")
+("xul" . "application/vnd.mozilla.xul+xml")
+("cil" . "application/vnd.ms-artgalry")
+("cab" . "application/vnd.ms-cab-compressed")
+("xls" . "application/vnd.ms-excel")
+("xlam" . "application/vnd.ms-excel.addin.macroenabled.12")
+("xlsb" . "application/vnd.ms-excel.sheet.binary.macroenabled.12")
+("xlsm" . "application/vnd.ms-excel.sheet.macroenabled.12")
+("xltm" . "application/vnd.ms-excel.template.macroenabled.12")
+("eot" . "application/vnd.ms-fontobject")
+("chm" . "application/vnd.ms-htmlhelp")
+("ims" . "application/vnd.ms-ims")
+("lrm" . "application/vnd.ms-lrm")
+("thmx" . "application/vnd.ms-officetheme")
+("cat" . "application/vnd.ms-pki.seccat")
+("stl" . "application/vnd.ms-pki.stl")
+("ppt" . "application/vnd.ms-powerpoint")
+("ppam" . "application/vnd.ms-powerpoint.addin.macroenabled.12")
+("pptm" . "application/vnd.ms-powerpoint.presentation.macroenabled.12")
+("sldm" . "application/vnd.ms-powerpoint.slide.macroenabled.12")
+("ppsm" . "application/vnd.ms-powerpoint.slideshow.macroenabled.12")
+("potm" . "application/vnd.ms-powerpoint.template.macroenabled.12")
+("mpp" . "application/vnd.ms-project")
+("docm" . "application/vnd.ms-word.document.macroenabled.12")
+("dotm" . "application/vnd.ms-word.template.macroenabled.12")
+("wps" . "application/vnd.ms-works")
+("wpl" . "application/vnd.ms-wpl")
+("xps" . "application/vnd.ms-xpsdocument")
+("mseq" . "application/vnd.mseq")
+("mus" . "application/vnd.musician")
+("msty" . "application/vnd.muvee.style")
+("taglet" . "application/vnd.mynfc")
+("nlu" . "application/vnd.neurolanguage.nlu")
+("ntf" . "application/vnd.nitf")
+("nnd" . "application/vnd.noblenet-directory")
+("nns" . "application/vnd.noblenet-sealer")
+("nnw" . "application/vnd.noblenet-web")
+("ngdat" . "application/vnd.nokia.n-gage.data")
+("n-gage" . "application/vnd.nokia.n-gage.symbian.install")
+("rpst" . "application/vnd.nokia.radio-preset")
+("rpss" . "application/vnd.nokia.radio-presets")
+("edm" . "application/vnd.novadigm.edm")
+("edx" . "application/vnd.novadigm.edx")
+("ext" . "application/vnd.novadigm.ext")
+("odc" . "application/vnd.oasis.opendocument.chart")
+("otc" . "application/vnd.oasis.opendocument.chart-template")
+("odb" . "application/vnd.oasis.opendocument.database")
+("odf" . "application/vnd.oasis.opendocument.formula")
+("odft" . "application/vnd.oasis.opendocument.formula-template")
+("odg" . "application/vnd.oasis.opendocument.graphics")
+("otg" . "application/vnd.oasis.opendocument.graphics-template")
+("odi" . "application/vnd.oasis.opendocument.image")
+("oti" . "application/vnd.oasis.opendocument.image-template")
+("odp" . "application/vnd.oasis.opendocument.presentation")
+("otp" . "application/vnd.oasis.opendocument.presentation-template")
+("ods" . "application/vnd.oasis.opendocument.spreadsheet")
+("ots" . "application/vnd.oasis.opendocument.spreadsheet-template")
+("odt" . "application/vnd.oasis.opendocument.text")
+("odm" . "application/vnd.oasis.opendocument.text-master")
+("ott" . "application/vnd.oasis.opendocument.text-template")
+("oth" . "application/vnd.oasis.opendocument.text-web")
+("xo" . "application/vnd.olpc-sugar")
+("dd2" . "application/vnd.oma.dd2+xml")
+("oxt" . "application/vnd.openofficeorg.extension")
+("pptx" . "application/vnd.openxmlformats-officedocument.presentationml.presentation")
+("sldx" . "application/vnd.openxmlformats-officedocument.presentationml.slide")
+("ppsx" . "application/vnd.openxmlformats-officedocument.presentationml.slideshow")
+("potx" . "application/vnd.openxmlformats-officedocument.presentationml.template")
+("xlsx" . "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet")
+("xltx" . "application/vnd.openxmlformats-officedocument.spreadsheetml.template")
+("docx" . "application/vnd.openxmlformats-officedocument.wordprocessingml.document")
+("dotx" . "application/vnd.openxmlformats-officedocument.wordprocessingml.template")
+("mgp" . "application/vnd.osgeo.mapguide.package")
+("dp" . "application/vnd.osgi.dp")
+("esa" . "application/vnd.osgi.subsystem")
+("pdb" . "application/vnd.palm")
+("paw" . "application/vnd.pawaafile")
+("str" . "application/vnd.pg.format")
+("ei6" . "application/vnd.pg.osasli")
+("efif" . "application/vnd.picsel")
+("wg" . "application/vnd.pmi.widget")
+("plf" . "application/vnd.pocketlearn")
+("pbd" . "application/vnd.powerbuilder6")
+("box" . "application/vnd.previewsystems.box")
+("mgz" . "application/vnd.proteus.magazine")
+("qps" . "application/vnd.publishare-delta-tree")
+("ptid" . "application/vnd.pvi.ptid1")
+("qxd" . "application/vnd.quark.quarkxpress")
+("bed" . "application/vnd.realvnc.bed")
+("mxl" . "application/vnd.recordare.musicxml")
+("musicxml" . "application/vnd.recordare.musicxml+xml")
+("cryptonote" . "application/vnd.rig.cryptonote")
+("cod" . "application/vnd.rim.cod")
+("rm" . "application/vnd.rn-realmedia")
+("rmvb" . "application/vnd.rn-realmedia-vbr")
+("link66" . "application/vnd.route66.link66+xml")
+("st" . "application/vnd.sailingtracker.track")
+("see" . "application/vnd.seemail")
+("sema" . "application/vnd.sema")
+("semd" . "application/vnd.semd")
+("semf" . "application/vnd.semf")
+("ifm" . "application/vnd.shana.informed.formdata")
+("itp" . "application/vnd.shana.informed.formtemplate")
+("iif" . "application/vnd.shana.informed.interchange")
+("ipk" . "application/vnd.shana.informed.package")
+("twd" . "application/vnd.simtech-mindmapper")
+("mmf" . "application/vnd.smaf")
+("teacher" . "application/vnd.smart.teacher")
+("sdkm" . "application/vnd.solent.sdkm+xml")
+("dxp" . "application/vnd.spotfire.dxp")
+("sfs" . "application/vnd.spotfire.sfs")
+("sdc" . "application/vnd.stardivision.calc")
+("sda" . "application/vnd.stardivision.draw")
+("sdd" . "application/vnd.stardivision.impress")
+("smf" . "application/vnd.stardivision.math")
+("sdw" . "application/vnd.stardivision.writer")
+("sgl" . "application/vnd.stardivision.writer-global")
+("smzip" . "application/vnd.stepmania.package")
+("sm" . "application/vnd.stepmania.stepchart")
+("sxc" . "application/vnd.sun.xml.calc")
+("stc" . "application/vnd.sun.xml.calc.template")
+("sxd" . "application/vnd.sun.xml.draw")
+("std" . "application/vnd.sun.xml.draw.template")
+("sxi" . "application/vnd.sun.xml.impress")
+("sti" . "application/vnd.sun.xml.impress.template")
+("sxm" . "application/vnd.sun.xml.math")
+("sxw" . "application/vnd.sun.xml.writer")
+("sxg" . "application/vnd.sun.xml.writer.global")
+("stw" . "application/vnd.sun.xml.writer.template")
+("sus" . "application/vnd.sus-calendar")
+("svd" . "application/vnd.svd")
+("sis" . "application/vnd.symbian.install")
+("xsm" . "application/vnd.syncml+xml")
+("bdm" . "application/vnd.syncml.dm+wbxml")
+("xdm" . "application/vnd.syncml.dm+xml")
+("tao" . "application/vnd.tao.intent-module-archive")
+("pcap" . "application/vnd.tcpdump.pcap")
+("tmo" . "application/vnd.tmobile-livetv")
+("tpt" . "application/vnd.trid.tpt")
+("mxs" . "application/vnd.triscape.mxs")
+("tra" . "application/vnd.trueapp")
+("ufd" . "application/vnd.ufdl")
+("utz" . "application/vnd.uiq.theme")
+("umj" . "application/vnd.umajin")
+("unityweb" . "application/vnd.unity")
+("uoml" . "application/vnd.uoml+xml")
+("vcx" . "application/vnd.vcx")
+("vsd" . "application/vnd.visio")
+("vis" . "application/vnd.visionary")
+("vsf" . "application/vnd.vsf")
+("wbxml" . "application/vnd.wap.wbxml")
+("wmlc" . "application/vnd.wap.wmlc")
+("wmlsc" . "application/vnd.wap.wmlscriptc")
+("wtb" . "application/vnd.webturbo")
+("nbp" . "application/vnd.wolfram.player")
+("wpd" . "application/vnd.wordperfect")
+("wqd" . "application/vnd.wqd")
+("stf" . "application/vnd.wt.stf")
+("xar" . "application/vnd.xara")
+("xfdl" . "application/vnd.xfdl")
+("hvd" . "application/vnd.yamaha.hv-dic")
+("hvs" . "application/vnd.yamaha.hv-script")
+("hvp" . "application/vnd.yamaha.hv-voice")
+("osf" . "application/vnd.yamaha.openscoreformat")
+("osfpvg" . "application/vnd.yamaha.openscoreformat.osfpvg+xml")
+("saf" . "application/vnd.yamaha.smaf-audio")
+("spf" . "application/vnd.yamaha.smaf-phrase")
+("cmp" . "application/vnd.yellowriver-custom-menu")
+("zir" . "application/vnd.zul")
+("zaz" . "application/vnd.zzazz.deck+xml")
+("vxml" . "application/voicexml+xml")
+("wgt" . "application/widget")
+("hlp" . "application/winhlp")
+("wsdl" . "application/wsdl+xml")
+("wspolicy" . "application/wspolicy+xml")
+("7z" . "application/x-7z-compressed")
+("abw" . "application/x-abiword")
+("ace" . "application/x-ace-compressed")
+("dmg" . "application/x-apple-diskimage")
+("aab" . "application/x-authorware-bin")
+("aam" . "application/x-authorware-map")
+("aas" . "application/x-authorware-seg")
+("bcpio" . "application/x-bcpio")
+("torrent" . "application/x-bittorrent")
+("blb" . "application/x-blorb")
+("bz" . "application/x-bzip")
+("bz2" . "application/x-bzip2")
+("cbr" . "application/x-cbr")
+("vcd" . "application/x-cdlink")
+("cfs" . "application/x-cfs-compressed")
+("chat" . "application/x-chat")
+("pgn" . "application/x-chess-pgn")
+("nsc" . "application/x-conference")
+("cpio" . "application/x-cpio")
+("csh" . "application/x-csh")
+("deb" . "application/x-debian-package")
+("dgc" . "application/x-dgc-compressed")
+("dir" . "application/x-director")
+("wad" . "application/x-doom")
+("ncx" . "application/x-dtbncx+xml")
+("dtb" . "application/x-dtbook+xml")
+("res" . "application/x-dtbresource+xml")
+("dvi" . "application/x-dvi")
+("evy" . "application/x-envoy")
+("eva" . "application/x-eva")
+("bdf" . "application/x-font-bdf")
+("gsf" . "application/x-font-ghostscript")
+("psf" . "application/x-font-linux-psf")
+("otf" . "application/x-font-otf")
+("pcf" . "application/x-font-pcf")
+("snf" . "application/x-font-snf")
+("ttf" . "application/x-font-ttf")
+("pfa" . "application/x-font-type1")
+("woff" . "application/x-font-woff")
+("arc" . "application/x-freearc")
+("spl" . "application/x-futuresplash")
+("gca" . "application/x-gca-compressed")
+("ulx" . "application/x-glulx")
+("gnumeric" . "application/x-gnumeric")
+("gramps" . "application/x-gramps-xml")
+("gtar" . "application/x-gtar")
+("hdf" . "application/x-hdf")
+("install" . "application/x-install-instructions")
+("iso" . "application/x-iso9660-image")
+("jnlp" . "application/x-java-jnlp-file")
+("latex" . "application/x-latex")
+("lzh" . "application/x-lzh-compressed")
+("mie" . "application/x-mie")
+("prc" . "application/x-mobipocket-ebook")
+("m3u8" . "application/x-mpegurl")
+("application" . "application/x-ms-application")
+("lnk" . "application/x-ms-shortcut")
+("wmd" . "application/x-ms-wmd")
+("wmz" . "application/x-ms-wmz")
+("xbap" . "application/x-ms-xbap")
+("mdb" . "application/x-msaccess")
+("obd" . "application/x-msbinder")
+("crd" . "application/x-mscardfile")
+("clp" . "application/x-msclip")
+("exe" . "application/x-msdownload")
+("mvb" . "application/x-msmediaview")
+("wmf" . "application/x-msmetafile")
+("mny" . "application/x-msmoney")
+("pub" . "application/x-mspublisher")
+("scd" . "application/x-msschedule")
+("trm" . "application/x-msterminal")
+("wri" . "application/x-mswrite")
+("nc" . "application/x-netcdf")
+("nzb" . "application/x-nzb")
+("p12" . "application/x-pkcs12")
+("p7b" . "application/x-pkcs7-certificates")
+("p7r" . "application/x-pkcs7-certreqresp")
+("rar" . "application/x-rar-compressed")
+("ris" . "application/x-research-info-systems")
+("sh" . "application/x-sh")
+("shar" . "application/x-shar")
+("swf" . "application/x-shockwave-flash")
+("xap" . "application/x-silverlight-app")
+("sql" . "application/x-sql")
+("sit" . "application/x-stuffit")
+("sitx" . "application/x-stuffitx")
+("srt" . "application/x-subrip")
+("sv4cpio" . "application/x-sv4cpio")
+("sv4crc" . "application/x-sv4crc")
+("t3" . "application/x-t3vm-image")
+("gam" . "application/x-tads")
+("tar" . "application/x-tar")
+("tcl" . "application/x-tcl")
+("tex" . "application/x-tex")
+("tfm" . "application/x-tex-tfm")
+("texinfo" . "application/x-texinfo")
+("obj" . "application/x-tgif")
+("ustar" . "application/x-ustar")
+("src" . "application/x-wais-source")
+("der" . "application/x-x509-ca-cert")
+("fig" . "application/x-xfig")
+("xlf" . "application/x-xliff+xml")
+("xpi" . "application/x-xpinstall")
+("xz" . "application/x-xz")
+("z1" . "application/x-zmachine")
+("xaml" . "application/xaml+xml")
+("xdf" . "application/xcap-diff+xml")
+("xenc" . "application/xenc+xml")
+("xhtml" . "application/xhtml+xml")
+("xml" . "application/xml")
+("dtd" . "application/xml-dtd")
+("xop" . "application/xop+xml")
+("xpl" . "application/xproc+xml")
+("xslt" . "application/xslt+xml")
+("xspf" . "application/xspf+xml")
+("mxml" . "application/xv+xml")
+("yang" . "application/yang")
+("yin" . "application/yin+xml")
+("zip" . "application/zip")
+("adp" . "audio/adpcm")
+("au" . "audio/basic")
+("mid" . "audio/midi")
+("mp4a" . "audio/mp4")
+("m4a" . "audio/mp4a-latm")
+("mpga" . "audio/mpeg")
+("oga" . "audio/ogg")
+("s3m" . "audio/s3m")
+("sil" . "audio/silk")
+("uva" . "audio/vnd.dece.audio")
+("eol" . "audio/vnd.digital-winds")
+("dra" . "audio/vnd.dra")
+("dts" . "audio/vnd.dts")
+("dtshd" . "audio/vnd.dts.hd")
+("lvp" . "audio/vnd.lucent.voice")
+("pya" . "audio/vnd.ms-playready.media.pya")
+("ecelp4800" . "audio/vnd.nuera.ecelp4800")
+("ecelp7470" . "audio/vnd.nuera.ecelp7470")
+("ecelp9600" . "audio/vnd.nuera.ecelp9600")
+("rip" . "audio/vnd.rip")
+("weba" . "audio/webm")
+("aac" . "audio/x-aac")
+("aif" . "audio/x-aiff")
+("caf" . "audio/x-caf")
+("flac" . "audio/x-flac")
+("mka" . "audio/x-matroska")
+("m3u" . "audio/x-mpegurl")
+("wax" . "audio/x-ms-wax")
+("wma" . "audio/x-ms-wma")
+("ram" . "audio/x-pn-realaudio")
+("rmp" . "audio/x-pn-realaudio-plugin")
+("wav" . "audio/x-wav")
+("xm" . "audio/xm")
+("cdx" . "chemical/x-cdx")
+("cif" . "chemical/x-cif")
+("cmdf" . "chemical/x-cmdf")
+("cml" . "chemical/x-cml")
+("csml" . "chemical/x-csml")
+("xyz" . "chemical/x-xyz")
+("bmp" . "image/bmp")
+("cgm" . "image/cgm")
+("g3" . "image/g3fax")
+("gif" . "image/gif")
+("ief" . "image/ief")
+("jp2" . "image/jp2")
+("jpeg" . "image/jpeg")
+("ktx" . "image/ktx")
+("pict" . "image/pict")
+("png" . "image/png")
+("btif" . "image/prs.btif")
+("sgi" . "image/sgi")
+("svg" . "image/svg+xml")
+("tiff" . "image/tiff")
+("psd" . "image/vnd.adobe.photoshop")
+("uvi" . "image/vnd.dece.graphic")
+("sub" . "image/vnd.dvb.subtitle")
+("djvu" . "image/vnd.djvu")
+("dwg" . "image/vnd.dwg")
+("dxf" . "image/vnd.dxf")
+("fbs" . "image/vnd.fastbidsheet")
+("fpx" . "image/vnd.fpx")
+("fst" . "image/vnd.fst")
+("mmr" . "image/vnd.fujixerox.edmics-mmr")
+("rlc" . "image/vnd.fujixerox.edmics-rlc")
+("mdi" . "image/vnd.ms-modi")
+("wdp" . "image/vnd.ms-photo")
+("npx" . "image/vnd.net-fpx")
+("wbmp" . "image/vnd.wap.wbmp")
+("xif" . "image/vnd.xiff")
+("webp" . "image/webp")
+("3ds" . "image/x-3ds")
+("ras" . "image/x-cmu-raster")
+("cmx" . "image/x-cmx")
+("fh" . "image/x-freehand")
+("ico" . "image/x-icon")
+("pntg" . "image/x-macpaint")
+("sid" . "image/x-mrsid-image")
+("pcx" . "image/x-pcx")
+("pic" . "image/x-pict")
+("pnm" . "image/x-portable-anymap")
+("pbm" . "image/x-portable-bitmap")
+("pgm" . "image/x-portable-graymap")
+("ppm" . "image/x-portable-pixmap")
+("qtif" . "image/x-quicktime")
+("rgb" . "image/x-rgb")
+("tga" . "image/x-tga")
+("xbm" . "image/x-xbitmap")
+("xpm" . "image/x-xpixmap")
+("xwd" . "image/x-xwindowdump")
+("eml" . "message/rfc822")
+("igs" . "model/iges")
+("msh" . "model/mesh")
+("dae" . "model/vnd.collada+xml")
+("dwf" . "model/vnd.dwf")
+("gdl" . "model/vnd.gdl")
+("gtw" . "model/vnd.gtw")
+("mts" . "model/vnd.mts")
+("vtu" . "model/vnd.vtu")
+("wrl" . "model/vrml")
+("x3db" . "model/x3d+binary")
+("x3dv" . "model/x3d+vrml")
+("x3d" . "model/x3d+xml")
+("manifest" . "text/cache-manifest")
+("appcache" . "text/cache-manifest")
+("ics" . "text/calendar")
+("css" . "text/css")
+("csv" . "text/csv")
+("html" . "text/html")
+("n3" . "text/n3")
+("txt" . "text/plain")
+("dsc" . "text/prs.lines.tag")
+("rtx" . "text/richtext")
+("sgml" . "text/sgml")
+("tsv" . "text/tab-separated-values")
+("t" . "text/troff")
+("ttl" . "text/turtle")
+("uri" . "text/uri-list")
+("vcard" . "text/vcard")
+("curl" . "text/vnd.curl")
+("dcurl" . "text/vnd.curl.dcurl")
+("scurl" . "text/vnd.curl.scurl")
+("mcurl" . "text/vnd.curl.mcurl")
+("sub" . "text/vnd.dvb.subtitle")
+("fly" . "text/vnd.fly")
+("flx" . "text/vnd.fmi.flexstor")
+("gv" . "text/vnd.graphviz")
+("3dml" . "text/vnd.in3d.3dml")
+("spot" . "text/vnd.in3d.spot")
+("jad" . "text/vnd.sun.j2me.app-descriptor")
+("wml" . "text/vnd.wap.wml")
+("wmls" . "text/vnd.wap.wmlscript")
+("s" . "text/x-asm")
+("c" . "text/x-c")
+("f" . "text/x-fortran")
+("java" . "text/x-java-source")
+("opml" . "text/x-opml")
+("p" . "text/x-pascal")
+("nfo" . "text/x-nfo")
+("etx" . "text/x-setext")
+("sfv" . "text/x-sfv")
+("uu" . "text/x-uuencode")
+("vcs" . "text/x-vcalendar")
+("vcf" . "text/x-vcard")
+("3gp" . "video/3gpp")
+("3g2" . "video/3gpp2")
+("h261" . "video/h261")
+("h263" . "video/h263")
+("h264" . "video/h264")
+("jpgv" . "video/jpeg")
+("jpm" . "video/jpm")
+("mj2" . "video/mj2")
+("ts" . "video/mp2t")
+("mp4" . "video/mp4")
+("mpeg" . "video/mpeg")
+("ogv" . "video/ogg")
+("qt" . "video/quicktime")
+("uvh" . "video/vnd.dece.hd")
+("uvm" . "video/vnd.dece.mobile")
+("uvp" . "video/vnd.dece.pd")
+("uvs" . "video/vnd.dece.sd")
+("uvv" . "video/vnd.dece.video")
+("dvb" . "video/vnd.dvb.file")
+("fvt" . "video/vnd.fvt")
+("mxu" . "video/vnd.mpegurl")
+("pyv" . "video/vnd.ms-playready.media.pyv")
+("uvu" . "video/vnd.uvvu.mp4")
+("viv" . "video/vnd.vivo")
+("dv" . "video/x-dv")
+("webm" . "video/webm")
+("f4v" . "video/x-f4v")
+("fli" . "video/x-fli")
+("flv" . "video/x-flv")
+("m4v" . "video/x-m4v")
+("mkv" . "video/x-matroska")
+("mng" . "video/x-mng")
+("asf" . "video/x-ms-asf")
+("vob" . "video/x-ms-vob")
+("wm" . "video/x-ms-wm")
+("wmv" . "video/x-ms-wmv")
+("wmx" . "video/x-ms-wmx")
+("wvx" . "video/x-ms-wvx")
+("avi" . "video/x-msvideo")
+("movie" . "video/x-sgi-movie")
+("smv" . "video/x-smv")
+("ice" . "x-conference/x-cooltalk")))
+
+(define (ext->mimetype ext)
+  (let ((x (assoc ext ducttape_ext2mimetype)))
+   (if x (cdr x) "text/plain")))

ADDED   ducttape/sample_ducttape.scm
Index: ducttape/sample_ducttape.scm
==================================================================
--- /dev/null
+++ ducttape/sample_ducttape.scm
@@ -0,0 +1,4 @@
+(include "ducttape-lib.scm")
+(import ducttape-lib)
+(inote "hello world")
+(exit 0)

ADDED   ducttape/test_ducttape.scm
Index: ducttape/test_ducttape.scm
==================================================================
--- /dev/null
+++ ducttape/test_ducttape.scm
@@ -0,0 +1,355 @@
+#!/usr/bin/env csi -script
+(use test)
+(include "ducttape-lib.scm")
+(import ducttape-lib)
+(import ansi-escape-sequences)
+(use trace)
+(set! systype (do-or-die (if (file-exists? "/bin/uname") "/bin/uname" "/usr/bin/uname")))
+;(trace skim-cmdline-opts-withargs-by-regex)
+;(trace keyword-skim)
+;(trace re-match?)
+(define (reset-ducttape)
+  (unsetenv "DUCTTAPE_DEBUG_LEVEL")
+  (ducttape-debug-level #f)
+
+  (unsetenv "DUCTTAPE_DEBUG_PATTERN")
+  (ducttape-debug-regex-filter ".")
+
+  (unsetenv "DUCTTAPE_LOG_FILE")
+  (ducttape-log-file #f)
+
+  (unsetenv "DUCTTAPE_SILENT_MODE")
+  (ducttape-silent-mode #f)
+
+  (unsetenv "DUCTTAPE_QUIET_MODE")
+  (ducttape-quiet-mode #f)
+
+  (unsetenv "DUCTTAPE_COLOR_MODE")
+  (ducttape-color-mode #f)
+)
+
+(define (reset-ducttape-with-cmdline-list cmdline-list)
+  (reset-ducttape)
+
+  (command-line-arguments cmdline-list)
+  (ducttape-process-command-line)
+)
+
+
+(define (direct-iputs-test)
+  (ducttape-color-mode #f)
+  (ierr "I'm an error")
+  (iwarn "I'm a warning")
+  (inote "I'm a note")
+
+  (ducttape-debug-level 1)
+  (idbg "I'm a debug statement")
+  (ducttape-debug-level #f)
+  (idbg "I'm a hidden debug statement")
+
+  (ducttape-silent-mode #t)
+  (iwarn "I shouldn't show up")
+  (inote "I shouldn't show up either")
+  (ierr "I should show up 1")
+  (ducttape-silent-mode #f)
+
+  (ducttape-quiet-mode #t)
+  (iwarn "I should show up 2")
+  (inote "I shouldn't show up though")
+  (ierr "I should show up 3")
+  (ducttape-quiet-mode #f)
+
+  (ducttape-debug-level 1)
+  (idbg "foo")
+  (iputs "dbg" "debug message")
+  (iputs "e" "error message")
+  (iputs "w" "warning message")
+  (iputs "n" "note message")
+
+  (ducttape-color-mode #t)
+  (ierr "I'm an error COLOR")
+  (iwarn "I'm a warning COLOR")
+  (inote "I'm a note COLOR")
+  (idbg "I'm a debug COLOR")
+
+
+  )
+
+(define (test-argprocessor-funcs)
+  
+  (test-group
+   "Command line processor utility functions"
+
+   (set! testargs1 '( "-d" "-d" "-d3" "-ddd" "-foo" "fooarg" "-foo" "fooarg2" "-lastArgIsDecoy" "-foo"))
+   (command-line-arguments testargs1)
+   (set! expected_result '("-d" "-d" "-d3" "-ddd"))
+   (set! expected_sideeffect '("-foo" "fooarg" "-foo" "fooarg2" "-lastArgIsDecoy" "-foo"))
+
+   (test "skim-cmdline-opts-noarg-by-regex result" expected_result (skim-cmdline-opts-noarg-by-regex "-d(d+|\\d+)?"))
+   (test "skim-cmdline-opts-noarg-by-regex sideeffect" expected_sideeffect (command-line-arguments))
+
+
+  
+   (command-line-arguments testargs1)
+   (set! expected_result '("fooarg" "fooarg2" ))
+   (set! expected_sideeffect '( "-d" "-d" "-d3" "-ddd" "-lastArgIsDecoy" "-foo"))
+   (test
+    "skim-cmdline-opts-withargs-by-regex result"
+    expected_result
+    (skim-cmdline-opts-withargs-by-regex "--?foo"))
+   
+   (test
+    "skim-cmdline-opts-withargs-by-regex sideeffect"
+    expected_sideeffect
+    (command-line-arguments))
+
+   ))
+
+(define (test-misc)
+  (test-group
+   "misc"
+   (let ((tmpfile (mktemp)))
+     (test-assert "mktemp: temp file created" (file-exists? tmpfile))
+     (if (file-exists? tmpfile)
+         (delete-file tmpfile))
+
+     )))
+
+
+
+(define (test-systemstuff)
+  (test-group
+   "system commands"
+
+   (let-values (((ec o e) (isys (find-exe "true"))))
+     (test-assert "isys: /bin/true should have exit code 0" (equal? ec 0)))
+   (let-values (((ec o e) (isys (find-exe "false"))))
+     (test-assert "isys: /bin/false should have exit code 1" (equal? ec 1)))
+
+   (let-values (((ec o e) (isys "/bin/echo" "foo" "bar" "baz")))
+     (test-assert "isys: /bin/echo should have exit code 0" (equal? ec 0))
+     (test-assert "isys: /bin/echo should have stdout 'foo bar baz'" (equal? o "foo bar baz")))
+   
+   (let-values (((ec o e) (isys "/bin/ls /zzzzz")))
+     (let ((expected-code
+            (if (equal? systype "Darwin") 1 2))
+           (expected-err
+            (if (equal? systype "Darwin")
+                "ls: /zzzzz: No such file or directory"
+                "/bin/ls: cannot access /zzzzz: No such file or directory"))
+
+           )
+       (test "isys: /bin/ls /zzzzz should have exit code 2" expected-code ec)
+       (test "isys: /bin/ls /zzzzz should have empty stdout" "" o)
+       (test
+        "isys: /bin/ls /zzzzz should have stderr"
+        expected-err
+        e))
+     )
+
+   (let-values (((ec o e) (isys "/bin/ls /etc/passwd")))
+     (test "isys: /bin/ls /etc/passwd should have exit code 0" 0 ec)
+     (test "isys: /bin/ls /etc/passwd should have stdout" "/etc/passwd" o)
+     (test
+      "isys: /bin/ls /etc/passwd should have empty stderr"
+      ""
+      e))
+
+      (let ((res (do-or-die "/bin/ls /etc/passwd")))
+        (test
+         "do-or-die: ls /etc/passwd should work"
+         "/etc/passwd" res ))
+
+      (let ((res (do-or-die "/bin/ls /zzzzz" nodie: #t)))
+        (test
+         "do-or-die: ls /zzzzz should die"
+         #f res ))
+
+      ; test reading from process stdout line at a time
+      (let* (
+             (lineno (counter-maker))
+
+             ; print each line with an index
+             (eachline-fn (lambda (line)
+                         (print "GOTLINE " (lineno) "> " line)))
+
+             (res
+              (do-or-die "/bin/ls -l /etc | head; true"
+                         foreach-stdout: eachline-fn )))
+        
+        (test-assert "ls -l /etc should not be empty"
+                     (not (equal? res ""))))
+      ;; test writing to process stdout line at a time
+
+      (let* ((tmpfile (mktemp))
+             (cmd (conc "cat > " tmpfile)))
+        (let-values (((c o e)
+                      (isys cmd stdin-proc:
+                       (lambda (myport)
+                         (write-line "hello" myport)
+                         (write-line "hello2" myport)
+                         (close-output-port myport)))))
+          (test "isys-sp: cat should exit 0" 0 c)
+          (let ((mycmd (conc "cat " tmpfile)))
+            (test "isys-sp: cat output should match input" "hello\nhello2" (do-or-die mycmd)))
+
+          (delete-file tmpfile)
+        ))
+
+      (let* ((tmpfile (mktemp))
+             (cmd (conc "cat > " tmpfile)))
+        (do-or-die cmd stdin-proc:
+                   (lambda (myport)
+                     (write-line "hello" myport)
+                     (write-line "hello2" myport)
+                     (close-output-port myport))
+                   cmd)
+        (test "dod-sp: cat output should match input" "hello\nhello2" (do-or-die (conc "cat " tmpfile)))
+        (delete-file tmpfile))
+
+
+
+      
+
+      (let*
+          ((thefile (conc "/tmp/" (get-environment-variable "USER")  "9-lines"))
+           (counter (counter-maker))
+           (stdin-writer
+            (lambda ()
+              (if (< (counter) 10)
+                  (number->string (counter 0))
+                  #f)))
+            (cmd (conc "cat > " thefile)))
+        (let-values
+            (((c o e)
+              (isys cmd foreach-stdin-thunk: stdin-writer)))
+
+          (test-assert "isys-fsl: cat should return 0" (equal? c 0))
+
+          (test-assert
+           "isys-fsl: cat should have written a file"
+           (file-exists? thefile))
+          
+          (if
+           (file-exists? thefile)
+           (begin
+             (test "isys-fsl: cat file should have right contents" "1\n2\n3\n4\n5\n6\n7\n8\n9" (do-or-die (conc "cat " thefile)))
+             (delete-file thefile)))))
+      
+   ) ; end test-group
+  ) ; end define
+
+   
+(define (test-argprocessor )
+  (test-group
+   "Command line processor parameter settings"
+
+   (reset-ducttape-with-cmdline-list '())
+   (test-assert "(nil) debug mode should be off" (not (ducttape-debug-level)))
+   (test-assert "(nil): debug pattern should be '.'" (equal? "." (ducttape-debug-regex-filter)))
+   (test-assert "(nil): colors should be off" (not (ducttape-color-mode)))
+   (test-assert "(nil): silent mode should be off" (not (ducttape-silent-mode)))
+   (test-assert "(nil): quiet mode should be off" (not (ducttape-quiet-mode)))
+   (test-assert "(nil): logfile should be off" (not (ducttape-log-file)))
+
+   (reset-ducttape-with-cmdline-list '("-d"))
+   (test-assert "-d: debug mode should be on at level 1" (eq? 1 (ducttape-debug-level)))
+
+   (reset-ducttape-with-cmdline-list '("-dd"))
+   (test "-dd: debug level should be 2" 2 (ducttape-debug-level))
+
+   (reset-ducttape-with-cmdline-list '("-ddd"))
+   (test "-ddd: debug level should be 3" 3 (ducttape-debug-level))
+
+   (reset-ducttape-with-cmdline-list '("-d2"))
+   (test "-d2: debug level should be 2" 2 (ducttape-debug-level))
+
+   (reset-ducttape-with-cmdline-list '("-d3"))
+   (test "-d3: debug level should be 3" 3 (ducttape-debug-level))
+
+   (reset-ducttape-with-cmdline-list '("-dp" "foo"))
+   (test "-dp foo: debug pattern should be 'foo'" "foo" (ducttape-debug-regex-filter))
+
+   (reset-ducttape-with-cmdline-list '("--debug-pattern" "foo"))
+   (test "--debug-pattern foo: debug pattern should be 'foo'" "foo" (ducttape-debug-regex-filter))
+
+   (reset-ducttape-with-cmdline-list '("-dp" "foo" "-dp" "bar"))
+   (test "-dp foo -dp bar: debug pattern should be 'foo|bar'"  "foo|bar" (ducttape-debug-regex-filter))
+
+   (reset-ducttape-with-cmdline-list '("--quiet"))
+   (test-assert "-quiet: quiet mode should be active" (ducttape-quiet-mode))
+
+   (reset-ducttape-with-cmdline-list '("--silent"))
+   (test-assert "-silent: silent mode should be active" (ducttape-silent-mode))
+
+   (reset-ducttape-with-cmdline-list '("--color"))
+   (test-assert "-color: color mode should be active" (ducttape-color-mode))
+
+   (reset-ducttape-with-cmdline-list '("--log" "foo"))
+   (test "--log foo: logfile should be 'foo'" "foo" (ducttape-log-file))
+
+))
+
+(define (test-wwdate)
+  (test-group
+   "wwdate conversion tests"
+   (let ((test-table
+          '(("16ww01.5" . "2016-01-01")
+            ("16ww18.5" . "2016-04-29")
+            ("1999ww33.5" . "1999-08-13")
+            ("16ww18.4" . "2016-04-28")
+            ("16ww18.3" . "2016-04-27")
+            ("13ww01.0" . "2012-12-30")
+            ("13ww52.6" . "2013-12-28")
+            ("16ww53.3" . "2016-12-28"))))
+     (for-each
+      (lambda (test-pair)
+        (let ((wwdate (car test-pair))
+              (isodate (cdr test-pair)))
+          (test
+           (conc "(isodate->wwdate "isodate ") => "wwdate)
+           wwdate
+           (isodate->wwdate isodate))
+          
+          (test
+           (conc "(wwdate->isodate "wwdate ")   => "isodate)
+           isodate
+           (wwdate->isodate wwdate))))
+      test-table))))
+
+(define (main)
+  ;; (test <description; #f uses func prototype> <expected result> <thunk>)
+  
+;  (test-group "silly settext group"
+;              (test #f "\x1b[1mfoo\x1b[0m" (set-text (list 'bold) "foo"))
+;              (test "settext bold" "\x1b[1mfoo\x1b[0m" (set-text (list 'bold) "foo"))
+;              )
+
+  ; visually inspect this
+  (direct-iputs-test)
+
+  ; following use unit test test-egg
+  (reset-ducttape)
+  (test-argprocessor-funcs)
+  (reset-ducttape)
+  (test-argprocessor)
+  (test-systemstuff)
+  (test-misc)
+  (test-wwdate)
+  ) ; end main()
+
+(main)
+(sendmail "brandon.j.barclay@intel.com" "6hello subject"  "test body" )
+
+;(let* ((image-file "/nfs/site/home/bjbarcla/megatest-logo.png")
+;       (cid "mtlogo")
+;       (image-alist (list (cons image-file cid)))
+;       (body  (conc "Hello world<br /><img cid:"cid" alt=\"test image\"><br>bye!")))
+
+;  (sendmail "brandon.j.barclay@intel.com" "7hello subject"  body use_html: #t images-with-content-id-alist: image-alist)
+;  (print "sent image mail"))
+;(sendmail "bjbarcla" "2hello subject html"  "test body<h1>hello</h1><i>italics</i>" use_html: #t)
+;(sendmail "bb" "4hello attach subject html"  "<h2>hmm</h2>" use_html: #t attach-files-list: '( "/Users/bb/Downloads/wdmycloud-manual-4779-705103.pdf" ) )
+
+;(launch-repl)
+(test-exit)

ADDED   ducttape/test_example.scm
Index: ducttape/test_example.scm
==================================================================
--- /dev/null
+++ ducttape/test_example.scm
@@ -0,0 +1,3 @@
+(use ducttape-lib)
+
+(inote "Hello world")

ADDED   ducttape/useargs-example.scm
Index: ducttape/useargs-example.scm
==================================================================
--- /dev/null
+++ ducttape/useargs-example.scm
@@ -0,0 +1,19 @@
+(use ducttape-lib)
+
+(let (
+      (customers (skim-cmdline-opts-withargs-by-regex "--cust(omer)?"))
+      (magicmode (skim-cmdline-opts-noarg-by-regex "--magic"))
+      )
+  (print "your customers are " customers)
+  (if (null? magicmode)
+      (print "no unicorns for you")
+      (print "magic!")
+  )
+  )
+
+(idbg "hello")
+(idbg "hello2" 2)
+(idbg "hello2" 3)
+(inote "note")
+(iwarn "warn")
+(ierr "err")

ADDED   ducttape/workweekdate.scm
Index: ducttape/workweekdate.scm
==================================================================
--- /dev/null
+++ ducttape/workweekdate.scm
@@ -0,0 +1,193 @@
+(use srfi-19)
+(use test)
+;;(use format)
+(use regex)
+;(declare (unit wwdate))
+;; utility procedures to convert among
+;; different ways to express date (wwdate, seconds since epoch, isodate)
+;;
+;; samples:
+;; isodate   -> "2016-01-01"
+;; wwdate -> "16ww01.5"
+;; seconds   -> 1451631600
+
+;; procedures provided:
+;; ====================
+;; seconds->isodate
+;; seconds->wwdate
+;;
+;; isodate->seconds
+;; isodate->wwdate
+;;
+;; wwdate->seconds
+;; wwdate->isodate
+
+;; srfi-19 used extensively; this doc is better tha the eggref:
+;; http://srfi.schemers.org/srfi-19/srfi-19.html
+
+;; Author: brandon.j.barclay@intel.com 16ww18.6
+
+(define (date->seconds date)
+  (inexact->exact
+   (string->number
+    (date->string date "~s"))))
+
+(define (seconds->isodate seconds)
+  (let* ((date (seconds->date seconds))
+         (result (date->string date "~Y-~m-~d")))
+    result))
+
+(define (isodate->seconds isodate)
+  "Takes a string input of the form 'YY-MM-DD' or 'YYYY-MM-DD' and returns epoch time; for YY, assume after Y2K"
+  (let* ((numlist (map string->number (string-split isodate "-")))
+        (raw-year (car numlist))
+        (year (if (< raw-year 100) (+ raw-year 2000) raw-year))
+        (month (list-ref numlist 1))
+        (day (list-ref numlist 2))
+        (date (make-date 0 0 0 0 day month year))
+        (seconds (date->seconds date)))
+
+    seconds))
+
+;; adapted from perl Intel::WorkWeek perl module
+;; workweek year consists of numbered weeks starting from week 1
+;;   days of week are numbered starting from 0 on sunday
+;;   weeks begin on sunday- day number 0 and end saturday- day 6
+;;   week 1 is defined as the week containing jan 1 of the year
+;;   workweek year does not match calendar year in workweek 1
+;;     since workweek 1 contains jan1 and workweek begins sunday,
+;;     days prior to jan1 in workweek 1 belong to the next workweek year
+(define (seconds->wwdate-values seconds)
+  (define (date-difference->seconds d1 d2)
+    (- (date->seconds d1) (date->seconds d2)))
+
+  (let* ((thisdate (seconds->date seconds))
+         (thisdow (string->number (date->string thisdate "~w")))
+
+         (year (date-year thisdate))
+         ;; intel workweek 1 begins on sunday of week containing jan1
+         (jan1 (make-date 0 0 0 0 1 1 year))
+         (jan1dow (date-week-day jan1))
+         (ww01 (date-subtract-duration jan1 (seconds->time (* 60 60 24 jan1dow))))
+
+         (ww01_delta_seconds (date-difference->seconds thisdate ww01))
+         (wwnum_initial (inexact->exact (add1 (floor (/ ww01_delta_seconds 24 3600 7) ))))
+         
+         ;; we could be in ww1 of next year
+         (this-saturday (seconds->date
+                         (+ seconds
+                            (* 60 60 24 (- 6 thisdow)))))
+         (this-week-ends-next-year?
+          (> (date-year this-saturday) year))
+         (intelyear
+          (if this-week-ends-next-year?
+              (add1 year)
+              year))
+         (intelweek
+          (if this-week-ends-next-year?
+              1
+              wwnum_initial)))
+   (values intelyear intelweek thisdow)))
+
+(define (string-leftpad in width pad-char)
+  (let* ((unpadded-str (->string in))
+         (padlen_temp (- width (string-length unpadded-str)))
+         (padlen (if (< padlen_temp 0) 0 padlen_temp))
+         (padding (make-string padlen pad-char)))
+    (conc padding unpadded-str)))
+
+(define (string-rightpad in width pad-char)
+  (let* ((unpadded-str (->string in))
+         (padlen_temp (- width (string-length unpadded-str)))
+         (padlen (if (< padlen_temp 0) 0 padlen_temp))
+         (padding (make-string padlen pad-char)))
+    (conc unpadded-str padding)))
+
+(define (zeropad num width)
+  (string-leftpad num width #\0))
+
+(define (seconds->wwdate seconds)
+
+  (let-values (((intelyear intelweek day-of-week-num)
+                (seconds->wwdate-values seconds)))
+    (let ((intelyear-str
+           (zeropad
+            (->string
+             (if (> intelyear 1999)
+                 (- intelyear 2000) intelyear))
+            2))
+          (intelweek-str
+           (zeropad (->string intelweek) 2))
+          (dow-str (->string day-of-week-num)))
+      (conc intelyear-str "ww" intelweek-str "." dow-str))))
+
+(define (isodate->wwdate isodate)
+  (seconds->wwdate
+   (isodate->seconds isodate)))
+
+(define (wwdate->seconds wwdate)
+  (let ((match (string-match "^(\\d+)ww(\\d+).(\\d)$" wwdate)))
+    (if
+     (not match)
+     #f
+     (let* (
+            (intelyear-raw (string->number (list-ref match 1)))
+            (intelyear (if (< intelyear-raw 100)
+                           (+ intelyear-raw 2000)
+                           intelyear-raw))
+            (intelww (string->number (list-ref match 2)))
+            (dayofweek (string->number (list-ref match 3)))
+
+            (day-of-seconds (* 60 60 24 ))
+            (week-of-seconds (* day-of-seconds 7))
+            
+
+            ;; get seconds at ww1.0
+            (new-years-date (make-date 0 0 0 0 1 1 intelyear))
+            (new-years-seconds
+             (date->seconds new-years-date))
+            (new-years-dayofweek (date-week-day new-years-date))
+            (ww1.0_seconds (- new-years-seconds
+                              (* day-of-seconds
+                                 new-years-dayofweek)))
+            (workweek-adjustment (* week-of-seconds (sub1 intelww)))
+            (weekday-adjustment (* dayofweek day-of-seconds))
+
+            (result (+ ww1.0_seconds workweek-adjustment weekday-adjustment)))
+       result))))
+
+(define (wwdate->isodate wwdate)
+  (seconds->isodate (wwdate->seconds wwdate)))
+
+(define (current-wwdate)
+  (seconds->wwdate (current-seconds)))
+
+(define (current-isodate)
+  (seconds->isodate (current-seconds)))
+
+(define (wwdate-tests)
+  (test-group
+   "date conversion tests"
+   (let ((test-table
+          '(("16ww01.5" . "2016-01-01")
+            ("16ww18.5" . "2016-04-29")
+            ("1999ww33.5" . "1999-08-13")
+            ("16ww18.4" . "2016-04-28")
+            ("16ww18.3" . "2016-04-27")
+            ("13ww01.0" . "2012-12-30")
+            ("13ww52.6" . "2013-12-28")
+            ("16ww53.3" . "2016-12-28"))))
+     (for-each
+      (lambda (test-pair)
+        (let ((wwdate (car test-pair))
+              (isodate (cdr test-pair)))
+          (test
+           (conc "(isodate->wwdate "isodate ") => "wwdate)
+           wwdate
+           (isodate->wwdate isodate))
+          
+          (test
+           (conc "(wwdate->isodate "wwdate ")   => "isodate)
+           isodate
+           (wwdate->isodate wwdate))))
+      test-table))))

ADDED   emacs.config
Index: emacs.config
==================================================================
--- /dev/null
+++ emacs.config
@@ -0,0 +1,13 @@
+;; Indenting module body code at column 0
+(defun scheme-module-indent (state indent-point normal-indent) 0)
+(put 'module 'scheme-indent-function 'scheme-module-indent)
+
+(put 'and-let* 'scheme-indent-function 1)
+(put 'parameterize 'scheme-indent-function 1)
+(put 'handle-exceptions 'scheme-indent-function 1)
+(put 'when 'scheme-indent-function 1)
+(put 'unless 'scheme-indent-function 1)
+(put 'match 'scheme-indent-function 1)
+(put 'let-values 'scheme-indent-function 1)
+
+

Index: env.scm
==================================================================
--- env.scm
+++ env.scm
@@ -21,20 +21,22 @@
 (declare (unit env))
 
 (use sql-de-lite) ;; srfi-1 posix regex regex-case srfi-69 srfi-18 call-with-environment-variables)
 
 (define (env:open-db fname)
-  (let* ((db-exists (common:file-exists? fname))
+  (let* ((db-exists (if (equal? fname ":memory:")
+			#f
+			(common:file-exists? fname)))
 	 (db        (open-database fname)))
     (if (not db-exists)
 	(begin
-	  (exec (sql db "CREATE TABLE envvars (
-                    id INTEGER PRIMARY KEY,
-                    context TEXT NOT NULL,
-                    var TEXT NOT NULL,
-                    val TEXT NOT NULL,
-                       CONSTRAINT envvars_constraint UNIQUE (context,var))"))))
+	  (exec (sql db "CREATE TABLE IF NOT EXISTS envvars (
+                            id INTEGER PRIMARY KEY,
+                            context TEXT NOT NULL,
+                            var TEXT NOT NULL,
+                            val TEXT NOT NULL,
+                               CONSTRAINT envvars_constraint UNIQUE (context,var))"))))
     (set-busy-handler! db (busy-timeout 10000))
     db))
 
 ;; save vars in given context, this is NOT incremental by default
 ;;
@@ -77,10 +79,33 @@
 				  val)))))
 	(sql db "SELECT var,val FROM envvars WHERE context=?")
 	context))
      contexts)
     result))
+
+;; envdelta: a-b (start=a, end=b, get the delta)
+;; ofile:    #f = write to stdout, else write to file with string name
+;;
+(define (env:envdelta db envdelta ofile)
+  (let ((match (string-split envdelta "-")));; (string-match "([a-z0-9_]+)=([a-z0-9_\\-,]+)" envdelta)))
+    (if (not (null? match))
+	(let* ((parts     match) ;; (string-split equn "-"))
+	       (minuend   (car parts))
+	       (subtraend (cadr parts))
+	       (added     (env:get-added   db minuend subtraend))
+	       (removed   (env:get-removed db minuend subtraend))
+	       (changed   (env:get-changed db minuend subtraend)))
+	  ;; (pp (hash-table->alist added))
+	  ;; (pp (hash-table->alist removed))
+	  ;; (pp (hash-table->alist changed))
+	  (if (args:get-arg "-o")
+	      (with-output-to-file
+		  (args:get-arg "-o")
+		(lambda ()
+		  (env:print added removed changed)))
+	      (env:print added removed changed)))
+	#f)))
 
 ;;  get list of removed variables between two contexts
 ;;
 (define (env:get-removed db contexta contextb)
   (let ((result (make-hash-table)))

ADDED   example2/rx.v
Index: example2/rx.v
==================================================================
--- /dev/null
+++ example2/rx.v
@@ -0,0 +1,649 @@
+////////////////////////////////////////////////////////////////////////////////
+//
+// Filename: 	rxuartlite.v
+//
+// Project:	wbuart32, a full featured UART with simulator
+//
+// Purpose:	Receive and decode inputs from a single UART line.
+//
+//
+//	To interface with this module, connect it to your system clock,
+//	and a UART input.  Set the parameter to the number of clocks per
+//	baud.  When data becomes available, the o_wr line will be asserted
+//	for one clock cycle.
+//
+//	This interface only handles 8N1 serial port communications.  It does
+//	not handle the break, parity, or frame error conditions.
+//
+//
+// Creator:	Dan Gisselquist, Ph.D.
+//		Gisselquist Technology, LLC
+//
+////////////////////////////////////////////////////////////////////////////////
+//
+// Copyright (C) 2015-2020, Gisselquist Technology, LLC
+//
+// This program is free software (firmware): you can redistribute it and/or
+// modify it under the terms of the GNU General Public License as published
+// by the Free Software Foundation, either version 3 of the License, or (at
+// your option) any later version.
+//
+// This program is distributed in the hope that it will be useful, but WITHOUT
+// ANY WARRANTY; without even the implied warranty of MERCHANTIBILITY or
+// FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+// for more details.
+//
+// You should have received a copy of the GNU General Public License along
+// with this program.  (It's in the $(ROOT)/doc directory.  Run make with no
+// target there if the PDF file isn't present.)  If not, see
+// <http://www.gnu.org/licenses/> for a copy.
+//
+// License:	GPL, v3, as defined and found on www.gnu.org,
+//		http://www.gnu.org/licenses/gpl.html
+//
+//
+////////////////////////////////////////////////////////////////////////////////
+//
+//
+`default_nettype	none
+//
+`define	RXUL_BIT_ZERO		4'h0
+`define	RXUL_BIT_ONE		4'h1
+`define	RXUL_BIT_TWO		4'h2
+`define	RXUL_BIT_THREE		4'h3
+`define	RXUL_BIT_FOUR		4'h4
+`define	RXUL_BIT_FIVE		4'h5
+`define	RXUL_BIT_SIX		4'h6
+`define	RXUL_BIT_SEVEN		4'h7
+`define	RXUL_STOP		4'h8
+`define	RXUL_WAIT		4'h9
+`define	RXUL_IDLE		4'hf
+
+module rxuartlite(i_clk, i_uart_rx, o_wr, o_data);
+	parameter			TIMER_BITS = 10;
+`ifdef	FORMAL
+	parameter  [(TIMER_BITS-1):0]	CLOCKS_PER_BAUD = 16; // Necessary for formal proof
+`else
+	parameter  [(TIMER_BITS-1):0]	CLOCKS_PER_BAUD = 868;	// 115200 MBaud at 100MHz
+`endif
+	localparam			TB = TIMER_BITS;
+	input	wire		i_clk;
+	input	wire		i_uart_rx;
+	output	reg		o_wr;
+	output	reg	[7:0]	o_data;
+
+
+	wire	[(TB-1):0]	half_baud;
+	reg	[3:0]		state;
+
+	assign	half_baud = { 1'b0, CLOCKS_PER_BAUD[(TB-1):1] };
+	reg	[(TB-1):0]	baud_counter;
+	reg			zero_baud_counter;
+
+
+	// Since this is an asynchronous receiver, we need to register our
+	// input a couple of clocks over to avoid any problems with 
+	// metastability.  We do that here, and then ignore all but the
+	// ck_uart wire.
+	reg	q_uart, qq_uart, ck_uart;
+	initial	q_uart  = 1'b1;
+	initial	qq_uart = 1'b1;
+	initial	ck_uart = 1'b1;
+	always @(posedge i_clk)
+		{ ck_uart, qq_uart, q_uart } <= { qq_uart, q_uart, i_uart_rx };
+
+	// Keep track of the number of clocks since the last change.
+	//
+	// This is used to determine if we are in either a break or an idle
+	// condition, as discussed further below.
+	reg	[(TB-1):0]	chg_counter;
+	initial	chg_counter = {(TB){1'b1}};
+	always @(posedge i_clk)
+	if (qq_uart != ck_uart)
+		chg_counter <= 0;
+	else if (chg_counter != { (TB){1'b1} })
+		chg_counter <= chg_counter + 1;
+
+	// Are we in the middle of a baud iterval?  Specifically, are we
+	// in the middle of a start bit?  Set this to high if so.  We'll use
+	// this within our state machine to transition out of the IDLE
+	// state.
+	reg	half_baud_time;
+	initial	half_baud_time = 0;
+	always @(posedge i_clk)
+		half_baud_time <= (!ck_uart)&&(chg_counter >= half_baud-1'b1-1'b1);
+
+
+	initial	state = `RXUL_IDLE;
+	always @(posedge i_clk)
+	if (state == `RXUL_IDLE)
+	begin // Idle state, independent of baud counter
+		// By default, just stay in the IDLE state
+		state <= `RXUL_IDLE;
+		if ((!ck_uart)&&(half_baud_time))
+			// UNLESS: We are in the center of a valid
+			// start bit
+			state <= `RXUL_BIT_ZERO;
+	end else if ((state >= `RXUL_WAIT)&&(ck_uart))
+		state <= `RXUL_IDLE;
+	else if (zero_baud_counter)
+	begin
+		if (state <= `RXUL_STOP)
+			// Data arrives least significant bit first.
+			// By the time this is clocked in, it's what
+			// you'll have.
+			state <= state + 1;
+	end
+
+	// Data bit capture logic.
+	//
+	// This is drastically simplified from the state machine above, based
+	// upon: 1) it doesn't matter what it is until the end of a captured
+	// byte, and 2) the data register will flush itself of any invalid
+	// data in all other cases.  Hence, let's keep it real simple.
+	reg	[7:0]	data_reg;
+	always @(posedge i_clk)
+	if ((zero_baud_counter)&&(state != `RXUL_STOP))
+		data_reg <= { qq_uart, data_reg[7:1] };
+
+	// Our data bit logic doesn't need nearly the complexity of all that
+	// work above.  Indeed, we only need to know if we are at the end of
+	// a stop bit, in which case we copy the data_reg into our output
+	// data register, o_data, and tell others (for one clock) that data is
+	// available.
+	//
+	initial	o_wr = 1'b0;
+	initial	o_data = 8'h00;
+	always @(posedge i_clk)
+	if ((zero_baud_counter)&&(state == `RXUL_STOP)&&(ck_uart))
+	begin
+		o_wr   <= 1'b1;
+		o_data <= data_reg;
+	end else
+		o_wr   <= 1'b0;
+
+	// The baud counter
+	//
+	// This is used as a "clock divider" if you will, but the clock needs
+	// to be reset before any byte can be decoded.  In all other respects,
+	// we set ourselves up for CLOCKS_PER_BAUD counts between baud
+	// intervals.
+	initial	baud_counter = 0;
+	always @(posedge i_clk)
+	if (((state==`RXUL_IDLE))&&(!ck_uart)&&(half_baud_time))
+		baud_counter <= CLOCKS_PER_BAUD-1'b1;
+	else if (state == `RXUL_WAIT)
+		baud_counter <= 0;
+	else if ((zero_baud_counter)&&(state < `RXUL_STOP))
+		baud_counter <= CLOCKS_PER_BAUD-1'b1;
+	else if (!zero_baud_counter)
+		baud_counter <= baud_counter-1'b1;
+
+	// zero_baud_counter
+	//
+	// Rather than testing whether or not (baud_counter == 0) within our
+	// (already too complicated) state transition tables, we use
+	// zero_baud_counter to pre-charge that test on the clock
+	// before--cleaning up some otherwise difficult timing dependencies.
+	initial	zero_baud_counter = 1'b1;
+	always @(posedge i_clk)
+	if ((state == `RXUL_IDLE)&&(!ck_uart)&&(half_baud_time))
+		zero_baud_counter <= 1'b0;
+	else if (state == `RXUL_WAIT)
+		zero_baud_counter <= 1'b1;
+	else if ((zero_baud_counter)&&(state < `RXUL_STOP))
+		zero_baud_counter <= 1'b0;
+	else if (baud_counter == 1)
+		zero_baud_counter <= 1'b1;
+
+`ifdef	FORMAL
+`define	FORMAL_VERILATOR
+`else
+`ifdef	VERILATOR
+`define	FORMAL_VERILATOR
+`endif
+`endif
+
+`ifdef	FORMAL
+`define ASSUME	assume
+`define ASSERT	assert
+`ifdef	VERIFIC
+	(* gclk *) wire	gbl_clk;
+	global clocking @(posedge gbl_clk); endclocking
+`endif
+
+
+	localparam	F_CKRES = 10;
+
+	(* anyseq *) wire	f_tx_start;
+	(* anyconst *) wire	[(F_CKRES-1):0]	f_tx_step;
+	reg			f_tx_zclk;
+	reg	[(TB-1):0]	f_tx_timer;
+	wire	[7:0]		f_rx_newdata;
+	reg	[(TB-1):0]	f_tx_baud;
+	wire			f_tx_zbaud;
+
+	wire	[(TB-1):0]	f_max_baud_difference;
+	reg	[(TB-1):0]	f_baud_difference;
+	reg	[(TB+3):0]	f_tx_count, f_rx_count;
+	(* anyseq *) wire	[7:0]		f_tx_data;
+
+
+
+	wire			f_txclk;
+	reg	[1:0]		f_rx_clock;
+	reg	[(F_CKRES-1):0]	f_tx_clock;
+	reg			f_past_valid, f_past_valid_tx;
+
+	initial	f_past_valid = 1'b0;
+	always @(posedge i_clk)
+		f_past_valid <= 1'b1;
+
+	initial	f_rx_clock = 3'h0;
+	always @($global_clock)
+		f_rx_clock <= f_rx_clock + 1'b1;
+
+	always @(*)
+		assume(i_clk == f_rx_clock[1]);
+	///////////////////////////////////////////////////////////
+	//
+	//
+	// Generate a transmitted signal
+	//
+	//
+	///////////////////////////////////////////////////////////
+	// First, calculate the transmit clock
+	localparam [(F_CKRES-1):0] F_MIDSTEP = { 2'b01, {(F_CKRES-2){1'b0}} };
+	//
+	// Need to allow us to slip by half a baud clock over 10 baud intervals
+	//
+	// (F_STEP / (2^F_CKRES)) * (CLOCKS_PER_BAUD)*10 < CLOCKS_PER_BAUD/2
+	// F_STEP * 2 * 10 < 2^F_CKRES
+	localparam [(F_CKRES-1):0] F_HALFSTEP= F_MIDSTEP/32;
+	localparam [(F_CKRES-1):0] F_MINSTEP = F_MIDSTEP - F_HALFSTEP + 1;
+	localparam [(F_CKRES-1):0] F_MAXSTEP = F_MIDSTEP + F_HALFSTEP - 1;
+	initial assert(F_MINSTEP <= F_MIDSTEP);
+	initial assert(F_MIDSTEP <= F_MAXSTEP);
+	//	assume((f_tx_step >= F_MINSTEP)&&(f_tx_step <= F_MAXSTEP));
+	//
+	//
+	always @(*) assume((f_tx_step == F_MINSTEP)
+			||(f_tx_step == F_MIDSTEP)
+			||(f_tx_step == F_MAXSTEP));
+	always @($global_clock)
+		f_tx_clock <= f_tx_clock + f_tx_step;
+	assign	f_txclk = f_tx_clock[F_CKRES-1];
+	// 
+	initial	f_past_valid_tx = 1'b0;
+	always @(posedge f_txclk)
+		f_past_valid_tx <= 1'b1;
+	initial	assume(i_uart_rx);
+	//////////////////////////////////////////////
+	//
+	//
+	// Build a simulated transmitter
+	//
+	//
+	//////////////////////////////////////////////
+	//
+	// First, the simulated timing generator
+	// parameter	TIMER_BITS = 10;
+	// parameter [(TIMER_BITS-1):0] CLOCKS_PER_BAUD = 868;
+	// localparam	TB = TIMER_BITS;
+	always @(*)
+	if (f_tx_busy)
+		assume(!f_tx_start);
+	initial	f_tx_baud = 0;
+	always @(posedge f_txclk)
+	if ((f_tx_zbaud)&&((f_tx_busy)||(f_tx_start)))
+		f_tx_baud <= CLOCKS_PER_BAUD-1'b1;
+	else if (!f_tx_zbaud)
+		f_tx_baud <= f_tx_baud - 1'b1;
+	always @(*)
+		`ASSERT(f_tx_baud < CLOCKS_PER_BAUD);
+	always @(*)
+	if (!f_tx_busy)
+		`ASSERT(f_tx_baud == 0);
+	assign	f_tx_zbaud = (f_tx_baud == 0);
+	// But only if we aren't busy
+	initial	assume(f_tx_data == 0);
+	always @(posedge f_txclk)
+	if ((!f_tx_zbaud)||(f_tx_busy)||(!f_tx_start))
+		assume(f_tx_data == $past(f_tx_data));
+	// Force the data to change on a clock only
+	always @($global_clock)
+	if ((f_past_valid)&&(!$rose(f_txclk)))
+		assume($stable(f_tx_data));
+	else if (f_tx_busy)
+		assume($stable(f_tx_data));
+	//
+	always @($global_clock)
+	if ((!f_past_valid)||(!$rose(f_txclk)))
+	begin
+		assume($stable(f_tx_start));
+		assume($stable(f_tx_data));
+	end
+	//
+	//
+	//
+	reg	[9:0]	f_tx_reg;
+	reg		f_tx_busy;
+	// Here's the transmitter itself (roughly)
+	initial	f_tx_busy   = 1'b0;
+	initial	f_tx_reg    = 0;
+	always @(posedge f_txclk)
+	if (!f_tx_zbaud)
+	begin
+		`ASSERT(f_tx_busy);
+	end else begin
+		f_tx_reg  <= { 1'b0, f_tx_reg[9:1] };
+		if (f_tx_start)
+			f_tx_reg <= { 1'b1, f_tx_data, 1'b0 };
+	end
+	// Create a busy flag that we'll use
+	always @(*)
+	if (!f_tx_zbaud)
+		f_tx_busy <= 1'b1;
+	else if (|f_tx_reg)
+		f_tx_busy <= 1'b1;
+	else
+		f_tx_busy <= 1'b0;
+	//
+	// Tie the TX register to the TX data
+	always @(posedge f_txclk)
+	if (f_tx_reg[9])
+		`ASSERT(f_tx_reg[8:0] == { f_tx_data, 1'b0 });
+	else if (f_tx_reg[8])
+		`ASSERT(f_tx_reg[7:0] == f_tx_data[7:0] );
+	else if (f_tx_reg[7])
+		`ASSERT(f_tx_reg[6:0] == f_tx_data[7:1] );
+	else if (f_tx_reg[6])
+		`ASSERT(f_tx_reg[5:0] == f_tx_data[7:2] );
+	else if (f_tx_reg[5])
+		`ASSERT(f_tx_reg[4:0] == f_tx_data[7:3] );
+	else if (f_tx_reg[4])
+		`ASSERT(f_tx_reg[3:0] == f_tx_data[7:4] );
+	else if (f_tx_reg[3])
+		`ASSERT(f_tx_reg[2:0] == f_tx_data[7:5] );
+	else if (f_tx_reg[2])
+		`ASSERT(f_tx_reg[1:0] == f_tx_data[7:6] );
+	else if (f_tx_reg[1])
+		`ASSERT(f_tx_reg[0] == f_tx_data[7]);
+	// Our counter since we start
+	initial	f_tx_count = 0;
+	always @(posedge f_txclk)
+	if (!f_tx_busy)
+		f_tx_count <= 0;
+	else
+		f_tx_count <= f_tx_count + 1'b1;
+	always @(*)
+	if (f_tx_reg == 10'h0)
+		assume(i_uart_rx);
+	else
+		assume(i_uart_rx == f_tx_reg[0]);
+	//
+	// Make sure the absolute transmit clock timer matches our state
+	//
+	always @(posedge f_txclk)
+	if (!f_tx_busy)
+	begin
+		if ((!f_past_valid_tx)||(!$past(f_tx_busy)))
+			`ASSERT(f_tx_count == 0);
+	end else if (f_tx_reg[9])
+		`ASSERT(f_tx_count ==
+				    CLOCKS_PER_BAUD -1 -f_tx_baud);
+	else if (f_tx_reg[8])
+		`ASSERT(f_tx_count ==
+				2 * CLOCKS_PER_BAUD -1 -f_tx_baud);
+	else if (f_tx_reg[7])
+		`ASSERT(f_tx_count ==
+				3 * CLOCKS_PER_BAUD -1 -f_tx_baud);
+	else if (f_tx_reg[6])
+		`ASSERT(f_tx_count ==
+				4 * CLOCKS_PER_BAUD -1 -f_tx_baud);
+	else if (f_tx_reg[5])
+		`ASSERT(f_tx_count ==
+				5 * CLOCKS_PER_BAUD -1 -f_tx_baud);
+	else if (f_tx_reg[4])
+		`ASSERT(f_tx_count ==
+				6 * CLOCKS_PER_BAUD -1 -f_tx_baud);
+	else if (f_tx_reg[3])
+		`ASSERT(f_tx_count ==
+				7 * CLOCKS_PER_BAUD -1 -f_tx_baud);
+	else if (f_tx_reg[2])
+		`ASSERT(f_tx_count ==
+				8 * CLOCKS_PER_BAUD -1 -f_tx_baud);
+	else if (f_tx_reg[1])
+		`ASSERT(f_tx_count ==
+				9 * CLOCKS_PER_BAUD -1 -f_tx_baud);
+	else if (f_tx_reg[0])
+		`ASSERT(f_tx_count ==
+				10 * CLOCKS_PER_BAUD -1 -f_tx_baud);
+	else
+		`ASSERT(f_tx_count ==
+				11 * CLOCKS_PER_BAUD -1 -f_tx_baud);
+	///////////////////////////////////////
+	//
+	// Receiver
+	//
+	///////////////////////////////////////
+	//
+	// Count RX clocks since the start of the first stop bit, measured in
+	// rx clocks
+	initial	f_rx_count = 0;
+	always @(posedge i_clk)
+	if (state == `RXUL_IDLE)
+		f_rx_count = (!ck_uart) ? (chg_counter+2) : 0;
+	else
+		f_rx_count <= f_rx_count + 1'b1;
+	always @(posedge i_clk)
+	if (state == 0)
+		`ASSERT(f_rx_count
+				== half_baud + (CLOCKS_PER_BAUD-baud_counter));
+	else if (state == 1)
+		`ASSERT(f_rx_count == half_baud + 2 * CLOCKS_PER_BAUD
+					- baud_counter);
+	else if (state == 2)
+		`ASSERT(f_rx_count == half_baud + 3 * CLOCKS_PER_BAUD
+					- baud_counter);
+	else if (state == 3)
+		`ASSERT(f_rx_count == half_baud + 4 * CLOCKS_PER_BAUD
+					- baud_counter);
+	else if (state == 4)
+		`ASSERT(f_rx_count == half_baud + 5 * CLOCKS_PER_BAUD
+					- baud_counter);
+	else if (state == 5)
+		`ASSERT(f_rx_count == half_baud + 6 * CLOCKS_PER_BAUD
+					- baud_counter);
+	else if (state == 6)
+		`ASSERT(f_rx_count == half_baud + 7 * CLOCKS_PER_BAUD
+					- baud_counter);
+	else if (state == 7)
+		`ASSERT(f_rx_count == half_baud + 8 * CLOCKS_PER_BAUD
+					- baud_counter);
+	else if (state == 8)
+		`ASSERT((f_rx_count == half_baud + 9 * CLOCKS_PER_BAUD
+					- baud_counter)
+			||(f_rx_count == half_baud + 10 * CLOCKS_PER_BAUD
+					- baud_counter));
+	always @(*)
+		`ASSERT( ((!zero_baud_counter)
+				&&(state == `RXUL_IDLE)
+				&&(baud_counter == 0))
+			||((zero_baud_counter)&&(baud_counter == 0))
+			||((!zero_baud_counter)&&(baud_counter != 0)));
+	always @(posedge i_clk)
+	if (!f_past_valid)
+		`ASSERT((state == `RXUL_IDLE)&&(baud_counter == 0)
+			&&(zero_baud_counter));
+	always @(*)
+	begin
+		`ASSERT({ ck_uart,qq_uart,q_uart,i_uart_rx } != 4'h2);
+		`ASSERT({ ck_uart,qq_uart,q_uart,i_uart_rx } != 4'h4);
+		`ASSERT({ ck_uart,qq_uart,q_uart,i_uart_rx } != 4'h5);
+		`ASSERT({ ck_uart,qq_uart,q_uart,i_uart_rx } != 4'h6);
+		`ASSERT({ ck_uart,qq_uart,q_uart,i_uart_rx } != 4'h9);
+		`ASSERT({ ck_uart,qq_uart,q_uart,i_uart_rx } != 4'ha);
+		`ASSERT({ ck_uart,qq_uart,q_uart,i_uart_rx } != 4'hb);
+		`ASSERT({ ck_uart,qq_uart,q_uart,i_uart_rx } != 4'hd);
+	end
+	always @(posedge i_clk)
+	if ((f_past_valid)&&($past(state) >= `RXUL_WAIT)&&($past(ck_uart)))
+		`ASSERT(state == `RXUL_IDLE);
+	always @(posedge i_clk)
+	if ((f_past_valid)&&($past(state) >= `RXUL_WAIT)
+			&&(($past(state) != `RXUL_IDLE)||(state == `RXUL_IDLE)))
+		`ASSERT(zero_baud_counter);
+	// Calculate an absolute value of the difference between the two baud
+	// clocks
+	always @(posedge i_clk)
+	if ((f_past_valid)&&($past(state)==`RXUL_IDLE)&&(state == `RXUL_IDLE))
+	begin
+		`ASSERT(($past(ck_uart))
+			||(chg_counter <=
+				{ 1'b0, CLOCKS_PER_BAUD[(TB-1):1] }));
+	end
+	always @(posedge f_txclk)
+	if (!f_past_valid_tx)
+		`ASSERT((state == `RXUL_IDLE)&&(baud_counter == 0)
+			&&(zero_baud_counter)&&(!f_tx_busy));
+	wire	[(TB+3):0]	f_tx_count_two_clocks_ago;
+	assign	f_tx_count_two_clocks_ago = f_tx_count - 2;
+	always @(*)
+	if (f_tx_count >= f_rx_count + 2)
+		f_baud_difference = f_tx_count_two_clocks_ago - f_rx_count;
+	else
+		f_baud_difference = f_rx_count - f_tx_count_two_clocks_ago;
+	localparam	F_SYNC_DLY = 8;
+	reg	[(TB+4+F_CKRES-1):0]	f_sub_baud_difference;
+	reg	[F_CKRES-1:0]	ck_tx_clock;
+	reg	[((F_SYNC_DLY-1)*F_CKRES)-1:0]	q_tx_clock;
+	reg	[TB+3:0]	ck_tx_count;
+	reg	[(F_SYNC_DLY-1)*(TB+4)-1:0]	q_tx_count;
+	initial	q_tx_count = 0;
+	initial	ck_tx_count = 0;
+	initial	q_tx_clock = 0;
+	initial	ck_tx_clock = 0;
+	always @($global_clock)
+		{ ck_tx_clock, q_tx_clock } <= { q_tx_clock, f_tx_clock };
+	always @($global_clock)
+		{ ck_tx_count, q_tx_count } <= { q_tx_count, f_tx_count };
+	reg	[TB+4+F_CKRES-1:0]	f_ck_tx_time, f_rx_time;
+	always @(*)
+		f_ck_tx_time = { ck_tx_count, !ck_tx_clock[F_CKRES-1],
+						ck_tx_clock[F_CKRES-2:0] };
+	always @(*)
+		f_rx_time = { f_rx_count, !f_rx_clock[1], f_rx_clock[0],
+						{(F_CKRES-2){1'b0}} };
+	reg	[TB+4+F_CKRES-1:0]	f_signed_difference;
+	always @(*)
+		f_signed_difference = f_ck_tx_time - f_rx_time;
+	always @(*)
+	if (f_signed_difference[TB+4+F_CKRES-1])
+		f_sub_baud_difference = -f_signed_difference;
+	else
+		f_sub_baud_difference =  f_signed_difference;
+	always @($global_clock)
+	if (state == `RXUL_WAIT)
+		`ASSERT((!f_tx_busy)||(f_tx_reg[9:1] == 0));
+	always @($global_clock)
+	if (state == `RXUL_IDLE)
+	begin
+		`ASSERT((!f_tx_busy)||(f_tx_reg[9])||(f_tx_reg[9:1]==0));
+		if (!ck_uart)
+			;//`PHASE_TWO_ASSERT((f_rx_count < 4)||(f_sub_baud_difference <= ((CLOCKS_PER_BAUD<<F_CKRES)/20)));
+		else
+			`ASSERT((f_tx_reg[9:1]==0)||(f_tx_count < (3 + CLOCKS_PER_BAUD/2)));
+	end else if (state == 0)
+		`ASSERT(f_sub_baud_difference
+				<=  2 * ((CLOCKS_PER_BAUD<<F_CKRES)/20));
+	else if (state == 1)
+		`ASSERT(f_sub_baud_difference
+				<=  3 * ((CLOCKS_PER_BAUD<<F_CKRES)/20));
+	else if (state == 2)
+		`ASSERT(f_sub_baud_difference
+				<=  4 * ((CLOCKS_PER_BAUD<<F_CKRES)/20));
+	else if (state == 3)
+		`ASSERT(f_sub_baud_difference
+				<=  5 * ((CLOCKS_PER_BAUD<<F_CKRES)/20));
+	else if (state == 4)
+		`ASSERT(f_sub_baud_difference
+				<=  6 * ((CLOCKS_PER_BAUD<<F_CKRES)/20));
+	else if (state == 5)
+		`ASSERT(f_sub_baud_difference
+				<=  7 * ((CLOCKS_PER_BAUD<<F_CKRES)/20));
+	else if (state == 6)
+		`ASSERT(f_sub_baud_difference
+				<=  8 * ((CLOCKS_PER_BAUD<<F_CKRES)/20));
+	else if (state == 7)
+		`ASSERT(f_sub_baud_difference
+				<=  9 * ((CLOCKS_PER_BAUD<<F_CKRES)/20));
+	else if (state == 8)
+		`ASSERT(f_sub_baud_difference
+				<= 10 * ((CLOCKS_PER_BAUD<<F_CKRES)/20));
+	always @(posedge i_clk)
+	if (o_wr)
+		`ASSERT(o_data == $past(f_tx_data,4));
+	// always @(posedge i_clk)
+	// if ((zero_baud_counter)&&(state != 4'hf)&&(CLOCKS_PER_BAUD > 6))
+		// assert(i_uart_rx == ck_uart);
+	// Make sure the data register matches
+	always @(posedge i_clk)
+	// if ((f_past_valid)&&(state != $past(state)))
+	begin
+		if (state == 4'h0)
+			`ASSERT(!data_reg[7]);
+		if (state == 4'h1)
+			`ASSERT((data_reg[7]
+				== $past(f_tx_data[0]))&&(!data_reg[6]));
+		if (state == 4'h2)
+			`ASSERT(data_reg[7:6]
+					== $past(f_tx_data[1:0]));
+		if (state == 4'h3)
+			`ASSERT(data_reg[7:5] == $past(f_tx_data[2:0]));
+		if (state == 4'h4)
+			`ASSERT(data_reg[7:4] == $past(f_tx_data[3:0]));
+		if (state == 4'h5)
+			`ASSERT(data_reg[7:3] == $past(f_tx_data[4:0]));
+		if (state == 4'h6)
+			`ASSERT(data_reg[7:2] == $past(f_tx_data[5:0]));
+		if (state == 4'h7)
+			`ASSERT(data_reg[7:1] == $past(f_tx_data[6:0]));
+		if (state == 4'h8)
+			`ASSERT(data_reg[7:0] == $past(f_tx_data[7:0]));
+	end
+	////////////////////////////////////////////////////////////////////////
+	//
+	// Cover properties
+	//
+	////////////////////////////////////////////////////////////////////////
+	//
+	always @(posedge i_clk)
+		cover(o_wr); // Step 626, takes about 20mins
+	always @(posedge i_clk)
+	begin
+		cover(!ck_uart);
+		cover((f_past_valid)&&($rose(ck_uart)));               //  82
+		cover((zero_baud_counter)&&(state == `RXUL_BIT_ZERO)); // 110
+		cover((zero_baud_counter)&&(state == `RXUL_BIT_ONE));  // 174
+		cover((zero_baud_counter)&&(state == `RXUL_BIT_TWO));  // 238
+		cover((zero_baud_counter)&&(state == `RXUL_BIT_THREE));// 302
+		cover((zero_baud_counter)&&(state == `RXUL_BIT_FOUR)); // 366
+		cover((zero_baud_counter)&&(state == `RXUL_BIT_FIVE)); // 430
+		cover((zero_baud_counter)&&(state == `RXUL_BIT_SIX));  // 494
+		cover((zero_baud_counter)&&(state == `RXUL_BIT_SEVEN));// 558
+		cover((zero_baud_counter)&&(state == `RXUL_STOP));     // 622
+		cover((zero_baud_counter)&&(state == `RXUL_WAIT));     // 626
+	end
+`endif
+`ifdef	FORMAL_VERILATOR
+	// FORMAL properties which can be tested via Verilator as well as
+	// Yosys FORMAL
+	always @(*)
+		assert((state == 4'hf)||(state <= `RXUL_WAIT));
+	always @(*)
+		assert(zero_baud_counter == (baud_counter == 0)? 1'b1:1'b0);
+	always @(*)
+		assert(baud_counter <= CLOCKS_PER_BAUD-1'b1);
+`endif
+endmodule

ADDED   example2/tx.v
Index: example2/tx.v
==================================================================
--- /dev/null
+++ example2/tx.v
@@ -0,0 +1,434 @@
+
+////////////////////////////////////////////////////////////////////////////////
+//
+// Filename: 	txuartlite.v
+//
+// Project:	wbuart32, a full featured UART with simulator
+//
+// Purpose:	Transmit outputs over a single UART line.  This particular UART
+//		implementation has been extremely simplified: it does not handle
+//	generating break conditions, nor does it handle anything other than the
+//	8N1 (8 data bits, no parity, 1 stop bit) UART sub-protocol.
+//
+//	To interface with this module, connect it to your system clock, and
+//	pass it the byte of data you wish to transmit.  Strobe the i_wr line
+//	high for one cycle, and your data will be off.  Wait until the 'o_busy'
+//	line is low before strobing the i_wr line again--this implementation
+//	has NO BUFFER, so strobing i_wr while the core is busy will just
+//	get ignored.  The output will be placed on the o_txuart output line.
+//
+//	(I often set both data and strobe on the same clock, and then just leave
+//	them set until the busy line is low.  Then I move on to the next piece
+//	of data.)
+//
+// Creator:	Dan Gisselquist, Ph.D.
+//		Gisselquist Technology, LLC
+//
+////////////////////////////////////////////////////////////////////////////////
+//
+// Copyright (C) 2015-2020, Gisselquist Technology, LLC
+//
+// This program is free software (firmware): you can redistribute it and/or
+// modify it under the terms of the GNU General Public License as published
+// by the Free Software Foundation, either version 3 of the License, or (at
+// your option) any later version.
+//
+// This program is distributed in the hope that it will be useful, but WITHOUT
+// ANY WARRANTY; without even the implied warranty of MERCHANTIBILITY or
+// FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+// for more details.
+//
+// You should have received a copy of the GNU General Public License along
+// with this program.  (It's in the $(ROOT)/doc directory.  Run make with no
+// target there if the PDF file isn't present.)  If not, see
+// <http://www.gnu.org/licenses/> for a copy.
+//
+// License:	GPL, v3, as defined and found on www.gnu.org,
+//		http://www.gnu.org/licenses/gpl.html
+//
+//
+////////////////////////////////////////////////////////////////////////////////
+//
+//
+`default_nettype	none
+//
+`define	TXUL_BIT_ZERO	4'h0
+`define	TXUL_BIT_ONE	4'h1
+`define	TXUL_BIT_TWO	4'h2
+`define	TXUL_BIT_THREE	4'h3
+`define	TXUL_BIT_FOUR	4'h4
+`define	TXUL_BIT_FIVE	4'h5
+`define	TXUL_BIT_SIX	4'h6
+`define	TXUL_BIT_SEVEN	4'h7
+`define	TXUL_STOP	4'h8
+`define	TXUL_IDLE	4'hf
+//
+//
+module txuartlite(i_clk, i_wr, i_data, o_uart_tx, o_busy);
+	parameter	[4:0]	TIMING_BITS = 5'd24;
+	localparam		TB = TIMING_BITS;
+	parameter	[(TB-1):0]	CLOCKS_PER_BAUD = 8; // 24'd868;
+	input	wire		i_clk;
+	input	wire		i_wr;
+	input	wire	[7:0]	i_data;
+	// And the UART input line itself
+	output	reg		o_uart_tx;
+	// A line to tell others when we are ready to accept data.  If
+	// (i_wr)&&(!o_busy) is ever true, then the core has accepted a byte
+	// for transmission.
+	output	wire		o_busy;
+
+	reg	[(TB-1):0]	baud_counter;
+	reg	[3:0]	state;
+	reg	[7:0]	lcl_data;
+	reg		r_busy, zero_baud_counter;
+
+	// Big state machine controlling: r_busy, state
+	// {{{
+	//
+	initial	r_busy = 1'b1;
+	initial	state  = `TXUL_IDLE;
+	always @(posedge i_clk)
+	begin
+		if (!zero_baud_counter)
+			// r_busy needs to be set coming into here
+			r_busy <= 1'b1;
+		else if (state > `TXUL_STOP)	// STATE_IDLE
+		begin
+			state <= `TXUL_IDLE;
+			r_busy <= 1'b0;
+			if ((i_wr)&&(!r_busy))
+			begin	// Immediately start us off with a start bit
+				r_busy <= 1'b1;
+				state <= `TXUL_BIT_ZERO;
+			end
+		end else begin
+			// One clock tick in each of these states ...
+			r_busy <= 1'b1;
+			if (state <=`TXUL_STOP) // start bit, 8-d bits, stop-b
+				state <= state + 1'b1;
+			else
+				state <= `TXUL_IDLE;
+		end
+	end
+	// }}}
+
+	// o_busy
+	// {{{
+	//
+	// This is a wire, designed to be true is we are ever busy above.
+	// originally, this was going to be true if we were ever not in the
+	// idle state.  The logic has since become more complex, hence we have
+	// a register dedicated to this and just copy out that registers value.
+	assign	o_busy = (r_busy);
+	// }}}
+
+
+	// lcl_data
+	// {{{
+	//
+	// This is our working copy of the i_data register which we use
+	// when transmitting.  It is only of interest during transmit, and is
+	// allowed to be whatever at any other time.  Hence, if r_busy isn't
+	// true, we can always set it.  On the one clock where r_busy isn't
+	// true and i_wr is, we set it and r_busy is true thereafter.
+	// Then, on any zero_baud_counter (i.e. change between baud intervals)
+	// we simple logically shift the register right to grab the next bit.
+	initial	lcl_data = 8'hff;
+	always @(posedge i_clk)
+		if ((i_wr)&&(!r_busy))
+			lcl_data <= i_data;
+		else if (zero_baud_counter)
+			lcl_data <= { 1'b1, lcl_data[7:1] };
+	// }}}
+
+	// o_uart_tx
+	// {{{
+	//
+	// This is the final result/output desired of this core.  It's all
+	// centered about o_uart_tx.  This is what finally needs to follow
+	// the UART protocol.
+	//
+	initial	o_uart_tx = 1'b1;
+	always @(posedge i_clk)
+		if ((i_wr)&&(!r_busy))
+			o_uart_tx <= 1'b0;	// Set the start bit on writes
+		else if (zero_baud_counter)	// Set the data bit.
+			o_uart_tx <= lcl_data[0];
+	// }}}
+
+	// Baud counter
+	// {{{
+	// All of the above logic is driven by the baud counter.  Bits must last
+	// CLOCKS_PER_BAUD in length, and this baud counter is what we use to
+	// make certain of that.
+	//
+	// The basic logic is this: at the beginning of a bit interval, start
+	// the baud counter and set it to count CLOCKS_PER_BAUD.  When it gets
+	// to zero, restart it.
+	//
+	// However, comparing a 28'bit number to zero can be rather complex--
+	// especially if we wish to do anything else on that same clock.  For
+	// that reason, we create "zero_baud_counter".  zero_baud_counter is
+	// nothing more than a flag that is true anytime baud_counter is zero.
+	// It's true when the logic (above) needs to step to the next bit.
+	// Simple enough?
+	//
+	// I wish we could stop there, but there are some other (ugly)
+	// conditions to deal with that offer exceptions to this basic logic.
+	//
+	// 1. When the user has commanded a BREAK across the line, we need to
+	// wait several baud intervals following the break before we start
+	// transmitting, to give any receiver a chance to recognize that we are
+	// out of the break condition, and to know that the next bit will be
+	// a stop bit.
+	//
+	// 2. A reset is similar to a break condition--on both we wait several
+	// baud intervals before allowing a start bit.
+	//
+	// 3. In the idle state, we stop our counter--so that upon a request
+	// to transmit when idle we can start transmitting immediately, rather
+	// than waiting for the end of the next (fictitious and arbitrary) baud
+	// interval.
+	//
+	// When (i_wr)&&(!r_busy)&&(state == `TXUL_IDLE) then we're not only in
+	// the idle state, but we also just accepted a command to start writing
+	// the next word.  At this point, the baud counter needs to be reset
+	// to the number of CLOCKS_PER_BAUD, and zero_baud_counter set to zero.
+	//
+	// The logic is a bit twisted here, in that it will only check for the
+	// above condition when zero_baud_counter is false--so as to make
+	// certain the STOP bit is complete.
+	initial	zero_baud_counter = 1'b1;
+	initial	baud_counter = 0;
+	always @(posedge i_clk)
+	begin
+		zero_baud_counter <= (baud_counter == 1);
+		if (state == `TXUL_IDLE)
+		begin
+			baud_counter <= 0;
+			zero_baud_counter <= 1'b1;
+			if ((i_wr)&&(!r_busy))
+			begin
+				baud_counter <= CLOCKS_PER_BAUD - 1'b1;
+				zero_baud_counter <= 1'b0;
+			end
+		end else if ((zero_baud_counter)&&(state == 4'h9))
+		begin
+			baud_counter <= 0;
+			zero_baud_counter <= 1'b1;
+		end else if (!zero_baud_counter)
+			baud_counter <= baud_counter - 1'b1;
+		else
+			baud_counter <= CLOCKS_PER_BAUD - 1'b1;
+	end
+	// }}}
+//
+//
+// FORMAL METHODS
+//
+//
+//
+`ifdef	FORMAL
+
+`ifdef	TXUARTLITE
+`define	ASSUME	assume
+`else
+`define	ASSUME	assert
+`endif
+
+	// Setup
+	// {{{
+	reg	f_past_valid, f_last_clk;
+
+	initial	f_past_valid = 1'b0;
+	always @(posedge i_clk)
+		f_past_valid <= 1'b1;
+
+	initial	`ASSUME(!i_wr);
+	always @(posedge i_clk)
+		if ((f_past_valid)&&($past(i_wr))&&($past(o_busy)))
+		begin
+			`ASSUME(i_wr   == $past(i_wr));
+			`ASSUME(i_data == $past(i_data));
+		end
+	// }}}
+
+	// Check the baud counter
+	// {{{
+	always @(posedge i_clk)
+		assert(zero_baud_counter == (baud_counter == 0));
+
+	always @(posedge i_clk)
+		if ((f_past_valid)&&($past(baud_counter != 0))&&($past(state != `TXUL_IDLE)))
+			assert(baud_counter == $past(baud_counter - 1'b1));
+
+	always @(posedge i_clk)
+		if ((f_past_valid)&&(!$past(zero_baud_counter))&&($past(state != `TXUL_IDLE)))
+			assert($stable(o_uart_tx));
+
+	reg	[(TB-1):0]	f_baud_count;
+	initial	f_baud_count = 1'b0;
+	always @(posedge i_clk)
+		if (zero_baud_counter)
+			f_baud_count <= 0;
+		else
+			f_baud_count <= f_baud_count + 1'b1;
+
+	always @(posedge i_clk)
+		assert(f_baud_count < CLOCKS_PER_BAUD);
+
+	always @(posedge i_clk)
+		if (baud_counter != 0)
+			assert(o_busy);
+	// }}}
+
+	reg	[9:0]	f_txbits;
+	// {{{
+	initial	f_txbits = 0;
+	always @(posedge i_clk)
+		if (zero_baud_counter)
+			f_txbits <= { o_uart_tx, f_txbits[9:1] };
+
+	always @(posedge i_clk)
+	if ((f_past_valid)&&(!$past(zero_baud_counter))
+			&&(!$past(state==`TXUL_IDLE)))
+		assert(state == $past(state));
+
+	reg	[3:0]	f_bitcount;
+	initial	f_bitcount = 0;
+	always @(posedge i_clk)
+		if ((!f_past_valid)||(!$past(f_past_valid)))
+			f_bitcount <= 0;
+		else if ((state == `TXUL_IDLE)&&(zero_baud_counter))
+			f_bitcount <= 0;
+		else if (zero_baud_counter)
+			f_bitcount <= f_bitcount + 1'b1;
+
+	always @(posedge i_clk)
+		assert(f_bitcount <= 4'ha);
+
+	reg	[7:0]	f_request_tx_data;
+	always @(posedge i_clk)
+		if ((i_wr)&&(!o_busy))
+			f_request_tx_data <= i_data;
+
+	wire	[3:0]	subcount;
+	assign	subcount = 10-f_bitcount;
+	always @(posedge i_clk)
+		if (f_bitcount > 0)
+			assert(!f_txbits[subcount]);
+
+	always @(posedge i_clk)
+		if (f_bitcount == 4'ha)
+		begin
+			assert(f_txbits[8:1] == f_request_tx_data);
+			assert( f_txbits[9]);
+		end
+
+	always @(posedge i_clk)
+		assert((state <= `TXUL_STOP + 1'b1)||(state == `TXUL_IDLE));
+
+	always @(posedge i_clk)
+	if ((f_past_valid)&&($past(f_past_valid))&&($past(o_busy)))
+		cover(!o_busy);
+	// }}}
+
+`endif	// FORMAL
+`ifdef	VERIFIC_SVA
+	reg	[7:0]	fsv_data;
+
+	//
+	// Grab a copy of the data any time we are sent a new byte to transmit
+	// We'll use this in a moment to compare the item transmitted against
+	// what is supposed to be transmitted
+	//
+	always @(posedge i_clk)
+		if ((i_wr)&&(!o_busy))
+			fsv_data <= i_data;
+
+	//
+	// One baud interval
+	// {{{
+	//
+	// 1. The UART output is constant at DAT
+	// 2. The internal state remains constant at ST
+	// 3. CKS = the number of clocks per bit.
+	//
+	// Everything stays constant during the CKS clocks with the exception
+	// of (zero_baud_counter), which is *only* raised on the last clock
+	// interval
+	sequence	BAUD_INTERVAL(CKS, DAT, SR, ST);
+		((o_uart_tx == DAT)&&(state == ST)
+			&&(lcl_data == SR)
+			&&(!zero_baud_counter))[*(CKS-1)]
+		##1 (o_uart_tx == DAT)&&(state == ST)
+			&&(lcl_data == SR)
+			&&(zero_baud_counter);
+	endsequence
+	// }}}
+
+	//
+	// One byte transmitted
+	// {{{
+	//
+	// DATA = the byte that is sent
+	// CKS  = the number of clocks per bit
+	//
+	sequence	SEND(CKS, DATA);
+		BAUD_INTERVAL(CKS, 1'b0, DATA, 4'h0)
+		##1 BAUD_INTERVAL(CKS, DATA[0], {{(1){1'b1}},DATA[7:1]}, 4'h1)
+		##1 BAUD_INTERVAL(CKS, DATA[1], {{(2){1'b1}},DATA[7:2]}, 4'h2)
+		##1 BAUD_INTERVAL(CKS, DATA[2], {{(3){1'b1}},DATA[7:3]}, 4'h3)
+		##1 BAUD_INTERVAL(CKS, DATA[3], {{(4){1'b1}},DATA[7:4]}, 4'h4)
+		##1 BAUD_INTERVAL(CKS, DATA[4], {{(5){1'b1}},DATA[7:5]}, 4'h5)
+		##1 BAUD_INTERVAL(CKS, DATA[5], {{(6){1'b1}},DATA[7:6]}, 4'h6)
+		##1 BAUD_INTERVAL(CKS, DATA[6], {{(7){1'b1}},DATA[7:7]}, 4'h7)
+		##1 BAUD_INTERVAL(CKS, DATA[7], 8'hff, 4'h8)
+		##1 BAUD_INTERVAL(CKS, 1'b1, 8'hff, 4'h9);
+	endsequence
+	// }}}
+
+	//
+	// Transmit one byte
+	// {{{
+	// Once the byte is transmitted, make certain we return to
+	// idle
+	//
+	assert property (
+		@(posedge i_clk)
+		(i_wr)&&(!o_busy)
+		|=> ((o_busy) throughout SEND(CLOCKS_PER_BAUD,fsv_data))
+		##1 (!o_busy)&&(o_uart_tx)&&(zero_baud_counter));
+	// }}}
+
+	// {{{
+	assume property (
+		@(posedge i_clk)
+		(i_wr)&&(o_busy) |=>
+			(i_wr)&&(o_busy)&&($stable(i_data)));
+
+	//
+	// Make certain that o_busy is true any time zero_baud_counter is
+	// non-zero
+	//
+	always @(*)
+		assert((o_busy)||(zero_baud_counter) );
+
+	// If and only if zero_baud_counter is true, baud_counter must be zero
+	// Insist on that relationship here.
+	always @(*)
+		assert(zero_baud_counter == (baud_counter == 0));
+
+	// To make certain baud_counter stays below CLOCKS_PER_BAUD
+	always @(*)
+		assert(baud_counter < CLOCKS_PER_BAUD);
+
+	//
+	// Insist that we are only ever in a valid state
+	always @(*)
+		assert((state <= `TXUL_STOP+1'b1)||(state == `TXUL_IDLE));
+	// }}}
+
+`endif // Verific SVA
+endmodule

Index: ezsteps.scm
==================================================================
--- ezsteps.scm
+++ ezsteps.scm
@@ -17,11 +17,12 @@
 ;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
 ;;
 
 ;;  strftime('%m/%d/%Y %H:%M:%S','now','localtime')
 
-(use srfi-1 posix regex srfi-69 directory-utils)
+(use srfi-1 posix regex srfi-69 directory-utils call-with-environment-variables posix-extras
+     z3 csv typed-records pathname-expand matchable)
 
 (declare (unit ezsteps))
 (declare (uses db))
 (declare (uses common))
 (declare (uses items))
@@ -33,13 +34,270 @@
 (include "key_records.scm")
 (include "db_records.scm")
 (include "run_records.scm")
 
 
-;;(rmt:get-test-info-by-id run-id test-id) -> testdat
+(define (ezsteps:step-name->mode stepname)
+  (match (string-search "\\.([^\\.]+)$" stepname)
+    ((_ ext) (string->symbol ext))
+    (else    #f)))
+
+(define (ezsteps:create-step-script envdbf stepname prevstepname mode cmd shellexe)
+  (let* (#;(shebang (case mode
+		    ((sh)  "/bin/sh")
+		    ((csh) "/bin/csh")
+		    (else  "/bin/bash")))
+	 (sourcef (conc ".ezsteps/vars_" prevstepname "." mode))
+	 (scriptn (conc "ez_" stepname))) ;; remember the name already has an extension .sh, .csh etc.
+    (with-output-to-file scriptn
+      (lambda ()
+	;; the shebang line
+	(print "#!" shellexe)
+	;; save the env at start
+	(print "megatest -envcap "stepname"_start "envdbf)
+	;; source vars from previous steps
+	(if (file-exists? sourcef)
+	    (print "source " sourcef))
+	;; run the command
+	(print cmd)
+	(if (eq? mode 'csh)
+	    (print "set ecode=$?")
+	    (print "ecode=$?"))
+	;; save the env at end
+	(print "megatest -envcap "stepname"_end "envdbf)
+	;; write the delta
+	(print "megatest -envdelta "stepname"_start-"stepname"_end -dumpmode bash -o .ezsteps/vars_"stepname".sh "envdbf)
+	(print "megatest -envdelta "stepname"_start-"stepname"_end -dumpmode csh -o .ezsteps/vars_"stepname".csh "envdbf)
+	(print "exit $ecode")))
+    (system (conc "chmod a+x " scriptn))))
+
+(define (ezsteps:get-ezpropvars res) ;; testconfig)
+  ;; (let* ((res (configf:lookup testconfig "setup" "ezpropvars")))
+    (if (string? res)
+	(let* ((dat (string-split res)))
+	  (match dat
+	    ((s shellexe)
+	     (let ((shl (string->symbol s)))
+	       `(,shl . ,shellexe)))
+	    ((s)
+	     (let* ((shl      (string->symbol s))
+		    (shellexe (if (eq? shl 'csh) "/bin/csh" "/bin/bash")))
+	       `(,shl . ,shellexe)))
+	    (else #f)))
+	#f))
+
+;; NOTE: returns logpro-used?
+;;
+(define (launch:runstep ezstep run-id test-id exit-info m tal testconfig all-steps-dat prevstepname envdbf)
+  (let* ((stepname       (car ezstep))  ;; do stuff to run the step
+	 (stepmode-n     (ezsteps:step-name->mode stepname))
+	 (stepinfo       (cadr ezstep))
+	 (shellmode      (ezsteps:get-ezpropvars  (configf:lookup testconfig "setup" "ezpropvars"))) ;; returns '(csh|sh . "/path/to/shell")
+	 (stepmode       (if stepmode-n ;; the .sh or .csh always wins
+			     stepmode-n
+			     (if shellmode
+				 (car shellmode)
+				 #f)))
+	 (shellexe       (if stepmode-n
+			     (case stepmode
+			       ((csh) "/bin/csh")
+			       (else  "/bin/bash"))
+			     (if shellmode
+				 (cdr shellmode)
+				 "/bin/bash")))
+	 ;; (let ((info (cadr ezstep)))
+	 ;; 		   (if (proc? info) "" info)))
+	 ;; (stepproc       (let ((info (cadr ezstep)))
+	 ;; 		   (if (proc? info) info #f)))
+	 (stepparts      (string-match (regexp "^(\\{([^\\}\\{]*)\\}\\s*|)(.*)$") stepinfo))
+	 (stepparams     (if (and (list? stepparts)
+				  (> (length stepparts) 1))
+			     (list-ref stepparts 2)
+			     #f)) ;; for future use, {VAR=1,2,3}, run step for each
+	 (paramparts     (if (string? stepparams)
+			     (map (lambda (x)(string-split x "=")) (string-split-fields "[^;]*=[^;]*" stepparams))
+			     '()))
+	 (subrun         (alist-ref "subrun" paramparts equal?))
+	 (stepcmd        (if (and (list? stepparts)
+				  (> (length stepparts) 2))
+			     (list-ref stepparts 3)
+			     (conc "# error, no command for step "stepname)))
+	 (script         "") ; "#!/bin/bash\n") ;; yep, we depend on bin/bash FIXME!!!\
+	 (logpro-file    (conc stepname ".logpro"))
+	 (html-file      (conc stepname ".html"))
+	 (dat-file       (conc stepname ".dat"))
+	 (tconfig-logpro (configf:lookup testconfig "logpro" stepname))
+	 (logpro-used    (common:file-exists? logpro-file)))
+    (setenv "MT_STEP_NAME" stepname)
+    (hash-table-set! all-steps-dat stepname `((params . ,paramparts)))
+    (debug:print 0 *default-log-port* "stepparts: " stepparts ", stepparams: " stepparams
+                 ", paramparts: " paramparts ", subrun: " subrun ", stepcmd: " stepcmd)
+    
+    (if (and tconfig-logpro
+	     (not logpro-used)) ;; no logpro file found but have a defn in the testconfig
+	(begin
+	  (with-output-to-file logpro-file
+	    (lambda ()
+	      (print ";; logpro file extracted from testconfig\n"
+		     ";;")
+	      (print tconfig-logpro)))
+	  (set! logpro-used #t)))
+    
+    ;; NB// can safely assume we are in test-area directory
+    (debug:print 4 *default-log-port* "ezsteps:\n stepname: " stepname " stepinfo: " stepinfo
+		 " stepparts: " stepparts
+		 " stepparams: " stepparams " stepcmd: " stepcmd)
+
+    (if stepmode (ezsteps:create-step-script envdbf stepname prevstepname stepmode stepcmd shellexe))
+
+    ;; ;; first source the previous environment
+    ;; (let ((prev-env (conc ".ezsteps/" prevstep (if (string-search (regexp "csh") 
+    ;;      							 (get-environment-variable "SHELL")) ".csh" ".sh"))))
+    ;;   (if (and prevstep (common:file-exists? prev-env))
+    ;;       (set! script (conc script "source " prev-env))))
+    
+    ;; call the command using mt_ezstep
+    ;; (set! script (conc "mt_ezstep " stepname " " (if prevstep prevstep "x") " " stepcmd))
+    
+    (debug:print 4 *default-log-port* "script: " script)
+    (rmt:teststep-set-status! run-id test-id stepname "start" "-" #f #f)
+    ;; now launch the actual process
+    (call-with-environment-variables 
+     (list (cons "PATH" (conc (get-environment-variable "PATH") ":.")))
+     (lambda () ;; (process-run "/bin/bash" "-c" "exec ls -l /tmp/foobar > /tmp/delme-more.log 2>&1")
+       (let* ((cmd (conc (if stepmode
+			     (conc "ez_" stepname)
+			     stepcmd)
+			 " > " stepname ".log 2>&1")) ;; >outfile 2>&1 
+	      (pid #f))
+	 (let ((proc (lambda ()
+		       (set! pid (process-run "/bin/bash" (list "-c" cmd))))))
+	   (if subrun
+               (begin
+                 (debug:print-info 0 *default-log-port* "Running without MT_.* environment variables.")
+                 (common:propogate-mt-vars-to-subrun proc '("MT_TARGET" "MT_LINKTREE" "MT_RUNNAME")))
+	       (proc)))
+	 
+         (with-output-to-file "Makefile.ezsteps"
+           (lambda ()
+             (print stepname ".log :")
+             (print "\t" cmd)
+             (if (common:file-exists? (conc stepname ".logpro"))
+                 (print "\tlogpro " stepname ".logpro " stepname ".html < " stepname ".log"))
+             (print)
+             (print stepname " : " stepname ".log")
+             (print))
+           #:append)
 
-
+	 (rmt:test-set-top-process-pid run-id test-id pid)
+	 (let processloop ((i 0))
+	   (let-values (((pid-val exit-status exit-code)(process-wait pid #t)))
+		       (mutex-lock! m)
+		       (launch:einf-pid-set!         exit-info pid)         ;; (vector-set! exit-info 0 pid)
+		       (launch:einf-exit-status-set! exit-info exit-status) ;; (vector-set! exit-info 1 exit-status)
+		       (launch:einf-exit-code-set!   exit-info exit-code)   ;; (vector-set! exit-info 2 exit-code)
+		       (mutex-unlock! m)
+		       (if (eq? pid-val 0)
+			   (begin
+			     (thread-sleep! 2)
+			     (processloop (+ i 1))))
+		       )))))
+    (debug:print-info 0 *default-log-port* "step " stepname " completed with exit code " (launch:einf-exit-code exit-info)) ;; (vector-ref exit-info 2))
+    ;; now run logpro if needed
+    (if logpro-used
+	(let* ((logpro-exe (or (getenv "LOGPRO_EXE") "logpro"))
+               (pid        (process-run (conc "/bin/sh -c '"logpro-exe" "logpro-file " " (conc stepname ".html") " < " stepname ".log > /dev/null'"))))
+	  (let processloop ((i 0))
+	    (let-values (((pid-val exit-status exit-code)(process-wait pid #t)))
+			(mutex-lock! m)
+			;; (make-launch:einf pid: pid exit-status: exit-status exit-code: exit-code)
+			(launch:einf-pid-set!         exit-info pid)         ;; (vector-set! exit-info 0 pid)
+			(launch:einf-exit-status-set! exit-info exit-status) ;; (vector-set! exit-info 1 exit-status)
+			(launch:einf-exit-code-set!   exit-info exit-code)   ;; (vector-set! exit-info 2 exit-code)
+			(mutex-unlock! m)
+			(if (eq? pid-val 0)
+			    (begin
+			      (thread-sleep! 2)
+			      (processloop (+ i 1)))))
+	    (debug:print-info 0 *default-log-port* "logpro for step " stepname " exited with code " (launch:einf-exit-code exit-info))))) ;; (vector-ref exit-info 2)))))
+    
+    (let ((exinfo (launch:einf-exit-code exit-info)) ;; (vector-ref exit-info 2))
+	  (logfna (if logpro-used (conc stepname ".html") ""))
+	  (comment #f))
+      (if logpro-used
+	  (let ((datfile (conc stepname ".dat")))
+	    ;; load the .dat file into the test_data table if it exists
+	    (if (common:file-exists? datfile)
+		(set! comment (launch:load-logpro-dat run-id test-id stepname)))
+	    (rmt:test-set-log! run-id test-id (conc stepname ".html"))))
+      (rmt:teststep-set-status! run-id test-id stepname "end" exinfo comment logfna))
+    ;; set the test final status
+    (let* ((process-exit-status (launch:einf-exit-code exit-info)) ;; (vector-ref exit-info 2))
+	   (this-step-status (cond
+			      ((and (eq? process-exit-status 2) logpro-used) 'warn)   ;; logpro 2 = warnings
+			      ((and (eq? process-exit-status 3) logpro-used) 'check)  ;; logpro 3 = check
+			      ((and (eq? process-exit-status 4) logpro-used) 'waived) ;; logpro 4 = waived
+			      ((and (eq? process-exit-status 5) logpro-used) 'abort)  ;; logpro 5 = abort
+			      ((and (eq? process-exit-status 6) logpro-used) 'skip)   ;; logpro 6 = skip
+			      ((eq? process-exit-status 0)                   'pass)   ;; logpro 0 = pass
+			      (else 'fail)))
+	   (overall-status   (cond
+			      ((eq? (launch:einf-rollup-status exit-info) 2) 'warn) ;; rollup-status (vector-ref exit-info 3)
+			      ((eq? (launch:einf-rollup-status exit-info) 0) 'pass) ;; (vector-ref exit-info 3)
+			      (else 'fail)))
+	   (next-status      (cond 
+			      ((eq? overall-status 'pass) this-step-status)
+			      ((eq? overall-status 'warn)
+			       (if (eq? this-step-status 'fail) 'fail 'warn))
+			      ((eq? overall-status 'abort) 'abort)
+			      (else 'fail)))
+	   (next-state       ;; "RUNNING") ;; WHY WAS THIS CHANGED TO NOT USE (null? tal) ??
+	    (cond
+	     ((null? tal) ;; more to run?
+	      "COMPLETED")
+	     (else "RUNNING"))))
+      (debug:print 4 *default-log-port* "Exit value received: " (launch:einf-exit-code exit-info) " logpro-used: " logpro-used 
+		   " this-step-status: " this-step-status " overall-status: " overall-status 
+		   " next-status: " next-status " rollup-status: "  (launch:einf-rollup-status exit-info)) ;; (vector-ref exit-info 3))
+      (case next-status
+	((warn)
+	 (launch:einf-rollup-status-set! exit-info 2) ;; (vector-set! exit-info 3 2) ;; rollup-status
+	 ;; NB// test-set-status! does rdb calls under the hood
+	 (tests:test-set-status! run-id test-id next-state "WARN" 
+				 (if (eq? this-step-status 'warn) "Logpro warning found" #f)
+				 #f))
+	((check)
+	 (launch:einf-rollup-status-set! exit-info 3) ;; (vector-set! exit-info 3 3) ;; rollup-status
+	 ;; NB// test-set-status! does rdb calls under the hood
+	 (tests:test-set-status! run-id test-id next-state "CHECK" 
+				 (if (eq? this-step-status 'check) "Logpro check found" #f)
+				 #f))
+	((waived)
+	 (launch:einf-rollup-status-set! exit-info 4) ;; (vector-set! exit-info 3 3) ;; rollup-status
+	 ;; NB// test-set-status! does rdb calls under the hood
+	 (tests:test-set-status! run-id test-id next-state "WAIVED" 
+				 (if (eq? this-step-status 'check) "Logpro waived found" #f)
+				 #f))
+	((abort)
+	 (launch:einf-rollup-status-set! exit-info 5) ;; (vector-set! exit-info 3 4) ;; rollup-status
+	 ;; NB// test-set-status! does rdb calls under the hood
+	 (tests:test-set-status! run-id test-id next-state "ABORT" 
+				 (if (eq? this-step-status 'abort) "Logpro abort found" #f)
+				 #f))
+	((skip)
+	 (launch:einf-rollup-status-set! exit-info 6) ;; (vector-set! exit-info 3 4) ;; rollup-status
+	 ;; NB// test-set-status! does rdb calls under the hood
+	 (tests:test-set-status! run-id test-id next-state "SKIP" 
+				 (if (eq? this-step-status 'skip) "Logpro skip found" #f)
+				 #f))
+	((pass)
+	 (tests:test-set-status! run-id test-id next-state "PASS" #f #f))
+	(else ;; 'fail
+	 (launch:einf-rollup-status-set! exit-info 1) ;; (vector-set! exit-info 3 1) ;; force fail, this used to be next-state but that doesn't make sense. should always be "COMPLETED" 
+	 (tests:test-set-status! run-id test-id "COMPLETED" "FAIL" (conc "Failed at step " stepname) #f)
+	 )))
+    logpro-used))
 
 (define (ezsteps:run-from testdat start-step-name run-one)
   ;;# TODO - recapture item variables, debug repeated step eval; regen logpro from test
   (let* ((do-update-test-state-status #f)
          (test-run-dir  ;; (filedb:get-path *fdb* 
@@ -54,11 +312,12 @@
 	 (test-id       (db:test-get-id        testdat))
 	 (run-id        (db:test-get-run_id    testdat))
 	 (test-name     (db:test-get-testname  testdat))
          (orig-test-state (db:test-get-state   testdat))
          (orig-test-status (db:test-get-status testdat))
-	 (kill-job      #f)) ;; for future use (on re-factoring with launch.scm code
+	 (kill-job      #f) ;; for future use (on re-factoring with launch.scm code
+	 (the-step-params '())) ;; not exactly "functional"
 
     ;; keep trying till NFS deigns to populate test run dir on this host
     (let loop ((count 5))
       (if (not (common:file-exists? test-run-dir))
 	  ;;(push-directory test-run-dir)
@@ -78,12 +337,14 @@
 	  (let loop ((ezstep   (car ezstepslst))
 		     (tal      (cdr ezstepslst))
                      (status-sym-so-far 'pass)
 		     ;;(runflag  #f)
                      (saw-start-step-name #f)) ;; flag used to skip steps when not starting at the beginning
-	    (if (vector-ref exit-info 1)
-		(let* ((stepname    (car ezstep))  ;; do stuff to run the step
+	    (if (or (vector-ref exit-info 1)
+		    (equal? (alist-ref 'keep-going prev-step-params) 'yes))
+		(let* ((prev-step-params the-step-params) ;; need to snag this now
+		       (stepname    (car ezstep))  ;; do stuff to run the step
                        (logpro-used (common:file-exists? (conc test-run-dir "/" stepname ".logpro")))
 		       (stepinfo    (cadr ezstep))
 		       (stepparts   (string-match (regexp "^(\\{([^\\}]*)\\}\\s*|)(.*)$") stepinfo))
 		       (stepparms   (list-ref stepparts 2)) ;; for future use, {VAR=1,2,3}, run step for each 
 		       (stepcmd     (list-ref stepparts 3))
@@ -94,10 +355,12 @@
                             (equal? stepname start-step-name)
                             (and saw-start-step-name (not run-one))
                             saw-start-step-name-next
                             (and start-step-name (equal? stepname start-step-name))))
                        )
+		  (debug:print 0 *default-log-port* "NOTE: stepparms=" stepparms)
+		  (set! prev-step-params stepparms)
                   (set! do-update-test-state-status (and proceed-with-this-step (null? tal)))
                   ;;(BB> "stepname="stepname" proceed-with-this-step="proceed-with-this-step " do-update-test-state-status="do-update-test-state-status " orig-test-state="orig-test-state" orig-test-status="orig-test-status)
                   (cond
                    ((and (not proceed-with-this-step) (null? tal))
                     'done)

ADDED   fossil-utils/Makefile
Index: fossil-utils/Makefile
==================================================================
--- /dev/null
+++ fossil-utils/Makefile
@@ -0,0 +1,14 @@
+
+
+all : run.sh
+
+go : run.sh
+	bash run.sh
+
+fossilrebase : fossilrebase.scm
+	csc fossilrebase.scm
+
+run.sh : fossilrebase justtesting/*.dat
+	./fossilrebase dumpcmds justtesting > run.sh
+
+

ADDED   fossil-utils/fossilrebase.scm
Index: fossil-utils/fossilrebase.scm
==================================================================
--- /dev/null
+++ fossil-utils/fossilrebase.scm
@@ -0,0 +1,262 @@
+(use yaml matchable srfi-1 sqlite3 regex)
+
+(define (get-timeline)
+  (let* ((inp (open-input-pipe "fossil json timeline checkin -n 0"))
+	 (res (yaml-load inp)))
+    (close-input-pipe inp)
+    res))
+
+(define (get-val data key)
+  (alist-ref key data equal?))
+
+(define (any->string val)
+  (if (string? val)
+      val
+      (conc val)))
+
+(define (branch-match branches tags)
+  (if (list? tags)
+      (any (lambda (x)
+	     (member x branches))
+	   tags)
+      (member tags branches)))
+
+(define (refdb-set-value dbname sheetname row col value)
+  (let ((pid (process-run "refdb" `("set" ,dbname ,sheetname ,row ,col ,value))))
+    (let-values (((a b c)(process-wait pid)))
+      b)))
+
+(define (seconds->std-time-str sec)
+  (time->string 
+   (seconds->local-time sec)
+   "%Y-%m-%d %H:%M:%S"))
+
+(define (gen-refdb dbname branches)
+  (if (not (file-exists? (conc dbname "/sheet-names.cfg")))
+      (begin
+	(print "ERROR: You must precreate the refdb with \"refdb edit <dbname>\"")
+	(exit 1)))
+  (print "Getting data from timeline...")
+  (let* ((data (get-timeline))
+	 (branches (string-split branches ",")))
+    (print "Got data from timeline...")
+    (let* ((timeline (get-val (get-val data "payload") "timeline")))
+      (print "Got " (length timeline) " timeline records. Filling refdb...")
+    (for-each
+     (lambda (rec)
+       (let ((uuid (get-val rec "uuid")))
+	 (if (branch-match branches (get-val rec "tags"))
+	     (let ((tagnum 0)
+		   (tags   (get-val rec "tags")))
+	       (print "uuid: " uuid " tags: " (get-val rec "tags"))
+	       ;; First the tags so they are visible to left
+	       (for-each
+		(lambda (tagv)
+		  (refdb-set-value dbname "timeline" uuid (conc "tag" tagnum) tagv)
+		  (set! tagnum (+ tagnum 1)))
+		(if (list? tags)
+		    tags
+		    (list tags)))
+	       (for-each
+		(lambda (key)
+		  (refdb-set-value dbname "timeline" uuid key (any->string (get-val rec key))))
+		'("user" "comment"))
+	       (refdb-set-value dbname "extra" uuid "parents" (string-intersperse (get-val rec "parents") ","))
+	       (refdb-set-value dbname "timeline" uuid "timestamp" (seconds->std-time-str (get-val rec "timestamp")))
+	       (refdb-set-value dbname "timeline" uuid "timestamp_sec" (any->string (get-val rec "timestamp")))
+	       ))))
+     timeline))))
+
+(define (escape-string-for-bash str)
+  (string-substitute "'" "''" str #t))
+
+;; tag0 tag1 tag2 cherrypick backout hide usedate recomment user
+;; comment timestamp timestamp_sec
+;;
+(define (get-node-details db node-id)
+  (let* ((result #f)
+	 (count  0))
+    (for-each-row
+     (lambda (rowkey tag0 cmdnum cherrypick do-commit backout hide usedate recomment user comment timestamp timestamp_sec)
+       (set! result `((uuid . ,rowkey)
+		      (tag0 . ,tag0)
+		      (cmdnum . ,cmdnum)
+		      (cherrypick . ,cherrypick)
+		      (do-commit  . ,do-commit)
+		      (backout    . ,backout)
+		      (hide . ,hide)
+		      (usedate . ,usedate)
+		      (recomment . ,recomment)
+		      (user . ,user)
+		      (comment . ,comment)
+		      (timestamp . ,timestamp)
+		      (timestamp_sec . ,timestamp_sec)))
+       (set! count (+ count 1)))
+     db
+     "SELECT rowkey,tag0,cmdnum,cherrypick,do_commit,backout,hide,usedate,recomment,user,comment,timestamp,timestamp_sec FROM timeline WHERE rowkey LIKE ?;"
+     node-id)
+    (if (> count 1)
+	(print "WARNING: more than one node matches " node-id ", found " count " nodes"))
+    result))
+
+;; get branches to create
+;;
+(define (get-new-branches db)
+  (let* ((res '()))
+    (for-each-row
+     (lambda (rowkey node mode)
+       (set! res (cons `((branch . ,rowkey)
+			 (node   . ,node)
+			 (mode   . ,mode))
+		       res)))
+     db
+     "SELECT rowkey,node,mode FROM branches;")
+    res))
+
+;; get cherrypicks
+;;
+(define (get-cherry-picks db)
+  (let* ((res '()))
+    (for-each-row
+     (lambda (rowkey tag0 cherrypick firstmerge do-commit usedate comment recomment)
+       (set! res (cons `((uuid       . ,rowkey)
+			 (tag0       . ,tag0)
+			 (cherrypick . ,cherrypick)
+			 (firstmerge . ,firstmerge)
+			 (do-commit  . ,do-commit)
+			 (usedate    . ,usedate)
+			 (comment    . ,comment)
+			 (recomment  . ,recomment))
+		       res)))
+     db ;; sort desc and the cons puts it back in correct order
+     "SELECT rowkey,tag0,cherrypick,firstmerge,do_commit,usedate,comment,recomment FROM timeline WHERE cherrypick != '' AND cherrypick NOT NULL ORDER BY timestamp_sec DESC;")
+    res))
+
+;; always private and same time as parent node + 1 second
+;;
+;; fossil branch new BRANCH-NAME BASIS ?OPTIONS?
+;; 
+;;        Create a new branch BRANCH-NAME off of check-in BASIS.
+;;        Supported options for this subcommand include:
+;;        --private             branch is private (i.e., remains local)
+;;        --bgcolor COLOR       use COLOR instead of automatic background
+;;        --nosign              do not sign contents on this branch
+;;        --date-override DATE  DATE to use instead of 'now'
+;;        --user-override USER  USER to use instead of the current default
+;; 
+;;        DATE may be "now" or "YYYY-MM-DDTHH:MM:SS.SSS". If in
+;;        year-month-day form, it may be truncated, the "T" may be
+;;        replaced by a space, and it may also name a timezone offset
+;;        from UTC as "-HH:MM" (westward) or "+HH:MM" (eastward).
+;;        Either no timezone suffix or "Z" means UTC.
+;; 
+(define (create-branch db branch-name parent-node)
+  (let* ((parent-info (get-node-details db (conc parent-node "%"))))
+    (if (not parent-info)
+	(print "ERROR: no info found for node " parent-node)
+	(let* ((parent-date (alist-ref 'timestamp parent-info))
+	       (parent-user (alist-ref 'user      parent-info)))
+	  (print "fossil branch new " branch-name " " parent-node " --private --date-override '" parent-date "'")
+	  ;; (print "Creating private branch " branch-name " from node " parent-node)
+	  ;; (pp parent-info)
+	  ;; (print "")
+	  ))))
+
+(define (do-cherrypick db cherrypick dbfname)
+  (let* ((tag0       (alist-ref 'tag0 cherrypick))
+	 (uuid       (alist-ref 'uuid cherrypick))
+	 (nodeinf    (get-node-details db uuid))
+	 (nodedate   (alist-ref 'timestamp nodeinf))
+	 (user       (alist-ref 'user      nodeinf))
+	 (targ       (alist-ref 'cherrypick cherrypick))     ;; do fossil up to this node
+	 (firstmerge (alist-ref 'firstmerge cherrypick))
+	 (do-commit  (alist-ref 'do-commit     cherrypick)) ;; if yes do a commit
+	 (usedate    (alist-ref 'usedate    cherrypick)) ;; if no use current time
+	 (comment    (alist-ref 'comment    cherrypick))
+	 (recomment  (alist-ref 'recomment cherrypick)))
+    (print "#======= Start of cherrypick for " uuid "=======")
+    (print "fossil checkout " targ)
+    ;; first - do we have a firstmerge?
+    (if (and (string? firstmerge)
+	     (> (string-length firstmerge) 0))
+	(print "fossil merge " firstmerge))
+    
+    (print "fossil merge --cherrypick " uuid)
+    (if #t ;;(member do-commit '("x" "yes"))
+	(print "fossil commit -m '" (escape-string-for-bash comment) "' "
+	       (if (equal? usedate "no")
+		   ""
+		   (conc " --date-override '" nodedate "'"))
+	       " --user-override " user
+	       ))
+    (print "if [[ $(fossil status | grep CONFLICT | wc -l) -gt 0 ]];then")
+    (print "  echo \"\nHAVE CONFLICT - STOPPING\n\"")
+    (print "  echo \"cherry pick of " uuid " into " targ " resulted in conflicts\"")
+    (print "  exit 1")
+    (print "else")
+    (print "  echo GOOD, marking node " uuid " as DONE")
+    (print "  refdb set " dbfname " timeline " uuid " status DONE")
+    (print "fi")
+    (print "#======= end of cherrypick for " uuid "=======")
+    (print "")
+    ))
+		   
+;; 
+(define (gen-rebase-commands dbname)
+  (let* ((sqldbname (conc "/tmp/" (current-user-name) "-" dbname ".db"))
+	 (dbfname   (conc (current-directory) "/" dbname))) ;; want the fully qualified path so we can call the generated script from anywhere
+    (print "# Create sqlite db " sqldbname "...")
+    (system (conc "refdb dump2sqlite3 " dbname " " sqldbname))
+    (let* ((db (open-database sqldbname))
+	   (branches (get-new-branches db))
+	   (cherrypicks (get-cherry-picks db)))
+      ;; create the setup
+      (dump-setup db)
+      
+      ;; create the branches
+      (for-each
+       (lambda (branchdat)
+	 (create-branch db
+			(alist-ref 'branch branchdat)
+			(alist-ref 'node   branchdat)))
+       branches)
+
+      ;; create the cherrypicks
+      (for-each
+       (lambda (cherrypick)
+	 (do-cherrypick db cherrypick dbfname))
+       cherrypicks)
+      )))
+
+(define (dump-setup db)
+  (for-each-row
+   (lambda (cmd)
+     (print cmd))
+   db
+   "SELECT command FROM 'setup' ORDER BY rowkey ASC;"))
+
+(define help
+"fossilrebase - register commits in a refdb, edit them by hand then execute them
+
+WARNING: It is highly recommended you do this on a disconnected copy of your fossil database!!
+
+Usage: fossilrebase cmd [params ...]
+  where cmd is one of:
+    genrefdb fname b1,b2... : generate a refdb of all the commits for branches matching patterns listed, edit with \"refdb edit fname\"
+    dumpcmds fname          : from refdb fname dump fossil commands to implement the rebase you want to do.
+")
+
+(define (main)
+  (if (< (length (command-line-arguments)) 1)
+      (begin
+	(print help)
+	(exit 1))
+      (match (command-line-arguments)
+	(("genrefdb" fname branches) (gen-refdb fname branches))
+	(("dumpcmds" fname)          (gen-rebase-commands fname))
+	(else
+	 (print "Sorry, didn't know what to do with \"" (string-intersperse (command-line-arguments) " ") "\"")
+	 (exit 1)))))
+
+
+(main)

ADDED   fossil-utils/justtesting/branches.dat
Index: fossil-utils/justtesting/branches.dat
==================================================================
--- /dev/null
+++ fossil-utils/justtesting/branches.dat
@@ -0,0 +1,6 @@
+[node]
+v1.65-broken-fixes 367ffc5bdf
+nobranch 367ffc5bdf
+[mode]
+v1.65-broken-fixes private
+nobranch private

ADDED   fossil-utils/justtesting/extra.dat
Index: fossil-utils/justtesting/extra.dat
==================================================================
--- /dev/null
+++ fossil-utils/justtesting/extra.dat
@@ -0,0 +1,723 @@
+[parents]
+e7b6428a2533b1901a3bb12411a4095ce23a4d35 e5c65818cc818ef14c94682202fac7bf40375ec1
+e5c65818cc818ef14c94682202fac7bf40375ec1 9fc475313fb461746f4de5df8343ddf15f6b345d,f6dc7607a8ecb7df68b5e50455a97f17eaefa348
+9fc475313fb461746f4de5df8343ddf15f6b345d e9153fe95b68ac1ab72d38b5cbe22b1f1237f8cc
+e9153fe95b68ac1ab72d38b5cbe22b1f1237f8cc 3bd95bc26bb7491d5ab89f264232159d7c188e1b
+c7baa27145762eab04802b34d95818386df2e3f7 1b0d4f257e6d9740397662ede6dc01bf0f5fcec7
+1b0d4f257e6d9740397662ede6dc01bf0f5fcec7 c13726326ce034fbedb36a634179fc1f685ef076
+c13726326ce034fbedb36a634179fc1f685ef076 ad2000389bacbff6847a9920ec8cc44363ff9682
+ad2000389bacbff6847a9920ec8cc44363ff9682 473d6eaf82c96fb6db9905da82b1ef1419852a93
+473d6eaf82c96fb6db9905da82b1ef1419852a93 367ffc5bdf35456922c1d3ceebbe633b65a65bcf
+f6dc39b0f7277ade8986ad06aa9a5f043c3fba2c 2ded3e4899f49656d06b26c1a35ff730ed9768be
+2ded3e4899f49656d06b26c1a35ff730ed9768be 39ec01ec3bb664aa2293ed35dc6f131e00b1d4db
+39ec01ec3bb664aa2293ed35dc6f131e00b1d4db 7f1e84d10d19cd8fa9a639fd60c5102aa6c3fdf5
+7f1e84d10d19cd8fa9a639fd60c5102aa6c3fdf5 7f0801084261f8dec9f4eaa05707897c239bd577
+7f0801084261f8dec9f4eaa05707897c239bd577 901de8992f8a31ef8ddfe47edfb31c251044de61
+901de8992f8a31ef8ddfe47edfb31c251044de61 6118471b3384fcc3ae99fd9400d2193b05ceb0f7
+6118471b3384fcc3ae99fd9400d2193b05ceb0f7 73dfd99fe60a44fc519d78117e3bfb0791268fa1
+73dfd99fe60a44fc519d78117e3bfb0791268fa1 2f7d94848b24bab8702d82654351d25711cc89b6
+2f7d94848b24bab8702d82654351d25711cc89b6 875a0b48c6fa9e2eb37094a0b53f80fa316f1189
+875a0b48c6fa9e2eb37094a0b53f80fa316f1189 66d6fd1aaf5dee5b79fbf7f47a3e7325851b7d6d
+66d6fd1aaf5dee5b79fbf7f47a3e7325851b7d6d 268055792a6b6210a6d53f3bce9555a6b2de7075,e7b6428a2533b1901a3bb12411a4095ce23a4d35
+f6dc7607a8ecb7df68b5e50455a97f17eaefa348 3bd95bc26bb7491d5ab89f264232159d7c188e1b
+f13cb3f1bc36ede7b967ea347fa9cad59d680c88 bd18bd00ac2955b4864a543b19522525434dfe80
+3bd95bc26bb7491d5ab89f264232159d7c188e1b 522b48d828c3295920e0dbd15480dae21426a74b
+522b48d828c3295920e0dbd15480dae21426a74b 5dc1573e7d958fae8fb3711663a07f7f5a0670f3
+5dc1573e7d958fae8fb3711663a07f7f5a0670f3 c5bd5112a83452b0cbae5dddc852d47c76ab9ff4
+c5bd5112a83452b0cbae5dddc852d47c76ab9ff4 9d1cc54fe17184885380c438aaa3a2f172d3c275
+9d1cc54fe17184885380c438aaa3a2f172d3c275 da2b09089751193627241c81260e7cafa10657bc
+da2b09089751193627241c81260e7cafa10657bc 7fc5b1bdcc47a6f43723efd27f2edcf63bc564b1
+7fc5b1bdcc47a6f43723efd27f2edcf63bc564b1 bb4c7dd6b98dbe9924182e9e5010f8846d702525
+bb4c7dd6b98dbe9924182e9e5010f8846d702525 071ebc34ba460be1bdead4ec1a3c261e6bcd2bc4
+071ebc34ba460be1bdead4ec1a3c261e6bcd2bc4 64aa9347d5e5af8d43fdcfbf64891596022cebe9
+64aa9347d5e5af8d43fdcfbf64891596022cebe9 50237f6e1f5f369b5e1022774427028c4dba7d6b
+50237f6e1f5f369b5e1022774427028c4dba7d6b e28be4def5c32dd0a16a6059db1fac22b2aa3653
+e28be4def5c32dd0a16a6059db1fac22b2aa3653 b487e8f3c5ee74eeeaa6edabd92e2548a33210f7
+b487e8f3c5ee74eeeaa6edabd92e2548a33210f7 63e558983a2101551ea0fa140888a5e6fd4322ae
+63e558983a2101551ea0fa140888a5e6fd4322ae 19f75192e22ab76c4de3eacbf57416d192617b48
+19f75192e22ab76c4de3eacbf57416d192617b48 8fd408420ba2b46d851b409832a4b0eb55f33a19
+8fd408420ba2b46d851b409832a4b0eb55f33a19 2e3a570e3e8896f290135b2dfc012b0f69c3516d
+268055792a6b6210a6d53f3bce9555a6b2de7075 aa29985039a593ff4c56ddc64870c8e205999184
+2e3a570e3e8896f290135b2dfc012b0f69c3516d e5bf9db624e5904b1efb29df7d7ed14f7fc23bc0
+e5bf9db624e5904b1efb29df7d7ed14f7fc23bc0 0a7ddadc4dece2446166d8156ecd1de168115649
+0a7ddadc4dece2446166d8156ecd1de168115649 aa29985039a593ff4c56ddc64870c8e205999184
+bd18bd00ac2955b4864a543b19522525434dfe80 0cb77d7f74edafa41a5d9ac28467c532b679325d
+aa29985039a593ff4c56ddc64870c8e205999184 0a9e690b28f0ef4ee710dab3af7b3c45a0e4a38d
+3d9c1de6339fcecbd59eb7cbec2be5680f0f914d 6625f3bc6a98d3f05f57ab42d329391613bbe008
+6625f3bc6a98d3f05f57ab42d329391613bbe008 3ccc64251fcfc210fe7ba1998fa90a96d3bf2fa3
+3ccc64251fcfc210fe7ba1998fa90a96d3bf2fa3 0a9e690b28f0ef4ee710dab3af7b3c45a0e4a38d
+0a9e690b28f0ef4ee710dab3af7b3c45a0e4a38d 18da8b6a613e8ee42c2b82fd00fedcf38c153433
+18da8b6a613e8ee42c2b82fd00fedcf38c153433 7ff937a8a2df1a3e473a760363b85e98aa01bbc4
+7ff937a8a2df1a3e473a760363b85e98aa01bbc4 5b7f0c6aa302ede19e96946ad2e33a7fa97e4fbb
+5b7f0c6aa302ede19e96946ad2e33a7fa97e4fbb ea8c3e52e9f9c216ed88a2707722d4c61e246522
+ea8c3e52e9f9c216ed88a2707722d4c61e246522 a374d9084bb19e0715a3981a05f81b259a7500fc
+a374d9084bb19e0715a3981a05f81b259a7500fc 07ff7dca1e64439988168406443a703b0ad929fa
+07ff7dca1e64439988168406443a703b0ad929fa 15b59cfa429cb21c7ea1dbe8cdc3d8074d3617b6
+0cb77d7f74edafa41a5d9ac28467c532b679325d d825e32743716501b8fe878f973898a5caa0c450
+15b59cfa429cb21c7ea1dbe8cdc3d8074d3617b6 0364beb9c92e54e3e658cdf1876d7c75b2d68e15,d825e32743716501b8fe878f973898a5caa0c450
+0364beb9c92e54e3e658cdf1876d7c75b2d68e15 0645166f9cdc9cbb2e922e7a3b0094fbf78e9c8c
+0645166f9cdc9cbb2e922e7a3b0094fbf78e9c8c 5de2fd17b5348d5283f874e7ec9bf2c53cad12a0
+d825e32743716501b8fe878f973898a5caa0c450 220b14a861c4883ff947e46ea39af32c046aaa99
+220b14a861c4883ff947e46ea39af32c046aaa99 8724301727841358def98a48e191a0e344ddbf68
+8724301727841358def98a48e191a0e344ddbf68 cdd5e92143e616f56b8b4ba90f6bc2114de0dee1
+5de2fd17b5348d5283f874e7ec9bf2c53cad12a0 2a858c5054f56588fefe6039621ebaefc5344d29
+2a858c5054f56588fefe6039621ebaefc5344d29 0495fb12176784b1907c243c54898c23f2afc140
+0495fb12176784b1907c243c54898c23f2afc140 3b86fd8d4c9f097a04885021f902a69cfc375eeb
+3b86fd8d4c9f097a04885021f902a69cfc375eeb 367ffc5bdf35456922c1d3ceebbe633b65a65bcf,cdd5e92143e616f56b8b4ba90f6bc2114de0dee1
+cdd5e92143e616f56b8b4ba90f6bc2114de0dee1 c7d9089a6f8e857878fcdfda8b46b9034379dcf9
+c7d9089a6f8e857878fcdfda8b46b9034379dcf9 c7977972a11df8cb1ea188cf6cf7a30e71d4292f
+c7977972a11df8cb1ea188cf6cf7a30e71d4292f ccab6e04aff4406711aecbfa9b41ea0a6349fb43
+ccab6e04aff4406711aecbfa9b41ea0a6349fb43 eeb358089d89aee9f2b1804a4c630ef42a231ee2
+eeb358089d89aee9f2b1804a4c630ef42a231ee2 e9a528680b234a33522c1b4f6d1719d95dda5b7e
+e9a528680b234a33522c1b4f6d1719d95dda5b7e caed2ecdc2c88e2ee1572137ec4cc6fe38e632bd
+caed2ecdc2c88e2ee1572137ec4cc6fe38e632bd b82fdf714f1b169991340004c60d758e09ba0fbf
+b82fdf714f1b169991340004c60d758e09ba0fbf 2c22506f667e6c675af6256a6bcc5bf3519f68c3
+2c22506f667e6c675af6256a6bcc5bf3519f68c3 03755c29bfeaf4f4b6d00c21048eb5dd798e5cba
+03755c29bfeaf4f4b6d00c21048eb5dd798e5cba 55a9a872eed80f88b6a2e2dd82da8d2822ae3fe6
+55a9a872eed80f88b6a2e2dd82da8d2822ae3fe6 f02d97f2923801d99f3dd769654032cb12ce7266
+f02d97f2923801d99f3dd769654032cb12ce7266 4c2b15c948deb5ac11fbd034872081dd93b029aa
+4c2b15c948deb5ac11fbd034872081dd93b029aa 6fef3e6460425a7627a787fee924c8077ceae6b6
+6fef3e6460425a7627a787fee924c8077ceae6b6 03921a66f9001e8fbc4252a2c355763aef6b2198
+03921a66f9001e8fbc4252a2c355763aef6b2198 db55d34798110efd902302e670128e5860e4e820
+db55d34798110efd902302e670128e5860e4e820 c9f20f12f36bad0d76d71faaac64f7d1a45a610e,367ffc5bdf35456922c1d3ceebbe633b65a65bcf
+c9f20f12f36bad0d76d71faaac64f7d1a45a610e 3d4fba2e820c1e62f2bc2822311388172aeece58
+3d4fba2e820c1e62f2bc2822311388172aeece58 681523dd88dc59a656b458bad144821ec5ac1411
+681523dd88dc59a656b458bad144821ec5ac1411 23a58a862f09874f9977dc7e56866c9537b25b3b
+23a58a862f09874f9977dc7e56866c9537b25b3b 156279118f7b88026768cec53312a037e6361062
+156279118f7b88026768cec53312a037e6361062 8b3c7571c1376d5d6bf49935e2ecdb37ab18a82f
+367ffc5bdf35456922c1d3ceebbe633b65a65bcf e1e57863eaf85b8ab3f383491a1ead12a9b46b79,e24a447e399223972ac25a520705a99221429b82
+e1e57863eaf85b8ab3f383491a1ead12a9b46b79 0193399945554a426feec8595486cbc212259970
+e24a447e399223972ac25a520705a99221429b82 0193399945554a426feec8595486cbc212259970
+0193399945554a426feec8595486cbc212259970 37d16ef457b144b699e5d0456a8110e697b0e892
+8b3c7571c1376d5d6bf49935e2ecdb37ab18a82f c3f58e0a36a34fc63b39a0e8b6dd714452a81b38
+c3f58e0a36a34fc63b39a0e8b6dd714452a81b38 462317ce59bff2956b603255c533579cd960e2c1
+462317ce59bff2956b603255c533579cd960e2c1 9d160839b2b6ef2f1f4ec697a4bb58595b9749ed,37d16ef457b144b699e5d0456a8110e697b0e892
+37d16ef457b144b699e5d0456a8110e697b0e892 9529e99c78d2bf1ffb1b0fd6d53f8e80c73eba17
+9d160839b2b6ef2f1f4ec697a4bb58595b9749ed 879965196f0456b5d09c387f51ad1aa8bc517b7e
+879965196f0456b5d09c387f51ad1aa8bc517b7e 074a5dfda2c9ce4d5d98e092edef0214a15e1243
+074a5dfda2c9ce4d5d98e092edef0214a15e1243 a6e3ff583a14d4a5ca8d660859a00e7501a9a4bd
+a6e3ff583a14d4a5ca8d660859a00e7501a9a4bd 6ba016ecfeaf3ae2aa56e66040cc96270b94b147,d0c812fcf1a7463a75a4b0821aad7b53a698ae94
+6ba016ecfeaf3ae2aa56e66040cc96270b94b147 51bf826840a8c9ae4cad2e8b5ef6d52183ede70f,9529e99c78d2bf1ffb1b0fd6d53f8e80c73eba17
+d0c812fcf1a7463a75a4b0821aad7b53a698ae94 51bf826840a8c9ae4cad2e8b5ef6d52183ede70f
+9529e99c78d2bf1ffb1b0fd6d53f8e80c73eba17 164020026e3a719738a3bb388ed211c757b66327
+164020026e3a719738a3bb388ed211c757b66327 79f23e4a0a71efe4bcfd5d12194b5be8116b3d95
+79f23e4a0a71efe4bcfd5d12194b5be8116b3d95 7dbdcbf5a0b70e2610cc6a033d855cf49277c14b
+51bf826840a8c9ae4cad2e8b5ef6d52183ede70f c9f5ad314ed551d772f67971e2bf31c41c86c692
+c9f5ad314ed551d772f67971e2bf31c41c86c692 cd0ae03e77f5e6b40577d94b4cad95beb0024205
+7dbdcbf5a0b70e2610cc6a033d855cf49277c14b 4021551b199416dec89ccf166f168aef66cf4607
+cd0ae03e77f5e6b40577d94b4cad95beb0024205 34c17b3528a056aa806b966b8fe2c875dcdfcf0f
+34c17b3528a056aa806b966b8fe2c875dcdfcf0f 28423d419711ab263d31dffd54765ac939b04ed8
+28423d419711ab263d31dffd54765ac939b04ed8 4021551b199416dec89ccf166f168aef66cf4607
+4021551b199416dec89ccf166f168aef66cf4607 99e278145e3f48aa41d9eec257ed0e9682d80449
+99e278145e3f48aa41d9eec257ed0e9682d80449 a0e6c2fdcb7cc5b53a65c204e6aacd6a41980d60
+a0e6c2fdcb7cc5b53a65c204e6aacd6a41980d60 4e53ed2041f4640f0f9bd87af471042a56d55539
+4e53ed2041f4640f0f9bd87af471042a56d55539 f7368a81a94f513114cb2cc1fed5f0b72269356e
+f7368a81a94f513114cb2cc1fed5f0b72269356e 1aa2709b5fa6242898d01a2c7a65dac7478a65f0
+1aa2709b5fa6242898d01a2c7a65dac7478a65f0 7458dc962f7de10c581e01d58ed10a190e725a95
+7458dc962f7de10c581e01d58ed10a190e725a95 7c99ac42bb0d578a369f60222222878bb4bb2cea
+7c99ac42bb0d578a369f60222222878bb4bb2cea 5df054d940f33812707b7c4db2ecbabb88c007f9
+5df054d940f33812707b7c4db2ecbabb88c007f9 e37d51cfa5b7019e32b59051293ac069a7eb3c76
+e37d51cfa5b7019e32b59051293ac069a7eb3c76 36d5ae8d9f42524366b6f3e0766235258888f879
+36d5ae8d9f42524366b6f3e0766235258888f879 7e2466117d4b0a7b8d3c096d65254c3a72deaf4d
+7e2466117d4b0a7b8d3c096d65254c3a72deaf4d 9fa5ffffd985c6c6835789649594f4c3eabe3e58
+9fa5ffffd985c6c6835789649594f4c3eabe3e58 070a358879597c688719a64957b27b06c6ae3470
+070a358879597c688719a64957b27b06c6ae3470 c7af076fb5441a6521944c470fcc7eb7e2379d1a
+c7af076fb5441a6521944c470fcc7eb7e2379d1a fca9c83d5196974ec2583dc568cd6d4d13373700
+fca9c83d5196974ec2583dc568cd6d4d13373700 00f6f2a2c39c22d21672f6c7d906c690d0df8df4
+00f6f2a2c39c22d21672f6c7d906c690d0df8df4 2d41b2e87dc70ee208e16fb5dbdbddb807635f4d
+2d41b2e87dc70ee208e16fb5dbdbddb807635f4d 844ff4c128bf32c32a02735411dbf058e5a1ed6b
+844ff4c128bf32c32a02735411dbf058e5a1ed6b 224048bd1995aca9704c0bd8e3702b3da8d89b13
+224048bd1995aca9704c0bd8e3702b3da8d89b13 578c1ae2425620886ec2a98b800bdfc5a75fedd6
+578c1ae2425620886ec2a98b800bdfc5a75fedd6 201844bfafadb8adbb2f8e8b66d024d0798561c0
+201844bfafadb8adbb2f8e8b66d024d0798561c0 9b45090ffbfdaa2b89d848b421a48b2df083977e
+9b45090ffbfdaa2b89d848b421a48b2df083977e e313d518c57ab333d2f81356e52ca3cf884672f0
+e313d518c57ab333d2f81356e52ca3cf884672f0 6f67e195394c055bd1f81e09f12dcd12b7b00594
+6f67e195394c055bd1f81e09f12dcd12b7b00594 e94599755425765da97442e9b266d93f465df718
+e94599755425765da97442e9b266d93f465df718 16da8558ede201d82667e5df765977aa99888f7b
+16da8558ede201d82667e5df765977aa99888f7b 02787730a2e6787aeb1dc8cbd2d20e43925b9272
+6fa2e78406096d30186b3237e119aa7d40206316 9ab2add492901a823f238b673f091a011a259f95
+9ab2add492901a823f238b673f091a011a259f95 77cd1aff880b9ae014d9495bfc358095c1007049
+77cd1aff880b9ae014d9495bfc358095c1007049 a7636bcfcc51032fb33630218d9761b01c219465
+a7636bcfcc51032fb33630218d9761b01c219465 dde06b663fd358e1704ecf43df3465204be6a92e
+dde06b663fd358e1704ecf43df3465204be6a92e 7e32aa8d9e0889efc2f30250e52aa82a832272a3
+7e32aa8d9e0889efc2f30250e52aa82a832272a3 69d1d314cd31b774f4336fa2c8906e4387696013
+69d1d314cd31b774f4336fa2c8906e4387696013 7ed5a5de192f37b2b56057b1d227d870c55eb769
+02787730a2e6787aeb1dc8cbd2d20e43925b9272 bce20f2af9049caf12c4cab893672a0c7db2f76a
+7ed5a5de192f37b2b56057b1d227d870c55eb769 bf33407036998851ea0546470d52a8954d3df5b2
+bf33407036998851ea0546470d52a8954d3df5b2 841c3f498e72b482c6dc66631427ab1292cef062
+841c3f498e72b482c6dc66631427ab1292cef062 27e03ab10c5de7b1c9479842a274873824d726f0
+27e03ab10c5de7b1c9479842a274873824d726f0 b433734ae4d1cd0014708b7172d9cb16303105b9
+b433734ae4d1cd0014708b7172d9cb16303105b9 f7cdc16245d3f850767e0c1e4b4ec954d0fa0be4
+bce20f2af9049caf12c4cab893672a0c7db2f76a c5229569095ff3749bf58ea164ae082ef65a6937
+f7cdc16245d3f850767e0c1e4b4ec954d0fa0be4 830231e6626606438e35d7d4320cd5a449db60ad
+830231e6626606438e35d7d4320cd5a449db60ad 88ef67d3eeb590a2f45277fa236264eeda6677f5
+88ef67d3eeb590a2f45277fa236264eeda6677f5 600378be441be44b2ec38356993736c374d604cf
+c5229569095ff3749bf58ea164ae082ef65a6937 a7f72a923ae16e361ae18fc8473754ea2de4b1da
+a7f72a923ae16e361ae18fc8473754ea2de4b1da 80a94ea109520c8cc719f9f7fb83e78f670a2c06
+80a94ea109520c8cc719f9f7fb83e78f670a2c06 c8e58c2956d3ae8924cea61bbfc83fd3f0914b6f
+600378be441be44b2ec38356993736c374d604cf f27cf9f446e2c0181415ed25d55c5047200c63ef
+c8e58c2956d3ae8924cea61bbfc83fd3f0914b6f e22603e687c8a3c0e025a432e8082431420c3d66
+e22603e687c8a3c0e025a432e8082431420c3d66 2454028ce7b5efdf6e1c7c467846d322c9b6e8c7
+f27cf9f446e2c0181415ed25d55c5047200c63ef 2daae45b51f3454a8f74d876ab6adf98e9fdf836
+2daae45b51f3454a8f74d876ab6adf98e9fdf836 27df8e8106135e2cd38975f36f07fdb4d944d484
+27df8e8106135e2cd38975f36f07fdb4d944d484 04fc782eae164945d7eca8c85d44ea51c525d547
+04fc782eae164945d7eca8c85d44ea51c525d547 577bbbab0b399075da217ec94d0521ae897185b3
+2454028ce7b5efdf6e1c7c467846d322c9b6e8c7 c165b411100e84002dded53504d2151a5fda47d5
+577bbbab0b399075da217ec94d0521ae897185b3 03fc95cacb87025a409d7dda22687770234e461f
+03fc95cacb87025a409d7dda22687770234e461f dfa5ecc8d17d379e8e2961297d116b7d818c9075
+dfa5ecc8d17d379e8e2961297d116b7d818c9075 2415804df98278e66a8f2a3837ec93f4c7ca1823
+c165b411100e84002dded53504d2151a5fda47d5 64fa416b34d4225a42ca988820b6cd356dc0419b
+64fa416b34d4225a42ca988820b6cd356dc0419b 8ec43965a7e5f43a9090442d36674c16595b9641
+8ec43965a7e5f43a9090442d36674c16595b9641 78105f5bdbb89ab66f1f2aa409e58d9c9a5cd59f
+78105f5bdbb89ab66f1f2aa409e58d9c9a5cd59f 8a260ddbc7f6c72167041280ae17c74934db579b
+2415804df98278e66a8f2a3837ec93f4c7ca1823 e057f70f5187dd2e058d15950be4eac0cd49e4ad
+e057f70f5187dd2e058d15950be4eac0cd49e4ad c54ed87ce367cf35aaf0916a9d3bf7108a52477c
+c54ed87ce367cf35aaf0916a9d3bf7108a52477c 3decad145bdb968c13959f6f2d7e6b85ca2079b7
+3decad145bdb968c13959f6f2d7e6b85ca2079b7 2c1a4adb23ced0b1be1e6b237573f08c48806cdf
+2c1a4adb23ced0b1be1e6b237573f08c48806cdf 5c9f3ec17a904eb05e916b3bca595db7ffd12a0e
+5c9f3ec17a904eb05e916b3bca595db7ffd12a0e 339aab0882a72b280c84f94b39d94e6f1b101b32
+339aab0882a72b280c84f94b39d94e6f1b101b32 740d248cf846ed8128931483a12247ed3a179813
+740d248cf846ed8128931483a12247ed3a179813 76caa1268409ae81c086266f91a1904711e90cc1
+76caa1268409ae81c086266f91a1904711e90cc1 b7a9734bdf60928400cdc3785c6c0e47ed4ca7fd
+8a260ddbc7f6c72167041280ae17c74934db579b 368d761da8fa62ab3fed5bad2aa03bd156d4fd4d,33694be5f862fb551556bc292347983d3629009b
+368d761da8fa62ab3fed5bad2aa03bd156d4fd4d 634c52d06c7fd44853ffba7bf5dce34256570a7f
+634c52d06c7fd44853ffba7bf5dce34256570a7f b3fbd7024b3f06a8d4dd4bda1cad1c8614367514
+b7a9734bdf60928400cdc3785c6c0e47ed4ca7fd 7a5eb536d0e29f04d7927150d3e8bfa43150191f
+33694be5f862fb551556bc292347983d3629009b e6e04b8c79af9dba388b2d7bdaaef52e4b46d1ee
+e6e04b8c79af9dba388b2d7bdaaef52e4b46d1ee dc43b3418e799d4a28a530781b89111b32fea18f
+dc43b3418e799d4a28a530781b89111b32fea18f b3fbd7024b3f06a8d4dd4bda1cad1c8614367514
+7a5eb536d0e29f04d7927150d3e8bfa43150191f 159145e9c371ad7bcab6f91856a06ad57afd509f
+159145e9c371ad7bcab6f91856a06ad57afd509f 7f499ea08bb1f3f491aac185a980444ddb694d54
+7f499ea08bb1f3f491aac185a980444ddb694d54 b056a2ef6454c89441a49ff127e73ea1d3a5e4bc
+b056a2ef6454c89441a49ff127e73ea1d3a5e4bc 8fb98dda5f358dfeca48c1d054fe474521ed8c45
+8fb98dda5f358dfeca48c1d054fe474521ed8c45 5f97e5ae8d8d44f424886e7dce0224698a157516
+5f97e5ae8d8d44f424886e7dce0224698a157516 566a3b0cf88b86bb0c2da1fea2ad970004d12d47
+566a3b0cf88b86bb0c2da1fea2ad970004d12d47 d6f3b7c58c9ec886897422a482ca25123ea92ccb
+d6f3b7c58c9ec886897422a482ca25123ea92ccb 016c7dba29c59cccea17fb2a1bcc93a839cb38d9
+016c7dba29c59cccea17fb2a1bcc93a839cb38d9 792cf5fe01f5cf08c1c69bcc242b5ff0fa6e970d
+792cf5fe01f5cf08c1c69bcc242b5ff0fa6e970d cfaa83fc7069a9cd0ee9d930b7d2c97042f517a0
+cfaa83fc7069a9cd0ee9d930b7d2c97042f517a0 3405d7b2dbfe7eb8f4bb9ce55fb4aa4298d820c4
+3405d7b2dbfe7eb8f4bb9ce55fb4aa4298d820c4 d22d4fa40848bafb724a0624c3d6d45da92f7982
+d22d4fa40848bafb724a0624c3d6d45da92f7982 074c36575043c530d29db1f9029aa9aecfc2df78
+074c36575043c530d29db1f9029aa9aecfc2df78 1773996e332e9fe68035384e4ea956345e5349aa
+1773996e332e9fe68035384e4ea956345e5349aa 93858377ad386a94ea9d93b82725bcd351222921
+93858377ad386a94ea9d93b82725bcd351222921 23f8fa562020b18153f44fe614bfb6e10576c723
+23f8fa562020b18153f44fe614bfb6e10576c723 036b7a9d4e9ad3bc6ec6c8a009b7104708bf2ea4
+036b7a9d4e9ad3bc6ec6c8a009b7104708bf2ea4 6afd2e723ab6072f128b66ebdae01d4f84fdaf3c
+6afd2e723ab6072f128b66ebdae01d4f84fdaf3c fde3cd0ad14f2e195c1dfd46a5ad3abf3bfd8f6d
+fde3cd0ad14f2e195c1dfd46a5ad3abf3bfd8f6d 932f8e97c02dd4a1a6a905862ade47d5a33ecefc
+932f8e97c02dd4a1a6a905862ade47d5a33ecefc 813b6b2b305151df1a237a4e3f9f3b3e2ca77efb
+813b6b2b305151df1a237a4e3f9f3b3e2ca77efb b564e3a921293af1df4c6425823045d083ea7abc
+b564e3a921293af1df4c6425823045d083ea7abc d684bd81f12e96d65885c9d23936bf313fdac673
+d684bd81f12e96d65885c9d23936bf313fdac673 9f0b57c507c1c8f7eff359e8ebd0047084138ff2
+9f0b57c507c1c8f7eff359e8ebd0047084138ff2 6b93274918649a6b61050d37c9aa787bb99b1db0
+6b93274918649a6b61050d37c9aa787bb99b1db0 5751790037c9a2a99b68388d884c2b514179d44a
+5751790037c9a2a99b68388d884c2b514179d44a d64b4b4760be2163a0b5e0321248fd1635dc8277
+d64b4b4760be2163a0b5e0321248fd1635dc8277 ebaba5e3733c35203175a40998d9b6f11ade5217
+ebaba5e3733c35203175a40998d9b6f11ade5217 a8e82ae9f4bd20bea816b3be31549e58fb7a70e6
+a8e82ae9f4bd20bea816b3be31549e58fb7a70e6 232c8ec0e8f142e78bad8f775bd65054b4a6997b
+232c8ec0e8f142e78bad8f775bd65054b4a6997b 01be4cf099557c79896956dcf4d0575cd97b71fd
+01be4cf099557c79896956dcf4d0575cd97b71fd f83553313cf13c83e8bc13cf8d4c2f071e7a7145
+f83553313cf13c83e8bc13cf8d4c2f071e7a7145 22eaf9c6fa040e13c652928b8bd56797ca3c6ae5
+22eaf9c6fa040e13c652928b8bd56797ca3c6ae5 f22dab86da656a98303cfa4839907922ed3fbe52
+f22dab86da656a98303cfa4839907922ed3fbe52 082ff62d8007aee4c47867bc92261c623d536e83
+082ff62d8007aee4c47867bc92261c623d536e83 0df1257922823f33bc48f8d468825ac205477c7c
+0df1257922823f33bc48f8d468825ac205477c7c 093e8bc8c2728655b17aeba753a25665ce1c4535
+093e8bc8c2728655b17aeba753a25665ce1c4535 d636d628b5a0f41bff89d72b66f374764f85fc69
+b3fbd7024b3f06a8d4dd4bda1cad1c8614367514 3eaa18cb5bd478a6d2dc747bef1073b29113abe8
+d636d628b5a0f41bff89d72b66f374764f85fc69 28468fe546a2cc9fd6650cac6a4064b70d0ebbe2
+28468fe546a2cc9fd6650cac6a4064b70d0ebbe2 07e5f0959111e1144339881645dd599bf793c9ca
+07e5f0959111e1144339881645dd599bf793c9ca 6871dc0b7945ef34afd2eadd67f4d32e9a1f4105
+3eaa18cb5bd478a6d2dc747bef1073b29113abe8 8a70b57bea4d1e5312f8826ffa5f16417531bbae
+6871dc0b7945ef34afd2eadd67f4d32e9a1f4105 b7b562b7b3af9671b0c986dcfdd98972607216a3
+b7b562b7b3af9671b0c986dcfdd98972607216a3 028f0d8c40e871fdf6ce62f08a8e5805d513c6a9
+028f0d8c40e871fdf6ce62f08a8e5805d513c6a9 77149209be527afd33c4f67b37e55cb5d64b982b
+77149209be527afd33c4f67b37e55cb5d64b982b fc8c642fb9b81ae9bcbc73cf5e0036231e09f15b
+fc8c642fb9b81ae9bcbc73cf5e0036231e09f15b 129edccbd5f34d3128bbb177bd104bad684d7eb4
+129edccbd5f34d3128bbb177bd104bad684d7eb4 a1f5573562dd58df7106703a41665b233bf82753
+a1f5573562dd58df7106703a41665b233bf82753 78799c8e556b479804fcf4b9cd8e487a405e90b5
+78799c8e556b479804fcf4b9cd8e487a405e90b5 1d3928260aa5e7503ca7ccdf71236c9849e51cff
+1d3928260aa5e7503ca7ccdf71236c9849e51cff f6d852ea5423899a904625e7ffb4afbdf2dd3045
+3dee8c9dd39b25a661cb50f7ed4e9b5533de0489 9b6c3193e6f492c668c89846b83b3a6b0a8f0a7a
+f6d852ea5423899a904625e7ffb4afbdf2dd3045 9b6c3193e6f492c668c89846b83b3a6b0a8f0a7a
+9b6c3193e6f492c668c89846b83b3a6b0a8f0a7a 99551309fa5760491b267e1754c2ee79a9c31c6f
+99551309fa5760491b267e1754c2ee79a9c31c6f dc7ab217fe2743658babab5613b2451356e448ed
+dc7ab217fe2743658babab5613b2451356e448ed 0869d10a938cbcba1b028d87fd7a6cc843303683
+0869d10a938cbcba1b028d87fd7a6cc843303683 71a141e42eef4f86e4e1ce50b9aebbf5bf80b0ef
+71a141e42eef4f86e4e1ce50b9aebbf5bf80b0ef 386b7b1848ab5f0babbbc73fa424b2514472e359
+386b7b1848ab5f0babbbc73fa424b2514472e359 2d1ae5e50841133cb6e39e5e60eb89c368b42ff0
+2d1ae5e50841133cb6e39e5e60eb89c368b42ff0 0ffb3c1a2bc275dd5482538586860091b97e9b5f
+0ffb3c1a2bc275dd5482538586860091b97e9b5f 634d2c37e0e30b768fcf211d9ae70a6f4860cdf2
+634d2c37e0e30b768fcf211d9ae70a6f4860cdf2 a114850abbcb083dc50de6e75cadaeb9ba3ea54c
+a114850abbcb083dc50de6e75cadaeb9ba3ea54c 54f26c491b0d2dd73fc2c9e7823e3aca72a9f5a2,8a70b57bea4d1e5312f8826ffa5f16417531bbae
+8a70b57bea4d1e5312f8826ffa5f16417531bbae 65e88e7bdc2bf7140c941bb20d46cb5875ee35d9
+65e88e7bdc2bf7140c941bb20d46cb5875ee35d9 92c72d977c5f448716b94425e030b6f759d89ba3,78c9e0e0c54cab356975604dd664f0df46404580
+92c72d977c5f448716b94425e030b6f759d89ba3 a7fef27f05f019b017d6c204aabf432f42b9b40e
+a7fef27f05f019b017d6c204aabf432f42b9b40e 61dc513a05232d6f7bb36636190b31cda11feace
+61dc513a05232d6f7bb36636190b31cda11feace 57d0d68288770282c430fa37afeb360fd9425c8c
+57d0d68288770282c430fa37afeb360fd9425c8c 84f39d59fbcb3bc49fa4c856d7126f1adc2f5d4a
+84f39d59fbcb3bc49fa4c856d7126f1adc2f5d4a ffb3fa86c6fd6939f728d06b404414cfd9ef55d5
+54f26c491b0d2dd73fc2c9e7823e3aca72a9f5a2 5b4dacbff273c38e8706c3aa60a2121d18b3f7d3
+5b4dacbff273c38e8706c3aa60a2121d18b3f7d3 fcf5650f1fe9f9a54858beab9087c62539873b93
+fcf5650f1fe9f9a54858beab9087c62539873b93 b767764b1adf9413412a3572d33a40a548d30bf9
+b767764b1adf9413412a3572d33a40a548d30bf9 e300afb35f20d9867341f92c250e911729cc8453,ffb3fa86c6fd6939f728d06b404414cfd9ef55d5
+ffb3fa86c6fd6939f728d06b404414cfd9ef55d5 0d84db9635a9271fa8b4009346c38a35b266b914
+e300afb35f20d9867341f92c250e911729cc8453 38212a804adc593bc4386c7445e5932b618605a9
+38212a804adc593bc4386c7445e5932b618605a9 0d84db9635a9271fa8b4009346c38a35b266b914
+0d84db9635a9271fa8b4009346c38a35b266b914 ad4a6187780e93ca8e49892b4c9b787fc18ab4cb,3e30a989772d3d1931bbe7a7065a905be61385c8
+ad4a6187780e93ca8e49892b4c9b787fc18ab4cb 1153bc2fbaf02086ad2b989accba68e6a9cb5ab5
+1153bc2fbaf02086ad2b989accba68e6a9cb5ab5 8f2462ead6441802a313373831c049a10465ba73
+8f2462ead6441802a313373831c049a10465ba73 7c04317658e9e33cc13113d833b0dff1c92c134e
+3e30a989772d3d1931bbe7a7065a905be61385c8 16ede37af50bf397cb08a4b83766a7c7465857d9,7c04317658e9e33cc13113d833b0dff1c92c134e
+7c04317658e9e33cc13113d833b0dff1c92c134e 20a8d29b9b4732f0aaa19129e9fa35cb95404edc
+20a8d29b9b4732f0aaa19129e9fa35cb95404edc 931244e94b062bb1a9d7af0078fc55465079d14c
+16ede37af50bf397cb08a4b83766a7c7465857d9 c4b5049ef650faded2af059d1e2dd2357f917a77,641de07eb28ec9fc09db6a32cf9c82908a8f8fdd
+c4b5049ef650faded2af059d1e2dd2357f917a77 741ee4b6a72d021b97712a303f6b3dfd5e91e379,e9444e85d37ef71fae8264684e627d14ccdb0e34,931244e94b062bb1a9d7af0078fc55465079d14c
+931244e94b062bb1a9d7af0078fc55465079d14c 769eada4588c4c14812c10d8bfcec36e169b46c5
+741ee4b6a72d021b97712a303f6b3dfd5e91e379 769eada4588c4c14812c10d8bfcec36e169b46c5,1fe765631fd96ed6e04304818a102c7a232d106e
+769eada4588c4c14812c10d8bfcec36e169b46c5 702e56f5a226458ce02fba6c18902b0b7bef2926
+702e56f5a226458ce02fba6c18902b0b7bef2926 b2688e276938c63f0e83343755c96e4ee87dcc8d
+b2688e276938c63f0e83343755c96e4ee87dcc8d e45a9670135d682a6a5f2af660950a6b8b2f589c
+e45a9670135d682a6a5f2af660950a6b8b2f589c f20587918bc5e1886f910058e5189d33ca07e2bb
+f20587918bc5e1886f910058e5189d33ca07e2bb ae80d00cc7e94dbfbe164d9a63022f16c61082b2
+ae80d00cc7e94dbfbe164d9a63022f16c61082b2 eb90f6fe980d47e0aeec5e24b106ff77ee4373bf
+eb90f6fe980d47e0aeec5e24b106ff77ee4373bf 2e84f80306de8d059a99affe97a6566244630b50
+2e84f80306de8d059a99affe97a6566244630b50 ffaeb9b69270c01c528394cb080e2ba815b0413b
+ffaeb9b69270c01c528394cb080e2ba815b0413b ec5345e6ecc7783dee188df0d4eae343912d9eac
+ec5345e6ecc7783dee188df0d4eae343912d9eac 731033a46a8632934c70c4a5aa1d354e91e2619f
+731033a46a8632934c70c4a5aa1d354e91e2619f 37a2da3f610d19d28099467f73fabe68713dd44b
+37a2da3f610d19d28099467f73fabe68713dd44b f08db11c36260ef555311695aef4290b4e6a22ee
+f08db11c36260ef555311695aef4290b4e6a22ee af3a660dfbb6065dafea4b91677da02ef8398f7a
+af3a660dfbb6065dafea4b91677da02ef8398f7a 19f2bc121f642d42ac3ccfab583566cc567bf0b0
+19f2bc121f642d42ac3ccfab583566cc567bf0b0 a36cdd0820c18f70ccc19e284c4b81dd1b8be2a1
+a36cdd0820c18f70ccc19e284c4b81dd1b8be2a1 00665c494078299dd945b4c438f8d7644cd04608
+00665c494078299dd945b4c438f8d7644cd04608 965c3fa0774eee49c5d8a6b128cf820a41f95fb6,f66fad5ea749f3df400e17e58c347b99e380a2dc
+965c3fa0774eee49c5d8a6b128cf820a41f95fb6 059415e777ed0967b88997c5e11f10e417024926,f7a5f0b8f14cda009733dc89a69c97a60a7ee4fe
+059415e777ed0967b88997c5e11f10e417024926 d3caf011b4c7ec0b40cadc97bd5d619654e5d03b,f66fad5ea749f3df400e17e58c347b99e380a2dc
+d3caf011b4c7ec0b40cadc97bd5d619654e5d03b 2c08c1f7c0493877c114715633c59bc2381a1113
+f7a5f0b8f14cda009733dc89a69c97a60a7ee4fe b129805ac85708a12a222c298b9c361f6ccf116d
+2c08c1f7c0493877c114715633c59bc2381a1113 49469ad16e121ddc47ac2cb268a71f5fe4e84e2f
+49469ad16e121ddc47ac2cb268a71f5fe4e84e2f 1aaf1064c64285d7466f05f2521d0a3554ea5fb0
+1aaf1064c64285d7466f05f2521d0a3554ea5fb0 eecf6b993e5deb874410fa317bb020d3b68b76e1
+eecf6b993e5deb874410fa317bb020d3b68b76e1 57d7865ae2c1a2a34822f253dcf9655e2e65de5c
+57d7865ae2c1a2a34822f253dcf9655e2e65de5c 0be89c389a4609197fe89dcda300528fc8c35c5a
+0be89c389a4609197fe89dcda300528fc8c35c5a b129805ac85708a12a222c298b9c361f6ccf116d
+b129805ac85708a12a222c298b9c361f6ccf116d f3be772e6ca62c38a11429c4c833cb038efe88e4
+f3be772e6ca62c38a11429c4c833cb038efe88e4 2cf2b7b1449efe706e802779e083fe6b358450b5,234608b6ff336c17a62e728fa8940e81393ef2d9
+2cf2b7b1449efe706e802779e083fe6b358450b5 44b91abd1f8477a45c7e257a51f5053e1fa207e1
+44b91abd1f8477a45c7e257a51f5053e1fa207e1 ca9da88e3e855c589ccb1d55c6661c76724b5279,1b5d412efbfb5634ce7799a505afe4925825df0f
+ca9da88e3e855c589ccb1d55c6661c76724b5279 e03d5c75f8af0be58e38b630f20de226de34a355
+e03d5c75f8af0be58e38b630f20de226de34a355 231a14dc2dd954ba25edc51a72e662daa53a192e
+231a14dc2dd954ba25edc51a72e662daa53a192e ec43e24ac438d698688e9afdd1a8e5edac65d67d
+ec43e24ac438d698688e9afdd1a8e5edac65d67d 351fd3ff4fd7df647baa430e6ed5a131824d655d
+351fd3ff4fd7df647baa430e6ed5a131824d655d ac8a516285c3fc79a272f935794a42e06621b46f
+ac8a516285c3fc79a272f935794a42e06621b46f 3a76f000c0bfa520b3b8d28b68d118caf37ef60d
+3a76f000c0bfa520b3b8d28b68d118caf37ef60d b7dfc5691b1deb29ddc0ff2d0d8417914960581f
+b7dfc5691b1deb29ddc0ff2d0d8417914960581f ab579cdb7a3bc9bca352591376aa7ac11ffe871b
+ab579cdb7a3bc9bca352591376aa7ac11ffe871b db1d22eadb8a586d7fc580a3d82029bdf7443d3c,8e9712a5d398a9fe5f8934af787d5d5d95a49a15
+db1d22eadb8a586d7fc580a3d82029bdf7443d3c f61052be3c1cb795806f4c8895add22d6d1c9bf8,1550ea7ddf75b4478f9cf8719b00fc1cafa26a1e
+f61052be3c1cb795806f4c8895add22d6d1c9bf8 8293650fcd428a498d500053f6d145e51b6ca526,2ea9ce81b49510a06465aa57e03fa9f5846abed7
+8293650fcd428a498d500053f6d145e51b6ca526 6fbc0a6bcf00bdf91d1ad9d133b34a29751ae9df
+6fbc0a6bcf00bdf91d1ad9d133b34a29751ae9df 2be9e621916f2895bc52f74d45a2c65b0d10f91c
+2be9e621916f2895bc52f74d45a2c65b0d10f91c c038aff905aa4ecad62a1da3d559d4bbd7ed2204,fe83540f6ad304de3f03fda268112557485781de
+c038aff905aa4ecad62a1da3d559d4bbd7ed2204 28de54b8dbfb3b2e5038fb59ab43ecf869733e70
+28de54b8dbfb3b2e5038fb59ab43ecf869733e70 61b1af2634de8b4dd1da756c3c7a57620b517aa6
+61b1af2634de8b4dd1da756c3c7a57620b517aa6 54a615c4aafa3617e6a60b911277ed87d163a162
+54a615c4aafa3617e6a60b911277ed87d163a162 16e5e51d776f635f0aeec080a5e4c26645cf83f6
+16e5e51d776f635f0aeec080a5e4c26645cf83f6 4b37eea7d09d818497b7fdaca5f139d64823e288
+4b37eea7d09d818497b7fdaca5f139d64823e288 002d037cb3d0cbab979b4e2e14b09e16ab2c76ee
+002d037cb3d0cbab979b4e2e14b09e16ab2c76ee 183f89d3457c45a95e5a70bd77943526eb59e45f
+183f89d3457c45a95e5a70bd77943526eb59e45f fa5f74982be4138bda1124183612e353bfe37503
+fa5f74982be4138bda1124183612e353bfe37503 3a179173299d7fdbd0cdeb64095bdd889ae3994f
+3a179173299d7fdbd0cdeb64095bdd889ae3994f d9ba150235432800ddbd88b1c1d36ec2d1fb3169
+d9ba150235432800ddbd88b1c1d36ec2d1fb3169 7ef81d8632ba5534eba2e00152396bf19fae1066,589e316b300ba53abd4c61730283ec7a3026de79
+7ef81d8632ba5534eba2e00152396bf19fae1066 7b1e0451690771f00400b797fbda41496c3941b0
+7b1e0451690771f00400b797fbda41496c3941b0 73cb4bf58e99c6154baa6981ca3e144c4bcbd03c,1d106be1728ca9ca36f72f9c60f0238bdba094e7
+73cb4bf58e99c6154baa6981ca3e144c4bcbd03c 2aaccbd409e28b08e66b8271cce18279d363d982,1b4e30d106adb0ba869c736335aede5e1fd7359d
+2aaccbd409e28b08e66b8271cce18279d363d982 31c8ca7f7868fc612e50a40a8b336abfe59947c2,ef2ec4a2aa8bbc0c3f805b815729f8b3430ac207
+adbeb66c05311ae7dd12044e50ffe30a7bac4d5c e52f8b2513cf17879f6a00d912aa445b35a45d76
+31c8ca7f7868fc612e50a40a8b336abfe59947c2 081ae45cc81c7d9bbcf14dbf11e947868786f4ca
+081ae45cc81c7d9bbcf14dbf11e947868786f4ca 8fe99604383456d3e09bf637076453d9c103690f
+8fe99604383456d3e09bf637076453d9c103690f 29f35f475c1ed2287f876308834d179cd39611ca
+e52f8b2513cf17879f6a00d912aa445b35a45d76 0c8e6ec6fdc3c7fbab8ca602f6aeb6cf430add71
+0c8e6ec6fdc3c7fbab8ca602f6aeb6cf430add71 bea6ae9a16fa70b27d1b341e7c280af1e97e31c0
+bea6ae9a16fa70b27d1b341e7c280af1e97e31c0 13061daea933c0ca8871abf3aa7d09a75b224706
+13061daea933c0ca8871abf3aa7d09a75b224706 e69f5bdf52f9b9757fc8db839951fa114296d6b4
+e69f5bdf52f9b9757fc8db839951fa114296d6b4 e7f856437160ec8916590616ec6f4b3fd17ce57d
+29f35f475c1ed2287f876308834d179cd39611ca 55bfa73d283ae904ae5cea04b8b27e6c3a75eb3a
+e7f856437160ec8916590616ec6f4b3fd17ce57d 977b907588e312b9feb26c3c49f168aaec0ac0e1
+977b907588e312b9feb26c3c49f168aaec0ac0e1 e0622d9f3d96c83e832c2e833c3d619e1ce765dd
+e0622d9f3d96c83e832c2e833c3d619e1ce765dd b28d552c97adc2d965ab7babf7c890e56e4eb4ce
+b28d552c97adc2d965ab7babf7c890e56e4eb4ce 366547935e9b654834b37a1cf05cf02a8bf1bbb0
+366547935e9b654834b37a1cf05cf02a8bf1bbb0 86a0fe717f7d121df52f81d3b4447c6d89d68c63
+86a0fe717f7d121df52f81d3b4447c6d89d68c63 20ab92b6e4a54fbc9f880852cbea28dc4a880f08
+20ab92b6e4a54fbc9f880852cbea28dc4a880f08 439caadb720f77df4157a7622ec441c6a01c6890
+439caadb720f77df4157a7622ec441c6a01c6890 82da6b65d8f801579b16415c2d2bc937694dbabd
+82da6b65d8f801579b16415c2d2bc937694dbabd e660d445bedeea6fc21810ef805b072b12056719
+e660d445bedeea6fc21810ef805b072b12056719 f8012076472f9a344abd6e7bafe3fd87c8714c47
+f8012076472f9a344abd6e7bafe3fd87c8714c47 959864784f3e7cf5452de90a774c7772eb3f7e51
+959864784f3e7cf5452de90a774c7772eb3f7e51 6899c9d176819ece27b00273876bea0647978d87
+6899c9d176819ece27b00273876bea0647978d87 723893d25c365adf9a50c309bd86458bad42e854
+723893d25c365adf9a50c309bd86458bad42e854 3484aad0053fc732860b110832ad11b445a45a20
+1d106be1728ca9ca36f72f9c60f0238bdba094e7 b5a0ecc65a1717a86364171529faf7352cd06bff,55bfa73d283ae904ae5cea04b8b27e6c3a75eb3a
+3484aad0053fc732860b110832ad11b445a45a20 da6d7b66552aac978cb586e2851fb56dfd167326,55bfa73d283ae904ae5cea04b8b27e6c3a75eb3a
+da6d7b66552aac978cb586e2851fb56dfd167326 b0a3cd70ab279e18883552db4a58982f84247294
+b0a3cd70ab279e18883552db4a58982f84247294 60b0f467ffc8670113b608b2ddbf88278a8a4ecf
+60b0f467ffc8670113b608b2ddbf88278a8a4ecf b5a0ecc65a1717a86364171529faf7352cd06bff
+55bfa73d283ae904ae5cea04b8b27e6c3a75eb3a 582b7fa0fbd2cecebceaa05b153860a49174d68f
+582b7fa0fbd2cecebceaa05b153860a49174d68f 7566f2bf71d40b4db4e7c42a4ed5b9604f5cc01c
+7566f2bf71d40b4db4e7c42a4ed5b9604f5cc01c c7a72a621149e788759cc375d5edf021a4eb35b5,06d1c273aab289fb1085e2d470c892222ca9086b
+c7a72a621149e788759cc375d5edf021a4eb35b5 4952641dd93462e7fde19779ba307e3e8e970816
+4952641dd93462e7fde19779ba307e3e8e970816 3c893a4210512daa70e7c955633e824f84d32d30,017981efcd5dbe3b7a59e19a0b8b1b3345a3deb9
+017981efcd5dbe3b7a59e19a0b8b1b3345a3deb9 900b334740ad45bcbcfc7421e0703a51890f05c5
+900b334740ad45bcbcfc7421e0703a51890f05c5 d9e675ce754550947c6e46586afc9705499a27fb
+d9e675ce754550947c6e46586afc9705499a27fb 3c893a4210512daa70e7c955633e824f84d32d30
+b5a0ecc65a1717a86364171529faf7352cd06bff 1254c88236907d47f7445c3f21ddb2606a3ea264
+1254c88236907d47f7445c3f21ddb2606a3ea264 542b91337514945425da3d5722a87c0564d068c8,3c893a4210512daa70e7c955633e824f84d32d30
+3c893a4210512daa70e7c955633e824f84d32d30 d26d705d6d4ae7234ee0a81b5ade3861e21abf15
+542b91337514945425da3d5722a87c0564d068c8 50ea23ff376618ba330117cf27c0d105f4e4e35b
+50ea23ff376618ba330117cf27c0d105f4e4e35b d26d705d6d4ae7234ee0a81b5ade3861e21abf15
+d26d705d6d4ae7234ee0a81b5ade3861e21abf15 ac0148ceafdaced62f5dfa03eaabb657185608de
+ac0148ceafdaced62f5dfa03eaabb657185608de 430f66247caec1a031a28b997f05a6f84155adda
+430f66247caec1a031a28b997f05a6f84155adda 1f6bb250f849ccfceb3ca03d383913896c7ca04b
+1f6bb250f849ccfceb3ca03d383913896c7ca04b 6d8663e1519c3c38126b6b35a7dc51d10692b558
+ed59d297988963292cb5f31798edb2c095027d2c c6ecb4ee03f6726df71fd4c74448315bdd31c285
+6d8663e1519c3c38126b6b35a7dc51d10692b558 32331b404a5e8fd77f7f83a15ef6e0dad4556959,85039c3ea470a14df0c2ce193ed4bc101b0ba761
+85039c3ea470a14df0c2ce193ed4bc101b0ba761 32331b404a5e8fd77f7f83a15ef6e0dad4556959
+c6ecb4ee03f6726df71fd4c74448315bdd31c285 32331b404a5e8fd77f7f83a15ef6e0dad4556959
+32331b404a5e8fd77f7f83a15ef6e0dad4556959 16c73ccb256348cf2de008746ea8d8a61c164173
+16c73ccb256348cf2de008746ea8d8a61c164173 8fddfd8f37adc66bdca13e41909e34bfe95ca285
+8fddfd8f37adc66bdca13e41909e34bfe95ca285 c066b7977151553d9ec37f5db8eb3776ee1d8c88
+c066b7977151553d9ec37f5db8eb3776ee1d8c88 738e6abeed9a984f31700812d084cd6ec40fe47d
+738e6abeed9a984f31700812d084cd6ec40fe47d 59a626c53fe61faf9fd4a1565814c0087d38e8b0
+aefba9d5f100edcf3c42a787563a2c231f7d27a6 99dec402d5e4207653a81fb914c06cfb50359d7c
+99dec402d5e4207653a81fb914c06cfb50359d7c 86beaad7468f163c3efd9f7f224e29768bfbbf0e
+86beaad7468f163c3efd9f7f224e29768bfbbf0e 386832d44235c0915bd0c59098ed39eeadc5d789
+386832d44235c0915bd0c59098ed39eeadc5d789 adb0f2f99cc50f48d0c1be93f04c78f2ed71f9e3
+adb0f2f99cc50f48d0c1be93f04c78f2ed71f9e3 f2aaee910053f7f2803ae67858011d7aaa50a1bd
+f2aaee910053f7f2803ae67858011d7aaa50a1bd 884a77869d8281d66058ef769c4f880fb6f51865
+884a77869d8281d66058ef769c4f880fb6f51865 8a363f876e77ab3e144a67ef3120384b6b1b513c
+8a363f876e77ab3e144a67ef3120384b6b1b513c 59a626c53fe61faf9fd4a1565814c0087d38e8b0
+59a626c53fe61faf9fd4a1565814c0087d38e8b0 4c0b5593dd64f4f03ea32ee9d1853347fa022db8
+4c0b5593dd64f4f03ea32ee9d1853347fa022db8 a5596b73e4822e25faf10acd35abf01b9b111b07
+a5596b73e4822e25faf10acd35abf01b9b111b07 5834a7acc8eaf3139a43dac4f56bb59a9c4679e8
+5834a7acc8eaf3139a43dac4f56bb59a9c4679e8 74324f583bc9dd7317a7c31cc6a3fd754693a903
+74324f583bc9dd7317a7c31cc6a3fd754693a903 eb63661bd1476f9156c6cf61534644f5b2d7b6bc,71d89918c0e5efb435591a5e25dd67b157540146
+71d89918c0e5efb435591a5e25dd67b157540146 934132ed7c6b885d00911062f5e0d2cad1032f8b
+934132ed7c6b885d00911062f5e0d2cad1032f8b edcc532c167c4ae2b74d6cbbe040ae356e1862f3
+edcc532c167c4ae2b74d6cbbe040ae356e1862f3 a647090d9409d12c72248d6b4a20ad38d252214a
+a647090d9409d12c72248d6b4a20ad38d252214a eb63661bd1476f9156c6cf61534644f5b2d7b6bc
+eb63661bd1476f9156c6cf61534644f5b2d7b6bc dbcb3cf9a959924a84fdc7cf79d1887c5e95f4dd
+dbcb3cf9a959924a84fdc7cf79d1887c5e95f4dd b2e6ae7b8938c2518d58179bf92c54d7454c5243
+b2e6ae7b8938c2518d58179bf92c54d7454c5243 a4dbbfa5fddfc3e167a1b4c05e57336b05ee9222
+a4dbbfa5fddfc3e167a1b4c05e57336b05ee9222 22faaf83686db877ff9058220271ba8827717a9b
+22faaf83686db877ff9058220271ba8827717a9b 2b11d3acea19d9917ac6a3b11c71e44d52c200d3
+2b11d3acea19d9917ac6a3b11c71e44d52c200d3 866681b74e95b997147b99c51e07da5d60feb432
+866681b74e95b997147b99c51e07da5d60feb432 494eadce2e32082499eddbf082ccc0e49ece3466
+494eadce2e32082499eddbf082ccc0e49ece3466 c45b0ca87c2b86f41f14bac0b162a446681aa601
+c45b0ca87c2b86f41f14bac0b162a446681aa601 11a467a8ef91545bb242890660b7c1ed16481f55
+11a467a8ef91545bb242890660b7c1ed16481f55 be6116e971bb865603ed4a6c8f83bd691c54422a
+fff83466f384a50a9cdbc24fdbec64fbe97b397b be6116e971bb865603ed4a6c8f83bd691c54422a
+be6116e971bb865603ed4a6c8f83bd691c54422a 38764bf86da93d5795e40d18947e4c6a8d71842f
+38764bf86da93d5795e40d18947e4c6a8d71842f 566569e56f5ce387da9bd1238e12e4a4673193a9
+566569e56f5ce387da9bd1238e12e4a4673193a9 33cf143a502e8422991ffd33794c4344e3cfd733
+33cf143a502e8422991ffd33794c4344e3cfd733 2a51bc466941c8e4cc79a790df3b41f94efe902e
+2a51bc466941c8e4cc79a790df3b41f94efe902e 67b2c7d27d32bc86e5c85546911865e6d53cbbd2
+67b2c7d27d32bc86e5c85546911865e6d53cbbd2 d12eb7e791044c266d07998cd4e302390f73c881
+d12eb7e791044c266d07998cd4e302390f73c881 5d8a2f9b91d23ef0302b3adf7c8c307a138eb03e
+5d8a2f9b91d23ef0302b3adf7c8c307a138eb03e 6c93b89220d50081c68cfcc49a18b3f413c91044
+6c93b89220d50081c68cfcc49a18b3f413c91044 6733bbf4a7a0255f2134f3bc7013a3a0b44d9723
+6733bbf4a7a0255f2134f3bc7013a3a0b44d9723 e669693ecfde3d8f65b6f79da4c0a5275908855a
+e669693ecfde3d8f65b6f79da4c0a5275908855a 0a8c497528261aa173658da4e2b416b3a58071f8
+0a8c497528261aa173658da4e2b416b3a58071f8 058bef15102031f9c04c7887b6497986f722513c
+058bef15102031f9c04c7887b6497986f722513c e4339a3c50515554d514886f630f68557ccc57a3,7a8dbd329924b2c3a1c5b3dd7a754ae677995f25
+7a8dbd329924b2c3a1c5b3dd7a754ae677995f25 52591d24f412f3dedf650c931009dfe99dd74b3e
+e4339a3c50515554d514886f630f68557ccc57a3 1b80dd0400d1deace38ef139ff02ff621f785bdf
+1b80dd0400d1deace38ef139ff02ff621f785bdf fd4c0d8701b7646e93dba00409e9022dac714827
+52591d24f412f3dedf650c931009dfe99dd74b3e fb7e6638f82b75f13d06d9695667992eba806073
+fd4c0d8701b7646e93dba00409e9022dac714827 b04e689404c660fdf6727bf2645dd515f6a2fed4
+b04e689404c660fdf6727bf2645dd515f6a2fed4 83edad0b8e3b7d7932fa579d0dce19b074773b29
+83edad0b8e3b7d7932fa579d0dce19b074773b29 10d6c50ecd62eaaf8476fd1f7878a7e6a4b9bf0f,27a8f638a910eca20e09ad51deb3ea22182077e8
+10d6c50ecd62eaaf8476fd1f7878a7e6a4b9bf0f 97716c5057503600ac267505e910b7b601c2ae26
+97716c5057503600ac267505e910b7b601c2ae26 fb7e6638f82b75f13d06d9695667992eba806073
+fb7e6638f82b75f13d06d9695667992eba806073 d55ba5cbfdf0cb089cdb58a32d7aaea623fef1ed
+d55ba5cbfdf0cb089cdb58a32d7aaea623fef1ed 6f7d6654c501279e136dae443ed655021fc25124
+6f7d6654c501279e136dae443ed655021fc25124 949d5407dbad5db056abd5b028a9cdce2c3eae58
+949d5407dbad5db056abd5b028a9cdce2c3eae58 6139430731c2e3daf64bf3515effab4064da2eef
+6139430731c2e3daf64bf3515effab4064da2eef c1e7660763b4416639fb0e35b58f290da1a854e5
+c1e7660763b4416639fb0e35b58f290da1a854e5 c260f8f3ea5df6be3602ccddc140193ba64443fd
+c260f8f3ea5df6be3602ccddc140193ba64443fd 2f6d498c71980333cb734d6a1226e8ebd46b2bef
+2f6d498c71980333cb734d6a1226e8ebd46b2bef 10a8cb99bfe2b89a84510196977d3a6c9401e78c
+10a8cb99bfe2b89a84510196977d3a6c9401e78c f4e6b4ecb213799fe9ebfaff2799b803eb4fa53d
+f4e6b4ecb213799fe9ebfaff2799b803eb4fa53d 6b4a7cf4a41521712a2d8076f3d20acc84111f61
+6b4a7cf4a41521712a2d8076f3d20acc84111f61 96a83f9ea5e62c9adced7d43f9818eb86e832d25
+96a83f9ea5e62c9adced7d43f9818eb86e832d25 5a7b531a5237bc6f9d8ccdf4ead5db55a8017ce2
+5a7b531a5237bc6f9d8ccdf4ead5db55a8017ce2 ac5c30cfa9a0af5aa442b6cf1c3cb60809e6ae9f
+ac5c30cfa9a0af5aa442b6cf1c3cb60809e6ae9f eed93e593410ead2dfb213c22cd4d461d748caf5
+eed93e593410ead2dfb213c22cd4d461d748caf5 681c4c04e0479999d9c39ba33a6c961c5f21e932
+681c4c04e0479999d9c39ba33a6c961c5f21e932 268ce73e8a93b35c48177f348e55e2b09ecf2ac2
+268ce73e8a93b35c48177f348e55e2b09ecf2ac2 91fc43b9f0070cc6c64f813846a19dc38e5885fe
+91fc43b9f0070cc6c64f813846a19dc38e5885fe c4eadcfc06eeb2f82f7e84ebf3c1eede03f20c65
+c4eadcfc06eeb2f82f7e84ebf3c1eede03f20c65 50a6d511213fbb79c2105e6478e0a0c89ae32dff
+50a6d511213fbb79c2105e6478e0a0c89ae32dff 55ad7b5c0301c04c61f781ec2e7c760eda44b8a5
+55ad7b5c0301c04c61f781ec2e7c760eda44b8a5 c64db4cd71340dec95f5e1fb95ce7a5c4b783cbd
+c64db4cd71340dec95f5e1fb95ce7a5c4b783cbd e15d743b85df021b3c3a8af77165c81db0684ed8
+e15d743b85df021b3c3a8af77165c81db0684ed8 8a75426772eb59bd97a9657c5e622a4e934eecb7
+8a75426772eb59bd97a9657c5e622a4e934eecb7 7011408fb5511bc3278fa56429b2f4a43819dcc3
+7011408fb5511bc3278fa56429b2f4a43819dcc3 ee1d5c9fac14e0c5a23f0b1479968d535cb361ce
+ee1d5c9fac14e0c5a23f0b1479968d535cb361ce a3760325d1d17ed96dc4138ae6e1f32bb3107f90
+a3760325d1d17ed96dc4138ae6e1f32bb3107f90 0323ded23f0f2937f939f8cb935a0529d1eac99c
+0323ded23f0f2937f939f8cb935a0529d1eac99c 5cda9f73463a504d040ccce183bcfc3d1239fcd6
+5cda9f73463a504d040ccce183bcfc3d1239fcd6 aa94695956a625174f6d85c2f566a81c4107867e
+aa94695956a625174f6d85c2f566a81c4107867e 03d9a6fefa74839a49232900092f7c5b1a4e53d9
+03d9a6fefa74839a49232900092f7c5b1a4e53d9 abf642e1fb04d7765589d5599e0de281bb92029e
+abf642e1fb04d7765589d5599e0de281bb92029e 0c15178d6d1f09ff8f09fa430bc73adaab1d2d62
+0c15178d6d1f09ff8f09fa430bc73adaab1d2d62 708a0404a7604d2efcede5917e3254725bc86acf
+708a0404a7604d2efcede5917e3254725bc86acf e174a07c36829083e912566dcd3907aa9bc83877
+6929385e83c3c54019e85e5eb4094d0c4fcbcb21 e174a07c36829083e912566dcd3907aa9bc83877
+e174a07c36829083e912566dcd3907aa9bc83877 754913fd32aa45542db1ef62fa4a9652b936fc29
+64c9c79a950c8a37d631cf7ea078270ac4eca7d9 1519ed155c9c1400fd579bc02cb50e1c47a3a56b
+754913fd32aa45542db1ef62fa4a9652b936fc29 0251c2384e7f1b247cb63560c5ef1b5a7ad6331c
+0251c2384e7f1b247cb63560c5ef1b5a7ad6331c 8e8dd3185e704f0b699e8712e1d4e1b4bbc94439,7a74b8e95278601116074b745efb8cc0cda35be5
+1519ed155c9c1400fd579bc02cb50e1c47a3a56b 5fb5dbfbf78c969ff4590c7d5e6ee60a98d6a256
+5fb5dbfbf78c969ff4590c7d5e6ee60a98d6a256 3200899a59caa8666a805583b2c0ea3228931542
+3200899a59caa8666a805583b2c0ea3228931542 39082cc602697fab98b65fa1a07daa276f31d1d0
+8e8dd3185e704f0b699e8712e1d4e1b4bbc94439 087b1eac2a1b7f3034e6eb39ba4fa6bb545ed25b,cb3bbc9d2e0a39c37bce340972c524a3b0c8e77f
+087b1eac2a1b7f3034e6eb39ba4fa6bb545ed25b 1dd24dcdda7d20f38bd88a0c2c01a4283d0e3eb0
+39082cc602697fab98b65fa1a07daa276f31d1d0 a00177454224cbad76c210cdb433359f7628ff07
+a00177454224cbad76c210cdb433359f7628ff07 8f16c927857bc68a2d317d10641842e5ae4f475e
+8f16c927857bc68a2d317d10641842e5ae4f475e 8abfd3775131b06db3b745f1c67a3b9ad5bba6ec
+8abfd3775131b06db3b745f1c67a3b9ad5bba6ec 992c83b80ddbf4d0dbd67afd1f5cb0050d9bbacb
+992c83b80ddbf4d0dbd67afd1f5cb0050d9bbacb 7a74b8e95278601116074b745efb8cc0cda35be5,00b438b957bdfbe2385f11cbd189ab5ddb02b05c
+00b438b957bdfbe2385f11cbd189ab5ddb02b05c eb1aa9c1230160fe1a8cf99c5943c0c19cc4c82d,7a74b8e95278601116074b745efb8cc0cda35be5
+eb1aa9c1230160fe1a8cf99c5943c0c19cc4c82d a32edcfb82854905ee5d3efd3a59c158209c4b16
+7a74b8e95278601116074b745efb8cc0cda35be5 2741d9eb4fd52f98b05fc33534428c226c016bef
+a32edcfb82854905ee5d3efd3a59c158209c4b16 c6224b1a9100e05cc5850b3dd5bcdab4c705fbed
+2741d9eb4fd52f98b05fc33534428c226c016bef c661628acbf41075ef824a737bc225f6f173a0c6
+c661628acbf41075ef824a737bc225f6f173a0c6 56e69f81e0f86eb66f9ab620298f00e4613232d2
+c6224b1a9100e05cc5850b3dd5bcdab4c705fbed ac6f23131f686339af403d236dac13c1fd6f2e14,56e69f81e0f86eb66f9ab620298f00e4613232d2
+56e69f81e0f86eb66f9ab620298f00e4613232d2 1dd24dcdda7d20f38bd88a0c2c01a4283d0e3eb0
+ac6f23131f686339af403d236dac13c1fd6f2e14 f5fba357bdfc3898731bfbb3866ef40ee75b16c0
+f5fba357bdfc3898731bfbb3866ef40ee75b16c0 f5559ef39a659c9f42979d45e7583a1d388c881e
+1dd24dcdda7d20f38bd88a0c2c01a4283d0e3eb0 b9f1218ee50d5a4df6aa0b76289e826b72d4f1bc
+f5559ef39a659c9f42979d45e7583a1d388c881e 335c8473b59bdc38492c9ead1bc3a0b5245d2e17
+335c8473b59bdc38492c9ead1bc3a0b5245d2e17 e551f1cae08dbe419dc2320cdd30f1cb04dad75b
+e551f1cae08dbe419dc2320cdd30f1cb04dad75b 90e6a7e419181c0fb3ea16d70a097b7099e25bd4
+90e6a7e419181c0fb3ea16d70a097b7099e25bd4 03ef168ab1775755638995b16d4c73ac64776c75
+03ef168ab1775755638995b16d4c73ac64776c75 b9f1218ee50d5a4df6aa0b76289e826b72d4f1bc
+b9f1218ee50d5a4df6aa0b76289e826b72d4f1bc f5f300b27d1b2a90d051f6137dcad9aae07a556c
+f5f300b27d1b2a90d051f6137dcad9aae07a556c 2d65cd8ad02de59743a61d2a04517f4b3968718b
+2d65cd8ad02de59743a61d2a04517f4b3968718b 93e4191ac585f159d69c56d24ff90f8cbd130f72,e99d630f5587c9fc7c3319e98a4c0c45ee3ce939
+e99d630f5587c9fc7c3319e98a4c0c45ee3ce939 649822464b92911db5733c5a6cd604d27f691387
+649822464b92911db5733c5a6cd604d27f691387 93e4191ac585f159d69c56d24ff90f8cbd130f72
+93e4191ac585f159d69c56d24ff90f8cbd130f72 4f2bafcb9e72d6be2bbfd96f8496b897cae985f3
+4f2bafcb9e72d6be2bbfd96f8496b897cae985f3 470f227b7c55112c04a4d63ad7e7d081be0b1e36
+470f227b7c55112c04a4d63ad7e7d081be0b1e36 5e968a126b69f89494596d6e429dee59826abbf6
+5e968a126b69f89494596d6e429dee59826abbf6 8232118283fc2cfa70eec8239a1012a62a15948d,1ba6aba073c6860a1a020486827144afef86abba
+8232118283fc2cfa70eec8239a1012a62a15948d 59a93a028a7d69ebeea9d2148615c411bb8be404
+1ba6aba073c6860a1a020486827144afef86abba 94a053d0eab42120fb0896f671db5fc1a9de46f5,a2ee369f433a570c5bcf673ec5d57f93a57ce54b
+59a93a028a7d69ebeea9d2148615c411bb8be404 a2ee369f433a570c5bcf673ec5d57f93a57ce54b,94a053d0eab42120fb0896f671db5fc1a9de46f5
+a2ee369f433a570c5bcf673ec5d57f93a57ce54b 977ca5be29771ae6680f3cee3cb420feb186a691
+977ca5be29771ae6680f3cee3cb420feb186a691 9480b4262994433d56ea454f5f942631f4346774
+94a053d0eab42120fb0896f671db5fc1a9de46f5 c28e4b5652ff8d1c9c3a5525a3762034086c9ab6
+c28e4b5652ff8d1c9c3a5525a3762034086c9ab6 f8b993531b45d0022629fd19ca5340dd9c397618
+9480b4262994433d56ea454f5f942631f4346774 9ebad2b30da5317976e8176fc160fccef4c589fb
+9ebad2b30da5317976e8176fc160fccef4c589fb 4aeb75f670ba69c9abd0ad109cc2d5b2ff3033d2
+4aeb75f670ba69c9abd0ad109cc2d5b2ff3033d2 d668d912e4bf2d89acbe50c524f72e4eaec835dd
+d668d912e4bf2d89acbe50c524f72e4eaec835dd c2d166b052fc39a8461a56b46d0ee330893402d0
+c2d166b052fc39a8461a56b46d0ee330893402d0 90452f880b21795692a2ac3d5113aefc5963abba
+f8b993531b45d0022629fd19ca5340dd9c397618 90452f880b21795692a2ac3d5113aefc5963abba
+90452f880b21795692a2ac3d5113aefc5963abba c280060f24e08bbd58a9d8ea941ff3780ede11d1
+c280060f24e08bbd58a9d8ea941ff3780ede11d1 77f61cd330a3ca2373c1d432d05ce087c8fd0db1
+77f61cd330a3ca2373c1d432d05ce087c8fd0db1 9e56800a6942b9cc89cd15a1373c414049393b05
+9e56800a6942b9cc89cd15a1373c414049393b05 01ed63fe8a3016ef61c067400cee73407c1a4d79,14e9c3fb650acaa291b75625bfa4a58f05c8297e
+14e9c3fb650acaa291b75625bfa4a58f05c8297e 01ed63fe8a3016ef61c067400cee73407c1a4d79
+01ed63fe8a3016ef61c067400cee73407c1a4d79 d7e5356bcad6e5622ea68cc039e89e86ba749493
+d7e5356bcad6e5622ea68cc039e89e86ba749493 3f0d1f8803cb6a95353b635c2dfe9c9cc4ef3899
+3f0d1f8803cb6a95353b635c2dfe9c9cc4ef3899 b5ed77d7454aac9d98703f7cd688bf408847c1ee
+b5ed77d7454aac9d98703f7cd688bf408847c1ee 2a86e587bcf4871707cb3aa55ceb44702495b91d
+2a86e587bcf4871707cb3aa55ceb44702495b91d 497953438434d529d1362091a6ee1fbca1ef2ee9
+497953438434d529d1362091a6ee1fbca1ef2ee9 1e9a20f13ab327da684893f312d18f06815f5a77,ae42e0260e2f476bb6c0558e1604d9b812a4b004
+ae42e0260e2f476bb6c0558e1604d9b812a4b004 ae21e2aec14b38a3186f609656779e22eec3a11b
+ae21e2aec14b38a3186f609656779e22eec3a11b 915e74bc332cca88f57964fe501c1d5c05b6e79a
+915e74bc332cca88f57964fe501c1d5c05b6e79a d05d52e7504b851b0932af9d52fbef30e08accca
+d05d52e7504b851b0932af9d52fbef30e08accca 1e9a20f13ab327da684893f312d18f06815f5a77
+1e9a20f13ab327da684893f312d18f06815f5a77 b7bca59fa9703a5a024fc550340524fc591132fc
+b7bca59fa9703a5a024fc550340524fc591132fc f598a7e51ea45ca101f2e89a1b31aa0618a9041e,18868f44fd07e5c73329377c60e946c8c4c4efb5
+f598a7e51ea45ca101f2e89a1b31aa0618a9041e b6ea4f981a526654afe9d6d30d5b462ae3a0cf62
+b6ea4f981a526654afe9d6d30d5b462ae3a0cf62 c57a166878875b960e8051d72eec716c016baf5b
+c57a166878875b960e8051d72eec716c016baf5b f1ae1885662d78efd7bc206352c21a1a974a2c0b
+f1ae1885662d78efd7bc206352c21a1a974a2c0b ab7e6db80c30b830ec8dc016e162f52b2ee7eb94
+ab7e6db80c30b830ec8dc016e162f52b2ee7eb94 6961246ad7afecc990d346b9d2f543b6abb76bf7
+6961246ad7afecc990d346b9d2f543b6abb76bf7 97727e82b875406e51e022fcddc642180f06e675
+97727e82b875406e51e022fcddc642180f06e675 3321c2c52278ba7f8d12aaea3cbc07f6a505fedc
+3321c2c52278ba7f8d12aaea3cbc07f6a505fedc 067b4c3661c6a97f88ff34072107ee601e782183
+067b4c3661c6a97f88ff34072107ee601e782183 cd9d9347c272aa02e2292cc3fa2fd599f53bd2f8
+cd9d9347c272aa02e2292cc3fa2fd599f53bd2f8 64d93529768e368d3dbf59e3da39a1750ab556bb
+64d93529768e368d3dbf59e3da39a1750ab556bb 30b0302862cb860f31ab9ab80e7fc8874e5be1a5
+30b0302862cb860f31ab9ab80e7fc8874e5be1a5 83fad2f941618f4b3efe58a2a40354e7d7f228e9
+83fad2f941618f4b3efe58a2a40354e7d7f228e9 744916ab205a49f31e30a3c215c50b9c1e7ba43c
+744916ab205a49f31e30a3c215c50b9c1e7ba43c 8a292192e55474a928883137244d11ff852ac2f5
+8a292192e55474a928883137244d11ff852ac2f5 d2b6ddbe9c4dc205ed92955daceae90b976399e4
+d2b6ddbe9c4dc205ed92955daceae90b976399e4 794d62eebe3a2bb8dc687152712f02804c76714e
+794d62eebe3a2bb8dc687152712f02804c76714e 856838e0f017591c07fa91f41cdca3423710d1a1
+856838e0f017591c07fa91f41cdca3423710d1a1 6f2b3e137f04276d578b367adf5b8ef4b1b75e7a
+6f2b3e137f04276d578b367adf5b8ef4b1b75e7a f37121f8b18ab9076f299c55249a5f4a5ce83602,fde3dc46b70e5b82c514fe2af4c02cc0c6c8cf78
+fde3dc46b70e5b82c514fe2af4c02cc0c6c8cf78 504c555d5a09ab502c55ef8f6eba884ae8090421
+504c555d5a09ab502c55ef8f6eba884ae8090421 0179214de8763308df414fdd8c25174c2c4d1ac6
+0179214de8763308df414fdd8c25174c2c4d1ac6 237a19178bf7b962c419090447ed12b093f98031
+237a19178bf7b962c419090447ed12b093f98031 be9acfd8edc953fd7c1a27df479f5dcb22d3d023
+be9acfd8edc953fd7c1a27df479f5dcb22d3d023 6b11655edddb7fe8219566adf05a7313cd3f3a52
+f37121f8b18ab9076f299c55249a5f4a5ce83602 3271143f7080ffd0be43286f513b58200a6bde42
+6b11655edddb7fe8219566adf05a7313cd3f3a52 fe0ca9de59f0dd99b5fb45340b42bc2884b263f6
+3271143f7080ffd0be43286f513b58200a6bde42 fe0ca9de59f0dd99b5fb45340b42bc2884b263f6
+ee563960f8474b8b2d6ef1d964ce55be449caa94 fe0ca9de59f0dd99b5fb45340b42bc2884b263f6
+fe0ca9de59f0dd99b5fb45340b42bc2884b263f6 114eed176f7dc84e70c567f7a20d59093bed7105,e4b276aa24aa86724ac0cd824a7227881519c126,ece2bfcae2b3897da82c44c8371486191f1e8c10
+114eed176f7dc84e70c567f7a20d59093bed7105 a8cb71c532ecef1e04cc0090d7bbc9953f673362
+a8cb71c532ecef1e04cc0090d7bbc9953f673362 b79b86ca4b2865063eac92cbdee0fbb37c5f0743
+b79b86ca4b2865063eac92cbdee0fbb37c5f0743 de8934622a88ef3efcae29b44871ffbbbaff4753
+de8934622a88ef3efcae29b44871ffbbbaff4753 08a3d6e3440b4221f4191377a95795e408e90962
+08a3d6e3440b4221f4191377a95795e408e90962 6275b9b5c591725e9d838cfb0d9a69a676cfb736
+0fe0deb19435d23d4b71a8b359dcaf38963b7e2e ece2bfcae2b3897da82c44c8371486191f1e8c10
+ece2bfcae2b3897da82c44c8371486191f1e8c10 776745031ae77aa2af8cafe7d4f6084780499182
+776745031ae77aa2af8cafe7d4f6084780499182 3d4ae9e02e2e680af484d3072dd52945b6c5b83f
+3d4ae9e02e2e680af484d3072dd52945b6c5b83f c460b80adbd94283479a317a59632e9ccf4600ce
+c460b80adbd94283479a317a59632e9ccf4600ce 6275b9b5c591725e9d838cfb0d9a69a676cfb736,0b61bcfc94a82dde32ed899aaebf16a055aa4de9
+6275b9b5c591725e9d838cfb0d9a69a676cfb736 aaa37a7f4af579627ee26c512e13e995f0d0f777,5be250d6fc1102b29d0529bc344ab2f604b9e71f
+aaa37a7f4af579627ee26c512e13e995f0d0f777 bfb563fbe2b0771d55b0f58de88c52b0e65e5157
+bfb563fbe2b0771d55b0f58de88c52b0e65e5157 ba67d062aed155feb5898ba14710bb9373576d44
+0b61bcfc94a82dde32ed899aaebf16a055aa4de9 ba67d062aed155feb5898ba14710bb9373576d44
+ba67d062aed155feb5898ba14710bb9373576d44 93728683855435e098dd85c5865dc9d5394358d5
+93728683855435e098dd85c5865dc9d5394358d5 e4718cf7ed770ae44fa1f433204f0313d2a82fef
+e4b276aa24aa86724ac0cd824a7227881519c126 b711d2b4301cad9eb2d600792480c8365193e2a1
+b711d2b4301cad9eb2d600792480c8365193e2a1 e4718cf7ed770ae44fa1f433204f0313d2a82fef
+e4718cf7ed770ae44fa1f433204f0313d2a82fef 87b98ca112fd8143b05ee24c80ab6734d0eca45a
+87b98ca112fd8143b05ee24c80ab6734d0eca45a 9f03d93cddf2c7503c53eb639fe66d37cefb6a9b
+9f03d93cddf2c7503c53eb639fe66d37cefb6a9b 8b52109594c7f506182eb0cf780a8e30d7605ab7
+8b52109594c7f506182eb0cf780a8e30d7605ab7 a630d7090cea3b1b4eb0b760d16b11506f8a59b6
+a630d7090cea3b1b4eb0b760d16b11506f8a59b6 4432b3c8fa5e5205e70b2195ff3869f1ebee18a5
+4432b3c8fa5e5205e70b2195ff3869f1ebee18a5 441e299543e0f819da8d988de6f36e5f593b5582
+441e299543e0f819da8d988de6f36e5f593b5582 c8b69bc77f121376922659f8a45b85026798313c
+c8b69bc77f121376922659f8a45b85026798313c a354b5c1cb82ccca2e2ad6ccbe161f88e2e5f0d4
+a354b5c1cb82ccca2e2ad6ccbe161f88e2e5f0d4 68d79bff21bb8edebbe644e4ce83279bf1c680b8
+68d79bff21bb8edebbe644e4ce83279bf1c680b8 8de562aa651be4ca133a38bc798c05e5e5d9ac4c
+8de562aa651be4ca133a38bc798c05e5e5d9ac4c 39718da514fa680d3b36220f278ded94fb864a8f
+39718da514fa680d3b36220f278ded94fb864a8f 2e121e3655c16a333eaafabdf3d9a9be0979a99e
+2e121e3655c16a333eaafabdf3d9a9be0979a99e a91345f8e232d8d120a1ba2a6959cf9b3009edaf,70391eee14574b70d75f91f6a7ba24fd0ffd93df
+a91345f8e232d8d120a1ba2a6959cf9b3009edaf 596110698ae00ddcb774e58070f12f35f67b00ab
+596110698ae00ddcb774e58070f12f35f67b00ab 7953e9dc317d38b0b7596c1249c2251c5a8528e4
+7953e9dc317d38b0b7596c1249c2251c5a8528e4 4a97fe2a81a0aa10a8bec8e6dea7189f6f3f4dc4
+18db59ea626c5bcfe6cad451022a7a369e40fa10 4a97fe2a81a0aa10a8bec8e6dea7189f6f3f4dc4
+4a97fe2a81a0aa10a8bec8e6dea7189f6f3f4dc4 7cb9fcca308241b8ee47ac03fbe225f34e4eab44
+7cb9fcca308241b8ee47ac03fbe225f34e4eab44 dabd344efb93270ef258726f7870d4485d334add
+dabd344efb93270ef258726f7870d4485d334add c0aef352366ca03fc684a04a26af9123a2d7f403
+c0aef352366ca03fc684a04a26af9123a2d7f403 3eb427f66fab067982a1525785b6035db89f8fc3
+3eb427f66fab067982a1525785b6035db89f8fc3 25d7ed4419d1f50254f6b4f42dd78938ac4e5d1e
+25d7ed4419d1f50254f6b4f42dd78938ac4e5d1e b5369b3646723455d85a19efde21b54b20f99b27,c60797615037705d285c62bb15b4ff38efa77d1a
+b5369b3646723455d85a19efde21b54b20f99b27 2f99cf9da6268db580aa2046abcc7a4a70644887,55cc440b5e3701841011542eabd752945e529082
+2f99cf9da6268db580aa2046abcc7a4a70644887 c0aaf523c6e77bd3dc079a00b5e34a1584863a8a,3944bdfd6a0741fdd3fdf41c8e6ce4d3c124af66
+c0aaf523c6e77bd3dc079a00b5e34a1584863a8a 5824d18b655397fe0c5d316c228a886f70ec7e9c,a399f30afdaeb5b0b247b3cfdef05300c6f3803f
+5824d18b655397fe0c5d316c228a886f70ec7e9c b054d488904c1db742d4d491a17a2fc7cd287b9e
+b054d488904c1db742d4d491a17a2fc7cd287b9e 5fe44e93934b015546033d33ecbff9f3fbec8e9f,621d3c2ef213a43cad70eb978b3308a4c3e0595e
+5fe44e93934b015546033d33ecbff9f3fbec8e9f b2ea6646eb94c43ebcbb98463157dcd38c1eac50
+b2ea6646eb94c43ebcbb98463157dcd38c1eac50 52d24fd4b2ee1236eb33e6f58ebba63f6af9ba79
+52d24fd4b2ee1236eb33e6f58ebba63f6af9ba79 244e676ac0b0e386d7620794d23806c13bca9113
+244e676ac0b0e386d7620794d23806c13bca9113 b6bf1dd82ba9dedbbbd963c379960f46a2555df0
+2abfcad6eb95acc73472061251b4d9fbb897c989 b6bf1dd82ba9dedbbbd963c379960f46a2555df0
+b6bf1dd82ba9dedbbbd963c379960f46a2555df0 0f8fa0be12ccac493e1d7d6be25ddcc7cb16a18e,456c27dbc63c1fd70ae48de899833c5ca02e6e32
+456c27dbc63c1fd70ae48de899833c5ca02e6e32 9f5f817c0ed579f0a3a7f3ba3a391403f6ee37bc
+9f5f817c0ed579f0a3a7f3ba3a391403f6ee37bc 624ddf95e6b54a943a644c0b5e785c990880999f,0f8fa0be12ccac493e1d7d6be25ddcc7cb16a18e
+624ddf95e6b54a943a644c0b5e785c990880999f 9a750784a33ab9d714cdc68949906610f76cb964
+9a750784a33ab9d714cdc68949906610f76cb964 0706805720a141819654f6446f832416b5c551a4
+0f8fa0be12ccac493e1d7d6be25ddcc7cb16a18e 6f42a208581102d3679d23617d936fa9f3c2225a,6789a2c68486802961334f34c07e8e881261e54c
+6789a2c68486802961334f34c07e8e881261e54c a01342192b8f798b5700d48b060a927a1714d636,6f42a208581102d3679d23617d936fa9f3c2225a
+6f42a208581102d3679d23617d936fa9f3c2225a 9e070b3017644c5621ea48c2beae202be4232c84,f1f17cc9c784db6de2905ed1374879c7524ba376
+0706805720a141819654f6446f832416b5c551a4 92c8226782546e3086fef83d361cf2cc866a9ec1
+9e070b3017644c5621ea48c2beae202be4232c84 92c8226782546e3086fef83d361cf2cc866a9ec1,849b4de9ea7d0cdf1fe4006709ee7072f2d13e23
+92c8226782546e3086fef83d361cf2cc866a9ec1 170a77e923c53908caff93faf855b22cf871cf6a
+170a77e923c53908caff93faf855b22cf871cf6a a533b6fa408fd80356242171e2f827a449ea3812
+a533b6fa408fd80356242171e2f827a449ea3812 0ae58081efbb1cc9fc7b20368d9c1208972e767b
+0ae58081efbb1cc9fc7b20368d9c1208972e767b 77620de737b78f85f7b30f7e298428ddd67bd928
+77620de737b78f85f7b30f7e298428ddd67bd928 b95f77dc672b96ded94aa1392769abcdd8eb2470
+b95f77dc672b96ded94aa1392769abcdd8eb2470 9d5efca0bda7c6edb3936805bfb5cd7ae32126dd
+9d5efca0bda7c6edb3936805bfb5cd7ae32126dd 703316903c43fb0ee8b445fb4811262fc937968e
+703316903c43fb0ee8b445fb4811262fc937968e d5ab33bd7c48cc126fb4ef8f086a6d862df59ef5
+d5ab33bd7c48cc126fb4ef8f086a6d862df59ef5 57fdf136efcbda786125e07951d6f8a8b7d14592
+57fdf136efcbda786125e07951d6f8a8b7d14592 1b76773ad44f3180d8d0dc4e77dc3b50485aa05d
+1b76773ad44f3180d8d0dc4e77dc3b50485aa05d 37803689fe1e764cb95508dad401f34972f73179
+37803689fe1e764cb95508dad401f34972f73179 0d58b5f4ddb056a6c8cb2350292d118696aa63b0,f8bf61270c28add4f64ab7d4bc9767a21f18e831
+0d58b5f4ddb056a6c8cb2350292d118696aa63b0 76b4277ddca72719e1ce0692c44b8907085f9791
+76b4277ddca72719e1ce0692c44b8907085f9791 67151b5753c7819309760ac097aaed33d74e2f93,23745b43026065c5ec6a3d61b964e1d65659036a
+67151b5753c7819309760ac097aaed33d74e2f93 a9bdb539385321ec79cace958a816d397b6625c7,43341d56e0f80c10302563c5773d8ed4c2f9f420
+a9bdb539385321ec79cace958a816d397b6625c7 5c94f3c9196e51913a0b8516423c95a1cca43362
+68a6b805c52f5da6ce3a5c58df25270c2045ab32 adc89fda393154699c1712a5d8869184419dd798
+5c94f3c9196e51913a0b8516423c95a1cca43362 c3d314c7c50116890ecf8cb6155c6ca7b9f711ef
+c3d314c7c50116890ecf8cb6155c6ca7b9f711ef 25f400c8f88eaddd0ca48c63e6e3f0791cc9f21a
+25f400c8f88eaddd0ca48c63e6e3f0791cc9f21a 8a40b211a4197f5016f1497240761123a7523fb2
+8a40b211a4197f5016f1497240761123a7523fb2 a1dbd06515099561a77523765ad303e23051b456
+a1dbd06515099561a77523765ad303e23051b456 2f03232e1d7998dd77f1e118585ba2e1420304e8,5464c15055afb0cf2627838a18d92f1081c7b066
+2f03232e1d7998dd77f1e118585ba2e1420304e8 a5ed8f0caaed7d6b63ad93abc1dddeb45a27fb8e
+a5ed8f0caaed7d6b63ad93abc1dddeb45a27fb8e 2120db9cffa7487197f01bf528fdb79c5319d0c9,2f6825c738be3a9d276e65d43975278ba174d9b5
+2120db9cffa7487197f01bf528fdb79c5319d0c9 10b99d180db996c6f438191e7521b7c39826979b,32584d6c1d9d8af3873babb0d356e8400c9582c0
+10b99d180db996c6f438191e7521b7c39826979b bcfb084eb25a7124496664afc5c48df85d85e838
+bcfb084eb25a7124496664afc5c48df85d85e838 82bd7da1b39153c0429fb36653a21994150420c1
+82bd7da1b39153c0429fb36653a21994150420c1 900f227fc0add02b87b86d8c509242eff7a6c264,2890f3b6933eb96b4f338b85524ab4562abda157
+900f227fc0add02b87b86d8c509242eff7a6c264 eac8148602a78ff2819b562f63e09679f24b4cbf
+eac8148602a78ff2819b562f63e09679f24b4cbf 841b30b8c962d535454b80a8e0bb5d4161225699
+841b30b8c962d535454b80a8e0bb5d4161225699 277cc86ec7d1921574b6fdc40e5af33efd1d27d4
+277cc86ec7d1921574b6fdc40e5af33efd1d27d4 69ed787cf98b13e1c6b9031871fbe5fe88284bd3
+69ed787cf98b13e1c6b9031871fbe5fe88284bd3 1bf5c0bd2017622e9d5cad94683a7f00b3a7985d,a692915fb36b1f34dabf71452af63e04c91be209
+1bf5c0bd2017622e9d5cad94683a7f00b3a7985d d823b9ddaeb9c1f2dfe6e1e914337bd0543357ae,cd95146b0abcec1cd52629d80db969fdd27fa303
+d823b9ddaeb9c1f2dfe6e1e914337bd0543357ae 5148b5915f997c933f63570bdff8461f1aa7278e
+5148b5915f997c933f63570bdff8461f1aa7278e a6afe6e1d7adba44262416bd4931e54f70b479d8,1c79e4a8344be1d5d9a293a542fc057aa524c50d
+a6afe6e1d7adba44262416bd4931e54f70b479d8 fc84397e48939f77d2f783eb85143bd9db674e1a
+fc84397e48939f77d2f783eb85143bd9db674e1a 20865cc9cf5470ee39ab9e99ef6a853233a9ca2a,e821f056086d11d0a8ff2fa6ae58f5a44678f707
+20865cc9cf5470ee39ab9e99ef6a853233a9ca2a ddc112387c36d1c270004bc9458b3cd3d6749ce9
+ddc112387c36d1c270004bc9458b3cd3d6749ce9 6a182939795451cf6d3817c41c343ecf905e831c
+6a182939795451cf6d3817c41c343ecf905e831c c269abcad799c19d0488a098ad3a861256e4aaac
+c269abcad799c19d0488a098ad3a861256e4aaac 2a906e05b06fa45908f2cf37b416649fecf09b7e,85fa0e2f1429aadd858971eec1a3798867a5112e
+2a906e05b06fa45908f2cf37b416649fecf09b7e 346da738c4dd3e54fc827b42ca65790e22239c23,d806a4bc7493caf7d6ac3d447ec476eb4ce428fd
+24a725dc99507e55283f453f7b5ca7d8e70be52f 3766f8e4ea2efd1e01520e99d4e5bf2885c302c4,346da738c4dd3e54fc827b42ca65790e22239c23
+7b2c89a42fa0a68561aee72886a479db368d713b fa65768bcc90fec0ddaf912d92a6bda4d06b3f61,346da738c4dd3e54fc827b42ca65790e22239c23
+aca1299f55bdb0844095f98de9c4a2008eac6ad0 a16fc0d2d04199c1d6664bc80706f165dc915d39,346da738c4dd3e54fc827b42ca65790e22239c23
+346da738c4dd3e54fc827b42ca65790e22239c23 b960ebe7d03d215353778093773b8ce3bcc9fb27,eaf721a3d3f690dc5766dca97c05ee8f779f828b
+5464c15055afb0cf2627838a18d92f1081c7b066 259631117742cbc4a691f43bc3ce278082455ab1,39bde846fc3cee61a8ca81872ddde83253f48925
+b960ebe7d03d215353778093773b8ce3bcc9fb27 259631117742cbc4a691f43bc3ce278082455ab1,03e6b6ae8854c6f585f3e82553dfc5311e49f53e
+259631117742cbc4a691f43bc3ce278082455ab1 cdbe742d201adb616cba467563fb2bfb524dd16a
+cdbe742d201adb616cba467563fb2bfb524dd16a d7af4dd892b8a48a5107c4bf871d5d25f63e8511
+d7af4dd892b8a48a5107c4bf871d5d25f63e8511 614169b1acb86b21b562f807a6b54aa164d4056a
+614169b1acb86b21b562f807a6b54aa164d4056a 7e269b22b6070768ce18c0b81d7b802662b2b6ed
+7e269b22b6070768ce18c0b81d7b802662b2b6ed 7d703fee73ee850af7325ac7e4eebb6514c2757e
+7d703fee73ee850af7325ac7e4eebb6514c2757e 6b673d12166ae1a5729aa517bdfd2e8ad974170e
+6b673d12166ae1a5729aa517bdfd2e8ad974170e edc83414c9a7955c8f874c2fed261d8e1ae2eb91
+edc83414c9a7955c8f874c2fed261d8e1ae2eb91 17f63f989af77ffcca34d142b8ef5c210323e098
+17f63f989af77ffcca34d142b8ef5c210323e098 958206e68abbb9bb2cc76256ab3202363678e61f,06a1cb9d9b23aadc5231cbb188b2fac1003fbe28
+958206e68abbb9bb2cc76256ab3202363678e61f da26ce8d3cc378e9e0d8246540197575428132f9
+da26ce8d3cc378e9e0d8246540197575428132f9 aeabc7304c582c9a58e6098443430cbd2b323616
+aeabc7304c582c9a58e6098443430cbd2b323616 6efedc27d5e08a15fb9501ad32c257738c48334e
+6efedc27d5e08a15fb9501ad32c257738c48334e 3a9471a6ea20a92b57325b0c56448d3e313a1d1a,1eb7abcd285650928a22eb81185a63d36b1b2cba
+3a9471a6ea20a92b57325b0c56448d3e313a1d1a 6aa0069d074711085d57def494f56ddeb65a7551,6129574e1588a0cf30d5d0762a8cf49a9ebb5585
+6aa0069d074711085d57def494f56ddeb65a7551 704e7039441ea5383545da405e3b5f4cf01077c3,b0c45c85fe85689c0c59660a15e3476340b6819a
+704e7039441ea5383545da405e3b5f4cf01077c3 b44a2afd2a47a63d510b1d4b7d58cdf5fc13b65d
+b0c45c85fe85689c0c59660a15e3476340b6819a 8a26c9c9d71007dad93508ff17c5971ff7dc13b3
+8a26c9c9d71007dad93508ff17c5971ff7dc13b3 b44a2afd2a47a63d510b1d4b7d58cdf5fc13b65d,8528e93d3ce01d0b8b209c599ab261aa1987a108
+b44a2afd2a47a63d510b1d4b7d58cdf5fc13b65d 8bb5134286f52a3dbb1979de5bee25d7460b3c36,09c716a4e30e8744365c158619b44006fbf6d3b6
+fa65768bcc90fec0ddaf912d92a6bda4d06b3f61 bb194efe1821622d96c8c43d2a4c9de17e800391,8bb5134286f52a3dbb1979de5bee25d7460b3c36
+a01342192b8f798b5700d48b060a927a1714d636 bbe5c643c42223f97c8914ba3cd26b3c8d2c5030,8bb5134286f52a3dbb1979de5bee25d7460b3c36
+8bb5134286f52a3dbb1979de5bee25d7460b3c36 cb8d623593567f34e3fbf89a1b640cdb7b1eda75,2fae4888f332dfba920901c5afaf9ac448ca89c9
+cb8d623593567f34e3fbf89a1b640cdb7b1eda75 c31a46930cee2835641e43171f6c3f8800da3ae8,e71001dca11670f6e468d5b3c05c78292a748834
+c31a46930cee2835641e43171f6c3f8800da3ae8 90059ea0179772a7d296a382bb3c94865003c33e,dec8d412cdcc82e55fd516b1b1a874f290e7a806
+90059ea0179772a7d296a382bb3c94865003c33e 07eda936ba952eb3255eca4e2cbc00d49c3fd831,a2b3efa030a54e6cfb6c6736fca7e1e27d07cd15
+07eda936ba952eb3255eca4e2cbc00d49c3fd831 0ac98cae0481794557025cd5002aa2508d5347b6
+0ac98cae0481794557025cd5002aa2508d5347b6 fdfd424b83ec718a8cf74f38b01d8f1005e01faa,50414b8e0e67e191f1ae38bde54e30189de97b34
+fdfd424b83ec718a8cf74f38b01d8f1005e01faa 0cadfc4182b8bb43635020f393f5cdd6578b7cfd
+0cadfc4182b8bb43635020f393f5cdd6578b7cfd dcf421dabda2384d57913343e73dd01688eb4dcf
+dcf421dabda2384d57913343e73dd01688eb4dcf 82e28e89e54c198a6aa3c6435b5b32eec05ed65f
+82e28e89e54c198a6aa3c6435b5b32eec05ed65f 657b6ecb353c1f5b0b91d2d5161aff9063af3fb0
+657b6ecb353c1f5b0b91d2d5161aff9063af3fb0 afa3279d3b6cb8913ba3d6eed8e635f66fa59d8e,30dc6100056269e9d384711478be9dd1bd744ddf
+afa3279d3b6cb8913ba3d6eed8e635f66fa59d8e 4485968e237121d19cce63d18312987c84f0860e,599461b731bbb3081f49dcd72c356695da4bf483
+4485968e237121d19cce63d18312987c84f0860e 21dd573ab7ab0a63d35c0df07df08dae8b19bb16,08a1393c61b3c6d2ee96a35b52ae945806d0299e
+21dd573ab7ab0a63d35c0df07df08dae8b19bb16 66eb2de9fa18125906e5d13abf52705839c9d088,3129220de08efe91135e7b1256772167e0dcdf15
+66eb2de9fa18125906e5d13abf52705839c9d088 fc9432d5a51c65f1716cf0ba20b1e693ccd2edce,5941191cd2682ef374df3afeebc0ae9d242162db
+fc9432d5a51c65f1716cf0ba20b1e693ccd2edce f72fea4b3bc98ca7ab186eacce57b3dfd2557032
+f72fea4b3bc98ca7ab186eacce57b3dfd2557032 ade6384a7b0e4d065e18076ffa901e580679e26d,dd090afbe47f0aa25d6ec8cfe484fa02c23eb61a

ADDED   fossil-utils/justtesting/setup.dat
Index: fossil-utils/justtesting/setup.dat
==================================================================
--- /dev/null
+++ fossil-utils/justtesting/setup.dat
@@ -0,0 +1,9 @@
+[command]
+0 rm -rf /tmp/$USER/megatest
+1 mkdir -p /tmp/$USER/megatest
+2 cp /home/matt/fossils/megatest.fossil /tmp/$USER/megatest
+3 cd /tmp/$USER/megatest
+4 fossil open megatest.fossil;fossil up trunk
+5 fossil set autosync 0
+7 fossil set gmerge ''
+8 fossil scrub --private --force

ADDED   fossil-utils/justtesting/sheet-names.cfg
Index: fossil-utils/justtesting/sheet-names.cfg
==================================================================
--- /dev/null
+++ fossil-utils/justtesting/sheet-names.cfg
@@ -0,0 +1,4 @@
+timeline
+extra
+branches
+setup

ADDED   fossil-utils/justtesting/sxml/_sheets.sxml
Index: fossil-utils/justtesting/sxml/_sheets.sxml
==================================================================
--- /dev/null
+++ fossil-utils/justtesting/sxml/_sheets.sxml
@@ -0,0 +1,69 @@
+((@ (http://www.w3.org/2001/XMLSchema-instance:schemaLocation
+      "http://www.gnumeric.org/v9.xsd"))
+ (http://www.gnumeric.org/v10.dtd:Version
+   (@ (Minor "17")
+      (Major "10")
+      (Full "1.10.17")
+      (Epoch "1")))
+ (http://www.gnumeric.org/v10.dtd:Attributes
+   (http://www.gnumeric.org/v10.dtd:Attribute
+     (http://www.gnumeric.org/v10.dtd:type "4")
+     (http://www.gnumeric.org/v10.dtd:name
+       "WorkbookView::show_horizontal_scrollbar")
+     (http://www.gnumeric.org/v10.dtd:value "TRUE"))
+   (http://www.gnumeric.org/v10.dtd:Attribute
+     (http://www.gnumeric.org/v10.dtd:type "4")
+     (http://www.gnumeric.org/v10.dtd:name
+       "WorkbookView::show_vertical_scrollbar")
+     (http://www.gnumeric.org/v10.dtd:value "TRUE"))
+   (http://www.gnumeric.org/v10.dtd:Attribute
+     (http://www.gnumeric.org/v10.dtd:type "4")
+     (http://www.gnumeric.org/v10.dtd:name
+       "WorkbookView::show_notebook_tabs")
+     (http://www.gnumeric.org/v10.dtd:value "TRUE"))
+   (http://www.gnumeric.org/v10.dtd:Attribute
+     (http://www.gnumeric.org/v10.dtd:type "4")
+     (http://www.gnumeric.org/v10.dtd:name
+       "WorkbookView::do_auto_completion")
+     (http://www.gnumeric.org/v10.dtd:value "TRUE"))
+   (http://www.gnumeric.org/v10.dtd:Attribute
+     (http://www.gnumeric.org/v10.dtd:type "4")
+     (http://www.gnumeric.org/v10.dtd:name
+       "WorkbookView::is_protected")
+     (http://www.gnumeric.org/v10.dtd:value "FALSE")))
+ (urn:oasis:names:tc:opendocument:xmlns:office:1.0:document-meta
+   (@ (urn:oasis:names:tc:opendocument:xmlns:office:1.0:version
+        "1.2"))
+   (urn:oasis:names:tc:opendocument:xmlns:office:1.0:meta
+     (http://purl.org/dc/elements/1.1/:date
+       "2020-06-01T04:28:18Z")
+     (urn:oasis:names:tc:opendocument:xmlns:meta:1.0:creation-date
+       "2020-06-01T01:13:31Z")))
+ (http://www.gnumeric.org/v10.dtd:Calculation
+   (@ (MaxIterations "100")
+      (ManualRecalc "0")
+      (IterationTolerance "0.001")
+      (FloatRadix "2")
+      (FloatDigits "53")
+      (EnableIteration "1")))
+ (http://www.gnumeric.org/v10.dtd:SheetNameIndex
+   (http://www.gnumeric.org/v10.dtd:SheetName
+     (@ (http://www.gnumeric.org/v10.dtd:Rows "65536")
+        (http://www.gnumeric.org/v10.dtd:Cols "256"))
+     "timeline")
+   (http://www.gnumeric.org/v10.dtd:SheetName
+     (@ (http://www.gnumeric.org/v10.dtd:Rows "65536")
+        (http://www.gnumeric.org/v10.dtd:Cols "256"))
+     "extra")
+   (http://www.gnumeric.org/v10.dtd:SheetName
+     (@ (http://www.gnumeric.org/v10.dtd:Rows "65536")
+        (http://www.gnumeric.org/v10.dtd:Cols "256"))
+     "branches")
+   (http://www.gnumeric.org/v10.dtd:SheetName
+     (@ (http://www.gnumeric.org/v10.dtd:Rows "65536")
+        (http://www.gnumeric.org/v10.dtd:Cols "256"))
+     "setup"))
+ (http://www.gnumeric.org/v10.dtd:Geometry
+   (@ (Width "2220") (Height "804")))
+ (http://www.gnumeric.org/v10.dtd:UIData
+   (@ (SelectedTab "0"))))

ADDED   fossil-utils/justtesting/sxml/_workbook.sxml
Index: fossil-utils/justtesting/sxml/_workbook.sxml
==================================================================
--- /dev/null
+++ fossil-utils/justtesting/sxml/_workbook.sxml
@@ -0,0 +1,1 @@
+(*TOP* (*PI* xml "version=\"1.0\" encoding=\"UTF-8\""))

ADDED   fossil-utils/justtesting/sxml/branches.sxml
Index: fossil-utils/justtesting/sxml/branches.sxml
==================================================================
--- /dev/null
+++ fossil-utils/justtesting/sxml/branches.sxml
@@ -0,0 +1,135 @@
+(http://www.gnumeric.org/v10.dtd:Sheet
+  (@ (Visibility "GNM_SHEET_VISIBILITY_VISIBLE")
+     (OutlineSymbolsRight "1")
+     (OutlineSymbolsBelow "1")
+     (HideZero "0")
+     (HideRowHeader "0")
+     (HideGrid "0")
+     (HideColHeader "0")
+     (GridColor "0:0:0")
+     (DisplayOutlines "1")
+     (DisplayFormulas "0"))
+  (http://www.gnumeric.org/v10.dtd:MaxCol "8")
+  (http://www.gnumeric.org/v10.dtd:MaxRow "16")
+  (http://www.gnumeric.org/v10.dtd:Zoom "1")
+  (http://www.gnumeric.org/v10.dtd:Names
+    (http://www.gnumeric.org/v10.dtd:Name
+      (http://www.gnumeric.org/v10.dtd:name
+        "Print_Area")
+      (http://www.gnumeric.org/v10.dtd:value "#REF!")
+      (http://www.gnumeric.org/v10.dtd:position "A1"))
+    (http://www.gnumeric.org/v10.dtd:Name
+      (http://www.gnumeric.org/v10.dtd:name
+        "Sheet_Title")
+      (http://www.gnumeric.org/v10.dtd:value
+        "\"First_Sheet\"")
+      (http://www.gnumeric.org/v10.dtd:position "A1")))
+  (http://www.gnumeric.org/v10.dtd:PrintInformation
+    (http://www.gnumeric.org/v10.dtd:Margins
+      (http://www.gnumeric.org/v10.dtd:top
+        (@ (PrefUnit "mm") (Points "93.26")))
+      (http://www.gnumeric.org/v10.dtd:bottom
+        (@ (PrefUnit "mm") (Points "93.26")))
+      (http://www.gnumeric.org/v10.dtd:left
+        (@ (PrefUnit "mm") (Points "72")))
+      (http://www.gnumeric.org/v10.dtd:right
+        (@ (PrefUnit "mm") (Points "72")))
+      (http://www.gnumeric.org/v10.dtd:header
+        (@ (PrefUnit "mm") (Points "72")))
+      (http://www.gnumeric.org/v10.dtd:footer
+        (@ (PrefUnit "mm") (Points "72"))))
+    (http://www.gnumeric.org/v10.dtd:Scale
+      (@ (type "percentage") (percentage "100")))
+    (http://www.gnumeric.org/v10.dtd:vcenter
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:hcenter
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:grid
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:even_if_only_styles
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:monochrome
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:draft
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:titles
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:do_not_print
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:print_range
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:order
+      "d_then_r")
+    (http://www.gnumeric.org/v10.dtd:orientation
+      "portrait")
+    (http://www.gnumeric.org/v10.dtd:Header
+      (@ (Right "") (Middle "&[tab]") (Left "")))
+    (http://www.gnumeric.org/v10.dtd:Footer
+      (@ (Right "") (Middle "&[page]") (Left "")))
+    (http://www.gnumeric.org/v10.dtd:paper
+      "na_letter")
+    (http://www.gnumeric.org/v10.dtd:comments "none")
+    (http://www.gnumeric.org/v10.dtd:errors
+      "as_displayed"))
+  (http://www.gnumeric.org/v10.dtd:Styles
+    (http://www.gnumeric.org/v10.dtd:StyleRegion
+      (@ (startRow "0")
+         (startCol "0")
+         (endRow "65535")
+         (endCol "255"))
+      (http://www.gnumeric.org/v10.dtd:Style
+        (@ (WrapText "0")
+           (VAlign "2")
+           (ShrinkToFit "0")
+           (Shade "0")
+           (Rotation "0")
+           (PatternColor "0:0:0")
+           (Locked "1")
+           (Indent "0")
+           (Hidden "0")
+           (HAlign "1")
+           (Format "General")
+           (Fore "0:0:0")
+           (Back "FFFF:FFFF:FFFF"))
+        (http://www.gnumeric.org/v10.dtd:Font
+          (@ (Unit "10")
+             (Underline "0")
+             (StrikeThrough "0")
+             (Script "0")
+             (Italic "0")
+             (Bold "0"))
+          "Sans"))))
+  (http://www.gnumeric.org/v10.dtd:Cols
+    (@ (DefaultSizePts "48"))
+    (http://www.gnumeric.org/v10.dtd:ColInfo
+      (@ (Unit "95.25") (No "0")))
+    (http://www.gnumeric.org/v10.dtd:ColInfo
+      (@ (Unit "99") (No "1") (HardSize "1")))
+    (http://www.gnumeric.org/v10.dtd:ColInfo
+      (@ (Unit "64.01") (No "2") (Count "7"))))
+  (http://www.gnumeric.org/v10.dtd:Rows
+    (@ (DefaultSizePts "12.1"))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "12.64") (No "0")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "13.5") (No "1") (Count "16"))))
+  (http://www.gnumeric.org/v10.dtd:Selections
+    (@ (CursorRow "2") (CursorCol "1"))
+    (http://www.gnumeric.org/v10.dtd:Selection
+      (@ (startRow "2")
+         (startCol "1")
+         (endRow "2")
+         (endCol "1"))))
+  (http://www.gnumeric.org/v10.dtd:SheetLayout
+    (@ (TopLeft "A2"))
+    (http://www.gnumeric.org/v10.dtd:FreezePanes
+      (@ (UnfrozenTopLeft "A2") (FrozenTopLeft "A1"))))
+  (http://www.gnumeric.org/v10.dtd:Solver
+    (@ (ProgramR "0")
+       (ProblemType "0")
+       (NonNeg "1")
+       (ModelType "0")
+       (MaxTime "60")
+       (MaxIter "1000")
+       (Discr "0")
+       (AutoScale "0"))))

ADDED   fossil-utils/justtesting/sxml/extra.sxml
Index: fossil-utils/justtesting/sxml/extra.sxml
==================================================================
--- /dev/null
+++ fossil-utils/justtesting/sxml/extra.sxml
@@ -0,0 +1,137 @@
+(http://www.gnumeric.org/v10.dtd:Sheet
+  (@ (Visibility "GNM_SHEET_VISIBILITY_VISIBLE")
+     (OutlineSymbolsRight "1")
+     (OutlineSymbolsBelow "1")
+     (HideZero "0")
+     (HideRowHeader "0")
+     (HideGrid "0")
+     (HideColHeader "0")
+     (GridColor "0:0:0")
+     (DisplayOutlines "1")
+     (DisplayFormulas "0"))
+  (http://www.gnumeric.org/v10.dtd:MaxCol "8")
+  (http://www.gnumeric.org/v10.dtd:MaxRow "722")
+  (http://www.gnumeric.org/v10.dtd:Zoom "1")
+  (http://www.gnumeric.org/v10.dtd:Names
+    (http://www.gnumeric.org/v10.dtd:Name
+      (http://www.gnumeric.org/v10.dtd:name
+        "Print_Area")
+      (http://www.gnumeric.org/v10.dtd:value "#REF!")
+      (http://www.gnumeric.org/v10.dtd:position "A1"))
+    (http://www.gnumeric.org/v10.dtd:Name
+      (http://www.gnumeric.org/v10.dtd:name
+        "Sheet_Title")
+      (http://www.gnumeric.org/v10.dtd:value
+        "\"First_Sheet\"")
+      (http://www.gnumeric.org/v10.dtd:position "A1")))
+  (http://www.gnumeric.org/v10.dtd:PrintInformation
+    (http://www.gnumeric.org/v10.dtd:Margins
+      (http://www.gnumeric.org/v10.dtd:top
+        (@ (PrefUnit "mm") (Points "93.26")))
+      (http://www.gnumeric.org/v10.dtd:bottom
+        (@ (PrefUnit "mm") (Points "93.26")))
+      (http://www.gnumeric.org/v10.dtd:left
+        (@ (PrefUnit "mm") (Points "72")))
+      (http://www.gnumeric.org/v10.dtd:right
+        (@ (PrefUnit "mm") (Points "72")))
+      (http://www.gnumeric.org/v10.dtd:header
+        (@ (PrefUnit "mm") (Points "72")))
+      (http://www.gnumeric.org/v10.dtd:footer
+        (@ (PrefUnit "mm") (Points "72"))))
+    (http://www.gnumeric.org/v10.dtd:Scale
+      (@ (type "percentage") (percentage "100")))
+    (http://www.gnumeric.org/v10.dtd:vcenter
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:hcenter
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:grid
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:even_if_only_styles
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:monochrome
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:draft
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:titles
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:do_not_print
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:print_range
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:order
+      "d_then_r")
+    (http://www.gnumeric.org/v10.dtd:orientation
+      "portrait")
+    (http://www.gnumeric.org/v10.dtd:Header
+      (@ (Right "") (Middle "&[tab]") (Left "")))
+    (http://www.gnumeric.org/v10.dtd:Footer
+      (@ (Right "") (Middle "&[page]") (Left "")))
+    (http://www.gnumeric.org/v10.dtd:paper
+      "na_letter")
+    (http://www.gnumeric.org/v10.dtd:comments "none")
+    (http://www.gnumeric.org/v10.dtd:errors
+      "as_displayed"))
+  (http://www.gnumeric.org/v10.dtd:Styles
+    (http://www.gnumeric.org/v10.dtd:StyleRegion
+      (@ (startRow "0")
+         (startCol "0")
+         (endRow "65535")
+         (endCol "255"))
+      (http://www.gnumeric.org/v10.dtd:Style
+        (@ (WrapText "0")
+           (VAlign "2")
+           (ShrinkToFit "0")
+           (Shade "0")
+           (Rotation "0")
+           (PatternColor "0:0:0")
+           (Locked "1")
+           (Indent "0")
+           (Hidden "0")
+           (HAlign "1")
+           (Format "General")
+           (Fore "0:0:0")
+           (Back "FFFF:FFFF:FFFF"))
+        (http://www.gnumeric.org/v10.dtd:Font
+          (@ (Unit "10")
+             (Underline "0")
+             (StrikeThrough "0")
+             (Script "0")
+             (Italic "0")
+             (Bold "0"))
+          "Sans"))))
+  (http://www.gnumeric.org/v10.dtd:Cols
+    (@ (DefaultSizePts "48"))
+    (http://www.gnumeric.org/v10.dtd:ColInfo
+      (@ (Unit "243") (No "0")))
+    (http://www.gnumeric.org/v10.dtd:ColInfo
+      (@ (Unit "462") (No "1")))
+    (http://www.gnumeric.org/v10.dtd:ColInfo
+      (@ (Unit "64.01") (No "2") (Count "7"))))
+  (http://www.gnumeric.org/v10.dtd:Rows
+    (@ (DefaultSizePts "12.1"))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "12.64") (No "0")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "13.5") (No "1") (Count "17")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "12.1") (No "18") (Count "705"))))
+  (http://www.gnumeric.org/v10.dtd:Selections
+    (@ (CursorRow "3") (CursorCol "1"))
+    (http://www.gnumeric.org/v10.dtd:Selection
+      (@ (startRow "3")
+         (startCol "1")
+         (endRow "3")
+         (endCol "1"))))
+  (http://www.gnumeric.org/v10.dtd:SheetLayout
+    (@ (TopLeft "A2"))
+    (http://www.gnumeric.org/v10.dtd:FreezePanes
+      (@ (UnfrozenTopLeft "A2") (FrozenTopLeft "A1"))))
+  (http://www.gnumeric.org/v10.dtd:Solver
+    (@ (ProgramR "0")
+       (ProblemType "0")
+       (NonNeg "1")
+       (ModelType "0")
+       (MaxTime "60")
+       (MaxIter "1000")
+       (Discr "0")
+       (AutoScale "0"))))

ADDED   fossil-utils/justtesting/sxml/setup.sxml
Index: fossil-utils/justtesting/sxml/setup.sxml
==================================================================
--- /dev/null
+++ fossil-utils/justtesting/sxml/setup.sxml
@@ -0,0 +1,129 @@
+(http://www.gnumeric.org/v10.dtd:Sheet
+  (@ (Visibility "GNM_SHEET_VISIBILITY_VISIBLE")
+     (OutlineSymbolsRight "1")
+     (OutlineSymbolsBelow "1")
+     (HideZero "0")
+     (HideRowHeader "0")
+     (HideGrid "0")
+     (HideColHeader "0")
+     (GridColor "0:0:0")
+     (DisplayOutlines "1")
+     (DisplayFormulas "0"))
+  (http://www.gnumeric.org/v10.dtd:MaxCol "1")
+  (http://www.gnumeric.org/v10.dtd:MaxRow "8")
+  (http://www.gnumeric.org/v10.dtd:Zoom "1")
+  (http://www.gnumeric.org/v10.dtd:Names
+    (http://www.gnumeric.org/v10.dtd:Name
+      (http://www.gnumeric.org/v10.dtd:name
+        "Print_Area")
+      (http://www.gnumeric.org/v10.dtd:value "#REF!")
+      (http://www.gnumeric.org/v10.dtd:position "A1"))
+    (http://www.gnumeric.org/v10.dtd:Name
+      (http://www.gnumeric.org/v10.dtd:name
+        "Sheet_Title")
+      (http://www.gnumeric.org/v10.dtd:value
+        "\"setup\"")
+      (http://www.gnumeric.org/v10.dtd:position "A1")))
+  (http://www.gnumeric.org/v10.dtd:PrintInformation
+    (http://www.gnumeric.org/v10.dtd:Margins
+      (http://www.gnumeric.org/v10.dtd:top
+        (@ (PrefUnit "mm") (Points "120")))
+      (http://www.gnumeric.org/v10.dtd:bottom
+        (@ (PrefUnit "mm") (Points "120")))
+      (http://www.gnumeric.org/v10.dtd:left
+        (@ (PrefUnit "mm") (Points "72")))
+      (http://www.gnumeric.org/v10.dtd:right
+        (@ (PrefUnit "mm") (Points "72")))
+      (http://www.gnumeric.org/v10.dtd:header
+        (@ (PrefUnit "mm") (Points "72")))
+      (http://www.gnumeric.org/v10.dtd:footer
+        (@ (PrefUnit "mm") (Points "72"))))
+    (http://www.gnumeric.org/v10.dtd:Scale
+      (@ (type "percentage") (percentage "100")))
+    (http://www.gnumeric.org/v10.dtd:vcenter
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:hcenter
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:grid
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:even_if_only_styles
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:monochrome
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:draft
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:titles
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:do_not_print
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:print_range
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:order
+      "d_then_r")
+    (http://www.gnumeric.org/v10.dtd:orientation
+      "portrait")
+    (http://www.gnumeric.org/v10.dtd:Header
+      (@ (Right "") (Middle "&[TAB]") (Left "")))
+    (http://www.gnumeric.org/v10.dtd:Footer
+      (@ (Right "") (Middle "Page &[PAGE]") (Left "")))
+    (http://www.gnumeric.org/v10.dtd:paper
+      "na_letter")
+    (http://www.gnumeric.org/v10.dtd:comments "none")
+    (http://www.gnumeric.org/v10.dtd:errors
+      "as_displayed"))
+  (http://www.gnumeric.org/v10.dtd:Styles
+    (http://www.gnumeric.org/v10.dtd:StyleRegion
+      (@ (startRow "0")
+         (startCol "0")
+         (endRow "65535")
+         (endCol "255"))
+      (http://www.gnumeric.org/v10.dtd:Style
+        (@ (WrapText "0")
+           (VAlign "2")
+           (ShrinkToFit "0")
+           (Shade "0")
+           (Rotation "0")
+           (PatternColor "0:0:0")
+           (Locked "1")
+           (Indent "0")
+           (Hidden "0")
+           (HAlign "1")
+           (Format "General")
+           (Fore "0:0:0")
+           (Back "FFFF:FFFF:FFFF"))
+        (http://www.gnumeric.org/v10.dtd:Font
+          (@ (Unit "10")
+             (Underline "0")
+             (StrikeThrough "0")
+             (Script "0")
+             (Italic "0")
+             (Bold "0"))
+          "Sans"))))
+  (http://www.gnumeric.org/v10.dtd:Cols
+    (@ (DefaultSizePts "48"))
+    (http://www.gnumeric.org/v10.dtd:ColInfo
+      (@ (Unit "48") (No "0")))
+    (http://www.gnumeric.org/v10.dtd:ColInfo
+      (@ (Unit "333") (No "1"))))
+  (http://www.gnumeric.org/v10.dtd:Rows
+    (@ (DefaultSizePts "12.75"))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "13.5") (No "0") (Count "9"))))
+  (http://www.gnumeric.org/v10.dtd:Selections
+    (@ (CursorRow "7") (CursorCol "0"))
+    (http://www.gnumeric.org/v10.dtd:Selection
+      (@ (startRow "7")
+         (startCol "0")
+         (endRow "7")
+         (endCol "255"))))
+  (http://www.gnumeric.org/v10.dtd:SheetLayout
+    (@ (TopLeft "A1")))
+  (http://www.gnumeric.org/v10.dtd:Solver
+    (@ (ProgramR "0")
+       (ProblemType "0")
+       (NonNeg "1")
+       (ModelType "0")
+       (MaxTime "60")
+       (MaxIter "1000")
+       (Discr "0")
+       (AutoScale "0"))))

ADDED   fossil-utils/justtesting/sxml/timeline.sxml
Index: fossil-utils/justtesting/sxml/timeline.sxml
==================================================================
--- /dev/null
+++ fossil-utils/justtesting/sxml/timeline.sxml
@@ -0,0 +1,547 @@
+(http://www.gnumeric.org/v10.dtd:Sheet
+  (@ (Visibility "GNM_SHEET_VISIBILITY_VISIBLE")
+     (OutlineSymbolsRight "1")
+     (OutlineSymbolsBelow "1")
+     (HideZero "0")
+     (HideRowHeader "0")
+     (HideGrid "0")
+     (HideColHeader "0")
+     (GridColor "0:0:0")
+     (DisplayOutlines "1")
+     (DisplayFormulas "0"))
+  (http://www.gnumeric.org/v10.dtd:MaxCol "17")
+  (http://www.gnumeric.org/v10.dtd:MaxRow "65535")
+  (http://www.gnumeric.org/v10.dtd:Zoom "1")
+  (http://www.gnumeric.org/v10.dtd:Names
+    (http://www.gnumeric.org/v10.dtd:Name
+      (http://www.gnumeric.org/v10.dtd:name
+        "Print_Area")
+      (http://www.gnumeric.org/v10.dtd:value "#REF!")
+      (http://www.gnumeric.org/v10.dtd:position "A1"))
+    (http://www.gnumeric.org/v10.dtd:Name
+      (http://www.gnumeric.org/v10.dtd:name
+        "Sheet_Title")
+      (http://www.gnumeric.org/v10.dtd:value
+        "\"First_Sheet\"")
+      (http://www.gnumeric.org/v10.dtd:position "A1")))
+  (http://www.gnumeric.org/v10.dtd:PrintInformation
+    (http://www.gnumeric.org/v10.dtd:Margins
+      (http://www.gnumeric.org/v10.dtd:top
+        (@ (PrefUnit "mm") (Points "93.26")))
+      (http://www.gnumeric.org/v10.dtd:bottom
+        (@ (PrefUnit "mm") (Points "93.26")))
+      (http://www.gnumeric.org/v10.dtd:left
+        (@ (PrefUnit "mm") (Points "72")))
+      (http://www.gnumeric.org/v10.dtd:right
+        (@ (PrefUnit "mm") (Points "72")))
+      (http://www.gnumeric.org/v10.dtd:header
+        (@ (PrefUnit "mm") (Points "72")))
+      (http://www.gnumeric.org/v10.dtd:footer
+        (@ (PrefUnit "mm") (Points "72"))))
+    (http://www.gnumeric.org/v10.dtd:Scale
+      (@ (type "percentage") (percentage "100")))
+    (http://www.gnumeric.org/v10.dtd:vcenter
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:hcenter
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:grid
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:even_if_only_styles
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:monochrome
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:draft
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:titles
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:do_not_print
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:print_range
+      (@ (value "0")))
+    (http://www.gnumeric.org/v10.dtd:order
+      "d_then_r")
+    (http://www.gnumeric.org/v10.dtd:orientation
+      "portrait")
+    (http://www.gnumeric.org/v10.dtd:Header
+      (@ (Right "") (Middle "&[tab]") (Left "")))
+    (http://www.gnumeric.org/v10.dtd:Footer
+      (@ (Right "") (Middle "&[page]") (Left "")))
+    (http://www.gnumeric.org/v10.dtd:paper
+      "na_letter")
+    (http://www.gnumeric.org/v10.dtd:comments "none")
+    (http://www.gnumeric.org/v10.dtd:errors
+      "as_displayed"))
+  (http://www.gnumeric.org/v10.dtd:Styles
+    (http://www.gnumeric.org/v10.dtd:StyleRegion
+      (@ (startRow "0")
+         (startCol "0")
+         (endRow "255")
+         (endCol "63"))
+      (http://www.gnumeric.org/v10.dtd:Style
+        (@ (WrapText "0")
+           (VAlign "2")
+           (ShrinkToFit "0")
+           (Shade "0")
+           (Rotation "0")
+           (PatternColor "0:0:0")
+           (Locked "1")
+           (Indent "0")
+           (Hidden "0")
+           (HAlign "1")
+           (Format "General")
+           (Fore "0:0:0")
+           (Back "FFFF:FFFF:FFFF"))
+        (http://www.gnumeric.org/v10.dtd:Font
+          (@ (Unit "10")
+             (Underline "0")
+             (StrikeThrough "0")
+             (Script "0")
+             (Italic "0")
+             (Bold "0"))
+          "Sans")))
+    (http://www.gnumeric.org/v10.dtd:StyleRegion
+      (@ (startRow "256")
+         (startCol "0")
+         (endRow "431")
+         (endCol "7"))
+      (http://www.gnumeric.org/v10.dtd:Style
+        (@ (WrapText "0")
+           (VAlign "2")
+           (ShrinkToFit "0")
+           (Shade "0")
+           (Rotation "0")
+           (PatternColor "0:0:0")
+           (Locked "1")
+           (Indent "0")
+           (Hidden "0")
+           (HAlign "1")
+           (Format "General")
+           (Fore "0:0:0")
+           (Back "FFFF:FFFF:FFFF"))
+        (http://www.gnumeric.org/v10.dtd:Font
+          (@ (Unit "10")
+             (Underline "0")
+             (StrikeThrough "0")
+             (Script "0")
+             (Italic "0")
+             (Bold "0"))
+          "Sans")))
+    (http://www.gnumeric.org/v10.dtd:StyleRegion
+      (@ (startRow "432")
+         (startCol "0")
+         (endRow "463")
+         (endCol "4"))
+      (http://www.gnumeric.org/v10.dtd:Style
+        (@ (WrapText "0")
+           (VAlign "2")
+           (ShrinkToFit "0")
+           (Shade "0")
+           (Rotation "0")
+           (PatternColor "0:0:0")
+           (Locked "1")
+           (Indent "0")
+           (Hidden "0")
+           (HAlign "1")
+           (Format "General")
+           (Fore "0:0:0")
+           (Back "FFFF:FFFF:FFFF"))
+        (http://www.gnumeric.org/v10.dtd:Font
+          (@ (Unit "10")
+             (Underline "0")
+             (StrikeThrough "0")
+             (Script "0")
+             (Italic "0")
+             (Bold "0"))
+          "Sans")))
+    (http://www.gnumeric.org/v10.dtd:StyleRegion
+      (@ (startRow "464")
+         (startCol "0")
+         (endRow "511")
+         (endCol "7"))
+      (http://www.gnumeric.org/v10.dtd:Style
+        (@ (WrapText "0")
+           (VAlign "2")
+           (ShrinkToFit "0")
+           (Shade "0")
+           (Rotation "0")
+           (PatternColor "0:0:0")
+           (Locked "1")
+           (Indent "0")
+           (Hidden "0")
+           (HAlign "1")
+           (Format "General")
+           (Fore "0:0:0")
+           (Back "FFFF:FFFF:FFFF"))
+        (http://www.gnumeric.org/v10.dtd:Font
+          (@ (Unit "10")
+             (Underline "0")
+             (StrikeThrough "0")
+             (Script "0")
+             (Italic "0")
+             (Bold "0"))
+          "Sans")))
+    (http://www.gnumeric.org/v10.dtd:StyleRegion
+      (@ (startRow "512")
+         (startCol "0")
+         (endRow "65535")
+         (endCol "63"))
+      (http://www.gnumeric.org/v10.dtd:Style
+        (@ (WrapText "0")
+           (VAlign "2")
+           (ShrinkToFit "0")
+           (Shade "0")
+           (Rotation "0")
+           (PatternColor "0:0:0")
+           (Locked "1")
+           (Indent "0")
+           (Hidden "0")
+           (HAlign "1")
+           (Format "General")
+           (Fore "0:0:0")
+           (Back "FFFF:FFFF:FFFF"))
+        (http://www.gnumeric.org/v10.dtd:Font
+          (@ (Unit "10")
+             (Underline "0")
+             (StrikeThrough "0")
+             (Script "0")
+             (Italic "0")
+             (Bold "0"))
+          "Sans")))
+    (http://www.gnumeric.org/v10.dtd:StyleRegion
+      (@ (startRow "432")
+         (startCol "5")
+         (endRow "448")
+         (endCol "5"))
+      (http://www.gnumeric.org/v10.dtd:Style
+        (@ (WrapText "0")
+           (VAlign "2")
+           (ShrinkToFit "0")
+           (Shade "0")
+           (Rotation "0")
+           (PatternColor "0:0:0")
+           (Locked "1")
+           (Indent "0")
+           (Hidden "0")
+           (HAlign "1")
+           (Format "General")
+           (Fore "0:0:0")
+           (Back "FFFF:FFFF:FFFF"))
+        (http://www.gnumeric.org/v10.dtd:Font
+          (@ (Unit "10")
+             (Underline "0")
+             (StrikeThrough "0")
+             (Script "0")
+             (Italic "0")
+             (Bold "0"))
+          "Sans")))
+    (http://www.gnumeric.org/v10.dtd:StyleRegion
+      (@ (startRow "449")
+         (startCol "5")
+         (endRow "449")
+         (endCol "5"))
+      (http://www.gnumeric.org/v10.dtd:Style
+        (@ (WrapText "0")
+           (VAlign "2")
+           (ShrinkToFit "0")
+           (Shade "0")
+           (Rotation "0")
+           (PatternColor "0:0:0")
+           (Locked "1")
+           (Indent "0")
+           (Hidden "0")
+           (HAlign "1")
+           (Format "General")
+           (Fore "0:0:0")
+           (Back "FFFF:FFFF:FFFF"))
+        (http://www.gnumeric.org/v10.dtd:Font
+          (@ (Unit "10")
+             (Underline "0")
+             (StrikeThrough "0")
+             (Script "0")
+             (Italic "0")
+             (Bold "0"))
+          "Sans")))
+    (http://www.gnumeric.org/v10.dtd:StyleRegion
+      (@ (startRow "450")
+         (startCol "5")
+         (endRow "463")
+         (endCol "5"))
+      (http://www.gnumeric.org/v10.dtd:Style
+        (@ (WrapText "0")
+           (VAlign "2")
+           (ShrinkToFit "0")
+           (Shade "0")
+           (Rotation "0")
+           (PatternColor "0:0:0")
+           (Locked "1")
+           (Indent "0")
+           (Hidden "0")
+           (HAlign "1")
+           (Format "General")
+           (Fore "0:0:0")
+           (Back "FFFF:FFFF:FFFF"))
+        (http://www.gnumeric.org/v10.dtd:Font
+          (@ (Unit "10")
+             (Underline "0")
+             (StrikeThrough "0")
+             (Script "0")
+             (Italic "0")
+             (Bold "0"))
+          "Sans")))
+    (http://www.gnumeric.org/v10.dtd:StyleRegion
+      (@ (startRow "432")
+         (startCol "6")
+         (endRow "463")
+         (endCol "7"))
+      (http://www.gnumeric.org/v10.dtd:Style
+        (@ (WrapText "0")
+           (VAlign "2")
+           (ShrinkToFit "0")
+           (Shade "0")
+           (Rotation "0")
+           (PatternColor "0:0:0")
+           (Locked "1")
+           (Indent "0")
+           (Hidden "0")
+           (HAlign "1")
+           (Format "General")
+           (Fore "0:0:0")
+           (Back "FFFF:FFFF:FFFF"))
+        (http://www.gnumeric.org/v10.dtd:Font
+          (@ (Unit "10")
+             (Underline "0")
+             (StrikeThrough "0")
+             (Script "0")
+             (Italic "0")
+             (Bold "0"))
+          "Sans")))
+    (http://www.gnumeric.org/v10.dtd:StyleRegion
+      (@ (startRow "256")
+         (startCol "8")
+         (endRow "511")
+         (endCol "63"))
+      (http://www.gnumeric.org/v10.dtd:Style
+        (@ (WrapText "0")
+           (VAlign "2")
+           (ShrinkToFit "0")
+           (Shade "0")
+           (Rotation "0")
+           (PatternColor "0:0:0")
+           (Locked "1")
+           (Indent "0")
+           (Hidden "0")
+           (HAlign "1")
+           (Format "General")
+           (Fore "0:0:0")
+           (Back "FFFF:FFFF:FFFF"))
+        (http://www.gnumeric.org/v10.dtd:Font
+          (@ (Unit "10")
+             (Underline "0")
+             (StrikeThrough "0")
+             (Script "0")
+             (Italic "0")
+             (Bold "0"))
+          "Sans")))
+    (http://www.gnumeric.org/v10.dtd:StyleRegion
+      (@ (startRow "0")
+         (startCol "64")
+         (endRow "65535")
+         (endCol "255"))
+      (http://www.gnumeric.org/v10.dtd:Style
+        (@ (WrapText "0")
+           (VAlign "2")
+           (ShrinkToFit "0")
+           (Shade "0")
+           (Rotation "0")
+           (PatternColor "0:0:0")
+           (Locked "1")
+           (Indent "0")
+           (Hidden "0")
+           (HAlign "1")
+           (Format "General")
+           (Fore "0:0:0")
+           (Back "FFFF:FFFF:FFFF"))
+        (http://www.gnumeric.org/v10.dtd:Font
+          (@ (Unit "10")
+             (Underline "0")
+             (StrikeThrough "0")
+             (Script "0")
+             (Italic "0")
+             (Bold "0"))
+          "Sans"))))
+  (http://www.gnumeric.org/v10.dtd:Cols
+    (@ (DefaultSizePts "48"))
+    (http://www.gnumeric.org/v10.dtd:ColInfo
+      (@ (Unit "243.8") (No "0")))
+    (http://www.gnumeric.org/v10.dtd:ColInfo
+      (@ (Unit "89.25")
+         (No "1")
+         (HardSize "1")
+         (Count "2")))
+    (http://www.gnumeric.org/v10.dtd:ColInfo
+      (@ (Unit "51") (No "3") (HardSize "1")))
+    (http://www.gnumeric.org/v10.dtd:ColInfo
+      (@ (Unit "49.5") (No "4") (HardSize "1")))
+    (http://www.gnumeric.org/v10.dtd:ColInfo
+      (@ (Unit "105") (No "5") (HardSize "1")))
+    (http://www.gnumeric.org/v10.dtd:ColInfo
+      (@ (Unit "48") (No "6")))
+    (http://www.gnumeric.org/v10.dtd:ColInfo
+      (@ (Unit "70.5") (No "7") (HardSize "1")))
+    (http://www.gnumeric.org/v10.dtd:ColInfo
+      (@ (Unit "48") (No "8")))
+    (http://www.gnumeric.org/v10.dtd:ColInfo
+      (@ (Unit "60.75") (No "9") (HardSize "1")))
+    (http://www.gnumeric.org/v10.dtd:ColInfo
+      (@ (Unit "34.5") (No "10") (HardSize "1")))
+    (http://www.gnumeric.org/v10.dtd:ColInfo
+      (@ (Unit "177") (No "11") (HardSize "1")))
+    (http://www.gnumeric.org/v10.dtd:ColInfo
+      (@ (Unit "63.75") (No "12") (HardSize "1")))
+    (http://www.gnumeric.org/v10.dtd:ColInfo
+      (@ (Unit "413.2") (No "13") (HardSize "1")))
+    (http://www.gnumeric.org/v10.dtd:ColInfo
+      (@ (Unit "213.8") (No "14") (HardSize "1")))
+    (http://www.gnumeric.org/v10.dtd:ColInfo
+      (@ (Unit "198.8") (No "15") (HardSize "1")))
+    (http://www.gnumeric.org/v10.dtd:ColInfo
+      (@ (Unit "104.2") (No "16")))
+    (http://www.gnumeric.org/v10.dtd:ColInfo
+      (@ (Unit "78.75") (No "17"))))
+  (http://www.gnumeric.org/v10.dtd:Rows
+    (@ (DefaultSizePts "12.1"))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "13.5") (No "0")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "13.5")
+         (No "1")
+         (Hidden "1")
+         (Count "17")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "12.1")
+         (No "18")
+         (Hidden "1")
+         (Count "41")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "13.5") (No "59") (Hidden "1")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "12.1")
+         (No "60")
+         (Hidden "1")
+         (Count "131")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "13.5") (No "191") (Hidden "1")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "12.1")
+         (No "192")
+         (Hidden "1")
+         (Count "215")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "13.5") (No "407")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "12.1") (No "408") (Count "10")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "12.1") (No "418") (Hidden "1")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "13.5") (No "419") (Hidden "1")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "12.1") (No "420")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "13.5") (No "421") (Hidden "1")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "12.1") (No "422") (Hidden "1")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "13.5") (No "423") (Hidden "1")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "12.1") (No "424") (Count "18")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "12.1") (No "442") (Hidden "1")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "12.1") (No "443")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "13.5") (No "444") (Hidden "1")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "12.1") (No "445")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "12.1")
+         (No "446")
+         (Hidden "1")
+         (Count "3")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "12.1") (No "449") (Count "7")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "13.5") (No "456") (Hidden "1")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "12.1") (No "457") (Hidden "1")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "12.1") (No "458") (Count "2")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "13.5")
+         (No "460")
+         (Hidden "1")
+         (Count "3")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "12.1") (No "463") (Count "4")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "13.5")
+         (No "467")
+         (Hidden "1")
+         (Count "15")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "12.1") (No "482") (Hidden "1")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "13.5")
+         (No "483")
+         (Hidden "1")
+         (Count "5")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "12.1") (No "488") (Hidden "1")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "13.5")
+         (No "489")
+         (Hidden "1")
+         (Count "4")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "12.1")
+         (No "493")
+         (Hidden "1")
+         (Count "5")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "13.5")
+         (No "498")
+         (Hidden "1")
+         (Count "3")))
+    (http://www.gnumeric.org/v10.dtd:RowInfo
+      (@ (Unit "12.1")
+         (No "501")
+         (Hidden "1")
+         (Count "65035"))))
+  (http://www.gnumeric.org/v10.dtd:Selections
+    (@ (CursorRow "426") (CursorCol "13"))
+    (http://www.gnumeric.org/v10.dtd:Selection
+      (@ (startRow "426")
+         (startCol "13")
+         (endRow "426")
+         (endCol "13"))))
+  (http://www.gnumeric.org/v10.dtd:SheetLayout
+    (@ (TopLeft "A2"))
+    (http://www.gnumeric.org/v10.dtd:FreezePanes
+      (@ (UnfrozenTopLeft "A2") (FrozenTopLeft "A1"))))
+  (http://www.gnumeric.org/v10.dtd:Filters
+    (http://www.gnumeric.org/v10.dtd:Filter
+      (@ (Area "A1:Q65536"))
+      (http://www.gnumeric.org/v10.dtd:Field
+        (@ (ValueType0 "v1.65-broken")
+           (Value0 "60")
+           (Type "expr")
+           (Op0 "eq")
+           (Index "1")))))
+  (http://www.gnumeric.org/v10.dtd:Solver
+    (@ (ProgramR "0")
+       (ProblemType "0")
+       (NonNeg "1")
+       (ModelType "0")
+       (MaxTime "60")
+       (MaxIter "1000")
+       (Discr "0")
+       (AutoScale "0"))))

ADDED   fossil-utils/justtesting/timeline.dat
Index: fossil-utils/justtesting/timeline.dat
==================================================================
--- /dev/null
+++ fossil-utils/justtesting/timeline.dat
cannot compute difference between binary files

Index: genexample.scm
==================================================================
--- genexample.scm
+++ genexample.scm
@@ -17,11 +17,13 @@
 ;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;======================================================================
 
 (declare (unit genexample))
-(use posix regex)
+(use posix regex matchable)
+
+(include "db_records.scm")
 
 (define genexample:example-logpro
 #<<EOF
   ;; You should have at least one expect:required. This ensures that your process ran
   ;; comment out the line below and replace "put pattern here" with a pattern that will
@@ -338,5 +340,179 @@
 			      (with-output-to-file (conc testdir "/" script)
 				(lambda ()
 				  (print genexample:example-script)))
 			      (system (conc "chmod ug+r,a+x " (conc testdir "/" script)))))))
 		    steps))))))
+
+;; easier to work backwards than change the upstream code
+;;
+(define (hrs-min-sec->seconds str)
+  (let* ((parts (string-split str))
+	 (res   0))
+    (for-each
+     (lambda (part)
+       (set! res
+	     (+ res
+		(match (string-match "(\\d+)([a-z])" part)
+		  ((_ val units)(* (string->number val)(case (string->symbol units)
+							 ((s) 1)
+							 ((m) 60)
+							 ((h) 3600))))
+		  (else 0)))))
+     parts)
+    res))
+
+;; generate a skeleton Megatest area from a current area with runs
+;;
+;;    specify target, runname etc to use specific runs for the template
+;;
+(define (genexample:extract-skeleton-area dest-path)
+  (let* ((target    (args:get-arg "-target"))
+	 (runname   (args:get-arg "-runname"))
+	 (obtuse    (make-hash-table))
+	 (obtusef   (args:get-arg "-obfuscate"))
+	 (letters   (string-split-fields "\\S" "abcdefghijklmnopqrstuvwxyz"))
+	 (maxletter (- (length letters) 1))
+	 (lastlet   0)
+	 (lastnum   1) 
+	 (obfuscate (lambda (instr)
+		      (or (hash-table-ref/default obtuse instr #f)
+			  (if obtusef
+			      (let* ((letter (list-ref letters lastlet))
+				     (val    (conc letter lastnum)))
+				(if (>= lastlet maxletter)
+				    (begin
+				      (set! lastlet 0)
+				      (set! lastnum (+ lastnum 1)))
+				    (set! lastlet (+ lastlet 1)))
+				(hash-table-set! obtuse instr val)
+				val)
+			      instr)))))
+    (if (not (and target runname))
+	(debug:print 0 *default-log-port* "WARNING: For best results please specifiy -target and -runname for a good run to use as a template."))
+    (if (not (and (file-exists? "megatest.config")
+		  (file-exists? "megatest.db")))
+	(begin
+	  (debug:print 0 *default-log-port* "ERROR: this command must be run at the top level of a megatest area where runs have been completed")
+	  (exit)))
+	     
+    ;; first create the dest path and needed subdirectories
+    (if (not (file-exists? dest-path))
+	(begin
+	  (create-directory dest-path)
+	  (create-directory (conc dest-path "/tests")))
+	(if (file-exists? (conc dest-path "/megatest.config"))
+	    (begin
+	      (debug:print 0 *default-log-port* "ERROR: destination path already has megatest.config, stopping now.")
+	      (exit))))
+
+    ;; dump the config files from this area to the dest area
+    (if (args:get-arg "-obfuscate")
+	(debug:print 0 *default-log-port* "WARNING: obfuscation is NOT done on megatest.config and runconfigs.config. Please edit those files to remove any sensitive information!"))
+    (system (conc "megatest -show-config > " dest-path "/megatest.config"))
+    (system (conc "megatest -show-runconfig > " dest-path "/runconfigs.config"))
+
+    ;; create stepsinfo and items refdbs, some stuff has to be done due to refdb not initing area
+    ;;
+    ;;            sheet       row       col      value
+    ;; stepsinfo  testname    itempath  stepname steptime
+    ;; miscinfo   "itemsinfo" testname  itempath "x"
+    ;;  
+    (for-each
+     (lambda (rdbname)
+       (if (not (file-exists? (conc dest-path "/" rdbname)))
+	   (begin
+	     (create-directory (conc dest-path "/" rdbname "/sxml") #t)
+	     (with-output-to-file (conc dest-path "/" rdbname "/sheet-names.cfg")
+	       (lambda ()(print))))))
+     '("stepsinfo" "miscinfo"))
+    
+    (let* ((runs     (rmt:simple-get-runs (or runname "%") #f #f (or target "%") #f))
+	   (tests    (make-hash-table)) ;; just tests
+	   (fullt    (make-hash-table)) ;; all test/items
+	   (testreg  (make-hash-table)) ;; for the testconfigs
+	   (stepsrdb (conc dest-path "/stepsinfo"))
+	   (miscrdb  (conc dest-path "/miscinfo")))
+      (if (> (length runs) 1)
+	  (debug:print-info 0 *default-log-port* "More than one run matches, first found data will be used."))
+      ;; get all testnames
+      (for-each
+       (lambda (run-id)
+	 (let* ((tests-data (rmt:get-tests-for-run run-id "%" '() '() #f #f #f #f #f #f #f #f)))
+	   (for-each
+	    (lambda (testdat)
+	      (let* ((test-id      (db:test-get-id testdat))
+		     (testname     (db:test-get-testname testdat))
+		     (item-path    (db:test-get-item-path testdat))
+		     (tlevel       (db:test-get-is-toplevel testdat))
+		     (tfullname    (db:test-get-fullname testdat))
+		     ;; now get steps info
+		     (test-steps   (tests:get-compressed-steps run-id test-id))
+		     (testconfig   (tests:get-testconfig testname item-path testreg #f)))
+
+		
+		(if (not (hash-table-exists? fullt tfullname))
+		    ;; do the work for this test if not previously done
+		    (let* ((new-test-dir (conc dest-path "/tests/" (obfuscate testname)))
+			   (tconfigf     (conc new-test-dir "/testconfig")))
+		      (print "Analyzing and extracting info for " tfullname " as " (obfuscate testname))
+		      (print "  toplevel: " (if tlevel "yes" "no"))
+		      (hash-table-set! fullt tfullname #t) ;; track that this one has been seen
+		      (if (not (directory-exists? new-test-dir))
+			  (create-directory new-test-dir #t))
+
+		      ;; create the testconfig IIF we are a toplevel or an item AND the testconfig has not been previously created
+		      (if (and (or (not tlevel)
+				   (not (equal? item-path "")))
+			       (not (file-exists? tconfigf)))
+			  (with-output-to-file tconfigf
+			    (lambda ()
+			      ;; first the ezsteps
+			      (print "[ezsteps]")
+			      (for-each
+			       (lambda (teststep)
+				 (let* ((step-name  (vector-ref teststep 0)))
+				   (print (obfuscate step-name)
+					  " sleep $(refdb lookup #{getenv MT_RUN_AREA_HOME}/stepsinfo "
+					  (obfuscate testname) " $MT_ITEMPATH "
+					  (obfuscate step-name) ")")))
+			       test-steps)
+
+			      ;; now the requirements section
+			      (if testconfig
+				  (begin
+				    (print "\n[requirements]")
+				    (for-each
+				     (lambda (entry)
+				       (let* ((key (car entry))
+					      (val (cadr entry)))
+					 (case (string->symbol key)
+					   ((waiton)  (print "waiton " (obfuscate val)))
+					   (else      (print key " " val)))))
+				     (configf:get-section testconfig "requirements")))
+				  #;(print "WARNING: No testconfig data for " testname ", " item-path))
+				    
+			      (print "\n[items]")
+			      (print "THE_ITEM [system refdb getrow #{getenv MT_RUN_AREA_HOME}/miscinfo itemsinfo " (obfuscate testname)" | awk '{print $1}']")
+			      )))
+
+		      ;; fill the stepsrdb
+		      (for-each
+		       (lambda (teststep)
+			 (let* ((step-name     (vector-ref teststep 0))
+				(step-duration (hrs-min-sec->seconds (vector-ref teststep 4))))
+			   
+			   (system (conc "refdb set " stepsrdb " " (obfuscate testname)
+					 " '" (if (equal? item-path "")
+						  "no-item-path"
+						  (obfuscate item-path))
+					 "' " (obfuscate step-name) " " step-duration))))
+		       test-steps)
+
+		      ;; miscinfo   "itemsinfo" testname  itempath "x"
+		      (if (not (equal? item-path ""))
+			  (system (conc "refdb set " miscrdb " itemsinfo " (obfuscate testname) " " (obfuscate item-path) " x")))
+
+		      ))))
+	    tests-data)))
+       (map (lambda (runrec)(simple-run-id runrec)) runs)))
+    ))

Index: http-transport.scm
==================================================================
--- http-transport.scm
+++ http-transport.scm
@@ -40,11 +40,11 @@
 
 (include "common_records.scm")
 (include "db_records.scm")
 (include "js-path.scm")
 
-(require-library stml)
+(use stml2)
 (define (http-transport:make-server-url hostport)
   (if (not hostport)
       #f
       (conc "http://" (car hostport) ":" (cadr hostport))))
 
@@ -132,11 +132,14 @@
                                   ((equal? (uri-path (request-uri (current-request))) 
 					   '(/ "dashboard"))
 				   (send-response body: (http-transport:html-dboard $) 
 						  headers: '((content-type text/HTML)))) 
 				  (else (continue))))))))
-    (with-output-to-file start-file (lambda ()(print (current-process-id))))
+    (handle-exceptions
+	exn
+      (debug:print 0 *default-log-port* "Failed to create file " start-file ", exn=" exn)
+      (with-output-to-file start-file (lambda ()(print (current-process-id)))))
     (http-transport:try-start-server ipaddrstr start-port)))
 
 ;; This is recursively run by http-transport:run until sucessful
 ;;
 (define (http-transport:try-start-server ipaddrstr portnum)
@@ -269,11 +272,11 @@
 						(set! success #f)
                                                 (if (debug:debug-mode 1)
                                                     (debug:print-info 0 *default-log-port* "couldn't talk to server, trying again ...")
                                                     (begin
                                                       (debug:print 0 *default-log-port* "WARNING: failure in with-input-from-request to " fullurl ".")
-                                                      (debug:print 0 *default-log-port* " message: " msg)
+                                                      (debug:print 0 *default-log-port* " message: " msg ", exn=" exn)
                                                       (debug:print 0 *default-log-port* " cmd: " cmd " params: " params)
                                                       (debug:print 0 *default-log-port* " call-chain: " call-chain)))
                                                 (if runremote
 						    (remote-conndat-set! runremote #f))
 						;; Killing associated server to allow clean retry.")
@@ -295,10 +298,11 @@
 			      (close-all-connections!)
 			      (mutex-unlock! *http-mutex*)
 			      ))
 	      (time-out     (lambda ()
 			      (thread-sleep! 45)
+			      (debug:print 0 *default-log-port* "WARNING: send-receive took more than 45 seconds!!")
 			      #f))
 	      (th1 (make-thread send-recieve "with-input-from-request"))
 	      (th2 (make-thread time-out     "time out")))
 	 (thread-start! th1)
 	 (thread-start! th2)
@@ -332,11 +336,11 @@
 	(let ((api-dat (http-transport:server-dat-get-api-uri server-dat)))
 	  (handle-exceptions
 	    exn
 	    (begin
 	      (print-call-chain *default-log-port*)
-	      (debug:print-error 0 *default-log-port* " closing connection failed with error: " ((condition-property-accessor 'exn 'message) exn)))
+	      (debug:print-error 0 *default-log-port* " closing connection failed with error: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn))
 	    (close-connection! api-dat)
             ;;(close-idle-connections!)
 	    #t))
 	#f)))
 
@@ -431,11 +435,14 @@
          (last-access 0)
 	 (server-timeout (server:expiration-timeout))
 	 (server-going  #f)
 	 (server-log-file (args:get-arg "-log"))) ;; always set when we are a server
 
-    (with-output-to-file started-file (lambda ()(print (current-process-id))))
+    (handle-exceptions
+	exn
+      (debug:print 0 *default-log-port* "Failed to create " started-file ", exn=" exn)
+      (with-output-to-file started-file (lambda ()(print (current-process-id)))))
 
     (let loop ((count         0)
 	       (server-state 'available)
 	       (bad-sync-count 0)
 	       (start-time     (current-milliseconds)))
@@ -494,11 +501,11 @@
           (if (common:low-noise-print 120 "server continuing")
               (debug:print-info 0 *default-log-port* "Server continuing, seconds since last db access: " (- (current-seconds) last-access))
 	      (let ((curr-time (current-seconds)))
 		(handle-exceptions
 		    exn
-		    (debug:print 0 *default-log-port* "ERROR: Failed to change timestamp on log file " server-log-file ". Are you out of space on that disk?")
+		    (debug:print 0 *default-log-port* "ERROR: Failed to change timestamp on log file " server-log-file ". Are you out of space on that disk? exn=" exn)
 		  (if (not *server-overloaded*)
 		      (change-file-times server-log-file curr-time curr-time)))))
           (loop 0 server-state bad-sync-count (current-milliseconds)))
          (else
           (debug:print-info 0 *default-log-port* "Server timed out. seconds since last db access: " (- (current-seconds) last-access))
@@ -550,17 +557,22 @@
 	 (server-started      (conc tmp-area "/.server-started"))
 	 (start-time          (common:lazy-modification-time server-start))
 	 (started-time        (common:lazy-modification-time server-started))
 	 (server-starting     (< start-time started-time)) ;; if start-time is less than started-time then a server is still starting
 	 (start-time-old      (> (- (current-seconds) start-time) 5))
-         (cleanup-proc        (lambda (msg)
+         (cleanup-proc        (lambda (msg) ;; would like to use (modulo (current-seconds) 60) instead of process-id to wrap filenames
                                 (let* ((serv-fname      (conc "server-" (current-process-id) "-" (get-host-name) ".log"))
+				       (new-fname       (conc "server-" (modulo (current-seconds) 60) "-" (get-host-name) ".log"))
                                        (full-serv-fname (conc *toppath* "/logs/" serv-fname))
-                                       (new-serv-fname  (conc *toppath* "/logs/" "defunct-" serv-fname)))
+                                       ;; (new-serv-fname  (conc *toppath* "/logs/" "defunct-" serv-fname))
+				       (new-serv-fname  (conc *toppath* "/logs/" new-fname))
+				       )
                                   (debug:print 0 *default-log-port* msg)
                                   (if (common:file-exists? full-serv-fname)
-                                      (system (conc "sleep 1;mv -f " full-serv-fname " " new-serv-fname))
+				      (with-output-to-pipe "at now + 10 minutes" (lambda ()
+										   (print "mv -f " full-serv-fname " " new-serv-fname)))
+                                      ;; (system (conc "sleep 10;mv -f " full-serv-fname " " new-serv-fname))
                                       (debug:print 0 *default-log-port* "INFO: cannot move " full-serv-fname " to " new-serv-fname))
                                   (exit)))))
     (if (and (not start-time-old) ;; last server start try was less than five seconds ago
 	     (not server-starting))
 	(begin

Index: launch.scm
==================================================================
--- launch.scm
+++ launch.scm
@@ -19,11 +19,12 @@
 ;;======================================================================
 ;; launch a task - this runs on the originating host, tests themselves
 ;;
 ;;======================================================================
 
-(use regex regex-case base64 sqlite3 srfi-18 directory-utils posix-extras z3 call-with-environment-variables csv)
+(use regex regex-case base64 sqlite3 srfi-18 directory-utils posix-extras z3
+     call-with-environment-variables csv)
 (use typed-records pathname-expand matchable)
 
 (import (prefix base64 base64:))
 (import (prefix sqlite3 sqlite3:))
 
@@ -30,14 +31,16 @@
 (declare (unit launch))
 (declare (uses subrun))
 (declare (uses common))
 (declare (uses configf))
 (declare (uses db))
+(declare (uses ezsteps))
 
 (include "common_records.scm")
 (include "key_records.scm")
 (include "db_records.scm")
+(include "megatest-fossil-hash.scm")
 
 ;;======================================================================
 ;; ezsteps
 ;;======================================================================
 
@@ -48,13 +51,19 @@
 ;; stepname {VAR=first,second,third ...} command ...
 ;; where the {VAR=first,second,third ...} is optional.
 
 ;; given an exit code and whether or not logpro was used calculate OK/BAD
 ;; return #t if we are ok, #f otherwise
-(define (steprun-good? logpro exitcode)
+(define (steprun-good? logpro exitcode stepparms)
   (or (eq? exitcode 0)
-      (and logpro (eq? exitcode 2))))
+      (and logpro (eq? exitcode 2)) ;; shouldn't this be (member exitcode 2 ...) with the other ok codes?
+      (let* ((params (alist-ref 'params stepparms)) ;; get the params section
+	     (keep-going (if params
+			     (alist-ref "keep-going" params equal?)
+			     #f)))
+	(debug:print 0 *default-log-port* "keep-going=" keep-going)
+	(and keep-going (equal? (car keep-going) "yes")))))
 
 ;; if handed a string, process it, else look for MT_CMDINFO
 (define (launch:get-cmdinfo-assoc-list #!key (encoded-cmd #f))
   (let ((enccmd (if encoded-cmd encoded-cmd (getenv "MT_CMDINFO"))))
     (if enccmd
@@ -85,199 +94,10 @@
 	   ((equal? status "PASS") "PASS") ;; skip the message part if status is pass
 	   (status (conc (configf:lookup dat "final" "exit-status") ": " (if msg msg "no message")))
 	   (else #f)))
 	#f)))
 
-(define (launch:runstep ezstep run-id test-id exit-info m tal testconfig) ;;; TODO: deprecate me in favor of ezsteps.scm
-  (let* ((stepname       (car ezstep))  ;; do stuff to run the step
-	 (stepinfo       (cadr ezstep))
-	;; (let ((info (cadr ezstep)))
-	;; 		   (if (proc? info) "" info)))
-	;; (stepproc       (let ((info (cadr ezstep)))
-	;; 		   (if (proc? info) info #f)))
-	 (stepparts      (string-match (regexp "^(\\{([^\\}\\{]*)\\}\\s*|)(.*)$") stepinfo))
-	 (stepparams     (if (and (list? stepparts)
-				  (> (length stepparts) 1))
-			     (list-ref stepparts 2)
-			     #f)) ;; for future use, {VAR=1,2,3}, run step for each
-	 (paramparts     (if (string? stepparams)
-			     (map (lambda (x)(string-split x "=")) (string-split-fields "[^;]*=[^;]*" stepparams))
-			     '()))
-	 (subrun         (alist-ref "subrun" paramparts equal?))
-	 (stepcmd        (if (and (list? stepparts)
-				  (> (length stepparts) 2))
-			     (list-ref stepparts 3)
-			     (conc "# error, no command for step "stepname)))
-	 (script         "") ; "#!/bin/bash\n") ;; yep, we depend on bin/bash FIXME!!!\
-	 (logpro-file    (conc stepname ".logpro"))
-	 (html-file      (conc stepname ".html"))
-	 (dat-file       (conc stepname ".dat"))
-	 (tconfig-logpro (configf:lookup testconfig "logpro" stepname))
-	 (logpro-used    (common:file-exists? logpro-file)))
-
-    (debug:print 0 *default-log-port* "stepparts: " stepparts ", stepparams: " stepparams
-                 ", paramparts: " paramparts ", subrun: " subrun ", stepcmd: " stepcmd)
-    
-    (if (and tconfig-logpro
-	     (not logpro-used)) ;; no logpro file found but have a defn in the testconfig
-	(begin
-	  (with-output-to-file logpro-file
-	    (lambda ()
-	      (print ";; logpro file extracted from testconfig\n"
-		     ";;")
-	      (print tconfig-logpro)))
-	  (set! logpro-used #t)))
-    
-    ;; NB// can safely assume we are in test-area directory
-    (debug:print 4 *default-log-port* "ezsteps:\n stepname: " stepname " stepinfo: " stepinfo " stepparts: " stepparts
-		 " stepparams: " stepparams " stepcmd: " stepcmd)
-    
-    ;; ;; first source the previous environment
-    ;; (let ((prev-env (conc ".ezsteps/" prevstep (if (string-search (regexp "csh") 
-    ;;      							 (get-environment-variable "SHELL")) ".csh" ".sh"))))
-    ;;   (if (and prevstep (common:file-exists? prev-env))
-    ;;       (set! script (conc script "source " prev-env))))
-    
-    ;; call the command using mt_ezstep
-    ;; (set! script (conc "mt_ezstep " stepname " " (if prevstep prevstep "x") " " stepcmd))
-    
-    (debug:print 4 *default-log-port* "script: " script)
-    (rmt:teststep-set-status! run-id test-id stepname "start" "-" #f #f)
-    ;; now launch the actual process
-    (call-with-environment-variables 
-     (list (cons "PATH" (conc (get-environment-variable "PATH") ":.")))
-     (lambda () ;; (process-run "/bin/bash" "-c" "exec ls -l /tmp/foobar > /tmp/delme-more.log 2>&1")
-       (let* ((cmd (conc stepcmd " > " stepname ".log 2>&1")) ;; >outfile 2>&1 
-	      (pid #f))
-	 (let ((proc (lambda ()
-		       (set! pid (process-run "/bin/bash" (list "-c" cmd))))))
-	   (if subrun
-               (begin
-                 (debug:print-info 0 *default-log-port* "Running without MT_.* environment variables.")
-                 (common:without-vars proc "^MT_.*"))
-	       (proc)))
-	 
-         (with-output-to-file "Makefile.ezsteps"
-           (lambda ()
-             (print stepname ".log :")
-             (print "\t" cmd)
-             (if (common:file-exists? (conc stepname ".logpro"))
-                 (print "\tlogpro " stepname ".logpro " stepname ".html < " stepname ".log"))
-             (print)
-             (print stepname " : " stepname ".log")
-             (print))
-           #:append)
-
-	 (rmt:test-set-top-process-pid run-id test-id pid)
-	 (let processloop ((i 0))
-	   (let-values (((pid-val exit-status exit-code)(process-wait pid #t)))
-		       (mutex-lock! m)
-		       (launch:einf-pid-set!         exit-info pid)         ;; (vector-set! exit-info 0 pid)
-		       (launch:einf-exit-status-set! exit-info exit-status) ;; (vector-set! exit-info 1 exit-status)
-		       (launch:einf-exit-code-set!   exit-info exit-code)   ;; (vector-set! exit-info 2 exit-code)
-		       (mutex-unlock! m)
-		       (if (eq? pid-val 0)
-			   (begin
-			     (thread-sleep! 2)
-			     (processloop (+ i 1))))
-		       )))))
-    (debug:print-info 0 *default-log-port* "step " stepname " completed with exit code " (launch:einf-exit-code exit-info)) ;; (vector-ref exit-info 2))
-    ;; now run logpro if needed
-    (if logpro-used
-	(let* ((logpro-exe (or (getenv "LOGPRO_EXE") "logpro"))
-               (pid        (process-run (conc "/bin/sh -c '"logpro-exe" "logpro-file " " (conc stepname ".html") " < " stepname ".log > /dev/null'"))))
-	  (let processloop ((i 0))
-	    (let-values (((pid-val exit-status exit-code)(process-wait pid #t)))
-			(mutex-lock! m)
-			;; (make-launch:einf pid: pid exit-status: exit-status exit-code: exit-code)
-			(launch:einf-pid-set!         exit-info pid)         ;; (vector-set! exit-info 0 pid)
-			(launch:einf-exit-status-set! exit-info exit-status) ;; (vector-set! exit-info 1 exit-status)
-			(launch:einf-exit-code-set!   exit-info exit-code)   ;; (vector-set! exit-info 2 exit-code)
-			(mutex-unlock! m)
-			(if (eq? pid-val 0)
-			    (begin
-			      (thread-sleep! 2)
-			      (processloop (+ i 1)))))
-	    (debug:print-info 0 *default-log-port* "logpro for step " stepname " exited with code " (launch:einf-exit-code exit-info))))) ;; (vector-ref exit-info 2)))))
-    
-    (let ((exinfo (launch:einf-exit-code exit-info)) ;; (vector-ref exit-info 2))
-	  (logfna (if logpro-used (conc stepname ".html") ""))
-	  (comment #f))
-      (if logpro-used
-	  (let ((datfile (conc stepname ".dat")))
-	    ;; load the .dat file into the test_data table if it exists
-	    (if (common:file-exists? datfile)
-		(set! comment (launch:load-logpro-dat run-id test-id stepname)))
-	    (rmt:test-set-log! run-id test-id (conc stepname ".html"))))
-      (rmt:teststep-set-status! run-id test-id stepname "end" exinfo comment logfna))
-    ;; set the test final status
-    (let* ((process-exit-status (launch:einf-exit-code exit-info)) ;; (vector-ref exit-info 2))
-	   (this-step-status (cond
-			      ((and (eq? process-exit-status 2) logpro-used) 'warn)   ;; logpro 2 = warnings
-			      ((and (eq? process-exit-status 3) logpro-used) 'check)  ;; logpro 3 = check
-			      ((and (eq? process-exit-status 4) logpro-used) 'waived) ;; logpro 4 = waived
-			      ((and (eq? process-exit-status 5) logpro-used) 'abort)  ;; logpro 5 = abort
-			      ((and (eq? process-exit-status 6) logpro-used) 'skip)   ;; logpro 6 = skip
-			      ((eq? process-exit-status 0)                   'pass)   ;; logpro 0 = pass
-			      (else 'fail)))
-	   (overall-status   (cond
-			      ((eq? (launch:einf-rollup-status exit-info) 2) 'warn) ;; rollup-status (vector-ref exit-info 3)
-			      ((eq? (launch:einf-rollup-status exit-info) 0) 'pass) ;; (vector-ref exit-info 3)
-			      (else 'fail)))
-	   (next-status      (cond 
-			      ((eq? overall-status 'pass) this-step-status)
-			      ((eq? overall-status 'warn)
-			       (if (eq? this-step-status 'fail) 'fail 'warn))
-			      ((eq? overall-status 'abort) 'abort)
-			      (else 'fail)))
-	   (next-state       ;; "RUNNING") ;; WHY WAS THIS CHANGED TO NOT USE (null? tal) ??
-	    (cond
-	     ((null? tal) ;; more to run?
-	      "COMPLETED")
-	     (else "RUNNING"))))
-      (debug:print 4 *default-log-port* "Exit value received: " (launch:einf-exit-code exit-info) " logpro-used: " logpro-used 
-		   " this-step-status: " this-step-status " overall-status: " overall-status 
-		   " next-status: " next-status " rollup-status: "  (launch:einf-rollup-status exit-info)) ;; (vector-ref exit-info 3))
-      (case next-status
-	((warn)
-	 (launch:einf-rollup-status-set! exit-info 2) ;; (vector-set! exit-info 3 2) ;; rollup-status
-	 ;; NB// test-set-status! does rdb calls under the hood
-	 (tests:test-set-status! run-id test-id next-state "WARN" 
-				 (if (eq? this-step-status 'warn) "Logpro warning found" #f)
-				 #f))
-	((check)
-	 (launch:einf-rollup-status-set! exit-info 3) ;; (vector-set! exit-info 3 3) ;; rollup-status
-	 ;; NB// test-set-status! does rdb calls under the hood
-	 (tests:test-set-status! run-id test-id next-state "CHECK" 
-				 (if (eq? this-step-status 'check) "Logpro check found" #f)
-				 #f))
-	((waived)
-	 (launch:einf-rollup-status-set! exit-info 4) ;; (vector-set! exit-info 3 3) ;; rollup-status
-	 ;; NB// test-set-status! does rdb calls under the hood
-	 (tests:test-set-status! run-id test-id next-state "WAIVED" 
-				 (if (eq? this-step-status 'check) "Logpro waived found" #f)
-				 #f))
-	((abort)
-	 (launch:einf-rollup-status-set! exit-info 5) ;; (vector-set! exit-info 3 4) ;; rollup-status
-	 ;; NB// test-set-status! does rdb calls under the hood
-	 (tests:test-set-status! run-id test-id next-state "ABORT" 
-				 (if (eq? this-step-status 'abort) "Logpro abort found" #f)
-				 #f))
-	((skip)
-	 (launch:einf-rollup-status-set! exit-info 6) ;; (vector-set! exit-info 3 4) ;; rollup-status
-	 ;; NB// test-set-status! does rdb calls under the hood
-	 (tests:test-set-status! run-id test-id next-state "SKIP" 
-				 (if (eq? this-step-status 'skip) "Logpro skip found" #f)
-				 #f))
-	((pass)
-	 (tests:test-set-status! run-id test-id next-state "PASS" #f #f))
-	(else ;; 'fail
-	 (launch:einf-rollup-status-set! exit-info 1) ;; (vector-set! exit-info 3 1) ;; force fail, this used to be next-state but that doesn't make sense. should always be "COMPLETED" 
-	 (tests:test-set-status! run-id test-id "COMPLETED" "FAIL" (conc "Failed at step " stepname) #f)
-	 )))
-    logpro-used))
-
 (define (launch:manage-steps run-id test-id item-path fullrunscript ezsteps subrun test-name tconfigreg exit-info m)
   ;; (let-values
   ;;  (((pid exit-status exit-code)
   ;;    (run-n-wait fullrunscript)))
   ;; (tests:test-set-status! test-id "RUNNING" "n/a" #f #f)
@@ -348,31 +168,41 @@
                     (append (or ezstepslst '())
                             (list (list "subrun" (conc "{subrun=true} " mt-cmd)))))))
 
 	;; process the ezsteps
 	(if ezsteps
-	    (begin
+	    (let* ((envdbf        (conc "/tmp/."(current-user-name)"-"(current-process-id)"-"run-id"-"test-id".db"))
+		   (all-steps-dat (make-hash-table))) ;; keep all the info around as stepname ==> alist;
+	                                              ;;; where  'params is the params list (add other
+	                                              ;;; stuff as needed)
 	      (if (not (common:file-exists? ".ezsteps"))(create-directory ".ezsteps"))
 	      ;; if ezsteps was defined then we are sure to have at least one step but check anyway
 	      (if (not (> (length ezstepslst) 0))
 		  (debug:print-error 0 *default-log-port* "ezsteps defined but ezstepslst is zero length")
-		  (let loop ((ezstep (car ezstepslst))
-			     (tal    (cdr ezstepslst))
-			     (prevstep #f))
-                    (debug:print-info 0 *default-log-port* "Processing ezstep \"" (string-intersperse ezstep " ") "\"")
-		    ;; check exit-info (vector-ref exit-info 1)
-		    (if (launch:einf-exit-status exit-info) ;; (vector-ref exit-info 1)
-			(let ((logpro-used (launch:runstep ezstep run-id test-id exit-info m tal testconfig))
-			      (stepname    (car ezstep)))
-			  ;; if logpro-used read in the stepname.dat file
-			  (if (and logpro-used (common:file-exists? (conc stepname ".dat")))
-			      (launch:load-logpro-dat run-id test-id stepname))
-			  (if (steprun-good? logpro-used (launch:einf-exit-code exit-info))
-			      (if (not (null? tal))
-				  (loop (car tal) (cdr tal) stepname))
-			      (debug:print 0 *default-log-port* "WARNING: step " (car ezstep) " failed. Stopping")))
-			(debug:print 0 *default-log-port* "WARNING: a prior step failed, stopping at " ezstep)))))))))
+		  (let ((all-step-names (map car ezstepslst)))
+		    (setenv "MT_STEP_NAMES" (string-intersperse all-step-names " "))
+		    (let loop ((ezstep (car ezstepslst))
+			       (tal    (cdr ezstepslst))
+			       (prevstep #f))
+		      (debug:print-info 0 *default-log-port* "Processing ezstep \"" (string-intersperse ezstep " ") "\"")
+		      ;; check exit-info (vector-ref exit-info 1)
+		      (if (launch:einf-exit-status exit-info) ;; (vector-ref exit-info 1)
+			  (let* ((logpro-used (launch:runstep ezstep run-id test-id exit-info m
+							      tal testconfig all-steps-dat prevstep envdbf))
+				 (stepname    (car ezstep))
+				 (stepparms   (hash-table-ref all-steps-dat stepname)))
+			    (setenv "MT_STEP_NAME" stepname)
+			    (pp (hash-table->alist all-steps-dat))
+			    ;; if logpro-used read in the stepname.dat file
+			    (if (and logpro-used (common:file-exists? (conc stepname ".dat")))
+				(launch:load-logpro-dat run-id test-id stepname))
+			    (if (steprun-good? logpro-used (launch:einf-exit-code exit-info) stepparms)
+				(if (not (null? tal))
+				    (loop (car tal) (cdr tal) stepname))
+				(debug:print 0 *default-log-port* "WARNING: step " (car ezstep) " failed. Stopping")))
+			  (debug:print 0 *default-log-port* "WARNING: a prior step failed, stopping at " ezstep))
+		      ))))))))
 
 (define (launch:monitor-job run-id test-id item-path fullrunscript ezsteps test-name tconfigreg exit-info m work-area runtlim misc-flags)
   (let* ((update-period (string->number (or (configf:lookup *configdat* "setup" "test-stats-update-period") "30")))
          (start-seconds (current-seconds))
 	 (calc-minutes  (lambda ()
@@ -382,17 +212,19 @@
 			     (current-seconds) 
 			     start-seconds)))))
 	 (kill-tries 0))
     ;; (tests:set-full-meta-info #f test-id run-id (calc-minutes) work-area)
     ;; (tests:set-full-meta-info test-id run-id (calc-minutes) work-area)
-    (tests:set-full-meta-info #f test-id run-id (calc-minutes) work-area 10)
+    (tests:set-full-meta-info #f test-id run-id (calc-minutes) work-area 10 update-db: #t)
 
     (let loop ((minutes   (calc-minutes))
 	       (cpu-load  (alist-ref 'adj-core-load (common:get-normalized-cpu-load #f)))
 	       (disk-free (get-df (current-directory)))
                (last-sync (current-seconds)))
-      (common:telemetry-log "zombie" (conc "launch:monitor-job - top of loop encountered at "(current-seconds)" with last-sync="last-sync))
+      ;; (common:telemetry-log "zombie" (conc "launch:monitor-job -
+      ;; top of loop encountered at "(current-seconds)" with
+      ;; last-sync="last-sync))
       (let* ((over-time     (> (current-seconds) (+ last-sync update-period)))
              (new-cpu-load  (let* ((load  (alist-ref 'adj-core-load (common:get-normalized-cpu-load #f)))
                                    (delta (abs (- load cpu-load))))
                               (if (> delta 0.1) ;; don't bother updating with small changes
                                   load
@@ -410,33 +242,28 @@
              (test-info   (rmt:get-test-info-by-id run-id test-id))
              (state       (db:test-get-state test-info))
              (status      (db:test-get-status test-info))
              (kill-reason  "no kill reason specified")
              (kill-job?    #f))
-        (common:telemetry-log "zombie" (conc "launch:monitor-job - decision time encountered at "(current-seconds)" with last-sync="last-sync" do-sync="do-sync" over-time="over-time" update-period="update-period))
+        #;(common:telemetry-log "zombie" (conc "launch:monitor-job - decision time encountered at "(current-seconds)" with last-sync="last-sync" do-sync="do-sync" over-time="over-time" update-period="update-period))
         (cond
          ((test-get-kill-request run-id test-id)
           (set! kill-reason "KILLING TEST since received kill request (KILLREQ)")
           (set! kill-job? #t))
          ((and runtlim (> (- (current-seconds) start-seconds) runtlim))
           (set! kill-reason (conc "KILLING TEST DUE TO TIME LIMIT EXCEEDED! Runtime=" (- (current-seconds) start-seconds) " seconds, limit=" runtlim))
           (set! kill-job? #t))
          ((equal? status "DEAD")
-          (tests:update-central-meta-info run-id test-id new-cpu-load new-disk-free (calc-minutes) #f #f)
+          (tests:update-central-meta-info run-id test-id new-cpu-load new-disk-free (calc-minutes) #f #f update-db: #t)
           (rmt:set-state-status-and-roll-up-items run-id test-id 'foo "RUNNING" "n/a" "was marked dead; really still running.")
           ;;(set! kill-reason "KILLING TEST because it was marked as DEAD by launch:handle-zombie-tests (might indicate really overloaded server or else overzealous setup.deadtime)") ;; MARK RUNNING
           (set! kill-job? #f)))
 
         (debug:print 4 *default-log-port* "cpu: " new-cpu-load " disk: " new-disk-free " last-sync: " last-sync " do-sync: " do-sync)
         (launch:handle-zombie-tests run-id)
-        (when do-sync
-          ;;(with-output-to-file (conc (getenv "MT_TEST_RUN_DIR") "/last-loadinfo.log" #:append)
-          ;;  (lambda () (pp (list (current-seconds) new-cpu-load new-disk-free (calc-minutes)))))
-          (common:telemetry-log "zombie" (conc  "launch:monitor-job - dosync started at "(current-seconds)))
-          (tests:update-central-meta-info run-id test-id new-cpu-load new-disk-free (calc-minutes) #f #f)
-          (common:telemetry-log "zombie" (conc "launch:monitor-job - dosync finished at "(current-seconds))))
-        
+        (if do-sync ;; save meta data about the running of this test
+	    (tests:update-central-meta-info run-id test-id new-cpu-load new-disk-free (calc-minutes) #f #f))
 	(if kill-job? 
 	    (begin
               (debug:print-info 0 *default-log-port* "proceeding to kill test: "kill-reason)
 	      (mutex-lock! m)
 	      ;; NOTE: The pid can change as different steps are run. Do we need handshaking between this
@@ -451,11 +278,11 @@
 		       (lambda (pid)
 			 (handle-exceptions
 			  exn
 			  (begin
 			    (debug:print-info 0 *default-log-port* "Unable to kill process with pid " pid ", possibly already killed.")
-			    (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn)))
+			    (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn))
 			  (debug:print 0 *default-log-port* "WARNING: Request received to kill job " pid) ;;  " (attempt # " kill-tries ")")
 			  (debug:print-info 0 *default-log-port* "Signal mask=" (signal-mask))
 			  ;; (if (process:alive? pid)
 			  ;;     (begin
 			  (map (lambda (pid-num)
@@ -463,13 +290,15 @@
 			       (process:get-sub-pids pid))
 			  (thread-sleep! 5)
 			  ;; (if (process:process-alive? pid)
 			  (map (lambda (pid-num)
 				 (handle-exceptions
-				  exn
-				  #f
-				  (process-signal pid-num signal/kill)))
+				     exn
+				   (begin
+				     (debug:print 0 *default-log-port* " .... had trouble sending kill to " pid-num ", exn=" exn)
+				     #f)
+				   (process-signal pid-num signal/kill)))
 			       (process:get-sub-pids pid))))
 		       ;;    (debug:print-info 0 *default-log-port* "not killing process " pid " as it is not alive"))))
 		       pids)
                       ;; BB: question to Matt -- does the tests:test-state-status! encompass rollup to toplevel?  If not, should it?
 		      (tests:test-set-status! run-id test-id "KILLED"  "KILLED" (conc (args:get-arg "-m")" "kill-reason) #f)) ;; BB ADDED kill-reason -- confirm OK with Matt
@@ -487,11 +316,11 @@
 	      (if (hash-table-ref/default misc-flags 'keep-going #f)  ;; keep originals for cpu-load and disk-free unless they change more than the allowed delta
 		  (loop (calc-minutes)
                         (or new-cpu-load cpu-load)
                         (or new-disk-free disk-free)
                         (if do-sync (current-seconds) last-sync)))))))
-    (tests:update-central-meta-info run-id test-id (get-cpu-load) (get-df (current-directory))(calc-minutes) #f #f))) ;; NOTE: Checking twice for keep-going is intentional
+    (tests:update-central-meta-info run-id test-id (get-cpu-load) (get-df (current-directory))(calc-minutes) #f #f update-db: #t))) ;; NOTE: Checking twice for keep-going is intentional
 
 
 (define (launch:execute encoded-cmd)
   (let* ((cmdinfo    (common:read-encoded-string encoded-cmd))
 	 (tconfigreg #f))
@@ -573,11 +402,10 @@
                                             ;; one more time, change to the work-area directory
                                             (change-directory work-area)))
 	       ) ;; let*
 
 	  (if contour (setenv "MT_CONTOUR" contour))
-	  
 	  ;; immediated set some key variables from CMDINFO data, yes, these will be set again below ...
 	  ;;
 	  (setenv "MT_TESTSUITENAME" areaname)
 	  (setenv "MT_RUN_AREA_HOME" top-path)
 	  (set! *toppath* top-path)
@@ -640,10 +468,13 @@
 				  (debug:print 0 *default-log-port* "ERROR: failed to find a record for test-id " test-id ", exiting.")
 				  (exit))))
 		 (test-pid  (db:test-get-process_id  test-info)))
 	    (cond
              ;; -mrw- I'm removing KILLREQ from this list so that a test in KILLREQ state is treated as a "do not run" flag.
+	     ;;((or (member (db:test-get-state test-info) '("INCOMPLETE" "KILLED" "UNKNOWN" "STUCK")) ;; prior run of this test didn't complete, go ahead and try to rerun
+	     ;;	  (and (equal? (db:test-get-state test-info) "COMPLETED")                           ;; completed/abort => rerun if asked
+	     ;;	       (member (db:test-get-status test-info) '("ABORT"))))
 	     ((member (db:test-get-state test-info) '("INCOMPLETE" "KILLED" "UNKNOWN" "STUCK")) ;; prior run of this test didn't complete, go ahead and try to rerun
 	      (debug:print 0 *default-log-port* "INFO: test is INCOMPLETE or KILLED, treat this execute call as a rerun request")
 	      ;; (tests:test-force-state-status! run-id test-id "REMOTEHOSTSTART" "n/a")
 
               (rmt:general-call 'set-test-start-time #f test-id)
@@ -651,15 +482,17 @@
 	      ) ;; prime it for running
 	     ((member (db:test-get-state test-info) '("RUNNING" "REMOTEHOSTSTART"))
 	      (if (process:alive-on-host? test-host test-pid)
 		  (debug:print-error 0 *default-log-port* "test state is "  (db:test-get-state test-info) " and process " test-pid " is still running on host " test-host ", cannot proceed")
 		  (exit)))
+	     ((member (db:test-get-state test-info) '("COMPLETED"))  ;; we do NOT want to re-run COMPLETED jobs. Mark as NOT_STARTED to run!
+	      (debug:print-error 0 *default-log-port* "test state is " (db:test-get-state test-info) ", cannot proceed")
+	      (exit))
 	     ((not (member (db:test-get-state test-info) '("REMOVING" "REMOTEHOSTSTART" "RUNNING" "KILLREQ")))
 	      ;; (tests:test-force-state-status! run-id test-id "REMOTEHOSTSTART" "n/a")
               (rmt:general-call 'set-test-start-time #f test-id)
-	      (rmt:test-set-state-status run-id test-id "REMOTEHOSTSTART" "n/a" #f)
-	      )
+	      (rmt:test-set-state-status run-id test-id "REMOTEHOSTSTART" "n/a" #f))
 	     (else ;; (member (db:test-get-state test-info) '("REMOVING" "REMOTEHOSTSTART" "RUNNING" "KILLREQ"))
 	      (debug:print-error 0 *default-log-port* "test state is " (db:test-get-state test-info) ", cannot proceed")
 	      (exit))))
 
           ;; cleanup prior execution's steps
@@ -903,11 +736,11 @@
 ;; > 3 RUNNING with not test_dead do nothing (run should already be RUNNING/ na
 ;; > 0 RUNNING and test_dead then send KILLREQ ==> COMPLETED
 ;; 0 RUNNING ==> this is actually the first condition, should not get here
 
 (define (launch:end-of-run-check run-id )
-    (let*	((not-completed-cnt (rmt:get-not-completed-cnt run-id))  
+    (let* ((not-completed-cnt (rmt:get-not-completed-cnt run-id))  
            (running-cnt (rmt:get-count-tests-running-for-run-id run-id))
            (all-test-launched (rmt:get-var (conc "lunch-complete-" run-id)))
            (current-state (rmt:get-run-state run-id))
            (current-status (rmt:get-run-status run-id)))
      ;;get-vars run-id to query metadata table to check if all completed. if all-test-launched = yes then only not-completed-cnt = 0 means everyting is completed if no entry found in the table do nothing 
@@ -944,11 +777,13 @@
               (if (not (null? tal))
 				  (loop (car tal) (cdr tal)))))))))))        
  
 (define (launch:is-test-alive host pid)
   (if (and host pid (not (equal? host "n/a")))
-      (let* ((cmd (conc "ssh " host " pstree -A " pid))
+      (let* ((is-local (equal? host (get-host-name)))
+	     (ssh-cmd   (if is-local " " (conc "ssh " host " ")))
+	     (cmd (conc ssh-cmd "pstree -A " pid))
 	     (output (with-input-from-pipe cmd read-lines)))
 	(debug:print 2 *default-log-port* "Running " cmd " received " output)
 	(if (eq? (length output) 0)
 	   #f
 	   #t))
@@ -977,45 +812,11 @@
 				  (loop (car tal) (cdr tal) (+ kill-cnt flag))
                  (+ kill-cnt flag))))))
 
 ;; DO NOT USE - caching of configs is handled in launch:setup now.
 ;;
-(define (launch:cache-config)
-  ;; if we have a linktree and -runtests and -target and the directory exists dump the config
-  ;; to megatest-(current-seconds).cfg and symlink it to megatest.cfg
-  (if (and *configdat* 
-	   (or (args:get-arg "-run")
-	       (args:get-arg "-runtests")
-	       (args:get-arg "-execute")))
-      (let* ((linktree (common:get-linktree)) ;; (get-environment-variable "MT_LINKTREE"))
-	     (target   (common:args-get-target exit-if-bad: #t))
-	     (runname  (or (args:get-arg "-runname")
-			   (args:get-arg ":runname")
-			   (getenv "MT_RUNNAME")))
-	     (fulldir  (conc linktree "/"
-			     target "/"
-			     runname)))
-	(if (and linktree (common:file-exists? linktree)) ;; can't proceed without linktree
-	    (begin
-	      (debug:print-info 0 *default-log-port* "Have -run with target=" target ", runname=" runname ", fulldir=" fulldir ", testpatt=" (or (args:get-arg "-testpatt") "%"))
-	      (if (not (common:file-exists? fulldir))
-		  (create-directory fulldir #t)) ;; need to protect with exception handler 
-	      (if (and target
-		       runname
-		       (common:file-exists? fulldir))
-		  (let ((tmpfile  (conc fulldir "/.megatest.cfg." (current-seconds)))
-			(targfile (conc fulldir "/.megatest.cfg-"  megatest-version "-" megatest-fossil-hash))
-			(rconfig  (conc fulldir "/.runconfig." megatest-version "-" megatest-fossil-hash)))
-		    (if (common:file-exists? rconfig) ;; only cache megatest.config AFTER runconfigs has been cached
-			(begin
-			  (debug:print-info 0 *default-log-port* "Caching megatest.config in " tmpfile)
-                          (if (not (common:in-running-test?))
-                              (configf:write-alist *configdat* tmpfile))
-			  (system (conc "ln -sf " tmpfile " " targfile))))
-		    )))
-	    (debug:print-info 1 *default-log-port* "No linktree yet, no caching configs.")))))
-
+;; (launch:cache-config) moved to attic below
 
 ;; gather available information, if legit read configs in this order:
 ;;
 ;;   if have cache;
 ;;      read it a return it
@@ -1039,14 +840,30 @@
 	(mutex-unlock! *launch-setup-mutex*)
 	*toppath*)
       (let ((res (launch:setup-body force-reread: force-reread areapath: areapath)))
 	(mutex-unlock! *launch-setup-mutex*)
 	res)))
+
+(define (launch:cache-files-changed? cache-files ref-seconds)
+  (let* ((changed #f))
+    (if (or (not cache-files)
+	    (null? cache-files))
+	(set! changed #t) ;; yep, they've changed
+	(for-each
+	 (lambda (fname)
+	   (if (not fname)
+	       (set! changed #t)
+	       (if (not (file-exists? fname))
+		   (set! changed #t)
+		   (if (> (file-modification-time fname) ref-seconds)
+		       (set! changed #t)))))
+	 cache-files))
+    changed))
 
 ;; return paths depending on what info is available.
 ;;
-(define (launch:get-cache-file-paths areapath toppath target mtconfig)
+(define (launch:get-cache-file-paths areapath toppath target)
   (let* ((use-cache (common:use-cache?))
          (runname  (common:args-get-runname))
          (linktree (common:get-linktree))
          (testname (common:get-full-test-name))
          (rundir   (if (and runname target linktree)
@@ -1077,11 +894,11 @@
       (let* ((use-cache (common:use-cache?)) ;; BB- use-cache checks *configdat* for use-cache setting.  We do not have *configdat*.  Bootstrapping problem here.
 	     (toppath  (common:get-toppath areapath))
 	     (target   (common:args-get-target))
 	     (sections (if target (list "default" target) #f)) ;; for runconfigs
 	     (mtconfig (or (args:get-arg "-config") "megatest.config")) ;; allow overriding megatest.config 
-             (cachefiles (launch:get-cache-file-paths areapath toppath target mtconfig))
+             (cachefiles (launch:get-cache-file-paths areapath toppath target))
 	     ;; checking for null cachefiles should not be necessary, I was seeing error car of '(), might be a chicken bug or a red herring ...
 	     (mtcachef   (if (null? cachefiles)
 			     #f
 			     (car cachefiles))) ;; (and cachedir (conc cachedir "/" ".megatest.cfg-"  megatest-version "-" megatest-fossil-hash)))
 	     (rccachef   (if (null? cachefiles)
@@ -1158,11 +975,11 @@
 					 (for-each (lambda (kt)
 						     (setenv (car kt) (cadr kt)))
 						   key-vals)
 					 (read-config (conc toppath "/runconfigs.config") *runconfigdat* #t ;; consider using runconfig:read some day ...
 						      sections: sections)))
-                         (cachefiles   (launch:get-cache-file-paths areapath toppath target mtconfig))
+                         (cachefiles   (launch:get-cache-file-paths areapath toppath target))
                          (mtcachef     (car cachefiles))
                          (rccachef     (cdr cachefiles)))
                     ;;  trap exception due to stale NFS handle -- Error: (open-output-file) cannot open file - Stale NFS file handle: "/p/fdk/gwa/lefkowit/mtTesting/qa/primbeqa/links/p1222/11/PDK_r1.1.1/prim/clean/pcell_testgen/.runconfigs.cfg-1.6427-7d1e789cb3f62f9cde719a4865bb51b3c17ea853" - ticket 220546342
                     ;; TODO - consider 1) using simple-lock to bracket cache write
                     ;;                 2) cache in hash on server, since need to do rmt: anyway to lock.
@@ -1216,18 +1033,18 @@
 		    (begin
 		      (handle-exceptions
 			  exn
 			  (begin
 			    (debug:print-error 0 *default-log-port* "Something went wrong when trying to create linktree dir at " linktree)
-			    (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
+			    (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn)
 			    (exit 1))
 			(create-directory linktree #t))))
 		(handle-exceptions
 		    exn
 		    (begin
 		      (debug:print-error 0 *default-log-port* "Something went wrong when trying to create link to linktree at " *toppath*)
-		      (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn)))
+		      (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn))
 		  (let ((tlink (conc *toppath* "/lt")))
 		    (if (not (common:file-exists? tlink))
 			(create-symbolic-link linktree tlink)))))
 	      (begin
 		(debug:print-error 0 *default-log-port* "linktree not defined in [setup] section of megatest.config")
@@ -1241,11 +1058,11 @@
 	      (debug:print-error 0 *default-log-port* "failed to find the top path to your Megatest area.")
 	      (set! *toppath* #f) ;; force it to be false so we return #f
 	      #f))
 	
         ;; one more attempt to cache the configs for future reading
-        (let* ((cachefiles   (launch:get-cache-file-paths areapath toppath target mtconfig))
+        (let* ((cachefiles   (launch:get-cache-file-paths areapath toppath target))
                (mtcachef     (car cachefiles))
                (rccachef     (cdr cachefiles)))
 
           ;; trap exception due to stale NFS handle -- Error: (open-output-file) cannot open file - Stale NFS file handle: "...somepath.../.runconfigs.cfg-1.6427-7d1e789cb3f62f9cde719a4865bb51b3c17ea853" - ticket 220546342
           ;; TODO - consider 1) using simple-lock to bracket cache write
@@ -1288,11 +1105,15 @@
 		;;(exit 1)
                  (if (null? disks)
                      (cons 1 (conc *toppath* "/runs"))
                      (let ((paths (sort disks (lambda (x y) (> (string-length (cadr x)) (string-length (cadr y)))))))
                        (let loop ((head (car paths)) (tail (cdr paths)))
-                         (let ((result (handle-exceptions exn #f (create-directory (cadr head) #t))))
+                         (let ((result (handle-exceptions exn
+					 (begin
+					   (debug:print 0 *default-log-port* "failed to create dir " (cadr head) ", exn=" exn)
+					   #f)
+					 (create-directory (cadr head) #t))))
                            (if result
                                result
                                (if (null? tail)
                                    (cons 1 (conc *toppath* "/runs"))
                                    (loop (car tail) (cdr tail)))))))))))
@@ -1384,11 +1205,11 @@
       (let ((success (if (and (not (common:directory-exists? lnkbase))
 			      (not (common:file-exists? lnkbase)))
 			 (handle-exceptions
 			  exn
 			  (begin
-			    (debug:print-error 0 *default-log-port* "Problem creating linktree base at " lnkbase)
+			    (debug:print-error 0 *default-log-port* "Problem creating linktree base at " lnkbase ", exn=" exn)
 			    (print-error-message exn (current-error-port))
 			    #t)
 			  (create-directory lnkbase #t)
 			  #f))))
 	(if (and (not success)(> done 0))
@@ -1407,28 +1228,31 @@
 	(let ((iterated-parent  (pathname-directory (conc lnkpath "/" item-path))))
 	  (debug:print-info 2 *default-log-port* "Creating iterated parent " iterated-parent)
 	  (handle-exceptions
 	   exn
 	   (begin
-	     (debug:print-error 0 *default-log-port* " Failed to create directory " iterated-parent ((condition-property-accessor 'exn 'message) exn) ", continuing but link tree may be corrupted")
+	     (debug:print-error 0 *default-log-port* " Failed to create directory " iterated-parent ((condition-property-accessor 'exn 'message) exn)
+				", continuing but link tree may be corrupted, exn=" exn)
 	     #;(exit 1))
 	   (create-directory iterated-parent #t))))
 
     (if (symbolic-link? lnkpath) 
 	(handle-exceptions
 	 exn
 	 (begin
-	   (debug:print-error 0 *default-log-port* " Failed to remove symlink " lnkpath ((condition-property-accessor 'exn 'message) exn) ", continuing but link tree may be corrupted.")
+	   (debug:print-error 0 *default-log-port* " Failed to remove symlink " lnkpath ((condition-property-accessor 'exn 'message) exn)
+			      ", continuing but link tree may be corrupted. exn=" exn)
 	   #;(exit 1))
 	 (delete-file lnkpath)))
 
     (if (not (or (common:file-exists? lnkpath)
 		 (symbolic-link? lnkpath)))
 	(handle-exceptions
 	 exn
 	 (begin
-	   (debug:print-error 0 *default-log-port* " Failed to create symlink " lnkpath ((condition-property-accessor 'exn 'message) exn) ", continuing but link tree may be corrupted.")
+	   (debug:print-error 0 *default-log-port* " Failed to create symlink " lnkpath ((condition-property-accessor 'exn 'message) exn)
+			      ", continuing but link tree may be corrupted. exn=" exn)
 	   #;(exit 1))
 	 (create-symbolic-link toptest-path lnkpath)))
     
     ;; NB - This was not working right - some top tests are not getting the path set!!!
     ;;
@@ -1455,12 +1279,14 @@
 	  (if (or (not curr-test-path)
 		  (not (directory-exists? toptest-path)))
 	      (begin
 		(debug:print-info 2 *default-log-port* "Creating " toptest-path " and link " lnkpath)
 		(handle-exceptions
-		 exn
-		 #f ;; don't care to catch and deal with errors here for now.
+		    exn
+		  (begin
+		    (debug:print 0 *default-log-port* "failed to create directory " toptest-path ", exn=" exn)
+		    #f)
 		 (create-directory toptest-path #t))
 		(hash-table-set! *toptest-paths* testname toptest-path)))))
 
     ;; The toptest path has been created, the link to the test in the linktree has
     ;; been created. Now, if this is an iterated test the real test dir must be created
@@ -1469,11 +1295,12 @@
 	  (debug:print 2 *default-log-port* "Setting up sub test run area")
 	  (debug:print 2 *default-log-port* " - creating run area in " test-path)
 	  (handle-exceptions
 	   exn
 	   (begin
-	     (debug:print-error 0 *default-log-port* " Failed to create directory " test-path ((condition-property-accessor 'exn 'message) exn) ", exiting")
+	     (debug:print-error 0 *default-log-port* " Failed to create directory " test-path ((condition-property-accessor 'exn 'message) exn)
+				", exiting, exn=" exn)
 	     (exit 1))
 	   (create-directory test-path #t))
 	  (debug:print 2 *default-log-port* 
 		       " - creating link from: " test-path "\n"
 		       "                   to: " lnktarget)
@@ -1480,11 +1307,11 @@
 
 	  ;; If there is already a symlink delete it and recreate it.
 	  (handle-exceptions
 	   exn
 	   (begin
-	     (debug:print-error 0 *default-log-port* " Failed to re-create link " lnktarget ((condition-property-accessor 'exn 'message) exn) ", exiting")
+	     (debug:print-error 0 *default-log-port* " Failed to re-create link " lnktarget ((condition-property-accessor 'exn 'message) exn) ", exiting, exn=" exn)
 	     (exit))
 	   (if (symbolic-link? lnktarget)     (delete-file lnktarget))
 	   (if (not (common:file-exists? lnktarget)) (create-symbolic-link test-path lnktarget)))))
 
     (if (not (directory? test-path))
@@ -1518,12 +1345,20 @@
       (debug:print 1 *default-log-port* "INFO: search and mark zombie tests")
       (rmt:set-var key (current-seconds))
       (rmt:find-and-mark-incomplete run-id #f))))
 
 
-
+(defstruct launch:ajt
+  (vars '())
+  (exekey #f)
+  (host-type #f)
+  (test-sig  #f)
+  (cmdline   #f))
 
+;; append vars
+(define (launch:ajt-add-vars dat vars)
+  (launch:ajt-vars-set! dat (append (launch:ajt-vars dat) vars)))
 
 ;; 1. look though disks list for disk with most space
 ;; 2. create run dir on disk, path name is meaningful
 ;; 3. create link from run dir to megatest runs area 
 ;; 4. remotely run the test on allocated host
@@ -1530,44 +1365,41 @@
 ;;    - could be ssh to host from hosts table (update regularly with load)
 ;;    - could be netbatch
 ;;      (launch-test db (cadr status) test-conf))
 (define (launch-test test-id run-id run-info keyvals runname test-conf test-name test-path itemdat params)
   (mutex-lock! *launch-setup-mutex*) ;; setting variables and processing the testconfig is NOT thread-safe, reuse the launch-setup mutex
-  (let* ( ;; (lock-key        (conc "test-" test-id))
-	;; (got-lock        (let loop ((lock        (rmt:no-sync-get-lock lock-key))
-	;; 			     (expire-time (+ (current-seconds) 15))) ;; give up on getting the lock and steal it after 15 seconds
-	;; 		    (if (car lock)
-	;; 			#t
-	;; 			(if (> (current-seconds) expire-time)
-	;; 			    (begin
-	;; 			      (debug:print-info 0 *default-log-port* "Timed out waiting for a lock to launch test " keyvals " " runname " " test-name " " test-path)
-	;; 			      (rmt:no-sync-del! lock-key) ;; destroy the lock
-	;; 			      (loop (rmt:no-sync-get-lock lock-key) expire-time)) ;; 
-	;; 			    (begin
-	;; 			      (thread-sleep! 1)
-	;; 			      (loop (rmt:no-sync-get-lock lock-key) expire-time))))))
+  (let* (;; locking code removed from here commented out and pasted at end of file
 	 (item-path       (item-list->path itemdat))
-	 (contour         #f)) ;; NOT READY FOR THIS (args:get-arg "-contour")))
+	 (contour         #f)                         ;; NOT READY FOR THIS (args:get-arg "-contour")))
+	 ;; launcher-mode will be 'adjutant or 'normal
+	 (launcher-mode   (string->symbol (or (configf:lookup *configdat* "jobtools" "mode") "normal")))
+	 (ajtdat          (make-launch:ajt)))
     (let loop ((delta        (- (current-seconds) *last-launch*))
-	       (launch-delay (configf:lookup-number *configdat* "setup" "launch-delay" default: 1)))
+	       (launch-delay (configf:lookup-number *configdat* "setup" "launch-delay" default: 0)))
       (if (> launch-delay delta)
 	  (begin
 	    (if (common:low-noise-print 1200 "test launch delay") ;; every two hours or so remind the user about launch delay.
 		(debug:print-info 0 *default-log-port* "NOTE: test launches are delayed by " launch-delay " seconds. See megatest.config launch-delay setting to adjust.")) ;; launch of " test-name " for " (- launch-delay delta) " seconds"))
 	    (thread-sleep! (- launch-delay delta))
 	    (loop (- (current-seconds) *last-launch*) launch-delay))))
     (change-directory *toppath*)
-    (alist->env-vars ;; consolidate this code with the code in megatest.scm for "-execute", *maybe* - the longer they are set the longer each launch takes (must be non-overlapping with the vars)
-     (append
-      (list
-       (list "MT_RUN_AREA_HOME" *toppath*)
-       (list "MT_TEST_NAME" test-name)
-       (list "MT_RUNNAME"   runname)
-       (list "MT_ITEMPATH"  item-path)
-       (list "MT_CONTOUR"   contour)
-       )
-      itemdat))
+    (let ((var-list (append
+		     (list
+		      (list "MT_RUN_AREA_HOME" *toppath*)
+		      (list "MT_TEST_NAME" test-name)
+		      (list "MT_RUNNAME"   runname)
+		      (list "MT_ITEMPATH"  item-path)
+		      (list "MT_CONTOUR"   contour)
+		      )
+		     itemdat)))
+       ;; consolidate this code with the code in megatest.scm for
+       ;; "-execute", *maybe* - the longer they are set the longer
+       ;; each launch takes (must be non-overlapping with the vars)
+      (alist->env-vars var-list)
+      ;; the var-list into the ajtdat adjutant record whether it is needed or not.
+      (launch:ajt-add-vars ajtdat var-list))
+    
     (let* ((tregistry       (tests:get-all)) ;; third param (below) is system-allowed
            ;; for tconfig, why do we allow fallback to test-conf?
 	   (tconfig         (or (tests:get-testconfig test-name item-path tregistry #t force-create: #t)
 				(begin
                                   (debug:print 0 *default-log-port* "WARNING: falling back to pre-calculated testconfig. This is likely not desired.")
@@ -1585,40 +1417,44 @@
 	   ;; (memory          (configf:lookup tconfig   "requirements" "memory"))
 	   ;; (hosts           (configf:lookup *configdat* "jobtools"     "workhosts")) ;; I'm pretty sure this was never completed
 	   (remote-megatest (configf:lookup *configdat* "setup" "executable"))
 	   (run-time-limit  (or (configf:lookup  tconfig   "requirements" "runtimelim")
 				(configf:lookup  *configdat* "setup" "runtimelim")))
-	   ;; FIXME SOMEDAY: not good how this is so obtuse, this hack is to 
-	   ;;                allow running from dashboard. Extract the path
-	   ;;                from the called megatest and convert dashboard
-	   ;;             	  or dboard to megatest
-	   (local-megatest  (let* ((lm  (car (argv)))
-				   (dir (pathname-directory lm))
-				   (exe (pathname-strip-directory lm)))
-			      (conc (if dir (conc dir "/") "")
-				    (case (string->symbol exe)
-				      ((dboard)    "../megatest")
-				      ((mtest)     "../megatest")
-				      ((dashboard) "megatest")
-				      (else exe)))))
-	   (launcher        (common:get-launcher *configdat* test-name item-path)) ;; (configf:lookup *configdat* "jobtools"     "launcher"))
-	   (test-sig        (conc (common:get-testsuite-name) ":" test-name ":" item-path)) ;; (item-list->path itemdat))) ;; test-path is the full path including the item-path
+	   (local-megatest  (common:find-local-megatest))
+	   (launcher        (let ((l (common:get-launcher *configdat* test-name item-path launcher-mode)))
+			      (if (string? l)
+				  (string-split l)
+				  l))) ;; some nonhomogenuity here. '(cmd param1 param2 ...) OR '(host-type launcher)
+	    ;; (item-list->path itemdat))) ;; test-path is the full path including the item-path
+	   (test-sig        (conc (common:get-testsuite-name) ":" test-name ":" item-path))
 	   (work-area       #f)
 	   (toptest-work-area #f) ;; for iterated tests the top test contains data relevant for all
 	   (diskpath   #f)
 	   (cmdparms   #f)
 	   (fullcmd    #f) ;; (define a (with-output-to-string (lambda ()(write x))))
 	   (mt-bindir-path #f)
 	   (testinfo   (rmt:get-test-info-by-id run-id test-id))
 	   (mt_target  (string-intersperse (map cadr keyvals) "/"))
 	   (debug-param (append (if (args:get-arg "-debug")  (list "-debug" (args:get-arg "-debug")) '())
-				(if (args:get-arg "-logging")(list "-logging") '()))))
+				(if (args:get-arg "-logging")(list "-logging") '())
+				(if (configf:lookup *configdat* "misc" "profilesw")
+				    (list (configf:lookup *configdat* "misc" "profilesw"))
+				    '()))))
+      ;; save the test-sig in the ajtdat record
+      (launch:ajt-test-sig-set! ajtdat test-sig)
+      ;; go ahead and figure out if we have a host-type from the
+      ;; launcher call above and save it in the ajtdat record
+      (if (and (eq? launcher-mode 'adjutant)
+	       (list? launcher)
+	       (> (length launcher) 1))
+	  (launch:ajt-host-type-set! ajtdat (car launcher)))
+ 
       ;; (if hosts (set! hosts (string-split hosts)))
       ;; set the megatest to be called on the remote host
       (if (not remote-megatest)(set! remote-megatest local-megatest)) ;; "megatest"))
       (set! mt-bindir-path (pathname-directory remote-megatest))
-      (if launcher (set! launcher (string-split launcher)))
+      ;; (if launcher (set! launcher (string-split launcher)))           ;; yuk!
       ;; set up the run work area for this test
       (if (and (args:get-arg "-preclean") ;; user has requested to preclean for this run
 	       (not (member (db:test-get-rundir testinfo)(list "n/a" "/tmp/badname")))) ;; n/a is a placeholder and thus not a read dir
 	  (begin
 	    (debug:print-info 0 *default-log-port* "attempting to preclean directory " (db:test-get-rundir testinfo) " for test " test-name "/" item-path)
@@ -1671,64 +1507,92 @@
 					(list 'runtlim   (if run-time-limit (common:hms-string->seconds run-time-limit) #f))
 					(list 'env-ovrd  (hash-table-ref/default *configdat* "env-override" '())) 
 					(list 'set-vars  (if params (hash-table-ref/default params "-setvars" #f)))
 					(list 'runname   runname)
 					(list 'mt-bindir-path mt-bindir-path))))))))
+      ;; save the cmdparms in the ajtdat
+      (launch:ajt-exekey-set! ajtdat cmdparms)
       
       ;; clean out step records from previous run if they exist
       ;; (rmt:delete-test-step-records run-id test-id)
       ;; if the dir does not exist we may have a itempath where individual variables are a path, launch anyway
       (if (common:file-exists? work-area)
 	  (change-directory work-area)) ;; so that log files from the launch process don't clutter the test dir
-      (cond
-       ;; ((and launcher hosts) ;; must be using ssh hostname
-       ;;    (set! fullcmd (append launcher (car hosts)(list remote-megatest "-m" test-sig "-execute" cmdparms) debug-param)))
-       ;; (set! fullcmd (append launcher (car hosts)(list remote-megatest test-sig "-execute" cmdparms))))
+
+      ;; save the command line for adjutant mode (might never be needed but best to assemble it here)
+      (launch:ajt-cmdline-set! ajtdat (string-intersperse
+				       (append (list remote-megatest "-m" test-sig "-execute" cmdparms) debug-param)))
+      (cond       
        (launcher
 	(set! fullcmd (append launcher (list remote-megatest "-m" test-sig "-execute" cmdparms) debug-param)))
-       ;; (set! fullcmd (append launcher (list remote-megatest test-sig "-execute" cmdparms))))
        (else
 	(if (not useshell)(debug:print 0 *default-log-port* "WARNING: internal launching will not work well without \"useshell yes\" in your [jobtools] section"))
 	(set! fullcmd (append (list remote-megatest "-m" test-sig "-execute" cmdparms) debug-param (list (if useshell "&" ""))))))
-      ;; (set! fullcmd (list remote-megatest test-sig "-execute" cmdparms (if useshell "&" "")))))
+      
       (if (args:get-arg "-xterm")(set! fullcmd (append fullcmd (list "-xterm"))))
       (debug:print 1 *default-log-port* "Launching " work-area)
       ;; set pre-launch-env-vars before launching, keep the vars in prevvals and put the envionment back when done
       (debug:print 4 *default-log-port* "fullcmd: " fullcmd)
       (set! *last-launch* (current-seconds)) ;; all that junk above takes time, set this as late as possible.
-      (let* ((commonprevvals (alist->env-vars
-			      (hash-table-ref/default *configdat* "env-override" '())))
-	     (miscprevvals   (alist->env-vars ;; consolidate this code with the code in megatest.scm for "-execute"
-			      (append (list (list "MT_TEST_RUN_DIR" work-area)
-					    (list "MT_TEST_NAME" test-name)
-					    (list "MT_ITEM_INFO" (conc itemdat)) 
-					    (list "MT_RUNNAME"   runname)
-					    (list "MT_TARGET"    mt_target)
-					    (list "MT_ITEMPATH"  item-path)
-					    )
-				      itemdat)))
-	     (testprevvals   (alist->env-vars
-			      (hash-table-ref/default tconfig "pre-launch-env-overrides" '())))
+      (let* ((env-override-vars  (hash-table-ref/default *configdat* "env-override" '()))
+	     (commonprevvals     (alist->env-vars env-override-vars))
+	     (misc-vars          (append (list (list "MT_TEST_RUN_DIR" work-area)
+					       (list "MT_TEST_NAME" test-name)
+					       (list "MT_ITEM_INFO" (conc itemdat)) 
+					       (list "MT_RUNNAME"   runname)
+					       (list "MT_TARGET"    mt_target)
+					       (list "MT_ITEMPATH"  item-path))
+					 itemdat))
+	     (miscprevvals   (alist->env-vars misc-vars));; consolidate this code with the code in megatest.scm for "-execute"
+	     (test-vars      (hash-table-ref/default tconfig "pre-launch-env-overrides" '()))
+	     (testprevvals   (alist->env-vars test-vars))
+			      
 	     ;; Launchwait defaults to true, must override it to turn off wait
 	     (launchwait     (if (equal? (configf:lookup *configdat* "setup" "launchwait") "no") #f #t))
-	     (launch-results-prev (apply (if launchwait ;; BB: TODO: refactor this to examine return code of launcher, if nonzero, set state to launch failed.
-					process:cmd-run-with-stderr-and-exitcode->list
-					process-run)
-				    (if useshell
-					(let ((cmdstr (string-intersperse fullcmd " ")))
-					  (if launchwait
-					      cmdstr
-					      (conc cmdstr " >> mt_launch.log 2>&1 &")))
-					(car fullcmd))
-				    (if useshell
-					'()
-					(cdr fullcmd))))
+	     ;; BB: TODO: refactor this to examine return code of launcher, if nonzero, set state to launch failed.
+	     (launch-results-prev (if (eq? launcher-mode 'adjutant)
+				      '(#t 0) ;; just some fake data to fool downstream but non-applicable code
+				      (apply (if launchwait
+						 process:cmd-run-with-stderr-and-exitcode->list
+						 process-run)
+					     (if useshell
+						 (let ((cmdstr (string-intersperse fullcmd " ")))
+						   (if launchwait
+						       cmdstr
+						       (conc cmdstr " >> mt_launch.log 2>&1 &")))
+						 (car fullcmd))
+					     (if useshell
+						 '()
+						 (cdr fullcmd)))))
              (success        (if launchwait (equal? 0 (cadr launch-results-prev)) #t))
              (launch-results (if launchwait (car launch-results-prev) launch-results-prev)))
-        (if (not success)
+
+	(launch:ajt-add-vars ajtdat env-override-vars)
+	(launch:ajt-add-vars ajtdat misc-vars)
+	(launch:ajt-add-vars ajtdat test-vars)
+
+	;; if in adjutant mode we register the job in the jobs_queue
+	;; then fire off an adjutant runner
+	;;
+	(if (eq? launcher-mode 'adjutant)
+	    (let* ((adjutant-runner-cmd (append (cdr launcher)
+						(list remote-megatest "-adjutant"
+						      (launch:ajt-host-type ajtdat)
+						      "-start-dir" *toppath*)))
+		   (adj-cmd     (conc (string-intersperse (map conc adjutant-runner-cmd) " ")
+				      "&")))         
+	      (rmt:no-sync-add-job
+	       (launch:ajt-host-type  ajtdat)
+	       (launch:ajt-vars ajtdat)
+	       (launch:ajt-exekey     ajtdat)
+	       (launch:ajt-cmdline    ajtdat))
+	      (print "adj-cmd: " adj-cmd)
+	      (system adj-cmd)
+	      ))
+	
+	(if (not success)
             (tests:test-set-status! run-id test-id "COMPLETED" "DEAD" "launcher failed; exited non-zero; check mt_launch.log" #f)) ;; (if launch-results launch-results "FAILED"))
-        (mutex-unlock! *launch-setup-mutex*) ;; yes, really should mutex all the way to here. Need to put this entire process into a fork.
 	;; (rmt:no-sync-del! lock-key)         ;; release the lock for starting this test
 	(if (not launchwait) ;; give the OS a little time to allow the process to start
 	    (thread-sleep! 0.01))
 	(with-output-to-file "mt_launch.log"
 	  (lambda ()
@@ -1750,12 +1614,17 @@
 	      (process-signal (current-process-id) signal/kill)
 	      ))
 	(alist->env-vars miscprevvals)
 	(alist->env-vars testprevvals)
 	(alist->env-vars commonprevvals)
+	;; yes, really should mutex all the way to here. Need to put this entire process into a fork.
+	;; the unlock previously was further up. This seemed wrong as we should not proceed until the
+	;; vars have been reset.
+	(mutex-unlock! *launch-setup-mutex*)
 	launch-results))
-    (change-directory *toppath*)))
+    (change-directory *toppath*)
+    (thread-sleep! (configf:lookup-number *configdat* "setup" "inter-test-delay" default: 0.0))))
 
 ;; recover a test where the top controlling mtest may have died
 ;;
 (define (launch:recover-test run-id test-id)
   ;; this function is called on the test run host via ssh
@@ -1778,5 +1647,60 @@
     ;; now wait on that process if all is correct
     ;; periodically update the db with runtime
     ;; when the process exits look at the db, if still RUNNING after 10 seconds set
     ;; state/status appropriately
     (process-wait pid)))
+
+;;======================================================================
+;; Attic
+;;======================================================================
+
+ ;; (lock-key        (conc "test-" test-id))
+	;; (got-lock        (let loop ((lock        (rmt:no-sync-get-lock lock-key))
+	;; 			     (expire-time (+ (current-seconds) 15))) ;; give up on getting the lock and steal it after 15 seconds
+	;; 		    (if (car lock)
+	;; 			#t
+	;; 			(if (> (current-seconds) expire-time)
+	;; 			    (begin
+	;; 			      (debug:print-info 0 *default-log-port* "Timed out waiting for a lock to launch test " keyvals " " runname " " test-name " " test-path)
+	;; 			      (rmt:no-sync-del! lock-key) ;; destroy the lock
+	;; 			      (loop (rmt:no-sync-get-lock lock-key) expire-time)) ;; 
+	;; 			    (begin
+	;; 			      (thread-sleep! 1)
+	;; 			      (loop (rmt:no-sync-get-lock lock-key) expire-time))))))
+	 
+
+
+#;(define (launch:cache-config)
+  ;; if we have a linktree and -runtests and -target and the directory exists dump the config
+  ;; to megatest-(current-seconds).cfg and symlink it to megatest.cfg
+  (if (and *configdat* 
+	   (or (args:get-arg "-run")
+	       (args:get-arg "-runtests")
+	       (args:get-arg "-execute")))
+      (let* ((linktree (common:get-linktree)) ;; (get-environment-variable "MT_LINKTREE"))
+	     (target   (common:args-get-target exit-if-bad: #t))
+	     (runname  (or (args:get-arg "-runname")
+			   (args:get-arg ":runname")
+			   (getenv "MT_RUNNAME")))
+	     (fulldir  (conc linktree "/"
+			     target "/"
+			     runname)))
+	(if (and linktree (common:file-exists? linktree)) ;; can't proceed without linktree
+	    (begin
+	      (debug:print-info 0 *default-log-port* "Have -run with target=" target ", runname=" runname ", fulldir=" fulldir ", testpatt=" (or (args:get-arg "-testpatt") "%"))
+	      (if (not (common:file-exists? fulldir))
+		  (create-directory fulldir #t)) ;; need to protect with exception handler 
+	      (if (and target
+		       runname
+		       (common:file-exists? fulldir))
+		  (let ((tmpfile  (conc fulldir "/.megatest.cfg." (current-seconds)))
+			(targfile (conc fulldir "/.megatest.cfg-"  megatest-version "-" megatest-fossil-hash))
+			(rconfig  (conc fulldir "/.runconfig." megatest-version "-" megatest-fossil-hash)))
+		    (if (common:file-exists? rconfig) ;; only cache megatest.config AFTER runconfigs has been cached
+			(begin
+			  (debug:print-info 0 *default-log-port* "Caching megatest.config in " tmpfile)
+                          (if (not (common:in-running-test?))
+                              (configf:write-alist *configdat* tmpfile))
+			  (system (conc "ln -sf " tmpfile " " targfile))))
+		    )))
+	    (debug:print-info 1 *default-log-port* "No linktree yet, no caching configs.")))))

ADDED   lib/libpangox-1.0.so
Index: lib/libpangox-1.0.so
==================================================================
--- /dev/null
+++ lib/libpangox-1.0.so
cannot compute difference between binary files

ADDED   lib/libpangox-1.0.so.0
Index: lib/libpangox-1.0.so.0
==================================================================
--- /dev/null
+++ lib/libpangox-1.0.so.0
cannot compute difference between binary files

ADDED   lib/libxcb-xlib.so.0
Index: lib/libxcb-xlib.so.0
==================================================================
--- /dev/null
+++ lib/libxcb-xlib.so.0
cannot compute difference between binary files

Index: megatest-version.scm
==================================================================
--- megatest-version.scm
+++ megatest-version.scm
@@ -16,8 +16,8 @@
 ;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
 
 ;; Always use two or four digit decimal
 ;; 1.01, 1.02...1.10,1.11,1.1101 ... 1.99,2.00..
 
-(declare (unit megatest-version))
+;; (declare (unit megatest-version))
 
-(define megatest-version 1.6558)
+(define megatest-version 1.6579)

Index: megatest.scm
==================================================================
--- megatest.scm
+++ megatest.scm
@@ -15,29 +15,17 @@
 ;;     You should have received a copy of the GNU General Public License
 ;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
 ;;
 
 ;; (include "common.scm")
-;; (include "megatest-version.scm")
+(include "megatest-version.scm")
 
 ;; fake out readline usage of toplevel-command
 (define (toplevel-command . a) #f)
 
-(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (prefix base64 base64:)
-     readline apropos json http-client directory-utils typed-records
-     http-client srfi-18 extras format)
-
-;; Added for csv stuff - will be removed
-;;
-(use sparse-vectors)
-
-(require-library mutils)
-
-;; (use zmq)
-
 (declare (uses common))
-(declare (uses megatest-version))
+;; (declare (uses megatest-version))
 (declare (uses margs))
 (declare (uses runs))
 (declare (uses launch))
 (declare (uses server))
 (declare (uses client))
@@ -51,20 +39,39 @@
 (declare (uses mt))
 (declare (uses api))
 (declare (uses tasks)) ;; only used for debugging.
 (declare (uses env))
 (declare (uses diff-report))
-(declare (uses ftail))
-(import ftail)
+(declare (uses mutils))
+(declare (uses adjutant))
+(import adjutant)
+
+(declare (uses mttop))
+(import mttop)
+
+;; (declare (uses ftail))
+;; (import ftail)
 
 (define *db* #f) ;; this is only for the repl, do not use in general!!!!
 
 (include "common_records.scm")
 (include "key_records.scm")
 (include "db_records.scm")
 (include "run_records.scm")
 (include "megatest-fossil-hash.scm")
+
+(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (prefix base64 base64:)
+     readline apropos json http-client directory-utils typed-records matchable
+     http-client srfi-18 extras format call-with-environment-variables)
+
+;; Added for csv stuff - will be removed
+;;
+(use sparse-vectors)
+
+(import mutils)
+
+;;(require-library mutils)
 
 (define *usage-log-file* #f)    ;; put path to file for logging usage in this var in the ~/.megatestrc file
 (define *usage-use-seconds* #t) ;; for Epoc seconds in usage logging change this to #t in ~/.megatestrc file
 
 ;; load the ~/.megatestrc file, put (use trace)(trace-call-sites #t)(trace function-you-want-to-trace) in this file
@@ -104,17 +111,18 @@
  
 Usage: megatest [options]
   -h                      : this help
   -manual                 : show the Megatest user manual
   -version                : print megatest version (currently " megatest-version ")
+  help                    : help for the new Megatest interface
 
 Launching and managing runs
   -run                    : run all tests or as specified by -testpatt
   -remove-runs            : remove the data for a run, requires -runname and -testpatt
                             Optionally use :state and :status, use -keep-records to remove only
                             the run data. Use -kill-wait to override the 10 second
-                            per test wait after kill delay. 
+                            per test wait after kill delay (e.g. -kill-wait 0). 
   -kill-runs              : kill existing run(s) (all incomplete tests killed)
   -kill-rerun             : kill an existing run (all incomplete tests killed and run is rerun)
   -set-state-status X,Y   : set state to X and status to Y, requires controls per -remove-runs
   -rerun FAIL,WARN...     : force re-run for tests with specificed status(s)
   -rerun-clean            : set all tests not COMPLETED+PASS,WARN,WAIVED to NOT_STARTED,n/a
@@ -201,19 +209,22 @@
   -update-meta            : update the tests metadata for all tests
   -setvars VAR1=val1,VAR2=val2 : Add environment variables to a run NB// these are
                                  overwritten by values set in config files.
   -server -|hostname      : start the server (reduces contention on megatest.db), use
                             - to automatically figure out hostname
+  -adjutant host-type     : start the server/adjutant with given host-type
+                            use 0,0 to auto use full machine
   -transport http|rpc     : use http or rpc for transport (default is http) 
   -log logfile            : send stdout and stderr to logfile
   -list-servers           : list the servers 
   -kill-servers           : kill all servers
   -repl                   : start a repl (useful for extending megatest)
   -load file.scm          : load and run file.scm
   -mark-incompletes       : find and mark incomplete tests
   -ping run-id|host:port  : ping server, exit with 0 if found
   -debug N|N,M,O...       : enable debug 0-N or N and M and O ...
+  -debug-noprop N|M,M,O...: enable debug but do not propagate to subprocesses via MT_DEBUG
   -config fname           : override the megatest.config file with fname
   -append-config fname    : append fname to the megatest.config file
 
 Utilities
   -env2file fname         : write the environment to fname.csh and fname.sh
@@ -226,21 +237,21 @@
                             will substitute %s for the sheet name in generating 
                             multiple sheets)
   -o                      : output file for refdb2dat (defaults to stdout)
   -archive cmd            : archive runs specified by selectors to one of disks specified
                             in the [archive-disks] section.
-                            cmd: keep-html, restore, save, save-remove, get (use 
+                            cmd: keep-html, restore, save, save-remove, get, replicate-db (use 
                             -dest to set destination), -include path1,path2... to get or save specific files
   -generate-html          : create a simple html dashboard for browsing your runs
   -generate-html-structure  : create a top level html veiw to list targets/runs and a Run view within each run directory.  
   -list-run-time          : list time requered to complete runs. It supports following switches
                             -run-patt <patt> -target-patt <patt> -dumpmode <csv,json,plain-text>
-  -list-test-time	   : list time requered to complete each test in a run. It following following arguments
+  -list-test-time	  : list time requered to complete each test in a run. It following following arguments
                             -runname <patt> -target <patt> -dumpmode <csv,json,plain-text>
-
-  		
-
+  -syscheck               : do some very basic checks; write access and space in tmp, home, runs, links and 
+                            is $DISPLAY valid 
+  -list-waivers           : dump waivers for specified target, runname, testpatt to stdout
 
 Diff report
   -diff-rep               : generate diff report (must include -src-target, -src-runname, -target, -runname
                                                   and either -diff-email or -diff-html)
   -src-target <target>
@@ -253,12 +264,12 @@
   -pathmod path           : insert path, i.e. path/runame/itempath/logfile.html
                             will clear the field if no rundir/testname/itempath/logfile
                             if it contains forward slashes the path will be converted
                             to windows style
 Getting started
-  -create-megatest-area       : create a skeleton megatest area. You will be prompted for paths
-  -create-test testname       : create a skeleton megatest test. You will be prompted for info
+  -create-megatest-area   : create a skeleton megatest area. You will be prompted for paths
+  -create-test testname   : create a skeleton megatest test. You will be prompted for info
 
 Examples
 
 # Get test path, use '.' to get a single path or a specific path/file pattern
 megatest -test-files 'logs/*.log' -target ubuntu/n%/no% -runname w49% -testpatt test_mt%
@@ -267,10 +278,14 @@
 Version " megatest-version ", built from " megatest-fossil-hash ))
 
 ;;  -gui                    : start a gui interface
 ;;  -config fname           : override the runconfigs file with fname
 
+
+(mttop-run (command-line-arguments)
+	   '("help"))
+
 ;; process args
 (define remargs (args:get-args 
 		 (argv)
 		 (list  "-runtests"  ;; run a specific test
 			"-config"    ;; override the config file name
@@ -301,26 +316,30 @@
 
 			"-days"
 			"-rename-run"
 			"-to"
 			"-dest"
+                        "-source" 
+                        "-time-stamp" 
 			;; values and messages
 			":category"
 			":variable"
 			":value"
 			":expected"
 			":tol"
 			":units"
+
 			;; misc
 			"-start-dir"
                         "-run-patt"
                         "-target-patt"   
 			"-contour"
                         "-area-tag"  
                         "-area"  
 			"-run-tag"
 			"-server"
+			"-adjutant"
 			"-transport"
 			"-port"
 			"-extract-ods"
 			"-pathmod"
 			"-env2file"
@@ -341,10 +360,11 @@
 			"-include"
 			"-exclude-rx"
 			"-exclude-rx-from"
 			
 			"-debug" ;; for *verbosity* > 2
+			"-debug-noprop"
 			"-create-test"
 			"-override-timeout"
 			"-test-files"  ;; -test-paths is for listing all
 			"-load"        ;; load and exectute a scheme file
 			"-section"
@@ -369,10 +389,13 @@
                         "-diff-email"
 			"-sync-to"			
 			"-pgsync"
 			"-kill-wait"    ;; wait this long before removing test (default is 10 sec)
                         "-diff-html"
+
+			;; wizards, area capture, setup new ...
+			"-extract-skeleton"
 			)
  		 (list  "-h" "-help" "--help"
 			"-manual"
 			"-version"
 		        "-force"
@@ -416,10 +439,11 @@
 			"-list-db-targets"
 			"-show-runconfig"
 			"-show-config"
 			"-show-cmdinfo"
 			"-get-run-status"
+			"-list-waivers"
 
 			;; queries
 			"-test-paths" ;; get path(s) to a test, ordered by youngest first
 
 			"-runall"    ;; run all tests, respects -testpatt, defaults to %
@@ -443,10 +467,16 @@
 			"-logging"
 			"-v" ;; verbose 2, more than normal (normal is 1)
 			"-q" ;; quiet 0, errors/warnings only
 
                         "-diff-rep"
+
+			"-syscheck"
+			"-obfuscate"
+			;; junk placeholder
+			;; "-:p"
+			
                         )
 		 args:arg-hash
 		 0))
 
 ;; Add args that use remargs here
@@ -484,11 +514,11 @@
 		    (lambda ()
 		      (handle-exceptions
 			  exn
 			  (begin
 			    (print-call-chain)
-			    (print " message: " ((condition-property-accessor 'exn 'message) exn)))
+			    (print " message: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn))
 			(common:watchdog)))
 		    "Watchdog thread"))
 
 ;;(if (not (args:get-arg "-server"))
 ;;    (thread-start! *watchdog*)) ;; if starting a server; wait till we get to running state before kicking off watchdog
@@ -495,10 +525,11 @@
 (let* ((no-watchdog-args
        '("-list-runs"
          "-testdata-csv"
          "-list-servers"
          "-server"
+	 "-adjutant"
          "-list-disks"
          "-list-targets"
          "-show-runconfig"
          ;;"-list-db-targets"
          "-show-runconfig"
@@ -506,10 +537,11 @@
          "-show-cmdinfo"
 	 "-cleanup-db"))
        (no-watchdog-args-vals (filter (lambda (x) x)
                                       (map args:get-arg no-watchdog-args)))
        (start-watchdog (null? no-watchdog-args-vals)))
+       ;;(print  "no-watchdog-args="no-watchdog-args "no-watchdog-args-vals="no-watchdog-args-vals " start-watchdog-specail-arg-val:" start-watchdog-specail-arg-val " start-watchdog:" start-watchdog) 
   ;;(BB> "no-watchdog-args="no-watchdog-args "no-watchdog-args-vals="no-watchdog-args-vals) 
   (if start-watchdog
       (thread-start! *watchdog*)))
 
 
@@ -537,11 +569,11 @@
 ;;
 (if (or (args:get-arg "-log")(args:get-arg "-server")) ;; redirect the log always when a server
     (handle-exceptions
 	exn
 	(begin
-	  (print "ERROR: Failed to switch to log output. " ((condition-property-accessor 'exn 'message) exn))
+	  (print "ERROR: Failed to switch to log output. " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn)
 	  )
       (let* ((tl   (or (args:get-arg "-log")(launch:setup)))   ;; run launch:setup if -server, ensure we do NOT run launch:setup if -log specified
 	     (logf (or (args:get-arg "-log") ;; use -log unless we are a server, then craft a logfile name
 		       (conc tl "/logs/server-" (current-process-id) "-" (get-host-name) ".log")))
 	     (oup  (open-logfile logf)))
@@ -587,12 +619,14 @@
 		      (printf "Preparing to exit with exit code ~A ...\n" exit-code)
 		      (for-each
 		       
 		       (lambda (pid)
 			 (handle-exceptions
-			  exn
-			  #t
+			     exn
+			   (begin
+			     (printf "process reap failed. exn=~A\n" exn)
+			     #t)
 			  (let-values (((pid-val exit-status exit-code) (process-wait pid #t)))
 				      (if (or (eq? pid-val pid)
 					      (eq? pid-val 0))
 					  (begin
 					    (printf "Sending signal/term to ~A\n" pid)
@@ -848,11 +882,14 @@
       (let* ((db      (env:open-db (if (null? remargs) "envdat.db" (car remargs)))))
 	(env:save-env-vars db envcap)
 	(env:close-database db)
 	(set! *didsomething* #t))))
 
-;; delta "language" will eventually be res=a+b-c but for now it is just res=a-b 
+;; delta "language" will eventually be res=a+b-c but for now it is just res=a-b
+;;
+;; db file can be stuck on the end of the command line:
+;;   megatest -envdelta start-end -dumpmode bash -o .ezsteps/step5.sh /tmp/myfile.db 
 ;;
 (let ((envdelta (args:get-arg "-envdelta")))
   (if envdelta
       (let ((match (string-split envdelta "-")));; (string-match "([a-z0-9_]+)=([a-z0-9_\\-,]+)" envdelta)))
 	(if (not (null? match))
@@ -889,10 +926,49 @@
     (let ((tl        (launch:setup))
           (transport-type (string->symbol (or (args:get-arg "-transport") "http"))))
       (server:launch 0 transport-type)
       (set! *didsomething* #t)))
 
+
+(define (naylist->alist inlst)
+  (map (lambda (dat)
+	 (cons (car dat)
+	       (or (if (list?   (cdr dat))
+		       (if (null? (cdr dat)) ""
+			   (cadr dat))
+		       (cdr dat))
+		   ""))) ;; we need a string for call-with-environment-variables
+       inlst))
+
+;; The adjutant is a bit different, it does NOT run (launch:setup) as it is not necessarily tied to
+;; a specific Megatest area. Detail are being hashed out and this may change.
+;;
+(if (args:get-arg "-adjutant")
+    (let* ((host-type (args:get-arg "-adjutant")))
+      (launch:setup) ;; dang it, wish this wasn't needed
+      (print "Running the adjutant!")
+      (let loop ((wait-count 0))
+	(if (< wait-count 10) ;; 6 x 10 seconds = one minute
+	    (let* ((dat (rmt:no-sync-take-job host-type)))
+	      (match dat
+		  ((id ht vars exekey cmdline state event-time last-update)
+		      (let ((vars-alist (with-input-from-string vars read)
+					))
+			(print "Vars:")
+			(pp vars-alist)
+			(call-with-environment-variables
+			 (naylist->alist vars-alist)
+			 (lambda ()
+			   (system cmdline))))
+		      (loop 0))
+		  (else
+		   (thread-sleep! 10)
+		   (loop (+ wait-count 1)))))
+	    (print "I'm bored. Exiting.")))
+      ;; (adjutant-run (args:get-arg "-ajutant") rmt:no-sync-take-job)
+      (set! *didsomething* #t)))
+
 (if (or (args:get-arg "-list-servers")
         (args:get-arg "-kill-servers"))
     (let ((tl (launch:setup)))
       (if tl ;; all roads from here exit
 	  (let* ((servers (server:get-list *toppath*))
@@ -1662,20 +1738,50 @@
           (set! *time-to-exit* #t)
           ) ;; end if true branch (end of a let)
         ) ;; end if
     ) ;; end if -list-runs
 
-;; Don't think I need this. Incorporated into -list-runs instead
-;;
-;; (if (and (args:get-arg "-since")
-;; 	 (launch:setup))
-;;     (let* ((since-time (string->number (args:get-arg "-since")))
-;; 	   (run-ids    (db:get-changed-run-ids since-time)))
-;;       ;; (rmt:get-tests-for-runs-mindata run-ids testpatt states status not-in)
-;;       (print (sort run-ids <))
-;;       (set! *didsomething* #t)))
-      
+;; list-waivers
+(if (and (args:get-arg "-list-waivers")
+	 (launch:setup))
+    (let* ((runpatt     (or (args:get-arg "-runname") "%"))
+	   (testpatt    (common:args-get-testpatt #f))
+	   (keys        (rmt:get-keys)) 
+	   (runsdat     (rmt:get-runs-by-patt
+			 keys runpatt 
+			 (common:args-get-target) #f #f
+			 '("id" "runname" "state" "status" "owner" "event_time" "comment") 0))
+	   (runs        (db:get-rows runsdat))
+	   (header      (db:get-header runsdat))
+	   (results     (make-hash-table))  ;; [target] ( (testname/itempath . "comment") ... )
+	   (addtest     (lambda (target testname itempath comment)
+			  (hash-table-set! results target (cons (cons (conc testname "/" itempath) comment)
+								(hash-table-ref/default results target '())))))
+	   (last-target #f))
+      (for-each
+       (lambda (run)
+	 (let* ((run-id  (db:get-value-by-header run header "id"))
+		(target  (rmt:get-target run-id))
+		(runname (db:get-value-by-header run header "runname")) 
+		(tests   (rmt:get-tests-for-run
+			  run-id testpatt '("COMPLETED") '("WAIVED") #f #f #f 'testname 'asc							     ;; use qryvals if test-spec provided
+			  #f #f #f)))
+	   (if (not (equal? target last-target))
+	       (print "[" target "]"))
+	   (set! last-target target)
+	   (print "# " runname)
+	   (for-each
+	    (lambda (testdat)
+	      (let* ((testfullname (conc (db:test-get-testname testdat)
+					 (if (equal? "" (db:test-get-item-path testdat))
+					     ""
+					     (conc "/" (db:test-get-item-path testdat)))
+					 )))
+	      (print testfullname " " (db:test-get-comment testdat))))
+	    tests)))
+       runs)
+      (set! *didsomething* #t)))
       
 ;;======================================================================
 ;; full run
 ;;======================================================================
 
@@ -1772,17 +1878,20 @@
 	       (debug:print-info 0 *default-log-port* "Pattern supplied for target or runname with "
 				 (length run-specs) " matches round. Running each in turn.")
 	       (if (null? run-specs)
 		   (debug:print 0 *default-log-port* "WARNING: No runs match target " target " and runname " runname))
 	       (for-each (lambda (spec) 
-			   (let* ((newcmdline (string-substitute
-					       (conc "target " target)
-					       (conc "target " (simple-run-target spec))
+			   (let* ((precmd     (if (args:get-arg "-precmd")(conc (args:get-arg "-precmd") " ") ""))
+				  (newcmdline (conc
+					       precmd
 					       (string-substitute
-						(conc "runname " runname)
-						(conc "runname " (simple-run-runname spec))
-						orig-cmdline))))
+						(conc "target " target)
+						(conc "target " (simple-run-target spec))
+						(string-substitute
+						 (conc "runname " runname)
+						 (conc "runname " (simple-run-runname spec))
+						 orig-cmdline)))))
 			     (debug:print 0 *default-log-port* "ORIG: " orig-cmdline)
 			     (debug:print 0 *default-log-port* "NEW:  " newcmdline)
 			     (system newcmdline)))
 			 run-specs))
 	     (handle-run-requests target runname keys keyvals need-clean))))))
@@ -1909,12 +2018,44 @@
 
 ;;======================================================================
 ;; Archive tests
 ;;======================================================================
 ;; Archive tests matching target, runname, and testpatt
-(if (args:get-arg "-archive")
+(if (equal? (args:get-arg "-archive") "replicate-db")
+    (begin
+          ;; check if source
+          ;; check if megatest.db exist
+         (print "launch")
+         (launch:setup)
+         (print "launce done")   
+         (if (not (args:get-arg "-source"))
+             (begin 
+             (debug:print-info 1 *default-log-port* "Missing required argument -source <archive path>")
+             (exit 1)))
+         (if (common:file-exists? (conc  *toppath* "/megatest.db"))
+             (begin  
+               (debug:print-info 1 *default-log-port* "File " (conc  *toppath* "/megatest.db") " already exists. Please remove it before trying to replicate db")
+               (exit 1)))
+         (if (and (common:get-db-tmp-area) (> (length (directory   (common:get-db-tmp-area) #f)) 0))
+           (begin
+           (debug:print-info 1 *default-log-port* (common:get-db-tmp-area) " not empty. Please remove it before trying to replicate db")
+           (exit 1)))    
+          ;; check if timestamp 
+          (let* ((source (args:get-arg "-source"))
+                (src     (if (not (equal? (substring source 0 1) "/"))
+                             (conc (current-directory) "/" source)
+                             source))
+                (ts (if (args:get-arg "-time-stamp")   (args:get-arg "-time-stamp") "latest")))
+              (if  (common:directory-exists? src)
+                  (begin 
+                  (archive:restore-db src ts)
+            (set! *didsomething* #t))
+       (begin
+         (debug:print-error 1 *default-log-port* "Path " source " not found")
+         (exit 1))))))   
     ;; else do a general-run-call
+   (if (and (args:get-arg "-archive") (not (equal? (args:get-arg "-archive") "replicate-db"))) 
     (begin
       ;; for the archive get we need to preserve the starting dir as part of the target path
       (if (and (args:get-arg "-dest")
 	       (not (equal? (substring (args:get-arg "-dest") 0 1) "/")))
 	  (let ((newpath  (conc (current-directory) "/" (args:get-arg "-dest"))))
@@ -2009,18 +2150,20 @@
 	      (debug:print-error 0 *default-log-port* "You must specify :state and :status with every call to -step")
 	      (exit 6))))))
 
 (if (args:get-arg "-step")
     (begin
+      (thread-sleep! 1.5)
       (megatest:step 
        (args:get-arg "-step")
        (or (args:get-arg "-state")(args:get-arg ":state"))
        (or (args:get-arg "-status")(args:get-arg ":status"))
        (args:get-arg "-setlog")
        (args:get-arg "-m"))
       ;; (if db (sqlite3:finalize! db))
-      (set! *didsomething* #t)))
+      (set! *didsomething* #t)
+      (thread-sleep! 1.5)))
     
 (if (or (args:get-arg "-setlog")       ;; since setting up is so costly lets piggyback on -test-status
 	;;     (not (args:get-arg "-step")))  ;; -setlog may have been processed already in the "-step" previous
 	;;     NEW POLICY - -setlog sets test overall log on every call.
 	(args:get-arg "-set-toplog")
@@ -2397,17 +2540,31 @@
     (let* ((toppath (launch:setup)))
       (if (tests:create-html-tree #f)
           (debug:print-info 0 *default-log-port* "HTML output created in " toppath "/lt/page0.html")
           (debug:print 0 *default-log-port* "Failed to create HTML output in " toppath "/lt/runs-index.html"))
       (set! *didsomething* #t)))
+
 (if (args:get-arg "-generate-html-structure")
     (let* ((toppath (launch:setup)))
       ;(if (tests:create-html-tree #f)
  				(if (tests:create-html-summary #f)
           (debug:print-info 0 *default-log-port* "HTML output created in " toppath "/lt/targets.html")
           (debug:print 0 *default-log-port* "Failed to create HTML output in " toppath "/lt/runs-index.html"))
       (set! *didsomething* #t)))
+
+(if (args:get-arg "-syscheck")
+    (begin
+      (mutils:syscheck common:raw-get-remote-host-load
+		       server:get-best-guess-address
+		       read-config)
+      (set! *didsomething* #t)))
+
+(if (args:get-arg "-extract-skeleton")
+    (let* ((toppath (launch:setup)))
+      (genexample:extract-skeleton-area (args:get-arg "-extract-skeleton"))
+      (set! *didsomething* #t)))
+
 ;;======================================================================
 ;; Exit and clean up
 ;;======================================================================
 
 (if (not *didsomething*)

Index: mt.scm
==================================================================
--- mt.scm
+++ mt.scm
@@ -190,11 +190,11 @@
 	      ;; (mutex-lock! *triggers-mutex*)
               (handle-exceptions
                exn
                (begin
                  (debug:print-error 0 *default-log-port* " Exception in mt:process-triggers for run-id="run-id" test-id="test-id" newstate="newstate" newstatus="newstatus
-                                    "\n   error: " ((condition-property-accessor 'exn 'message) exn)
+                                    "\n   error: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn
                                     "\n   test-rundir="test-rundir
                                     "\n   test-name="test-name
                                     "\n   item-path="item-path
                                     "\n   state="state
                                     "\n   status="status

ADDED   mtargs.scm
Index: mtargs.scm
==================================================================
--- /dev/null
+++ mtargs.scm
@@ -0,0 +1,23 @@
+;;======================================================================
+;; Copyright 2019, Matthew Welland.
+;; 
+;; This file is part of Megatest.
+;; 
+;;     Megatest is free software: you can redistribute it and/or modify
+;;     it under the terms of the GNU General Public License as published by
+;;     the Free Software Foundation, either version 3 of the License, or
+;;     (at your option) any later version.
+;; 
+;;     Megatest is distributed in the hope that it will be useful,
+;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;     GNU General Public License for more details.
+;; 
+;;     You should have received a copy of the GNU General Public License
+;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
+
+;;======================================================================
+
+(declare (unit mtargs))
+
+(include "mtargs/mtargs.scm")

ADDED   mtargs/Makefile
Index: mtargs/Makefile
==================================================================
--- /dev/null
+++ mtargs/Makefile
@@ -0,0 +1,22 @@
+# Copyright 2007-2010, 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.
+
+# TARGDIR = $(shell csi -e "(print (car \#\#sys\#include-pathnames))(exit)")
+
+all : uptodate.log # $(TARGDIR)/mtargs.so
+
+uptodate.log : mtargs.scm mtargs.setup
+	chicken-install | tee uptodate.log
+
+$(TARGDIR)/mtargs.so : mtargs.so
+	@echo installing to $(TARGDIR)
+	cp mtargs.so $(TARGDIR)
+
+mtargs.so : mtargs.scm
+	csc -s mtargs.scm

ADDED   mtargs/mtargs.meta
Index: mtargs/mtargs.meta
==================================================================
--- /dev/null
+++ mtargs/mtargs.meta
@@ -0,0 +1,20 @@
+(
+; Your egg's license:
+(license "LGPL")
+
+; Pick one from the list of categories (see below) for your egg and enter it
+; here.
+(category misc)
+
+; A list of eggs mpeg3 depends on.  If none, you can omit this declaration
+; altogether. If you are making an egg for chicken 3 and you need to use
+; procedures from the `files' unit, be sure to include the `files' egg in the
+; `needs' section (chicken versions < 3.4.0 don't provide the `files' unit).
+; `depends' is an alias to `needs'.
+(needs srfi-69 srfi-1)
+
+; A list of eggs required for TESTING ONLY.  See the `Tests' section.
+(test-depends test)
+
+(author "Matt Welland")
+(synopsis "Primitive argument processor."))

ADDED   mtargs/mtargs.scm
Index: mtargs/mtargs.scm
==================================================================
--- /dev/null
+++ mtargs/mtargs.scm
@@ -0,0 +1,96 @@
+;; Copyright 2007-2010, Matthew Welland.
+;;
+;; This file is part of mtargs.
+;; 
+;;     mtargs is free software: you can redistribute it and/or modify
+;;     it under the terms of the GNU General Public License as published by
+;;     the Free Software Foundation, either version 3 of the License, or
+;;     (at your option) any later version.
+;; 
+;;     mtargs is distributed in the hope that it will be useful,
+;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;     GNU General Public License for more details.
+;; 
+;;     You should have received a copy of the GNU General Public License
+;;     along with mtargs.  If not, see <http://www.gnu.org/licenses/>.
+
+
+(module mtargs
+    (
+     arg-hash
+     get-arg
+     get-arg-from
+     usage
+     get-args
+     print-args
+     any-defined?
+     help
+     )
+
+(import scheme chicken data-structures extras posix ports files)
+(use srfi-69 srfi-1)
+
+(define arg-hash (make-hash-table))
+(define help "")
+
+(define (get-arg arg . default)
+  (if (null? default)
+      (hash-table-ref/default arg-hash arg #f)
+      (hash-table-ref/default arg-hash arg (car default))))
+
+(define (any-defined? . args)
+  (not (null? (filter (lambda (x) x)
+		      (map get-arg args)))))
+
+;; (define any any-defined?)
+
+(define (get-arg-from ht arg . default)
+  (if (null? default)
+      (hash-table-ref/default ht arg #f)
+      (hash-table-ref/default ht arg (car default))))
+
+(define (usage . args)
+  (if (> (length args) 0)
+      (apply print "ERROR: " args))
+  (if (string? help)
+      (print help)
+      (print "Usage: " (car (argv)) " ... "))
+  (exit 0))
+
+(define (get-args args params switches arg-hash num-needed)
+  (let* ((numtargs (length args))
+	 (adj-num-needed (if num-needed (+ num-needed 2) #f)))
+    (if (< numtargs (if adj-num-needed adj-num-needed 2))
+	(if (>= num-needed 1)
+	    (usage "No arguments provided")
+	    '())
+	(let loop ((arg (cadr args))
+		   (tail (cddr args))
+		   (remtargs '()))
+	  (cond 
+	   ((member arg params) ;; args with params
+	    (if (< (length tail) 1)
+		(usage "param given without argument " arg)
+		(let ((val     (car tail))
+		      (newtail (cdr tail)))
+		  (hash-table-set! arg-hash arg val)
+		  (if (null? newtail) remtargs
+		      (loop (car newtail)(cdr newtail) remtargs)))))
+	   ((member arg switches)         ;; args with no params (i.e. switches)
+	    (hash-table-set! arg-hash arg #t)
+	    (if (null? tail) remtargs
+		(loop (car tail)(cdr tail) remtargs)))
+	   (else
+	    (if (null? tail)(append remtargs (list arg)) ;; return the non-used args
+		(loop (car tail)(cdr tail)(append remtargs (list arg))))))))
+    ))
+
+(define (print-args remtargs arg-hash)
+  (print "ARGS: " remtargs)
+  (for-each (lambda (arg)
+	      (print "   " arg "   " (hash-table-ref/default arg-hash arg #f)))
+	    (hash-table-keys arg-hash)))
+
+
+)

ADDED   mtargs/mtargs.setup
Index: mtargs/mtargs.setup
==================================================================
--- /dev/null
+++ mtargs/mtargs.setup
@@ -0,0 +1,18 @@
+;; Copyright 2007-2010, 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.
+
+;;;; mtargs.setup
+
+;; compile the code into a dynamically loadable shared object
+;; (will generate mtargs.so)
+(compile -s mtargs.scm)
+
+;; Install as extension library
+(standard-extension 'mtargs "mtargs.so")
+

Index: mtexec.scm
==================================================================
--- mtexec.scm
+++ mtexec.scm
@@ -26,17 +26,16 @@
    srfi-19  srfi-18 extras format pkts regex regex-case
      (prefix dbi dbi:)
      )
 
 ;; (declare (uses common))
-(declare (uses megatest-version))
 (declare (uses margs))
 (declare (uses configf))
 ;; (declare (uses rmt))
 
 ;; (use ducttape-lib)
-
+(include "megatest-version.scm")
 (include "megatest-fossil-hash.scm")
 
 ;; (require-library stml)
 
 (define help (conc "

ADDED   mttop.scm
Index: mttop.scm
==================================================================
--- /dev/null
+++ mttop.scm
@@ -0,0 +1,55 @@
+;; Copyright 2006-2011, 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.
+
+;; This is from the perl world, a hash of hashes is a super easy way to keep a handle on
+;; lots of disparate data
+;;
+
+(declare (unit mttop))
+
+(module mttop
+    *
+
+(import chicken scheme
+	;; data-structures posix
+	srfi-1
+	;; srfi-13
+	srfi-69
+	ports
+	extras
+	regex
+	posix
+	data-structures
+	matchable
+	)
+
+(define (str-is-cmd cmd all-cmds)
+  (let* ((rx  (regexp (conc "^" cmd ".*")))
+	 (mx  (filter string? (map (lambda (x)
+				     (let ((res (string-match rx x)))
+				       (if res (car res) #f)))
+				   all-cmds))))
+    (if (eq? (length mx) 1) ;; have a command
+	(car mx)
+	#f)))
+
+(define (mttop-run args all-cmds)
+  ;; any path through this call must end in exit if it is NOT an old Megatest call
+  (if (null? args)
+      #f ;; continue on and do the old Megatest stuff
+      (let ((cmd (str-is-cmd (car args) all-cmds)))
+	(if cmd
+	    (begin
+	      (case (string->symbol cmd)
+		((help)(print "New help"))
+		(else (print "Command " cmd " is not implemented yet.")))
+	      (exit)) ;; always exit here
+	    #f))))    ;; or continue on to Megatest old stuff here
+  
+)

Index: mtut.scm
==================================================================
--- mtut.scm
+++ mtut.scm
@@ -15,11 +15,11 @@
 ;;     You should have received a copy of the GNU General Public License
 ;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
 ;;
 
 ;; (include "common.scm")
-;; (include "megatest-version.scm")
+(include "megatest-version.scm")
 
 ;; fake out readline usage of toplevel-command
 (define (toplevel-command . a) #f)
 
 (use srfi-1 posix srfi-69 readline ;;  regex regex-case srfi-69 apropos json http-client directory-utils rpc typed-records;; (srfi 18) extras)
@@ -27,20 +27,19 @@
      (prefix dbi dbi:)
      (prefix sqlite3 sqlite3:)
      nanomsg)
 
 (declare (uses common))
-(declare (uses megatest-version))
 (declare (uses margs))
 (declare (uses configf))
 ;; (declare (uses rmt))
 
 (use ducttape-lib)
 
 (include "megatest-fossil-hash.scm")
 
-(require-library stml)
+(use stml2)
 
 ;; stuff for the mapper and checker functions
 ;;
 (define *target-mappers*  (make-hash-table)) 
 (define *runname-mappers* (make-hash-table)) 
@@ -155,10 +154,11 @@
    show [areas|contours... ] : show areas, contours or other section from megatest.config
    gendot                    : generate a graphviz dot file from pkts.
 
 Contour actions:
    process                   : runs import, rungen and dispatch 
+   go                        : runs import, rungen and dispatch every five minutes forever
 			     
 Trigger propagation actions:
    tsend a=b,c=d...          : send trigger info to all recpients in the [listeners] section
    tlisten -port N           : listen for trigger info on port N
 			     
@@ -774,11 +774,11 @@
 				(begin
 				  (print-call-chain)
 				  (print "FAILED TO RUN RUNNAME MAPPER " callname " FOR AREA " area)
 				  (print " message: " ((condition-property-accessor 'exn 'message) exn))
 				  runname)
-			      (print "(mapper " (string-intersperse (list runkey runname area area-path reason contour mode-patt) ", ") ")")
+			      (print "(mapper " (string-intersperse (map conc (list runkey runname area area-path reason contour mode-patt)) ", ") ")")
 			      (mapper runkey runname area area-path reason contour mode-patt))
 			    (case callname
 			      ((auto #f) runname)
 			      (else   runtrans)))))
 	 (new-target     target) ;; I believe we will want target manipulation here .. (map-targets xlatr-key runkey area contour))
@@ -1324,11 +1324,13 @@
 		      (begin
 			(print "ERROR: Unknown key in packet \"" key "\" with value \"" val "\"")
 			res)))))
 	  (conc "megatest " (if (not (member action '("sync")))
 				(conc action " " action-param)
-				""))
+				"") (if (member action '("-run" "-rerun-clean" "-rerun-all" "-kill-rerun"))
+                                                        "-rerun DEAD,ABORT,KILLED"
+                                                        ""))
 	  pkta)))
 
 ;; (use trace)(trace pkt->cmdline)
 
 (define (write-pkt pktsdir uuid pkt)
@@ -1611,23 +1613,70 @@
 	 ;;  (hash-table-keys adjargs))
 	 (let-values (((uuid pkt)
 		       (command-line->pkt *action* adjargs #f area-path: area-path new-ss: new-ss)))
            (print "run log @ " (conc (current-directory) "/" uuid "-" *action* ".log"))
 	   (write-pkt pktsdir uuid pkt))))
-      ((dispatch import rungen process)
+      ((dispatch import rungen process go)
        (let* ((mtconfdat (simple-setup (args:get-arg "-start-dir")))
 	      (mtconf    (car mtconfdat))
-	      (toppath   (configf:lookup mtconf "scratchdat" "toppath")))
+	      (toppath   (configf:lookup mtconf "scratchdat" "toppath"))
+	      (period    (configf:lookup-number mtconf "mtutil" "autorun-period" default: 300))
+	      (rest-time (configf:lookup-number mtconf "mtutil" "autorun-rest"   default: 30)))
+	 (print "Using period="period" and rest time="rest-time)
 	 (case (string->symbol *action*)
 	   ((process)  (begin
 			 (common:load-pkts-to-db mtconf)
 			 (generate-run-pkts mtconf toppath)
 			 (common:load-pkts-to-db mtconf)
 			 (dispatch-commands mtconf toppath)))
 	   ((import)   (common:load-pkts-to-db mtconf)) ;; import pkts
 	   ((rungen)   (generate-run-pkts mtconf toppath))
-	   ((dispatch) (dispatch-commands mtconf toppath)))))
+	   ((dispatch) (dispatch-commands mtconf toppath))
+	   ;; [mtutil]
+	   ;; # approximate interval between run processing in mtutil (seconds)
+	   ;; autorun-period 300
+	   ;; # minimal rest period between processing 
+	   ;; autorun-rest   30
+	   ((go)
+	    ;; determine if I'm the boss
+	    (if (file-exists? "mtutil-go.pid")
+		(begin
+		  (print "ERROR: mtutil go is already running under host and pid " (with-input-from-file "mtutil-go.pid" read-line)
+			 ". Please kill that process and remove the file \"mutil-go.pid\" and try again.")
+		  (exit)))
+	    (with-output-to-file "mtutil-go.pid" (lambda ()(print (get-host-name) " " (current-process-id))))
+	    (print "Starting long running import, rungen, and process loop")
+	    (if (file-exists? "do-not-run-mtutil-go")
+		(begin
+		  (print "NOTE: Removing flag file "(current-directory)"/do-not-run-mtutil-go")
+		  (delete-file* "do-not-run-mtutil-go")))
+	    (let loop ((last-run (- (current-seconds) (+ period 10))) ;; fake out first time in 
+		       (this-run (current-seconds)))
+	      (if (file-exists? "do-not-run-mtutil-go")
+		  (begin
+		    (print "File do-not-run-mtutil-go exists, exiting.")
+		    (delete-file* "mtutil-go.pid")
+		    (exit)))
+	      (let ((delta (- this-run last-run)))
+		(if (>= delta period)
+		    (let* ((mtconfdat (simple-setup (args:get-arg "-start-dir")))
+			   (mtconf    (car mtconfdat)))
+		      (print "Running import at " (current-seconds))
+		      (common:load-pkts-to-db mtconf)
+		      (print "Running generate run pkts at " (current-seconds))
+		      (generate-run-pkts mtconf toppath)
+		      (print "Running run dispatch at " (current-seconds))
+		      (common:load-pkts-to-db mtconf)
+		      (dispatch-commands mtconf toppath)
+		      (print "Done running import, generate, and dispatch done in " (- (current-seconds) this-run))
+		      (print "NOTE: touch " (current-directory) "/do-not-run-mtutil-go to kill this runner.")
+		      (loop this-run (current-seconds)))
+		    (let ((now (current-seconds)))
+		      (print "Sleeping " rest-time " seconds, next run in aproximately " (- period (- now last-run)) " seconds")
+		      (thread-sleep! rest-time)
+		      (loop last-run (current-seconds))))))
+	    (delete-file* "mtutil-go.pid")))))
       ;; misc
       ((show)
        (if (> (length remargs) 0)
 	   (let* ((mtconfdat (simple-setup (args:get-arg "-start-dir")))
 		  (mtconf    (car mtconfdat))
@@ -1806,46 +1855,52 @@
                                   )
 
                                 )))
                            (loop (nn-recv rep))))
 		       (print "ERROR: Port " portnum " already in use. Try another port")))))))
-      
-
-
-
-      ((tlisten)
-       (if (null? remargs)
-           (print "ERROR: useage for tlisten is \"mtutil tlisten portnum\"")
-           (let ((portnum (string->number (car remargs))))
-              
-             (if (not portnum)
-                 (print "ERROR: the portnumber parameter must be a number, you gave: " (car remargs))
-                 (begin
-                   (if (not (is-port-in-use portnum))  
-                       (let* ((rep       (start-nn-server portnum))
-                              (mtconfdat (simple-setup (args:get-arg "-start-dir")))
-                              (mtconf    (car mtconfdat))
-                              (contact   (configf:lookup mtconf "listener" "owner"))
-                              (script    (configf:lookup mtconf "listener" "script")))
-                         (print "Listening on port " portnum " for messages.")
-                         (set-signal-handler! signal/int  (lambda (signum) 
-															(set! *time-to-exit* #t)
-  														(debug:print-error 0 *default-log-port* "Received signal " signum " sending email befor exiting !!")
-  														(let ((email-body (mtut:stml->string (s:body
-																						(s:p (conc "Received signal " signum ". Lister has been terminated on host " (get-environment-variable "HOST") ". "))))))
-             					        (sendmail contact "Listner has been terminated." email-body  use_html: #t))
-                              (exit)))
-															(set-signal-handler! signal/term  (lambda (signum) 
-															(set! *time-to-exit* #t)
-  														(debug:print-error 0 *default-log-port* "Received signal " signum " sending email befor exiting !!")
-  														(let ((email-body (mtut:stml->string (s:body
-																						(s:p (conc "Received signal " signum ". Lister has been terminated on host " (get-environment-variable "HOST") ". "))))))
-             					        (sendmail contact "Listner has been terminated." email-body  use_html: #t))
-                              (exit)))
-
-                         ;(set-signal-handler! signal/term special-signal-handler)
-                         
+
+    ((tlisten)
+     (if (null? remargs)
+         (print "ERROR: useage for tlisten is \"mtutil tlisten portnum\"")
+         (let ((portnum (string->number (car remargs))))
+           
+           (if (not portnum)
+               (print "ERROR: the portnumber parameter must be a number, you gave: " (car remargs))
+               (begin
+                 (if (not (is-port-in-use portnum))  
+                     (let* ((rep       (start-nn-server portnum))
+                            (mtconfdat (simple-setup (args:get-arg "-start-dir")))
+                            (mtconf    (car mtconfdat))
+                            (contact   (configf:lookup mtconf "listener" "owner"))
+                            (script    (configf:lookup mtconf "listener" "script")))
+                       (print "Listening on port " portnum " for messages.")
+                       (set-signal-handler! signal/int
+					    (lambda (signum) 
+					      (set! *time-to-exit* #t)
+  					      (debug:print-error 0 *default-log-port* "Received signal " signum
+								 " sending email befor exiting !!")
+  					      (let ((email-body (mtut:stml->string
+								 (s:body
+								  (s:p (conc "Received signal " signum
+									     ". Lister has been terminated on host "
+									     (get-environment-variable "HOST") ". "))))))
+             					(sendmail contact "Listner has been terminated." email-body  use_html: #t))
+					      (exit)))
+		       (set-signal-handler! signal/term  (lambda (signum) 
+							   (set! *time-to-exit* #t)
+  							   (debug:print-error 0 *default-log-port* "Received signal "
+									      signum " sending email befor exiting !!")
+  							   (let ((email-body (mtut:stml->string
+									      (s:body
+									       (s:p (conc "Received signal " signum
+											  ". Lister has been terminated on host "
+											  (get-environment-variable "HOST") ". "))))))
+             					             (sendmail contact "Listner has been terminated." email-body  use_html: #t))
+							   (exit)))
+
+		       ;; (set-signal-handler! signal/term special-signal-handler)
+                       
                          (let loop ((instr (nn-recv rep)))
                              (nn-send rep "ok")
                              (let ((ctime (date->string (current-date)))) 
                              (if  (equal? instr "time-to-die")
                               (begin 

ADDED   mutils.scm
Index: mutils.scm
==================================================================
--- /dev/null
+++ mutils.scm
@@ -0,0 +1,23 @@
+;;======================================================================
+;; Copyright 2019, Matthew Welland.
+;; 
+;; This file is part of Megatest.
+;; 
+;;     Megatest is free software: you can redistribute it and/or modify
+;;     it under the terms of the GNU General Public License as published by
+;;     the Free Software Foundation, either version 3 of the License, or
+;;     (at your option) any later version.
+;; 
+;;     Megatest is distributed in the hope that it will be useful,
+;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;     GNU General Public License for more details.
+;; 
+;;     You should have received a copy of the GNU General Public License
+;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
+
+;;======================================================================
+
+(declare (unit mutils))
+
+(include "mutils/mutils.scm")

ADDED   mutils/Makefile
Index: mutils/Makefile
==================================================================
--- /dev/null
+++ mutils/Makefile
@@ -0,0 +1,22 @@
+# Copyright 2007-2010, 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.
+
+# TARGDIR = $(shell csi -e "(print (car \#\#sys\#include-pathnames))(exit)")
+
+all : uptodate.log # $(TARGDIR)/mutils.so
+
+uptodate.log : mutils.scm mutils.setup
+	chicken-setup | tee uptodate.log
+
+$(TARGDIR)/mutils.so : mutils.so
+	@echo installing to $(TARGDIR)
+	cp mutils.so $(TARGDIR)
+
+mutils.so : mutils.scm
+	csc -s mutils.scm

ADDED   mutils/mutils.meta
Index: mutils/mutils.meta
==================================================================
--- /dev/null
+++ mutils/mutils.meta
@@ -0,0 +1,20 @@
+(
+; Your egg's license:
+(license "BSD")
+
+; Pick one from the list of categories (see below) for your egg and enter it
+; here.
+(category misc)
+
+; A list of eggs mpeg3 depends on.  If none, you can omit this declaration
+; altogether. If you are making an egg for chicken 3 and you need to use
+; procedures from the `files' unit, be sure to include the `files' egg in the
+; `needs' section (chicken versions < 3.4.0 don't provide the `files' unit).
+; `depends' is an alias to `needs'.
+(needs sparse-vectors)
+
+; A list of eggs required for TESTING ONLY.  See the `Tests' section.
+(test-depends test)
+
+(author "Matt Welland")
+(synopsis "A basic description of the purpose of the egg."))

ADDED   mutils/mutils.scm
Index: mutils/mutils.scm
==================================================================
--- /dev/null
+++ mutils/mutils.scm
@@ -0,0 +1,310 @@
+;; Copyright 2006-2011, 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.
+
+;; This is from the perl world, a hash of hashes is a super easy way to keep a handle on
+;; lots of disparate data
+;;
+
+(module mutils
+    *
+
+  (import chicken scheme
+	  ;; data-structures posix
+	  srfi-1
+	  ;; srfi-13
+	  srfi-69
+	  ports
+	  extras
+	  regex
+	  posix
+	  data-structures
+	  matchable
+	  )
+
+(define (mutils:hierhash-ref hh . keys)
+  (if (null? keys)
+      #f
+      (let loop ((ht   hh)
+		 (key  (car keys))
+		 (tail (cdr keys)))
+	(if (null? tail)
+	    (if (hash-table? ht)
+		(hash-table-ref/default ht key #f)
+		#f)
+	    (if (hash-table? ht)
+		(loop (hash-table-ref/default ht key #f)
+		      (car tail)
+		      (cdr tail))
+		#f)))))
+
+;; WATCH THE NON-INTUITIVE INTERFACE HERE!!!!
+;; val comes first!
+;;
+(define (mutils:hierhash-set! hh val . keys)
+  (if (null? keys)
+      #f
+      (let loop ((ht    hh)
+		 (key  (car keys))
+		 (tail (cdr keys)))
+	(if (null? tail) ;; last one!
+	    (hash-table-set! ht key val)
+	    (let ((nh (hash-table-ref/default ht key #f)))
+	      (if (not nh)(set! nh (make-hash-table)))
+	      (hash-table-set! ht key nh)
+	      (loop nh
+		    (car tail)
+		    (cdr tail)))))))
+
+;; nice little routine to add an item to a list in a hashtable 
+;;
+(define (mutils:hash-table-add-to-list htbl key item)
+  (let ((l (hash-table-ref/default htbl key #f)))
+    (if l
+	(hash-table-set! htbl key (cons item l))
+	(hash-table-set! htbl key (list item)))))
+
+(define (mutils:hash-table-append-to-list htbl key lst)
+  (let ((l (hash-table-ref/default htbl key #f)))
+    (if l
+	(hash-table-set! htbl key (append lst l))
+        (hash-table-set! htbl key lst))))
+
+;;======================================================================
+;; Utils
+;;======================================================================
+
+(define (mutils:file->list fname)
+  (let ((fh (open-input-file fname))
+	(comment (regexp "^\\s*#"))
+	(blank   (regexp "^\\s*$")))
+    (let loop ((l   (read-line fh))
+	       (res '()))
+      (if (eof-object? l)
+	  (reverse res)
+	  (if (or (string-match comment l)
+		  (string-match blank l))
+	      (loop (read-line fh) res)
+	      (loop (read-line fh) (cons l res)))))))
+
+(use sparse-vectors)
+
+;; this is a simple two dimensional sparse array
+
+;; ONLY TWO DIMENSIONS!!! SEE ARRAY-LIB IF YOUR NEEDS ARE GREATER!!
+;;
+(define (mutils:make-sparse-array)
+  (let ((a (make-sparse-vector)))
+    (sparse-vector-set! a 0 (make-sparse-vector))
+    a))
+
+(define (mutils:sparse-array? a)
+  (and (sparse-vector? a)
+       (sparse-vector? (sparse-vector-ref a 0))))
+
+(define (mutils:sparse-array-ref a x y)
+  (let ((row (sparse-vector-ref a x)))
+    (if row
+	(sparse-vector-ref row y)
+	#f)))
+
+(define (mutils:sparse-array-set! a x y val)
+  (let ((row (sparse-vector-ref a x)))
+    (if row
+	(sparse-vector-set! row y val)
+	(let ((new-row (make-sparse-vector)))
+	  (sparse-vector-set! a x new-row)
+	  (sparse-vector-set! new-row y val)))))
+
+;; some routines for treating assoc lists a bit like hash tables
+
+(define (mutils:assoc-get/default alist key default)
+  (let ((res (assoc key alist)))
+    (if (and res (list? res)(> (length res) 1))
+	(cadr res)
+	default)))
+
+(define (mutils:assoc-get alist key)
+  (cadr (assoc key alist)))
+
+(define (mutils:hier-list? @hierlist)
+  (and (list? @hierlist)
+       (> (length @hierlist) 0)
+       (list? (car @hierlist))
+       (> (length (car @hierlist)) 1)))
+
+(define (mutils:hier-list-get @hierlist . @path)
+  (if (list? @hierlist)
+      (let* (($path (car @path))
+	     (@rempath (cdr @path))
+	     (@match (assoc $path @hierlist)))
+	(if @match
+	    (if (or (not (list? @rempath))(null? @rempath))
+		(cadr @match)
+		(apply mutils:hier-list-get (cadr @match) @rempath))
+	    #f))
+      #f))
+
+(define (mutils:hier-list-put! @hierlist . @path)
+  (let* (($path (car @path))
+	 (@rempath (cdr @path))
+	 ($value   (cadr @path))
+	 (@match (assoc $path @hierlist))
+	 (@remhierlist (remove (lambda (a)
+                                 (equal? a @match))
+                               @hierlist))
+         (@old-pair (let (($value (mutils:hier-list-get @hierlist $path))) (if $value $value '())))
+	 (@new-pair (list $path (if (eq? (length @rempath) 1) 
+				    (car @rempath)
+				    (apply mutils:hier-list-put! @old-pair @rempath)))))
+    (cons @new-pair @remhierlist)))
+
+(define (mutils:hier-list-remove! @hierlist . @path)
+  (let (($path (car @path)))
+    (if (eq? (length @path) 1)
+	(remove (lambda (a)
+                  (equal? a (assoc $path @hierlist)))
+                @hierlist)
+	(let* ((@rempath (cdr @path))
+	       (@match (assoc $path @hierlist))
+	       (@remhierlist (remove (lambda (a) 
+                                       (equal? @match a))
+                                     @hierlist))
+	       (@old-pair (let (($value (mutils:hier-list-get @hierlist $path))) (if $value $value '())))
+	       (@new-pair (list $path (apply mutils:hier-list-remove! @old-pair @rempath))))
+	  (cons @new-pair @remhierlist)))))
+
+(define (mutils:keys @hierlist . @path)
+  (map (lambda (@l)
+	 (if (and (list? @l)(not (null? @l))) 
+	     (car @l))) 
+       (if (null? @path) @hierlist
+	   (apply mutils:hier-list-get @hierlist @path))))
+
+;;======================================================================
+;; Other utils
+;;======================================================================
+
+(define (check-write-create fpath)
+  (and (file-write-access? fpath)
+       (let ((fname (conc fpath "/.junk-" (current-seconds) "-" (random 10000))))
+	 ;;(print "trying to create/remove " fname)
+	 (handle-exceptions
+	  exn
+	  #f
+	  (begin
+	    (with-output-to-file fname
+	      (lambda ()
+		(print "You can delete this file")))
+	    (delete-file fname)
+	    #t)))))
+
+(define (run-and-return-output cmd . params)
+  (let-values (((inp oup pid)
+		(process cmd params)))
+    (let ((res (with-input-from-port inp read-lines)))
+      (let-values (((pidres status estatus)
+		    (process-wait pid)))
+	(and status (eq? estatus 0) res)))))
+
+(define (confirm-ssh-access-to-host hostname)
+  (run-and-return-output "ssh" hostname "uptime"))
+
+(define (check-display dsp)
+  (run-and-return-output "xdpyinfo" "-display" dsp))
+
+#;(define (check-display dsp)
+  (let-values (((inp oup pid)
+		(process "xdpyinfo" `("-display" ,dsp))))
+    (let ((res (with-input-from-port inp read-lines)))
+      (let-values (((pidres status estatus)
+		    (process-wait pid)))
+	(and status (eq? estatus 0) res)))))
+
+;; do some sanity checks on the system
+;;
+(define (mutils:syscheck common:raw-get-remote-host-load
+			 server:get-best-guess-address
+			 read-config)
+  ;; current dir writeable and do megatest.config, runconfigs.config files exist/readable
+  (print "Current directory " (current-directory) " writeable: " 
+	 (if (check-write-create ".") "yes" "NO"))
+  ;; home dir writeable
+  (print "Home directory " (get-environment-variable "HOME") " writeable: "
+	 (if (check-write-create (get-environment-variable "HOME")) "yes" "NO"))
+  ;; /tmp writeable
+  (print "/tmp directory writeable: " (if (check-write-create "/tmp") "yes" "NO"))
+  ;; load configs
+  (print "$DISPLAY set: " (if (get-environment-variable "DISPLAY")
+			      (conc  (get-environment-variable "DISPLAY") " yes")
+			      "NO"))
+
+  (print "$DISPLAY accessible? "
+	  ;; (eq? (system "xdpyinfo -display $DISPLAY &>/dev/null") 0)
+	 (if (check-display (get-environment-variable "DISPLAY"))
+	     "yes" "NO"))
+
+  (print "Password-less ssh access to localhost: "
+	 (if  (confirm-ssh-access-to-host "localhost")
+	      "yes"
+	      "NO"))
+
+  ;; if I'm in a Megatest area do some checks
+  (print "Have megatest.config: "
+	 (if (file-exists? "megatest.config")
+	     "yes"
+	     "NO"))
+
+  (print "Have runconfigs.config: "
+	 (if (file-exists? "runconfigs.config")
+	     "yes"
+	     "NO"))
+
+  (if (file-exists? ".homehost")
+      (let* ((homehost (with-input-from-file ".homehost"
+			 read-line))
+	     (currhost (get-host-name))
+	     (bestadrs (server:get-best-guess-address currhost)))
+	(print "Have .homehost and it is the localhost: "
+	       (if (equal? homehost bestadrs)
+		   "yes"
+		   (conc ".homehost=" homehost ", localhost=" bestadrs ", NO")))
+	(print "Have .homehost and it is reachable via ssh: "
+	       (if (confirm-ssh-access-to-host homehost)
+		   "yes"
+		   "NO"))
+	))
+
+  (if (file-exists? "megatest.config")
+      (let* ((cdat (read-config "megatest.config" #f #f)))
+	(print "Have [disks] section: "
+	       (if (hash-table-ref/default cdat "disks" #f)
+		   (conc (hash-table-ref cdat "disks") " yes")
+		   "NO"))
+	(for-each
+	 (lambda (entry)
+	   (match
+	    entry
+	    ((dname path)
+	     (print "Disk " dname " at " path " writeable: "
+		    (if (check-write-create path) "yes" "NO")))
+	    (else (print "bad entry: " entry))))
+	 (hash-table-ref/default cdat "disks" '()))))
+
+  (print "Have link tree and it is writable: "
+	 (if (and (file-exists? "lt")
+		  (check-write-create "lt"))
+	     "yes"
+	     "NO"))
+  ;;    check load on homehost
+  )
+
+;; Develop stuff here - then move to where it belongs.
+
+
+)

ADDED   mutils/mutils.setup
Index: mutils/mutils.setup
==================================================================
--- /dev/null
+++ mutils/mutils.setup
@@ -0,0 +1,18 @@
+;; Copyright 2007-2010, 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.
+
+;;;; mutils.setup
+
+;; compile the code into a dynamically loadable shared object
+;; (will generate mutils.so)
+(compile -s mutils.scm)
+
+;; Install as extension library
+(install-extension 'mutils "mutils.so")
+

ADDED   mutils/tests/datastruct.scm
Index: mutils/tests/datastruct.scm
==================================================================
--- /dev/null
+++ mutils/tests/datastruct.scm
@@ -0,0 +1,15 @@
+
+(use test)
+
+(include "datastruct.scm")
+
+(define hh (make-hash-table))
+
+(hierhash-set! hh 5 1 2 3 4)
+
+(test 5 (hierhash-ref hh 1 2 3 4))
+
+(hierhash-set! hh 10 1 2 3 5)
+
+(test 10 (hierhash-ref hh 1 2 3 5))
+(test 5  (hierhash-ref hh 1 2 3 4))

ADDED   pkts.scm
Index: pkts.scm
==================================================================
--- /dev/null
+++ pkts.scm
@@ -0,0 +1,23 @@
+;;======================================================================
+;; Copyright 2019, Matthew Welland.
+;; 
+;; This file is part of Megatest.
+;; 
+;;     Megatest is free software: you can redistribute it and/or modify
+;;     it under the terms of the GNU General Public License as published by
+;;     the Free Software Foundation, either version 3 of the License, or
+;;     (at your option) any later version.
+;; 
+;;     Megatest is distributed in the hope that it will be useful,
+;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;     GNU General Public License for more details.
+;; 
+;;     You should have received a copy of the GNU General Public License
+;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
+
+;;======================================================================
+
+(declare (unit pkts))
+
+(include "pkts/pkts.scm")

ADDED   pkts/pktrec.scm
Index: pkts/pktrec.scm
==================================================================
--- /dev/null
+++ pkts/pktrec.scm
@@ -0,0 +1,196 @@
+(define-syntax define-record-type
+  (syntax-rules ()
+    ((define-record-type type
+       (constructor constructor-tag ...)
+       predicate
+       (field-tag accessor . more) ...)
+     (begin
+       (define type
+         (make-record-type 'type '(field-tag ...)))
+       (define constructor
+         (record-constructor type '(constructor-tag ...)))
+       (define predicate
+         (record-predicate type))
+       (define-record-field type field-tag accessor . more)
+       ...))))
+
+; An auxilliary macro for define field accessors and modifiers.
+; This is needed only because modifiers are optional.
+
+(define-syntax define-record-field
+  (syntax-rules ()
+    ((define-record-field type field-tag accessor)
+     (define accessor (record-accessor type 'field-tag)))
+    ((define-record-field type field-tag accessor modifier)
+     (begin
+       (define accessor (record-accessor type 'field-tag))
+       (define modifier (record-modifier type 'field-tag))))))
+
+; Record types
+
+; We define the following procedures:
+; 
+; (make-record-type <type-name <field-names>)    -> <record-type>
+; (record-constructor <record-type<field-names>) -> <constructor>
+; (record-predicate <record-type>)               -> <predicate>
+; (record-accessor <record-type <field-name>)    -> <accessor>
+; (record-modifier <record-type <field-name>)    -> <modifier>
+;   where
+; (<constructor> <initial-value> ...)         -> <record>
+; (<predicate> <value>)                       -> <boolean>
+; (<accessor> <record>)                       -> <value>
+; (<modifier> <record> <value>)         -> <unspecific>
+
+; Record types are implemented using vector-like records.  The first
+; slot of each record contains the record's type, which is itself a
+; record.
+
+(define (record-type record)
+  (record-ref record 0))
+
+;----------------
+; Record types are themselves records, so we first define the type for
+; them.  Except for problems with circularities, this could be defined as:
+;  (define-record-type :record-type
+;    (make-record-type name field-tags)
+;    record-type?
+;    (name record-type-name)
+;    (field-tags record-type-field-tags))
+; As it is, we need to define everything by hand.
+
+(define :record-type (make-record 3))
+(record-set! :record-type 0 :record-type)	; Its type is itself.
+(record-set! :record-type 1 ':record-type)
+(record-set! :record-type 2 '(name field-tags))
+
+; Now that :record-type exists we can define a procedure for making more
+; record types.
+
+(define (make-record-type name field-tags)
+  (let ((new (make-record 3)))
+    (record-set! new 0 :record-type)
+    (record-set! new 1 name)
+    (record-set! new 2 field-tags)
+    new))
+
+; Accessors for record types.
+
+(define (record-type-name record-type)
+  (record-ref record-type 1))
+
+(define (record-type-field-tags record-type)
+  (record-ref record-type 2))
+
+;----------------
+; A utility for getting the offset of a field within a record.
+
+(define (field-index type tag)
+  (let loop ((i 1) (tags (record-type-field-tags type)))
+    (cond ((null? tags)
+           (error "record type has no such field" type tag))
+          ((eq? tag (car tags))
+           i)
+          (else
+           (loop (+ i 1) (cdr tags))))))
+
+;----------------
+; Now we are ready to define RECORD-CONSTRUCTOR and the rest of the
+; procedures used by the macro expansion of DEFINE-RECORD-TYPE.
+
+(define (record-constructor type tags)
+  (let ((size (length (record-type-field-tags type)))
+        (arg-count (length tags))
+        (indexes (map (lambda (tag)
+                        (field-index type tag))
+                      tags)))
+    (lambda args
+      (if (= (length args)
+             arg-count)
+          (let ((new (make-record (+ size 1))))
+            (record-set! new 0 type)
+            (for-each (lambda (arg i)
+			(record-set! new i arg))
+                      args
+                      indexes)
+            new)
+          (error "wrong number of arguments to constructor" type args)))))
+
+(define (record-predicate type)
+  (lambda (thing)
+    (and (record? thing)
+         (eq? (record-type thing)
+              type))))
+
+(define (record-accessor type tag)
+  (let ((index (field-index type tag)))
+    (lambda (thing)
+      (if (and (record? thing)
+               (eq? (record-type thing)
+                    type))
+          (record-ref thing index)
+          (error "accessor applied to bad value" type tag thing)))))
+
+(define (record-modifier type tag)
+  (let ((index (field-index type tag)))
+    (lambda (thing value)
+      (if (and (record? thing)
+               (eq? (record-type thing)
+                    type))
+          (record-set! thing index value)
+          (error "modifier applied to bad value" type tag thing)))))
+
+Records
+
+; This implements a record abstraction that is identical to vectors,
+; except that they are not vectors (VECTOR? returns false when given a
+; record and RECORD? returns false when given a vector).  The following
+; procedures are provided:
+;   (record? <value>)                -> <boolean>
+;   (make-record <size>)             -> <record>
+;   (record-ref <record> <index>)    -> <value>
+;   (record-set! <record> <index> <value>) -> <unspecific>
+;
+; These can implemented in R5RS Scheme as vectors with a distinguishing
+; value at index zero, providing VECTOR? is redefined to be a procedure
+; that returns false if its argument contains the distinguishing record
+; value.  EVAL is also redefined to use the new value of VECTOR?.
+
+; Define the marker and redefine VECTOR? and EVAL.
+
+(define record-marker (list 'record-marker))
+
+(define real-vector? vector?)
+
+(define (vector? x)
+  (and (real-vector? x)
+       (or (= 0 (vector-length x))
+	   (not (eq? (vector-ref x 0)
+		record-marker)))))
+
+; This won't work if ENV is the interaction environment and someone has
+; redefined LAMBDA there.
+
+(define eval
+  (let ((real-eval eval))
+    (lambda (exp env)
+      ((real-eval `(lambda (vector?) ,exp))
+       vector?))))
+
+; Definitions of the record procedures.
+
+(define (record? x)
+  (and (real-vector? x)
+       (< 0 (vector-length x))
+       (eq? (vector-ref x 0)
+            record-marker)))
+
+(define (make-record size)
+  (let ((new (make-vector (+ size 1))))
+    (vector-set! new 0 record-marker)
+    new))
+
+(define (record-ref record index)
+  (vector-ref record (+ index 1)))
+
+(define (record-set! record index value)
+  (vector-set! record (+ index 1) value))

ADDED   pkts/pkts.meta
Index: pkts/pkts.meta
==================================================================
--- /dev/null
+++ pkts/pkts.meta
@@ -0,0 +1,21 @@
+;; -*- scheme -*-
+(
+; Your egg's license:
+(license "BSD")
+
+; Pick one from the list of categories (see below) for your egg and enter it
+; here.
+(category db)
+
+; A list of eggs pkts depends on.  If none, you can omit this declaration
+; altogether. If you are making an egg for chicken 3 and you need to use
+; procedures from the `files' unit, be sure to include the `files' egg in the
+; `needs' section (chicken versions < 3.4.0 don't provide the `files' unit).
+; `depends' is an alias to `needs'.
+;; (needs (autoload "3.0"))
+
+; A list of eggs required for TESTING ONLY.  See the `Tests' section.
+(test-depends test)
+
+(author "Matt Welland")
+(synopsis "A sha1-chain based datastore built on packets consisting of single line cards modeled loosely on the fossil scm datastore."))

ADDED   pkts/pkts.release-info
Index: pkts/pkts.release-info
==================================================================
--- /dev/null
+++ pkts/pkts.release-info
@@ -0,0 +1,3 @@
+(repo fossil "http://www.kiatoa.com/cgi-bin/fossils/{egg-name}")
+(uri zip "http://www.kiatoa.com/cgi-bin/fossils/{egg-name}/zip/{egg-name}.zip?uuid={egg-release}")
+(release "1.0")

ADDED   pkts/pkts.scm
Index: pkts/pkts.scm
==================================================================
--- /dev/null
+++ pkts/pkts.scm
@@ -0,0 +1,1075 @@
+;; Copyright 2006-2017, Matthew Welland.
+;; 
+;; This file is part of Pkts
+;; 
+;;     Pkts is free software: you can redistribute it and/or modify
+;;     it under the terms of the GNU General Public License as published by
+;;     the Free Software Foundation, either version 3 of the License, or
+;;     (at your option) any later version.
+;; 
+;;     Pkts is distributed in the hope that it will be useful,
+;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;     GNU General Public License for more details.
+;; 
+;;     You should have received a copy of the GNU General Public License
+;;     along with Pkts.  If not, see <http://www.gnu.org/licenses/>.
+;;
+
+;; CARDS:
+;;
+;; A card is a line of text, the first two characters are a letter followed by a
+;;   space. The letter is the card type.
+;;
+;; PKTS:
+;;
+;; A pkt is a sorted list of cards with a final card Z that contains the shar1 hash
+;;   of all of the preceding cards.
+;;
+;; APKT:
+;;
+;;  An alist mapping card types to card data
+;;      '((T . "pkttype")
+;;        (a . "some content"))
+;;
+;; EPKT:
+;;
+;;  Extended packet using friendly keys. Must use a pktspec to convert to/from epkts
+;;    '((ptype . "pkttype")
+;;      (adata . "some content))
+;;
+;; DPKT:
+;;
+;; pkts pulled from the database have this format:
+;;
+;;((apkt (Z . "7de89c09ac024b3832c93e16cd78d11e2e28733b")     <= this is a the alist
+;;       (t . "v1.63/tip/dev")
+;;       (c . "QUICKPATT")
+;;       (T . "runstart")
+;;       (P . "354eeb67120a921e3e33155ecab1b522ac10b6bd")
+;;       (D . "1488995096.0"))
+;;  (id . 8)
+;;  (group-id . 0)
+;;  (uuid . "7de89c09ac024b3832c93e16cd78d11e2e28733b")
+;;  (parent . "")
+;;  (pkt-type . "runstart")
+;;  (pkt . "D 1488995096.0\nP 354eeb67120a921e3e33155ecab1b522ac10b6bd\nT runstart\nc QUICKPATT\nt v1.63/tip/dev\nZ 7de89c09ac024b3832c93e16cd78d11e2e28733b"))
+;;
+;; pktspec is alist of alists mapping types and nicekeys to keys
+;;
+;; '((posting . ((title . t)
+;;               (url   . u)
+;;               (blurb . b)))
+;;   (comment . ((comment . c)
+;;               (score   . s))))
+
+;; Reserved cards:
+;;   P      : pkt parent
+;;   R      : reference pkt containing mapping of short string -> sha1sum strings
+;;   T      : pkt type
+;;   D      : current time from (current-time), unless provided
+;;   Z      : shar1 hash of the packet
+
+;; Example usage:
+;;
+;; Create a pkt:
+;;
+;; (use pkts)
+;; (define-values (uuid pkt)
+;;     (alist->pkt
+;;       '((fruit . "apple") (meat . "beef"))  ;; this is the data to convert
+;;       '((foods (fruit . f) (meat . m)))     ;; this is the pkt spec
+;;       ptype:
+;;       'foods))
+;;
+;; Add to pkt queue:
+;;
+;; (define db (open-queue-db "/tmp/pkts" "pkts.db"))
+;; (add-to-queue db pkt uuid 'foods #f 0) ;; no parent and use group_id of 0
+;;
+;; Retrieve the packet from the db and extract a value:
+;;
+;; (alist-ref
+;;    'meat
+;;    (dpkt->alist
+;;         (car (get-dpkts db #f 0 #f))
+;;        '((foods (fruit . f)
+;;                 (meat . m)))))
+;; => "beef"
+;;
+
+(module pkts
+(
+;; cards, util and misc
+;; sort-cards
+;; calc-shar1
+;;
+;; low-level constructor procs, exposed only for development/testing, will be removed
+construct-sdat
+construct-pkt     
+card->type/value  
+add-z-card
+
+;; queue database procs
+open-queue-db
+add-to-queue
+create-and-queue
+lookup-by-uuid
+lookup-by-id
+get-dpkts
+get-not-processed-pkts
+get-related
+find-pkts
+process-pkts
+get-descendents
+get-ancestors
+get-pkts
+get-last-descendent
+with-queue-db
+load-pkts-to-db
+
+;; procs that operate directly on pkts, sdat, apkts, dpkts etc.
+pkt->alist    ;; pkt -> apkt (i.e. alist)
+pkt->sdat     ;; pkt -> '("a aval" "b bval" ...)
+sdat->alist   ;; '("a aval" "b bval"...) -> ((a . "aval")(b . "bval") ...)
+dblst->dpkts  ;; convert list of tuples from queue db into dpkts
+dpkt->alist   ;; flatten a dpkt into an alist containing all db fields and the pkt alist
+dpkts->alists ;; apply dpkt->alist to a list of alists using a pkt-spec
+alist->pkt    ;; returns two values uuid, pkt
+get-value     ;; looks up a value given a key in a dpkt
+flatten-all   ;; merge the list of values from a query which includes a pkt into a flat alist <== really useful!
+check-pkt
+
+;; pkt alists
+write-alist->pkt
+read-pkt->alist
+
+;; archive database
+archive-open-db
+write-archive-pkts
+archive-pkts
+mark-processed
+
+;; pktsdb
+pktdb-conn     ;; useful
+pktdb-fname
+pktsdb-open
+pktsdb-close
+pktsdb-add-record
+;; temporary
+pktdb-pktspec
+
+;; utility procs
+increment-string ;; used to get indexes for strings in ref pkts
+make-report      ;; make a .dot file 
+)
+
+(import chicken scheme data-structures posix srfi-1 regex srfi-13 srfi-69 ports extras)
+(use crypt sha1 message-digest (prefix dbi dbi:) typed-records)
+
+;;======================================================================
+;; DATA MANIPULATION UTILS
+;;======================================================================
+
+(define-inline (unescape-data data)
+  (string-translate* data '(("\\n" . "\n") ("\\\\" . "\\"))))
+
+(define-inline (escape-data data)
+  (string-translate* data '(("\n" . "\\n") ("\\" . "\\\\"))))
+
+(define-inline (make-card type data)
+  (conc type " " (escape-data (->string data))))
+
+;; reverse an alist for doing pktkey -> external key conversions
+;;
+(define-inline (reverse-aspec aspec)
+  (map (lambda (dat)
+	 (cons (cdr dat)(car dat)))
+       aspec))
+
+;; add a card to the list of cards, sdat
+;; if type is #f return only sdat
+;; if data is #f return only sdat
+;;
+(define-inline (add-card sdat type data)
+  (if (and type data)
+      (cons (make-card type data) sdat)
+      sdat))
+
+;;======================================================================
+;; STRING AS FUNKY NUMBER
+;;======================================================================
+
+;; NOTE: PTDZ are removed as they are reserved. NB// the R card is not used in a
+;;       ref, instead the P parent card is used.
+;;       Question: Why does it matter to remove PTDZ?
+;;                 To make the ref easier to use the ref strings will be the keys
+;;                 so we cannot have overlap with any actual keys. But this is a
+;;                 bit silly. What we need to do instead is reject keys of length
+;;                 one where the char is in PTDZ
+;;
+;; This is basically base92
+;;
+(define string-num-chars (string->list "!#$%&'()*+,-./0123456789:;<=>?@ABCEFGHIJKLMNOQRSUVWXY[\\]^_abcdefghijklmnopqrstuvwxyz{|}~"))
+;; "0123456789abcdefghijklmnopqrstuvwxyzABCEFGHIJKLMNOQSUVWXY!#$%&'()*+,-./[]:;<=>?\\^_{}|"))
+
+(define (char-incr inchar)
+  (let* ((carry     #f)
+	 (next-char (let ((rem (member inchar string-num-chars)))
+		      (if (eq? (length rem) 1) ;; we are at the last character in our string-num-chars list
+			  (begin
+			    (set! carry #t)
+			    (car string-num-chars))
+			  (cadr rem)))))
+    (values next-char carry)))
+    
+(define (increment-string str)
+  (if (string-null? str)
+      "0"
+      (let ((strlst (reverse (string->list str)))) ;; need to process the string from the lsd
+	(list->string
+	 (let loop ((hed (car strlst))
+		    (tal (cdr strlst))
+		    (res '()))
+	   (let-values (((newhed carry)(char-incr hed)))
+	     ;; (print "newhed: " newhed " carry: " carry " tal: " tal)
+	     (let ((newres (cons newhed res)))
+	       (if carry ;; we'll have to propagate the carry
+		   (if (null? tal) ;; at the end, tack on "0" (which is really a "1")
+		       (cons (car string-num-chars) newres)
+		       (loop (car tal)(cdr tal) newres))
+		   (append (reverse tal) newres)))))))))
+    
+;;======================================================================
+;; P K T S D B   I N T E R F A C E
+;;
+;; INTEGER, REAL, TEXT
+;;======================================================================
+;;
+;; spec
+;;  ( (tablename1 . (field1name L1 TYPE)
+;;                  (field2name L2 TYPE) ... )
+;;    (tablename2 ... ))
+;;
+;;  Example: (tests (testname n TEXT)
+;;                  (rundir   r TEXT)
+;;                   ... )
+;;
+;; pkt keys are taken from the first letter, if that is not unique
+;; then look at the next letter and so on
+;;
+
+;; use this struct to hold the pktspec and the db handle
+;;
+(defstruct pktdb
+  (fname       #f)
+  (pktsdb-spec #f)
+  (pktspec     #f)  ;; cache the pktspec
+  (field-keys  #f)  ;; cache the field->key mapping (field1 . k1) ...
+  (key-fields  #f)  ;; cache the key->field mapping
+  (conn        #f)
+  )
+
+;; WARNING: There is a simplification in the pktsdb spec w.r.t. pktspec.
+;;          The field specs are the cdr of the table list - not a full
+;;          list. The extra list level in pktspec is gratuitous and should
+;;          be removed.
+;;
+(define (pktsdb-spec->pktspec tables-spec)
+  (map (lambda (tablespec)
+	 (list (car tablespec)
+	       (map (lambda (field-spec)
+		      (cons (car field-spec)(cadr field-spec)))
+		    (cdr tablespec))))
+       tables-spec))
+
+(define (pktsdb-open dbfname pktsdb-spec)
+  (let* ((pdb      (make-pktdb))
+	 (dbexists (file-exists? dbfname))
+	 (db       (dbi:open 'sqlite3 `((dbname . ,dbfname)))))
+    (pktdb-pktsdb-spec-set! pdb pktsdb-spec)
+    (pktdb-pktspec-set!     pdb (pktsdb-spec->pktspec pktsdb-spec))
+    (pktdb-fname-set!       pdb dbfname)
+    (pktdb-conn-set!        pdb db)
+    (if (not dbexists)
+	(pktsdb-init pdb))
+    pdb))
+
+(define (pktsdb-init pktsdb)
+  (let* ((db          (pktdb-conn pktsdb))
+	 (pktsdb-spec (pktdb-pktsdb-spec pktsdb)))
+    ;; create a table for the pkts themselves
+    (dbi:exec db "CREATE TABLE IF NOT EXISTS pkts (id INTEGER PRIMARY KEY, zkey TEXT, record_id INTEGER, pkt TEXT);")
+    (for-each
+     (lambda (table)
+       (let* ((table-name (car table))
+	      (fields     (cdr table))
+	      (stmt (conc "CREATE TABLE IF NOT EXISTS "
+			  table-name
+			  " (id INTEGER PRIMARY KEY,"
+			  (string-intersperse
+			   (map (lambda (fieldspec)
+				  (conc (car fieldspec) " "
+					(caddr fieldspec)))
+				fields)
+			   ",")
+			  ");")))
+	 (dbi:exec db stmt)))
+     pktsdb-spec)))
+
+;; create pkt from the data and insert into pkts table
+;; 
+;; data is assoc list of (field . value) ...
+;; tablename is a symbol matching the table name
+;;
+(define (pktsdb-add-record pktsdb tablename data #!optional (parent #f))
+  (let*-values (((zkey pkt) (alist->pkt data (pktdb-pktspec pktsdb) ptype: tablename)))
+    ;; have the data as alist so insert it into appropriate table also
+    (let* ((db        (pktdb-conn pktsdb)))
+      ;; TODO: Address collisions
+      (dbi:exec db "INSERT INTO pkts (zkey,pkt,record_id) VALUES (?,?,?);"
+		zkey pkt -1)
+      (let* (;; (pktid     (pktsdb-pktkey->pktid pktsdb pktkey))
+	     (record-id (pktsdb-insert pktsdb tablename data)))
+	(dbi:exec db "UPDATE pkts SET record_id=? WHERE zkey=?;"
+		  record-id zkey)
+      ))))
+
+;; 
+(define (pktsdb-insert pktsdb tablename data)
+  (let* ((db (pktdb-conn pktsdb))
+	 (stmt (conc "INSERT INTO " tablename
+		     " (" (string-intersperse (map conc (map car data)) ",")
+		     ") VALUES ('"
+		     ;; TODO: Add lookup of data type and do not
+		     ;;       wrap integers with quotes
+		     (string-intersperse (map conc (map cdr data)) "','")
+		     "');")))
+    (print "stmt: " stmt)
+    (dbi:exec db stmt)
+    ;; lookup the record-id and return it
+    
+    ))
+    
+
+(define (pktsdb-close pktsdb)
+  (dbi:close (pktdb-conn pktsdb)))
+
+;; (let loop ((s "0")(n 0))(print s)(if (< n 5000)(loop (increment-string s)(+ n 1))))
+
+;;======================================================================
+;; CARDS, MISC and UTIL
+;;======================================================================
+
+;; given string (likely multi-line) "dat" return shar1 hash
+;;
+(define-inline (calc-shar1 instr)
+  (message-digest-string
+   (sha1-primitive)
+   instr))
+
+;; given a single card return its type and value
+;;
+(define (card->type/value card)
+  (let ((ctype (substring card 0 1))
+	(cval  (substring card 2 (string-length card))))
+    (values (string->symbol ctype) cval)))
+
+;;======================================================================
+;; SDAT procs
+;;  sdat is legacy/internal usage. Intention is to remove sdat calls from
+;;  the exposed calls.
+;;======================================================================
+
+;; sort list of cards
+;;
+(define-inline (sort-cards sdat)
+  (sort sdat string<=?))
+
+;; pkt rules
+;; 1. one card per line
+;; 2. at least one card
+;; 3. no blank lines
+
+;; given sdat, a list of cards return uuid, packet (as sdat)
+;;
+(define (add-z-card sdat)
+  (let* ((sorted-sdat (sort-cards sdat))
+	 (dat         (string-intersperse sorted-sdat "\n"))
+	 (uuid        (calc-shar1 dat)))
+    (values
+     uuid
+     (conc
+      dat
+      "\nZ "
+      uuid))))
+
+(define (check-pkt pkt)
+  (handle-exceptions
+      exn
+      #f ;; anything goes wrong - call it a crappy pkt
+    (let* ((sdat (string-split pkt "\n"))
+	   (rdat (reverse sdat)) ;; reversed
+	   (zdat (car rdat))
+	   (Z    (cadr (string-split zdat)))
+	   (cdat (string-intersperse (reverse (cdr rdat)) "\n")))
+      (equal? Z (calc-shar1 cdat)))))
+
+;;======================================================================
+;; APKTs
+;;======================================================================
+
+;; convert a sdat (list of cards) to an alist
+;;
+(define (sdat->alist sdat)
+  (let loop ((hed (car sdat))
+	     (tal (cdr sdat))
+	     (res '()))
+    (let-values (( (ctype cval)(card->type/value hed) ))
+      ;; if this card is not one of the common ones tack it on to rem
+      (let* ((oldval (alist-ref ctype res))
+	     (newres (cons (cons ctype
+				 (if oldval ;; list or string
+				     (if (list? oldval)
+					 (cons cval oldval)
+					 (cons cval (list oldval)))
+				     cval))
+			   res)))
+	(if (null? tal)
+	    newres
+	    (loop (car tal)(cdr tal) newres))))))
+
+;;((apkt (Z . "7de89c09ac024b3832c93e16cd78d11e2e28733b")     <= this is a the alist
+;;       (t . "v1.63/tip/dev")
+;;       (c . "QUICKPATT")
+;;       (T . "runstart")
+;;       (P . "354eeb67120a921e3e33155ecab1b522ac10b6bd")
+;;       (D . "1488995096.0"))
+;;  (id . 8)
+;;  (group-id . 0)
+;;  (uuid . "7de89c09ac024b3832c93e16cd78d11e2e28733b")
+;;  (parent . "")
+;;  (pkt-type . "runstart")
+;;  (pkt . "D 1488995096.0\nP 354eeb67120a921e3e33155ecab1b522ac10b6bd\nT runstart\nc QUICKPATT\nt v1.63/tip/dev\nZ 7de89c09ac024b3832c93e16cd78d11e2e28733b"))
+;;
+;; pktspec is alist of alists mapping types and nicekeys to keys
+;;
+;; '((posting . ((title . t)
+;;               (url   . u)
+;;               (blurb . b)))
+;;   (comment . ((comment . c)
+;;               (score   . s))))
+
+;; DON'T USE? 
+;;
+(define (get-value field dpkt . spec-in)
+  (if (null? spec-in)
+      (alist-ref field dpkt)
+      (let* ((spec  (car spec-in))
+	     (apkt  (alist-ref 'apkt dpkt))) ;; get the pkt alist
+	(if (and apkt spec)
+	    (let* ((ptype (alist-ref 'pkt-type dpkt))
+		   (pspec (alist-ref (string->symbol ptype) spec))) ;; do we have a spec for this type of pkt
+	      (and pspec
+		  (let* ((key (alist-ref field pspec)))
+		    (and key (alist-ref key apkt)))))
+	    #f))))
+
+;; convert a dpkt to a pure alist given a pktspec
+;; this flattens out the alist to include the data from
+;; the queue database record
+;;
+(define (dpkt->alist dpkt pktspec)
+  (let* ((apkt       (alist-ref 'apkt dpkt))
+	 (pkt-type   (or (alist-ref 'pkt-type dpkt) ;; pkt-type is from the database field pkt_type
+			 (alist-ref 'T apkt)))
+	 (pkt-fields (alist-ref (string->symbol pkt-type) pktspec))
+	 (rev-fields (if pkt-fields
+			 (reverse-aspec pkt-fields)
+			 '())))
+    (append (map (lambda (entry)
+		   (let* ((pkt-key (car entry))
+			  (new-key (or (alist-ref pkt-key rev-fields) pkt-key)))
+		     `(,new-key . ,(cdr entry))))
+		 apkt)
+	    dpkt)))
+
+;; convert a list of dpkts into a list of alists using pkt-spec
+;;
+(define (dpkts->alists dpkts pkt-spec)
+   (map (lambda (x)
+	  (dpkt->alist x pkt-spec))
+	dpkts))
+
+;; Generic flattener, make the tuple and pkt into a single flat alist
+;;
+;; qry-result-spec is a list of symbols corresponding to each field
+;;
+(define (flatten-all inlst pktspec . qry-result-spec)
+  (map
+   (lambda (tuple)
+     (dpkt->alist
+      (apply dblst->dpkts tuple qry-result-spec)
+      pktspec))
+   inlst))
+
+;; call like this:
+;;  (construct-sdat 'a "a data" 'S "S data" ...)
+;; returns list of cards
+;;  ( "A a value" "D 12345678900" ...)
+;;
+(define (construct-sdat . alldat)
+  (let ((have-D-card #f)) ;; flag
+    (if (even? (length alldat))
+	(let loop ((type (car alldat))
+		   (data (cadr alldat))
+		   (tail (cddr alldat))
+		   (res  '()))
+	  (if (eq? type 'D)(set! have-D-card #t))
+	  (if (null? tail)
+	      (if have-D-card ;; return the constructed pkt, add a D card if none found
+		  (add-card res type data)
+		  (add-card 
+		   (add-card res 'D (current-seconds))
+		   type data))
+	      (loop (car tail)
+		    (cadr tail)
+		    (cddr tail)
+		    (add-card res type data))))
+	#f))) ;; #f means it failed to create the sdat
+
+(define (construct-pkt . alldat)
+  (add-z-card
+   (apply construct-sdat alldat)))
+
+;;======================================================================
+;; CONVERTERS
+;;======================================================================
+
+(define (pkt->sdat pkt)
+  (map unescape-data (string-split pkt "\n")))
+
+;; given a pure pkt return an alist
+;;
+(define (pkt->alist pkt #!key (pktspec #f))
+  (let ((sdat (cond
+	       ((string? pkt)  (pkt->sdat pkt))
+	       ((list? pkt)    pkt)
+	       (else #f))))
+    (if pkt
+	(if pktspec
+	    (dpkt->alist (list (cons 'apkt (sdat->alist sdat))) pktspec)
+	    (sdat->alist sdat))
+	#f)))
+
+;; convert an alist to an sdat
+;;  in: '((a . "blah")(b . "foo"))
+;; out: '("a blah" "b foo")
+;;
+(define (alist->sdat adat)
+  (map (lambda (dat)
+	 (conc (car dat) " " (cdr dat)))
+       adat))
+
+;; adat is the incoming alist, aspec is the mapping
+;; from incoming key to the pkt key (usually one
+;; letter to keep data tight) see the pktspec at the
+;; top of this file
+;;
+;; NOTE: alists can contain multiple instances of the same key (supported fine by pkts)
+;;       but you (obviously I suppose) cannot use alist-ref to access those entries.
+;;
+(define (alist->pkt adat aspec #!key (ptype #f))
+  (let* ((pkt-type (or ptype
+		       (alist-ref 'T adat) ;; can provide in the incoming alist
+		       #f))
+	 (pkt-spec (if pkt-type            ;; alist of external-key -> key
+		       (or (alist-ref pkt-type aspec) '())
+		       (if (null? aspec)
+			   '()
+			   (cdar aspec)))) ;; default to first one if nothing specified
+	 (new-alist (map (lambda (dat)
+			   (let* ((key    (car dat))
+				  (val    (cdr dat))
+				  (newkey (or (alist-ref key pkt-spec)
+					      key)))
+			     (cons newkey (escape-data (conc val))))) ;; convert all incoming data (symbols, numbers etc.) to a string and then escape newlines.
+			 adat))
+	 (new-with-type (if (alist-ref 'T new-alist)
+			    new-alist
+			    (cons `(T . ,pkt-type) new-alist)))
+	 (with-d-card   (if (alist-ref 'D new-with-type)
+			    new-with-type
+			    (cons `(D . ,(current-seconds))
+				  new-with-type))))
+    (add-z-card
+     (alist->sdat with-d-card))))
+
+;;======================================================================
+;;  D B   Q U E U E   I N T E R F A C E
+;;======================================================================
+
+;; pkts (
+;;   id SERIAL PRIMARY KEY,
+;;   uuid TEXT NOT NULL,
+;;   parent_uuid TEXT default '',
+;;   pkt_type INTEGER DEFAULT 0,
+;;   group_id INTEGER NOT NULL,
+;;   pkt TEXT NOT NULL
+
+;; schema is list of SQL statements - can be used to extend db with more tables
+;;
+(define (open-queue-db dbpath dbfile #!key (schema '()))
+  (let* ((dbfname  (conc dbpath "/" dbfile))
+	 (dbexists (if (file-exists? dbfname) #t (begin (create-directory dbpath #t) #f)))
+	 (db       (dbi:open 'sqlite3 (list (cons 'dbname dbfname)))))
+    ;; (set-busy-handler! (dbi:db-conn db) (busy-timeout 10000))
+    (if (not dbexists) ;; NOTE: In the archive we allow duplicates and other messiness. 
+	(for-each
+	 (lambda (stmt)
+	   (dbi:exec db stmt))
+	 (cons "CREATE TABLE IF NOT EXISTS pkts
+                          (id           INTEGER PRIMARY KEY,
+                           group_id     INTEGER NOT NULL,
+                           uuid         TEXT NOT NULL,
+                           parent_uuid  TEXT TEXT DEFAULT '',
+                           pkt_type     TEXT NOT NULL,
+                           pkt          TEXT NOT NULL,
+                           processed    INTEGER DEFAULT 0)"
+		   schema))) ;; 0=not processed, 1=processed, 2... for expansion
+    db))
+
+(define (add-to-queue db pkt uuid pkt-type parent-uuid group-id)
+  (dbi:exec db "INSERT INTO pkts (uuid,parent_uuid,pkt_type,pkt,group_id)
+                   VALUES(?,?,?,?,?);" ;; $1,$2,$3,$4,$5);"
+	    uuid
+	    (if parent-uuid parent-uuid "");; use null string as placeholder for no parent uuid.
+	    (if pkt-type (conc pkt-type) "") 
+	    pkt
+	    group-id))
+
+;; given all needed parameters create a pkt and store it in the queue
+;;  procs is an alist that maps pkt-type to a function that takes a list of pkt params
+;;  in data and returns the uuid and pkt
+;;
+(define (create-and-queue conn procs pkt-type parent-uuid group-id data)
+  (let ((proc (alist-ref pkt-type procs)))
+    (if proc
+	(let-values (( (uuid pkt) (proc data) ))
+	  (add-to-queue conn pkt uuid pkt-type parent-uuid group-id)
+	  uuid)
+	#f)))
+
+;; given uuid get pkt, if group-id is specified use it (reduces probablity of
+;;     being messed up by a uuid collision)
+;;
+(define (lookup-by-uuid db pkt-uuid group-id)
+  (if group-id
+      (dbi:get-one db "SELECT pkt FROM pkts WHERE group_id=? AND uuid=?;" group-id pkt-uuid)
+      (dbi:get-one db "SELECT pkt FROM pkts WHERE uuid=?;" pkt-uuid)))
+      
+;; find a packet by its id
+;;
+(define (lookup-by-id db id)
+  (dbi:get-one db "SELECT pkt FROM pkts WHERE id=?;" id))
+
+;; apply a proc to the open db handle for a pkt db in pdbpath
+;;
+(define (with-queue-db pdbpath proc #!key (schema #f))
+  (cond
+   ((not (equal? (file-owner pdbpath)(current-effective-user-id)))
+    (print "ERROR: directory " pdbpath " is not owned by " (current-effective-user-name)))
+   (else
+    (let* ((pdb  (open-queue-db pdbpath "pkts.db"
+				schema: schema)) ;;  '("CREATE TABLE groups (id INTEGER PRIMARY KEY,groupname TEXT, CONSTRAINT group_constraint UNIQUE (groupname));"))))
+	   (res  (proc pdb)))
+      (dbi:close pdb)
+      res))))
+
+(define (load-pkts-to-db pktsdirs pdbpath #!key (schema #f))
+  (with-queue-db
+   pdbpath
+   (lambda (pdb)
+     (for-each
+      (lambda (pktsdir) ;; look at all
+	(cond
+	 ((not (file-exists? pktsdir))
+	  (print "ERROR: packets directory " pktsdir " does not exist."))
+	 ((not (directory? pktsdir))
+	  (print "ERROR: packets directory path " pktsdir " is not a directory."))
+	 ((not (file-read-access? pktsdir))
+	  (print "ERROR: packets directory path " pktsdir " is not readable."))
+	 (else
+	  ;; (print "INFO: Loading packets found in " pktsdir)
+	  (let ((pkts (glob (conc pktsdir "/*.pkt"))))
+	    (for-each
+	     (lambda (pkt)
+	       (let* ((uuid    (cadr (string-match ".*/([0-9a-f]+).pkt" pkt)))
+		      (exists  (lookup-by-uuid pdb uuid #f)))
+		 (if (not exists)
+		     (let* ((pktdat (string-intersperse
+				     (with-input-from-file pkt read-lines)
+				     "\n"))
+			    (apkt   (pkt->alist pktdat))
+			    (ptype  (alist-ref 'T apkt)))
+		       (add-to-queue pdb pktdat uuid (or ptype 'cmd) #f 0))
+		       ;; (debug:print 4 *default-log-port* "Added " uuid " of type " ptype " to queue"))
+		       ;; (debug:print 4 *default-log-port* "pkt: " uuid " exists, skipping...")
+		     )))
+	     pkts)))))
+      pktsdirs))))
+
+;;======================================================================
+;;  P R O C E S S   P K T S
+;;======================================================================
+
+;; given a list of field values pulled from the queue db generate a list
+;; of dpkt's
+;;
+(define (dblst->dpkts lst . altmap)
+  (let* ((maplst (if (null? altmap)
+		     '(id group-id uuid parent pkt-type pkt processed)
+		     altmap))
+	 (res (map cons maplst lst))) ;; produces list of pairs, i.e an alist
+    (cons `(apkt . ,(pkt->alist (alist-ref 'pkt res)))
+	  res)))
+
+;; NB// ptypes is a list of symbols, '() or #f find all types
+;;
+(define (get-dpkts db ptypes group-id parent-uuid #!key (uuid #f))
+  (let* ((ptype-qry (if (and ptypes
+			     (not (null? ptypes)))
+			(conc " IN ('" (string-intersperse (map conc ptypes) "','") "')")
+			(conc " LIKE '%' ")))
+	 (rows      (dbi:get-rows
+		     db
+		     (conc
+		      "SELECT id,group_id,uuid,parent_uuid,pkt_type,pkt,processed FROM pkts
+                         WHERE pkt_type " ptype-qry " AND group_id=?
+                         AND processed=0 "
+			 (if parent-uuid (conc "AND parent_uuid='" parent-uuid "' ") "")
+			 (if uuid        (conc "AND        uuid='"        uuid "' ") "")
+			 "ORDER BY id DESC;")
+		     group-id)))
+    (map dblst->dpkts (map vector->list rows))))
+
+;; get N pkts not yet processed for group-id
+;;
+(define (get-not-processed-pkts db group-id pkt-type limit offset)
+  (map dblst->dpkts
+       (map vector->list
+	    (dbi:get-rows
+	     db
+	     "SELECT id,group_id,uuid,parent_uuid,pkt_type,pkt,processed FROM pkts
+                WHERE pkt_type = ? AND group_id = ? AND processed=0
+                LIMIT ? OFFSET ?;"
+	     (conc pkt-type) ;; convert symbols to string
+	     group-id
+	     limit
+	     offset
+	     ))))
+
+;; given a uuid, get not processed child pkts 
+;;
+(define (get-related db group-id uuid)
+  (map dblst->dpkts
+       (dbi:get-rows
+	db
+	"SELECT id,group_id,uuid,parent_uuid,pkt_type,pkt,processed FROM pkts
+           WHERE parent_uuid=? AND group_id=? AND processed=0;"
+	uuid group-id)))
+
+;; generic pkt processor
+;;
+;; find all packets in group-id of type in ptypes and apply proc to pktdat
+;;
+(define (process-pkts conn group-id ptypes parent-uuid proc)
+  (let* ((pkts (get-dpkts conn ptypes group-id parent-uuid)))
+    (map proc pkts)))
+
+;; criteria is an alist ((k . valpatt) ...)
+;;   - valpatt is a regex
+;;   - ptypes is a list of types (symbols expected)
+;;   match-type: 'any or 'all
+;;
+(define (find-pkts db ptypes criteria #!key (processed #f)(match-type 'any)(pkt-spec #f)) ;; processed=#f, don't use, else use
+  (let* ((pkts (get-dpkts db ptypes 0 #f))
+	 (match-rules (lambda (pktdat) ;; returns a list of matching rules
+			(filter (lambda (c)
+				  ;; (print "c: " c)
+				  (let* ((ctype (car c)) ;; card type
+					 (rx    (cdr c)) ;; card pattern
+					 ;; (t     (alist-ref 'pkt-type pktdat))
+					 (pkt   (alist-ref 'pkt pktdat))
+					 (apkt  (pkt->alist pkt))
+					 (cdat  (alist-ref ctype apkt)))
+				    ;; (print "cdat: " cdat) ;; " apkt: " apkt)
+				    (if cdat
+					(string-match rx cdat)
+					#f)))
+				criteria)))
+	 (res         (filter (lambda (pktdat)
+				(if (null? criteria) ;; looking for all pkts
+				    #t
+				    (case match-type
+				      ((any)(not (null? (match-rules pktdat))))
+				      ((all)(eq? (length (match-rules pktdat))(length criteria)))
+				      (else
+				       (print "ERROR: bad match type " match-type ", expecting any or all.")))))
+			      pkts)))
+    (if pkt-spec
+	(dpkts->alists res pkt-spec)
+	res)))
+
+;; get descendents of parent-uuid
+;;
+;; NOTE: Should be doing something like the following:
+;;
+;; given a uuid, get not processed child pkts 
+;; processed:
+;;    #f => get all
+;;     0 => get not processed
+;;     1 => get processed
+;;
+(define (get-ancestors db group-id uuid #!key (processed #f))
+  (map dblst->dpkts
+       (map vector->list
+	    (dbi:get-rows
+	     db
+	     (conc
+	      "SELECT id,group_id,uuid,parent_uuid,pkt_type,pkt,processed 
+                FROM pkts
+                 WHERE uuid IN 
+                     (WITH RECURSIVE
+                       tree(uuid,parent_uuid)
+                        AS
+                        (
+                           SELECT uuid, parent_uuid
+                           FROM pkts
+                           WHERE uuid = ?
+                           UNION ALL
+                           SELECT t.uuid, t.parent_uuid
+                           FROM pkts t
+                           JOIN tree ON t.uuid = tree.parent_uuid
+                        )
+	              SELECT uuid FROM tree)
+	    AND group_id=?" (if processed (conc " AND processed=" processed) "") ";")
+	     uuid group-id))))
+
+;; Untested
+;;
+(define (get-descendents db group-id uuid #!key (processed #f))
+  (map dblst->dpkts
+       (map vector->list
+	    (dbi:get-rows
+	     db
+	     (conc
+	      "SELECT id,group_id,uuid,parent_uuid,pkt_type,pkt,processed 
+                FROM pkts
+                 WHERE uuid IN 
+                     (WITH RECURSIVE
+                       tree(uuid,parent_uuid)
+                        AS
+                        (
+                           SELECT uuid, parent_uuid
+                           FROM pkts
+                           WHERE uuid = ?
+                           UNION ALL
+                           SELECT t.uuid, t.parent_uuid
+                           FROM pkts t
+                           JOIN tree ON t.parent_uuid = tree.uuid
+                        )
+	              SELECT uuid FROM tree)
+	    AND group_id=?" (if processed (conc " AND processed=" processed) "") ";")
+	     uuid group-id))))
+
+;; look up descendents based on given info unless passed in a list via inlst
+;;
+(define (get-last-descendent db group-id uuid #!key (processed #f)(inlst #f))
+  (let ((descendents (or inlst (get-descendents db group-id uuid processed: processed))))
+    (if (null? descendents)
+	#f
+	(last descendents))))
+
+;;======================================================================
+;;  A R C H I V E S - always to a sqlite3 db 
+;;======================================================================
+
+;; open an archive db
+;; path: archive-dir/<year>/month.db
+;;
+(define (archive-open-db archive-dir)
+  (let* ((curr-time (seconds->local-time (current-seconds)))
+	 (dbpath    (conc archive-dir "/" (time->string curr-time "%Y")))
+	 (dbfile    (conc dbpath "/" (time->string curr-time "%m") ".db"))
+	 (dbexists (if (file-exists? dbfile) #t (begin (create-directory dbpath #t) #f))))
+    (let ((db (dbi:open 'sqlite3 (list (cons 'dbname dbfile)))))
+      ;; (set-busy-handler! db (busy-timeout 10000))
+      (if (not dbexists) ;; NOTE: In the archive we allow duplicates and other messiness. 
+	  (dbi:exec db "CREATE TABLE IF NOT EXISTS pkts
+                          (id           INTEGER,
+                           group_id     INTEGER,
+                           uuid         TEXT,
+                           parent_uuid  TEXT,
+                           pkt_type     TEXT,
+                           pkt          TEXT,
+                           processed    INTEGER DEFAULT 0)"))
+      db)))
+
+;; turn on transactions! otherwise this will be painfully slow
+;;
+(define (write-archive-pkts src-db db pkt-ids)
+  (let ((pkts (dbi:get-rows
+	       src-db
+	       (conc "SELECT id,group_id,uuid,parent_uuid,pkt_type,pkt FROM pkts WHERE id IN ("
+		     (string-intersperse (map conc pkt-ids) ",") ")"))))
+    ;; (dbi:with-transaction
+    ;;  db
+     (lambda ()
+       (for-each
+	(lambda (pkt)
+	  (apply dbi:exec  db "INSERT INTO pkts (id,group_id,uuid,parent_uuid,pkt_type,pkt)
+                               VALUES (?,?,?,?,?,?)"
+		 pkt))
+	pkts)))) ;; )
+
+;; given a list of uuids and lists of uuids move all to
+;; the sqlite3 db for the current archive period
+;;
+(define (archive-pkts conn pkt-ids archive-dir)
+  (let ((db (archive-open-db archive-dir)))
+    (write-archive-pkts conn db pkt-ids)
+    (dbi:close db))
+  ;; (pg:with-transaction
+  ;;  conn
+  ;; (lambda ()
+     (for-each
+      (lambda (id)
+	(dbi:get-one
+	 conn
+	 "DELETE FROM pkts WHERE id=?" id))
+      pkt-ids)) ;; ))
+
+;; given a list of ids mark all as processed
+;;
+(define (mark-processed conn pkt-ids)
+  ;; (pg:with-transaction
+   ;; conn
+   ;; (lambda ()
+     (for-each
+      (lambda (id)
+	(dbi:get-one
+	 conn
+	 "UPDATE pkts SET processed=1 WHERE id=?;" id))
+      pkt-ids)) ;; x))
+
+;; a generic pkt getter, gets from the pkts db
+;;
+(define (get-pkts conn ptypes)
+  (let* ((ptypes-str    (if (null? ptypes)
+			    ""
+			    (conc " WHERE pkt_type IN ('" (string-intersperse ptypes ",") "') ")))
+	 (qry-str       (conc "SELECT id,group_id,uuid,parent_uuid,pkt_type,pkt,processed FROM pkts" ptypes-str)))
+    (map vector->list (dbi:get-rows conn qry-str))))
+
+;; make a report of the pkts in the db
+;; ptypes of '() gets all pkts
+;; display-fields
+;;
+(define (make-report dest conn pktspec display-fields . ptypes)
+  (let* (;; (conn          (dbi:db-conn (s:db)))
+	 (all-rows      (get-pkts conn ptypes))
+	 (all-pkts      (flatten-all
+			 all-rows
+			 pktspec
+			 'id 'group-id 'uuid 'parent 'pkt-type 'pkt 'processed))
+	 (by-uuid       (let ((ht (make-hash-table)))
+			  (for-each
+			   (lambda (pkt)
+			     (let ((uuid (alist-ref 'uuid pkt)))
+			       (hash-table-set! ht uuid pkt)))
+			   all-pkts)
+			  ht))
+	 (by-parent     (let ((ht (make-hash-table)))
+			  (for-each
+			   (lambda (pkt)
+			     (let ((parent (alist-ref 'parent pkt)))
+			       (hash-table-set! ht parent (cons pkt (hash-table-ref/default ht parent '())))))
+			   all-pkts)
+			    ht))
+	 (oup           (if dest (open-output-file dest) (current-output-port))))
+    
+    (with-output-to-port
+	oup
+      (lambda ()
+	(print "digraph megatest_state_status {
+  // ranksep=0.05
+  rankdir=LR;
+  node [shape=\"box\"];
+")
+	;; first all the names
+	(for-each
+	 (lambda (pkt)
+	   (let* ((uuid        (alist-ref 'uuid pkt))
+		  (shortuuid   (substring uuid 0 4))
+		  (type        (alist-ref 'pkt-type pkt))
+		  (processed   (alist-ref 'processed pkt)))
+	     
+	     (print "\"" uuid "\" [label=\"" shortuuid ", ("
+		    type ", "
+		    (if processed "processed" "not processed") ")")
+	     (for-each
+	      (lambda (key-field)
+		(let ((val (alist-ref key-field pkt)))
+		  (if val
+		      (print key-field "=" val))))
+	      display-fields)
+	     (print "\" ];")))
+	 all-pkts)
+	;; now for parent-child relationships
+	(for-each
+	 (lambda (pkt)
+	   (let ((uuid   (alist-ref 'uuid pkt))
+		 (parent (alist-ref 'parent pkt)))
+	     (if (not (equal? parent ""))
+		 (print "\"" parent "\" -> \"" uuid"\";"))))
+	 all-pkts)
+
+	(print "}")
+	))
+    (if dest
+	(begin
+	  (close-output-port oup)
+	  (system "dot -Tpdf out.dot -o out.pdf")))
+    
+    ))
+
+;;======================================================================
+;; Read ref pkts into a vector < laststr hash table > 
+;;======================================================================
+
+
+
+;;======================================================================
+;; Read/write packets to files (convience functions)
+;;======================================================================
+
+;; write alist to a pkt file
+;;
+(define (write-alist->pkt targdir dat #!key (pktspec '())(ptype #f))
+  (let-values (((uuid pkt)(alist->pkt dat pktspec ptype: ptype)))
+    (with-output-to-file (conc targdir "/" uuid ".pkt")
+      (lambda ()
+	(print pkt)))
+    uuid)) ;; return the uuid
+
+;; read pkt into alist
+;;
+(define (read-pkt->alist pkt-file #!key (pktspec #f))
+  (pkt->alist (with-input-from-file
+		  pkt-file
+		read-string)
+	      pktspec: pktspec))
+
+
+) ;; module pkts

ADDED   pkts/pkts.setup
Index: pkts/pkts.setup
==================================================================
--- /dev/null
+++ pkts/pkts.setup
@@ -0,0 +1,11 @@
+;; Copyright 2007-2017, 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.
+
+;;;; pkts.setup
+(standard-extension 'pkts "1.0")

ADDED   pkts/tests/run.scm
Index: pkts/tests/run.scm
==================================================================
--- /dev/null
+++ pkts/tests/run.scm
@@ -0,0 +1,139 @@
+(use test)
+
+;; (use (prefix pkts pkts:))
+(use pkts (prefix dbi dbi:))
+;; (use trace)(trace sdat->alist pkt->alist)
+
+(if (file-exists? "queue.db")(delete-file "queue.db"))
+
+(test-begin "pkts and pkt archives")
+
+;;======================================================================
+;; Basic pkt creation, parsing and conversion routines
+;;======================================================================
+
+(test-begin "basic packets")
+(test #f '(A "This is a packet") (let-values (((t v)
+					       (card->type/value "A This is a packet")))
+				   (list t v)))
+(test #f "A A\nZ 664449e7299e0065a3e25c138ccef2df13ba291e"
+      (let-values (((uuid res)
+		    (add-z-card '("A A"))))
+	res))
+(test #f '("CC C++" "D 1486332719.0" "a A" "b C")(sort (construct-sdat 'b "C" 'a "A" 'CC "C++" 'D 1486332719.0)
+						       string<=?))
+(define pkt-example #f)
+(test #f "CC C++\nD 1486332719.0\na A\nb C\nZ 263eb3b6193de7fe65b1ded5bcda513e8b4d6b84"
+      (let-values (((uuid res)
+		    (construct-pkt 'b "C" 'a "A" 'CC "C++" 'D 1486332719.0)))
+	(set! pkt-example (cons uuid res))
+	res))
+(test-end "basic packets")
+
+;;======================================================================
+;; Sqlite and postgresql based queue of pkts
+;;======================================================================
+
+(test-begin "pkt queue")
+(define db #f)
+(test #f 'sqlite3 (let ((dbh (open-queue-db "." "queue.db")))
+		    (set! db dbh)
+		    (dbi:db-dbtype dbh)))
+(test #f (cdr pkt-example)
+      (begin
+	(add-to-queue db (cdr pkt-example)(car pkt-example) 'basic #f 0)
+	(lookup-by-uuid db (car pkt-example) 0)))
+(test #f (cdr pkt-example)
+      (lookup-by-id db 1))
+(test #f 1 (length (find-pkts db '(basic) '())))
+
+(test-end "pkt queue")
+
+
+;;======================================================================
+;; Process groups of pkts
+;;======================================================================
+
+(test-begin "lists of packets")
+(test #f '((apkt . #f) (id . 1) (group-id . 2) (uuid . 3) (parent . 4) (pkt-type . 5)) ;; ((id . 1) (group-id . 2) (uuid . 3) (parent . 4) (pkt-type . 5))
+      (dblst->dpkts '(1 2 3 4 5)))
+(test #f '(((apkt (Z . "263eb3b6193de7fe65b1ded5bcda513e8b4d6b84") (b . "C") (a . "A") (D . "1486332719.0") (C . " C++")) (id . 1) (group-id . 0) (uuid . "263eb3b6193de7fe65b1ded5bcda513e8b4d6b84") (parent . "") (pkt-type . "basic") (pkt . "CC C++\nD 1486332719.0\na A\nb C\nZ 263eb3b6193de7fe65b1ded5bcda513e8b4d6b84") (processed . 0)))
+      ;; '(((apkt (Z . "263eb3b6193de7fe65b1ded5bcda513e8b4d6b84") (b . "C") (a . "A") (D . "1486332719.0") (C . " C++")) (id . 1) (group-id . 0) (uuid . "263eb3b6193de7fe65b1ded5bcda513e8b4d6b84") (parent . "") (pkt-type . "basic") (pkt . "CC C++\nD 1486332719.0\na A\nb C\nZ 263eb3b6193de7fe65b1ded5bcda513e8b4d6b84")))
+      ;; '(((id . 1) (group-id . 0) (uuid . "263eb3b6193de7fe65b1ded5bcda513e8b4d6b84") (parent . "") (pkt-type . "basic") (pkt . "CC C++\nD 1486332719.0\na A\nb C\nZ 263eb3b6193de7fe65b1ded5bcda513e8b4d6b84")))
+      (get-dpkts db '(basic) 0 #f))
+(test #f '(((apkt (Z . "263eb3b6193de7fe65b1ded5bcda513e8b4d6b84") (b . "C") (a . "A") (D . "1486332719.0") (C . " C++")) (id . 1) (group-id . 0) (uuid . "263eb3b6193de7fe65b1ded5bcda513e8b4d6b84") (parent . "") (pkt-type . "basic") (pkt . "CC C++\nD 1486332719.0\na A\nb C\nZ 263eb3b6193de7fe65b1ded5bcda513e8b4d6b84") (processed . 0)))
+      ;; '(((apkt (Z . "263eb3b6193de7fe65b1ded5bcda513e8b4d6b84") (b . "C") (a . "A") (D . "1486332719.0") (C . " C++")) (id . 1) (group-id . 0) (uuid . "263eb3b6193de7fe65b1ded5bcda513e8b4d6b84") (parent . "") (pkt-type . "basic") (pkt . "CC C++\nD 1486332719.0\na A\nb C\nZ 263eb3b6193de7fe65b1ded5bcda513e8b4d6b84")))
+      ;; '(((id . 1) (group-id . 0) (uuid . "263eb3b6193de7fe65b1ded5bcda513e8b4d6b84") (parent . "") (pkt-type . "basic") (pkt . "CC C++\nD 1486332719.0\na A\nb C\nZ 263eb3b6193de7fe65b1ded5bcda513e8b4d6b84")))
+      (get-not-processed-pkts db 0 'basic 1000 0))
+(test-end "lists of packets")
+
+(test-begin "pkts as alists")
+(define pktspec '((posting . ((title . t)   ;; NOTE: same as ((posting (title . t)(url . u)(blub . b)) ... 
+			      (url   . u)
+			      (blurb . b)))
+		  (comment . ((comment . c)
+			      (score   . s)))
+		  (basic   . ((b-field . b)
+			      (a-field . a)))))
+(define pktlst (find-pkts db '(basic) '()))
+(define dpkt (car pktlst))
+(test #f "A" (get-value 'a-field dpkt pktspec))
+
+(test #f "C" (alist-ref 'b-field (dpkt->alist dpkt pktspec)))
+
+(define basic-spec '((nada (foo . b)(bar . f))(basic (foo . f)(bar . b))))
+(define test-pkt   '((foo . "fooval")(bar . "barval")))
+(let*-values (((u p)  (alist->pkt test-pkt basic-spec ptype: 'basic))
+		((apkt) (pkt->alist p))
+		((bpkt) (pkt->alist p pktspec: basic-spec)))
+    (test #f "fooval" (alist-ref 'f apkt))
+    (test #f "fooval" (alist-ref 'foo bpkt))
+    (test #f #f       (alist-ref 'f   bpkt)))
+
+(test-end "pkts as alists")
+
+(test-begin "descendents and ancestors")
+
+(define (get-uuid pkt)(alist-ref 'uuid pkt))
+
+;; add a child to 263e
+(let-values (((uuid pkt)
+	      (construct-pkt 'x "X" 'y "Y" 'P "263eb3b6193de7fe65b1ded5bcda513e8b4d6b84"
+			     'D "1486332719.0")))
+  (add-to-queue db pkt uuid 'basic "263eb3b6193de7fe65b1ded5bcda513e8b4d6b84" 0))
+
+(test #f '("263eb3b6193de7fe65b1ded5bcda513e8b4d6b84" "818fe30988c9673441b8f203972a8bda6af682f8")
+      (map (lambda (x)(alist-ref 'uuid x))
+	   (get-descendents
+	    db 0
+	    "263eb3b6193de7fe65b1ded5bcda513e8b4d6b84")))
+
+(test #f '("263eb3b6193de7fe65b1ded5bcda513e8b4d6b84" "818fe30988c9673441b8f203972a8bda6af682f8")
+      (map (lambda (x)(alist-ref 'uuid x))
+	   (get-ancestors
+	    db 0
+	    "818fe30988c9673441b8f203972a8bda6af682f8")))
+
+(test-end "descendents and ancestors")
+
+(test-end "pkts and pkt archives")
+
+(test-begin "pktsdb")
+
+(define spec '((tests (testname n TEXT)
+		      (testpath p TEXT)
+		      (duration d INTEGER))))
+;; (define pktsdb (make-pktdb))
+;; (pktdb-pktsdb-spec-set! pktsdb spec)
+
+(define pktsdb #f)
+
+(test #f #t (dbi:database? (let ((pdb (pktsdb-open "test.db" spec)))
+			     (set! pktsdb pdb)
+			     (pktdb-conn pdb))))
+;; (pp (pktdb-pktspec pktsdb))
+(test #f #t (pktsdb-add-record pktsdb 'tests '((testname . "test1"))))
+
+(pktsdb-close pktsdb)
+
+(test-end "pktsdb")

Index: process.scm
==================================================================
--- process.scm
+++ process.scm
@@ -196,12 +196,14 @@
 	    (equal? rpid pid)))))
 
 (define (process:alive-on-host? host pid)
   (let ((cmd (conc "ssh " host " ps -o pid= -p " pid)))
     (handle-exceptions
-     exn
-     #f ;; anything goes wrong - assume the process in NOT running.
+	exn
+      (begin
+	(debug:print 0 *default-log-port* "failed to identify if process " pid ", on host " host " is alive. exn=" exn)
+	#f) ;; anything goes wrong - assume the process in NOT running.
      (with-input-from-pipe 
       cmd
       (lambda ()
 	(let loop ((inl (read-line)))
 	  (if (eof-object? inl)

ADDED   reindent.el
Index: reindent.el
==================================================================
--- /dev/null
+++ reindent.el
@@ -0,0 +1,14 @@
+; Indenting module body code at column 0
+(defun scheme-module-indent (state indent-point normal-indent) 0)
+(put 'module 'scheme-indent-function 'scheme-module-indent)
+
+(put 'and-let* 'scheme-indent-function 1)
+(put 'parameterize 'scheme-indent-function 1)
+(put 'handle-exceptions 'scheme-indent-function 1)
+(put 'when 'scheme-indent-function 1)
+(put 'unless 'scheme-indent-function 1)
+(put 'match 'scheme-indent-function 1)
+(put 'let-values 'scheme-indent-function 1)
+
+;; do the work
+(indent-region (point-min) (point-max) nil)

Index: rmt.scm
==================================================================
--- rmt.scm
+++ rmt.scm
@@ -22,10 +22,12 @@
 
 (declare (unit rmt))
 (declare (uses api))
 (declare (uses http-transport))
 (include "common_records.scm")
+(include "db_records.scm")
+
 ;; (declare (uses rmtmod))
 
 ;; (import rmtmod)
 
 ;;
@@ -54,18 +56,39 @@
 		  (client:setup areapath)
 		  #f))))
 
 (define *send-receive-mutex* (make-mutex)) ;; should have separate mutex per run-id
 
+(define *rmt-query-last-call-time* 0)
+(define *rmt-query-last-rest-time* 0) ;; last time there was at least a 1/2 second rest - giving other processes access to the db
+
+;; NOTE: This query rest algorythm will not adapt to long query times. REDESIGN NEEDED. TODO. FIXME.
+;;
+(define (rmt:query-rest cmd rid params)
+  (let* ((now (current-milliseconds)))
+    (cond
+     ((> (- now *rmt-query-last-call-time*) 100)  ;; it's been a while since last query - no need to rest
+      (set! *rmt-query-last-rest-time*  now)
+      (set! *rmt-query-last-call-time*  now))
+     ((> (- now *rmt-query-last-rest-time*) 5000) ;; no natural rests have happened
+      (debug:print 0 *default-log-port* "query rest needed. blocking for 0.1 second. cmd="cmd", run id="rid", params="params)
+      (thread-sleep! 0.1) ;; force a rest of a half second
+      (set! *rmt-query-last-rest-time* now)
+      (set! *rmt-query-last-call-time* now))
+     (else ;; sufficient rests have occurred, just record the last query time
+      (set! *rmt-query-last-call-time* now)))))
+
 ;; RA => e.g. usage (rmt:send-receive 'get-var #f (list varname))
 ;;
 (define (rmt:send-receive cmd rid params #!key (attemptnum 1)(area-dat #f)) ;; start attemptnum at 1 so the modulo below works as expected
 
   #;(common:telemetry-log (conc "rmt:"(->string cmd))
                         payload: `((rid . ,rid)
                                    (params . ,params)))
-                          
+  (if (not (equal? (configf:lookup *configdat* "setup" "query-rest") "no"))
+      (rmt:query-rest cmd rid params))
+  
   (if (> attemptnum 2)
       (debug:print 0 *default-log-port* "INFO: attemptnum in rmt:send-receive is " attemptnum))
     
   (cond
    ((> attemptnum 2) (thread-sleep! 0.05))
@@ -313,29 +336,10 @@
 	;; there was a detected issue at the other end
 	(extras-transport-succeded *default-log-port* *rmt-mutex* attemptnum runremote res params rid cmd)
 	(extras-transport-failed *default-log-port* *rmt-mutex* attemptnum runremote cmd rid params)
 	)))
 
-;; (define (rmt:update-db-stats run-id rawcmd params duration)
-;;   (mutex-lock! *db-stats-mutex*)
-;;   (handle-exceptions
-;;    exn
-;;    (begin
-;;      (debug:print 0 *default-log-port* "WARNING: stats collection failed in update-db-stats")
-;;      (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
-;;      (print "exn=" (condition->list exn))
-;;      #f) ;; if this fails we don't care, it is just stats
-;;    (let* ((cmd      (conc "run-id=" run-id " " (if (eq? rawcmd 'general-call) (car params) rawcmd)))
-;; 	  (stat-vec (hash-table-ref/default *db-stats* cmd #f)))
-;;      (if (not (vector? stat-vec))
-;; 	 (let ((newvec (vector 0 0)))
-;; 	   (hash-table-set! *db-stats* cmd newvec)
-;; 	   (set! stat-vec newvec)))
-;;      (vector-set! stat-vec 0 (+ (vector-ref stat-vec 0) 1))
-;;      (vector-set! stat-vec 1 (+ (vector-ref stat-vec 1) duration))))
-;;   (mutex-unlock! *db-stats-mutex*))
-
 (define (rmt:print-db-stats)
   (let ((fmtstr "~40a~7-d~9-d~20,2-f")) ;; "~20,2-f"
     (debug:print 18 *default-log-port* "DB Stats\n========")
     (debug:print 18 *default-log-port* (format #f "~40a~8a~10a~10a" "Cmd" "Count" "TotTime" "Avg"))
     (for-each (lambda (cmd)
@@ -380,20 +384,20 @@
 	 (resdat         (if (not (and read-only qry-is-write))
 			     (let ((v (api:execute-requests dbstruct-local (vector (symbol->string cmd) params))))
 			       (handle-exceptions ;; there has been a long history of receiving strange errors from values returned by the client when things go wrong..
 				exn               ;;  This is an attempt to detect that situation and recover gracefully
 				(begin
-				  (debug:print 0 *default-log-port* "ERROR: bad data from server " v " message: "  ((condition-property-accessor 'exn 'message) exn))
+				  (debug:print 0 *default-log-port* "ERROR: bad data from server " v " message: "  ((condition-property-accessor 'exn 'message) exn) ", exn=" exn)
 				  (vector #t '())) ;; should always get a vector but if something goes wrong return a dummy
 				(if (and (vector? v)
 					 (> (vector-length v) 1))
 				    (let ((newvec (vector (vector-ref v 0)(vector-ref v 1))))
 				      newvec)           ;; by copying the vector while inside the error handler we should force the detection of a corrupted record
 				    (vector #t '()))))  ;; we could also check that the returned types are valid
 			     (vector #t '())))
-	 (success        (vector-ref resdat 0))
-	 (res            (vector-ref resdat 1))
+	 (success        (common:safe-vector-ref resdat 0 #f)) ;; (vector-ref resdat 0))
+	 (res            (common:safe-vector-ref resdat 1 #f)) ;; (vector-ref resdat 1))
 	 (duration       (- (current-milliseconds) start)))
     (if (and read-only qry-is-write)
         (debug:print 0 *default-log-port* "ERROR: attempt to write to read-only database ignored. cmd=" cmd))
     (if (not success)
 	(if (> remretries 0)
@@ -408,35 +412,26 @@
 	  ;; (rmt:update-db-stats run-id cmd params duration)
 	  ;; mark this run as dirty if this was a write, the watchdog is responsible for syncing it
 	  (if qry-is-write
 	      (let ((start-time (current-seconds)))
 		(mutex-lock! *db-multi-sync-mutex*)
-/		(set! *db-last-access* start-time)  ;; THIS IS PROBABLY USELESS? (we are on a client)
+		(set! *db-last-access* start-time)  ;; THIS IS PROBABLY USELESS? (we are on a client)
                 (mutex-unlock! *db-multi-sync-mutex*)))))
     res))
 
 (define (rmt:send-receive-no-auto-client-setup connection-info cmd run-id params)
   (let* ((run-id   (if run-id run-id 0))
 	 (res  	   (handle-exceptions
-		    exn
-		    #f
-		    (http-transport:client-api-send-receive run-id connection-info cmd params))))
+		       exn
+		     (begin
+		       (print "transport failed. exn=" exn)
+		       #f)
+		     (http-transport:client-api-send-receive run-id connection-info cmd params))))
     (if (and res (vector-ref res 0))
 	(vector-ref res 1) ;;; YES!! THIS IS CORRECT!! CHANGE IT HERE, THEN CHANGE rmt:send-receive ALSO!!!
 	#f)))
 
-;; ;; 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  
 ;;
 ;;======================================================================
@@ -476,13 +471,10 @@
 
 ;; given a hostname, return a pair of cpu load and update time representing latest intelligence from tests running on that host
 (define (rmt:get-latest-host-load hostname)
   (rmt:send-receive 'get-latest-host-load 0 (list hostname)))
 
-;; (define (rmt:sync-inmem->db run-id)
-;;   (rmt:send-receive 'sync-inmem->db run-id '()))
-
 (define (rmt:sdb-qry qry val run-id)
   ;; add caching if qry is 'getid or 'getstr
   (rmt:send-receive 'sdb-qry run-id (list qry val)))
 
 ;; NOT COMPLETED
@@ -493,10 +485,16 @@
   (rmt:send-receive 'get-run-record-ids #f (list target run keynames test-patt)))
 
 (define (rmt:get-changed-record-ids since-time)
   (rmt:send-receive 'get-changed-record-ids #f (list since-time)) )
 
+(define (rmt:drop-all-triggers)
+     (rmt:send-receive 'drop-all-triggers #f '()))
+
+(define (rmt:create-all-triggers)
+     (rmt:send-receive 'create-all-triggers #f '()))
+
 ;;======================================================================
 ;;  T E S T   M E T A 
 ;;======================================================================
 
 (define (rmt:get-tests-tags)
@@ -550,15 +548,32 @@
   (rmt:general-call 'register-test run-id run-id test-name item-path))
 
 (define (rmt:get-test-id run-id testname item-path)
   (rmt:send-receive 'get-test-id run-id (list run-id testname item-path)))
 
-;; run-id is NOT used
+;; run-id is NOT used - but it will be! 
 ;;
 (define (rmt:get-test-info-by-id run-id test-id)
   (if (number? test-id)
-      (rmt:send-receive 'get-test-info-by-id run-id (list run-id test-id))
+      (let* ((testdat  (rmt:send-receive 'get-test-info-by-id run-id (list run-id test-id)))
+             (trundir  (vector-ref testdat 10))
+	     (trundatf (conc trundir"/.mt_data/test-run.dat")))
+	;; now we can update a couple fields from the filesystem
+	(handle-exceptions
+	    exn
+	    (begin
+	      (debug:print-info 0 *default-log-port* "Could not update testdat record from "trundatf", exn=" exn)
+	      #f)
+	  (if (and trundir
+		   (file-exists? trundatf))
+	      (let* ((duration     (vector-ref testdat 12)) ;; (db:test-get-run_duration testdat))
+		     (event-time   (vector-ref testdat 5))   ;; (db:test-get-event_time   testdat))
+		     (last-touch   (file-modification-time trundatf))
+		     (new-duration (max duration (- last-touch event-time))))
+		(vector-set! testdat 12 new-duration))))
+	      #;(db:test-set-run_duration! testdat (max duration (- last-touch event-time)))
+	testdat)
       (begin
 	(debug:print 0 *default-log-port* "WARNING: Bad data handed to rmt:get-test-info-by-id run-id=" run-id ", test-id=" test-id)
 	(print-call-chain (current-error-port))
 	#f)))
 
@@ -585,10 +600,13 @@
   ;;    (begin
   ;;	(debug:print-error 0 *default-log-port* "rmt:get-tests-for-run called with bad run-id=" run-id)
   ;;	(print-call-chain (current-error-port))
   ;;	'())))
 
+(define (rmt:get-tests-for-run-state-status run-id testpatt last-update)
+  (rmt:send-receive 'get-tests-for-run-state-status run-id (list run-id testpatt last-update)))
+
 ;; get stuff via synchash 
 (define (rmt:synchash-get run-id proc synckey keynum params)
   (rmt:send-receive 'synchash-get run-id (list run-id proc synckey keynum params)))
 
 (define (rmt:get-tests-for-run-mindata run-id testpatt states status not-in)
@@ -638,15 +656,10 @@
 ;; 		       run-id-list))))
 
 (define (rmt:delete-test-records run-id test-id)
   (rmt:send-receive 'delete-test-records run-id (list run-id test-id)))
 
-;; This is not needed as test steps are deleted on test delete call
-;;
-;; (define (rmt:delete-test-step-records run-id test-id)
-;;   (rmt:send-receive 'delete-test-step-records run-id (list run-id test-id)))
-
 (define (rmt:test-set-state-status run-id test-id state status msg)
   (rmt:send-receive 'test-set-state-status run-id (list run-id test-id state status msg)))
 
 (define (rmt:test-toplevel-num-items run-id test-name)
   (rmt:send-receive 'test-toplevel-num-items run-id (list run-id test-name)))
@@ -685,18 +698,17 @@
     (apply append 
 	   (map (lambda (run-id)
 		  (rmt:send-receive 'test-get-paths-matching-keynames-target-new run-id (list run-id keynames target res testpatt statepatt statuspatt runname)))
 	   run-ids))))
 
-;; (define (rmt:get-run-ids-matching keynames target res)
-;;   (rmt:send-receive #f 'get-run-ids-matching (list keynames target res)))
-
 (define (rmt:get-prereqs-not-met run-id waitons ref-test-name ref-item-path #!key (mode '(normal))(itemmaps #f))
   (rmt:send-receive 'get-prereqs-not-met run-id (list run-id waitons ref-test-name ref-item-path mode itemmaps)))
 
 (define (rmt:get-count-tests-running-for-run-id run-id)
-  (rmt:send-receive 'get-count-tests-running-for-run-id run-id (list run-id)))
+  (if (number? run-id)
+      (rmt:send-receive 'get-count-tests-running-for-run-id run-id (list run-id))
+      0))
 
 (define (rmt:get-not-completed-cnt run-id)
   (rmt:send-receive 'get-not-completed-cnt run-id (list run-id)))
 
 
@@ -762,12 +774,12 @@
   (rmt:send-receive 'delete-old-deleted-test-records #f '()))
 
 (define (rmt:get-runs runpatt count offset keypatts)
   (rmt:send-receive 'get-runs #f (list runpatt count offset keypatts)))
 
-(define (rmt:simple-get-runs runpatt count offset target)
-  (rmt:send-receive 'simple-get-runs #f (list runpatt count offset target)))
+(define (rmt:simple-get-runs runpatt count offset target last-update)
+  (rmt:send-receive 'simple-get-runs #f (list runpatt count offset target last-update)))
 
 (define (rmt:get-all-run-ids)
   (rmt:send-receive 'get-all-run-ids #f '()))
 
 (define (rmt:get-prev-run-ids run-id)
@@ -788,10 +800,12 @@
   (rmt:send-receive 'set-run-status #f (list run-id run-status msg)))
 
 (define (rmt:set-run-state-status run-id state status )
   (rmt:send-receive 'set-run-state-status #f (list run-id state status)))
 
+(define (rmt:update-tesdata-on-repilcate-db old-lt new-lt)
+(rmt:send-receive 'update-tesdata-on-repilcate-db #f (list old-lt new-lt)))
 
 (define (rmt:update-run-event_time run-id)
   (rmt:send-receive 'update-run-event_time #f (list run-id)))
 
 (define (rmt:get-runs-by-patt  keys runnamepatt targpatt offset limit fields last-runs-update  #!key  (sort-order "asc")) ;; fields of #f uses default
@@ -811,10 +825,19 @@
   (rmt:send-receive 'del-var #f (list varname)))
 
 (define (rmt:set-var varname value)
   (rmt:send-receive 'set-var #f (list varname value)))
 
+(define (rmt:inc-var varname)
+  (rmt:send-receive 'inc-var #f (list varname)))
+
+(define (rmt:dec-var varname)
+  (rmt:send-receive 'dec-var #f (list varname)))
+
+(define (rmt:add-var varname value)
+  (rmt:send-receive 'add-var #f (list varname value)))
+
 ;;======================================================================
 ;; M U L T I R U N   Q U E R I E S
 ;;======================================================================
 
 ;; Need to move this to multi-run section and make associated changes
@@ -946,10 +969,19 @@
 (define (rmt:no-sync-del! var)
   (rmt:send-receive 'no-sync-del! #f `(,var)))
 
 (define (rmt:no-sync-get-lock keyname)
   (rmt:send-receive 'no-sync-get-lock #f `(,keyname)))
+
+(define (rmt:no-sync-add-job host-type vars-list exekey cmdline)
+  (rmt:send-receive 'no-sync-add-job #f `(,host-type ,vars-list ,exekey ,cmdline)))
+
+(define (rmt:no-sync-take-job host-type)
+  (rmt:send-receive 'no-sync-take-job #f `(,host-type)))
+
+(define (rmt:no-sync-job-records-clean)
+  (rmt:set-receive 'no-sync-job-records-clean #f '()))
 
 ;;======================================================================
 ;; A R C H I V E S
 ;;======================================================================
 

Index: rmtmod.scm
==================================================================
--- rmtmod.scm
+++ rmtmod.scm
@@ -18,44 +18,67 @@
 
 ;;======================================================================
 
 (declare (unit rmtmod))
 (declare (uses commonmod))
+(declare (uses apimod))
+;; (declare (uses apimod.import))
+(declare (uses ulex))
+
+;; (include "ulex/ulex.scm")
 
 (module rmtmod
 	*
 	
 (import scheme chicken data-structures extras)
 (import (prefix sqlite3 sqlite3:) posix typed-records srfi-18)
-(import commonmod)
-
-;; Hack to make these functions visible to the refactored code, goal is to eliminate these over time.
-(define (rmt:send-receive . params) #f)
-(define (http-transport:close-connections . params) #f)
-;; from remote defstruct in common.scm
-(define (remote-conndat-set! . params) #f)
-(define (remote-server-url-set! . params) #f)
-(define (remote-ro-mode . params) #f)
-(define (remote-ro-mode-set! . params) #f)
-(define (remote-ro-mode-checked-set! . params) #f)
-(define (remote-ro-mode-checked . params) #f)
-(define (debug:print . params) #f)
-(define (debug:print-info . params) #f)
-
-(define (set-functions send-receive        rsus
-		       close-connections   rcs
-		       dbgp                dbgpinfo
-		       ro-mode             ro-mode-set
-		       ro-mode-checked-set ro-mode-checked
-		       ) 
-  (set! rmt:send-receive                 send-receive)
-  (set! remote-server-url-set!           rsus)
-  (set! http-transport:close-connections close-connections)
-  (set! remote-conndat-set!              rcs)
-  (set! debug:print                      dbgp)
-  (set! debug:print-info                 dbgpinfo)
-  (set! remote-ro-mode                   ro-mode)
-  (set! remote-ro-mode-set!              ro-mode-set)
-  (set! remote-ro-mode-checked-set!      ro-mode-checked-set)
-  (set! remote-ro-mode-checked           ro-mode-checked))
-
+(import (prefix commonmod cmod:))
+(import apimod)
+(import (prefix ulex ulex:))
+
+(defstruct alldat
+  (areapath #f)
+  (ulexdat  #f)
+  )
+
+;; return the handle struct for sending queries to a specific database
+;;  - initializes the connection object if this is the first access
+;;    - finds the "captain" and asks who to talk to for the given dbfname
+;;    - establishes the connection to the current dbowner
+;;
+#;(define (rmt:connect alldat dbfname dbtype)
+  (let* ((ulexdat    (or (alldat-ulexdat alldat)
+			 (rmt:setup-ulex alldat))))
+    (ulex:connect ulexdat dbfname dbtype)))
+
+;; setup the remote calls
+#;(define (rmt:setup-ulex alldat)
+  (let* ((udata (ulex:setup))) ;; establish connection to ulex
+    (alldat-ulexdat-set! alldat udata)
+    ;; register all needed procs
+    (ulex:register-handler udata 'ping cmod:get-full-version)  ;; override ping with get-full-version
+    (ulex:register-handler udata 'login cmod:get-full-version) ;; force setup of the connection
+    (ulex:register-handler udata 'execute api:execute-requests)
+    udata))
+
+;; set up a connection to the current owner of the dbfile associated with rid
+;; then send the query to that dbfile owner and wait for a response.
+;;
+#;(define (rmt:send-receive alldat cmd rid params #!key (attemptnum 1)(area-dat #f)) ;; start attemptnum at 1 so the modulo below works as expected
+  (let* (;; (alldat   *alldat*)
+	 (areapath (alldat-areapath alldat))
+	 (dbtype   (if (or (not rid)(< rid 1)) ;; this is the criteria for "main.db"
+		       "main" "runs"))
+	 (dbfname  (if (equal? dbtype "main")
+		       "main.db"
+		       (conc rid ".db")))
+	 (dbfile   (conc areapath "/.db/" dbfname))
+	 (ulexconn (rmt:connect alldat dbfname dbtype))  ;; ulexconn is our new *runremote*, it is a dbowner struct < pdat lastrefresh >
+	 (udata    (alldat-ulexdat alldat)))
+    	(ulex:remote-request udata ulexconn 'immediate dbfile 'execute rid params)))
+    ;; need to call this on the other side 
+    ;; (api:execute-requests dbstruct-local (vector (symbol->string cmd) params))))
+    
+    #;(with-input-from-string
+	(ulex:remote-request udata ulexconn 'immediate dbfile 'execute rid (with-output-to-string (lambda ()(serialize params))))
+       (lambda ()(deserialize)))
 )

DELETED rpc-transport.scm
Index: rpc-transport.scm
==================================================================
--- rpc-transport.scm
+++ /dev/null
@@ -1,237 +0,0 @@
-
-;; Copyright 2006-2012, Matthew Welland.
-;; 
-;; This file is part of Megatest.
-;; 
-;;     Megatest is free software: you can redistribute it and/or modify
-;;     it under the terms of the GNU General Public License as published by
-;;     the Free Software Foundation, either version 3 of the License, or
-;;     (at your option) any later version.
-;; 
-;;     Megatest is distributed in the hope that it will be useful,
-;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;     GNU General Public License for more details.
-;; 
-;;     You should have received a copy of the GNU General Public License
-;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
-;;
-
-(require-extension (srfi 18) extras tcp s11n rpc)
-(import (prefix rpc rpc:))
-
-(use sqlite3 srfi-1 posix regex regex-case srfi-69 hostinfo md5 message-digest)
-(import (prefix sqlite3 sqlite3:))
-
-(declare (unit rpc-transport))
-
-(declare (uses common))
-(declare (uses db))
-(declare (uses tests))
-(declare (uses tasks)) ;; tasks are where stuff is maintained about what is running.
-
-(include "common_records.scm")
-(include "db_records.scm")
-
-;; procstr is the name of the procedure to be called as a string
-(define (rpc-transport:autoremote procstr params)
-  (handle-exceptions
-   exn
-   (begin
-     (debug:print 1 *default-log-port* "Remote failed for " proc " " params)
-     (apply (eval (string->symbol procstr)) params))
-   ;; (if *runremote*
-   ;;    (apply (eval (string->symbol (conc "remote:" procstr))) params)
-   (apply (eval (string->symbol procstr)) params)))
-
-;; all routes though here end in exit ...
-;;
-;; start_server? 
-;;
-(define (rpc-transport:launch run-id)
-  (let* ((tdbdat (tasks:open-db)))
-    (BB> "rpc-transport:launch fired for run-id="run-id)
-    (set! *run-id*   run-id)
-    (if (args:get-arg "-daemonize")
-        (daemon:ize))
-    (if (server:check-if-running run-id)
-        (begin
-          (debug:print 0 *default-log-port* "INFO: Server for run-id " run-id " already running")
-          (exit 0)))
-    (let loop ((server-id (tasks:server-lock-slot (db:delay-if-busy tdbdat) run-id))
-               (remtries  4))
-      (if (not server-id)
-          (if (> remtries 0)
-              (begin
-                (thread-sleep! 2)
-                (loop (tasks:server-lock-slot (db:delay-if-busy tdbdat) run-id)
-                      (- remtries 1)))
-              (begin
-                ;; since we didn't get the server lock we are going to clean up and bail out
-                (debug:print-info 2 *default-log-port* "INFO: server pid=" (current-process-id) ", hostname=" (get-host-name) " not starting due to other candidates ahead in start queue")
-                (tasks:server-delete-records-for-this-pid (db:delay-if-busy tdbdat) " rpc-transport:launch")))
-          (begin
-            (rpc-transport:run (if (args:get-arg "-server")(args:get-arg "-server") "-") run-id server-id)
-            (exit))))))
-
-(define (rpc-transport:run hostn run-id server-id)
-  (debug:print 2 *default-log-port* "Attempting to start the rpc server ...")
-   ;; (trace rpc:publish-procedure!)
-
-  (rpc:publish-procedure! 'server:login server:login)
-  (rpc:publish-procedure! 'testing (lambda () "Just testing"))
-
-  (let* ((db              #f)
-	 (hostname        (get-host-name))
-	 (ipaddrstr       (let ((ipstr (if (string=? "-" hostn)
-					   ;; (string-intersperse (map number->string (u8vector->list (hostname->ip hostname))) ".")
-					   (server:get-best-guess-address hostname)
-					   #f)))
-			    (if ipstr ipstr hostn))) ;; hostname))) 
-	 (start-port      (open-run-close tasks:server-get-next-port tasks:open-db))
-	 (link-tree-path  (configf:lookup *configdat* "setup" "linktree"))
-	 (rpc:listener    (rpc-transport:find-free-port-and-open (rpc:default-server-port)))
-	 (th1             (make-thread
-			   (lambda ()
-			     ((rpc:make-server rpc:listener) #t))
-			   "rpc:server"))
-			   ;; (cute (rpc:make-server rpc:listener) "rpc:server")
-			   ;; 'rpc:server))
-	 (hostname        (if (string=? "-" hostn)
-			      (get-host-name) 
-			      hostn))
-	 (ipaddrstr       (if (string=? "-" hostn)
-			      (server:get-best-guess-address hostname) ;; (string-intersperse (map number->string (u8vector->list (hostname->ip hostname))) ".")
-			      #f))
-	 (portnum         (rpc:default-server-port))
-	 (host:port       (conc (if ipaddrstr ipaddrstr hostname) ":" portnum))
-	 (tdb             (tasks:open-db)))
-    (thread-start! th1)
-    (set! db *dbstruct-db*)
-    (open-run-close tasks:server-set-interface-port 
-		    tasks:open-db 
-		    server-id 
-		    ipaddrstr portnum)
-    (debug:print 0 *default-log-port* "Server started on " host:port)
-    
-    ;; (trace rpc:publish-procedure!)
-    ;; (rpc:publish-procedure! 'server:login server:login)
-    ;; (rpc:publish-procedure! 'testing (lambda () "Just testing"))
-
-    ;;======================================================================
-    ;;	  ;; end of publish-procedure section
-    ;;======================================================================
-    ;;
-    (on-exit (lambda ()
-	       (open-run-close tasks:server-set-state! tasks:open-db server-id "stopped")))
-
-    (set! *rpc:listener* rpc:listener)
-    (tasks:server-set-state! tdb server-id "running")
-    (set! *dbstruct-db*  (db:setup run-id))
-    ;; if none running or if > 20 seconds since 
-    ;; server last used then start shutdown
-    (let loop ((count 0))
-      (thread-sleep! 5) ;; no need to do this very often
-      (let ((numrunning -1)) ;; (db:get-count-tests-running db)))
-	(if (or (> numrunning 0)
-		(> (+ *db-last-access* 60)(current-seconds)))
-	    (begin
-	      (debug:print-info 0 *default-log-port* "Server continuing, tests running: " numrunning ", seconds since last db access: " (- (current-seconds) *db-last-access*))
-	      (loop (+ 1 count)))
-	    (begin
-	      (debug:print-info 0 *default-log-port* "Starting to shutdown the server side")
-	      (open-run-close tasks:server-delete-record tasks:open-db server-id " rpc-transport:try-start-server stop")
-	      (thread-sleep! 10)
-	      (debug:print-info 0 *default-log-port* "Max cached queries was " *max-cache-size*)
-	      (debug:print-info 0 *default-log-port* "Server shutdown complete. Exiting")
-	      ))))))
-
-(define (rpc-transport:find-free-port-and-open port)
-  (handle-exceptions
-   exn
-	  (begin
-     (print "Failed to bind to port " (rpc:default-server-port) ", trying next port")
-     (rpc-transport:find-free-port-and-open (+ port 1)))
-   (rpc:default-server-port port)
-   (tcp-read-timeout 240000)
-   (tcp-listen (rpc:default-server-port) 10000)))
-
-(define (rpc-transport:ping run-id host port)
-  (handle-exceptions
-   exn
-   (begin
-     (print "SERVER_NOT_FOUND")
-     (exit 1))
-   (let ((login-res ((rpc:procedure 'server:login host port) *toppath*)))
-     (if (and (list? login-res)
-	      (car login-res))
-	 (begin
-	   (print "LOGIN_OK")
-	   (exit 0))
-	 (begin
-	   (print "LOGIN_FAILED")
-	   (exit 1))))))
-
-(define (rpc-transport:client-setup run-id #!key (remtries 10))
-  (if *runremote*
-      (begin
-	(debug:print-error 0 *default-log-port* "Attempt to connect to server but already connected")
-	#f)
-      (let* ((host-info (hash-table-ref/default *runremote* run-id #f))) ;; (open-run-close db:get-var #f "SERVER"))
-	(if host-info
-	    (let ((iface    (car host-info))
-		  (port     (cadr host-info))
-		  (ping-res ((rpc:procedure 'server:login host port) *toppath*)))
-	      (if ping-res
-		  (let ((server-dat (list iface port #f #f #f)))
-		    (hash-table-set! *runremote* run-id server-dat)
-		    server-dat)
-		  (begin
-		    (server:try-running *toppath*)
-		    (thread-sleep! 2)
-		    (rpc-transport:client-setup run-id (- remtries 1)))))
- 	    (let* ((server-db-info (open-run-close tasks:get-server tasks:open-db run-id)))
- 	      (debug:print-info 0 *default-log-port* "client:setup server-dat=" server-dat ", remaining-tries=" remaining-tries)
-	      (if server-db-info
- 		  (let* ((iface     (tasks:hostinfo-get-interface server-db-info))
- 			 (port      (tasks:hostinfo-get-port      server-db-info))
-			 (server-dat (list iface port #f #f #f))
- 			 (ping-res  ((rpc:procedure 'server:login host port) *toppath*)))
- 		    (if start-res
- 			(begin
- 			  (hash-table-set! *runremote* run-id server-dat)
-			  server-dat)
-			(begin
-			  (server:try-running *toppath*)
-			  (thread-sleep! 2)
-			  (rpc-transport:client-setup run-id (- remtries 1)))))
-		  (begin
-		    (server:try-running *toppath*)
-		    (thread-sleep! 2)
-		    (rpc-transport:client-setup run-id (- remtries 1)))))))))
-;; 
-;; 	     (port     (if (and hostinfo (> (length hostdat) 1))(cadr hostdat) #f)))
-;; 	(if (and port
-;; 		 (string->number port))
-;; 	    (let ((portn (string->number port)))
-;; 	      (debug:print-info 2 *default-log-port* "Setting up to connect to host " host ":" port)
-;; 	      (handle-exceptions
-;; 	       exn
-;; 	       (begin
-;; 		 (debug:print-error 0 *default-log-port* "Failed to open a connection to the server at host: " host " port: " port)
-;; 		 (debug:print 0 *default-log-port* "   EXCEPTION: " ((condition-property-accessor 'exn 'message) exn))
-;; 		 ;; (open-run-close 
-;; 		 ;;  (lambda (db . param) 
-;; 		 ;;    (sqlite3:execute db "DELETE FROM metadat WHERE var='SERVER'"))
-;; 		 ;;  #f)
-;; 		 (set! *runremote* #f))
-;; 	       (if (and (not (args:get-arg "-server")) ;; no point in the server using the server using the server
-;; 			((rpc:procedure 'server:login host portn) *toppath*))
-;; 		   (begin
-;; 		     (debug:print-info 2 *default-log-port* "Logged in and connected to " host ":" port)
-;; 		     (set! *runremote* (vector host portn)))
-;; 		   (begin
-;; 		     (debug:print-info 2 *default-log-port* "Failed to login or connect to " host ":" port)
-;; 		     (set! *runremote* #f)))))
-;; 	    (debug:print-info 2 *default-log-port* "no server available")))))
-

Index: runs.scm
==================================================================
--- runs.scm
+++ runs.scm
@@ -16,11 +16,12 @@
 ;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;  strftime('%m/%d/%Y %H:%M:%S','now','localtime')
 
 (use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (srfi 18) 
-     posix-extras directory-utils pathname-expand typed-records format  sxml-serializer sxml-modifications)
+     posix-extras directory-utils pathname-expand typed-records format  sxml-serializer
+     sxml-modifications matchable)
 
 (declare (unit runs))
 (declare (uses db))
 (declare (uses common))
 (declare (uses items))
@@ -45,18 +46,129 @@
 (defstruct runs:dat
   reglen regfull
   runname max-concurrent-jobs run-id
   test-patts required-tests test-registry
   registry-mutex flags keyvals run-info all-tests-registry
-  can-run-more-tests
-  ((can-run-more-tests-count 0) : fixnum))
+  ;; stores results from last runs:can-run-more-tests 
+  (can-run-more-tests      #f) ;; (list can-run-more-flag num-running num-running-in-jobgroup max-concurrent-jobs job-group-limit)
+  ((can-run-more-tests-count 0) : fixnum)
+  (last-fuel-check         0)  ;; time when we last checked fuel
+  (beginning-of-time       (current-seconds))
+  (load-mgmt-function      #f)
+  (wait-for-jobs-function  #f)
+  (last-load-check-time    0)
+  (last-jobs-check-time    0)
+  )
 
 (defstruct runs:testdat
   hed tal reg reruns  test-record
   test-name item-path jobgroup
   waitons testmode  newtal itemmaps prereqs-not-met)
 
+(module runsmod
+    (
+     runs:wait-if-seen-recently
+     )
+  
+(import scheme chicken data-structures extras files)
+(import posix typed-records srfi-18 srfi-69
+	  md5 message-digest
+	  regex srfi-1)
+
+(define *last-seen-ht* (make-hash-table))
+
+(define (runs:wait-if-seen-recently wait-until . keys)
+  (let* ((full-key   (string-intersperse keys "-"))
+	 (last-seen  (hash-table-ref/default *last-seen-ht* full-key 0))
+	 (now        (current-seconds))
+	 (delta      (- now last-seen))
+	 (needed     (if (< delta wait-until)
+			 0
+			 (- wait-until delta))))
+    (if (> needed 0)(thread-sleep! needed))
+    (hash-table-set! *last-seen-ht* full-key (current-seconds))
+    needed))
+)
+
+(import runsmod)
+    
+;; look in the $MT_RUN_AREA_HOME/.softlocks directory for key-host-pid.softlock files
+;;  - remove any that are over 3600 seconds old
+;;  - if there are any that are younger than 10 seconds
+;;      * sleep 10 seconds
+;;      * touch my key-host-pid.softlock file
+;;      * return
+;;  - if there are no files younger than 10 seconds
+;;     * touch my key-host-pid.softlock file
+;;     * return
+;;  
+(define (runs:wait-on-softlock rdat key)
+  (if (not (and *toppath* (file-exists? *toppath*))) ;; don't seem to have toppath yet
+      (debug:print-info 0 *default-log-port* "Can't create softlocks - don't see MTRAH yet.")
+      (let* ((softlocks-dir (conc *toppath* "/.softlocks")))
+	(if (not (file-exists? softlocks-dir))
+	    (create-directory softlocks-dir #t))
+	(let* ((my-lock-file   (conc softlocks-dir "/" key "-" (get-host-name) "-" (current-process-id) ".softlock"))
+	       (lock-files     (filter (lambda (x)
+					 (not (equal? x my-lock-file)))
+				       (glob (conc softlocks-dir "/" key "*.softlock"))))
+	       (fresh-locks    (any (lambda (x) ;; do we have any locks younger than 10 seconds
+				      (let* ((mod-time (file-modification-time x))
+					     (age      (- (current-seconds) mod-time)))
+					(cond
+					 ((> age 3600) ;; too old to keep, remove it
+					  (delete-file* x) #f)
+					 ((< age 10)  #t)
+					 (else #f))))
+				    lock-files)))
+	  (if fresh-locks
+	      (begin
+		(if (runs:lownoise "runners-softlock-wait" 360)
+		    (debug:print-info 0 *default-log-port* "Other runners in flight, giving up some time..."))
+		(thread-sleep! 2))
+	      (begin
+		(if (runs:lownoise "runners-softlock-nowait" 360)
+		    (debug:print-info 0 *default-log-port* "No runners in flight, updating softlock"))
+		(let* ((ouf (open-output-file my-lock-file)))
+		  (with-output-to-port ouf
+		    (lambda ()(print (current-seconds))))
+		  (close-output-port ouf))))
+	  (runs:dat-last-fuel-check-set! rdat (current-seconds))))))
+  
+;; Fourth try, do accounting through time
+;;
+(define (runs:parallel-runners-mgmt rdat)
+  (let ((time-to-check (configf:lookup-number *configdat* "runners" "time-to-check" default: 10)) ;; 28
+	(time-to-wait  (configf:lookup-number *configdat* "runners" "time-to-wait" default: 30))
+	(now-time      (current-seconds)))
+    (if (> (- now-time (runs:dat-last-fuel-check rdat)) time-to-check) ;; time to check
+	(runs:wait-on-softlock rdat "runners"))))
+
+;; To test parallel-runners management start a repl:
+;;  megatest -repl
+;; then run:
+;;  (runs:test-parallel-runners 60)
+;;
+(define (runs:test-parallel-runners duration #!optional (proc #f))
+  (let* ((rdat   (make-runs:dat))
+	 (rtime  0)
+	 (startt (current-seconds))
+	 (endt   (+ startt duration)))
+    ((or proc runs:parallel-runners-mgmt) rdat)
+    (let loop ()
+      (let* ((wstart (current-seconds)))
+	(if (< wstart endt)
+	    (let* ((work-time (random 10)))
+	      #;(debug:print-info 0 *default-log-port* "working for " work-time
+				" seconds. Total work: " rtime ", elapsed time: " (- wstart startt))
+	      (thread-sleep! work-time)
+	      (set! rtime (+ rtime work-time))
+	      ((or proc runs:parallel-runners-mgmt) rdat)
+	      (loop)))))
+    (let* ((done-time (current-seconds)))
+      (debug:print-info 0 *default-log-port* "DONE: rtime=" rtime ", elapsed time=" (- done-time startt)
+			", ratio=" (/ rtime (- done-time startt))))))
 
 (define (runs:get-mt-env-alist run-id runname target testname itempath)
   ;;(bb-check-path msg: "runs:set-megatest-env-vars entry")
   `(("MT_TEST_NAME"     . ,testname)
     
@@ -87,15 +199,10 @@
     
     ,@(map (lambda (var)
              (let ((val (configf:lookup *configdat* "env-override" var)))
                (cons var val)))
            (configf:section-vars *configdat* "env-override"))))
-
-
-    
-
-    
     
 ;; set up needed environment variables given a run-id and optionally a target, itempath etc.
 ;;
 (define (runs:set-megatest-env-vars run-id #!key (inkeys #f)(inrunname #f)(inkeyvals #f)(intarget #f)(testname #f)(itempath #f))
   ;;(bb-check-path msg: "runs:set-megatest-env-vars entry")
@@ -139,15 +246,17 @@
 	  exn
 	  (let ((call-chain (get-call-chain))
 		(msg        ((condition-property-accessor 'exn 'message) exn)))
 	    (if (< count 5)
 		(begin ;; this call is colliding, do some crude stuff to fix it.
-		  (debug:print 0 *default-log-port* "ERROR: *configdat* was inaccessible! This should never happen. Retry #" count)
+		  (debug:print 0 *default-log-port* "ERROR: *configdat* was inaccessible! This should never happen. Retry #" count
+			       ", exn=" exn)
 		  (launch:setup force-reread: #t)
 		  (fatal-loop (+ count 1))) 
 		(begin
-		  (debug:print 0 *default-log-port* "FATAL: *configdat* was inaccessible! This should never happen. Retried " count " times. Message: " msg)
+		  (debug:print 0 *default-log-port* "FATAL: *configdat* was inaccessible! This should never happen. Retried " count
+			       " times. Message: " msg)
 		  (debug:print 0 *default-log-port* "Call chain:")
 		  (with-output-to-port *default-log-port*
 
                     (lambda ()
                       (print "*configdat* is >>"*configdat*"<<")
@@ -237,29 +346,18 @@
   ;; Take advantage of a good place to exit if running the one-pass methodology
   (if (and (> (runs:dat-can-run-more-tests-count runsdat) 20)
 	   (args:get-arg "-one-pass"))
       (exit 0))
 
-  (thread-sleep! (cond ;; BB: check with Matt.  Should this sleep move
-		       ;; to cond clauses below where we determine we
-		       ;; have too many jobs running rather than each
-		       ;; time the and condition above is true (which
-		       ;; seems like always)?
-        	  ((> (runs:dat-can-run-more-tests-count runsdat) 20) ;; original intent was - save cycles, wait a long time
-		   (if (runs:lownoise "waiting on tasks" 60)(debug:print-info 2 *default-log-port* "waiting for tasks to complete, sleeping briefly ..."))
-		   10)  ;; obviously haven't had any work to do for a while
-		  (else
-		   ;; if have a number for inter-test-delay, use it, else don't delay much, maybe even zero?
-		   (configf:lookup-number *configdat* "setup" "inter-test-delay" default: 0.01))))
-  
-  (let* ((num-running             (rmt:get-count-tests-running run-id))
+  (if (runs:dat-load-mgmt-function runsdat)((runs:dat-load-mgmt-function runsdat)))
+
+  (let* ((num-running             (rmt:get-count-tests-running run-id)) 
 	 (num-running-in-jobgroup (rmt:get-count-tests-running-in-jobgroup run-id jobgroup))
-	 (job-group-limit         (let ((jobg-count (configf:lookup *configdat* "jobgroups" jobgroup)))
-				    (if (string? jobg-count)
-					(string->number jobg-count)
-					jobg-count))))
-    (if (> (+ num-running num-running-in-jobgroup) 0)
+	 (job-group-limit         (configf:lookup-number *configdat* "jobgroups" jobgroup)))
+    (if (and (number? num-running)                   ;; checking for number - had a crash where a non-number was returned. Not sure why.
+	     (number? num-running-in-jobgroup)       ;; probably can remove this when rmt switches away from http.
+	     (> (+ num-running num-running-in-jobgroup) 0))
 	(runs:inc-can-run-more-tests-count runsdat)) ;; (set! *runs:can-run-more-tests-count* (+ *runs:can-run-more-tests-count* 1)))
     (if (not (eq? *last-num-running-tests* num-running))
 	(begin
 	  (debug:print 2 *default-log-port* "max-concurrent-jobs: " max-concurrent-jobs ", num-running: " num-running)
 	  (set! *last-num-running-tests* num-running)))
@@ -303,11 +401,11 @@
           (if (null? existing-tests)
               (let* ((use-log-dir (if (not (directory-exists? log-dir))
                                       (handle-exceptions
                                        exn
                                        (begin
-                                         (debug:print 0 *default-log-port* "WARNING: Failed to create " log-dir)
+                                         (debug:print 0 *default-log-port* "WARNING: Failed to create " log-dir ", exn=" exn)
                                          #f)
                                        (create-directory log-dir #t)
                                        #t)
                                       #t))
                      (start-time   (current-seconds))
@@ -314,17 +412,19 @@
                      (actual-logf  (if use-log-dir full-log-fname log-file)))
                 (handle-exceptions
                  exn
                  (begin
                    (print-call-chain *default-log-port*)
-                   (debug:print 0 *default-log-port* "Message: " ((condition-property-accessor 'exn 'message) exn))
+                   (debug:print 0 *default-log-port* "Message: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn)
                    (debug:print 0 *default-log-port* "ERROR: failed to run pre-hook " run-pre-hook ", check the log " log-file))
                  (debug:print-info 0 *default-log-port* "running run-pre-hook: \"" run-pre-hook "\", log is " actual-logf)
                  (system (conc run-pre-hook " >> " actual-logf " 2>&1"))
                  (debug:print-info 0 *default-log-port* "pre-hook \"" run-pre-hook "\" took " (- (current-seconds) start-time) " seconds to run.")))
               (debug:print 0 *default-log-port* "Skipping pre-hook call \"" run-pre-hook "\" as there are existing tests for this run.")))))
-    
+   
+
+
 (define (runs:run-post-hook run-id)
     (let* ((run-post-hook   (configf:lookup *configdat* "runs" "post-hook"))
            (existing-tests (if run-post-hook
                                (rmt:get-tests-for-run run-id "%" '() '() ;; run-id testpatt states statuses
                                                       #f #f ;; offset limit
@@ -343,11 +443,11 @@
           ;;    (debug:print 0 *default-log-port* "Skipping post-hook call \"" run-post-hook "\" as there are existing tests for this run.")))))
 	  (let* ((use-log-dir (if (not (directory-exists? log-dir))
 				  (handle-exceptions
 				      exn
 				      (begin
-					(debug:print 0 *default-log-port* "WARNING: Failed to create " log-dir)
+					(debug:print 0 *default-log-port* "WARNING: Failed to create " log-dir ", exn=" exn)
 					#f)
 				    (create-directory log-dir #t)
 				    #t)
 				  #t))
 		 (start-time   (current-seconds))
@@ -354,19 +454,76 @@
 		 (actual-logf  (if use-log-dir full-log-fname log-file)))
 	    (handle-exceptions
 		exn
 		(begin
 		  (print-call-chain *default-log-port*)
-		  (debug:print 0 *default-log-port* "Message: " ((condition-property-accessor 'exn 'message) exn))
+		  (debug:print 0 *default-log-port* "Message: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn)
 		  (debug:print 0 *default-log-port* "ERROR: failed to run post-hook " run-post-hook ", check the log " log-file))
 	      (debug:print-info 0 *default-log-port* "running run-post-hook: \"" run-post-hook "\", log is " actual-logf)
 	      (system (conc run-post-hook " >> " actual-logf " 2>&1"))
 	      (debug:print-info 0 *default-log-port* "post-hook \"" run-post-hook "\" took " (- (current-seconds) start-time) " seconds to run."))))))
+
+
+(define (runs:rerun-hook test-id new-test-path testdat rerunlst)
+    (let* ((rerun-hook   (configf:lookup *configdat* "runs" "rerun-hook"))
+           (log-dir         (conc *toppath* "/reruns/logs"))
+           (target (getenv "MT_TARGET"))
+           (runname (common:args-get-runname))
+           (rundir (db:test-get-rundir testdat))
+           (tarfiledir (conc *toppath* "/reruns"))
+           (status (db:test-get-status testdat))
+           (comment (conc "\"" (db:test-get-comment testdat) "\"" ))
+           (testname (db:test-get-testname testdat))
+           (itempath (db:test-get-item-path testdat))
+           (file-body (conc status "-" (string-translate target "/" "-") "-" runname "." testname (if (not (string=? itempath "")) (conc  "." (string-translate itempath "/" "-")) "")))
+           (log-file (conc file-body ".log"))
+           ;; (log-file        (conc status "-" (string-translate target "/" "-") "-" runname "." testname (if (not (string=? itempath "")) (conc  "." (string-translate itempath "/" "-")) "") ".log"))
+           (full-log-fname  (conc log-dir "/" log-file))
+           (tarfilename (conc file-body ".tar"))
+           ;; (tarfilename (conc status "." (string-translate target "/" "-") "." runname "." testname (if (not (string=? itempath "")) (conc  "." (string-translate itempath "/" "-")) "") ".tar"))
+           )
+      (if rerun-hook
+	  (let* ((use-log-dir (if (not (directory-exists? log-dir))
+				  (handle-exceptions
+				      exn
+				      (begin
+					(debug:print 0 *default-log-port* "WARNING: Failed to create " log-dir ", exn=" exn)
+					#f)
+				    (create-directory log-dir #t)
+				    #t)
+				  #t))
+		 (start-time   (current-seconds))
+		 (actual-logf  (if use-log-dir full-log-fname log-file))
+                 (sys-call-text (conc rerun-hook " " tarfilename " " rundir " " actual-logf " " runname " " tarfiledir " " status " " target " " comment " " testname " " itempath " >> " actual-logf " 2>&1"))
+                 )
+	    (debug:print 2 *default-log-port* "Found rerun-hook in config:" rerun-hook)
+	    (handle-exceptions
+		exn
+		(begin
+		  (print-call-chain *default-log-port*)
+		  (debug:print 0 *default-log-port* "Message: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn)
+		  (debug:print 0 *default-log-port* "ERROR: failed to run rerun-hook " rerun-hook ", check the log " log-file))
+	      (debug:print-info 0 *default-log-port* "running rerun-hook: \"" rerun-hook "\", log is " actual-logf)
+              ;; call the hook
+              (debug:print-info 0 *default-log-port* "Calling rerun-hook for " test-id new-test-path testdat rerunlst)
+              (debug:print-info 0 *default-log-port* "rerun hook: " rerun-hook)
+              (debug:print-info 0 *default-log-port* "tarfilename: " tarfilename)
+              (debug:print-info 0 *default-log-port* "rundir: " rundir)
+              (debug:print-info 0 *default-log-port* "actual-logf: " actual-logf)
+              (debug:print-info 0 *default-log-port* "runname: " runname)
+              (debug:print-info 0 *default-log-port* "sys-call-text: " sys-call-text)
+	      (system sys-call-text)
+	      (debug:print-info 0 *default-log-port* "rerun-hook \"" rerun-hook "\" took " (- (current-seconds) start-time) " seconds to run."))))))
+
+
+
 
 ;; return #t when all items in waitors-upon list are represented in test-patt, #f otherwise.
 (define (runs:testpatts-mention-waitors-upon? test-patt waitors-upon)
   (null? (tests:filter-test-names-not-matched waitors-upon test-patt)))
+
+(define *find-and-mark-incomplete-last-run* (make-hash-table))
 
 ;;======================================================================
 ;; runs:run-tests is called from megatest.scm and itself
 ;;======================================================================
 ;;
@@ -392,11 +549,13 @@
 	 (task-key           (conc (hash-table->alist flags) " " (get-host-name) " " (current-process-id)))
 	 ;; (tdbdat             (tasks:open-db))
 	 (config-reruns      (let ((x (configf:lookup *configdat* "setup" "reruns")))
 			       (if x (string->number x) #f)))
 	 (allowed-tests      #f)
-	 (runconf            #f))
+	 (runconf            #f)
+	 (cache-files        (launch:get-cache-file-paths #f (common:get-toppath *toppath* ) target))
+	 (runstart-time      (current-seconds)))
 
     ;; check if readonly
     (when readonly-mode
       (debug:print-error 0 *default-log-port* "megatest.db is readonly.  Cannot proceed.")
       (exit 1))
@@ -460,11 +619,11 @@
 
     ;; register this run in monitor.db
     (rmt:tasks-add "run-tests" user target runname test-patts task-key) ;; params)
     (rmt:tasks-set-state-given-param-key task-key "running")
 
-    (common:telemetry-log "run-tests"
+    #;(common:telemetry-log "run-tests"
                           payload:
                           `( (target . ,target)
                              (run-name . ,runname)
                              (test-patts . ,test-patts) ) )
 
@@ -530,21 +689,21 @@
     (runs:update-all-test_meta #f)
 
     ;; run the run prehook if there are no tests yet run for this run:
     ;;
     (runs:run-pre-hook run-id)
-    ;; mark all test launced flag as false in the meta table 
+    ;; mark all test launched flag as false in the meta table 
     (rmt:set-var (conc "lunch-complete-" run-id) "no")
     (debug:print-info 1 *default-log-port* "Setting end-of-run to no")
     (let* ((config-reruns      (let ((x (configf:lookup *configdat* "setup" "reruns")))
-			       (if x (string->number x) #f)))
-	  (config-rerun-cnt (if config-reruns
-			config-reruns
-			1)))
-    (if (eq? config-rerun-cnt run-count)
-      (rmt:set-var (conc "end-of-run-" run-id) "no")))
-
+				 (if x (string->number x) #f)))
+	   (config-rerun-cnt (if config-reruns
+				 config-reruns
+				 1)))
+      (if (eq? config-rerun-cnt run-count)
+	  (rmt:set-var (conc "end-of-run-" run-id) "no")))
+    
     (rmt:set-run-state-status run-id "new" "n/a")
     ;; now add non-directly referenced dependencies (i.e. waiton)
     ;;======================================================================
     ;; refactoring this block into tests:get-full-data
     ;;
@@ -658,48 +817,46 @@
     (debug:print-info 4 *default-log-port* "test-records=" (hash-table->alist test-records))
     (let ((reglen (configf:lookup *configdat* "setup" "runqueue")))
       (if (> (length (hash-table-keys test-records)) 0)
 	  (let* ((keep-going        #t)
 		 (run-queue-retries 5)
-		 #;(th1        (make-thread (lambda ()
-					    (handle-exceptions
-						exn
-						(begin
-						  (print-call-chain)
-						  (print " message: " ((condition-property-accessor 'exn 'message) exn)))
-					      (runs:run-tests-queue run-id runname test-records keyvals flags test-patts required-tests
-								    (any->number reglen) all-tests-registry)))
-					  "runs:run-tests-queue"))
 		 (th2        (make-thread (lambda ()			 ;; BBQ: why are we visiting ALL runs here?	    
 					    ;; (rmt:find-and-mark-incomplete-all-runs))))) CAN'T INTERRUPT IT ...
 					    (let ((run-ids (rmt:get-all-run-ids)))
 					      (for-each (lambda (run-id)
 							  (if keep-going
 							      (handle-exceptions
-							       exn
-							       (debug:print 0 *default-log-port* "error in calling find-and-mark-incomplete for run-id " run-id)
-							       (rmt:find-and-mark-incomplete run-id #f)))) ;; ovr-deadtime))) ;; could be root of https://hsdes.intel.com/appstore/article/#/220546828/main -- Title: Megatest jobs show DEAD even though they are still running (1.64/27)
+								  exn
+								  (debug:print 0 *default-log-port* "error in calling find-and-mark-incomplete for run-id " run-id ", exn=" exn)
+								;; lets run this only if a run has been NOT seen for more than 900 seconds
+								(if (> (- (current-seconds)(hash-table-ref/default *find-and-mark-incomplete-last-run* run-id 0)) 900)
+								    (begin
+								      (rmt:find-and-mark-incomplete run-id #f)
+								      (hash-table-set! *find-and-mark-incomplete-last-run* run-id (current-seconds)))
+								    )))) ;; ovr-deadtime))) ;; could be root of https://hsdes.intel.com/appstore/article/#/220546828/main -- Title: Megatest jobs show DEAD even though they are still running (1.64/27)
 							run-ids)))
 					  "runs: mark-incompletes")))
-	    ;; (thread-start! th1)
 	    (thread-start! th2)
-	    ;; (thread-join! th1)
-	    ;; just do the main stuff in the main thread
 	    (runs:run-tests-queue run-id runname test-records keyvals flags test-patts required-tests
 								    (any->number reglen) all-tests-registry)
 	    (set! keep-going #f)
 	    (thread-join! th2)
+	    (if (launch:cache-files-changed? cache-files runstart-time)
+		(begin ;; force a start-over
+		  (launch:setup force-reread: #t)
+		  (runs:run-tests target runname test-patts user flags run-count: 0)))
+	    
 	    ;; if run-count > 0 call, set -preclean and -rerun STUCK/DEAD
 	    (if (> run-count 0) ;; handle reruns
 		(begin
 		  (if (not (hash-table-ref/default flags "-preclean" #f))
 		      (hash-table-set! flags "-preclean" #t))
 		  (if (not (hash-table-ref/default flags "-rerun" #f))
-		      (hash-table-set! flags "-rerun" "STUCK/DEAD,n/a,ZERO_ITEMS"))
+		      (hash-table-set! flags "-rerun" "ABORT,STUCK/DEAD,n/a,ZERO_ITEMS"))
 		  ;; recursive call to self
-      (runs:run-tests target runname test-patts user flags run-count: (- run-count 1)))
-                  (launch:end-of-run-check run-id)))
+		  (runs:run-tests target runname test-patts user flags run-count: (- run-count 1)))
+                (launch:end-of-run-check run-id)))
 	  (debug:print-info 0 *default-log-port* "No tests to run")))
     (debug:print-info 4 *default-log-port* "All done by here")
     ;; TODO: try putting post hook call here
       
     ;  (debug:print-info 2 *default-log-port* " run-count " run-count)
@@ -912,13 +1069,17 @@
 	   (null? non-completed))
      (debug:print-info 4 *default-log-port* "cond branch - "  "ei-4")
       (if  (runs:can-keep-running? hed 20)
 	  (begin
 	    (runs:inc-cant-run-tests hed)
-	    (debug:print-info 0 *default-log-port* "no fails in prerequisites for " hed " but also none running, keeping " hed " for now. Try count: " (hash-table-ref/default *seen-cant-run-tests* hed 0)) ;; 
+	    (debug:print-info 0 *default-log-port* "no fails in prerequisites for " hed " but also none running, keeping " hed " for now. Try count: " (hash-table-ref/default *seen-cant-run-tests* hed 0) ", going to wait 60 sec.") ;; 
 	    ;; getting here likely means the system is way overloaded, kill a full minute before continuing
-	    (thread-sleep! 60) ;; TODO: gate by normalized server load > 1.0 (maxload config thing)
+	    ;; (thread-sleep! 60) ;; TODO: gate by normalized server load > 1.0 (maxload config thing) CHECKTHIS!!!
+	    ;; No runsdat, can't do this yet
+	    ;; (if (runs:dat-load-mgmt-function runsdat)((runs:dat-load-mgmt-function runsdat)))
+	    ;;
+	    (thread-sleep! 5) ;; TODO: gate by normalized server load > 1.0 (maxload config thing)
 	    ;; num-retries code was here
 	    ;; we use this opportunity to move contents of reg to tal
 	    (list (car newtal)(append (cdr newtal) reg) '() reruns)) ;; an issue with prereqs not yet met?
 	  (begin
 	    (debug:print-info 1 *default-log-port* "no fails in prerequisites for " hed " but nothing seen running in a while, dropping test " hed " from the run queue")
@@ -1044,11 +1205,29 @@
 				  (conc " WARNING: t is not a vector=" t )))
 			    prereqs-not-met)
 		       ", ") ") fails: " fails
 		       "\nregistered? " (hash-table-ref/default test-registry (db:test-make-full-name test-name item-path) #f))
 			    
-
+    ;; well, first lets see if cpu load throttling is enabled. If so wait around until the
+    ;; average cpu load is under the threshold before continuing
+    ;;
+    (if (runs:dat-load-mgmt-function runsdat)
+	((runs:dat-load-mgmt-function runsdat))
+	(runs:dat-load-mgmt-function-set!
+	 runsdat
+	 (lambda ()
+	   ;; jobtools maxload is useful for where the full Megatest run is done on one machine
+	   (if (and (not (common:on-homehost?))
+		    maxload) ;; only gate if maxload is specified, NOTE: maxload is normalized, i.e. load=1 means all cpus fully utilized
+	       (common:wait-for-normalized-load maxload "Waiting for load to drop before starting more tests" #f))
+	   
+	   ;; jobtools maxhomehostload is intended to prevent overloading on the homehost which can cause database corruption issues
+	   (if maxhomehostload
+	       (common:wait-for-homehost-load maxhomehostload
+					      (conc "Waiting for homehost load to drop below normalized value of " maxhomehostload))))))
+    
+ 
     
     (if (and (not (null? prereqs-not-met))
 	     (runs:lownoise (conc "waiting on tests " prereqs-not-met hed) 60))
 	(debug:print-info 2 *default-log-port* "waiting on tests; " (string-intersperse (runs:mixed-list-testname-and-testrec->list-of-strings prereqs-not-met) ", ")))
 
@@ -1117,11 +1296,11 @@
      ((not have-resources) ;; simply try again after waiting a second
       (if (runs:lownoise "no resources" 60)
 	  (debug:print-info 1 *default-log-port* "no resources to run new tests, waiting ..."))
       ;; Have gone back and forth on this but db starvation is an issue.
       ;; wait one second before looking again to run jobs.
-      (thread-sleep! 1)
+      (thread-sleep! 1) ;; changed back to 1 from 0.25
       ;; could have done hed tal here but doing car/cdr of newtal to rotate tests
       (list (car newtal)(cdr newtal) reg reruns))
      
      ;; This is the final stage, everything is in place so launch the test
      ;;
@@ -1133,28 +1312,17 @@
       ;; (hash-table-delete! *max-tries-hash* (db:test-make-full-name test-name item-path))
       ;; we are going to reset all the counters for test retries by setting a new hash table
       ;; this means they will increment only when nothing can be run
       (set! *max-tries-hash* (make-hash-table))
       
-      ;; well, first lets see if cpu load throttling is enabled. If so wait around until the
-      ;; average cpu load is under the threshold before continuing
-
-      ;; jobtools maxload is useful for where the full Megatest run is done on one machine
-      (if maxload ;; only gate if maxload is specified, NOTE: maxload is normalized, i.e. load=1 means all cpus fully utilized
-          (common:wait-for-normalized-load maxload "Waiting for load to drop before starting more tests" #f))
-
-      ;; jobtools maxhomehostload is intended to prevent overloading on the homehost which can cause database corruption issues
-      (if maxhomehostload
-          (common:wait-for-homehost-load maxhomehostload (conc "Waiting for homehost load to drop below normalized value of " maxhomehostload)))
-      
-      (run:test run-id run-info keyvals runname test-record flags #f test-registry all-tests-registry)
+      (run:test run-id run-info keyvals runname test-record flags #f test-registry all-tests-registry runsdat testdat)
       (runs:incremental-print-results run-id)
       (hash-table-set! test-registry (db:test-make-full-name test-name item-path) 'running)
       (runs:shrink-can-run-more-tests-count runsdat)  ;; DELAY TWEAKER (still needed?)
       ;; (thread-sleep! *global-delta*)
       (if (or (not (null? tal))(not (null? reg)))
-	  (runs:loop-values tal reg reglen regfull reruns)
+	  (runs:loop-values tal reg reglen regfull reruns) ;; hed should be dropped at this time
 	  #f))
      
      ;; must be we have unmet prerequisites
      ;;
      (else
@@ -1171,19 +1339,18 @@
 	      (member 'toplevel testmode))
 	  (begin
 	    ;; couldn't run, take a breather
 	    (if  (runs:lownoise "Waiting for more work to do..." 60)
 		 (debug:print-info 0 *default-log-port* "Waiting for more work to do..."))
-	    (thread-sleep! 1)
+	    
+	    ;; (if (runs:dat-load-mgmt-function runsdat)((runs:dat-load-mgmt-function runsdat)))
+	    (thread-sleep! 5)
 	    (list (car newtal)(cdr newtal) reg reruns))
 	  ;; the waiton is FAIL so no point in trying to run hed ever again
 	  (begin
             (let ((my-test-id (rmt:get-test-id run-id test-name item-path)))
-              (mt:test-set-state-status-by-id-unless-completed run-id my-test-id "COMPLETED" "PREQ_FAIL" "Failed to run due to failed prerequisites2"))
-
-
-            
+              (mt:test-set-state-status-by-id-unless-completed run-id my-test-id "COMPLETED" "PREQ_FAIL" "Failed to run due to failed prerequisites2"))            
             (if (or (not (null? reg))(not (null? tal)))
                 (if (vector? hed)
 		  (begin
 		    (debug:print 1 *default-log-port* "WARNING: Dropping test " test-name "/" item-path
 				 " from the launch list as it has prerequistes that are FAIL")
@@ -1288,12 +1455,13 @@
    target: #f
    )
   )
 
 (define (runs:incremental-print-results run-id)
-  (let ((curr-sec (current-seconds)))
-    (if (> (- curr-sec (runs:gendat-inc-results-last-update *runs:general-data*)) 5) ;; at least five seconds since last update
+  (let ((curr-sec    (current-seconds))
+	(last-update (runs:gendat-inc-results-last-update *runs:general-data*)))
+    (if (> (- curr-sec last-update) 5) ;; at least five seconds since last update
 	(let* ((run-dat  (or (runs:gendat-run-info *runs:general-data*)(rmt:get-run-info run-id)))
 	       (runname  (or (runs:gendat-runname *runs:general-data*)
 			     (db:get-value-by-header (db:get-rows run-dat)
 						     (db:get-header run-dat) "runname")))
 	       (target   (or (runs:gendat-target *runs:general-data*)(rmt:get-target run-id)))
@@ -1302,19 +1470,20 @@
 				     #f #f ;; offset limit
 				     #f ;; not-in
 				     #f ;; sort-by
 				     #f ;; sort-order
 				     #f ;; get full data (not 'shortlist)
-				     (runs:gendat-inc-results-last-update *runs:general-data*) ;; last update time
+				     last-update
 				     'dashboard)))
 			   (if (list? res)
 			       res
 			       (begin
 				 (debug:print-error
 				  0 *default-log-port*
 				  "FAILED TO GET DATA using rmt:get-tests-for-run. Notify developers if you see this. result: " res)
 				 '())))))
+	  (runs:gendat-inc-results-last-update-set! *runs:general-data* (- curr-sec 1))
 	  (if (not (runs:gendat-run-info *runs:general-data*))
 	      (runs:gendat-run-info-set! *runs:general-data* run-dat))
 	  (if (not (runs:gendat-runname  *runs:general-data*))
 	      (runs:gendat-runname-set! *runs:general-data* runname))
 	  (if (not (runs:gendat-target *runs:general-data*))
@@ -1346,17 +1515,24 @@
 			     dtime
 			     (seconds->hr-min-sec duration)
 			     (conc "lt/" target "/" runname "/" test-name (if (string-null? item-path) "" (conc "/" item-path))))
 		     (hash-table-set! (runs:gendat-inc-results *runs:general-data*) (conc run-id "," test-id) testdat)))))
 	   testsdat)))
-    (runs:gendat-inc-results-last-update-set! *runs:general-data* (- curr-sec 10))))
+
+    ;; I don't think this should be here? -- Matt
+    #;(runs:gendat-inc-results-last-update-set! *runs:general-data* (- curr-sec 10))
+
+    ))
 
 ;; every time though the loop increment the test/itempatt val.
 ;; when the min is > max-allowed and none running then force exit
 ;;
 (define *max-tries-hash* (make-hash-table))
 
+(define (runs:pretty-long-list lst)
+   (if (> (length lst) 8)(append (take lst 3)(list "...")) lst))
+
 ;;======================================================================
 ;; runs:run-tests-queue is called by runs:run-tests
 ;;======================================================================
 ;;
 ;; test-records is a hash table testname:item_path => vector < testname testconfig waitons priority items-info ... >
@@ -1379,10 +1555,11 @@
          (max-concurrent-jobs   (configf:lookup-number *configdat* "setup" "max_concurrent_jobs" default: 50))
          (reglen                (if (number? reglen-in) reglen-in 1))
          (last-time-incomplete  (- (current-seconds) 900)) ;; force at least one clean up cycle
          (last-time-some-running (current-seconds))
          ;; (tdbdat                (tasks:open-db))
+	 (misc-data             (make-hash-table)) ;; use as needed
          (runsdat (make-runs:dat
                    ;; hed: hed
                    ;; tal: tal
                    ;; reg: reg
                    ;; reruns: reruns
@@ -1439,10 +1616,16 @@
           (begin
             (set! last-time-incomplete (current-seconds))
             ;; (rmt:find-and-mark-incomplete-all-runs)
 	    ))
 
+      ;; WAIT FOR TIME ON TIGHT LOOP
+      (if (< (- (current-milliseconds)(hash-table-ref/default misc-data "tight-loop-last-time" 0))
+	     100) ;; less than 1/100 second since came through the loop
+	  (thread-sleep! 0.1)) ;; wait a 1/100 seconds
+      (hash-table-set! misc-data "tight-loop-last-time" (current-milliseconds))
+      
       ;; (print "Top of loop, hed=" hed ", tal=" tal " ,reruns=" reruns)
       (let* ((test-record (hash-table-ref test-records hed))
 	     (test-name   (tests:testqueue-get-testname test-record))
 	     (tconfig     (tests:testqueue-get-testconfig test-record))
 	     (jobgroup    (configf:lookup tconfig "test_meta" "jobgroup"))
@@ -1492,19 +1675,10 @@
 			   itemmaps:    itemmaps
 			   ;; prereqs-not-met: prereqs-not-met
 			   )))
 	(runs:dat-regfull-set! runsdat regfull)
     
-        ;; -- removed BB 17ww28 - no longer needed.
-	;; every 15 minutes verify the server is there for this run
-	;; (if (and (common:low-noise-print 240 "try start server"  run-id)
-	;; 	 (not (or (and *runremote*
-	;; 		       (remote-server-url *runremote*)
-	;; 		       (server:ping (remote-server-url *runremote*)))
-	;; 		  (server:check-if-running *toppath*))))
-	;;     (server:kind-run *toppath*))
-	
 	(if (> num-running 0)
             (set! last-time-some-running (current-seconds)))
 
         (if (> (current-seconds)(+ last-time-some-running (or (configf:lookup *configdat* "setup" "give-up-waiting") 36000)))
             (hash-table-set! *max-tries-hash* tfullname (+ (hash-table-ref/default *max-tries-hash* tfullname 0) 1)))
@@ -1533,11 +1707,11 @@
 
 	(runs:incremental-print-results run-id)
 	(debug:print 4 *default-log-port* "TOP OF LOOP => "
 		     "test-name: " test-name
 		     "\n  hed:         " hed
-		     "\n  tal:         " tal
+		     "\n  tal:         " (runs:pretty-long-list tal)
 		     "\n  reg:         " reg
                      "\n  test-record  " test-record
                      "\n  itemdat:     " itemdat
 		     "\n  items:       " items
 		     "\n  item-path:   " item-path
@@ -1546,10 +1720,12 @@
                      "\n  reruns:      " reruns
 		     "\n  regfull:     " regfull
 		     "\n  reglen:      " reglen
 		     "\n  length reg:  " (length reg)
                      )
+
+	;; (runs:parallel-runners-mgmt runsdat)
 
 	;; check for hed in waitons => this would be circular, remove it and issue an
 	;; error
 	(if (member test-name waitons)
 	    (begin
@@ -1581,13 +1757,69 @@
           (debug:print-info 4 *default-log-port* "cond branch - "  "rtq-2")
 	  (debug:print-info 4 *default-log-port* "OUTER COND: (not items)")
 	  (if (and (not (tests:match test-patts (tests:testqueue-get-testname test-record) item-path required: required-tests))
 		   (not (null? tal)))
 	      (loop (car tal)(cdr tal) reg reruns))
+
+	  ;; gonna try a strategy change here.
+	  ;;
+	  ;; check if can run more tests. if yes, continue, if no, rest until can run more
+	  ;; look at the test jobgroup and tot jobs running
+	  ;;
+	  ;; NOTE: This does NOT actually gate here, only captures the proc to be called later
+	  ;; 
+	  (if (not (runs:dat-wait-for-jobs-function runsdat))
+	      (runs:dat-wait-for-jobs-function-set!
+	       runsdat 
+	       (lambda (testdat-in)
+		 (let* ((jobgroup              (runs:testdat-jobgroup testdat-in))
+			(can-run-more-tests    (runs:dat-can-run-more-tests runsdat))
+			(last-jobs-check-time  (runs:dat-last-jobs-check-time runsdat))
+			(should-check-jobs     (match can-run-more-tests
+						 ((can-run-more-flag num-running nr-in-jobgroup max-concurrent-jobs . params)
+						  (if (< (- max-concurrent-jobs num-running) 25)
+						      (begin
+							(debug:print-info 0 *default-log-port*
+									  "less than 20 jobs headroom, ("max-concurrent-jobs
+									  "-"num-running")>20. Forcing prelaunch check.")
+							#t)
+						      #f))
+						 (else #f)))) ;; no record yet
+		   (if should-check-jobs
+		       (let loop-can-run-more
+			   ((res      (runs:can-run-more-tests runsdat run-id jobgroup max-concurrent-jobs))
+			    (remtries 1440)) ;; we can wait for up to two hours for jobs to get done
+			 (match res
+			   ((run-more num-running . rem)
+			    (if (or run-more
+				    (< remtries 1))
+				(begin
+				  (if (runs:lownoise "num-running" 30)
+				      (debug:print-info 0 *default-log-port* "Have "num-running" tests of max " max-concurrent-jobs))
+				  (runs:dat-can-run-more-tests-set! runsdat res)) ;; capture the result and then drop through
+				(begin
+				  (if (runs:lownoise "num-running" 10)
+				      (debug:print-info 0 *default-log-port* "Can't run more tests, have "num-running" tests of "
+							max-concurrent-jobs " allowed."))
+				  (thread-sleep! 5) ;; if we've hit max concurrent jobs take a breather, nb// make this configurable
+				  
+				  ;; wait for load here
+				  (if (runs:dat-load-mgmt-function runsdat)((runs:dat-load-mgmt-function runsdat)))
+				  (loop-can-run-more (runs:can-run-more-tests runsdat run-id jobgroup max-concurrent-jobs)
+						     (- remtries 1)))))))
+		       )))))
+
+	  ;; I'm not clear on why prereqs are gathered here TODO: verfiy this is needed
+	  (let ((waited (runs:wait-if-seen-recently 5 "prereqs-not-met" hed item-path))) ;; if we've been down this path in the past 5 seconds - wait out the difference
+	    (if (> waited 0)(debug:print 0 *default-log-port* "Waited for prereqs-not-met-"hed"-"item-path" for " waited "seconds.")))
+	  
 	  (runs:testdat-prereqs-not-met-set! testdat (rmt:get-prereqs-not-met run-id waitons hed item-path mode: testmode itemmaps: itemmaps))
-	  (runs:dat-can-run-more-tests-set! runsdat (runs:can-run-more-tests runsdat run-id jobgroup max-concurrent-jobs)) ;; look at the test jobgroup and tot jobs running
-	  (let ((loop-list (runs:process-expanded-tests runsdat testdat)))
+
+	  ;; I'm not clear on why we'd capture running job counts here TODO: verify this is needed
+	  (runs:dat-can-run-more-tests-set! runsdat (runs:can-run-more-tests runsdat run-id jobgroup max-concurrent-jobs))
+
+	  (let ((loop-list (runs:process-expanded-tests runsdat testdat))) ;; in process-expanded-tests ultimately run:test -> launch-test -> test actually running
             (if loop-list (apply loop loop-list))))
 
 	 ;; items processed into a list but not came in as a list been processed
 	 ;;
 	 ((and (list? items)     ;; thus we know our items are already calculated
@@ -1646,13 +1878,13 @@
 	 ;; if items is a proc then need to run items:get-items-from-config, get the list and loop 
 	 ;;    - but only do that if resources exist to kick off the job
 	 ;; EXPAND ITEMS
 	 ((or (procedure? items)(eq? items 'have-procedure))
           (debug:print-info 4 *default-log-port* "cond branch - "  "rtq-4")
-	  (let ((can-run-more    (runs:can-run-more-tests runsdat run-id jobgroup max-concurrent-jobs)))
-	    (if (and (list? can-run-more)
-		     (car can-run-more))
+	  (let ((can-run-more    #f)) ;; (runs:can-run-more-tests runsdat run-id jobgroup max-concurrent-jobs)))
+	    (if (not can-run-more) #;(and (list? can-run-more)
+		(car can-run-more))
 		(let ((loop-list (runs:expand-items hed tal reg reruns regfull newtal jobgroup max-concurrent-jobs run-id waitons item-path testmode test-record can-run-more items runname tconfig reglen test-registry test-records itemmaps))) ;; itemized test expanded here
 		  (if loop-list
 		      (apply loop loop-list)
                       (debug:print-info 4 *default-log-port* " -- Can't expand hed="hed)
                       )
@@ -1691,30 +1923,37 @@
     ;; this is the point where everything is launched and now you can mark the run in metadata table as all launched 
     (rmt:set-var (conc "lunch-complete-" run-id) "yes")  
         
     ;; now *if* -run-wait we wait for all tests to be done
     ;; Now wait for any RUNNING tests to complete (if in run-wait mode)
+    ;; (if (runs:dat-load-mgmt-function runsdat)((runs:dat-load-mgmt-function runsdat)))
     (thread-sleep! 10) ;; I think there is a race condition here. Let states/statuses settle
+    
     (let wait-loop ((num-running      (rmt:get-count-tests-running-for-run-id run-id))
 		    (prev-num-running 0))
       ;; (debug:print-info 13 *default-log-port* "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 *default-log-port* "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 *default-log-port* "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))
-		  (rmt:find-and-mark-incomplete run-id #f)))
-	    (if (not (eq? num-running prev-num-running))
-		(debug:print-info 0 *default-log-port* "run-wait specified, waiting on " num-running " tests in RUNNING, REMOTEHOSTSTART or LAUNCHED state at " (time->string (seconds->local-time (current-seconds)))))
-	    (thread-sleep! 5)
-	    ;; (wait-loop (rmt:get-count-tests-running-for-run-id run-id) num-running))))
-	    (wait-loop (rmt:get-count-tests-running-for-run-id run-id) num-running))))
+	    (if (> (- (current-seconds)(hash-table-ref/default *find-and-mark-incomplete-last-run* run-id 0)) 900)
+		;; (begin(if (> (current-seconds)(+ last-time-incomplete 900))
+		(let ((actual-num-running num-running)) ;; (rmt:get-count-tests-running-for-run-id run-id))) ;; why call it again?
+		  (debug:print-info 0 *default-log-port* "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)) ;; FIXME, this might be causing slow down - use of set!
+		  (rmt:find-and-mark-incomplete run-id #f)
+		  (hash-table-set! *find-and-mark-incomplete-last-run* run-id (current-seconds))
+		  (debug:print-info 0 *default-log-port* "run-wait specified, waiting on " actual-num-running
+				    " tests in RUNNING, REMOTEHOSTSTART or LAUNCHED state at "
+				    (time->string (seconds->local-time (current-seconds))))))
+	    ;; (if (runs:dat-load-mgmt-function runsdat)((runs:dat-load-mgmt-function runsdat)))
+	    (thread-sleep! 5) ;; (if (>= num-running max-concurrent-jobs) 5 1))
+	    (wait-loop (rmt:get-count-tests-running-for-run-id run-id)
+		       num-running))))
     ;; LET* ((test-record
     ;; we get here on "drop through". All done!
     ;; this is moved to runs:run-testes since this function is getting called twice to ensure everthing is completed. 
     ;; (debug:print-info 0 *default-log-port* "Calling Post Hook")    
     ;; (runs:run-post-hook run-id)
@@ -1767,11 +2006,11 @@
 	     (conc (db:test-get-testname t) ":" (db:test-get-state t) "/" (db:test-get-status t))))
        lst))
 
 ;; parent-test is there as a placeholder for when parent-tests can be run as a setup step
 ;;
-(define (run:test run-id run-info keyvals runname test-record flags parent-test test-registry all-tests-registry)
+(define (run:test run-id run-info keyvals runname test-record flags parent-test test-registry all-tests-registry runsdat testdat-rec)
   ;; All these vars might be referenced by the testconfig file reader
   ;; 
   ;; NEED to reprocess testconfig here, ensuring that item variables are available.
   ;; This is for Tal's issue with item-specific env vars not being set for use in skip.
   ;; HSD https://hsdes.intel.com/appstore/icf/index.html#/article?articleId=1408763273
@@ -1845,12 +2084,13 @@
 		  (set! test-id (rmt:get-test-id run-id test-name item-path))))
 	    (debug:print-info 4 *default-log-port* "test-id=" test-id ", run-id=" run-id ", test-name=" test-name ", item-path=\"" item-path "\"")
 	    (set! testdat (rmt:get-test-info-by-id run-id test-id))
 	    (if (not testdat)
 		(begin
-		  (debug:print-info 0 *default-log-port* "WARNING: server is overloaded, trying again in one second")
-		  (thread-sleep! 1)
+		  (debug:print-info 0 *default-log-port* "WARNING: server is overloaded, trying again in two seconds")
+		  ;; (if (runs:dat-load-mgmt-function runsdat)((runs:dat-load-mgmt-function runsdat)))
+		  (thread-sleep! 2)
 		  (loop)))))
       (if (not testdat) ;; should NOT happen
 	  (debug:print-error 0 *default-log-port* "failed to get test record for test-id " test-id))
       (set! test-id (db:test-get-id testdat))
       (if (common:file-exists? test-path)
@@ -1879,25 +2119,34 @@
 		  (or (member (test:get-status testdat) '("PASS" "WARN" "CHECK" "SKIP" "WAIVED"))
 		      (member (test:get-state  testdat) '("COMPLETED")))) 
 	     (debug:print-info 2 *default-log-port* "running test " test-name "/" item-path " suppressed as it is " (test:get-state testdat) " and " (test:get-status testdat))
 	     (hash-table-set! test-registry full-test-name 'DONOTRUN) ;; COMPLETED)
 	     (set! runflag #f))
+
 	    ;; -rerun and status is one of the specifed, run it
 	    ((and rerun
 		  (let* ((rerunlst   (string-split rerun ","))
 			 (must-rerun (member (test:get-status testdat) rerunlst)))
 		    (debug:print-info 3 *default-log-port* "-rerun list: " rerun ", test-status: " (test:get-status testdat)", must-rerun: " must-rerun)
 		    must-rerun))
 	     (debug:print-info 2 *default-log-port* "Rerun forced for test " test-name "/" item-path)
-	     (set! runflag #t))
-	    ;; -keepgoing, do not rerun FAIL
+	     (set! runflag #t)
+             (debug:print-info 2 *default-log-port* "Calling rerun hook")
+             (runs:rerun-hook test-id new-test-path testdat rerun)
+             )
+             
+
+	    
+            ;; -keepgoing, do not rerun FAIL
 	    ((and keepgoing
 		  (member (test:get-status testdat) '("FAIL")))
 	     (set! runflag #f))
-	    ((and (not rerun)
+	    
+            ((and (not rerun)
 		  (member (test:get-status testdat) '("FAIL" "n/a")))
 	     (set! runflag #t))
+
 	    (else (set! runflag #f)))
 	   (debug:print 4 *default-log-port* "RUNNING => runflag: " runflag " STATE: " (test:get-state testdat) " STATUS: " (test:get-status testdat))
 	   (if (not runflag)
 	       (if (not parent-test)
 		   (if (runs:lownoise (conc "not starting test" full-test-name) 60)
@@ -1957,15 +2206,23 @@
 		       (mt:test-set-state-status-by-id run-id test-id "COMPLETED" "SKIP" skip-test)
 		       (debug:print-info 1 *default-log-port* "SKIPPING Test " full-test-name " due to " skip-test))
 		     ;;
 		     ;; Here the test is handed off to launch.scm for launch-test to complete the launch process
 		     ;;
-		     (if (not (launch-test test-id run-id run-info keyvals runname test-conf test-name test-path itemdat flags))
-			 (begin
-			   (print "ERROR: Failed to launch the test. Exiting as soon as possible")
-			   (set! *globalexitstatus* 1) ;; 
-			   (process-signal (current-process-id) signal/kill))))))))
+		     (begin
+		       ;; wait for less than max jobs here
+		       (if (runs:dat-wait-for-jobs-function runsdat)
+			   ((runs:dat-wait-for-jobs-function runsdat) testdat-rec))
+		       
+		       (if (not (launch-test test-id run-id run-info keyvals runname test-conf test-name test-path itemdat flags))
+			   (begin
+			     (print "ERROR: Failed to launch the test. Exiting as soon as possible")
+			     (set! *globalexitstatus* 1) ;; 
+			     (process-signal (current-process-id) signal/kill))
+			   )
+		       ;; wait again here?
+		       ))))))
 	((KILLED) 
 	 (debug:print 1 *default-log-port* "NOTE: " full-test-name " is already running or was explictly killed, use -force to launch it.")
 	 (hash-table-set! test-registry (db:test-make-full-name test-name test-path) 'DONOTRUN)) ;; KILLED))
 	((LAUNCHED REMOTEHOSTSTART RUNNING)  
 	 (debug:print 2 *default-log-port* "NOTE: " test-name " is already running"))
@@ -2034,11 +2291,11 @@
   (let* ((targets (string-split target-patts ","))
 	 (keys    (rmt:get-keys))
 	 (res-ht  (make-hash-table))) ;; target -> ( runrecord1 runrecord2 ... )
     (for-each
      (lambda (target-patt)
-       (let ((runs     (rmt:simple-get-runs runpatt #f #f target-patt)))
+       (let ((runs     (rmt:simple-get-runs runpatt #f #f target-patt #f)))
 	 (for-each
 	  (lambda (run)
 	    (let ((target (simple-run-target run)))
 	      (hash-table-set! res-ht target (cons run (hash-table-ref/default res-ht target '())))))
 	  runs)))
@@ -2051,52 +2308,76 @@
 ;; 
 (define (runs:remove-all-but-last-n-runs-per-target target-patts runpatt num-to-keep #!key (actions '(print)))
   (let* ((runs-ht  (runs:get-hash-by-target target-patts runpatt))
 	 (age      (if (args:get-arg "-age")(common:hms-string->seconds (args:get-arg "-age")) #f))
 	 (age-mark (if age (- (current-seconds) age) (+ (current-seconds) 86400)))
-	 (precmd   (or (args:get-arg "-precmd") "")))
-    (print "Actions: " actions)
-    (for-each
-     (lambda (target)
-       (let* ((runs      (hash-table-ref runs-ht target))
-	      (sorted    (sort runs (lambda (a b)(< (simple-run-event_time a)(simple-run-event_time b)))))
-	      (to-remove (let* ((len      (length sorted))
-                                (trim-amt (- len num-to-keep)))
-                           (if (> trim-amt 0)
-                               (take sorted trim-amt)
-                               '()))))
-	 (hash-table-set! runs-ht target to-remove)
-         (print target ":")
-         (for-each
-          (lambda (run)
-            (let ((remove (member run to-remove (lambda (a b)
-                                                  (eq? (simple-run-id a)
-                                                       (simple-run-id b))))))
-	      (if (and age (> (simple-run-event_time run) age-mark))
-		  (print "Skipping handling of " target "/" (simple-run-runname run) " as it is younger than " (args:get-arg "-age"))
-		  (for-each
-		   (lambda (action)
+	 (precmd   (or (args:get-arg "-precmd") ""))
+         (action-chk (member (string->symbol "remove-runs") actions)))
+     ;; check the sequence of actions  archive must comme before remove-runs
+     (if  (and action-chk (member (string->symbol "archive") action-chk))
+          (begin
+          (debug:print-error 0 *default-log-port* "action remove-runs must come after archive")
+          (exit 1))) 
+    (print "Actions: " actions " age: " age)
+    (for-each
+         (lambda (target)
+            (let* ((runs      (hash-table-ref runs-ht target))
+	           (sorted    (sort runs (lambda (a b)(< (simple-run-event_time a)(simple-run-event_time b)))))
+	           (to-remove (let* ((len      (length sorted))
+                                     (trim-amt (- len num-to-keep)))
+                                 (if (> trim-amt 0)
+                                    (take sorted trim-amt)
+                                    '()))))
+	   (hash-table-set! runs-ht target to-remove)))
+      (hash-table-keys runs-ht))
+
+    (for-each
+     (lambda (action)
+        (for-each
+         (lambda (target)
+            (let* ((runs      (hash-table-ref runs-ht target))
+	           (sorted    (sort runs (lambda (a b)(< (simple-run-event_time a)(simple-run-event_time b)))))
+	           (to-remove (let* ((len      (length sorted))
+                                     (trim-amt (- len num-to-keep)))
+                                 (if (> trim-amt 0)
+                                    (take sorted trim-amt)
+                                    '()))))
+	   ;(hash-table-set! runs-ht target to-remove)
+           (print action " " target ":")
+           (for-each
+            (lambda (run)
+              (let ((remove #t ));(member run to-remove (lambda (a b)
+                                ;                    (eq? (simple-run-id a)
+                                 ;                        (simple-run-id b))))))
+  	        (if (and age (> (simple-run-event_time run) age-mark))
+		     (print "Skipping handling of " target "/" (simple-run-runname run) " as it is younger than " (args:get-arg "-age"))
 		     (case action
 		       ((print)
 			(print " " (simple-run-runname run)
 			       " " (time->string (seconds->local-time (simple-run-event_time run)) "WW%V.%u %H:%M:%S")
 			       " " (if remove "REMOVE" "")))
 		       ((remove-runs)
-			(if remove (system (conc precmd " megatest -remove-runs -target " target " -runname " (simple-run-runname run) " -testpatt %"
+                         (print "in remove-runs")
+			(if remove 
+                             (let ((cmd (conc precmd " megatest -remove-runs -target " target " -runname " (simple-run-runname run) " -testpatt %"
 						 (if (member 'kill-runs actions) ;; if kill-runs is specified then set -kill-wait to 0
 						     " -kill-wait 0"
-						     "")))))
+						     ""))))
+                                   (print cmd) 
+                                   (system cmd))))
 		       ((archive)
-			(if remove (system (conc precmd " megatest -archive save-remove -target " target " -runname " (simple-run-runname run) " -testpatt %"))))
+			(if remove 
+                              (let ((cmd (conc precmd " megatest -archive save-remove -target " target " -runname " (simple-run-runname run) " -testpatt %")))
+                                   (print cmd) 
+                                   (system cmd))))
 		       ((kill-runs)
 			(if remove (system (conc precmd " megatest -kill-runs -target " target " -runname " (simple-run-runname run) " -testpatt %"))))
-			))
-		   actions))))
-          sorted)))
-     ;; (print "Sorted: " (map simple-run-event_time sorted))
-     ;; (print "Remove: " (map simple-run-event_time to-remove))))
-     (hash-table-keys runs-ht))
+                       (else 
+                         (print "unrecognised cmd " action))))))
+            sorted)))
+         (hash-table-keys runs-ht)))
+      actions)
     runs-ht))
 
 (define (remove-last-path-directory path-in)
   (let* ((dparts  (string-split path-in "/"))
     (path-out (conc "/" (string-intersperse (take dparts (- (length dparts) 1)) "/")))
@@ -2104,29 +2385,10 @@
     path-out
   )
 )
 
 
-;; (define (runs:remove-all-but-last-n-runs-per-target target-patts runpatt num-to-keep)
-;;   (let ((data (runs:get-all-but-most-recent-n-per-target target-patts runpatt num-to-keep)))
-;;     (for-each
-;;      (lambda (target)
-;;        (let ((runs-to-remove (hash-table-ref data target )))
-;;          (for-each
-;;           (lambda (run)
-;;             (print "megatest -remove-runs -target " target " -runname " (simple-run-runname run) " -testpatt %"))
-;;           runs-to-remove)))
-;;      (hash-table-keys data))))
-
-;; Remove runs
-;; fields are passing in through 
-;; action:
-;;    'remove-runs
-;;    'set-state-status
-;;
-;; NB// should pass in keys?
-;;
 (define (runs:operate-on action target runnamepatt testpatt #!key (state #f)(status #f)(new-state-status #f)(mode #f)(options '()))
   (common:clear-caches) ;; clear all caches
   (let* ((db           #f)
 	 ;; (tdbdat       (tasks:open-db))
 	 (keys         (rmt:get-keys))
@@ -2360,11 +2622,11 @@
                                       (begin
                                        (let ((rundir (db:test-get-rundir new-test-dat)))
                                         (if (and (not (string=  rundir "/tmp/badname")) 
                                              (file-exists? rundir)
                                              (substring-index run-name rundir)
-                                             (substring-index target rundir)
+                                             (tests:glob-like-match (conc "%/" target "/%") rundir)
                                              )
                                           (begin
                                             (set! lasttpath (db:test-get-rundir new-test-dat)) ;; remember this path for run removal
                                             (set! lastrealpath (remove-last-path-directory (resolve-pathname lasttpath)))
                                             (hash-table-set! run-paths-hash lastrealpath 1)
@@ -2373,11 +2635,13 @@
                                           (begin
                                             (debug:print 2 *default-log-port* "Not removing directory " rundir " because either it doesn't exist or has a bad name")
                                             (debug:print 2 *default-log-port* "Is /tmp/badname: " (string=  rundir "/tmp/badname"))
                                             (debug:print 2 *default-log-port* "Exists: " (file-exists? rundir))
                                             (debug:print 2 *default-log-port* "Has run-name: " (substring-index run-name rundir))
-                                            (debug:print 2 *default-log-port* "Has target: " (substring-index target rundir))
+                                            (debug:print 2 *default-log-port* "Has target: " (tests:glob-like-match (conc "%/" target "/%") rundir))
+                                            (debug:print 2 *default-log-port* "Target: " target)
+
                                             ;;PJH remove record from db no need to cleanup directory
                                             (case mode
                                                ((remove-data-only)(mt:test-set-state-status-by-id (db:test-get-run_id test)(db:test-get-id test) (db:test-get-state test)(db:test-get-status test) #f))
                                                ((archive-remove)  (mt:test-set-state-status-by-id (db:test-get-run_id test)(db:test-get-id test) "ARCHIVED" #f #f))
                                                (else (rmt:delete-test-records (db:test-get-run_id test) (db:test-get-id test))))
@@ -2436,11 +2700,11 @@
 				(if (not (null? tal))
 				    (loop (car tal)(cdr tal))))
 			       ((run-wait)
                                 ;; BB TODO - manage has-subrun case
 				(debug:print-info 2 *default-log-port* "still waiting, " (length tests) " tests still running")
-				(thread-sleep! 10)
+				(thread-sleep! 5)
 				(let ((new-tests (proc-get-tests run-id)))
 				  (if (null? new-tests)
 				      (debug:print-info 1 *default-log-port* "Run completed according to zero tests matching provided criteria.")
 				      (loop (car new-tests)(cdr new-tests)))))
 			       ((archive)
@@ -2491,10 +2755,15 @@
 	 ))
      runs)
     ;; special case - archive get
     (if (equal? (args:get-arg "-archive") "get")
 	(archive:bup-get-data "get" #f #f test-records rp-mutex bup-mutex))
+    (if (or (equal? (args:get-arg "-archive") "save") (equal? (args:get-arg "-archive") "save-remove"))
+        (begin 
+             (print "db archive started")  
+             (archive:megatest-db target runnamepatt)
+             (print "db archived")))
     )
   #t
   )
 
 (define (runs:remove-test-directory test mode) ;; remove-data-only)
@@ -2538,18 +2807,18 @@
     (if (symbolic-link? run-dir)
 	(begin
 	  (debug:print-info 1 *default-log-port* "Removing symlink " run-dir)
 	  (handle-exceptions
 	   exn
-	   (debug:print-error 0 *default-log-port* " Failed to remove symlink " run-dir ((condition-property-accessor 'exn 'message) exn) ", attempting to continue")
+	   (debug:print-error 0 *default-log-port* " Failed to remove symlink " run-dir ((condition-property-accessor 'exn 'message) exn) ", attempting to continue, exn=" exn)
 	   (delete-file run-dir)))
 	(if (directory? run-dir)
 	    (if (> (directory-fold (lambda (f x)(+ 1 x)) 0 run-dir) 0)
 		(debug:print 0 *default-log-port* "WARNING: refusing to remove " run-dir " as it is not empty")
 		(handle-exceptions
 		 exn
-		 (debug:print-error 0 *default-log-port* " Failed to remove directory " run-dir ((condition-property-accessor 'exn 'message) exn) ", attempting to continue")
+		 (debug:print-error 0 *default-log-port* " Failed to remove directory " run-dir ((condition-property-accessor 'exn 'message) exn) ", attempting to continue, exn=" exn)
 		 (delete-directory run-dir)))
 	    (if (and run-dir
 		     (not (member run-dir (list "n/a" "/tmp/badname"))))
 		(debug:print 0 *default-log-port* "WARNING: not removing " run-dir " as it either doesn't exist or is not a symlink")
 		(debug:print 0 *default-log-port* "NOTE: the run dir for this test is undefined. Test may have already been deleted."))
@@ -2822,11 +3091,11 @@
 		    (let* ((final-doc ((sxml-modify `("testsuite" insert-into (@ (name ,xml-ts-name) (tests ,tests-count) (errors ,error-cnt) (failures ,fail-cnt)))) new-doc)))
 		    (debug:print 0 *default-log-port* "modify attrib error=" error-cnt " fail= " fail-cnt)
 		    (handle-exceptions
 		     exn
 		     (let*	((msg	((condition-property-accessor 'exn 'message) exn)))
-		       (debug:print 0 *default-log-port* (conc "WARNING: Failed to update file" xml-path". Message:" msg)))
+		       (debug:print 0 *default-log-port* (conc "WARNING: Failed to update file" xml-path". Message:" msg ", exn=" exn)))
 		     		   
 		     (if (not (file-exists? xml-dir)) 
 			 (create-directory xml-dir #t))
                      (if (not (rmt:no-sync-get/default keyname #f)) 
                        (begin
@@ -2856,10 +3125,10 @@
 		  (debug:print-info 0 *default-log-port* "Removing cached files:\n    " (string-intersperse files "\n    "))
 		  (for-each 
 		   (lambda (f)
 		     (handle-exceptions
 			 exn
-			 (debug:print 0 *default-log-port* "WARNING: Failed to remove file " f)
+			 (debug:print 0 *default-log-port* "WARNING: Failed to remove file " f ", exn=" exn)
 		       (delete-file f)))
 		   files))))
 	  (debug:print-error 0 *default-log-port* "-clean-cache requires -runname."))
       (debug:print-error 0 *default-log-port* "-clean-cache requires -target or -reqtarg")))

Index: sauth-common.scm
==================================================================
--- sauth-common.scm
+++ sauth-common.scm
@@ -240,11 +240,20 @@
          (set!  obj data-row))))
 ;(print obj)
 obj))
 
 
+(define (sauth-common:src-size path)
+  (let ((output (with-input-from-pipe (conc "/usr/bin/du -s " path  "  | awk '{print $1}'")  
+                 (lambda()
+                  (read-line)))))
+      (string->number output)))  
 
+(define (sauth-common:space-left-at-dest path)
+   (let* ((output  (run/string (pipe (df ,path ) (tail -1))))
+         (size (caddr (cdr (string-split output " ")))))
+  (string->number size)))
 
 ;; function to validate the users input for target path and resolve the path
 ;; TODO: Check for restriction in subpath 
 (define (sauth-common:resolve-path  new current allowed-sheets)
    (let* ((target-path (append  current (string-split new "/")))
@@ -279,11 +288,11 @@
                     
 	              
                            (if (and (not (equal? restricted-areas "" ))
                              (string-match (regexp  restrictions) target-path)) 
                            (begin
-                              (sauth:print-error "Access denied to " (string-join resolved-path "/"))
+                              (sauth:print-error (conc "Access denied to " (string-join resolved-path "/")))
                               ;(exit 1)   
                             #f)
                              target-path)
                             
 ))

Index: sauthorize.scm
==================================================================
--- sauthorize.scm
+++ sauthorize.scm
@@ -26,12 +26,12 @@
 
 (use sql-de-lite srfi-1 posix regex regex-case srfi-69)
 ;(declare (uses common))
 ;(declare (uses configf))
 (declare (uses margs))
-(declare (uses megatest-version))
 
+(include "megatest-version.scm")
 (include "megatest-fossil-hash.scm")
 ;;; please create this file before using sautherise. For sample file is avaliable sample-sauth-paths.scm. 
 (include "sauth-paths.scm")
 (include "sauth-common.scm")
 

Index: server.scm
==================================================================
--- server.scm
+++ server.scm
@@ -125,17 +125,21 @@
 	 (curr-pid    (current-process-id))
 	 (homehost    (common:get-homehost)) ;; configf:lookup *configdat* "server" "homehost" ))
 	 (target-host (car homehost))
 	 (testsuite   (common:get-testsuite-name))
 	 (logfile     (conc areapath "/logs/server.log")) ;; -" curr-pid "-" target-host ".log"))
+	 (profile-mode (or (configf:lookup *configdat* "misc" "profilesw")
+			   ""))
 	 (cmdln (conc (common:get-megatest-exe)
 		      " -server " (or target-host "-") (if (equal? (configf:lookup *configdat* "server" "daemonize") "yes")
 							   " -daemonize "
 							   "")
 		      ;; " -log " logfile
-		      " -m testsuite:" testsuite)) ;; (conc " >> " logfile " 2>&1 &")))))
-	 (log-rotate  (make-thread common:rotate-logs  "server run, rotate logs thread"))
+		      " -m testsuite:" testsuite
+		      " " profile-mode
+		      )) ;; (conc " >> " logfile " 2>&1 &")))))
+	 (log-rotate  (make-thread common:rotate-logs  "server run, rotate logs thread")) ;; why are we rotating logs here? This is a sensitive location with a lot going on!?
          (load-limit  (configf:lookup-number *configdat* "jobtools" "max-server-start-load" default: 3.0)))
     ;; we want the remote server to start in *toppath* so push there
     (push-directory areapath)
     (debug:print 0 *default-log-port* "INFO: Trying to start server (" cmdln ") ...")
     (thread-start! log-rotate)
@@ -151,11 +155,11 @@
 	  (setenv "TARGETHOST" target-host)))
       
     (setenv "TARGETHOST_LOGF" logfile)
     (thread-sleep! (/ (random 5000) 1000)) ;; add about a random (up to 5 seconds) initial delay. It seems pretty common that many running tests request a server at the same time
     ;; (common:wait-for-normalized-load load-limit " delaying server start due to load" target-host) ;; do not try starting servers on an already overloaded machine, just wait forever
-    (common:wait-for-homehost-load load-limit (conc " delaying server start due to load on homehost. limit is " load-limit))
+    #;(common:wait-for-homehost-load load-limit (conc " delaying server start due to load on homehost. limit is " load-limit))
     (system (conc "nbfake " cmdln))
     (unsetenv "TARGETHOST_LOGF")
     (if (get-environment-variable "TARGETHOST")(unsetenv "TARGETHOST"))
     (thread-join! log-rotate)
     (pop-directory)))
@@ -164,11 +168,13 @@
 ;;
 (define (server:logf-get-start-info logf)
   (let ((rx (regexp "^SERVER STARTED: (\\S+):(\\d+) AT ([\\d\\.]+)"))) ;; SERVER STARTED: host:port AT timesecs
     (handle-exceptions
 	exn
-	(list #f #f #f) ;; no idea what went wrong, call it a bad server
+      (begin
+	(print "failed to get server info from " logf ", exn=" exn)
+	(list #f #f #f)) ;; no idea what went wrong, call it a bad server
       (with-input-from-file
 	  logf
 	(lambda ()
 	  (let loop ((inl  (read-line))
 		     (lnum 0))
@@ -196,13 +202,13 @@
     (if (if (directory-exists? (conc areapath "/logs"))
 	    '()
 	    (if (file-write-access? areapath)
 		(begin
 		  (condition-case
-		      (create-directory (conc areapath "/logs") #t)
-		    (exn (i/o file)(debug:print 0 *default-log-port* "ERROR: Cannot create directory at " (conc areapath "/logs")))
-		    (exn ()(debug:print 0 *default-log-port* "ERROR: Unknown error attemtping to get server list.")))
+		   (create-directory (conc areapath "/logs") #t)
+		   (exn (i/o file)(debug:print 0 *default-log-port* "ERROR: Cannot create directory at " (conc areapath "/logs")))
+		   (exn ()(debug:print 0 *default-log-port* "ERROR: Unknown error attemtping to get server list. exn=" exn)))
 		  (directory-exists? (conc areapath "/logs")))
 		'()))
 	(let* ((server-logs   (glob (conc areapath "/logs/server-*.log")))
 	       (num-serv-logs (length server-logs)))
 	  (if (null? server-logs)
@@ -209,13 +215,15 @@
 	      '()
 	      (let loop ((hed  (car server-logs))
 			 (tal  (cdr server-logs))
 			 (res '()))
 		(let* ((mod-time  (handle-exceptions
-				      exn
-				      (current-seconds) ;; 0
-				    (file-modification-time hed))) ;; default to *very* old so log gets ignored if deleted
+				   exn
+				   (begin
+				     (debug:print 0 *default-log-port* "failed to get modification time on " hed ", exn=" exn)
+				     (current-seconds)) ;; 0
+				   (file-modification-time hed))) ;; default to *very* old so log gets ignored if deleted
 		       (down-time (- (current-seconds) mod-time))
 		       (serv-dat  (if (or (< num-serv-logs 10)
 				  	  (< down-time 900)) ;; day-seconds))
 				      (server:logf-get-start-info hed)
 				      '())) ;; don't waste time processing server files not touched in the 15 minutes if there are more than ten servers to look at
@@ -223,16 +231,16 @@
 		       (fmatch   (string-match fname-rx hed))
 		       (pid      (if fmatch (string->number (list-ref fmatch 2)) #f))
 		       (new-res  (if (null? serv-dat)
 				     res
 				     (cons (append serv-rec (list pid)) res))))
-		(if (null? tal)
-		    (if (and limit
-			     (> (length new-res) limit))
-			new-res ;; (take new-res limit)  <= need intelligent sorting before this will work
-			new-res)
-		    (loop (car tal)(cdr tal) new-res)))))))))
+		  (if (null? tal)
+		      (if (and limit
+			       (> (length new-res) limit))
+			  new-res ;; (take new-res limit)  <= need intelligent sorting before this will work
+			  new-res)
+		      (loop (car tal)(cdr tal) new-res)))))))))
 
 (define (server:get-num-alive srvlst)
   (let ((num-alive 0))
     (for-each
      (lambda (server)
@@ -266,14 +274,15 @@
 				    (mod-time   (list-ref rec 0)))
 				;; (print "start-time: " start-time " mod-time: " mod-time)
 				(and start-time mod-time
 				     (> (- now start-time) 0)    ;; been running at least 0 seconds
 				     (< (- now mod-time)   16)   ;; still alive - file touched in last 16 seconds
-				     (< (- now start-time)       
-					(+ (- (string->number (or (configf:lookup *configdat* "server" "runtime") "3600"))
-					      180)
-					   (random 360))) ;; under one hour running time +/- 180
+				     (or (not (configf:lookup *configdat* "server" "runtime")) ;; skip if not set
+					 (< (- now start-time)       
+					    (+ (- (string->number (configf:lookup *configdat* "server" "runtime"))
+					       180)
+					    (random 360)))) ;; under one hour running time +/- 180
 				     ))
 			      #f))
 			srvlst)
 		(lambda (a b)
 		  (< (list-ref a 3)
@@ -310,13 +319,92 @@
   (if *my-client-signature* *my-client-signature*
       (let ((sig (server:mk-signature)))
         (set! *my-client-signature* sig)
         *my-client-signature*)))
 
+;; wait for server=start-last to be three seconds old
+;;
+(define (server:wait-for-server-start-last-flag areapath)
+  (let* ((flag-dir   (conc areapath "/logs"))
+	 (start-flag (conc flag-dir "/server-start-last"))
+	 ;;; THIS INTERACTS WITH [server] timeout. Suggest using 0.1 or above for timeout (6 seconds)
+	 (reftime    (configf:lookup-number *configdat* "server" "idletime" default: 4))
+	 (server-key (conc (get-host-name) "-" (current-process-id)))
+	 (create-key-file (lambda ()
+			    (with-output-to-file start-flag
+			      (lambda ()
+				(print server-key)))))
+	 (check-key-file  (lambda ()
+			    (let ((res (with-input-from-file start-flag
+					 (lambda ()
+					   (read-line)))))
+			      (equal? server-key res))))
+	 (get-file-age    (lambda ()
+			    (let* ((fmodtime (file-modification-time start-flag)))
+			      (- (current-seconds) fmodtime)))))
+    (if (not (directory-exists? flag-dir))
+	(begin
+	  (debug:print-info 0 *default-log-port* "Directory " flag-dir " does not exist! Cannot gate.")
+	  #f)
+	(if (file-exists? start-flag)
+	    (if (check-key-file) ;; is it me?
+		#t               ;; yes, it is me, proceed
+		(let* ((file-age (get-file-age)))
+		  (if (> file-age reftime) ;; let the previous guy have at least 4 seconds to do their thing
+		      (begin                     ;; file is old enough, we can try to take it
+			(create-key-file)        ;; take the file and try again
+			(server:wait-for-server-start-last-flag areapath))
+		      (let* ((remtime (max 1 (min file-age reftime))))
+			(debug:print-info 0 *default-log-port* "Gating server start, waiting remtime="remtime)
+			(thread-sleep! remtime)
+			(server:wait-for-server-start-last-flag areapath)))))
+	    (begin
+	      (create-key-file)
+	      (server:wait-for-server-start-last-flag areapath))))))
+		    
+
+		    
+;; wait for server=start-last to be three seconds old
+;;
+(define (server:wait-for-server-start-last-flag-old areapath)
+  (let* ((start-flag (conc areapath "/logs/server-start-last"))
+	 ;;; THIS INTERACTS WITH [server] timeout. Suggest using 0.1 or above for timeout (6 seconds)
+	 (reftime    (configf:lookup-number *configdat* "server" "idletime" default: 4))
+	 (server-key (conc (get-host-name) "-" (current-process-id)))
+	 (create-key-file (lambda ()
+			    (with-output-to-file start-flag
+			      (lambda ()
+				(print server-key)))))
+	 (check-key-file  (lambda ()
+			    (let ((res (with-input-from-file start-flag
+					 (lambda ()
+					   (read-line)))))
+			      (equal? server-key res)))))
+    ;; (thread-sleep! (/ (random 500) 1000)) ;; I don't think this made a difference
+    (if (file-exists? start-flag)
+	(let* ((fmodtime (file-modification-time start-flag))
+	       (delta    (- (current-seconds) fmodtime))
+	       (all-go   (> delta reftime)))
+	  (if (and all-go
+		   (begin
+		     (create-key-file)
+		     (thread-sleep! 0.25)
+		     (check-key-file)))
+	      #t ;; (system (conc "touch " start-flag)) ;; lazy but safe
+	      (begin
+		(debug:print-info 0 *default-log-port* "Gating server start, last start: "
+				  fmodtime ", delta: " delta ", reftime: " reftime ", all-go=" all-go)
+		(thread-sleep! reftime)
+		(server:wait-for-server-start-last-flag areapath)))))))
+
 ;; kind start up of servers, wait 40 seconds before allowing another server for a given
 ;; run-id to be launched
+;;
 (define (server:kind-run areapath)
+  ;; look for $MT_RUN_AREA_HOME/logs/server-start-last
+  ;; and wait for it to be at least 3 seconds old
+  (server:wait-for-server-start-last-flag areapath)
   (if (not (server:check-if-running areapath)) ;; why try if there is already a server running?
       (let* ((last-run-dat (hash-table-ref/default *server-kind-run* areapath '(0 0))) ;; callnum, whenrun
 	     (call-num     (car last-run-dat))
 	     (when-run     (cadr last-run-dat))
 	     (run-delay    (+ (case call-num
@@ -325,17 +413,20 @@
 				((2)  300)
 				(else 600))
 			      (random 5)))   ;; add a small random number just in case a lot of jobs hit the work hosts simultaneously
 	     (lock-file    (conc areapath "/logs/server-start.lock")))
 	(if	(> (- (current-seconds) when-run) run-delay)
-		(begin
+		(let* ((start-flag (conc areapath "/logs/server-start-last")))
 		  (common:simple-file-lock-and-wait lock-file expire-time: 15)
+		  (system (conc "touch " start-flag)) ;; lazy but safe
 		  (server:run areapath)
 		  (thread-sleep! 2) ;; don't release the lock for at least a few seconds
 		  (common:simple-file-release-lock lock-file)))
 	(hash-table-set! *server-kind-run* areapath (list (+ call-num 1)(current-seconds))))))
 
+;; this one seems to be the general entry point
+;;
 (define (server:start-and-wait areapath #!key (timeout 60))
   (let ((give-up-time (+ (current-seconds) timeout)))
     (let loop ((server-url (server:check-if-running areapath))
 	       (try-num    0))
       (if (or server-url
@@ -541,14 +632,17 @@
                                (if (not (configf:lookup *configdat* "server" "disable-db-snapshot"))
                                    (common:snapshot-file mtdbfile subdir: ".db-snapshot"))
 		               (delete-file* staging-file)
 		               (let* ((start-time (current-milliseconds))
                                       (res (system sync-cmd))
+                                      (dbbackupfile (conc mtdbfile ".backup"))
                                       (res2 
                                        (cond
-                                        ((eq? 0 res)
-		                         (delete-file* (conc mtdbfile ".backup"))
+                                        ((eq? 0 res )
+                                         (if (file-exists? dbbackupfile)
+		                           (delete-file* dbbackupfile)
+                                         )
                                          (if (eq? 0 (file-size sync-log))
                                              (delete-file sync-log))
 		                         (system (conc "/bin/mv " staging-file " " mtdbfile))
                                          
                                          (set! last-sync-seconds (/ (- (current-milliseconds) start-time) 1000))
@@ -618,10 +712,11 @@
   (let ((legacy-sync  (common:run-sync?))
         (sync-stale-seconds (configf:lookup-number *configdat* "server" "sync-stale-seconds" default: 300))
 	(debug-mode   (debug:debug-mode 1))
 	(last-time    (current-seconds))
 	(no-sync-db   (db:open-no-sync-db))
+	(stmt-cache   (dbr:dbstruct-stmt-cache dbstruct))
         (sync-duration 0) ;; run time of the sync in milliseconds
         ;;(this-wd-num  (begin (mutex-lock! *wdnum*mutex) (let ((x *wdnum*)) (set! *wdnum* (add1 *wdnum*)) (mutex-unlock! *wdnum*mutex) x)))
         )
     (set! *no-sync-db* no-sync-db) ;; make the no sync db available to api calls
     (debug:print-info 2 *default-log-port* "Periodic sync thread started.")
@@ -739,9 +834,9 @@
 		      (begin
 			(thread-sleep! 1)
 			(delay-loop (+ count 1))))
 		  (if (not *time-to-exit*) (loop))))
 	    ;; time to exit, close the no-sync db here
-	    (db:no-sync-close-db no-sync-db)
+	    (db:no-sync-close-db no-sync-db stmt-cache)
 	    (if (common:low-noise-print 30)
 		(debug:print-info 0 *default-log-port* "Exiting watchdog timer, *time-to-exit* = " *time-to-exit*" pid="(current-process-id) ))))))) ;;" this-wd-num="this-wd-num)))))))
 

Index: spublish.scm
==================================================================
--- spublish.scm
+++ spublish.scm
@@ -26,13 +26,11 @@
 
 ;(declare (uses configf))
 ;; (declare (uses tree))
 (declare (uses margs))
 
-(declare (uses megatest-version))
-;; (declare (uses tbd))
-
+(include "megatest-version.scm")
 (include "megatest-fossil-hash.scm")
 ;;; please create this file before using sautherise. For sample file is avaliable sample-sauth-paths.scm. 
 (include "sauth-paths.scm")
 (include "sauth-common.scm")
 (define (toplevel-command . args) #f)
@@ -393,10 +391,14 @@
    ((not (file-exists? target-path))
 	(sauth:print-error (conc " target Directory " target-path " does not exist!!")))
    ((not (file-exists? src-path))
     (sauth:print-error (conc "Source path " src-path " does not exist!!" )))
    (else
+     (if (< (sauth-common:space-left-at-dest target-path) (sauth-common:src-size src-path))
+          (begin 
+             (sauth:print-error "Destination does not have enough disk space.")
+             (exit 1)))    
      (if (is_directory src-path) 
         (begin
             (let* ((parent-dir src-path)
                    (start-dir target-path))
                  (run (pipe

Index: sretrieve.scm
==================================================================
--- sretrieve.scm
+++ sretrieve.scm
@@ -24,13 +24,12 @@
 (use refdb)
 (use sql-de-lite srfi-1 posix regex regex-case srfi-69)
 ;(declare (uses common))
 ;(declare (uses configf))
 (declare (uses margs))
-(declare (uses megatest-version))
- 
 
+(include "megatest-version.scm")
 (include "megatest-fossil-hash.scm")
 ;;; please create this file before using sautherise. For sample file is avaliable sample-sauth-paths.scm. 
 (include "sauth-paths.scm")
 (include "sauth-common.scm")
 
@@ -639,10 +638,11 @@
                                       (pathname-file target-path)))
                   (curr-dir (current-directory))   
                   (start-dir (conc (current-directory) "/" last-dir-name))
                   (execlude (make-exclude-pattern (string-split restrictions ",")))
                    (tmpfile (conc "/tmp/" (current-user-name) "/my-pipe-" (current-process-id))))
+                    (sauth:print-error start-dir)
                     (if  (file-exists? start-dir)
                     (begin
                          (sauth:print-error (conclast-dir-name " already exist in your work dir."))
                          (sauth:print-error  "Nothing has been retrieved!!  "))
                      (begin

ADDED   stml2.scm
Index: stml2.scm
==================================================================
--- /dev/null
+++ stml2.scm
@@ -0,0 +1,23 @@
+;;======================================================================
+;; Copyright 2019, Matthew Welland.
+;; 
+;; This file is part of Megatest.
+;; 
+;;     Megatest is free software: you can redistribute it and/or modify
+;;     it under the terms of the GNU General Public License as published by
+;;     the Free Software Foundation, either version 3 of the License, or
+;;     (at your option) any later version.
+;; 
+;;     Megatest is distributed in the hope that it will be useful,
+;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;     GNU General Public License for more details.
+;; 
+;;     You should have received a copy of the GNU General Public License
+;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
+
+;;======================================================================
+
+(declare (unit stml2))
+
+(include "stml2/stml2.scm")

ADDED   stml2/COPYING
Index: stml2/COPYING
==================================================================
--- /dev/null
+++ stml2/COPYING
@@ -0,0 +1,724 @@
+		    GNU GENERAL PUBLIC LICENSE
+		       Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+                       51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+			    Preamble
+
+  The licenses for most software are designed to take away your
+freedom to share and change it.  By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users.  This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it.  (Some other Free Software Foundation software is covered by
+the GNU Library General Public License instead.)  You can apply it to
+your programs, too.
+
+  When we speak of free software, we are referring to freedom, not
+price.  Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+this service if you wish), that you receive source code or can get it
+if you want it, that you can change the software or use pieces of it
+in new free programs; and that you know you can do these things.
+
+  To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+  For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have.  You must make sure that they, too, receive or can get the
+source code.  And you must show them these terms so they know their
+rights.
+
+  We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+  Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software.  If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+  Finally, any free program is threatened constantly by software
+patents.  We wish to avoid the danger that redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary.  To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.
+
+		    GNU GENERAL PUBLIC LICENSE
+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+  0. This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License.  The "Program", below,
+refers to any such program or work, and a "work based on the Program"
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language.  (Hereinafter, translation is included without limitation in
+the term "modification".)  Each licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope.  The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+  1. You may copy and distribute verbatim copies of the Program's
+source code as you receive it, in any medium, provided that you
+conspicuously and appropriately publish on each copy an appropriate
+copyright notice and disclaimer of warranty; keep intact all the
+notices that refer to this License and to the absence of any warranty;
+and give any other recipients of the Program a copy of this License
+along with the Program.
+
+You may charge a fee for the physical act of transferring a copy, and
+you may at your option offer warranty protection in exchange for a fee.
+
+  2. You may modify your copy or copies of the Program or any portion
+of it, thus forming a work based on the Program, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+    a) You must cause the modified files to carry prominent notices
+    stating that you changed the files and the date of any change.
+
+    b) You must cause any work that you distribute or publish, that in
+    whole or in part contains or is derived from the Program or any
+    part thereof, to be licensed as a whole at no charge to all third
+    parties under the terms of this License.
+
+    c) If the modified program normally reads commands interactively
+    when run, you must cause it, when started running for such
+    interactive use in the most ordinary way, to print or display an
+    announcement including an appropriate copyright notice and a
+    notice that there is no warranty (or else, saying that you provide
+    a warranty) and that users may redistribute the program under
+    these conditions, and telling the user how to view a copy of this
+    License.  (Exception: if the Program itself is interactive but
+    does not normally print such an announcement, your work based on
+    the Program is not required to print an announcement.)
+
+These requirements apply to the modified work as a whole.  If
+identifiable sections of that work are not derived from the Program,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works.  But when you
+distribute the same sections as part of a whole which is a work based
+on the Program, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+  3. You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+    a) Accompany it with the complete corresponding machine-readable
+    source code, which must be distributed under the terms of Sections
+    1 and 2 above on a medium customarily used for software interchange; or,
+
+    b) Accompany it with a written offer, valid for at least three
+    years, to give any third party, for a charge no more than your
+    cost of physically performing source distribution, a complete
+    machine-readable copy of the corresponding source code, to be
+    distributed under the terms of Sections 1 and 2 above on a medium
+    customarily used for software interchange; or,
+
+    c) Accompany it with the information you received as to the offer
+    to distribute corresponding source code.  (This alternative is
+    allowed only for noncommercial distribution and only if you
+    received the program in object code or executable form with such
+    an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for
+making modifications to it.  For an executable work, complete source
+code means all the source code for all modules it contains, plus any
+associated interface definition files, plus the scripts used to
+control compilation and installation of the executable.  However, as a
+special exception, the source code distributed need not include
+anything that is normally distributed (in either source or binary
+form) with the major components (compiler, kernel, and so on) of the
+operating system on which the executable runs, unless that component
+itself accompanies the executable.
+
+If distribution of executable or object code is made by offering
+access to copy from a designated place, then offering equivalent
+access to copy the source code from the same place counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+  4. You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License.  Any attempt
+otherwise to copy, modify, sublicense or distribute the Program is
+void, and will automatically terminate your rights under this License.
+However, parties who have received copies, or rights, from you under
+this License will not have their licenses terminated so long as such
+parties remain in full compliance.
+
+  5. You are not required to accept this License, since you have not
+signed it.  However, nothing else grants you permission to modify or
+distribute the Program or its derivative works.  These actions are
+prohibited by law if you do not accept this License.  Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+  6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program subject to
+these terms and conditions.  You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+  7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License.  If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Program at all.  For example, if a patent
+license would not permit royalty-free redistribution of the Program by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system, which is
+implemented by public license practices.  Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+  8. If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program under this License
+may add an explicit geographical distribution limitation excluding
+those countries, so that distribution is permitted only in or among
+countries not thus excluded.  In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+  9. The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time.  Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number.  If the Program
+specifies a version number of this License which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation.  If the Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+  10. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission.  For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this.  Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+			    NO WARRANTY
+
+  11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+  12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+		     END OF TERMS AND CONDITIONS
+
+	    How to Apply These Terms to Your New Programs
+
+  If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+  To do so, attach the following notices to the program.  It is safest
+to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+    <one line to give the program's name and a brief idea of what it does.>
+    Copyright (C) <year>  <name of author>
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+    Gnomovision version 69, Copyright (C) year  name of author
+    Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+    This is free software, and you are welcome to redistribute it
+    under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License.  Of course, the commands you use may
+be called something other than `show w' and `show c'; they could even be
+mouse-clicks or menu items--whatever suits your program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary.  Here is a sample; alter the names:
+
+  Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+  `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+  <signature of Ty Coon>, 1 April 1989
+  Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program into
+proprietary programs.  If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library.  If this is what you want to do, use the GNU Library General
+Public License instead of this License.
+
+
+GNU Free Documentation License
+******************************
+
+                        Version 1.1, March 2000
+     Copyright (C) 2000 Free Software Foundation, Inc.
+     51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+     
+     Everyone is permitted to copy and distribute verbatim copies
+     of this license document, but changing it is not allowed.
+
+  0. PREAMBLE
+
+     The purpose of this License is to make a manual, textbook, or other
+     written document "free" in the sense of freedom: to assure everyone
+     the effective freedom to copy and redistribute it, with or without
+     modifying it, either commercially or noncommercially.  Secondarily,
+     this License preserves for the author and publisher a way to get
+     credit for their work, while not being considered responsible for
+     modifications made by others.
+
+     This License is a kind of "copyleft", which means that derivative
+     works of the document must themselves be free in the same sense.
+     It complements the GNU General Public License, which is a copyleft
+     license designed for free software.
+
+     We have designed this License in order to use it for manuals for
+     free software, because free software needs free documentation: a
+     free program should come with manuals providing the same freedoms
+     that the software does.  But this License is not limited to
+     software manuals; it can be used for any textual work, regardless
+     of subject matter or whether it is published as a printed book.
+     We recommend this License principally for works whose purpose is
+     instruction or reference.
+
+  1. APPLICABILITY AND DEFINITIONS
+
+     This License applies to any manual or other work that contains a
+     notice placed by the copyright holder saying it can be distributed
+     under the terms of this License.  The "Document", below, refers to
+     any such manual or work.  Any member of the public is a licensee,
+     and is addressed as "you".
+
+     A "Modified Version" of the Document means any work containing the
+     Document or a portion of it, either copied verbatim, or with
+     modifications and/or translated into another language.
+
+     A "Secondary Section" is a named appendix or a front-matter
+     section of the Document that deals exclusively with the
+     relationship of the publishers or authors of the Document to the
+     Document's overall subject (or to related matters) and contains
+     nothing that could fall directly within that overall subject.
+     (For example, if the Document is in part a textbook of
+     mathematics, a Secondary Section may not explain any mathematics.)
+     The relationship could be a matter of historical connection with
+     the subject or with related matters, or of legal, commercial,
+     philosophical, ethical or political position regarding them.
+
+     The "Invariant Sections" are certain Secondary Sections whose
+     titles are designated, as being those of Invariant Sections, in
+     the notice that says that the Document is released under this
+     License.
+
+     The "Cover Texts" are certain short passages of text that are
+     listed, as Front-Cover Texts or Back-Cover Texts, in the notice
+     that says that the Document is released under this License.
+
+     A "Transparent" copy of the Document means a machine-readable copy,
+     represented in a format whose specification is available to the
+     general public, whose contents can be viewed and edited directly
+     and straightforwardly with generic text editors or (for images
+     composed of pixels) generic paint programs or (for drawings) some
+     widely available drawing editor, and that is suitable for input to
+     text formatters or for automatic translation to a variety of
+     formats suitable for input to text formatters.  A copy made in an
+     otherwise Transparent file format whose markup has been designed
+     to thwart or discourage subsequent modification by readers is not
+     Transparent.  A copy that is not "Transparent" is called "Opaque".
+
+     Examples of suitable formats for Transparent copies include plain
+     ASCII without markup, Texinfo input format, LaTeX input format,
+     SGML or XML using a publicly available DTD, and
+     standard-conforming simple HTML designed for human modification.
+     Opaque formats include PostScript, PDF, proprietary formats that
+     can be read and edited only by proprietary word processors, SGML
+     or XML for which the DTD and/or processing tools are not generally
+     available, and the machine-generated HTML produced by some word
+     processors for output purposes only.
+
+     The "Title Page" means, for a printed book, the title page itself,
+     plus such following pages as are needed to hold, legibly, the
+     material this License requires to appear in the title page.  For
+     works in formats which do not have any title page as such, "Title
+     Page" means the text near the most prominent appearance of the
+     work's title, preceding the beginning of the body of the text.
+
+  2. VERBATIM COPYING
+
+     You may copy and distribute the Document in any medium, either
+     commercially or noncommercially, provided that this License, the
+     copyright notices, and the license notice saying this License
+     applies to the Document are reproduced in all copies, and that you
+     add no other conditions whatsoever to those of this License.  You
+     may not use technical measures to obstruct or control the reading
+     or further copying of the copies you make or distribute.  However,
+     you may accept compensation in exchange for copies.  If you
+     distribute a large enough number of copies you must also follow
+     the conditions in section 3.
+
+     You may also lend copies, under the same conditions stated above,
+     and you may publicly display copies.
+
+  3. COPYING IN QUANTITY
+
+     If you publish printed copies of the Document numbering more than
+     100, and the Document's license notice requires Cover Texts, you
+     must enclose the copies in covers that carry, clearly and legibly,
+     all these Cover Texts: Front-Cover Texts on the front cover, and
+     Back-Cover Texts on the back cover.  Both covers must also clearly
+     and legibly identify you as the publisher of these copies.  The
+     front cover must present the full title with all words of the
+     title equally prominent and visible.  You may add other material
+     on the covers in addition.  Copying with changes limited to the
+     covers, as long as they preserve the title of the Document and
+     satisfy these conditions, can be treated as verbatim copying in
+     other respects.
+
+     If the required texts for either cover are too voluminous to fit
+     legibly, you should put the first ones listed (as many as fit
+     reasonably) on the actual cover, and continue the rest onto
+     adjacent pages.
+
+     If you publish or distribute Opaque copies of the Document
+     numbering more than 100, you must either include a
+     machine-readable Transparent copy along with each Opaque copy, or
+     state in or with each Opaque copy a publicly-accessible
+     computer-network location containing a complete Transparent copy
+     of the Document, free of added material, which the general
+     network-using public has access to download anonymously at no
+     charge using public-standard network protocols.  If you use the
+     latter option, you must take reasonably prudent steps, when you
+     begin distribution of Opaque copies in quantity, to ensure that
+     this Transparent copy will remain thus accessible at the stated
+     location until at least one year after the last time you
+     distribute an Opaque copy (directly or through your agents or
+     retailers) of that edition to the public.
+
+     It is requested, but not required, that you contact the authors of
+     the Document well before redistributing any large number of
+     copies, to give them a chance to provide you with an updated
+     version of the Document.
+
+  4. MODIFICATIONS
+
+     You may copy and distribute a Modified Version of the Document
+     under the conditions of sections 2 and 3 above, provided that you
+     release the Modified Version under precisely this License, with
+     the Modified Version filling the role of the Document, thus
+     licensing distribution and modification of the Modified Version to
+     whoever possesses a copy of it.  In addition, you must do these
+     things in the Modified Version:
+
+       A. Use in the Title Page (and on the covers, if any) a title
+          distinct from that of the Document, and from those of
+          previous versions (which should, if there were any, be listed
+          in the History section of the Document).  You may use the
+          same title as a previous version if the original publisher of
+          that version gives permission.
+
+       B. List on the Title Page, as authors, one or more persons or
+          entities responsible for authorship of the modifications in
+          the Modified Version, together with at least five of the
+          principal authors of the Document (all of its principal
+          authors, if it has less than five).
+
+       C. State on the Title page the name of the publisher of the
+          Modified Version, as the publisher.
+
+       D. Preserve all the copyright notices of the Document.
+
+       E. Add an appropriate copyright notice for your modifications
+          adjacent to the other copyright notices.
+
+       F. Include, immediately after the copyright notices, a license
+          notice giving the public permission to use the Modified
+          Version under the terms of this License, in the form shown in
+          the Addendum below.
+
+       G. Preserve in that license notice the full lists of Invariant
+          Sections and required Cover Texts given in the Document's
+          license notice.
+
+       H. Include an unaltered copy of this License.
+
+       I. Preserve the section entitled "History", and its title, and
+          add to it an item stating at least the title, year, new
+          authors, and publisher of the Modified Version as given on
+          the Title Page.  If there is no section entitled "History" in
+          the Document, create one stating the title, year, authors,
+          and publisher of the Document as given on its Title Page,
+          then add an item describing the Modified Version as stated in
+          the previous sentence.
+
+       J. Preserve the network location, if any, given in the Document
+          for public access to a Transparent copy of the Document, and
+          likewise the network locations given in the Document for
+          previous versions it was based on.  These may be placed in
+          the "History" section.  You may omit a network location for a
+          work that was published at least four years before the
+          Document itself, or if the original publisher of the version
+          it refers to gives permission.
+
+       K. In any section entitled "Acknowledgments" or "Dedications",
+          preserve the section's title, and preserve in the section all
+          the substance and tone of each of the contributor
+          acknowledgments and/or dedications given therein.
+
+       L. Preserve all the Invariant Sections of the Document,
+          unaltered in their text and in their titles.  Section numbers
+          or the equivalent are not considered part of the section
+          titles.
+
+       M. Delete any section entitled "Endorsements".  Such a section
+          may not be included in the Modified Version.
+
+       N. Do not retitle any existing section as "Endorsements" or to
+          conflict in title with any Invariant Section.
+
+     If the Modified Version includes new front-matter sections or
+     appendices that qualify as Secondary Sections and contain no
+     material copied from the Document, you may at your option
+     designate some or all of these sections as invariant.  To do this,
+     add their titles to the list of Invariant Sections in the Modified
+     Version's license notice.  These titles must be distinct from any
+     other section titles.
+
+     You may add a section entitled "Endorsements", provided it contains
+     nothing but endorsements of your Modified Version by various
+     parties--for example, statements of peer review or that the text
+     has been approved by an organization as the authoritative
+     definition of a standard.
+
+     You may add a passage of up to five words as a Front-Cover Text,
+     and a passage of up to 25 words as a Back-Cover Text, to the end
+     of the list of Cover Texts in the Modified Version.  Only one
+     passage of Front-Cover Text and one of Back-Cover Text may be
+     added by (or through arrangements made by) any one entity.  If the
+     Document already includes a cover text for the same cover,
+     previously added by you or by arrangement made by the same entity
+     you are acting on behalf of, you may not add another; but you may
+     replace the old one, on explicit permission from the previous
+     publisher that added the old one.
+
+     The author(s) and publisher(s) of the Document do not by this
+     License give permission to use their names for publicity for or to
+     assert or imply endorsement of any Modified Version.
+
+  5. COMBINING DOCUMENTS
+
+     You may combine the Document with other documents released under
+     this License, under the terms defined in section 4 above for
+     modified versions, provided that you include in the combination
+     all of the Invariant Sections of all of the original documents,
+     unmodified, and list them all as Invariant Sections of your
+     combined work in its license notice.
+
+     The combined work need only contain one copy of this License, and
+     multiple identical Invariant Sections may be replaced with a single
+     copy.  If there are multiple Invariant Sections with the same name
+     but different contents, make the title of each such section unique
+     by adding at the end of it, in parentheses, the name of the
+     original author or publisher of that section if known, or else a
+     unique number.  Make the same adjustment to the section titles in
+     the list of Invariant Sections in the license notice of the
+     combined work.
+
+     In the combination, you must combine any sections entitled
+     "History" in the various original documents, forming one section
+     entitled "History"; likewise combine any sections entitled
+     "Acknowledgments", and any sections entitled "Dedications".  You
+     must delete all sections entitled "Endorsements."
+
+  6. COLLECTIONS OF DOCUMENTS
+
+     You may make a collection consisting of the Document and other
+     documents released under this License, and replace the individual
+     copies of this License in the various documents with a single copy
+     that is included in the collection, provided that you follow the
+     rules of this License for verbatim copying of each of the
+     documents in all other respects.
+
+     You may extract a single document from such a collection, and
+     distribute it individually under this License, provided you insert
+     a copy of this License into the extracted document, and follow
+     this License in all other respects regarding verbatim copying of
+     that document.
+
+  7. AGGREGATION WITH INDEPENDENT WORKS
+
+     A compilation of the Document or its derivatives with other
+     separate and independent documents or works, in or on a volume of
+     a storage or distribution medium, does not as a whole count as a
+     Modified Version of the Document, provided no compilation
+     copyright is claimed for the compilation.  Such a compilation is
+     called an "aggregate", and this License does not apply to the
+     other self-contained works thus compiled with the Document, on
+     account of their being thus compiled, if they are not themselves
+     derivative works of the Document.
+
+     If the Cover Text requirement of section 3 is applicable to these
+     copies of the Document, then if the Document is less than one
+     quarter of the entire aggregate, the Document's Cover Texts may be
+     placed on covers that surround only the Document within the
+     aggregate.  Otherwise they must appear on covers around the whole
+     aggregate.
+
+  8. TRANSLATION
+
+     Translation is considered a kind of modification, so you may
+     distribute translations of the Document under the terms of section
+     4.  Replacing Invariant Sections with translations requires special
+     permission from their copyright holders, but you may include
+     translations of some or all Invariant Sections in addition to the
+     original versions of these Invariant Sections.  You may include a
+     translation of this License provided that you also include the
+     original English version of this License.  In case of a
+     disagreement between the translation and the original English
+     version of this License, the original English version will prevail.
+
+  9. TERMINATION
+
+     You may not copy, modify, sublicense, or distribute the Document
+     except as expressly provided for under this License.  Any other
+     attempt to copy, modify, sublicense or distribute the Document is
+     void, and will automatically terminate your rights under this
+     License.  However, parties who have received copies, or rights,
+     from you under this License will not have their licenses
+     terminated so long as such parties remain in full compliance.
+
+ 10. FUTURE REVISIONS OF THIS LICENSE
+
+     The Free Software Foundation may publish new, revised versions of
+     the GNU Free Documentation License from time to time.  Such new
+     versions will be similar in spirit to the present version, but may
+     differ in detail to address new problems or concerns.  See
+     `http://www.gnu.org/copyleft/'.
+
+     Each version of the License is given a distinguishing version
+     number.  If the Document specifies that a particular numbered
+     version of this License "or any later version" applies to it, you
+     have the option of following the terms and conditions either of
+     that specified version or of any later version that has been
+     published (not as a draft) by the Free Software Foundation.  If
+     the Document does not specify a version number of this License,
+     you may choose any version ever published (not as a draft) by the
+     Free Software Foundation.
+
+ADDENDUM: How to use this License for your documents
+----------------------------------------------------
+
+  To use this License in a document you have written, include a copy of
+the License in the document and put the following copyright and license
+notices just after the title page:
+
+       Copyright (C)  YEAR  YOUR NAME.
+       Permission is granted to copy, distribute and/or modify this document
+       under the terms of the GNU Free Documentation License, Version 1.1
+       or any later version published by the Free Software Foundation;
+       with the Invariant Sections being LIST THEIR TITLES, with the
+       Front-Cover Texts being LIST, and with the Back-Cover Texts being LIST.
+       A copy of the license is included in the section entitled ``GNU
+       Free Documentation License''.
+
+  If you have no Invariant Sections, write "with no Invariant Sections"
+instead of saying which ones are invariant.  If you have no Front-Cover
+Texts, write "no Front-Cover Texts" instead of "Front-Cover Texts being
+LIST"; likewise for Back-Cover Texts.
+
+  If your document contains nontrivial examples of program code, we
+recommend releasing these examples in parallel under your choice of
+free software license, such as the GNU General Public License, to
+permit their use in free software.
+

ADDED   stml2/INSTALL
Index: stml2/INSTALL
==================================================================
--- /dev/null
+++ stml2/INSTALL
@@ -0,0 +1,23 @@
+These are rough installation instructions. Please contact me at matt@kiatoa.com
+if you have trouble installing.
+
+1. Copy install.cfg.template to install.cfg and modify appropriately
+
+2. Copy stml.config.template to your cgi dir as .stml.config and modify appropriately
+    - choose your db
+
+3. Copy requirements.scm.template to requirements.scm and modify as needed
+    - choose your db (must match what you choose in 2. above)
+
+If on 64 bit and you get error in compiling try fPIC:
+
+CSC_OPTIONS='-C "-fPIC"' make
+
+run 
+
+> make 
+
+or 
+
+> CSC_OPTIONS='-C "-fPIC"' make
+

ADDED   stml2/Makefile
Index: stml2/Makefile
==================================================================
--- /dev/null
+++ stml2/Makefile
@@ -0,0 +1,88 @@
+# Copyright 2007-2008, 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.
+#
+# Following needed on bluehost (maybe on all 64bit?)
+#
+# CSC_OPTIONS='-C "-fPIC"' make
+#
+include install.cfg
+
+SRCFILES    = stml2.scm misc-stml.scm session.scm sqltbl.scm formdat.scm setup.scm keystore.scm html-filter.scm cookie.scm 
+MODULEFILES = $(wildcard modules/*/*-mod.scm)
+SOFILES     = $(MODULEFILES:%.scm=%.so)
+CFILES      = $(MODULEFILES:%.scm=%.c)
+OFILES      = $(SRCFILES:%.scm=%.o)
+TARGFILES   = $(notdir $(SOFILES))
+MODULES     = $(addprefix $(TARGDIR)/modules/,$(TARGFILES))
+
+install : $(TARGDIR)/stmlrun $(LOGDIR) $(MODULES)
+	chicken-install
+
+all : $(SOFILES)
+
+# stmlrun : stmlrun.scm formdat.scm  misc-stml.scm  session.scm stml.scm \
+#           setup.scm html-filter.scm requirements.scm keystore.scm \
+#           cookie.scm sqltbl.scm
+# 	csc stmlrun.scm
+
+$(TARGDIR)/stmlrun : stmlrun stml2.so
+	echo "NOTE: CSC_OPTIONS='-C \"-fPIC\"' make"
+	install stmlrun $(TARGDIR)
+	chmod a+rx $(TARGDIR)/stmlrun
+
+$(TARGDIR)/modules :
+	mkdir -p $(TARGDIR)/modules
+
+$(MODULES) : $(SOFILES) $(TARGDIR)/modules
+	cp $< $@
+
+stmlrun : $(OFILES) stmlrun.scm requirements.scm stmlcommon.scm
+	csc $(CSCOPTS) $(OFILES) stmlrun.scm -o stmlrun
+
+stml.so : stmlmodule.so
+	cp stmlmodule.so stml.so
+
+stmlmodule.so : $(OFILES) stmlmodule.scm requirements.scm stmlcommon.scm
+	csc $(CSCOPTS) $(OFILES) -s stmlmodule.scm
+
+# logging currently relies on this
+#
+$(LOGDIR) :
+	mkdir -p $(LOGDIR)
+	chmod a+rwx $(LOGDIR)
+
+test: kiatoa.db cookie.so
+	echo '(exit)'| csi -q  ./tests/test.scm 
+
+# modules
+#
+%.so : %.scm
+	csc $(CSCOPTS) -I modules/* -s $<
+
+%.o : %.scm
+	csc $(CSCOPTS) -c $<
+
+# Cookie is a special case for now. Make a loadable so for test
+# Complile it in by include (see dependencies above).
+cookie.so : cookie.scm
+	csc i$(CSCOPTS) -s cookie.scm
+
+clean :
+	rm -f doc/*~ modules/*/*.so *.import.scm *.import.so *.o *.so *~
+
+# $(CFILES): build/%.c: ../scm/%.scm ../scm/macros.scm
+# 	chicken $< -output-file $@
+# 
+# 
+# $(OFILES): src/%.o: src/%.c
+# 	gcc -c $< `chicken-config -cflags` -o $@
+# 
+# $(src_code): %: src/%.o src/laedlib.o src/layobj.o
+# 	gcc src/$*.o src/laedlib.o src/layobj.o -o $* `chicken-config -libs`
+# 

ADDED   stml2/README
Index: stml2/README
==================================================================
--- /dev/null
+++ stml2/README
@@ -0,0 +1,1 @@
+This is the stml, scheme based cgi application framework. 

ADDED   stml2/TODO
Index: stml2/TODO
==================================================================
--- /dev/null
+++ stml2/TODO
@@ -0,0 +1,22 @@
+1. Documentation. 
+      multiple apps in same cgi dir
+      compilation of models for speed and code protection
+      tricks
+2. Hierarchial pages. Currently pages can be hierarchial but the control.scm 
+   doesn't get called at the right time. 
+3. For sqlite3 usage put session into own db?
+4. A mechanism for sharing variables better between control and view
+   would be good.
+   Perhaps:
+     (let ()
+       (load control)
+       (load view))
+5. Change all the "included" files to be seperately compiled units
+   and adj. makefile accordingly. This would speed up compilation
+   when changes are isolated to one or two files.
+6. The dbi interface needs a simple config mecanism alternative to
+   the current list of pairs which is hard to use on the fly. 
+   Something like the perl:
+     "dbi:host:port:user:password"
+
+I'm sure there is more ...

ADDED   stml2/cookie.scm
Index: stml2/cookie.scm
==================================================================
--- /dev/null
+++ stml2/cookie.scm
@@ -0,0 +1,264 @@
+;;;
+;;; cookie.scm - parse and construct http state information
+;;;  
+;;;   Copyright (c) 2000-2003 Shiro Kawai, All rights reserved.
+;;;   
+;;;   Redistribution and use in source and binary forms, with or without
+;;;   modification, are permitted provided that the following conditions
+;;;   are met:
+;;;   
+;;;   1. Redistributions of source code must retain the above copyright
+;;;      notice, this list of conditions and the following disclaimer.
+;;;  
+;;;   2. Redistributions in binary form must reproduce the above copyright
+;;;      notice, this list of conditions and the following disclaimer in the
+;;;      documentation and/or other materials provided with the distribution.
+;;;  
+;;;   3. Neither the name of the authors nor the names of its contributors
+;;;      may be used to endorse or promote products derived from this
+;;;      software without specific prior written permission.
+;;;  
+;;;   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+;;;   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+;;;   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+;;;   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+;;;   OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+;;;   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
+;;;   TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;;;   PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;;;   LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;;   NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;;   SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+;;;  
+;;;  Ported to Chicken by Reed Sheridan
+;;;
+
+;; Parser and constructor of http "Cookies" defined in
+;; RFC 2965 HTTP state managemnet mechanism
+;;   <ftp://ftp.isi.edu/in-notes/rfc2965.txt>
+;; See also
+;; RFC 2964 Use of HTTP state management
+;;   <ftp://ftp.isi.edu/in-notes/rfc2964.txt>
+;; The parser also supports the old Netscape spec
+;;   <http://www.netscape.com/newsref/std/cookie_spec.html>
+
+;; (declare (unit cookie))
+
+(module cookie
+    *
+
+(import chicken scheme data-structures extras srfi-13 ports posix)
+  
+(require-extension srfi-1 srfi-13 srfi-14 regex)
+;; (use  srfi-1 srfi-13 srfi-14 regex)
+;; (declare (export parse-cookie-string construct-cookie-string))
+
+;; #>
+;; #include <time.h>
+;; <#
+;; 
+;; (define fmt-time
+;;   (foreign-lambda* c-string ((long secs_since_epoch))
+;;     "static char buf[256];"
+;;     "time_t t = (time_t) secs_since_epoch;"
+;;     "strftime(buf, sizeof(buf), \"%a, %d-%b-%Y %H:%M:%S GMT\", gmtime(&t));"
+;;     "return(buf);"))
+
+
+(define (fmt-time seconds)
+   (time->string (seconds->utc-time seconds) "%D"))
+
+ ;; utility fn.  breaks  ``attr=value;attr=value ... '' into alist.
+ ;; version is a cookie version.  if version>0, we allow comma as the
+ ;; delimiter as well as semicolon.
+ (define (parse-av-pairs input version)
+   (define attr-regexp
+     (if (= version 0)
+         (regexp "\\s*([\\w$_-]+)\\s*([=\\;]\\s*)?")
+         (regexp "\\s*([\\w$_-]+)\\s*([=\\;,]\\s*)?")))
+   (define attr-delim
+     (if (= version 0) #\; (char-set #\, #\\ #\;)))
+   
+   (define (read-attr input r)
+     (cond ((string-null? input) (reverse! r))
+           ((string-search attr-regexp input)
+            => (lambda (m)
+                 (if (and-let* ((delimiter (third m))) ;;is an attr_value pai
+ 		      (string-prefix? "=" delimiter))
+                     (let ((attr (second m))
+                           (rest (string-search-after attr-regexp input)))
+                       (if (string-prefix? "\"" rest)
+                           (read-token-quoted attr (string-drop rest 1) r)
+                           (read-token attr rest r)))
+                     (read-attr (string-search-after attr-regexp input) ;; Skip ahead if broken input?
+                                (alist-cons (second m) #f r)))))
+           (else
+            ;; the input is broken; for now, we ignore the rest.
+            (reverse! r))))
+   (define (read-token attr input r)
+     (cond ((string-index input attr-delim)
+            => (lambda (i)
+                 (read-attr (string-drop input (+ i 1))
+                            (alist-cons attr
+ 				       (string-trim-right (string-take input i))
+ 				       r))))
+           (else
+            (reverse! (alist-cons attr (string-trim-right input) r)))))
+   (define (read-token-quoted attr input r)
+     (let loop ((input input)
+                (partial '()))
+       (cond ((string-index input (char-set #\\ #\"))
+              => (lambda (i)
+                   (let ((c (string-ref input i)))
+                     (if (char=? c #\\)
+                         (if (< (string-length input) (+ i 1))
+                             (error-unterminated attr)
+                             (loop (string-drop input (+ i 2))
+                                   (cons* (string (string-ref input (+ i 1)))
+                                          (string-take input i)
+                                          partial)))
+                         (read-attr (string-drop input (+ i 1))
+                                    (alist-cons attr
+ 					       (string-concatenate-reverse
+ 						(cons (string-take input i)
+ 						      partial))
+ 					       r))))))
+             (else (error-unterminated attr)))))
+   (define (error-unterminated attr)
+     (error "Unterminated quoted value given for attribute" attr))
+ 
+   (read-attr input '()))
+ 
+ ;; Parses the header value of "Cookie" request header.
+ ;; If cookie version is known by "Cookie2" request header, it should
+ ;; be passed to version (as integer).  Otherwise, it figures out
+ ;; the cookie version from input.
+ ;;
+ ;; Returns the following format.
+ ;;   ((<name> <value> [:path <path>] [:domain <domain>] [:port <port>])
+ ;;    ...)
+ 
+ (define (parse-cookie-string input #!optional version)
+   (let ((ver (cond ((integer? version) version)
+                    ((string-search "^\\s*\\$Version\\s*=\\s*(\\d+)" input)
+                     => (lambda (m)
+                          (string->number (cadr m))))
+                    (else 0))))
+     (let loop ((av-pairs (parse-av-pairs input ver))
+                (r '())
+                (current '()))
+       (cond ((null? av-pairs)
+              (if (null? current)
+                  (reverse r)
+                  (reverse (cons (reverse current) r))))
+             ((string-ci=? "$path" (caar av-pairs))
+              (loop (cdr av-pairs) r (cons* (cdar av-pairs) path: current)))
+             ((string-ci=? "$domain" (caar av-pairs))
+              (loop (cdr av-pairs) r (cons* (cdar av-pairs) domain: current)))
+             ((string-ci=? "$port" (caar av-pairs))
+              (loop (cdr av-pairs) r (cons* (cdar av-pairs) port: current)))
+             (else
+              (if (null? current)
+                  (loop (cdr av-pairs) r (list (cdar av-pairs) (caar av-pairs)))
+                  (loop (cdr av-pairs)
+                        (cons (reverse current) r)
+                        (list (cdar av-pairs) (caar av-pairs)))))))))
+ 
+ ;; Construct a cookie string suitable for Set-Cookie or Set-Cookie2 header.
+ ;; specs is the following format.
+ ;;
+ ;;   ((<name> <value> [:comment <comment>] [:comment-url <comment-url>]
+ ;;                    [:discard <bool>] [:domain <domain>]
+ ;;                    [:max-age <age>] [:path <value>] [:port <port-list>]
+ ;;                    [:secure <bool>] [:version <version>] [:expires <date>]
+ ;;    ) ...)
+ ;;
+ ;; Returns a list of cookie strings for each <name>=<value> pair.  In the
+ ;; ``new cookie'' implementation, you can join them by comma and send it
+ ;; at once with Set-cookie2 header.  For the old netscape protocol, you
+ ;; must send each of them by Set-cookie header.
+ 
+ 
+ (define (construct-cookie-string specs #!optional (version 1))
+   (map (lambda (spec) (construct-cookie-string-1 spec version))
+        specs))
+ 
+ (define (construct-cookie-string-1 spec ver)
+   (when (< (length spec) 2)
+     (error "bad cookie spec: at least <name> and <value> required" spec))
+   (let ((name (car spec))
+         (value (cadr spec)))
+     (let loop ((attr (cddr spec))
+                (r    (list (if value
+                                (string-append name "="
+                                               (quote-if-needed value))
+                                name))))
+       (define (next s) (loop (cddr attr) (cons s r)))
+       (define (ignore) (loop (cddr attr) r))
+       (cond
+        ((null? attr) (string-join (reverse r) ";"))
+        ((null? (cdr attr))
+         (error (conc "bad cookie spec: attribute " (car attr) " requires value" )))
+        ((eqv? comment: (car attr))
+         (if (> ver 0)
+ 	    (next (string-append "Comment=" (quote-if-needed (cadr attr))))
+             (ignore)))
+        ((eqv? comment-url: (car attr))
+         (if (> ver 0)
+             (next (string-append "CommentURL=" (quote-value (cadr attr))))
+             (ignore)))
+        ((eqv? discard: (car attr))
+         (if (and (> ver 0) (cadr attr)) (next "Discard") (ignore)))
+        ((eqv? domain: (car attr))
+         (next (string-append "Domain=" (cadr attr))))
+        ((eqv? max-age: (car attr))
+         (if (> ver 0)
+             (next (sprintf "Max-Age=~a" (cadr attr)))
+             (ignore)))
+        ((eqv? path: (car attr))
+         (next (string-append "Path=" (quote-if-needed (cadr attr)))))
+        ((eqv? port: (car attr))
+         (if (> ver 0)
+             (next (string-append "Port=" (quote-value (cadr attr))))
+             (ignore)))
+        ((eqv? secure: (car attr))
+         (if (cadr attr) (next "Secure") (ignore)))
+        ((eqv? version: (car attr))
+         (if (> ver 0)
+             (next (sprintf "Version=~a" (cadr attr)))
+             (ignore)))
+        ((eqv? expires: (car attr))
+         (if (> ver 0)
+             (ignore)
+             (next (make-expires-attr (cadr attr)))))
+        (else (error "Unknown cookie attribute" (car attr))))
+       ))
+   )
+ 
+ 
+ ;; (define (quote-value value)
+ ;;   (string-append "\"" (regexp-replace-all #/\"|\\/ value "\\\\\\0") "\""))
+ 
+ (define (quote-value value)
+   (string-append "\"" (string-substitute* value '(("\\\"" . "\\\"") ("\\\\" . "\\\\"))) "\""))
+ 
+ (define quote-if-needed
+   (let ((rx (regexp "[\\\",;\\\\ \\t\\n]")))
+     (lambda (value)
+       (if (string-search rx value)
+ 	  (quote-value value)
+ 	  value))))
+ 
+ (define (make-expires-attr time)
+   (sprintf "Expires=~a"
+ 	   (if (number? time)
+ 	       (fmt-time time)
+ 	       time)))
+ 
+ ;;;; Added support functions from my utils, split this out
+ 
+ (define (string-search-after r s #!optional (start 0))
+   (and-let* ((match-indices (string-search-positions r s start))
+ 	     (right-match (second (first match-indices))))
+     (substring s right-match)))
+)

ADDED   stml2/doc/Makefile
Index: stml2/doc/Makefile
==================================================================
--- /dev/null
+++ stml2/doc/Makefile
@@ -0,0 +1,7 @@
+all : manual.pdf web-page.html
+
+manual.pdf : manual.txt
+	a2x -a toc -f pdf manual.txt
+	# asciidoc -a toc plan.txt
+	a2x -f chunked -a toc manual.txt
+

ADDED   stml2/doc/howto.txt
Index: stml2/doc/howto.txt
==================================================================
--- /dev/null
+++ stml2/doc/howto.txt
@@ -0,0 +1,177 @@
+Gotchas!
+=======
+
+All items for a page *must* be part of a list!
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+   OK:     (list (function1 param1)(function2 param2))
+   NOT OK: (begin (function1 param1)(function2 param2))
+
+
+Various components
+~~~~~~~~~~~~~~~~~~
+
+The URL:
+
+http://the.domain.com/pagename/p1/p2/p3?param1=value1
+
+(s:get-page-params) => '("p1" "p2")
+
+(s:get-param 'param1) => "value1"
+(s:get-param 'param1 'number) => number or #f 
+
+NOTE: it is often practical to use the generic (s:get-inp ...) which
+      will first look for the POST input variable and then fall back
+      to the GET param. This allows one to switch back and forth
+      between GET and POST during development without changing the code.
+
+(s:get-inp 'param1)  ;; trys to find input by name of param1, followed by trying get-param
+
+Create a link.
+~~~~~~~~~~~~~~
+
+(s:a name 'href 
+    (s:link-to "pagename/blah" ""))
+
+Call current page with new param
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+In view.scm:
+
+ (s:center "[" (s:a 'href (s:link-to "polls"
+                           'id
+                            (begin
+                              (poll:poll 'fill-polls)
+                              (poll:poll 'get-next-poll)))
+                          "Go to the next poll")  "]")
+
+In control.scm:
+
+(let ((poll-id (s:get-param 'id)))
+ ;; do stuff based on poll-id
+
+
+Call an action on a specific page
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+ (s:a 'href (s:link-to "polls" 'id (poll:poll 'get 'id) 
+			       'action "poll.edit")
+            "Suggest changes to this poll")
+
+ NOT TRUE! This calls fuction poll.edit (should be in control.scm). Parameter set is 'id to a poll num.
+
+
+A complex link example
+~~~~~~~~~~~~~~~~~~~~~~
+
+(s:a "Reply" 'href (s:link-to (s:current-page) 
+	           'action "discussion.reply" ;; <page>.<action>
+	           'reply_to (number->string (hash-table-ref row 'posts.id)) 
+	           'id (s:get "discussion.parent_object_id")) "reply")
+
+;; use (s:get-param to get the 'id, or 'reply_to values
+
+
+Get and set a session var
+~~~~~~~~~~~~~~~~~~~~~~~~~
+
+(s:session-var-get "keyname")
+(s:session-var-get "keyname" 'number) 
+(s:session-var-set! "keyname" "value")
+
+5.1 Page local vars
+
+(s:set! key val)
+(s:get key)
+
+
+make a selection drop down
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+;; items is a hierarchial alist
+;; ( (label1 value1 dispval1 #t) ;; <== this one is selected
+;;   (label2 (label3 value2 dispval2)
+;;           (label4 value3 dispval3)))
+
+In view.scm: 
+
+;;                                   Label   Value visible-str selected
+(s:select '(("World" 0)("Country" 1)("State" 2     "The state" #t       )("Town/City" 3)) 'name 'scope)
+
+Visible str will be shown if provided. Selected will set that entry to pre-selected.
+
+To select a specific entry:
+
+(s:select '(("World" 0 "world" #f)("Country" 1 "country" #t)("State" 2 "state" #f)("Town/City" 3 "town" #f)) 'name 'scope)
+
+In control.scm:
+
+(let ((scope     (s:get-input 'scope))
+      (scope-num (s:get-input 'scope 'number))) ;; 'number, 'raw or 'escaped
+  ....
+
+The optional fourth entry sets that item as selected if true
+
+Simple error reporting
+~~~~~~~~~~~~~~~~~~~~~~
+
+In control.scm:
+(s:set-err "You must provide an email address")
+
+In view.scm:
+(s:get-err s:err-font)
+
+Or:
+(s:get-err (lambda (x)(s:err-font x (s:br))))
+
+
+Sharing data between pages
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+NOTE: This data is *not* preserved between cgi calls.
+
+;; In first page called
+(s:shared-set! "somekey" somevalue)
+
+;; In a page called later
+(let ((dat (s:shared-get "somekey")))
+  ( .... ))
+
+
+Misc useful stuff
+~~~~~~~~~~~~~~~~~
+
+  i. Lazy/safe string->number 
+
+(s:any->number val)
+
+  ii. Random string
+
+(session:make-rand-string len)
+
+ iii. string to number for pgint
+ 
+(s:any->pgint val)
+
+
+Forms and input
+~~~~~~~~~~~~~~~
+
+(s:form 'action "login.login" 'method "post"
+   (s:input-preserve 'type "text" 'name "email-address" 'size "16" 'maxlength "30")
+   (s:input 'type "submit"   'name "form-name" 'value "login"))
+
+(s:get-input 'email-address)
+
+To preserve the input simply do a set of the value on the 'name field:
+(s:set! "email-address" "matt@kiatoa.com")
+
+Radio buttons:
+
+	(s:div 'class "col_3"
+		       (s:input 'type "radio" 'id "group-type1" 'name "group-type" 'value "private" 'checked "checked")
+		       (s:label 'for "group-type1" 'class "inline" "Private")
+		       (s:input 'type "radio" 'id "group-type2" 'name "group-type" 'value "public")
+		       (s:label 'for "group-type2" 'class "inline" "Public"))
+
+       (s:get-input 'group-type) ==> returns private or public depending on which is selected.

ADDED   stml2/doc/manual.txt
Index: stml2/doc/manual.txt
==================================================================
--- /dev/null
+++ stml2/doc/manual.txt
@@ -0,0 +1,56 @@
+STML User Manual
+================
+Matt Welland <matt@kiatoa.com>
+v1.0, 2012-6
+
+NOT DONE YET! :( sorry.
+
+:numbered!:
+[abstract]
+Example Abstract
+----------------
+
+Yada about stml
+
+:numbered:
+
+User Data Specification
+-----------------------
+
+.User Data
+[width="100%",options="header",cols="<s,2m,2e,2e,2e",frame="topbot"]
+|==============================
+| Field            | Field Template    |Short form| Example                              | Description
+| Likes            | :likes            |:l        | :likes rock, jazz, blues             | List of things liked, used to narrow down music liked etc.
+|==============================
+
+.Example stuff
+-----------------------------
+stuff eh
+-----------------------------
+
+// -----------------------
+
+<<<<<<<<<<<<<<<<<
+
+Plan
+----
+
+Today
+~~~~~
+
+. Nothing scheduled
+
+Done Stuff
+~~~~~~~~~~
+
+Phase 3
+~~~~~~~
+
+. Error printing with debug levels
+. Complete the manual
+. Get working with Chromium, test with Internet Explorer and other browsers
+
+Notes
+-----
+

ADDED   stml2/doc/stml-snapshot.png
Index: stml2/doc/stml-snapshot.png
==================================================================
--- /dev/null
+++ stml2/doc/stml-snapshot.png
cannot compute difference between binary files

ADDED   stml2/example/Makefile
Index: stml2/example/Makefile
==================================================================
--- /dev/null
+++ stml2/example/Makefile
@@ -0,0 +1,26 @@
+# Copyright 2007-2008, 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.
+
+# Uncomment and fix path if you want your models to be compiled
+#
+MODELS := $(wildcard models/*scm)
+SOFILES := $(patsubst %.scm,%.so,$(MODELS))
+
+
+# all : $(SOFILES)
+
+# If you want compiled models uncomment the following
+#
+# $(SOFILES) : %.so: %.scm
+#	csc -s $<
+
+test: # $(SOFILES)
+	echo '(exit)'| csi -q  ./tests/test.scm 
+
+# cgi-util proplist cgi-util cookie

ADDED   stml2/example/POLICY
Index: stml2/example/POLICY
==================================================================
--- /dev/null
+++ stml2/example/POLICY

ADDED   stml2/example/README
Index: stml2/example/README
==================================================================
--- /dev/null
+++ stml2/example/README
@@ -0,0 +1,3 @@
+This is an (unfinished) example application. 
+
+To see it live go to: www.approvalvote.org

ADDED   stml2/example/TODO
Index: stml2/example/TODO
==================================================================
--- /dev/null
+++ stml2/example/TODO
@@ -0,0 +1,2 @@
+
+

ADDED   stml2/example/db/db-tweaks.sql
Index: stml2/example/db/db-tweaks.sql
==================================================================
--- /dev/null
+++ stml2/example/db/db-tweaks.sql
@@ -0,0 +1,172 @@
+>-- create table polls(id serial not null,poll_type text,title text,description text,poll_state text);
+-- create table poll_categories(id serial not null,poll_id integer,description text);
+-- create table poll_votes(id serial not null,period integer,poll_type text,poll_category text,voter_group integer, votes integer);
+
+-- create table vote_items (id serial primary key,type integer,item_id integer,item_level text,town_votes integer,state_votes integer,country_votes integer,world_votes integer);
+-- 
+-- alter table vote_items alter column town_votes set default 0;
+-- alter table vote_items alter column state_votes set default 0;
+-- alter table vote_items alter column country_votes set default 0;
+-- alter table vote_items alter column world_votes set default 0;
+-- 
+-- alter table poll_items add column class_0 int4;
+-- alter table poll_items add column class_1 int4;
+-- alter table poll_items add column class_2 int4;
+-- 
+-- alter table poll_items add column classp_0 int4;
+-- alter table poll_items add column classp_1 int4;
+-- alter table poll_items add column classp_2 int4;
+-- 
+-- alter table poll_items alter column classp_0 set default 0;
+-- alter table poll_items alter column classp_1 set default 0;
+-- alter table poll_items alter column classp_2 set default 0;
+-- 
+-- alter table poll_items add column suggestor int4;
+-- 
+-- alter table poll_items alter column class_0 set default 0;
+-- alter table poll_items alter column class_1 set default 0;
+-- alter table poll_items alter column class_2 set default 0;
+-- 
+-- alter table poll_items add column status int4;
+-- alter table poll_items alter column status set default 0;
+
+-- alter table poll_items add column url text;
+-- alter table vote_items add column submit_date date;
+-- alter table poll_items add column submit_date date;
+
+-- alter table people add column pt_balance int4;
+-- alter table people alter column pt_balance set default 0;
+
+-- alter table people add column cert_date date;
+-- alter table people alter column pt_balance set default 0;
+
+-- create table pt_transactions (id serial not null,from_id integer,to_id integer,amount integer,transaction_time timestamp);
+-- alter table pt_transactions alter column amount set default 0;
+
+-- alter table classifieds add column points int4;
+-- alter table classifieds alter column points set default 0;
+
+-- alter table pt_transactions add column comment text;
+-- alter table pt_transactions add column comment text;
+
+-- create table temp_key(id serial not null,key  text,sent_date date);
+-- alter table people add column lastlogin timestamp;
+
+-- create table pictures(id serial not null,owner integer,size integer,name  text,type text,md5sum text,uploaded date);
+-- alter table pictures add column status text;
+
+-- create table pic_allocation(id serial not null,picnum integer,used_by integer);
+
+-- alter table posts add column url text;
+-- alter table posts add column blurb text;
+
+insert into subjects (subjectid,subject,item_type,description) values('VoSp','Spanish','lang','Basic Spanish Vocabulary');
+insert into subjects (subjectid,subject,item_type,description) values('HoMe','Homeopathy','Info','Basic Homeopathy');
+
+alter table items add column group_name text;
+alter table items add column state int4;
+
+create table sessions (id serial not null,session_key text);
+create table session_vars (id serial not null,session_id integer,page text,key text,value text);
+
+alter table poll_items add column num_voted  integer default 0;
+alter table poll_items add column vote_tot   integer default 0;
+alter table poll_items add column item_votes integer default 0;
+
+-- remember ballots are used for many things other than polls!!!!!!!!
+create table ballots (id serial not null, item_id integer, class_id integer, votes integer, type_id integer);
+create table ballot_classes (id serial not null, name text, pts_per_vote integer); -- join with ballots to sum up votes (pts are really votes)
+insert into ballot_classes values (0,'',1);
+insert into ballot_classes values (1,'',2);
+insert into ballot_classes values (2,'',10);
+insert into ballot_classes values (3,'',20);
+insert into ballot_classes values (4,'',45);
+insert into ballot_classes values (5,'',90);
+insert into ballot_classes values (6,'',105);
+insert into ballot_classes values (7,'',145);
+insert into ballot_classes values (8,'',205);
+insert into ballot_classes values (9,'',245);
+
+create table ballot_types (id serial not null, name text);                         -- poll plurality = 0, poll approval = 1
+insert into ballot_types (id,name) values (0,'poll plurality');
+insert into ballot_types (id,name) values (1,'poll approval');
+
+alter table voted add column type_id integer;
+alter table voted add column id serial not null;
+create table voted_types (id serial not null, name text);
+insert into voted_types (id, name) values (0, 'poll vote');                -- YES!!! WE DO NEED voted_types SEPERATE FROM ballot_types
+insert into voted_types (id, name) values (1, 'council vote for poll');    -- yes, they are similar but I think combining them would be
+insert into voted_types (id, name) values (2, 'council vote for item');    -- painful.
+insert into voted_types (id, name) values (3, 'council vote for story');
+
+alter table people add column email_validated integer default 0;  -- has email been validated? Hmmm... should this be a seperate table
+alter table people add column grade integer default 0;            -- 
+
+alter table voted add column grade integer default 0;
+
+-- grade
+-- 
+-- 0 - no status (refusing cookies)
+-- 1 - has session
+-- 2 - logged in, has user id
+-- 3 - email validated
+-- 4 ++ add 1 for every 20 points of cert_level
+
+alter table poll_items drop column class_0  ;
+alter table poll_items drop column class_1  ;
+alter table poll_items drop column class_2  ;
+alter table poll_items drop column classp_0 ;
+alter table poll_items drop column classp_1 ;
+alter table poll_items drop column classp_2 ;
+alter table poll_items drop column votes    ;
+alter table poll_items drop column vote_tot ;
+alter table poll_items drop column num_voted;
+
+alter table poll_items add column a_vote_tot integer default 0; -- approval  votes total
+alter table poll_items add column p_vote_tot integer default 0; -- plurality votes total
+
+alter table people alter column num set default 0;
+alter table polls add column discussion_id integer default 0;
+
+create table poll_status (id serial not null, name text);
+insert into poll_status (id,name) values (0, 'In queue'); -- just posted and in queue
+insert into poll_status (id,name) values (1, 'Posted');   -- published to discussion
+
+-- fix default cert_level
+alter table people alter column cert_level set default 0;
+update people set cert_level=0 where cert_level is NULL;
+
+create table discussions (id serial not null,type_id integer,activity_state integer);
+update posts set thread=id where parent=0; -- was this necessary?
+
+insert into discussions select id,0,1 from posts where parent=0;
+
+-- ======================================================================
+-- New council stuff
+--======================================================================
+
+create table councils (id serial not null, name text, discussion_id integer default 0);
+alter table  council_members add column join_date date;
+
+-- DONE ON TANG UP TO HERE
+
+--======================================================================
+-- New locations table
+--======================================================================
+
+create table locations
+         (id serial not null, parent_id integer default 0, 
+          council_id integer,nick text, fullname text, 
+          level_id integer, blurb text, pict_id integer);
+insert into locations(council_id,nick,fullname,level_id,blurb)
+    values(0,'','World',0,'Our beloved Planet Earth');
+insert into locations(council_id,nick,fullname,level_id,blurb)
+    values(1,'us','United States',1,'The Land of the Free');
+insert into locations(parent_id,council_id,nick,fullname,level_id,blurb)
+    values(1,2,'az','Arizona',2,'It''s a dry heat');
+
+drop table location;
+drop table towns;
+drop table states;
+drop table neighborhoods ;
+drop table countries;

ADDED   stml2/example/db/dump_db
Index: stml2/example/db/dump_db
==================================================================
--- /dev/null
+++ stml2/example/db/dump_db
@@ -0,0 +1,1 @@
+pg_dump -d kiatoa | grep -v 'INSERT INTO session_vars' | grep -v 'INSERT INTO sessions' > Kiatoa.sql

ADDED   stml2/example/docs/Setup-notes.txt
Index: stml2/example/docs/Setup-notes.txt
==================================================================
--- /dev/null
+++ stml2/example/docs/Setup-notes.txt
@@ -0,0 +1,15 @@
+1) add:
+
+host    all         all         192.168.1.1/32        password
+
+to the bottom of /etc/postgresql/8.2/main/pg_hba.conf
+
+2)
+
+ln -s /home/matt/kiatoa/kiatoa-scm/kiatoa /var/www
+
+3) copy/update the stml.conf file
+
+sudo cp stml.conf.template /usr/lib/cgi-bin/.stml.conf
+sudo vi /usr/lib/cgi-bin/.stml.conf
+

ADDED   stml2/example/docs/comments.txt
Index: stml2/example/docs/comments.txt
==================================================================
--- /dev/null
+++ stml2/example/docs/comments.txt
@@ -0,0 +1,20 @@
+
+If we had any at all of the alternative voting ideas like instant runoff, Condorcet, any of them, I think it might make the whole process better
+
+My thought was to get people familiar with approval voting, then get people to pledge only to vote for a candidate if that candidate supported approval voting. I put the beginings of a site together here: http://approvalvote.org but stopped working on it because I decided not to push the idea for this election. Morally, in my opinion, letting the neocons in for another term is unacceptable, I suspect (but don't know) that McCain is a participant of the neocon movement. Since these elections can hinge on a few hundreds of votes I thought it wasn't worth even the infintesimal risk of any activity that would get people thinking about the alternatives to the top two pulling votes away from Obama. I did think of pushing the idea in venues dominated by interest in Ron Paul but there was some beer in the fridge and, well, you can guess the rest of that story.
+
+Although the current implementation needs major rework I do think the idea has potential.
+
+   1. Get people to experience plurality vs approval voting. IMHO once you've tried it going back to plurality is actually quite uncomfortable.
+   2. Get people to pledge to vote only for candidates that support approval voting.
+   3. Get candidates to address approval voting.
+
+Now why approval and not Condorcet, range, IRV or any one of the dozens of other voting techniques?
+
+   1. Approval is 100% doable using existing election machines
+   2. Approval is highly resistant to any meaningful strategic voting.
+   3. Approval is easy for the end users. Go try doing some condorcet or IRV ranked voting. It is really tedious.
+   4. IRV is *worse* than Plurality in its vunerablity to strategic voting.
+   5. Condorcet is too hard to grok for most folks. I knew once how it worked but couldn't explain it to someone right now for the life of me.
+
+In short the marginal improvement of the more complex voting solutions over approval doesn't buy much.

ADDED   stml2/example/example/layout.css
Index: stml2/example/example/layout.css
==================================================================
--- /dev/null
+++ stml2/example/example/layout.css
@@ -0,0 +1,244 @@
+
+/*-General-----------------------------------------------*/
+
+html, body {
+	margin:0px;
+	padding:0px;
+}
+
+form {
+	display:inline;
+	margin:0px;
+	padding:0px;
+}
+
+a img {
+	border:none;
+	margin:0px;
+	padding:0px;
+}
+
+h1, h2, h3, h4, h5, h6, p, div {
+	margin:0px;
+	padding:0px;
+}
+
+.right {
+	float:right;
+}
+
+.left{
+	float:left;
+}
+
+/*-Main Layout-------------------------------------------*/
+
+#overall {
+	margin:5px 12px 0px 12px;
+	padding:0px;
+}
+
+/*-Header-------------*/
+
+.header {
+	position:relative;
+	height:90px;
+}
+
+/*-Footer-------------*/
+
+.footer {
+	padding:40px 0px 0px 0px;
+	position:relative;
+	clear:both;
+}
+
+/*-Content Area-------*/
+
+.content {
+	width:100%;
+}
+
+/*-Left Column--------*/
+
+.leftcolumn	{
+  float:left;
+  width:145px;
+  margin:5px;
+}
+
+.leftcolumn .node {
+	margin:0px 0px 15px 0px;
+}
+
+.leftcolumn .node h1 {
+	padding:0px 0px 0px 3px;
+}
+
+.leftcolumn .node ul {
+	margin:0px;
+	padding:0px;
+}
+
+.leftcolumn .node li {
+	display:block;
+	padding:0px 0px 0px 3px;
+	margin:0px;
+}
+
+.leftcolumn .node li.more{
+	padding:0px 0px 0px 6px;
+}
+
+/*-Center Column------*/
+
+.centercolumn {
+        margin: 5px;
+	margin-left:152px;
+        margin-right:200px;
+	font-family:"\"}\"";
+	font-family:inherit;
+}
+
+.centercolumn .node h1 {
+	padding: 0px 0px 0px 13px;
+}
+
+.centercolumn .node h4 {
+	margin: 15px 0px 10px 0px;
+}
+
+.centercolumn .node p {
+	margin: 0px 0px 10px 0px; */
+	padding: 0px 0px 0px 0px;
+}  /* this seemed not to work */
+
+.posts_0  {
+	margin: 0px 0px 0px 0px;
+}
+
+.posts_1  {
+	margin: 0px 0px 0px 20px;
+}
+
+.posts_2  {
+	margin: 0px 0px 0px 40px;
+}
+
+.posts_3  {
+	margin: 0px 0px 0px 60px;
+}
+
+.posts_4  {
+	margin: 0px 0px 0px 80px;
+}
+
+.posts_5  {
+	margin: 0px 0px 0px 100px;
+}
+
+.posts_6  {
+	margin: 0px 0px 0px 120px;
+}
+
+.posts_7  {
+	margin: 0px 0px 0px 140px;
+}
+
+.posts_8  {
+	margin: 0px 0px 0px 160px;
+}
+
+.posts_9  {
+	margin: 0px 0px 0px 160px;
+}
+
+.posts_10  {
+	margin: 0px 0px 0px 180px;
+}
+
+/*-Right Column-------*/
+
+.rightcolumn {
+	float:right;
+        width:190px;
+	margin:5px 5px 0px 0px;
+}
+
+* html .rightcolumn {
+	margin:3px 3px 3px 3px;
+}
+
+body>div .rightcolumn {
+	margin:0px 0px 0px 0px;
+}
+
+.rightcolumn .node {
+	margin:0px 0px 5px 0px;
+	padding:0px;
+}
+
+.rightcolumn .node h2 {
+	margin:3px 3px 3px 2px;
+}
+
+.rightcolumn .node ul {
+  list-style-position:inside;
+  margin:0px;
+  padding:1px;
+}
+
+.rightcolumn .node ul.none {
+	list-style-position:inside;
+}
+
+.rightcolumn .node ul.dot {
+	list-style-position:inside;
+}
+
+.rightcolumn .node ul.books {
+	list-style-position:outside;
+	margin:0px 0px 0px 35px;
+}
+
+.rightcolumn .node li {
+	padding:0px 0px 0px 3px;
+	margin:0px;
+}
+
+/*-Remaining layout--------------------------------------*/
+
+#title {
+	top: 0px;
+	left: 0px;
+	position: absolute;
+}
+
+#search {
+	float:left;
+	margin:0px 0px 0px 30px;
+}
+
+#randomquote {
+	float:right;
+	margin:0px 30px 0px 0px;
+}
+
+#copyright {
+	text-align:center;
+	padding:15px 0px 0px 0px;
+	margin:0px 0px 0px 0px;
+	clear:both;
+}
+
+#bottomNav {
+	text-align:center;
+	margin:0px 0px 20px 0px;
+	padding:0px;
+}
+
+#oldStuffNav {
+	font-weight:bold;
+	text-align:right;
+}
+

ADDED   stml2/example/example/markup.css
Index: stml2/example/example/markup.css
==================================================================
--- /dev/null
+++ stml2/example/example/markup.css
@@ -0,0 +1,299 @@
+/*-General-----------------------------------------------*/
+
+body {
+  background-color:#ffffff;
+  color:#0f0f0f;
+  font-family:serif;
+  font-weight:normal;
+  text-decoration:none; 
+/*  font-size:x-small; */
+  voice-family:"\"}\"";
+  voice-family:inherit;
+  font-size:small;
+}
+
+html>body {
+  font-size:small;
+}
+
+.strong {
+  font-weight:bold;
+}
+
+#red { 
+  color: #ff0000
+}
+
+/*-Main Markup-------------------------------------------*/
+
+#overall {
+  background-color: #ffffff;
+  color:#000000;
+}
+
+/*-Left Column--------*/
+
+.leftcolumn .node a {
+  color:#006666;
+  background-color:transparent;
+}
+
+.leftcolumn .node p {
+  font-size:1.2em;
+  font-weight:normal;
+}
+
+.leftcolumn .node h1 {
+  font-weight:normal;
+  font-size:1.2em;
+  color:#ffffff;
+  background-color:#000000; /* #005991;  #7f9bff #006666; */
+}
+
+.leftcolumn .node h1 a {
+  color:#ffffff;
+  background-color:transparent;
+}
+
+.leftcolumn .node h2 {
+  font-weight:bold;
+  font-size:.95em;
+}
+
+.leftcolumn .node ul {
+  list-style-type:none;
+}
+
+.leftcolumn .node li.more {
+  font-weight:bold;
+  font-size:.75em;
+}
+
+.leftcolumn .node li.selected {
+  font-weight:bold;
+  font-size:1.18em;
+  color:#000000;
+  background-color:#cccccc;
+}
+
+.leftcolumn .node li.selected a {
+  color:#000000;
+  background-color:transparent;
+}
+
+/*-Center Column for classifieds-*/
+
+.centercolumn .classifieds h1 { 
+  font-family:Arial, Helvetica, serif;
+  font-weight:bold;
+  font-size:1.38em;
+  color:#000000; /* ffffff; */
+  background: #5390b7; /* a6bcac; #0c1e0f; 043b0d; 1a6126; */
+}
+
+/*-Center Column------*/
+.centercolumn .node {
+  font-family:serif;
+}
+
+.centercolumn .node a {
+  color:#006666;
+  background-color:transparent;
+}
+
+.centercolumn .node h1 {
+  font-family:Arial, Helvetica, serif;
+  font-weight:bold;
+  font-size:1.38em;
+  color:#ffffff;
+  background:#000000; /* #005991; */
+} /* #006666 /* url('../images/slc.gif') no-repeat; */
+     
+.centercolumn .node h1 a {
+  color:#ffffff;
+  background-color:transparent;
+}
+
+.centercolumn .node h2 {
+  font-weight:bold;
+  font-size:1.18em;
+}
+
+.centercolumn .node h3 {
+  font-weight:bold;
+  font-size:.95em;
+}
+
+.centercolumn .node h4 {
+  font-weight:normal;
+  font-size:1.2em;
+}
+
+.centercolumn .node h4 a {
+  font-weight:bold;
+}
+
+.centercolumn .node p {
+  font-weight:normal;
+}
+
+.centercolumn .posts_0 h1 { 
+  color:#ffffff;
+  background-color:#606060;
+  font-size:1.18em;
+}
+
+.centercolumn .posts_1 h1 { 
+  color:#ffffff;
+  background-color:#606060;
+  font-size:1.18em;
+}
+
+.centercolumn .posts_2 h1 { 
+  color:#ffffff;
+  background-color:#606060;
+  font-size:1.18em;
+}
+
+.centercolumn .posts_3 h1 { 
+  color:#ffffff;
+  background-color:#606060;
+  font-size:1.18em;
+}
+
+.centercolumn .posts_4 h1 { 
+  color:#ffffff;
+  background-color:#606060;
+  font-size:1.18em;
+}
+
+.centercolumn .posts_5 h1 { 
+  color:#ffffff;
+  background-color:#606060;
+  font-size:1.18em;
+}
+
+.centercolumn .posts_6 h1 { 
+  color:#ffffff;
+  background-color:#606060;
+  font-size:1.18em;
+}
+
+.centercolumn .posts_7 h1 { 
+  color:#ffffff;
+  background-color:#606060;
+  font-size:1.18em;
+}
+
+.centercolumn .posts_8 h1 { 
+  color:#ffffff;
+  background-color:#606060;
+  font-size:1.18em;
+}
+
+.centercolumn .posts_9 h1 { 
+  color:#ffffff;
+  background-color:#606060;
+  font-size:1.18em;
+}
+
+.centercolumn .posts_10 h1 { 
+  color:#ffffff;
+  background-color:#606060;
+  font-size:1.18em;
+}
+
+/*-Right Column-------*/
+
+.rightcolumn .node {
+  color:#000000;
+  background-color:#cccccc;
+  font-family:serif;
+}
+
+.rightcolumn .node a {
+  color:#000000; /* #005991;  #006666; */
+  background-color:transparent;
+}
+
+.rightcolumn .node h1 {
+  font-family:Arial, Helvetica, serif;
+  font-weight:bold;
+  font-size:0.95em; /* 1.38em; */
+  color:#ffffff;
+  background-color: #000000; /* #005991;  #006666; */
+}
+
+.rightcolumn .node h1 a {
+  color:#ffffff;
+  background-color:transparent;
+}
+
+.rightcolumn .node h2 {
+  font-weight:bold;
+  font-size:.95em;
+}
+
+.rightcolumn .node ul.none {
+  list-style-type:none;
+}
+
+.rightcolumn .node ul.dot {
+  list-style-type:none;
+  /* list-style-image:url('../images/listdot.gif'); */
+}
+
+.rightcolumn .node ul.books {
+  list-style-type:disc;
+}
+
+/*-OSDN Navagation bar-----------------------------------*/
+
+#OSDNNavbar {
+  background-color:#999999;
+  color:#000000; /* #005991; /* #006666; */
+}
+
+#OSDNNavbar div#links {
+  background-color:#999999;
+  color:#000000; /* #005991; /* #006666; */
+}
+
+#OSDNNavbar a {
+  background-color: transparent;
+  color: #000000; /* #005991; /* #006666; */
+}
+
+/*-Remaining layout--------------------------------------*/
+
+#randomquote {
+  font-size:1.2em;
+  font-style:italic;
+}
+
+#copyright {
+  font-size:.75em;
+  font-family:Arial, Helvetica, serif;
+  background-color:transparent;
+  color:#000000; /* #005991; /* #006666; */
+}
+
+#copyright a {
+  background-color:transparent;
+  color:#000000; /* #005991; /* #006666; */
+}
+
+#bottomNav {
+  background-color:transparent;
+  color:#000000; /* #005991; /* #006666; */
+}
+
+#bottomNav a {
+  background-color:transparent;
+  color:#ffffff;
+}
+
+#oldStuffNav {
+  font-weight:bold;
+}
+

ADDED   stml2/example/models/candidate.scm
Index: stml2/example/models/candidate.scm
==================================================================
--- /dev/null
+++ stml2/example/models/candidate.scm
@@ -0,0 +1,67 @@
+;; Copyright 2007-2008, Matthew Welland. matt@kiatoa.com All rights reserved.
+;; 
+;; models/candidates.scm
+;;
+
+(define (candidate:get-top n)
+  (dbi:get-rows 
+   (s:db) 
+   "SELECT DISTINCT id,name,url,party,desc,supports_av,date_added,score,pscore FROM candidates AS c ORDER BY score DESC LIMIT ?;" n))
+
+;; HERE !!!! getting vote counts... DONT'USE- SEE VOTED INSTEAD
+(define (candidate:get-votes candidates vote_type)
+  (let ((ids (map (lambda (c)(candidate:get-id c)) candidates)))
+    (dbi:get-rows (s:db)
+		  (conc
+		   "SELECT id,sum(votes*(1+score)) WHERE vote_date>"
+		   (- (current-time) (* 24 60 60 7)) ;; seven days
+		   " AND id IN "
+		   (apply conc (intersperse ids ","))))))
+		   
+(define (candidate:get-by-name name)
+  (dbi:get-one-row (s:db) "SELECT id,name,url,party,desc,supports_av,date_added,score,pscore FROM candidates WHERE name=?;" name))
+
+;; update an existing candidate or create if new
+(define (candidate:update dat)
+  (let* ((name   (candidate:get-name dat))
+	 (olddat (candidate:get-by-name name)))
+    (if olddat
+	(begin
+	  (dbi:exec (s:db) 
+		    "UPDATE candidates SET url=?,party=?,desc=?,supports_av=? WHERE name=?;"
+		    (candidate:get-url   dat)
+		    (candidate:get-party dat)
+		    (candidate:get-desc  dat)
+		    (candidate:get-supports-av dat)
+		    name)
+	  (candidate:get-by-name name))
+	(begin
+	  (dbi:exec (s:db)
+		    "INSERT INTO candidates (name,url,party,desc,supports_av) VALUES(?,?,?,?,?);"
+		    name
+		    (candidate:get-url   dat)
+		    (candidate:get-party dat)
+		    (candidate:get-desc  dat)
+		    (candidate:get-supports-av dat))
+	  (candidate:get-by-name name)))))
+
+
+(define (candidate:get-id           dat)(vector-ref dat 0)) 
+(define (candidate:get-name         dat)(vector-ref dat 1)) 
+(define (candidate:get-url          dat)(vector-ref dat 2))
+(define (candidate:get-party        dat)(vector-ref dat 3))
+(define (candidate:get-desc         dat)(vector-ref dat 4))
+(define (candidate:get-supports-av  dat)(vector-ref dat 5))
+(define (candidate:get-date-added   dat)(vector-ref dat 6))
+(define (candidate:get-score        dat)(vector-ref dat 7))
+(define (candidate:get-pscore       dat)(vector-ref dat 8))
+
+(define (candidate:set-id!          dat val)(vector-set! dat 0 val)) 
+(define (candidate:set-name!        dat val)(vector-set! dat 1 val)) 
+(define (candidate:set-url!         dat val)(vector-set! dat 2 val))
+(define (candidate:set-party!       dat val)(vector-set! dat 3 val))
+(define (candidate:set-desc!        dat val)(vector-set! dat 4 val))
+(define (candidate:set-supports-av! dat val)(vector-set! dat 5 val))
+(define (candidate:set-date-added!  dat val)(vector-set! dat 6 val))
+(define (candidate:set-score!       dat val)(vector-set! dat 7 val))
+

ADDED   stml2/example/models/maint.scm
Index: stml2/example/models/maint.scm
==================================================================
--- /dev/null
+++ stml2/example/models/maint.scm
@@ -0,0 +1,57 @@
+;; Copyright 2007-2008, Matthew Welland. matt@kiatoa.com All rights reserved.
+;; 
+;; maint/control.scm
+;;
+
+;; evolve your schema here!
+;; Add entries and then go to http:/your-url/maint
+;;
+;; first make maint:db available as a global
+;;
+(define maint:db (slot-ref s:session 'conn))
+
+;; you can store lambda's or SQL queries to be exectuted
+;; be extremely careful - especially with the lambda's!!!
+(define maint:schema-updates
+  (list (list 1 (lambda ()(keystore:set! maint:db "MAINTPW" "Abc123")))
+	(list 2 "CREATE TABLE people (id INTEGER PRIMARY KEY,name TEXT DEFAULT '',nick TEXT DEFAULT '',email TEXT,password TEXT,status INTEGER DEFAULT 0,score INTEGER DEFAULT 0,location_id INTEGER DEFAULT 0);")
+	(list 3 "CREATE TABLE candidates (id INTEGER PRIMARY KEY,name TEXT DEFAULT '',url TEXT DEFAULT '',party TEXT DEFAULT '',desc TEXT DEFAULT '',supports_av INTEGER,date_added DATETIME,score INTEGER DEFAULT 0);")
+	(list 4 "CREATE TABLE votes (id INTEGER PRIMARY KEY,candidate_id INTEGER,vote_date INTEGER,votes INTEGER,score INTEGER,vote_type INTEGER);")
+	(list 5 "CREATE TABLE voted (id INTEGER PRIMARY KEY,user_id INTEGER,vote_date INTEGER,score INTEGER);")
+	;; location_type can be: city, town, state, region, county etc
+	(list 6 "CREATE TABLE locations (id INTEGER PRIMARY KEY,parent_id INTEGER,codename TEXT,name TEXT,location_type TEXT,desc TEXT,url TEXT);")
+	(list 7 "INSERT INTO locations VALUES(0,0,'ea','earth','planet','Home Planet of Humans','');")
+	(list 8 "ALTER TABLE candidates ADD column pscore INTEGER DEFAULT 0;")
+	))
+
+(define (maint:am-i-maint?)
+  ;; Enter a maint password - return #t if good
+  #t)
+
+(define (maint:update-tables)
+  (let* ((db       (slot-ref s:session 'conn))
+	 (curr-ver (s:any->number (keystore:get db "SCHEMA-VERSION"))))
+    (if (not curr-ver)
+	(begin
+	  (keystore:set! (slot-ref s:session 'conn) "SCHEMA-VERSION" 0)
+	  (set! curr-ver 0)))
+    (if (null? maint:schema-updates)
+	(keystore:set! (slot-ref s:session 'conn) "SCHEMA-VERSION" 0)
+	(let loop ((hed (car  maint:schema-updates))
+		   (tal (cdr maint:schema-updates))
+		   (highest-ver 0))
+	  (if (< (length hed) 2)
+	      (s:log "Malformed maint:schema-updates table in maint/control.scm")
+	      (let ((ver (car hed))
+		    (act (cadr hed)))
+		(if (> ver curr-ver) ;; need to apply this one
+		    (begin
+		      (if (string? act)
+			  (dbi:exec db act)
+			  (act))
+		      ;; yes, do this for each one, just in case of a crash
+		      (keystore:set! db "SCHEMA-VERSION" ver)))
+		(if (null? tal)
+		    highest-ver
+		    (loop (car tal)(cdr tal) ver))))))))
+

ADDED   stml2/example/models/person.scm
Index: stml2/example/models/person.scm
==================================================================
--- /dev/null
+++ stml2/example/models/person.scm
@@ -0,0 +1,68 @@
+;; Copyright 2007-2008, Matthew Welland. matt@kiatoa.com All rights reserved.
+;; 
+;; models/person.scm
+;;
+(require "md5")
+
+(define (person:get-dat email)
+  (dbi:get-one-row (s:db) "SELECT id,name,email,status,password,score FROM people WHERE email=?;" email))
+
+;; this effectively auto logs in using "" as the password
+(define (person:create-or-get email)
+  (let ((dat (person:get-dat email)))
+    (if dat
+	(person:authenticate email "")
+	(person:set-password email ""))))
+
+(define (person:password-match? password cryptedpw)
+  (string=? (md5:digest password) cryptedpw))
+
+(define (person:authenticate email password)
+  (let ((pdat (person:get-dat email)))
+    (if pdat
+	;; (if (s:password-match? password (vector-ref pdat 4))
+	(if (person:password-match? password (vector-ref pdat 4))
+	    pdat ;; password matched, return basic record id,name,email,status
+	    #f)
+	#f)))
+
+;; sets password, creates user if doesn't exist
+(define (person:set-password email password)
+  (let ((pdat (person:get-dat email))
+	;; (cpwd (s:crypt-passwd password #f)))
+        (cpwd (md5:digest password)))
+    (if pdat
+	(dbi:exec (s:db)
+		  "UPDATE people SET password=? WHERE email=?;" 
+		  cpwd
+		  email)
+	(dbi:exec (s:db)
+		  "INSERT INTO people (name,email,password) VALUES(?,?,?);"
+		  ""
+		  email
+		  cpwd))
+    (if pdat 
+	pdat
+	(person:get-dat email))))
+
+(define (person:learn_enabled? email)
+  (eq? (dbi:get-one (s:db) "SELECT status FROM people WHERE email=?;" email)
+       1))
+
+(define(person:files_enabled? email)
+  #f)
+
+;; id,name,email,status,password,score
+(define (person:get-id       dat)(vector-ref dat 0))
+(define (person:get-name     dat)(vector-ref dat 1))
+(define (person:get-email    dat)(vector-ref dat 2))
+(define (person:get-status   dat)(vector-ref dat 3))
+(define (person:get-password dat)(vector-ref dat 4))
+(define (person:get-score    dat)(vector-ref dat 5))
+
+(define (person:set-id!       dat val)(vector-set! dat 0 val))
+(define (person:set-name!     dat val)(vector-set! dat 1 val))
+(define (person:set-email!    dat val)(vector-set! dat 2 val))
+(define (person:set-status!   dat val)(vector-set! dat 3 val))
+(define (person:set-password! dat val)(vector-set! dat 4 val))
+(define (person:set-score!    dat val)(vector-set! dat 5 val))

ADDED   stml2/example/models/voting.scm
Index: stml2/example/models/voting.scm
==================================================================
--- /dev/null
+++ stml2/example/models/voting.scm
@@ -0,0 +1,61 @@
+;; Copyright 2007-2008, Matthew Welland. matt@kiatoa.com All rights reserved.
+;; 
+;; models/voting.scm
+;;
+;; store the votes!
+
+;; look up the entry to which to add 
+(define (voting:get-entry-id candidate-id score type)
+  (dbi:get-one (s:db) "SELECT id FROM votes WHERE candidate_id=? AND score=? AND vote_type=? AND vote_date>?;"
+	       candidate-id
+	       score
+	       type
+	       (- (current-seconds) 86400))) ;; i.e. since 24 hrs ago
+  
+(define (voting:apply-vote dat candidate-id vote-type)
+  (let* ((score (person:get-score dat))
+	 (vote-entry-id (voting:get-entry-id candidate-id score vote-type)))
+    (if vote-entry-id
+	(dbi:exec (s:db) "UPDATE votes SET votes=votes+1 WHERE id=?;" vote-entry-id)
+	(dbi:exec (s:db) "INSERT INTO votes (candidate_id,vote_date,votes,score,vote_type) VALUES(?,?,?,?,?);" 
+		  candidate-id
+		  (current-seconds)
+		  1
+		  score
+		  vote-type))))
+
+(define (voting:rollup-votes)
+  (let ((adat (dbi:get-rows (s:db) 
+			    "SELECT candidate_id AS id,SUM(votes*(score+1)) AS score FROM votes WHERE vote_date>? AND vote_type=1 GROUP BY candidate_id;"
+			    (- (current-seconds) (* 24 60 60 7))))
+	(pdat (dbi:get-rows (s:db) 
+			    "SELECT candidate_id AS id,SUM(votes*(score+1)) AS score FROM votes WHERE vote_date>? AND vote_type=0 GROUP BY candidate_id;"
+			    (- (current-seconds) (* 24 60 60 7)))))
+    (for-each
+     (lambda (row)
+       (dbi:exec (s:db) "UPDATE candidates SET score=? WHERE id=?;" (vector-ref row 1)(vector-ref row 0)))
+     adat)
+    (for-each
+     (lambda (row)
+       (dbi:exec (s:db) "UPDATE candidates SET pscore=? WHERE id=?;" (vector-ref row 1)(vector-ref row 0)))
+     pdat)))
+
+;; vote_type: 0=plurality, 1=approval
+(define (voting:handle-votes email approval plurality)
+  (let* ((pdat (let ((e (s:session-var-get "email")))
+		 (if e 
+		     (person:get-dat e)
+		     (person:create-or-get (if (or (not (string? email)) 
+						   (string-match (regexp "^\\s*$") email))
+					       "noname" 
+					       email)))))) ;; is this really the logic I wanted?
+    ;; (s:log "Got here eh!" " pdat: " pdat)
+    (if (not pdat)
+	(s:set! "errmsg" "Failed to auto log in/register, email or nick already in use. Consider reseting your password")
+	(begin
+	  (s:session-var-set! "email" (person:get-email pdat))
+	  (voting:apply-vote pdat plurality 0)
+	  (map (lambda (candidate-id)
+		 (voting:apply-vote pdat candidate-id 1))
+	       approval)
+	  (voting:rollup-votes)))))

ADDED   stml2/example/pages/action/view.scm
Index: stml2/example/pages/action/view.scm
==================================================================
--- /dev/null
+++ stml2/example/pages/action/view.scm
@@ -0,0 +1,51 @@
+;; Copyright 2007-2008, Matthew Welland. Kiatoa.com All rights reserved.
+;; 
+(s:div 'class "node" 
+       (s:h1 "Approval voting works")
+       "<p>Approval voting is very resistant to strategic voting and it is 
+        extremely easy to implement using existing ballot technology.
+       <p>Every four years voters must
+       make a painful strategic choice, either vote for the candidate
+       they <b><i>really</i></b> want and risk getting saddled
+       with a candidate they <b><i>don't</b></i> want, OR
+       vote for the most palatable frontrunner, and send a false
+       message of disinterest in their true choice."
+       (s:h1 "Thinking is required for a democracy to work")
+       "<p>Consider trying the &quot;fool test&quot; on an unsuspecting friend or aquaintence.
+        . Pick a popular smear or other known distortion aimed at a candidate you suspect your
+        &quot;person under test&quot;, or PUT,
+        doesn't like. Research the item and find out the truth about it as
+        best you can. Start with <A target=\"_blank\" href=\"http://factcheck.org\">
+        factcheck.org</a> but don't stop there. Use google or other search 
+        engines to build up a picture of what is true.
+
+        <p>Once you are armed with information you can apply the test. Ask your
+        friend or collegue for the truth behind the smear. Be neutral. Accept
+        their answer without judgement if it is incorrect. Say &quot;oh&quot;, or 
+        &quot;thanks&quot; and let it be at that. Again, DO NOT CORRECT THEM!
+
+        <p>If your PUT fails the test don't harp on them or correct them. 
+        Although everyone is responsible for researching the facts many people will
+        lock onto their existing ideas if challenged. Instead say something like,
+        &quot;you may want to research that&quot; and accept that you are dealing with
+        someone who just might be a fool, unwilling or unable to look at their
+        favorite candidate with a critical eye.
+        <p>Finally, be prepared to be tested yourself,
+        aggressively research the smears your favored candidates put out. If they are true
+        be prepared to prove it, if they are false, be prepared to put them in 
+        context or simply admit they are false. No candidate will be perfect."
+	(s:h1 "A strategy for change")
+	"<p>Get a yes/no answer from your favored candidate about approval voting.
+         If your candidate refuses to support approval voting first hear them out. If their 
+         reasons are good then publish them so we can all learn from it. If their
+         reasons are weak then look for an alternative candidate to support.
+
+         <p>Improve your score here on approvalvote.org and then vote again in our front 
+         page poll. Your score will adjust the power of your vote such that the poll 
+         will reflect the choices of those who are willing to think. 
+       
+         We will advocate that everyone votes for an approval vote supporting independant 
+         candidate if that candidate is at least 10% ahead of the next candidate of 
+         the same leaning (i.e. liberal or conservative). Otherwise you should vote 
+         for the frontrunner candidate of your choosen leaning due to the dangers of 
+         plurality voting.")

ADDED   stml2/example/pages/footer/view.scm
Index: stml2/example/pages/footer/view.scm
==================================================================
--- /dev/null
+++ stml2/example/pages/footer/view.scm
@@ -0,0 +1,5 @@
+;; Copyright 2007-2008, Matthew Welland. Kiatoa.com All rights reserved.
+;; 
+;; footer
+(list
+ (s:div 'class "node" "This is the footer"))

ADDED   stml2/example/pages/header/control.scm
Index: stml2/example/pages/header/control.scm
==================================================================
--- /dev/null
+++ stml2/example/pages/header/control.scm
@@ -0,0 +1,9 @@
+;; Copyright 2007-2008, Matthew Welland. Kiatoa.com All rights reserved.
+;; 
+;; header/control.scm
+
+;; (load (s:model-path "blah"))
+(define header:menu-items '(("home" "Home")("learn" "Learn")("action" "Take Action")("discussion" "Discussion")
+			    ("preferences" "Preferences")))
+(define header:title (let ((t (s:get-param 'section)))
+		       (if t t "Home")))

ADDED   stml2/example/pages/header/view.scm
Index: stml2/example/pages/header/view.scm
==================================================================
--- /dev/null
+++ stml2/example/pages/header/view.scm
@@ -0,0 +1,30 @@
+;; Copyright 2007-2008, Matthew Welland. Kiatoa.com All rights reserved.
+;; 
+;; header/view.scm
+;;
+(list
+ ;; (s:div 'id "titlebar"
+	(s:table
+	 (s:tr
+	  (s:td (s:img 'src "/www/images/approvalvote.png" 
+		       'alt "ApprovalVote.com" 
+		       'title "Welcome to ApprovalVote.com"))
+	  (s:td 'valign "top" 'align "right"
+		(s:table 'border "0" 'cellspacing "0"
+			 (s:tr 
+			  (s:td 'valign "center" ;; 'width "250" ;; 'rowspan "2"
+				(s:a (s:small " *      NOW IS A GREAT TIME TO PUSH FOR APPROVAL VOTING!     * "))
+				(s:br)))
+			 (s:tr 
+			  (s:td 'columnspan="3" 
+				(s:center "*********")))))) ;;  header:title))))))
+	 ;; this is the horizontal menus
+	 (s:tr 'columnspan "4"
+	       (s:table
+		(s:tr
+		  (map (lambda (m-item)
+			 (s:td (s:small  "[" 
+					 (s:a 'href (s:link-to (car m-item))(cadr m-item))
+					 "]")))
+		       header:menu-items)
+		  )))));; )

ADDED   stml2/example/pages/home/view.scm
Index: stml2/example/pages/home/view.scm
==================================================================
--- /dev/null
+++ stml2/example/pages/home/view.scm
@@ -0,0 +1,12 @@
+;; Copyright 2007-2008, Matthew Welland. Kiatoa.com All rights reserved.
+;; 
+(s:div 'class "node" 
+       (s:h1 "Please Help Save Our Democracy.")
+      "<p>We need approval voting to re-energize our democracy.
+       Our system is in danger of failing us since it leaves us powerless
+       to force change. Arguably the biggest problem lies in our use of
+       plurality voting to choose leaders.
+      ")
+(s:div 'class "node"
+       (s:h1 "Practice some approval voting now!")
+       (s:call "uspresident"))

ADDED   stml2/example/pages/index/control.scm
Index: stml2/example/pages/index/control.scm
==================================================================
--- /dev/null
+++ stml2/example/pages/index/control.scm
@@ -0,0 +1,6 @@
+;; Copyright 2007-2008, Matthew Welland. Kiatoa.com All rights reserved.
+;; 
+;; this gets read for ALL pages. Don't weigh it down excessively!
+;;
+;; index/control.scm
+

ADDED   stml2/example/pages/index/view.scm
Index: stml2/example/pages/index/view.scm
==================================================================
--- /dev/null
+++ stml2/example/pages/index/view.scm
@@ -0,0 +1,21 @@
+;; Copyright 2007-2008, Matthew Welland. Kiatoa.com All rights reserved.
+;; 
+;; index
+
+(list
+ (s:html
+  (s:head
+   (s:title "Approval Voting Now!")
+   (s:link  'rel "stylesheet" 'type "text/css" 'href "/approvalvote/markup.css")
+   (s:link  'rel "stylesheet" 'type "text/css" 'href "/approvalvote/layout.css"))
+  (s:body
+   (s:div 'class "header"       (s:call "header"))
+   (s:div 'class "rightcolumn"  (s:call "rightcol"))
+   (s:div 'class "leftcolumn"   (s:call "leftnav"))
+   (s:div 'class "centercolumn"
+          (let ((page    (slot-ref s:session 'page)))
+            (if page
+                (s:call page)
+                (list (s:h2 "Home")
+		      (s:call "sys-state")))))
+   (s:div 'class "footer" (s:call "footer")))))

ADDED   stml2/example/pages/learn/view.scm
Index: stml2/example/pages/learn/view.scm
==================================================================
--- /dev/null
+++ stml2/example/pages/learn/view.scm
@@ -0,0 +1,7 @@
+;; Copyright 2007-2008, Matthew Welland. Kiatoa.com All rights reserved.
+;; 
+(s:div 'class "node" 
+       (s:h1 "Resources")
+        "<p>Two excellent sites with more information on approval voting:
+         <p><A target=\"_blank\" href=\"http://approvalvoting.org\">approvalvoting.org</a>
+         <p><a target=\"_blank\" href=\"http://approvalvoting.com\">approvalvoting.com</a>")

ADDED   stml2/example/pages/leftnav/control.scm
Index: stml2/example/pages/leftnav/control.scm
==================================================================
--- /dev/null
+++ stml2/example/pages/leftnav/control.scm
@@ -0,0 +1,11 @@
+;; Copyright 2007-2008, Matthew Welland. Kiatoa.com All rights reserved.
+;; 
+;; leftnav/control.scm 
+
+;; nothing needed here yet!
+
+(define (leftnav-action action)
+  (case action
+    ('logout
+     (s:logout))))
+

ADDED   stml2/example/pages/leftnav/view.scm
Index: stml2/example/pages/leftnav/view.scm
==================================================================
--- /dev/null
+++ stml2/example/pages/leftnav/view.scm
@@ -0,0 +1,38 @@
+;; Copyright 2007-2008, Matthew Welland. Kiatoa.com All rights reserved.
+;; 
+;; leftnav/view.scm
+
+(list
+    (s:div 
+     'class "node"
+     (s:h1 "Navigation")
+     (let ((section (slot-ref s:session 'page)))
+       (cond
+	((or (not section) ;; this is home
+	     (string=? section "home"))
+	 "Home menu")
+	((string=? section "discussions")
+	 (list
+	  (s:a "Filter"         'href (s:link-to "discussions" 'filter "on"))))
+	((string=? section "learn")
+	 (list
+	  (s:a "Learn"  'href (s:link-to "learn"  'action "learn.teach"))(s:br)
+	  (s:a "Test"   'href (s:link-to "learn"  'action "learn.test"))(s:br)
+	  ))
+	((string=? section "preferences")
+	 (list 
+	  (s:a "Password"       'href (s:link-to "preferences" 'action "password"))(s:br)
+	  (s:a "Messages"       'href (s:link-to "preferences" 'action "messages"))(s:br)
+	  (s:a "Preferences"    'href (s:link-to "preferences" 'action "preferences"))(s:br)))
+	(else '( "nada" ))))
+     (s:br))
+    (s:div
+     'class "node"
+     (s:h1 "About you")
+     (let ((email (s:session-var-get "email")))
+       (if email
+           (list email (s:br))
+           "Not logged in")))
+    (s:div
+     'class "node"
+     (s:call "pledge")))

ADDED   stml2/example/pages/login/control.scm
Index: stml2/example/pages/login/control.scm
==================================================================
--- /dev/null
+++ stml2/example/pages/login/control.scm
@@ -0,0 +1,25 @@
+;; Copyright 2007-2008, Matthew Welland. Kiatoa.com All rights reserved.
+;; 
+(load (s:model-path "person"))
+
+(define (login-action action)
+  (case (string->symbol action)
+    ('login
+     ;; the actual login code
+     (s:log "Got here, doing login")
+     (let ((email  (s:get-input 'email-address))
+           (passwd (s:get-input 'password)))
+	   ;; (person (make-person))) ;; DO WE NEED A PERSON "OBJECT"?
+       (s:set! "email-address" email) ;; preserve user as email-address
+       (if (and email passwd)
+	   (let ((good-login (person:authenticate email passwd)))
+	     (if good-login
+		 (begin
+		   (s:set! "msg" "Login successful!")
+		   (s:session-var-set! "email" email))
+		 (s:set! "msg" "Bad password or email. Please try again")))
+	   (s:set! "msg" "Missing password or email"))))
+    ('logout
+     (s:delete-session))
+    ('nada
+     (s:log "Got here, action=" action))))

ADDED   stml2/example/pages/login/view.scm
Index: stml2/example/pages/login/view.scm
==================================================================
--- /dev/null
+++ stml2/example/pages/login/view.scm
@@ -0,0 +1,24 @@
+;; Copyright 2007-2008, Matthew Welland. Kiatoa.com All rights reserved.
+;; 
+;; Login view
+
+(s:div 'class "node"
+       ;; (s:p (s:get-err s:strong)) ;; error message
+       (if (s:session-var-get "email") 
+           (s:a "Log out" 'href (s:link-to (s:current-page) 'action "login.logout"))
+           (list 
+            (s:center (s:p (s:strong "Log in here!")))
+	    (let ((msg (s:get "msg")))
+	      (if msg
+		  (begin
+		    (s:del! "msg")
+		    (s:err-font msg))
+		  (s:null "")))
+            (s:form 'action "login.login" 'method "post"
+                    (s:strong "Id: (*)")(s:br)
+                    (s:input-preserve 'type "text" 'name "email-address" 'size "14" 'maxlength "30")(s:br)
+                    (s:strong "Password:")(s:br)
+                    (s:input 'type "password" 'name "password" 'size "14" 'maxlength "30")(s:br)
+                    (s:input 'type "submit"   'name "form-name"    'value "login")(s:br)
+                    (s:a "Create account" 'href (s:link-to "new_account"))
+                    ))))

ADDED   stml2/example/pages/maint/control.scm
Index: stml2/example/pages/maint/control.scm
==================================================================
--- /dev/null
+++ stml2/example/pages/maint/control.scm
@@ -0,0 +1,13 @@
+;; Copyright 2007-2008, Matthew Welland. matt@kiatoa.com All rights reserved.
+;; 
+;; maint/control.scm
+;;
+(s:load-model "maint")
+
+;; remember that the system will call the function <pagename>-action with the action as a parameter
+(define (maint-action action)
+  (let ((asym (string->symbol action)))
+    (s:log "Doing action! " action)
+    (case asym
+      ('update_tables
+       (maint:update-tables)))))

ADDED   stml2/example/pages/maint/view.scm
Index: stml2/example/pages/maint/view.scm
==================================================================
--- /dev/null
+++ stml2/example/pages/maint/view.scm
@@ -0,0 +1,12 @@
+;; Copyright 2007-2008, Matthew Welland. Kiatoa.com All rights reserved.
+;; 
+;; maint/view.scm
+;;
+(if (maint:am-i-maint?)
+    (list
+     (s:h1 "Hello Maint!")
+     (s:p (s:a "Update Tables" 'href (s:link-to (s:current-page) 
+					'action "maint.update_tables"))))
+    '())
+
+	

ADDED   stml2/example/pages/new_account/control.scm
Index: stml2/example/pages/new_account/control.scm
==================================================================
--- /dev/null
+++ stml2/example/pages/new_account/control.scm
@@ -0,0 +1,53 @@
+;; Copyright 2007-2008, Matthew Welland. matt@iatoa.com All rights reserved.
+;; 
+;; new_account/control.scm
+
+(load (s:model-path "person"))
+
+(define (new_account:validate-inputs password password-again email-address email-address-again)
+  (cond
+   ((or (not password)(not password-again)
+        (not email-address)(not email-address-again))
+    (s:set-err "Form is incomplete. Please fill in all fields and try again")
+    #f)
+   ((< (string-length password) 2)
+    (s:set-err "Password is too short. Please try again")
+    #f)
+   ((not (string=? password password-again))
+    (s:set-err "Passwords do not match. Please try again")
+    #f)
+   ((> (string-length password) 9)
+    (s:set-err "Password is too long. Please try again")
+    #f)
+   ((not (string=? email-address email-address-again))
+    (s:set-err "Email addresses provided do not match. Please try again")
+    #f)
+   ((and (not (string-match (regexp "^\\s*$") email-address))
+         (not (string-match (regexp "^[^@]+@[^@]+\\.[^@]+$") email-address)))
+    (s:set-err "Not a valid email address, please try again")
+    #f)
+   (else #t)))
+
+(define (new_account-action action)
+  (case (string->symbol action)
+    ('create
+     (s:log "Got here, doing create new account")
+     (let ((password            (s:get-input 'password))
+           (password-again      (s:get-input 'password-again))
+           (email-address       (s:string-downcase (s:get-input 'email-address)))
+           (email-address-again (s:string-downcase (s:get-input 'email-address-again))))
+       ;; save preserved inputs
+       (s:set! "email-address" email-address)
+       (s:log "Saved inputs. Now check inputs")
+       (if (new_account:validate-inputs password password-again email-address 
+                                        email-address-again)
+           ;; Great!! Now have good inputs
+           (if (person:get-dat email-address)
+	       (s:set-err "There is already an account for that email address!")
+	       (let ((pdat (person:set-password email-address password)))
+		 (if pdat
+		     (s:set-err "SUCCESS!! You can now log in with " email-address " and your password")
+		     (s:set-err "ERROR!! Unable to automatically log you on with the same credentials used to create your account. This shouldn't happen. Please send email to matt@kiatoa.com about this"))))
+           ;; bad inputs
+           #f)))
+    ('else (s:log "Placeholder for future actions. Shouldn't get here"))))

ADDED   stml2/example/pages/new_account/view.scm
Index: stml2/example/pages/new_account/view.scm
==================================================================
--- /dev/null
+++ stml2/example/pages/new_account/view.scm
@@ -0,0 +1,27 @@
+;; Copyright 2007-2008, Matthew Welland. Kiatoa.com All rights reserved.
+;; 
+;; new_account/view.scm
+;;
+(list 
+ (s:div 'class "node"
+        ;; (s:p (s:get-err s:strong)) ;; error message
+        (s:p "")(s:p (s:get-err s:err-font))
+        (if (not (s:session-var-get "email")) ;; setting email defines "logged in"
+            (s:form 'action "new_account.create" 'method "post"
+                    (s:table 'border "0" 'spacing "0"
+                             
+                             (s:tr (s:td (s:strong "Email address:")) ;; (s:br)
+                                   (s:td (s:input-preserve 'type "text" 'name "email-address" 'size "16" 'maxlength "30"))) ;; (s:br)
+                             
+                             (s:tr (s:td (s:strong "Email address again:")) ;; (s:br)
+                                   (s:td (s:input-preserve 'type "text" 'name "email-address-again" 'size "16" 'maxlength "30"))) ;; (s:br)
+                    
+                             (s:tr (s:td (s:strong "Password:")) ;; (s:br)
+                                   (s:td (s:input 'type "password" 'name "password" 'size "16" 'maxlength "16"))) ;; (s:br)
+                             
+                             (s:tr (s:td (s:strong "Password again:")) ;; (s:br)
+                                   (s:td (s:input 'type "password" 'name "password-again" 'size "16" 'maxlength "16")))); (s:br)
+                             
+                    (s:input 'type "submit"   'name "form-name"    'value "submit"))
+            (s:h1 "Welcome " (s:session-var-get "email") ":" (s:session-var-get "location") "!"))))
+ 

ADDED   stml2/example/pages/pledge/view.scm
Index: stml2/example/pages/pledge/view.scm
==================================================================
--- /dev/null
+++ stml2/example/pages/pledge/view.scm
@@ -0,0 +1,16 @@
+;; Copyright 2007-2008, Matthew Welland. matt@iatoa.com All rights reserved.
+;; 
+(s:if-sessionvar 
+ "email"
+ (list
+  (s:h1 "Pledge now!")
+  (s:fieldset 
+   "Pledge"
+   (s:form 'action "pledge.pledge"
+	   'method "post"
+	   (s:i " - I will vote" (s:b "ONLY") " for a candidate who supports approval voting!")
+	   (s:table
+	    (s:tr (s:td "Yes")  (s:td (s:input 'type "radio"    'name "pledge_answer" 'value "yes")))
+	    (s:tr (s:td "No")   (s:td (s:input 'type "radio"    'name "pledge_answer" 'value "no")))
+	    (s:tr (s:td "Maybe")(s:td (s:input 'type "radio"    'name "pledge_answer" 'value "maybe"))))
+	   (s:input 'type "button" 'name "pledge_answer" 'value "Submit")))))

ADDED   stml2/example/pages/preferences/view.scm
Index: stml2/example/pages/preferences/view.scm
==================================================================
--- /dev/null
+++ stml2/example/pages/preferences/view.scm
@@ -0,0 +1,12 @@
+;; Copyright 2007-2008, Matthew Welland. matt@iatoa.com All rights reserved.
+;; 
+;; preferences/view.scm
+;;
+(s:div
+ 'class "node"
+ (s:h1 "Register your email address")
+ (s:p "Adds 9 pts to your score the first time you do it and enables very occasional email updates. If you change your email address
+       you need to re-register to keep your 9 pts.")
+ (s:form 'action "preferences.register_email"
+	 'method "post"
+	  (s:input 'type "submit" 'name "register_email" 'value "Register Email"))) 

ADDED   stml2/example/pages/rightcol/view.scm
Index: stml2/example/pages/rightcol/view.scm
==================================================================
--- /dev/null
+++ stml2/example/pages/rightcol/view.scm
@@ -0,0 +1,9 @@
+;; Copyright 2007-2008, Matthew Welland. Kiatoa.com All rights reserved.
+;; 
+
+;; rightcol
+(list
+  (s:div 'class "node" 
+	 (s:call "login")))
+
+;; "This is the right-most column"))

ADDED   stml2/example/pages/sys-state/view.scm
Index: stml2/example/pages/sys-state/view.scm
==================================================================
--- /dev/null
+++ stml2/example/pages/sys-state/view.scm
@@ -0,0 +1,16 @@
+;; Copyright 2007-2008, Matthew Welland. Kiatoa.com All rights reserved.
+;; 
+
+;; sys-state
+
+(list (let ((p (open-input-pipe "env")))
+	(let loop ((l (read-line p))
+		   (res '()))
+	  (if (not (eof-object? l))
+	      (loop (read-line p)(cons (list l "<BR>") res))
+	      res)))
+      ;; "USER=" (user-information (current-user-id))
+
+      (s:h2 "Form data")
+      (session:pp-formdat s:session)
+      "argv=" (argv))

ADDED   stml2/example/pages/uspresident/control.scm
Index: stml2/example/pages/uspresident/control.scm
==================================================================
--- /dev/null
+++ stml2/example/pages/uspresident/control.scm
@@ -0,0 +1,72 @@
+;; Copyright 2007-2008, Matthew Welland. Kiatoa.com All rights reserved.
+;; 
+;; this gets read for ALL pages. Don't weigh it down excessively!
+;;
+;; uspresident/control.scm
+
+(s:load-model "candidate")
+(s:load-model "voting")
+(s:load-model "person")
+
+(define candidates (candidate:get-top 10))
+(define candidates:vote-sum-approval  (apply + (map candidate:get-score candidates)))
+(define candidates:vote-sum-plurality (apply + (map candidate:get-pscore candidates)))
+(define candidates:top-plurality-id   (let ((id       #f)
+					    (topscore 0))
+					(for-each (lambda (cand)
+						    (if (> (candidate:get-pscore cand) topscore)
+							(begin 
+							  (set! topscore (candidate:get-pscore cand))
+							  (set! id       (candidate:get-id cand)))))
+						  candidates)
+					id))
+(define candidates:top-approval-id   (let ((id       #f)
+					   (topscore 0))
+				       (for-each (lambda (cand)
+						   (if (> (candidate:get-score cand) topscore)
+						       (begin 
+							 (set! topscore (candidate:get-score cand))
+							 (set! id       (candidate:get-id cand)))))
+						 candidates)
+				       id))
+							   
+
+(define (uspresident-action action)
+  (let ((acsym (string->symbol action)))
+    (cond
+     ('vote
+      (let ((button (s:get-input 'vote)))
+	(cond
+	 ((equal? button "Vote")
+	  (let* ((approval    (s:get-input 'approval))
+		 (plurality   (s:get-input 'plurality))
+		 (newdat      (make-vector 9 ""))
+		 (email       (s:session-var-get "email"))
+		 (newcandname (s:get-input 'poll_name))
+		 (nick-email  (if email email (s:get-input 'users_email))))
+	    (if (not (list? approval))
+		(set! approval (list approval)))
+	    (if (string-match (regexp "^[a-zA-Z]+") newcandname)
+		(let* ((dat (candidate:get-by-name newcandname)))
+		  (if dat ;; i.e. this is a new candidate
+		      (set! newdat dat)
+		      (begin
+			(candidate:set-name! newdat newcandname)
+			(candidate:set-supports-av! newdat (s:get-input 'poll_supports_av))
+			(candidate:set-party! newdat (s:get-input 'poll_party))
+			(candidate:set-url! newdat (s:get-input 'poll_url))
+			(set! newdat (candidate:update newdat))))
+		  (s:log "cid: " (candidate:get-id newdat))
+		  (set! approval  (cons (candidate:get-id newdat) approval))
+		  (set! plurality (candidate:get-id newdat))))
+	    (set! approval (filter (lambda (x)(or (number? x)(string? x))) approval)) ;; clean the approval list
+	    (s:log "using email: " nick-email)
+	    (s:log "approval: " approval)
+	    (s:log "plurality: " plurality)
+	    (if (and approval plurality (not (null? approval)))
+		(begin
+		  (voting:handle-votes nick-email
+				       approval
+				       plurality)
+		  (s:session-var-set! "voted" "yes"))
+		(s:set! "errmsg" "Please select one plurality vote and one or more approval votes"))))))))))

ADDED   stml2/example/pages/uspresident/view.scm
Index: stml2/example/pages/uspresident/view.scm
==================================================================
--- /dev/null
+++ stml2/example/pages/uspresident/view.scm
@@ -0,0 +1,85 @@
+;; Copyright 2007-2008, Matthew Welland. Kiatoa.com All rights reserved.
+;; 
+
+;; Note: the (list is actually no longer needed. 
+
+(list
+ (s:if-sessionvar 
+  "email"
+  (s:if-sessionvar 
+   "voted"
+   "We are glad you tried approval voting. Try again to see how the system works. Don't worry about the poll numbers. This poll is for you to play with."))
+ (s:fieldset
+  "Poll"
+  (s:center
+   (s:if-param "errmsg"
+	       (let ((err (s:get "errmsg")))
+		 (s:del! "errmsg")
+		 (s:err-font err)))
+   (s:form  'action "uspresident.vote"
+	    'method "post"
+	    (s:table 'border "1" 'cellspacing "0"
+		     (s:tr 
+		      (s:td "Candidate")(s:td "Party")(s:td "Supports approval?")
+		      (s:if-sessionvar 
+		       "voted"
+		       (list (s:td "Plurality")
+			     (s:td "Approval")
+			     (s:td "Plurality" (conc "(" candidates:vote-sum-plurality "votes" ")"))
+			     (s:td "Approval"  (conc "(" candidates:vote-sum-plurality "votes" ")")))
+		       (list (s:td "Plurality (vote for one only)")(s:td "Approval (vote for all which you approve of)"))))
+		     ;; map the poll items for each row
+		     (map (lambda (candidate)
+			    (let ((poll-item-id          (number->string (candidate:get-id candidate)))
+				  (poll-item-url         (s:tidy-url (candidate:get-url candidate)))
+				  (poll-item-name        (candidate:get-name candidate))
+				  (poll-item-description (candidate:get-desc candidate))
+				  (poll-item-percent-a   (quotient (* 100 (candidate:get-score candidate)) candidates:vote-sum-plurality))
+				  (poll-item-percent-p   (quotient (* 100 (candidate:get-pscore candidate)) candidates:vote-sum-plurality)))
+			      (list
+			       (s:tr
+				(s:td
+				 (if poll-item-url
+				     (s:a 'href poll-item-url 'target "_blank" poll-item-name)
+				     poll-item-name))
+				;; (if (poll:poll 'have-description?)
+				;;     (s:td 'bgcolor "#f0f0f0" poll-item-description) ;; description
+				;;     '())
+				(s:td (candidate:get-party       candidate))
+				(s:td (candidate:get-supports-av candidate))
+				;; (if (not (s:session-var-get "voted")) ;; here are the check buttons for plurality and approval voting
+				;;    (list 
+				(s:td (s:center
+				       (s:input 'type "radio"    'name "plurality" 'value poll-item-id)))
+				(s:td (s:center
+				       (s:input 'type "checkbox" 'name "approval"  'value poll-item-id)))
+				(s:if-sessionvar "voted"
+						 (list
+						  (s:td (conc poll-item-percent-p "%") 'bgcolor (if (eq? (candidate:get-id candidate)  candidates:top-plurality-id)
+												    "cyan"
+												    "lightgrey")
+							(conc "(" (candidate:get-pscore candidate) ")") 'align "center")
+						  (s:td (conc poll-item-percent-a "%")  'bgcolor (if (eq? (candidate:get-id candidate)  candidates:top-approval-id)
+												    "cyan"
+												    "lightgrey")
+							(conc "(" (candidate:get-score candidate) ")")  'align "center"))))))) ;; % votes
+			  candidates)
+		     (s:tr 
+		      (s:td "Write in (name):<br>"
+			    (s:input-preserve 'type "text" 'name "poll_name"  'size "15" 'maxlength "40"))
+		      (s:td "Party:<br>" (s:input-preserve 'type "text" 'name "poll_party" 'size "10" 'maxlength "40"))
+		      (s:td "Supports approval:<br>" (s:input-preserve 'type "text" 'name "poll_supports_av"  'size "10" 'maxlength "40"))
+		      (s:td "Url:<br>"   (s:input-preserve 'type "text" 'name "poll_url"   'size "40" 'maxlength "120") 'colspan 4))
+		     (s:tr
+		      (s:td 'colspan 7
+			    (s:center (s:input 'type "submit" 'name "vote" 'value "Vote") 
+				      (s:if-sessionvar "email"
+						       '()
+						       (list
+							"Email or nickname:" 
+							(s:input-preserve 'type "text" 'name "users_email" 'size 20 'maxlength 40)
+							"(required), Country code:"
+							(s:input-preserve 'type "text" 'name "users_country_code" 'size 2 'maxlength 2)
+							"(optional)"
+							))
+				       ))))))))

ADDED   stml2/example/tests/test.scm
Index: stml2/example/tests/test.scm
==================================================================
--- /dev/null
+++ stml2/example/tests/test.scm
@@ -0,0 +1,85 @@
+#!/usr/local/bin/csi -q 
+
+;; This currently requires that the stml code is available in a parallel directory.
+
+(use test)
+(if (file-exists? "test.db")
+    (begin
+      (print "Removing old test.db")
+      (system "rm -f test.db")))
+
+(load "../stml/misc-stml.scm")
+(load "../stml/formdat.scm")
+(load "../stml/stml.scm")
+(load "../stml/session.scm")
+(load "../stml/sqltbl.scm")
+(load "../stml/html-filter.scm") ;; required for s:split-string 
+(load "../stml/dbi.scm")
+(load "../stml/keystore.scm")
+(load "../stml/sugar.scm")
+
+;; create a session to work with")
+(setenv "REQUEST_URI" "/stmlrun?action=maint.nada")
+(setenv "SCRIPT_NAME" "/cgi-bin/stmlrun")
+(setenv "PATH_INFO" "/maint")
+(setenv "QUERY_STRING" "action=maint.nada")
+(setenv "SERVER_NAME" "localhost")
+(setenv "REQUEST_METHOD" "GET")
+;; (define session-name "pfNOeqUHkJ26BpU6y49IN") ;; ensure this session already exists
+;; (setenv "HTTP_COOKIE" (string-append "session_key=" session-name)) ;; to09ipFJ9_2KXT96b2f9Q")
+
+(load "../stml/setup.scm")
+;; (test (string-append "Session set to existing session " session-name)
+;;       session-name (slot-ref s:session 'session-key))
+
+(s:validate-inputs)
+
+;; test session variables
+
+;; lazy stuff
+(define *conn* (slot-ref s:session 'conn))
+
+;; setup tables
+(load "models/maint.scm")
+(test "Create tables" #t (> (maint:update-tables)
+			    0))
+
+;; test person
+(let ((fh (open-input-pipe "ls models/*.scm")))
+  (let loop ((l (read-line fh)))
+    (if (not (eof-object? l))
+        (begin
+          (print "loading " l)
+          (load l)
+          (loop (read-line fh)))))
+  (close-input-port fh))
+
+(let ((fh (open-input-pipe "find pages -name control.scm"))) ;; ls pages/*/control.scm")))
+  (let loop ((l (read-line fh)))
+    (if (not (eof-object? l))
+        (begin
+          (print "loading " l)
+          (load l)
+          (loop (read-line fh)))))
+  (close-input-port fh))
+
+(let ((fh (open-input-pipe "ls pages/*/view.scm")))
+  (let loop ((l (read-line fh)))
+    (if (not (eof-object? l))
+        (begin
+          (print "loading " l)
+          (load l)
+          (loop (read-line fh)))))
+  (close-input-port fh))
+
+;;======================================================================
+;; Maint
+;;======================================================================
+;; 
+(load "models/maint.scm")
+
+(test "Update tables"   #t                (> (maint:update-tables))) ;;  *conn* 2 "us") 0))
+(test "Add user"        "matt@kiatoa.com" (vector-ref (person:set-password "matt@kiatoa.com" "Password") 2))
+(test "Authenticate"    "matt@kiatoa.com" (vector-ref (person:authenticate "matt@kiatoa.com" "Password") 2))
+(test "Validate inputs" #t                (new_account:validate-inputs "Password" "Password" "matt@kiatoa.com" "matt@kiatoa.com"))
+

ADDED   stml2/example/www/layout.css
Index: stml2/example/www/layout.css
==================================================================
--- /dev/null
+++ stml2/example/www/layout.css
@@ -0,0 +1,245 @@
+
+/*-General-----------------------------------------------*/
+
+html, body {
+	margin:0px;
+	padding:0px;
+}
+
+form {
+	display:inline;
+	margin:0px;
+	padding:0px;
+}
+
+a img {
+	border:none;
+	margin:0px;
+	padding:0px;
+}
+
+h1, h2, h3, h4, h5, h6, p, div {
+	margin:0px;
+	padding:0px;
+}
+
+.right {
+	float:right;
+}
+
+.left{
+	float:left;
+}
+
+/*-Main Layout-------------------------------------------*/
+
+#overall {
+	/* margin:5px 12px 0px 12px; */
+	padding:0px;
+}
+
+/*-Header-------------*/
+
+.header {
+        /* float:top; */
+	position:relative; 
+	height:55px;
+}
+
+/*-Footer-------------*/
+
+.footer {
+	padding:40px 0px 0px 0px;
+	position:relative;
+	clear:both;
+}
+
+/*-Content Area-------*/
+
+.content {
+	width:100%;
+}
+
+/*-Left Column--------*/
+
+.leftcolumn	{
+  float:left;
+  width:145px;
+  margin:5px;
+}
+
+.leftcolumn .node {
+	margin:0px 0px 15px 0px;
+}
+
+.leftcolumn .node h1 {
+	padding:0px 0px 0px 3px;
+}
+
+.leftcolumn .node ul {
+	margin:0px;
+	padding:0px;
+}
+
+.leftcolumn .node li {
+	display:block;
+	padding:0px 0px 0px 3px;
+	margin:0px;
+}
+
+.leftcolumn .node li.more{
+	padding:0px 0px 0px 6px;
+}
+
+/*-Center Column------*/
+
+.centercolumn {
+        margin: 5px;
+	margin-left:152px;
+        margin-right:140px;
+	font-family:"\"}\"";
+	font-family:inherit;
+}
+
+.centercolumn .node h1 {
+	padding: 0px 0px 0px 13px;
+}
+
+.centercolumn .node h4 {
+	margin: 15px 0px 10px 0px;
+}
+
+.centercolumn .node p {
+	margin: 0px 0px 10px 0px; */
+	padding: 0px 0px 0px 0px;
+}  /* this seemed not to work */
+
+.posts_0  {
+	margin: 0px 0px 0px 0px;
+}
+
+.posts_1  {
+	margin: 0px 0px 0px 20px;
+}
+
+.posts_2  {
+	margin: 0px 0px 0px 40px;
+}
+
+.posts_3  {
+	margin: 0px 0px 0px 60px;
+}
+
+.posts_4  {
+	margin: 0px 0px 0px 80px;
+}
+
+.posts_5  {
+	margin: 0px 0px 0px 100px;
+}
+
+.posts_6  {
+	margin: 0px 0px 0px 120px;
+}
+
+.posts_7  {
+	margin: 0px 0px 0px 140px;
+}
+
+.posts_8  {
+	margin: 0px 0px 0px 160px;
+}
+
+.posts_9  {
+	margin: 0px 0px 0px 160px;
+}
+
+.posts_10  {
+	margin: 0px 0px 0px 180px;
+}
+
+/*-Right Column-------*/
+
+.rightcolumn {
+	float:right;
+        width:130px;
+	margin:5px 5px 0px 0px;
+}
+
+* html .rightcolumn {
+	margin:3px 3px 3px 3px;
+}
+
+body>div .rightcolumn {
+	margin:0px 0px 0px 0px;
+}
+
+.rightcolumn .node {
+	margin:0px 0px 5px 0px;
+	padding:0px;
+}
+
+.rightcolumn .node h2 {
+	margin:3px 3px 3px 2px;
+}
+
+.rightcolumn .node ul {
+  list-style-position:inside;
+  margin:0px;
+  padding:1px;
+}
+
+.rightcolumn .node ul.none {
+	list-style-position:inside;
+}
+
+.rightcolumn .node ul.dot {
+	list-style-position:inside;
+}
+
+.rightcolumn .node ul.books {
+	list-style-position:outside;
+	margin:0px 0px 0px 35px;
+}
+
+.rightcolumn .node li {
+	padding:0px 0px 0px 3px;
+	margin:0px;
+}
+
+/*-Remaining layout--------------------------------------*/
+
+#title {
+	top: 0px;
+	left: 0px;
+	position: absolute;
+}
+
+#search {
+	float:left;
+	margin:0px 0px 0px 30px;
+}
+
+#randomquote {
+	float:right;
+	margin:0px 30px 0px 0px;
+}
+
+#copyright {
+	text-align:center;
+	padding:15px 0px 0px 0px;
+	margin:0px 0px 0px 0px;
+	clear:both;
+}
+
+#bottomNav {
+	text-align:center;
+	margin:0px 0px 20px 0px;
+	padding:0px;
+}
+
+#oldStuffNav {
+	font-weight:bold;
+	text-align:right;
+}
+

ADDED   stml2/example/www/markup.css
Index: stml2/example/www/markup.css
==================================================================
--- /dev/null
+++ stml2/example/www/markup.css
@@ -0,0 +1,299 @@
+/*-General-----------------------------------------------*/
+
+body {
+  background-color:#ffffff;
+  color:#0f0f0f;
+/*  font-family:serif; */
+  font-weight:normal;
+  text-decoration:none; 
+  font-size:x-small; 
+  voice-family:"\"}\"";
+  voice-family:inherit;
+  font-size:small;
+}
+
+html>body {
+  font-size:small;
+}
+
+.strong {
+  font-weight:bold;
+}
+
+#red { 
+  color: #ff0000
+}
+
+/*-Main Markup-------------------------------------------*/
+
+#overall {
+  background-color: #ffffff;
+  color:#000000;
+}
+
+/*-Left Column--------*/
+
+.leftcolumn .node a {
+  color:#006666;
+  background-color:transparent;
+}
+
+.leftcolumn .node p {
+  font-size:1.2em;
+  font-weight:normal;
+}
+
+.leftcolumn .node h1 {
+  font-weight:normal;
+  font-size:1.2em;
+  color:#ffffff;
+  background-color:#000000; /* #005991;  #7f9bff #006666; */
+}
+
+.leftcolumn .node h1 a {
+  color:#ffffff;
+  background-color:transparent;
+}
+
+.leftcolumn .node h2 {
+  font-weight:bold;
+  font-size:.95em;
+}
+
+.leftcolumn .node ul {
+  list-style-type:none;
+}
+
+.leftcolumn .node li.more {
+  font-weight:bold;
+  font-size:.75em;
+}
+
+.leftcolumn .node li.selected {
+  font-weight:bold;
+  font-size:1.18em;
+  color:#000000;
+  background-color:#cccccc;
+}
+
+.leftcolumn .node li.selected a {
+  color:#000000;
+  background-color:transparent;
+}
+
+/*-Center Column for classifieds-*/
+
+.centercolumn .classifieds h1 { 
+  font-family:Arial, Helvetica, serif;
+  font-weight:bold;
+  font-size:1.38em;
+  color:#000000; /* ffffff; */
+  background: #5390b7; /* a6bcac; #0c1e0f; 043b0d; 1a6126; */
+}
+
+/*-Center Column------*/
+.centercolumn .node {
+/*  font-family:serif; */
+}
+
+.centercolumn .node a {
+  color:#006666;
+  background-color:transparent;
+}
+
+.centercolumn .node h1 {
+  font-family:Arial, Helvetica, serif;
+  font-weight:bold;
+  font-size:1.38em;
+  color:#ffffff;
+  background:#000000; /* #005991; */
+} /* #006666 /* url('../images/slc.gif') no-repeat; */
+     
+.centercolumn .node h1 a {
+  color:#ffffff;
+  background-color:transparent;
+}
+
+.centercolumn .node h2 {
+  font-weight:bold;
+  font-size:1.18em;
+}
+
+.centercolumn .node h3 {
+  font-weight:bold;
+  font-size:.95em;
+}
+
+.centercolumn .node h4 {
+  font-weight:normal;
+  font-size:1.2em;
+}
+
+.centercolumn .node h4 a {
+  font-weight:bold;
+}
+
+.centercolumn .node p {
+  font-weight:normal;
+}
+
+.centercolumn .posts_0 h1 { 
+  color:#ffffff;
+  background-color:#606060;
+  font-size:1.18em;
+}
+
+.centercolumn .posts_1 h1 { 
+  color:#ffffff;
+  background-color:#606060;
+  font-size:1.18em;
+}
+
+.centercolumn .posts_2 h1 { 
+  color:#ffffff;
+  background-color:#606060;
+  font-size:1.18em;
+}
+
+.centercolumn .posts_3 h1 { 
+  color:#ffffff;
+  background-color:#606060;
+  font-size:1.18em;
+}
+
+.centercolumn .posts_4 h1 { 
+  color:#ffffff;
+  background-color:#606060;
+  font-size:1.18em;
+}
+
+.centercolumn .posts_5 h1 { 
+  color:#ffffff;
+  background-color:#606060;
+  font-size:1.18em;
+}
+
+.centercolumn .posts_6 h1 { 
+  color:#ffffff;
+  background-color:#606060;
+  font-size:1.18em;
+}
+
+.centercolumn .posts_7 h1 { 
+  color:#ffffff;
+  background-color:#606060;
+  font-size:1.18em;
+}
+
+.centercolumn .posts_8 h1 { 
+  color:#ffffff;
+  background-color:#606060;
+  font-size:1.18em;
+}
+
+.centercolumn .posts_9 h1 { 
+  color:#ffffff;
+  background-color:#606060;
+  font-size:1.18em;
+}
+
+.centercolumn .posts_10 h1 { 
+  color:#ffffff;
+  background-color:#606060;
+  font-size:1.18em;
+}
+
+/*-Right Column-------*/
+
+.rightcolumn .node {
+  color:#000000;
+  background-color:#cccccc;
+  font-family:serif;
+}
+
+.rightcolumn .node a {
+  color:#000000; /* #005991;  #006666; */
+  background-color:transparent;
+}
+
+.rightcolumn .node h1 {
+  font-family:Arial, Helvetica, serif;
+  font-weight:bold;
+  font-size:0.95em; /* 1.38em; */
+  color:#ffffff;
+  background-color: #000000; /* #005991;  #006666; */
+}
+
+.rightcolumn .node h1 a {
+  color:#ffffff;
+  background-color:transparent;
+}
+
+.rightcolumn .node h2 {
+  font-weight:bold;
+  font-size:.95em;
+}
+
+.rightcolumn .node ul.none {
+  list-style-type:none;
+}
+
+.rightcolumn .node ul.dot {
+  list-style-type:none;
+  /* list-style-image:url('../images/listdot.gif'); */
+}
+
+.rightcolumn .node ul.books {
+  list-style-type:disc;
+}
+
+/*-OSDN Navagation bar-----------------------------------*/
+
+#OSDNNavbar {
+  background-color:#999999;
+  color:#000000; /* #005991; /* #006666; */
+}
+
+#OSDNNavbar div#links {
+  background-color:#999999;
+  color:#000000; /* #005991; /* #006666; */
+}
+
+#OSDNNavbar a {
+  background-color: transparent;
+  color: #000000; /* #005991; /* #006666; */
+}
+
+/*-Remaining layout--------------------------------------*/
+
+#randomquote {
+  font-size:1.2em;
+  font-style:italic;
+}
+
+#copyright {
+  font-size:.75em;
+  font-family:Arial, Helvetica, serif;
+  background-color:transparent;
+  color:#000000; /* #005991; /* #006666; */
+}
+
+#copyright a {
+  background-color:transparent;
+  color:#000000; /* #005991; /* #006666; */
+}
+
+#bottomNav {
+  background-color:transparent;
+  color:#000000; /* #005991; /* #006666; */
+}
+
+#bottomNav a {
+  background-color:transparent;
+  color:#ffffff;
+}
+
+#oldStuffNav {
+  font-weight:bold;
+}
+

ADDED   stml2/formdat.scm
Index: stml2/formdat.scm
==================================================================
--- /dev/null
+++ stml2/formdat.scm
@@ -0,0 +1,21 @@
+;; Copyright 2007-2011, 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 formdat))
+
+(module formdat
+    *
+
+(import chicken scheme data-structures extras srfi-13 ports )
+(use html-filter)
+
+(use regex)
+(require-extension srfi-69)
+
+)

ADDED   stml2/html-filter.scm
Index: stml2/html-filter.scm
==================================================================
--- /dev/null
+++ stml2/html-filter.scm
@@ -0,0 +1,21 @@
+;; Copyright 2007-2011, 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 html-filter))
+
+(module html-filter
+    *
+
+(import chicken scheme data-structures extras srfi-13 ports )
+(use misc-stml)
+
+(require-extension regex)
+
+;; 
+)

ADDED   stml2/install.cfg.template
Index: stml2/install.cfg.template
==================================================================
--- /dev/null
+++ stml2/install.cfg.template
@@ -0,0 +1,6 @@
+
+TARGDIR=/usr/lib/cgi-bin
+LOGDIR=/tmp/stmlrun
+SQLITE3=/usr/bin/sqlite3
+# this was needed on the nokia n800 :-)
+# SQLITE3=/tmp/sqlite3

ADDED   stml2/keystore.scm
Index: stml2/keystore.scm
==================================================================
--- /dev/null
+++ stml2/keystore.scm
@@ -0,0 +1,22 @@
+;; Copyright 2007-2011, 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.
+
+;;======================================================================
+;; The meta data key store, just a general dumping ground for values
+;; only used occasionally
+;;======================================================================
+
+;; (declare (unit keystore))
+
+(module keystore
+    *
+
+(import chicken scheme data-structures extras srfi-13 ports )
+
+)

ADDED   stml2/misc-stml.scm
Index: stml2/misc-stml.scm
==================================================================
--- /dev/null
+++ stml2/misc-stml.scm
@@ -0,0 +1,24 @@
+;; Copyright 2007-2011, 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.
+
+;;======================================================================
+;; dumbobj helpers
+;;======================================================================
+
+;; (declare (unit misc-stml))
+
+(module misc-stml
+  *
+
+(import chicken scheme data-structures extras srfi-13 ports posix)
+  
+(use regex (prefix dbi dbi:))
+(use (prefix crypt c:))
+(use (prefix dbi dbi:))
+)

ADDED   stml2/modules/twiki/Makefile
Index: stml2/modules/twiki/Makefile
==================================================================
--- /dev/null
+++ stml2/modules/twiki/Makefile
@@ -0,0 +1,10 @@
+
+twiki.l.scm : twiki.l
+	csi -batch -eval '(use silex)(if (lex "twiki.l" "twiki.l.scm")(exit 0)(exit 1))'
+
+test-silex : twiki.l.scm test-silex.scm
+	csc test-silex.scm
+
+twikicount : twiki.l.scm twikicount.scm
+	csc twikicount.scm
+

ADDED   stml2/modules/twiki/misc-notes.txt
Index: stml2/modules/twiki/misc-notes.txt
==================================================================
--- /dev/null
+++ stml2/modules/twiki/misc-notes.txt
@@ -0,0 +1,46 @@
+#|
+telnet localhost 80
+GET cgi-bin/kiatoa/twiki?image=4&wiki_key=bG9jYXRpb25zIHdvcmxk HTTP/1.1
+Accept: */*
+Accept-Language: en-us
+Connection: Keep-Alive
+Host: localhost
+Referer: http://localhost/links.asp
+User-Agent: Mozilla/4.0 (compatible; MSIE 5.5; Windows NT 5.0)
+Accept-Encoding: gzip, deflate
+
+GET /kiatoa/images/kiatoa.png HTTP/1.1
+Accept: */*
+Accept-Language: en-us
+Connection: Keep-Alive
+Host: localhost
+Referer: http://localhost/links.asp
+
+GET index.html HTTP/1.1
+Accept: */*
+Accept-Language: en-us
+Connection: Keep-Alive
+Host: localhost
+Referer: http://localhost/links.asp
+
+GET /cgi-bin/kiatoa/twiki?image=2&wiki_key=bG9jYXRpb25zIHdvcmxk HTTP/1.1
+Accept: */*
+Accept-Language: en-us
+Connection: Keep-Alive
+Host: localhost
+Referer: http://192.168.2.1/cgi-bin/kiatoa/location/?twiki_maint=2
+User-Agent: Mozilla/4.0
+Accept-Encoding: gzip, deflate
+
+HTTP/1.1 200 OK
+Date: Tue, 01 Sep 2009 02:18:16 GMT
+Server: Apache/2.2.11 (Ubuntu) PHP/5.2.6-3ubuntu4.2 with Suhosin-Patch
+Last-Modified: Sun, 19 Jul 2009 02:47:52 GMT
+ETag: "a38005-12c2-46f060c330600"
+Accept-Ranges: bytes
+Content-Length: 4802
+Keep-Alive: timeout=15, max=100
+Connection: Keep-Alive
+Content-Type: image/png
+
+|#

ADDED   stml2/modules/twiki/tlayout.css
Index: stml2/modules/twiki/tlayout.css
==================================================================
--- /dev/null
+++ stml2/modules/twiki/tlayout.css
@@ -0,0 +1,172 @@
+/*{{{*/
+* html .tiddler {height:1%;}
+
+body {font-size:.75em; font-family:arial,helvetica; margin:0; padding:0;}
+
+h1,h2,h3,h4,h5,h6 {font-weight:bold; text-decoration:none;}
+h1,h2,h3 {padding-bottom:1px; margin-top:1.2em;margin-bottom:0.3em;}
+h4,h5,h6 {margin-top:1em;}
+h1 {font-size:1.35em;}
+h2 {font-size:1.25em;}
+h3 {font-size:1.1em;}
+h4 {font-size:1em;}
+h5 {font-size:.9em;}
+
+hr {height:1px;}
+
+a {text-decoration:none;}
+
+dt {font-weight:bold;}
+
+ol {list-style-type:decimal;}
+ol ol {list-style-type:lower-alpha;}
+ol ol ol {list-style-type:lower-roman;}
+ol ol ol ol {list-style-type:decimal;}
+ol ol ol ol ol {list-style-type:lower-alpha;}
+ol ol ol ol ol ol {list-style-type:lower-roman;}
+ol ol ol ol ol ol ol {list-style-type:decimal;}
+
+.txtOptionInput {width:11em;}
+
+#contentWrapper .chkOptionInput {border:0;}
+
+.externalLink {text-decoration:underline;}
+
+.indent {margin-left:3em;}
+.outdent {margin-left:3em; text-indent:-3em;}
+code.escaped {white-space:nowrap;}
+
+.tiddlyLinkExisting {font-weight:bold;}
+.tiddlyLinkNonExisting {font-style:italic;}
+
+/* the 'a' is required for IE, otherwise it renders the whole tiddler in bold */
+a.tiddlyLinkNonExisting.shadow {font-weight:bold;}
+
+#mainMenu .tiddlyLinkExisting,
+	#mainMenu .tiddlyLinkNonExisting,
+	#sidebarTabs .tiddlyLinkNonExisting {font-weight:normal; font-style:normal;}
+#sidebarTabs .tiddlyLinkExisting {font-weight:bold; font-style:normal;}
+
+.header {position:relative;}
+.header a:hover {background:transparent;}
+.headerShadow {position:relative; padding:4.5em 0em 1em 1em; left:-1px; top:-1px;}
+.headerForeground {position:absolute; padding:4.5em 0em 1em 1em; left:0px; top:0px;}
+
+.siteTitle {font-size:3em;}
+.siteSubtitle {font-size:1.2em;}
+
+#mainMenu {position:absolute; left:0; width:10em; text-align:right; line-height:1.6em; padding:1.5em 0.5em 0.5em 0.5em; font-size:1.1em;}
+
+#sidebar {position:absolute; right:3px; width:16em; font-size:.9em;}
+#sidebarOptions {padding-top:0.3em;}
+#sidebarOptions a {margin:0em 0.2em; padding:0.2em 0.3em; display:block;}
+#sidebarOptions input {margin:0.4em 0.5em;}
+#sidebarOptions .sliderPanel {margin-left:1em; padding:0.5em; font-size:.85em;}
+#sidebarOptions .sliderPanel a {font-weight:bold; display:inline; padding:0;}
+#sidebarOptions .sliderPanel input {margin:0 0 .3em 0;}
+#sidebarTabs .tabContents {width:15em; overflow:hidden;}
+
+.wizard {padding:0.1em 1em 0em 2em;}
+.wizard h1 {font-size:2em; font-weight:bold; background:none; padding:0em 0em 0em 0em; margin:0.4em 0em 0.2em 0em;}
+.wizard h2 {font-size:1.2em; font-weight:bold; background:none; padding:0em 0em 0em 0em; margin:0.4em 0em 0.2em 0em;}
+.wizardStep {padding:1em 1em 1em 1em;}
+.wizard .button {margin:0.5em 0em 0em 0em; font-size:1.2em;}
+.wizardFooter {padding:0.8em 0.4em 0.8em 0em;}
+.wizardFooter .status {padding:0em 0.4em 0em 0.4em; margin-left:1em;}
+.wizard .button {padding:0.1em 0.2em 0.1em 0.2em;}
+
+#messageArea {position:fixed; top:2em; right:0em; margin:0.5em; padding:0.5em; z-index:2000; _position:absolute;}
+.messageToolbar {display:block; text-align:right; padding:0.2em 0.2em 0.2em 0.2em;}
+#messageArea a {text-decoration:underline;}
+
+.tiddlerPopupButton {padding:0.2em 0.2em 0.2em 0.2em;}
+.popupTiddler {position: absolute; z-index:300; padding:1em 1em 1em 1em; margin:0;}
+
+.popup {position:absolute; z-index:300; font-size:.9em; padding:0; list-style:none; margin:0;}
+.popup .popupMessage {padding:0.4em;}
+.popup hr {display:block; height:1px; width:auto; padding:0; margin:0.2em 0em;}
+.popup li.disabled {padding:0.4em;}
+.popup li a {display:block; padding:0.4em; font-weight:normal; cursor:pointer;}
+.listBreak {font-size:1px; line-height:1px;}
+.listBreak div {margin:2px 0;}
+
+.tabset {padding:1em 0em 0em 0.5em;}
+.tab {margin:0em 0em 0em 0.25em; padding:2px;}
+.tabContents {padding:0.5em;}
+.tabContents ul, .tabContents ol {margin:0; padding:0;}
+.txtMainTab .tabContents li {list-style:none;}
+.tabContents li.listLink { margin-left:.75em;}
+
+#contentWrapper {display:block;}
+#splashScreen {display:none;}
+
+#displayArea {margin:1em 17em 0em 14em;}
+
+.toolbar {text-align:right; font-size:.9em;}
+
+.tiddler {padding:1em 1em 0em 1em;}
+
+.missing .viewer,.missing .title {font-style:italic;}
+
+.title {font-size:1.6em; font-weight:bold;}
+
+.missing .subtitle {display:none;}
+.subtitle {font-size:1.1em;}
+
+.tiddler .button {padding:0.2em 0.4em;}
+
+.tagging {margin:0.5em 0.5em 0.5em 0; float:left; display:none;}
+.isTag .tagging {display:block;}
+.tagged {margin:0.5em; float:right;}
+.tagging, .tagged {font-size:0.9em; padding:0.25em;}
+.tagging ul, .tagged ul {list-style:none; margin:0.25em; padding:0;}
+.tagClear {clear:both;}
+
+.footer {font-size:.9em;}
+.footer li {display:inline;}
+
+.annotation {padding:0.5em; margin:0.5em;}
+
+* html .viewer pre {width:99%; padding:0 0 1em 0;}
+.viewer {line-height:1.4em; padding-top:0.5em;}
+.viewer .button {margin:0em 0.25em; padding:0em 0.25em;}
+.viewer blockquote {line-height:1.5em; padding-left:0.8em;margin-left:2.5em;}
+.viewer ul, .viewer ol {margin-left:0.5em; padding-left:1.5em;}
+
+.viewer table, table.twtable {border-collapse:collapse; margin:0.8em 1.0em;}
+.viewer th, .viewer td, .viewer tr,.viewer caption,.twtable th, .twtable td, .twtable tr,.twtable caption {padding:3px;}
+table.listView {font-size:0.85em; margin:0.8em 1.0em;}
+table.listView th, table.listView td, table.listView tr {padding:0px 3px 0px 3px;}
+
+.viewer pre {padding:0.5em; margin-left:0.5em; font-size:1.2em; line-height:1.4em; overflow:auto;}
+.viewer code {font-size:1.2em; line-height:1.4em;}
+
+.editor {font-size:1.1em;}
+.editor input, .editor textarea {display:block; width:100%; font:inherit;}
+.editorFooter {padding:0.25em 0em; font-size:.9em;}
+.editorFooter .button {padding-top:0px; padding-bottom:0px;}
+
+.fieldsetFix {border:0; padding:0; margin:1px 0px 1px 0px;}
+
+.sparkline {line-height:1em;}
+.sparktick {outline:0;}
+
+.zoomer {font-size:1.1em; position:absolute; overflow:hidden;}
+.zoomer div {padding:1em;}
+
+* html #backstage {width:99%;}
+* html #backstageArea {width:99%;}
+#backstageArea {display:none; position:relative; overflow: hidden; z-index:150; padding:0.3em 0.5em 0.3em 0.5em;}
+#backstageToolbar {position:relative;}
+#backstageArea a {font-weight:bold; margin-left:0.5em; padding:0.3em 0.5em 0.3em 0.5em;}
+#backstageButton {display:none; position:absolute; z-index:175; top:0em; right:0em;}
+#backstageButton a {padding:0.1em 0.4em 0.1em 0.4em; margin:0.1em 0.1em 0.1em 0.1em;}
+#backstage {position:relative; width:100%; z-index:50;}
+#backstagePanel {display:none; z-index:100; position:absolute; width:90%; margin:0em 3em 0em 3em; padding:1em 1em 1em 1em;}
+.backstagePanelFooter {padding-top:0.2em; float:right;}
+.backstagePanelFooter a {padding:0.2em 0.4em 0.2em 0.4em;}
+#backstageCloak {display:none; z-index:20; position:absolute; width:100%; height:100px;}
+
+.whenBackstage {display:none;}
+.backstageVisible .whenBackstage {display:block;}
+/*}}}*/

ADDED   stml2/modules/twiki/twiki-mod.scm
Index: stml2/modules/twiki/twiki-mod.scm
==================================================================
--- /dev/null
+++ stml2/modules/twiki/twiki-mod.scm
@@ -0,0 +1,984 @@
+;; Copyright 2007-2010, 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.
+
+;; twiki module
+(require-extension sqlite3 regex posix md5 message-digest base64)
+(import (prefix base64 base64:))
+
+;; TODO
+;;
+;; * Inline tiddlers [inline[TiddlerName]]
+;; * Pics            [pic X Y[picname.jpg]]
+;; * Move twiki parsing/expanding to mattsutils as loadable module
+
+;; Routines intended to be overridden by end users
+;;  (twiki:access keys wiki-name user-id)
+;; search the code for "override" for more.
+
+;; twiki css
+;; =========
+;; Block                tag
+;; -----                ---
+;; twiki                twiki
+;; twiki body div       twiki-node
+;; twiki main menu      twiki-main-menu
+
+;; This is the currently supported mechanism. Postgres will be added later -mrw- 7/26/2009
+;;
+(define (twiki:open-db key . create-not-ok)
+  ;; (s:log "Got to twiki:open-db with key: " key)
+  (let* ((create-ok (if (null? create-not-ok) #t (car create-not-ok)))
+	 (fdat      (twiki:key->fname key))
+	 (basepath  (sdat-get-twikidir s:session))
+	 (fpath     (car fdat))
+	 (fname     (cadr fdat))
+	 (fulldir   (conc basepath "/" fpath))
+	 (fullname  (let ((fn (conc fulldir "/" fname)))
+		      (if (sdat-get-debugmode s:session)(s:log "\ntwikipath: " fn))
+		      fn))
+	 (fexists   (file-exists? fullname))
+	 (db        (if fexists (dbi:open 'sqlite3 (list (cons 'dbname fullname))) #f)))
+    (if (and (not db)
+	     (not create-ok))
+	(exit 100)
+	(begin
+	  (if (not fexists)
+	      (begin
+		;; (print "fullname: " fullname)
+		(if (sdat-get-debugmode s:session)
+		    (s:log "\ncreating fulldir: " fulldir))
+		(twiki:register-wiki key fullname)
+		(system (conc "mkdir -p " fulldir)) ;; create the path
+		(if (file-exists? fpath)
+		    (s:log "OK: dir " fpath " has been made")
+		    (s:log "ERROR: Failed to make the path for the twiki"))
+		(set! db (dbi:open 'sqlite3 (list (cons 'dbname fullname))))
+		(for-each 
+		 (lambda (sqry)
+		   ;; (print sqry)
+		   (dbi:exec db sqry))
+		 ;; types: 0 text, 1 jpg, 2 png, 3 svg, 4 spreadsheet, 5 audio, 6 video :: better specs to come...
+		 (list
+		  "CREATE TABLE pics      (id INTEGER PRIMARY KEY,name TEXT,wiki_id INTEGER,dat_id INTEGER,thumb_dat_id INTEGER,created_on INTEGER,owner_id INTEGER);"
+		  "CREATE TABLE dats      (id INTEGER PRIMARY KEY,md5sum TEXT,dat BLOB,type INTEGER);"
+		  ;; on every modification a new tiddlers entry is created. When displaying the tiddlers do:
+		  ;;    select where created_on < somedate order by created_on desc limit 1
+		  "CREATE TABLE tiddlers (id INTEGER PRIMARY KEY,wiki_id INTEGER,name TEXT,rev INTEGER,dat_id INTEGER,created_on INTEGER,owner_id INTEGER);"
+		  ;; rev and tag only utilized when user sets a tag. All results from a select as above for tiddlers are set to the tag
+		  "CREATE TABLE revs     (id INTEGER PRIMARY KEY,tag TEXT);"
+		  ;; wikis is here for when postgresql support is added or if a sub wiki is created. 
+		  "CREATE TABLE wikis    (id INTEGER PRIMARY KEY,name TEXT,created_on INTEGER);"
+		  ;; access control, negative numbered groups are private groups, postive numbered groups are system groups
+		  ;; permissions are on a per-wiki granularity
+		  ;; access; 0=none,1=read,2=read/write
+		  "CREATE TABLE perms    (id INTEGER PRIMARY KEY,wiki_id INTEGER,group_id INTEGER,access INTEGER);"
+		  "CREATE TABLE groups   (id INTEGER PRIMARY KEY,name TEXT);"
+		  "CREATE TABLE members  (id INTEGER PRIMARY KEY,person_id INTEGER,group_id INTEGER);"
+		  ;; setup and configuration data
+		  "CREATE TABLE meta     (id INTEGER PRIMARY KEY,key TEXT,val TEXT);"
+		  ;; need to create an entry for *this* twiki
+		  (conc "INSERT INTO wikis (id,name,created_on) VALUES (1,'main'," (current-seconds) ");")))
+		;;     (conc "INSERT INTO tiddlers (wiki_id,name,created_on) VALUES(1,'MainMenu'," (current-seconds) ");")))))
+		(twiki:save-tiddler db "MainMenu" "[[FirstTiddler]]" "" 1 1)))
+	  ;; (sqlite3:set-busy-timeout!(dbi:db-conn db) 1000000)
+	  db))))
+
+;;======================================================================
+;; twikis (db naming, sqlite vs postgresql, keys etc.
+;;======================================================================
+
+;; A wiki is specified by a list of keys, here we convert that list to a single string
+(define (twiki:keys->key keys)
+  (if (not (null? keys))
+      (string-intersperse (map conc keys) " ")
+      " "))
+
+(define (twiki:key->fname key)
+  (let* (;; (md5keypath (md5:digest key)) ;; (twiki:keys->key keys)))
+	 (keypath    (twiki:web64enc key))
+	 (delta      (quotient (string-length keypath) 3)) ;; 
+	 (p1         (substring keypath 0           delta)) ;;  0  8))
+	 (p2         (substring keypath delta       (* delta 2)));;  8 16))
+	 (p3         (substring keypath (* delta 2) (* delta 3)))) ;; 16 24))
+    (list (string-intersperse (list "dbs" p1 p2 p3) "/") keypath)))
+
+;; look up the wid based on the keys, this is used for sub wikis only. I.e. a wiki instantiated inside another wiki 
+;; giving a separate namespace to all the tiddlers
+(define (twiki:name->wid db name) 
+  (let ((wid (dbi:get-one db "SELECT id FROM wikis WHERE name=?;" name)))
+    (if wid wid
+	(begin
+	  (dbi:exec db "INSERT INTO wikis (name,created_on) VALUES(?,?);" name (current-seconds))
+	  (twiki:name->wid db name)))))
+
+;;======================================================================
+;; twiki record
+;;======================================================================
+
+;; make-vector-record twiki wiki wid name key dbh
+(define (make-twiki:wiki)(make-vector 5))
+(define-inline (twiki:wiki-get-wid    vec)    (vector-ref  vec 0))
+(define-inline (twiki:wiki-get-name   vec)    (vector-ref  vec 1))
+(define-inline (twiki:wiki-get-key    vec)    (vector-ref  vec 2))
+(define-inline (twiki:wiki-get-dbh    vec)    (vector-ref  vec 3))
+(define-inline (twiki:wiki-get-perms  vec)    (vector-ref  vec 4))
+
+(define-inline (twiki:wiki-set-wid!   vec val)(vector-set! vec 0 val))
+(define-inline (twiki:wiki-set-name!  vec val)(vector-set! vec 1 val))
+(define-inline (twiki:wiki-set-key!   vec val)(vector-set! vec 2 val))
+(define-inline (twiki:wiki-set-dbh!   vec val)(vector-set! vec 3 val))
+(define-inline (twiki:wiki-set-perms! vec val)(vector-set! vec 4 val))
+
+;;======================================================================
+;; twiki misc
+;;======================================================================
+
+;; returns help html
+(define (twiki:help section)
+  (let ((main (twiki:div 
+	       'node "twiki-help"
+	       (list 
+		(twiki:h3 "Help stuff")
+		(twiki:pre "
+Link to page:      [[Page Title]]
+Heading3:          !!! The heading
+Underline:         __underlined__
+Table:             | cell1 | cell2 |
+List:              # item1
+                   ## item2
+Bullet:            * item1
+                   ** item2
+Preformatted:      {{{stuff here}}}
+Insert a picture:  [pic[PicName]]
+Or with size:      [pic100x100[PicName]]
+Upload the picture using the \"Pic\" link first")))))
+	;;(case section
+    main))
+
+;;======================================================================
+;; twiki access control
+;;======================================================================
+
+;; idea here is for the end user to redefine this routine,
+;; and call twiki:interal-access if desired
+;; 
+;; if override is #t then give access no matter what
+(define (twiki:access keys wiki-name user-id)
+  '(r w))
+
+;; Add support for storing groups, users and access internally
+;; 
+(define (twiki:internal-access keys wiki-name user-id)
+  #f)
+
+;;======================================================================
+;; twiki registry
+;;======================================================================
+
+;; these can be overridden by end user (just create a new routine by the same name)
+
+(define (twiki:open-registry)
+  (let* ((basepath  (sdat-get-twikidir s:session))
+	 (regfile   (conc basepath "/registry.db"))
+	 (regexists (file-exists? regfile))
+	 (db        #f))
+    (if (sdat-get-debugmode s:session)
+	(s:log "regfile: " regfile " regexists: " regexists " db: " db))
+    (set! db (dbi:open 'sqlite3 (list (cons 'dbname regfile))))
+    (if regexists
+	db
+	(begin
+	  (for-each (lambda (stmt)(dbi:exec db stmt))
+		    (list "CREATE TABLE wikis (key TEXT PRIMARY KEY,path TEXT,creation_date INTEGER,creator_id INTEGER);"))
+	  db))))
+
+(define (twiki:register-wiki key path)
+  (let ((db (twiki:open-registry)))
+    (dbi:exec db 
+	      "INSERT OR REPLACE INTO wikis (key,path,creation_date,creator_id) VALUES(?,?,?,?);"
+	      key path (current-seconds) (twiki:get-id))
+    (dbi:close db)))
+
+;;======================================================================
+;; tiddlers
+;;======================================================================
+
+(define twiki:tiddler-selector "SELECT t.id,t.name,t.rev,t.dat_id,t.created_on,t.owner_id FROM tiddlers AS t INNER JOIN dats AS d ON t.dat_id=d.id")
+(define (twiki:tiddler-make)(make-vector 8 #f))
+(define-inline (twiki:tiddler-get-id           vec)    (vector-ref  vec 0))
+(define-inline (twiki:tiddler-get-name         vec)    (vector-ref  vec 1))
+(define-inline (twiki:tiddler-get-rev          vec)    (vector-ref  vec 2))
+(define-inline (twiki:tiddler-get-dat-id       vec)    (vector-ref  vec 3))
+(define-inline (twiki:tiddler-get-created_on   vec)    (vector-ref  vec 4))
+(define-inline (twiki:tiddler-get-owner_id     vec)    (vector-ref  vec 5))
+;; (define-inline (twiki:tiddler-get-dat-type     vec)    (vector-ref  vec 6))
+
+(define-inline (twiki:tiddler-set-id!          vec val)(vector-set! vec 0 val) vec)
+(define-inline (twiki:tiddler-set-name!        vec val)(vector-set! vec 1 val) vec)
+(define-inline (twiki:tiddler-set-rev!         vec val)(vector-set! vec 2 val) vec)
+(define-inline (twiki:tiddler-set-dat-id!      vec val)(vector-set! vec 3 val) vec)
+(define-inline (twiki:tiddler-set-created_on!  vec val)(vector-set! vec 4 val) vec)
+;; (define-inline (twiki:tiddler-set-owner_id!    vec val)(vector-set! vec 5 val))
+
+;;======================================================================
+;; Routines for displaying, editing, browsing etc. tiddlers
+;;======================================================================	
+
+;; should change this to take a tiddler structure?
+;; This is the display of a single tiddler
+(define (twiki:view dat  tkey wid tiddler wiki) ;; close, close others, edit, more
+  (let ((is-not-main  (not (equal? "MainMenu" (twiki:tiddler-get-name tiddler))))
+	(edit-allowed (member 'w (twiki:wiki-get-perms wiki))))
+    (s:div 'class "tiddler"
+	   (s:div 'class "tiddler-menu"
+		  (if (equal? "MainMenu" (twiki:tiddler-get-name tiddler))
+		      (if edit-allowed
+			  (list (s:a "edit" 'href
+				     (s:link-to (twiki:get-link-back-to-current)
+						'edit_tiddler (twiki:tiddler-get-id tiddler))))
+			  '())
+		      (s:div 'class "tiddler-menu-internal"
+		       (s:a "close" 'href (s:link-to (twiki:get-link-back-to-current) 'close_tiddler (twiki:tiddler-get-id tiddler))) "."
+		       (s:a "close others" 'href (s:link-to (twiki:get-link-back-to-current) 'close_other_tiddlers (twiki:tiddler-get-id tiddler))) "."
+		       (if edit-allowed
+			   (s:a "edit"  'href (s:link-to (twiki:get-link-back-to-current) 'edit_tiddler (twiki:tiddler-get-id tiddler)))
+			   '()))))
+	    (s:p (twiki:dat->html dat wiki)))))
+
+(define (twiki:view-tiddler db  tkey wid tiddler wiki)
+  (let* ((dat-id (twiki:tiddler-get-dat-id tiddler))
+	 (dat    (twiki:get-dat db dat-id))
+	 (tnum   (twiki:tiddler-get-id tiddler)))
+    ;; (s:log "twid: " dat-id " dat: " dat)
+    (twiki:view dat  tkey wid tiddler wiki)))
+
+;; call with param => action-name-key e.g. save-bWFpbg__-aGVsbG8gbnVyc2U_ (save main "hello nurse")
+;; this one is called when an edit form is submitted (i.e. POST)
+(define (twiki:action params)
+  (if (and (list? params)
+	   (> (length params) 0))
+      (let* ((cmdln (string-split (car params) "-"))
+	     (cmd   (string->symbol (car cmdln)))
+	     (tkey  (twiki:web64dec (caddr cmdln)))
+	     (wid   (string->number (cadr cmdln)))
+	     (tdb   (twiki:open-db tkey)))
+	(s:log "cmdln: " cmdln " cmd: " cmd " tkey: " tkey " wid: " wid)
+	(case cmd
+	  ((save)
+	   (twiki:save-curr-tiddler tdb wid))
+	  ((savepic)
+	   (s:log "twiki:action got to savepic")
+	   (twiki:save-pic-from-form tdb wid))
+	  ((cancel) ;; deprecated. Use a link for this (i.e in the twiki:twiki proc
+	   (s:del! (conc "CURRENT_TWIDLER_UNDER_EDIT:" wid))
+	   )))))
+
+;; generate a form for editing a twiddler tnum
+(define (twiki:edit-tiddler db tkey wid tnum)
+  (s:log "twiki:edit-tiddler: tkey=" tkey " wid: " wid)
+  (let* ((enc-key  (twiki:web64enc tkey))
+	 (tiddats  (twiki:get-tiddlers-by-num db wid (list tnum))))
+    (if (null? tiddats)
+	(let* ((tid    0)
+	       (dat-id 0))
+	  (s:set! "twiki_title" "")
+	  (s:set! "twiki_body"  ""))
+	(let* ((tid    (car tiddats))
+	       (dat-id (twiki:tiddler-get-dat-id tid)))
+	  ;; (s:log "tid: " tid " dat-id: " dat-id)
+	  (s:set! "twiki_title" (twiki:tiddler-get-name tid))
+	  (s:set! "twiki_body"  (twiki:get-dat db dat-id))))
+    (s:form 'action (s:link-to (twiki:get-link-back-to-current)
+			       'action (conc "twiki.save-" (number->string wid) "-" enc-key))
+	    'method "post" ;; 'twikiname tkey ;; done, cancel, delete
+	    (s:input 'type "submit"   'name "form-name" 'value "save" 'twikiname tkey)
+	    ;; (s:a "done" 'href (s:link-to (twiki:get-link-back-to-current) 'save_tmenu tnum))
+	    (s:a "cancel" 'href (s:link-to (twiki:get-link-back-to-current) 'cancel_tedit tnum)) "."
+	    (s:a "delete" 'href (s:link-to (twiki:get-link-back-to-current) 'delete_tiddler tnum))(s:br)
+	    (s:input-preserve 'type "text" 'name "twiki_title" 'size "58" 'maxlength "150")
+	    (s:textarea-preserve 'type "textarea" 'name "twiki_body" 'rows "10" 'cols "65")
+	    (s:p "Tags" (s:input-preserve 'type "text" 'name "twiki_tags" 'size "55" 'maxlength "150")))))
+
+;; save a tiddler to the db for the twiki twik, getting data from the INPUT
+(define (twiki:save-curr-tiddler tdb wid)
+  (formdat:printall (sdat-get-formdat s:session) s:log)
+  (let* ((heading (s:get-input 'twiki_title))
+	 (body    (s:get-input 'twiki_body))
+	 (tags    (s:get-input 'twiki_tags))
+	 (uid     (twiki:get-id)))
+    ;; (s:log "twiki:save-curr-tiddler heading: " heading " body: " body " tags: " tags)
+    (s:set! 'twiki_title heading)
+    (if body
+	(begin
+	  (set! body (string-chomp body))
+	  (s:set! 'twiki_body  body)))
+    (s:set! 'twiki_tags  tags)
+    (s:del! (conc "CURRENT_TWIDLER_UNDER_EDIT:" wid))
+    (let ((res (twiki:save-tiddler tdb heading body tags wid uid)))
+      ;; Now, replace this twiddler number in the view list with 
+      ;; the new number from the db
+      (twiki:normalize-current-twiddlers tdb wid)
+      (s:del! 'twiki_title)
+      (s:del! 'twiki_body)
+      (s:del! 'twiki_tags)
+      res)
+    ))
+
+(define (twiki:normalize-current-twiddlers tdb wid)
+  (let* ((cvar      (conc "CURRENT_TWIDLERS:" wid))
+	 (curr-slst (s:get cvar))
+	 (curr-lst  (map string->number (string-split curr-slst ",")))
+	 (tdlrs     (twiki:get-tiddlers-by-num tdb wid curr-lst))
+	 (names     (remove (lambda (t)(string=? "MainMenu" t))
+			    (map twiki:tiddler-get-name tdlrs)))
+	 (newnums   (map twiki:tiddler-get-id 
+			 (map (lambda (tn)
+				(twiki:get-tiddler-by-name tdb wid tn))
+			      names))))
+    (s:set! cvar (string-intersperse (map number->string newnums)
+				     ","))))
+    
+;; generic save tiddler
+(define (twiki:save-tiddler tdb heading body tags wid uid)
+    (if (misc:non-zero-string heading)
+	(let* ((prev-tid (twiki:get-tiddler-by-name tdb wid heading))
+	       (prev-dat-id (if prev-tid 
+				(twiki:tiddler-get-dat-id prev-tid)
+				-1))
+	       (dat-id (twiki:save-dat tdb body 0))) ;; 0=text
+	  ;; (s:log "twiki:save-tiddler dat-id: " dat-id " body: " body)
+	  (if (equal? prev-dat-id dat-id) ;; no need to insert a new record if the dat didn't change
+	      #t
+	      (dbi:exec tdb 
+			"INSERT INTO tiddlers (wiki_id,name,dat_id,created_on,owner_id) VALUES(?,?,?,?,?);"
+			wid heading dat-id (current-seconds) uid))
+	  #t) ;; success
+	#f))  ;; non-success
+
+;; text=0, jpg=1, png=2
+(define (twiki:save-dat db dat type)
+  (let* ((md5sum (message-digest-string (md5-primitive) dat)) ;; (md5-digest dat))
+	 (datid  (twiki:dat-exists? db md5sum type))
+	 (datblob (if (string? dat)
+		      (string->blob dat)
+		      dat)))
+    (if datid
+	datid
+	(begin
+	  (case type
+	    ((0)   (dbi:exec db "INSERT INTO dats (md5sum,dat,type) VALUES(?,?,?);" md5sum datblob 0))
+	    ((1)   (dbi:exec db "INSERT INTO dats (md5sum,dat,type) VALUES(?,?,?);" md5sum datblob 1))
+	    (else  (dbi:exec db "INSERT INTO dats (md5sum,dat,type) VALUES(?,?,?);" md5sum datblob type)))
+	  (twiki:dat-exists? db md5sum type)))))
+       
+(define (twiki:dat-exists? db md5sum type)
+  (dbi:get-one db "SELECT id FROM dats WHERE md5sum=? AND type=?;" md5sum type))
+
+(define (twiki:get-dat db id)
+  (if (and id (number? id))
+      (if (< id 0)
+	  ""
+	  (let ((res (dbi:get-one-row db "SELECT dat,type FROM dats WHERE id=?;" id)))
+	    (if res
+		(case (vector-ref res 1)
+		  ((0)(blob->string (vector-ref res 0)))
+		  (else (vector-ref res 0)))
+		#f)))
+      #f))
+
+(define (twiki:maint_area tdb wid tkey wiki)
+  (let ((maint (s:get-param 'twiki_maint))
+	(write-perm (member 'w (twiki:wiki-get-perms wiki))))
+    (s:div 'class "twiki-menu-internal"
+     (if write-perm
+	 (list (s:a "Orphans"  'href (s:link-to (twiki:get-link-back-to-current) 'twiki_maint 1))(s:br)
+	       (s:a "Pics"     'href (s:link-to (twiki:get-link-back-to-current) 'twiki_maint 2))(s:br)
+	       (s:a "Help"     'href (s:link-to (twiki:get-link-back-to-current) 'twiki_maint 4))(s:br))
+	 '())
+     (s:a "Search"   'href (s:link-to (twiki:get-link-back-to-current) 'twiki_maint 3))(s:br)
+     (case maint
+       ((1)
+	(twiki:list-orphans tdb))
+       (else
+	 '())))))
+
+;;======================================================================
+;; Orphans
+;;======================================================================
+(define (twiki:make-tiddler-list tdlrs . tnums)
+  (conc (string-intersperse 
+	 (map conc (delete-duplicates
+		    (append (map twiki:tiddler-get-id tdlrs) tnums)))
+	 ",")))
+
+(define (twiki:get-orphans tdb)
+  '())
+
+(define (twiki:list-orphans tdb)
+  '())
+
+;;======================================================================
+;; Pictures
+;;======================================================================
+(define (twiki:pic_mgmt tdb wid tkey)
+  (s:div 
+   (s:a "Add pic" 'href (s:link-to (twiki:get-link-back-to-current) 'twiki_maint 2 'twiki_maint_add_pics 1))(s:br)
+   (if (s:get-param "twiki_maint_add_pics")
+       (s:form 'enctype "multipart/form-data" ;; 'name "does-a-form-have-a-name"
+	       (s:input 'type "file" 'name "input-picture" 'value "Upload pic")
+	       (s:input 'type "submit" 'name "submit-picture" 'value "Submit")
+	       'method "post" 
+	       'action (s:link-to (twiki:get-link-back-to-current) 'action (conc "twiki.savepic-" (number->string wid) "-" (twiki:web64enc tkey)))
+	       (s:input 'type "text" 'name "picture-name" 'value ""))
+       '())
+   (let ((pics (dbi:get-rows tdb "SELECT id,name,dat_id,thumb_dat_id FROM pics WHERE wiki_id=?;" wid)))
+     (map (lambda (pic)
+	    (s:div 'class "tiddlerthumb"
+		   (s:img 'title (vector-ref pic 1) 'alt (vector-ref pic 1)
+		 	  ;; 'src (s:link-to "twiki" 'wiki_key (twiki:web64enc tkey) 'image  (vector-ref pic 0)))
+		 	  'src (s:link-to "twiki" 'wiki_key (conc (number->string wid) "-" (twiki:web64enc tkey))
+					  'thumb  (vector-ref pic 0)))
+		   ;;       (conc "twiki/" wid "/thumbs/" (vector-ref pic 0))))
+		   (vector-ref pic 0) (vector-ref pic 1)))
+	  pics))))
+
+(define  (twiki:save-pic-from-form tdb wid)
+  (let* ((pic-dat  (s:get-input 'input-picture))
+	 (alt-name (s:get-input 'picture-name)))
+    (if pic-dat
+	(begin
+	  (s:log "twiki:save-pic-from-form with pic-dat=" pic-dat " and alt-name=" alt-name)
+	  (twiki:save-pic tdb pic-dat wid alt-name))
+	#f)))
+
+;; get pic id for a pic name, returns the latest
+(define (twiki:get-pic-id tdb pic-name wid)
+  (dbi:get-one tdb "SELECT pics.id FROM pics WHERE pics.name=? AND pics.wiki_id=? ORDER BY pics.id DESC LIMIT 1;" pic-name wid))
+
+(define (twiki:save-pic tdb pic-dat wid alt)
+  (let ((pic-name (car pic-dat))
+	(pic-type (cadr pic-dat))
+	(pic-data (caddr pic-dat))
+	;; I'm not too happy with this solution but I can't seem to chomp the \n\d from the end of the string
+	(alt-name (if alt (string-substitute (regexp "[^\\w ]") "" alt #t) #f)))
+    (if (and alt-name
+	     (string-match (regexp "\\w+") alt-name))
+	(set! pic-name alt-name))
+    (s:log "alt: " alt " alt-name: " alt-name)
+    (if pic-data
+	(let ((dat-id (twiki:save-dat tdb pic-data (twiki:mime->twiki-type pic-type)))
+	      (creation-time (current-seconds)))
+	  ;; (twiki:delete-pic-by-name tdb pic-name)
+	  (dbi:exec tdb 
+		    "INSERT INTO pics (name,wiki_id,dat_id,created_on,owner_id) VALUES(?,?,?,?,?);"
+		    pic-name wid dat-id creation-time (twiki:get-id))
+	  (let ((pic-id (twiki:get-pic-id tdb pic-name wid)))
+	    (twiki:make-thumbnail tdb pic-id wid))
+	  #t)
+	#f)))
+
+(define (twiki:get-pic-dat tdb wid pic-id)
+  (dbi:get-one tdb "SELECT dat FROM pics INNER JOIN dats ON pics.dat_id=dats.id WHERE pics.id=? AND wiki_id=?;" pic-id wid))
+
+(define (twiki:get-thumb-dat tdb wid pic-id)
+  (dbi:get-one tdb "SELECT dat FROM pics INNER JOIN dats ON pics.thumb_dat_id=dats.id WHERE pics.id=? AND wiki_id=?;" pic-id wid))
+
+;; this one sets up the Content type, puts the data into page-dat and is done
+(define (twiki:return-image-dat tdb wid pic-id)
+  (let ((dat  (twiki:get-pic-dat tdb wid pic-id)))
+    (s:log "twiki:return-image-dat dat is: " dat " of size: " (if (blob? dat)(blob-size dat) "[not a blob]"))
+    (sdat-set-page-type!    s:session 'image)
+    (sdat-set-content-type! s:session "image/jpeg")
+    (sdat-set-alt-page-dat! s:session dat)))
+    ;; (session:alt-out s:session)))
+
+;; this one sets up the Content type, puts the data into page-dat and is done
+(define (twiki:return-thumb-dat tdb wid pic-id)
+  (let ((dat  (twiki:get-thumb-dat tdb wid pic-id)))
+    (s:log "twiki:return-image-dat dat is: " dat " of size: " (if (blob? dat)(blob-size dat) "[not a blob]"))
+    (sdat-set-page-type!    s:session 'image)
+    (sdat-set-content-type! s:session "image/jpeg")
+    (sdat-set-alt-page-dat! s:session dat)))
+    ;; (session:alt-out s:session)))
+  
+(define (twiki:make-thumbnail tdb pic-id wid)
+  (let ((indat  (twiki:get-pic-dat tdb wid pic-id)))
+    ;;   (outdat (open-output-string)))
+    (let-values (((inp oup pid)(process "convert" (list "-size" "500x180" "-" "-thumbnail" "250x90" "-unsharp" "0x.5" "-"))))
+		(write-string (blob->string indat) #f oup)
+		(close-input-port oup)
+		;; (write-string #f inp (blob->string indat))
+		(let ((l (read-string #f inp)))
+		  (close-output-port inp)
+		  ;; (write-string l #f outdat)
+		  (let* ((newdat (string->blob l)) ;; (get-output-string outdat)))
+			 (dat-id (twiki:save-dat tdb newdat 2))) ;; bug?
+		    (dbi:exec tdb "UPDATE pics SET thumb_dat_id=? WHERE id=?;" dat-id pic-id)
+		    dat-id)))))
+
+;; not tested
+(define (twiki:picdat->thumbdat picdat)
+  (let-values (((inp oup pid)(process "convert" ;; (list "-size" "500x180" "-" "-thumbnail" "250x90" "-unsharp" "0x.5" "-"))))
+				      (list "-size" "500x180" "-" "-thumbnail" "200x70" "-unsharp" "0x.5" "-"))))
+	      (write-string (blob->string picdat) #f oup)
+	      (close-input-port oup)
+	      ;; (write-string #f inp (blob->string indat))
+	      (let ((l (read-string #f inp)))
+		(close-output-port inp)
+		(write-string l #f oup)
+		(string->blob l))))
+
+(define (twiki:mime->twiki-type mime-type)
+  (case (string->symbol mime-type)
+    ((image/jpeg) 1)
+    ((image/png)  2)
+    (else 0)))
+
+;;======================================================================
+;; Wiki stuff
+;;======================================================================
+
+;; curr-tiddlers is a list of the names of the current tiddlers displayed
+;; tiddler-under-edit is the tiddler being edited (or #f for none).
+(define (twiki:wiki name keys)
+  (let ((perms   (twiki:access name keys (twiki:get-id))))
+    ;; (s:log "twiki:wiki name: \"" name "\" keys: " keys)
+    (if (or (not name)
+	    (string=? name "")) ;; name must be "" or #f to get here and return an image
+	;; handle returning pictures, note keys and name are ignored for these. They are called out in
+	;; the twiki/view.scm (twiki:twiki "blah" '(nada foo)) call.
+	(let ((image   (s:get-param "image"))
+	      (thumb   (s:get-param "thumb")))
+	  (s:log "image: " image " thumb: " thumb " wiki_key: " (s:get-param 'wiki_key))
+	  (if (and (member 'r perms) image)
+	      (let* ((varlst (string-split (s:get-param 'wiki_key) "-"))
+		     (tkey (twiki:web64dec (cadr varlst)))
+		     (wid  (string->number (car  varlst)))
+		     (tdbn (twiki:open-db tkey #f)))
+		(s:log "tkey: " tkey " image number: " image)
+		(twiki:return-image-dat tdbn wid (string->number image)))) ;; do not return from twiki:return-image
+	  (if (and (member 'r perms) thumb)
+	      (let* ((varlst (string-split (s:get-param 'wiki_key) "-"))
+		     (tkey   (twiki:web64dec (cadr varlst)))
+		     (wid    (string->number (car  varlst)))
+		     (tdbn   (twiki:open-db tkey #f)))
+		(s:log "tkey: " tkey " thumb number: " image)
+		(twiki:return-thumb-dat tdbn wid (string->number thumb))))) ;; do not return from twiki:return-image
+	(if (not (member 'r perms)) ;; read access
+	    '() ;; return a blank slate
+	    (twiki:display-wiki name keys perms)))))
+
+(define (twiki:display-wiki name keys perms)
+  (let* ((wikidat  (make-twiki:wiki))
+	 (tkey     (twiki:keys->key keys))
+	 (tdb      (twiki:open-db tkey))
+	 (wid      (twiki:name->wid tdb name))
+	 (cvar     (conc "CURRENT_TWIDLERS:" wid)) ;; page var to store current twiddlers being viewed
+	 (cvar-ed  (conc "CURRENT_TWIDLER_UNDER_EDIT:" wid))
+	 (tnumedit (if (s:get cvar-ed) 
+		       (string->number (s:get cvar-ed))
+		       #f)) ;; #f => nothing to edit, -1 create a new tiddler
+	 (tnumview #f)
+	 (lmenu    (twiki:get-tiddlers tdb wid (list "MainMenu")))
+	 ;; store tiddlers for this page/twiki in cvar (i.e. CURRENT_TWIDLERS:<wid>
+	 (tdlnums  (if (s:get cvar)
+		       (map string->number (string-split (s:get cvar) ","))
+		       '())) ;; list of tiddler numbers
+	 (tdlrs    '())
+	 (tedited  (if (member 'w perms) #f #t)) ;; force no edits if not a writer
+	 (edit-tmenu-id (if (and (member 'w perms)
+				 (s:get-param "edit_tmenu"))
+			    (string->number (s:get-param "edit_tmenu"))
+			    #f))
+	 (edit-tiddler (if  (and (member 'w perms)
+				 (s:get-param "edit_tiddler")) ;; this handles the "edit" link in the tiddler control bar
+			    (let ((t (twiki:get-tiddlers-by-num tdb wid (list (string->number (s:get-param "edit_tiddler"))))))
+			      (s:log "t: " t)
+			      (if t
+				  (car t ) ;; should be a list of one
+				  (twiki:tiddler-set-name!
+				   (twiki:tiddler-set-id! (twiki:tiddler-make) -1) "NewTiddler")))
+			    #f))
+	 (view-tiddler (if (s:get-param "view_tiddler")
+			   (let* ((tname (twiki:web64dec (s:get-param "view_tiddler")))
+				  (t     (twiki:get-tiddler-by-name tdb wid tname)))
+			     (s:log "t: " t)
+			     (if t
+				 t 
+				 (begin
+				   (twiki:save-tiddler tdb tname (conc "!" tname) "" wid (twiki:get-id))
+				   (twiki:get-tiddler-by-name tdb wid tname))))
+			   #f))
+	 ) ;; image is the dat_id, keep it simple silly.
+
+    (twiki:wiki-set-wid!  wikidat wid)
+    (twiki:wiki-set-key!  wikidat tkey)
+    (twiki:wiki-set-name! wikidat name)
+    (twiki:wiki-set-dbh!  wikidat tdb)
+    (twiki:wiki-set-perms! wikidat perms)
+
+    ;; (s:log "edit-tmenu-id: " edit-tmenu-id " edit-tiddler: " edit-tiddler)
+
+    ;; Handle other URI commands here
+    (if (s:get-param "cancel_tedit") ;; doesn't matter which tiddler - just use this to cancel any edit
+	(begin
+	  (s:del! (conc "CURRENT_TWIDLER_UNDER_EDIT:" wid))
+	  (set! edit-tiddler #f)
+	  (set! tnumedit #f)
+	  (set! view-tiddler #f)
+	  (twiki:normalize-current-twiddlers tdb wid)
+	  (if (s:get cvar)
+	      (set! tdlnums (map string->number (string-split (s:get cvar) ","))))))
+    (if (s:get-param "delete_tiddler") '())
+    ;; (twiki:delete_tiddler tdb wid (string->number (s:get-param "delete_tiddler"))))
+
+    (s:set! "TWIKI_KEY" tkey) ;; this mechanism will fail for hierarchial twikis
+    ;; override the twiddler to edit when editing MainMenu
+    (if edit-tiddler
+	(begin
+	  (set! tnumedit (twiki:tiddler-get-id edit-tiddler))
+	  (s:set! 'twiki_title (twiki:tiddler-get-name edit-tiddler))
+	  (s:set! 'twiki_body  (twiki:get-dat tdb (twiki:tiddler-get-dat-id edit-tiddler)))))
+    (if view-tiddler
+	(begin
+	  (set! tnumview (twiki:tiddler-get-id view-tiddler))))
+    
+    ;; NOW WHAT FOR VIEW - fix the links, add to tdlst
+
+
+    (if edit-tmenu-id   (set! tnumedit edit-tmenu-id))
+    (if tnumedit (set! tdlnums (cons tnumedit tdlnums)))
+    (if tnumview (set! tdlnums (cons tnumview tdlnums)))
+    (set! tdlrs (twiki:get-tiddlers-by-num tdb wid tdlnums))
+
+    ;; remove tdlrs from the list if close_tiddler called
+    (if (s:get-param "close_tiddler")
+	(set! tdlrs (let ((tnum (string->number (s:get-param "close_tiddler"))))
+		      (remove (lambda (t)
+				(equal? (twiki:tiddler-get-id t) tnum))
+			      tdlrs))))
+
+    ;; remove all others if close_other_tiddlers called
+    (if (s:get-param "close_other_tiddlers")
+	(set! tdlrs (let ((tnum (string->number (s:get-param "close_other_tiddlers"))))
+		      (remove (lambda (t)
+				(not (equal? (twiki:tiddler-get-id t) tnum)))
+			      tdlrs))))
+    
+    (s:set! cvar (twiki:make-tiddler-list tdlrs))
+    (if tnumedit 
+	(s:set! cvar-ed tnumedit)
+	(s:del! cvar-ed))
+
+    ;; must have a MainMenu tiddler by now
+    (if (null? lmenu)
+	(begin
+	  (twiki:save-tiddler tdb "MainMenu" "" "" wid (twiki:get-id))
+	  (set! lmenu (twiki:get-tiddlers tdb wid (list "MainMenu")))))
+    
+    ;; get the tiddlers from the db now
+    (set! result
+	  (s:div 'class "twiki"
+	   ;; float to the right the control menu
+	   (s:div 'class "twiki-main-menu" (twiki:maint_area tdb wid tkey wikidat))
+	   (twiki:view-tiddler tdb  tkey wid (car lmenu) wikidat)
+	   ;; this is probably not needed as there is no reason to create tiddlers this way
+	   ;; (if (eq? tnumedit -1)(twiki:edit-tiddler tdb tkey wid tnumedit) '())
+	   ;; insert the picture editor window if enabled
+	   (if (equal? (s:get-param "twiki_maint") "2")(twiki:pic_mgmt tdb wid tkey) '())
+	   (if (equal? (s:get-param "twiki_maint") "4")(twiki:help 1) '())
+	   (if (not (null? tdlrs))
+	       (map (lambda (tdlr)
+		      (let ((tnum  (twiki:tiddler-get-id tdlr)))
+			(s:log "tnum: " tnum " tnumedit: " tnumedit)
+			(if (and tnumedit (not tedited) (equal? tnumedit tnum))
+			    (begin
+			      (set! tedited #t) ;; only allow editing one tiddler at a time
+			      (twiki:edit-tiddler tdb tkey wid tnum))
+			    (twiki:view-tiddler tdb  tkey wid tdlr wikidat))))
+		    tdlrs)
+	       '())))
+    (dbi:close tdb)
+    result))
+
+;; should do a single more efficient query but this is good enough
+(define (twiki:get-tiddlers db wid tnames)
+  (apply twiki:get-tiddlers-by-name db wid tnames))
+;;   (let* ((tdlrs '())
+;; 	 ;; (conn   (sdat-get-conn s:session))
+;; 	 (namelst (conc "('" (string-intersperse (map conc tnames) "','") "')"))
+;; 	 (qry     (conc twiki:tiddler-selector " WHERE t.wiki_id=? AND t.id IN " namelst ";")))
+;;     ;; (print qry)
+;;     (dbi:for-each-row
+;;      (lambda (row)
+;;        (set! tdlrs (cons row tdlrs)))
+;;      db qry wid)
+;;     (reverse tdlrs))) ;; !Twiki\
+
+;; tlst is a list of tiddler nums
+(define (twiki:get-tiddlers-by-num db wid tlst)
+  ;; (s:log "Got to twiki:get-tiddlers with keys: " tlst " and wid: " wid)
+  ;; select where created_on < somedate order by created_on desc limit 1
+  (let* ((tdlrs '())
+	 (tlststr (string-intersperse (map number->string tlst) ","))
+	 (already-got (make-hash-table))
+	 (qry    (conc twiki:tiddler-selector " WHERE t.wiki_id=? AND t.id IN (" tlststr ") ORDER BY created_on DESC;")))
+    (dbi:for-each-row
+     (lambda (row)
+       (let ((tname (twiki:tiddler-get-name row)))
+	 (if (not (hash-table-ref/default already-got tname #f))
+	     (begin
+	       (set! tdlrs (cons row tdlrs))
+	       (hash-table-set! already-got tname #t)))))
+     db qry wid)
+    (if (null? tdlrs) tdlrs (reverse tdlrs)))) ;; !Twiki\nTitle, pictures, etc.\n{{{\nCode\n}}}\n[[links]]\n|table|of|stuff|\n|more|stuff|here|\n"))
+
+;; wid = wiki id
+;; returns a list of twiki:tiddlers
+(define (twiki:get-tiddlers-by-name tdb wid . names)
+  (let ((tdlrs '()))
+    (for-each (lambda (name)
+		(let ((tdlr (twiki:get-tiddler-by-name tdb wid name)))
+		  (if tdlr (set! tdlrs (cons tdlr tdlrs)))))
+	      names)
+    (reverse tdlrs)))
+;; with the right query it should be possible to do this much faster approach for twiki:get-tiddlers-by-name
+;;   (let ((tdlrs '())
+;; 	(namelst (conc "('" (string-intersperse names "','") "')")))
+;;     (dbi:for-each-row
+;;      (lambda (row)
+;;        (set! tdlrs (cons row tdlrs)))
+;;      tdb
+;;      (conc twiki:tiddler-selector " WHERE t.wiki_id=? AND t.name IN " namelst) wid)
+;;     (reverse tdlrs)))
+
+;; get the tiddler with the given name and the max date
+(define (twiki:get-tiddler-by-name tdb wid name)
+  (dbi:get-one-row tdb (conc twiki:tiddler-selector " WHERE t.wiki_id=? AND t.name=? ORDER BY created_on DESC LIMIT 1;") wid name))
+
+(define (twiki:tiddler-name->id db tname)
+  (dbi:get-one db "SELECT id FROM tiddlers WHERE name=?;" tname))
+
+;;======================================================================
+;; twiki text formating, parsing and display
+;;======================================================================
+
+;; twiki formating routines (override these to change your look and feel
+(define twiki:twiki-tag  s:b)
+(define twiki:h3         s:h3)
+(define twiki:h2         s:h2)
+(define twiki:h1         s:h1)
+;; (define twiki:make-tlink s:i)
+(define twiki:ul         s:ul)
+(define twiki:ol         s:ol)
+(define twiki:li         s:li)
+(define twiki:pre        s:pre)
+(define twiki:p          s:p)
+(define twiki:u          s:u)
+(define twiki:td         s:td)
+(define twiki:tr         s:tr)
+(define twiki:table      s:table)
+(define twiki:div        s:div)
+
+(define (twiki:web64enc str)
+  (string-substitute "=" "_" (base64:base64-encode str) #t))
+
+(define (twiki:web64dec str)
+  (base64:base64-decode (string-substitute "_" "=" str #t)))
+    
+(define (twiki:make-tlink text tiddlername)
+  (s:a text 'href (s:link-to (twiki:get-link-back-to-current) 'view_tiddler (twiki:web64enc tiddlername))))
+
+(define (twiki:pic pic-name size wiki)
+  (let* ((tdb    (twiki:wiki-get-dbh wiki))
+	 (tkey   (twiki:wiki-get-key wiki))
+	 (xy     (string-split size "x"))
+	 (pic-id (twiki:get-pic-id tdb pic-name (twiki:wiki-get-wid wiki)))
+	 (img-lnk  (s:link-to "twiki" 'wiki_key (conc (number->string (twiki:wiki-get-wid wiki)) "-" (twiki:web64enc tkey))
+			      'image  pic-id)))
+    (if (and (> (length xy) 1)
+	     (car xy)
+	     (cadr xy)) ;; yep, have two numbers
+	(s:img 'title pic-name 'alt pic-name 'width (car xy) 'height (cadr xy) 'src img-lnk)
+	(s:img 'title pic-name 'alt pic-name 'src img-lnk))))
+
+;; override these also
+(define (twiki:get-id)
+  (s:session-var-get "id"))
+
+;; override this to set links inside wiki's
+(define (twiki:get-link-back-to-current)
+  (s:current-page))
+
+
+;; regexes are listed in the order in which they should be checked
+
+(define twiki:h3-patt (regexp "^!!!(.*)$"))
+(define twiki:h2-patt (regexp "^!!(.*)$"))
+(define twiki:h1-patt (regexp "^!(.*)$"))
+
+(define twiki:tlink-patt     (regexp "^(.*)\\[\\[([^\\[\\]]*)\\]\\](.*)$"))
+(define twiki:pic-patt       (regexp "^(.*)\\[pic([0-9%]*x*[0-9%]*)\\[([^\\[\\]]+)\\]\\](.*)$"))
+(define twiki:underline-patt (regexp "^(.*)__(.*)__(.*)$"))
+(define twiki:table-patt     (regexp "^\\|(.*)\\|$"))
+
+;; these are for multi-line formating
+(define twiki:list-patt    (regexp "^(\\*+|\\#+)(.*)$"))
+(define twiki:bullet-patt  (regexp "^(\\*+)(.*)$"))
+(define twiki:number-patt  (regexp "^(\\#+)(.*)$"))
+(define twiki:prefor-patt  (regexp "^\\{\\{\\{$"))
+(define twiki:prefor-end-patt (regexp "^\\}\\}\\}$"))
+
+;; regex
+(define t:match  #f)
+(define (t-match r s)
+  (let ((res (string-match r s)))
+    (set! t:match res)
+    res))
+
+;; should switch to recursively processing by block?
+;; (process-block dat)
+;;   ...
+;;   (process-block remdat)
+(define (twiki:dat->html dat wiki)
+  (let* ((inp        (open-input-string dat))
+	 (nest-depth 0) ;; depth of nested lists
+	 ;; token (i.e. line) handling stuff
+	 (next-line  #f)
+	 (peek-line  (lambda ()
+		       next-line))
+	 (get-line   (lambda ()
+		       (let ((res next-line))
+			 (set! next-line (read-line inp))
+			 ;; (print "get-line: prev=" res " next=" next-line "\n")
+			 res)))
+	 (l          (get-line))) ;; discard the #f in next-line
+    (twiki:read-block peek-line get-line nest-depth #f wiki)))
+
+;; blk-type is #f for not in a block (i.e. at top level), 'pre for preformated, 'ul or 'ol
+;; call with first line as legit data
+;; i.e. for preform - skip the {{{ line then call read-block
+;;      for # or * call with first line
+(define (twiki:read-block peek-line get-line nest-depth blk-type wiki)
+  (let loop ((res '())
+	     (l   (peek-line))) ;; should this be a peek-line? yes!!
+    ;; (print "twiki:read-block loop nest-depth="nest-depth " blk-type=" blk-type " l=" l "\n  res=" res)
+    (if (eof-object? l)
+	;; we are done! return the list
+	res
+	;; process it!
+	(cond
+	 ;; handle preformated text
+	 ((eq? blk-type 'pre)
+	  (if (t-match  twiki:prefor-end-patt l)
+	      (begin
+		(get-line) ;; discard the }}}
+		res)       ;; end of preformatted
+	      (begin
+		;; (get-line) ;; discard the {{{
+		(loop (append res (list (get-line)))
+		      (peek-line)))))
+	 ;; handle tables
+	 ((eq? blk-type 'table)
+	  (if (t-match twiki:table-patt l)
+	      (let ((cels  (string-split (cadr t:match) "|")))
+		(get-line)
+		(loop (append res (twiki:tr (map twiki:td 
+						 (map (lambda (x)(twiki:line->html x #f wiki)) cels))))
+		      (get-line)))
+	      res))
+	 ;; handle lists
+	 ((or (t-match twiki:bullet-patt l) ;; have *
+	      (t-match twiki:number-patt l))
+	  (let* ((directive (cadr t:match))
+		 (levelnum (string-length directive))
+		 (text     (twiki:line->html (caddr t:match) #t wiki))
+		 (btype    (if (string=? "#" (substring directive 0 1))
+			       'ol
+			       'ul))
+		 (func     (if (eq? btype 'ul)
+			       twiki:ul
+			       twiki:ol)))
+	    ;; (print "handling " btype ": levelnum=" levelnum " text=" text " nest-depth=" nest-depth " blk-type=" blk-type)
+	    (cond
+	     ((not blk-type) ;; i.e first member of the list!
+	      (loop (append res (func (twiki:read-block peek-line get-line levelnum btype wiki)))
+		    (get-line)))
+	     ((> levelnum nest-depth)
+	      (loop (append res (func (twiki:read-block peek-line get-line (+ nest-depth 1) btype wiki)))
+		    (peek-line)))
+	     ((< levelnum nest-depth)
+	      (append res (twiki:li text))) ;; return the bulleted item, don't get the next line??
+	     (else
+	      (get-line)
+	      (loop (append res (twiki:li text))
+		    (peek-line))))))
+	 ((t-match twiki:prefor-patt l)
+	  (get-line) ;; discard the {{{
+	  (loop (append res (twiki:pre (twiki:read-block peek-line get-line nest-depth 'pre wiki)))
+		(peek-line)))
+	 ((t-match twiki:table-patt l)
+	  (get-line)
+	  (loop (append res (twiki:table 'border 1 'cellspacing 0 (twiki:read-block peek-line get-line 0 'table wiki)))
+		(peek-line)))
+	 (else
+	  (get-line)
+	  (loop (append res (twiki:line->html l #t wiki))
+		(peek-line)))))))
+
+(define (twiki:line->html dat firstcall wiki)
+  (if firstcall 
+      ;; process the patterns that test for beginning of line only on the first call
+      (cond
+       ((t-match twiki:h3-patt dat)
+	(twiki:h3 (twiki:line->html (cadr t:match) #f wiki)))
+       ((t-match twiki:h2-patt dat)
+	(twiki:h2 (twiki:line->html (cadr t:match) #f wiki)))
+       ((t-match twiki:h1-patt dat)
+	(twiki:h1 (twiki:line->html (cadr t:match) #f wiki)))
+       ;; why was the (s:br) here? trying without
+       (else (twiki:line->html dat #f wiki)))
+       ;; (else  (append (twiki:line->html dat #f wiki)(list (s:br)))));; (s:p 'class "tiddlerpar"
+      ;; not firstcall so process other patterns
+      (cond
+       ((t-match twiki:tlink-patt dat)
+	(let ((pre  (cadr   t:match))
+	      (lnk  (caddr  t:match))
+	      (post (cadddr t:match)))
+	  (list (twiki:line->html pre #f wiki)
+		(twiki:make-tlink (twiki:line->html lnk #f wiki) lnk) ;; special handling
+		(twiki:line->html post #f wiki))))
+       ((t-match twiki:pic-patt dat)
+	(let ((pre  (cadr    t:match))
+	      (size (caddr   t:match)) 
+	      (pic  (cadddr  t:match))
+	      (post (list-ref t:match 4)))
+	  (list (twiki:line->html pre #f wiki)
+		(twiki:pic pic size wiki)
+		(twiki:line->html post #t wiki))))
+       ((t-match twiki:underline-patt dat)
+	(let ((pre  (cadr   t:match))
+	      (lnk  (caddr  t:match))
+	      (post (cadddr t:match)))
+	  (list (twiki:line->html pre #f wiki)
+		(twiki:u (twiki:line->html lnk #f wiki))
+		(twiki:line->html post #f wiki))))
+       ((t-match twiki:table-patt dat)
+	(let ((cels  (string-split (cadr t:match) "|")))
+	  (twiki:tr (map twiki:td (twiki:line->html cels #f wiki)))))
+       (else (list dat)))))
+
+
+#|
+(twiki:dat->html "a\n{{{\nb\nc\nd\n}}}\n!e\n[[f]]\n[[g]]\n*h" wiki)
+(s:output (current-output-port) (twiki:dat->html "!Testing [[my first link]]\n* Test\n* Foo\nblah" wiki))   
+(s:output (current-output-port) (twiki:dat->html "[[a]]\n{{{\nb\n  c\n   d\n}}}\n*x\n[[f]]\n[[g]]\n*h" wiki))
+(s:output (current-output-port)
+|#
+

ADDED   stml2/modules/twiki/twiki-test.scm
Index: stml2/modules/twiki/twiki-test.scm
==================================================================
--- /dev/null
+++ stml2/modules/twiki/twiki-test.scm
@@ -0,0 +1,5 @@
+(include "../../stml.scm")
+;; (include "../../session.scm")
+(include "../../misc-stml.scm")
+(include "twiki-mod.scm")
+

ADDED   stml2/modules/twiki/twiki.l
Index: stml2/modules/twiki/twiki.l
==================================================================
--- /dev/null
+++ stml2/modules/twiki/twiki.l
@@ -0,0 +1,33 @@
+;; twiki
+
+period           \.
+comma            ,
+semicolon        \;
+opensq           \[
+closesq          \]
+opensquig        \{
+closesquig       \}
+
+digit            [0-9]
+letter           [a-zA-Z]
+okchars          [_%\/\.:\*\+\-\(\)\\#']
+escape           \\ 
+whitespace       [ \9]
+linefeed         \n
+bang             !
+plaintext        ({letter}|{digit}|{okchars}|{whitespace}|{linefeed})+
+
+%%
+
+{opensq}                        (list 'opensq     yytext)
+{closesq}                       (list 'closesq    yytext)
+
+{opensquig}                     (list 'opensquig  yytext)
+{closesquig}                    (list 'closesquig yytext)
+
+{bang}                          (list 'bang       yytext)
+{plaintext}                     (list 'plaintext  yytext)
+
+<<EOF>>                         (list 'end-of-input #f ) ;; yyline)
+
+<<ERROR>>                       (lex-error (conc yyline " : illegal character ") (yygetc))

ADDED   stml2/modules/twiki/twiki.l.scm
Index: stml2/modules/twiki/twiki.l.scm
==================================================================
--- /dev/null
+++ stml2/modules/twiki/twiki.l.scm
@@ -0,0 +1,1194 @@
+; *** This file starts with a copy of the file multilex.scm ***
+; Copyright (C) 1997 Danny Dube', Universite' de Montre'al.
+; All rights reserved.
+; SILex 1.0.
+
+;
+; Gestion des Input Systems
+; Fonctions a utiliser par l'usager:
+;   lexer-make-IS, lexer-get-func-getc, lexer-get-func-ungetc,
+;   lexer-get-func-line, lexer-get-func-column et lexer-get-func-offset
+;
+
+; Taille initiale par defaut du buffer d'entree
+(define lexer-init-buffer-len 1024)
+
+; Numero du caractere newline
+(define lexer-integer-newline (char->integer #\newline))
+
+; Constructeur d'IS brut
+(define lexer-raw-IS-maker
+  (lambda (buffer read-ptr input-f counters)
+    (let ((input-f          input-f)                ; Entree reelle
+	  (buffer           buffer)                 ; Buffer
+	  (buflen           (string-length buffer))
+	  (read-ptr         read-ptr)
+	  (start-ptr        1)                      ; Marque de debut de lexeme
+	  (start-line       1)
+	  (start-column     1)
+	  (start-offset     0)
+	  (end-ptr          1)                      ; Marque de fin de lexeme
+	  (point-ptr        1)                      ; Le point
+	  (user-ptr         1)                      ; Marque de l'usager
+	  (user-line        1)
+	  (user-column      1)
+	  (user-offset      0)
+	  (user-up-to-date? #t))                    ; Concerne la colonne seul.
+      (letrec
+	  ((start-go-to-end-none         ; Fonctions de depl. des marques
+	    (lambda ()
+	      (set! start-ptr end-ptr)))
+	   (start-go-to-end-line
+	    (lambda ()
+	      (let loop ((ptr start-ptr) (line start-line))
+		(if (= ptr end-ptr)
+		    (begin
+		      (set! start-ptr ptr)
+		      (set! start-line line))
+		    (if (char=? (string-ref buffer ptr) #\newline)
+			(loop (+ ptr 1) (+ line 1))
+			(loop (+ ptr 1) line))))))
+	   (start-go-to-end-all
+	    (lambda ()
+	      (set! start-offset (+ start-offset (- end-ptr start-ptr)))
+	      (let loop ((ptr start-ptr)
+			 (line start-line)
+			 (column start-column))
+		(if (= ptr end-ptr)
+		    (begin
+		      (set! start-ptr ptr)
+		      (set! start-line line)
+		      (set! start-column column))
+		    (if (char=? (string-ref buffer ptr) #\newline)
+			(loop (+ ptr 1) (+ line 1) 1)
+			(loop (+ ptr 1) line (+ column 1)))))))
+	   (start-go-to-user-none
+	    (lambda ()
+	      (set! start-ptr user-ptr)))
+	   (start-go-to-user-line
+	    (lambda ()
+	      (set! start-ptr user-ptr)
+	      (set! start-line user-line)))
+	   (start-go-to-user-all
+	    (lambda ()
+	      (set! start-line user-line)
+	      (set! start-offset user-offset)
+	      (if user-up-to-date?
+		  (begin
+		    (set! start-ptr user-ptr)
+		    (set! start-column user-column))
+		  (let loop ((ptr start-ptr) (column start-column))
+		    (if (= ptr user-ptr)
+			(begin
+			  (set! start-ptr ptr)
+			  (set! start-column column))
+			(if (char=? (string-ref buffer ptr) #\newline)
+			    (loop (+ ptr 1) 1)
+			    (loop (+ ptr 1) (+ column 1))))))))
+	   (end-go-to-point
+	    (lambda ()
+	      (set! end-ptr point-ptr)))
+	   (point-go-to-start
+	    (lambda ()
+	      (set! point-ptr start-ptr)))
+	   (user-go-to-start-none
+	    (lambda ()
+	      (set! user-ptr start-ptr)))
+	   (user-go-to-start-line
+	    (lambda ()
+	      (set! user-ptr start-ptr)
+	      (set! user-line start-line)))
+	   (user-go-to-start-all
+	    (lambda ()
+	      (set! user-ptr start-ptr)
+	      (set! user-line start-line)
+	      (set! user-column start-column)
+	      (set! user-offset start-offset)
+	      (set! user-up-to-date? #t)))
+	   (init-lexeme-none             ; Debute un nouveau lexeme
+	    (lambda ()
+	      (if (< start-ptr user-ptr)
+		  (start-go-to-user-none))
+	      (point-go-to-start)))
+	   (init-lexeme-line
+	    (lambda ()
+	      (if (< start-ptr user-ptr)
+		  (start-go-to-user-line))
+	      (point-go-to-start)))
+	   (init-lexeme-all
+	    (lambda ()
+	      (if (< start-ptr user-ptr)
+		  (start-go-to-user-all))
+	      (point-go-to-start)))
+	   (get-start-line               ; Obtention des stats du debut du lxm
+	    (lambda ()
+	      start-line))
+	   (get-start-column
+	    (lambda ()
+	      start-column))
+	   (get-start-offset
+	    (lambda ()
+	      start-offset))
+	   (peek-left-context            ; Obtention de caracteres (#f si EOF)
+	    (lambda ()
+	      (char->integer (string-ref buffer (- start-ptr 1)))))
+	   (peek-char
+	    (lambda ()
+	      (if (< point-ptr read-ptr)
+		  (char->integer (string-ref buffer point-ptr))
+		  (let ((c (input-f)))
+		    (if (char? c)
+			(begin
+			  (if (= read-ptr buflen)
+			      (reorganize-buffer))
+			  (string-set! buffer point-ptr c)
+			  (set! read-ptr (+ point-ptr 1))
+			  (char->integer c))
+			(begin
+			  (set! input-f (lambda () 'eof))
+			  #f))))))
+	   (read-char
+	    (lambda ()
+	      (if (< point-ptr read-ptr)
+		  (let ((c (string-ref buffer point-ptr)))
+		    (set! point-ptr (+ point-ptr 1))
+		    (char->integer c))
+		  (let ((c (input-f)))
+		    (if (char? c)
+			(begin
+			  (if (= read-ptr buflen)
+			      (reorganize-buffer))
+			  (string-set! buffer point-ptr c)
+			  (set! read-ptr (+ point-ptr 1))
+			  (set! point-ptr read-ptr)
+			  (char->integer c))
+			(begin
+			  (set! input-f (lambda () 'eof))
+			  #f))))))
+	   (get-start-end-text           ; Obtention du lexeme
+	    (lambda ()
+	      (substring buffer start-ptr end-ptr)))
+	   (get-user-line-line           ; Fonctions pour l'usager
+	    (lambda ()
+	      (if (< user-ptr start-ptr)
+		  (user-go-to-start-line))
+	      user-line))
+	   (get-user-line-all
+	    (lambda ()
+	      (if (< user-ptr start-ptr)
+		  (user-go-to-start-all))
+	      user-line))
+	   (get-user-column-all
+	    (lambda ()
+	      (cond ((< user-ptr start-ptr)
+		     (user-go-to-start-all)
+		     user-column)
+		    (user-up-to-date?
+		     user-column)
+		    (else
+		     (let loop ((ptr start-ptr) (column start-column))
+		       (if (= ptr user-ptr)
+			   (begin
+			     (set! user-column column)
+			     (set! user-up-to-date? #t)
+			     column)
+			   (if (char=? (string-ref buffer ptr) #\newline)
+			       (loop (+ ptr 1) 1)
+			       (loop (+ ptr 1) (+ column 1)))))))))
+	   (get-user-offset-all
+	    (lambda ()
+	      (if (< user-ptr start-ptr)
+		  (user-go-to-start-all))
+	      user-offset))
+	   (user-getc-none
+	    (lambda ()
+	      (if (< user-ptr start-ptr)
+		  (user-go-to-start-none))
+	      (if (< user-ptr read-ptr)
+		  (let ((c (string-ref buffer user-ptr)))
+		    (set! user-ptr (+ user-ptr 1))
+		    c)
+		  (let ((c (input-f)))
+		    (if (char? c)
+			(begin
+			  (if (= read-ptr buflen)
+			      (reorganize-buffer))
+			  (string-set! buffer user-ptr c)
+			  (set! read-ptr (+ read-ptr 1))
+			  (set! user-ptr read-ptr)
+			  c)
+			(begin
+			  (set! input-f (lambda () 'eof))
+			  'eof))))))
+	   (user-getc-line
+	    (lambda ()
+	      (if (< user-ptr start-ptr)
+		  (user-go-to-start-line))
+	      (if (< user-ptr read-ptr)
+		  (let ((c (string-ref buffer user-ptr)))
+		    (set! user-ptr (+ user-ptr 1))
+		    (if (char=? c #\newline)
+			(set! user-line (+ user-line 1)))
+		    c)
+		  (let ((c (input-f)))
+		    (if (char? c)
+			(begin
+			  (if (= read-ptr buflen)
+			      (reorganize-buffer))
+			  (string-set! buffer user-ptr c)
+			  (set! read-ptr (+ read-ptr 1))
+			  (set! user-ptr read-ptr)
+			  (if (char=? c #\newline)
+			      (set! user-line (+ user-line 1)))
+			  c)
+			(begin
+			  (set! input-f (lambda () 'eof))
+			  'eof))))))
+	   (user-getc-all
+	    (lambda ()
+	      (if (< user-ptr start-ptr)
+		  (user-go-to-start-all))
+	      (if (< user-ptr read-ptr)
+		  (let ((c (string-ref buffer user-ptr)))
+		    (set! user-ptr (+ user-ptr 1))
+		    (if (char=? c #\newline)
+			(begin
+			  (set! user-line (+ user-line 1))
+			  (set! user-column 1))
+			(set! user-column (+ user-column 1)))
+		    (set! user-offset (+ user-offset 1))
+		    c)
+		  (let ((c (input-f)))
+		    (if (char? c)
+			(begin
+			  (if (= read-ptr buflen)
+			      (reorganize-buffer))
+			  (string-set! buffer user-ptr c)
+			  (set! read-ptr (+ read-ptr 1))
+			  (set! user-ptr read-ptr)
+			  (if (char=? c #\newline)
+			      (begin
+				(set! user-line (+ user-line 1))
+				(set! user-column 1))
+			      (set! user-column (+ user-column 1)))
+			  (set! user-offset (+ user-offset 1))
+			  c)
+			(begin
+			  (set! input-f (lambda () 'eof))
+			  'eof))))))
+	   (user-ungetc-none
+	    (lambda ()
+	      (if (> user-ptr start-ptr)
+		  (set! user-ptr (- user-ptr 1)))))
+	   (user-ungetc-line
+	    (lambda ()
+	      (if (> user-ptr start-ptr)
+		  (begin
+		    (set! user-ptr (- user-ptr 1))
+		    (let ((c (string-ref buffer user-ptr)))
+		      (if (char=? c #\newline)
+			  (set! user-line (- user-line 1))))))))
+	   (user-ungetc-all
+	    (lambda ()
+	      (if (> user-ptr start-ptr)
+		  (begin
+		    (set! user-ptr (- user-ptr 1))
+		    (let ((c (string-ref buffer user-ptr)))
+		      (if (char=? c #\newline)
+			  (begin
+			    (set! user-line (- user-line 1))
+			    (set! user-up-to-date? #f))
+			  (set! user-column (- user-column 1)))
+		      (set! user-offset (- user-offset 1)))))))
+	   (reorganize-buffer            ; Decaler ou agrandir le buffer
+	    (lambda ()
+	      (if (< (* 2 start-ptr) buflen)
+		  (let* ((newlen (* 2 buflen))
+			 (newbuf (make-string newlen))
+			 (delta (- start-ptr 1)))
+		    (let loop ((from (- start-ptr 1)))
+		      (if (< from buflen)
+			  (begin
+			    (string-set! newbuf
+					 (- from delta)
+					 (string-ref buffer from))
+			    (loop (+ from 1)))))
+		    (set! buffer    newbuf)
+		    (set! buflen    newlen)
+		    (set! read-ptr  (- read-ptr delta))
+		    (set! start-ptr (- start-ptr delta))
+		    (set! end-ptr   (- end-ptr delta))
+		    (set! point-ptr (- point-ptr delta))
+		    (set! user-ptr  (- user-ptr delta)))
+		  (let ((delta (- start-ptr 1)))
+		    (let loop ((from (- start-ptr 1)))
+		      (if (< from buflen)
+			  (begin
+			    (string-set! buffer
+					 (- from delta)
+					 (string-ref buffer from))
+			    (loop (+ from 1)))))
+		    (set! read-ptr  (- read-ptr delta))
+		    (set! start-ptr (- start-ptr delta))
+		    (set! end-ptr   (- end-ptr delta))
+		    (set! point-ptr (- point-ptr delta))
+		    (set! user-ptr  (- user-ptr delta)))))))
+	(list (cons 'start-go-to-end
+		    (cond ((eq? counters 'none) start-go-to-end-none)
+			  ((eq? counters 'line) start-go-to-end-line)
+			  ((eq? counters 'all ) start-go-to-end-all)))
+	      (cons 'end-go-to-point
+		    end-go-to-point)
+	      (cons 'init-lexeme
+		    (cond ((eq? counters 'none) init-lexeme-none)
+			  ((eq? counters 'line) init-lexeme-line)
+			  ((eq? counters 'all ) init-lexeme-all)))
+	      (cons 'get-start-line
+		    get-start-line)
+	      (cons 'get-start-column
+		    get-start-column)
+	      (cons 'get-start-offset
+		    get-start-offset)
+	      (cons 'peek-left-context
+		    peek-left-context)
+	      (cons 'peek-char
+		    peek-char)
+	      (cons 'read-char
+		    read-char)
+	      (cons 'get-start-end-text
+		    get-start-end-text)
+	      (cons 'get-user-line
+		    (cond ((eq? counters 'none) #f)
+			  ((eq? counters 'line) get-user-line-line)
+			  ((eq? counters 'all ) get-user-line-all)))
+	      (cons 'get-user-column
+		    (cond ((eq? counters 'none) #f)
+			  ((eq? counters 'line) #f)
+			  ((eq? counters 'all ) get-user-column-all)))
+	      (cons 'get-user-offset
+		    (cond ((eq? counters 'none) #f)
+			  ((eq? counters 'line) #f)
+			  ((eq? counters 'all ) get-user-offset-all)))
+	      (cons 'user-getc
+		    (cond ((eq? counters 'none) user-getc-none)
+			  ((eq? counters 'line) user-getc-line)
+			  ((eq? counters 'all ) user-getc-all)))
+	      (cons 'user-ungetc
+		    (cond ((eq? counters 'none) user-ungetc-none)
+			  ((eq? counters 'line) user-ungetc-line)
+			  ((eq? counters 'all ) user-ungetc-all))))))))
+
+; Construit un Input System
+; Le premier parametre doit etre parmi "port", "procedure" ou "string"
+; Prend un parametre facultatif qui doit etre parmi
+; "none", "line" ou "all"
+(define lexer-make-IS
+  (lambda (input-type input . largs)
+    (let ((counters-type (cond ((null? largs)
+				'line)
+			       ((memq (car largs) '(none line all))
+				(car largs))
+			       (else
+				'line))))
+      (cond ((and (eq? input-type 'port) (input-port? input))
+	     (let* ((buffer   (make-string lexer-init-buffer-len #\newline))
+		    (read-ptr 1)
+		    (input-f  (lambda () (read-char input))))
+	       (lexer-raw-IS-maker buffer read-ptr input-f counters-type)))
+	    ((and (eq? input-type 'procedure) (procedure? input))
+	     (let* ((buffer   (make-string lexer-init-buffer-len #\newline))
+		    (read-ptr 1)
+		    (input-f  input))
+	       (lexer-raw-IS-maker buffer read-ptr input-f counters-type)))
+	    ((and (eq? input-type 'string) (string? input))
+	     (let* ((buffer   (string-append (string #\newline) input))
+		    (read-ptr (string-length buffer))
+		    (input-f  (lambda () 'eof)))
+	       (lexer-raw-IS-maker buffer read-ptr input-f counters-type)))
+	    (else
+	     (let* ((buffer   (string #\newline))
+		    (read-ptr 1)
+		    (input-f  (lambda () 'eof)))
+	       (lexer-raw-IS-maker buffer read-ptr input-f counters-type)))))))
+
+; Les fonctions:
+;   lexer-get-func-getc, lexer-get-func-ungetc,
+;   lexer-get-func-line, lexer-get-func-column et lexer-get-func-offset
+(define lexer-get-func-getc
+  (lambda (IS) (cdr (assq 'user-getc IS))))
+(define lexer-get-func-ungetc
+  (lambda (IS) (cdr (assq 'user-ungetc IS))))
+(define lexer-get-func-line
+  (lambda (IS) (cdr (assq 'get-user-line IS))))
+(define lexer-get-func-column
+  (lambda (IS) (cdr (assq 'get-user-column IS))))
+(define lexer-get-func-offset
+  (lambda (IS) (cdr (assq 'get-user-offset IS))))
+
+;
+; Gestion des lexers
+;
+
+; Fabrication de lexer a partir d'arbres de decision
+(define lexer-make-tree-lexer
+  (lambda (tables IS)
+    (letrec
+	(; Contenu de la table
+	 (counters-type        (vector-ref tables 0))
+	 (<<EOF>>-pre-action   (vector-ref tables 1))
+	 (<<ERROR>>-pre-action (vector-ref tables 2))
+	 (rules-pre-actions    (vector-ref tables 3))
+	 (table-nl-start       (vector-ref tables 5))
+	 (table-no-nl-start    (vector-ref tables 6))
+	 (trees-v              (vector-ref tables 7))
+	 (acc-v                (vector-ref tables 8))
+
+	 ; Contenu du IS
+	 (IS-start-go-to-end    (cdr (assq 'start-go-to-end IS)))
+	 (IS-end-go-to-point    (cdr (assq 'end-go-to-point IS)))
+	 (IS-init-lexeme        (cdr (assq 'init-lexeme IS)))
+	 (IS-get-start-line     (cdr (assq 'get-start-line IS)))
+	 (IS-get-start-column   (cdr (assq 'get-start-column IS)))
+	 (IS-get-start-offset   (cdr (assq 'get-start-offset IS)))
+	 (IS-peek-left-context  (cdr (assq 'peek-left-context IS)))
+	 (IS-peek-char          (cdr (assq 'peek-char IS)))
+	 (IS-read-char          (cdr (assq 'read-char IS)))
+	 (IS-get-start-end-text (cdr (assq 'get-start-end-text IS)))
+	 (IS-get-user-line      (cdr (assq 'get-user-line IS)))
+	 (IS-get-user-column    (cdr (assq 'get-user-column IS)))
+	 (IS-get-user-offset    (cdr (assq 'get-user-offset IS)))
+	 (IS-user-getc          (cdr (assq 'user-getc IS)))
+	 (IS-user-ungetc        (cdr (assq 'user-ungetc IS)))
+
+	 ; Resultats
+	 (<<EOF>>-action   #f)
+	 (<<ERROR>>-action #f)
+	 (rules-actions    #f)
+	 (states           #f)
+	 (final-lexer      #f)
+
+	 ; Gestion des hooks
+	 (hook-list '())
+	 (add-hook
+	  (lambda (thunk)
+	    (set! hook-list (cons thunk hook-list))))
+	 (apply-hooks
+	  (lambda ()
+	    (let loop ((l hook-list))
+	      (if (pair? l)
+		  (begin
+		    ((car l))
+		    (loop (cdr l)))))))
+
+	 ; Preparation des actions
+	 (set-action-statics
+	  (lambda (pre-action)
+	    (pre-action final-lexer IS-user-getc IS-user-ungetc)))
+	 (prepare-special-action-none
+	  (lambda (pre-action)
+	    (let ((action #f))
+	      (let ((result
+		     (lambda ()
+		       (action "")))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-special-action-line
+	  (lambda (pre-action)
+	    (let ((action #f))
+	      (let ((result
+		     (lambda (yyline)
+		       (action "" yyline)))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-special-action-all
+	  (lambda (pre-action)
+	    (let ((action #f))
+	      (let ((result
+		     (lambda (yyline yycolumn yyoffset)
+		       (action "" yyline yycolumn yyoffset)))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-special-action
+	  (lambda (pre-action)
+	    (cond ((eq? counters-type 'none)
+		   (prepare-special-action-none pre-action))
+		  ((eq? counters-type 'line)
+		   (prepare-special-action-line pre-action))
+		  ((eq? counters-type 'all)
+		   (prepare-special-action-all  pre-action)))))
+	 (prepare-action-yytext-none
+	  (lambda (pre-action)
+	    (let ((get-start-end-text IS-get-start-end-text)
+		  (start-go-to-end    IS-start-go-to-end)
+		  (action             #f))
+	      (let ((result
+		     (lambda ()
+		       (let ((yytext (get-start-end-text)))
+			 (start-go-to-end)
+			 (action yytext))))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-action-yytext-line
+	  (lambda (pre-action)
+	    (let ((get-start-end-text IS-get-start-end-text)
+		  (start-go-to-end    IS-start-go-to-end)
+		  (action             #f))
+	      (let ((result
+		     (lambda (yyline)
+		       (let ((yytext (get-start-end-text)))
+			 (start-go-to-end)
+			 (action yytext yyline))))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-action-yytext-all
+	  (lambda (pre-action)
+	    (let ((get-start-end-text IS-get-start-end-text)
+		  (start-go-to-end    IS-start-go-to-end)
+		  (action             #f))
+	      (let ((result
+		     (lambda (yyline yycolumn yyoffset)
+		       (let ((yytext (get-start-end-text)))
+			 (start-go-to-end)
+			 (action yytext yyline yycolumn yyoffset))))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-action-yytext
+	  (lambda (pre-action)
+	    (cond ((eq? counters-type 'none)
+		   (prepare-action-yytext-none pre-action))
+		  ((eq? counters-type 'line)
+		   (prepare-action-yytext-line pre-action))
+		  ((eq? counters-type 'all)
+		   (prepare-action-yytext-all  pre-action)))))
+	 (prepare-action-no-yytext-none
+	  (lambda (pre-action)
+	    (let ((start-go-to-end    IS-start-go-to-end)
+		  (action             #f))
+	      (let ((result
+		     (lambda ()
+		       (start-go-to-end)
+		       (action)))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-action-no-yytext-line
+	  (lambda (pre-action)
+	    (let ((start-go-to-end    IS-start-go-to-end)
+		  (action             #f))
+	      (let ((result
+		     (lambda (yyline)
+		       (start-go-to-end)
+		       (action yyline)))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-action-no-yytext-all
+	  (lambda (pre-action)
+	    (let ((start-go-to-end    IS-start-go-to-end)
+		  (action             #f))
+	      (let ((result
+		     (lambda (yyline yycolumn yyoffset)
+		       (start-go-to-end)
+		       (action yyline yycolumn yyoffset)))
+		    (hook
+		     (lambda ()
+		       (set! action (set-action-statics pre-action)))))
+		(add-hook hook)
+		result))))
+	 (prepare-action-no-yytext
+	  (lambda (pre-action)
+	    (cond ((eq? counters-type 'none)
+		   (prepare-action-no-yytext-none pre-action))
+		  ((eq? counters-type 'line)
+		   (prepare-action-no-yytext-line pre-action))
+		  ((eq? counters-type 'all)
+		   (prepare-action-no-yytext-all  pre-action)))))
+
+	 ; Fabrique les fonctions de dispatch
+	 (prepare-dispatch-err
+	  (lambda (leaf)
+	    (lambda (c)
+	      #f)))
+	 (prepare-dispatch-number
+	  (lambda (leaf)
+	    (let ((state-function #f))
+	      (let ((result
+		     (lambda (c)
+		       state-function))
+		    (hook
+		     (lambda ()
+		       (set! state-function (vector-ref states leaf)))))
+		(add-hook hook)
+		result))))
+	 (prepare-dispatch-leaf
+	  (lambda (leaf)
+	    (if (eq? leaf 'err)
+		(prepare-dispatch-err leaf)
+		(prepare-dispatch-number leaf))))
+	 (prepare-dispatch-<
+	  (lambda (tree)
+	    (let ((left-tree  (list-ref tree 1))
+		  (right-tree (list-ref tree 2)))
+	      (let ((bound      (list-ref tree 0))
+		    (left-func  (prepare-dispatch-tree left-tree))
+		    (right-func (prepare-dispatch-tree right-tree)))
+		(lambda (c)
+		  (if (< c bound)
+		      (left-func c)
+		      (right-func c)))))))
+	 (prepare-dispatch-=
+	  (lambda (tree)
+	    (let ((left-tree  (list-ref tree 2))
+		  (right-tree (list-ref tree 3)))
+	      (let ((bound      (list-ref tree 1))
+		    (left-func  (prepare-dispatch-tree left-tree))
+		    (right-func (prepare-dispatch-tree right-tree)))
+		(lambda (c)
+		  (if (= c bound)
+		      (left-func c)
+		      (right-func c)))))))
+	 (prepare-dispatch-tree
+	  (lambda (tree)
+	    (cond ((not (pair? tree))
+		   (prepare-dispatch-leaf tree))
+		  ((eq? (car tree) '=)
+		   (prepare-dispatch-= tree))
+		  (else
+		   (prepare-dispatch-< tree)))))
+	 (prepare-dispatch
+	  (lambda (tree)
+	    (let ((dicho-func (prepare-dispatch-tree tree)))
+	      (lambda (c)
+		(and c (dicho-func c))))))
+
+	 ; Fabrique les fonctions de transition (read & go) et (abort)
+	 (prepare-read-n-go
+	  (lambda (tree)
+	    (let ((dispatch-func (prepare-dispatch tree))
+		  (read-char     IS-read-char))
+	      (lambda ()
+		(dispatch-func (read-char))))))
+	 (prepare-abort
+	  (lambda (tree)
+	    (lambda ()
+	      #f)))
+	 (prepare-transition
+	  (lambda (tree)
+	    (if (eq? tree 'err)
+		(prepare-abort     tree)
+		(prepare-read-n-go tree))))
+
+	 ; Fabrique les fonctions d'etats ([set-end] & trans)
+	 (prepare-state-no-acc
+	   (lambda (s r1 r2)
+	     (let ((trans-func (prepare-transition (vector-ref trees-v s))))
+	       (lambda (action)
+		 (let ((next-state (trans-func)))
+		   (if next-state
+		       (next-state action)
+		       action))))))
+	 (prepare-state-yes-no
+	  (lambda (s r1 r2)
+	    (let ((peek-char       IS-peek-char)
+		  (end-go-to-point IS-end-go-to-point)
+		  (new-action1     #f)
+		  (trans-func (prepare-transition (vector-ref trees-v s))))
+	      (let ((result
+		     (lambda (action)
+		       (let* ((c (peek-char))
+			      (new-action
+			       (if (or (not c) (= c lexer-integer-newline))
+				   (begin
+				     (end-go-to-point)
+				     new-action1)
+				   action))
+			      (next-state (trans-func)))
+			 (if next-state
+			     (next-state new-action)
+			     new-action))))
+		    (hook
+		     (lambda ()
+		       (set! new-action1 (vector-ref rules-actions r1)))))
+		(add-hook hook)
+		result))))
+	 (prepare-state-diff-acc
+	  (lambda (s r1 r2)
+	    (let ((end-go-to-point IS-end-go-to-point)
+		  (peek-char       IS-peek-char)
+		  (new-action1     #f)
+		  (new-action2     #f)
+		  (trans-func (prepare-transition (vector-ref trees-v s))))
+	      (let ((result
+		     (lambda (action)
+		       (end-go-to-point)
+		       (let* ((c (peek-char))
+			      (new-action
+			       (if (or (not c) (= c lexer-integer-newline))
+				   new-action1
+				   new-action2))
+			      (next-state (trans-func)))
+			 (if next-state
+			     (next-state new-action)
+			     new-action))))
+		    (hook
+		     (lambda ()
+		       (set! new-action1 (vector-ref rules-actions r1))
+		       (set! new-action2 (vector-ref rules-actions r2)))))
+		(add-hook hook)
+		result))))
+	 (prepare-state-same-acc
+	  (lambda (s r1 r2)
+	    (let ((end-go-to-point IS-end-go-to-point)
+		  (trans-func (prepare-transition (vector-ref trees-v s)))
+		  (new-action #f))
+	      (let ((result
+		     (lambda (action)
+		       (end-go-to-point)
+		       (let ((next-state (trans-func)))
+			 (if next-state
+			     (next-state new-action)
+			     new-action))))
+		    (hook
+		     (lambda ()
+		       (set! new-action (vector-ref rules-actions r1)))))
+		(add-hook hook)
+		result))))
+	 (prepare-state
+	  (lambda (s)
+	    (let* ((acc (vector-ref acc-v s))
+		   (r1 (car acc))
+		   (r2 (cdr acc)))
+	      (cond ((not r1)  (prepare-state-no-acc   s r1 r2))
+		    ((not r2)  (prepare-state-yes-no   s r1 r2))
+		    ((< r1 r2) (prepare-state-diff-acc s r1 r2))
+		    (else      (prepare-state-same-acc s r1 r2))))))
+
+	 ; Fabrique la fonction de lancement du lexage a l'etat de depart
+	 (prepare-start-same
+	  (lambda (s1 s2)
+	    (let ((peek-char    IS-peek-char)
+		  (eof-action   #f)
+		  (start-state  #f)
+		  (error-action #f))
+	      (let ((result
+		     (lambda ()
+		       (if (not (peek-char))
+			   eof-action
+			   (start-state error-action))))
+		    (hook
+		     (lambda ()
+		       (set! eof-action   <<EOF>>-action)
+		       (set! start-state  (vector-ref states s1))
+		       (set! error-action <<ERROR>>-action))))
+		(add-hook hook)
+		result))))
+	 (prepare-start-diff
+	  (lambda (s1 s2)
+	    (let ((peek-char         IS-peek-char)
+		  (eof-action        #f)
+		  (peek-left-context IS-peek-left-context)
+		  (start-state1      #f)
+		  (start-state2      #f)
+		  (error-action      #f))
+	      (let ((result
+		     (lambda ()
+		       (cond ((not (peek-char))
+			      eof-action)
+			     ((= (peek-left-context) lexer-integer-newline)
+			      (start-state1 error-action))
+			     (else
+			      (start-state2 error-action)))))
+		    (hook
+		     (lambda ()
+		       (set! eof-action <<EOF>>-action)
+		       (set! start-state1 (vector-ref states s1))
+		       (set! start-state2 (vector-ref states s2))
+		       (set! error-action <<ERROR>>-action))))
+		(add-hook hook)
+		result))))
+	 (prepare-start
+	  (lambda ()
+	    (let ((s1 table-nl-start)
+		  (s2 table-no-nl-start))
+	      (if (= s1 s2)
+		  (prepare-start-same s1 s2)
+		  (prepare-start-diff s1 s2)))))
+
+	 ; Fabrique la fonction principale
+	 (prepare-lexer-none
+	  (lambda ()
+	    (let ((init-lexeme IS-init-lexeme)
+		  (start-func  (prepare-start)))
+	      (lambda ()
+		(init-lexeme)
+		((start-func))))))
+	 (prepare-lexer-line
+	  (lambda ()
+	    (let ((init-lexeme    IS-init-lexeme)
+		  (get-start-line IS-get-start-line)
+		  (start-func     (prepare-start)))
+	      (lambda ()
+		(init-lexeme)
+		(let ((yyline (get-start-line)))
+		  ((start-func) yyline))))))
+	 (prepare-lexer-all
+	  (lambda ()
+	    (let ((init-lexeme      IS-init-lexeme)
+		  (get-start-line   IS-get-start-line)
+		  (get-start-column IS-get-start-column)
+		  (get-start-offset IS-get-start-offset)
+		  (start-func       (prepare-start)))
+	      (lambda ()
+		(init-lexeme)
+		(let ((yyline   (get-start-line))
+		      (yycolumn (get-start-column))
+		      (yyoffset (get-start-offset)))
+		  ((start-func) yyline yycolumn yyoffset))))))
+	 (prepare-lexer
+	  (lambda ()
+	    (cond ((eq? counters-type 'none) (prepare-lexer-none))
+		  ((eq? counters-type 'line) (prepare-lexer-line))
+		  ((eq? counters-type 'all)  (prepare-lexer-all))))))
+
+      ; Calculer la valeur de <<EOF>>-action et de <<ERROR>>-action
+      (set! <<EOF>>-action   (prepare-special-action <<EOF>>-pre-action))
+      (set! <<ERROR>>-action (prepare-special-action <<ERROR>>-pre-action))
+
+      ; Calculer la valeur de rules-actions
+      (let* ((len (quotient (vector-length rules-pre-actions) 2))
+	     (v (make-vector len)))
+	(let loop ((r (- len 1)))
+	  (if (< r 0)
+	      (set! rules-actions v)
+	      (let* ((yytext? (vector-ref rules-pre-actions (* 2 r)))
+		     (pre-action (vector-ref rules-pre-actions (+ (* 2 r) 1)))
+		     (action (if yytext?
+				 (prepare-action-yytext    pre-action)
+				 (prepare-action-no-yytext pre-action))))
+		(vector-set! v r action)
+		(loop (- r 1))))))
+
+      ; Calculer la valeur de states
+      (let* ((len (vector-length trees-v))
+	     (v (make-vector len)))
+	(let loop ((s (- len 1)))
+	  (if (< s 0)
+	      (set! states v)
+	      (begin
+		(vector-set! v s (prepare-state s))
+		(loop (- s 1))))))
+
+      ; Calculer la valeur de final-lexer
+      (set! final-lexer (prepare-lexer))
+
+      ; Executer les hooks
+      (apply-hooks)
+
+      ; Resultat
+      final-lexer)))
+
+; Fabrication de lexer a partir de listes de caracteres taggees
+(define lexer-make-char-lexer
+  (let* ((char->class
+	  (lambda (c)
+	    (let ((n (char->integer c)))
+	      (list (cons n n)))))
+	 (merge-sort
+	  (lambda (l combine zero-elt)
+	    (if (null? l)
+		zero-elt
+		(let loop1 ((l l))
+		  (if (null? (cdr l))
+		      (car l)
+		      (loop1
+		       (let loop2 ((l l))
+			 (cond ((null? l)
+				l)
+			       ((null? (cdr l))
+				l)
+			       (else
+				(cons (combine (car l) (cadr l))
+				      (loop2 (cddr l))))))))))))
+	 (finite-class-union
+	  (lambda (c1 c2)
+	    (let loop ((c1 c1) (c2 c2) (u '()))
+	      (if (null? c1)
+		  (if (null? c2)
+		      (reverse u)
+		      (loop c1 (cdr c2) (cons (car c2) u)))
+		  (if (null? c2)
+		      (loop (cdr c1) c2 (cons (car c1) u))
+		      (let* ((r1 (car c1))
+			     (r2 (car c2))
+			     (r1start (car r1))
+			     (r1end (cdr r1))
+			     (r2start (car r2))
+			     (r2end (cdr r2)))
+			(if (<= r1start r2start)
+			    (cond ((< (+ r1end 1) r2start)
+				   (loop (cdr c1) c2 (cons r1 u)))
+				  ((<= r1end r2end)
+				   (loop (cdr c1)
+					 (cons (cons r1start r2end) (cdr c2))
+					 u))
+				  (else
+				   (loop c1 (cdr c2) u)))
+			    (cond ((> r1start (+ r2end 1))
+				   (loop c1 (cdr c2) (cons r2 u)))
+				  ((>= r1end r2end)
+				   (loop (cons (cons r2start r1end) (cdr c1))
+					 (cdr c2)
+					 u))
+				  (else
+				   (loop (cdr c1) c2 u))))))))))
+	 (char-list->class
+	  (lambda (cl)
+	    (let ((classes (map char->class cl)))
+	      (merge-sort classes finite-class-union '()))))
+	 (class-<
+	  (lambda (b1 b2)
+	    (cond ((eq? b1 'inf+) #f)
+		  ((eq? b2 'inf-) #f)
+		  ((eq? b1 'inf-) #t)
+		  ((eq? b2 'inf+) #t)
+		  (else (< b1 b2)))))
+	 (finite-class-compl
+	  (lambda (c)
+	    (let loop ((c c) (start 'inf-))
+	      (if (null? c)
+		  (list (cons start 'inf+))
+		  (let* ((r (car c))
+			 (rstart (car r))
+			 (rend (cdr r)))
+		    (if (class-< start rstart)
+			(cons (cons start (- rstart 1))
+			      (loop c rstart))
+			(loop (cdr c) (+ rend 1))))))))
+	 (tagged-chars->class
+	  (lambda (tcl)
+	    (let* ((inverse? (car tcl))
+		   (cl (cdr tcl))
+		   (class-tmp (char-list->class cl)))
+	      (if inverse? (finite-class-compl class-tmp) class-tmp))))
+	 (charc->arc
+	  (lambda (charc)
+	    (let* ((tcl (car charc))
+		   (dest (cdr charc))
+		   (class (tagged-chars->class tcl)))
+	      (cons class dest))))
+	 (arc->sharcs
+	  (lambda (arc)
+	    (let* ((range-l (car arc))
+		   (dest (cdr arc))
+		   (op (lambda (range) (cons range dest))))
+	      (map op range-l))))
+	 (class-<=
+	  (lambda (b1 b2)
+	    (cond ((eq? b1 'inf-) #t)
+		  ((eq? b2 'inf+) #t)
+		  ((eq? b1 'inf+) #f)
+		  ((eq? b2 'inf-) #f)
+		  (else (<= b1 b2)))))
+	 (sharc-<=
+	  (lambda (sharc1 sharc2)
+	    (class-<= (caar sharc1) (caar sharc2))))
+	 (merge-sharcs
+	  (lambda (l1 l2)
+	    (let loop ((l1 l1) (l2 l2))
+	      (cond ((null? l1)
+		     l2)
+		    ((null? l2)
+		     l1)
+		    (else
+		     (let ((sharc1 (car l1))
+			   (sharc2 (car l2)))
+		       (if (sharc-<= sharc1 sharc2)
+			   (cons sharc1 (loop (cdr l1) l2))
+			   (cons sharc2 (loop l1 (cdr l2))))))))))
+	 (class-= eqv?)
+	 (fill-error
+	  (lambda (sharcs)
+	    (let loop ((sharcs sharcs) (start 'inf-))
+	      (cond ((class-= start 'inf+)
+		     '())
+		    ((null? sharcs)
+		     (cons (cons (cons start 'inf+) 'err)
+			   (loop sharcs 'inf+)))
+		    (else
+		     (let* ((sharc (car sharcs))
+			    (h (caar sharc))
+			    (t (cdar sharc)))
+		       (if (class-< start h)
+			   (cons (cons (cons start (- h 1)) 'err)
+				 (loop sharcs h))
+			   (cons sharc (loop (cdr sharcs)
+					     (if (class-= t 'inf+)
+						 'inf+
+						 (+ t 1)))))))))))
+	 (charcs->tree
+	  (lambda (charcs)
+	    (let* ((op (lambda (charc) (arc->sharcs (charc->arc charc))))
+		   (sharcs-l (map op charcs))
+		   (sorted-sharcs (merge-sort sharcs-l merge-sharcs '()))
+		   (full-sharcs (fill-error sorted-sharcs))
+		   (op (lambda (sharc) (cons (caar sharc) (cdr sharc))))
+		   (table (list->vector (map op full-sharcs))))
+	      (let loop ((left 0) (right (- (vector-length table) 1)))
+		(if (= left right)
+		    (cdr (vector-ref table left))
+		    (let ((mid (quotient (+ left right 1) 2)))
+		      (if (and (= (+ left 2) right)
+			       (= (+ (car (vector-ref table mid)) 1)
+				  (car (vector-ref table right)))
+			       (eqv? (cdr (vector-ref table left))
+				     (cdr (vector-ref table right))))
+			  (list '=
+				(car (vector-ref table mid))
+				(cdr (vector-ref table mid))
+				(cdr (vector-ref table left)))
+			  (list (car (vector-ref table mid))
+				(loop left (- mid 1))
+				(loop mid right))))))))))
+    (lambda (tables IS)
+      (let ((counters         (vector-ref tables 0))
+	    (<<EOF>>-action   (vector-ref tables 1))
+	    (<<ERROR>>-action (vector-ref tables 2))
+	    (rules-actions    (vector-ref tables 3))
+	    (nl-start         (vector-ref tables 5))
+	    (no-nl-start      (vector-ref tables 6))
+	    (charcs-v         (vector-ref tables 7))
+	    (acc-v            (vector-ref tables 8)))
+	(let* ((len (vector-length charcs-v))
+	       (v (make-vector len)))
+	  (let loop ((i (- len 1)))
+	    (if (>= i 0)
+		(begin
+		  (vector-set! v i (charcs->tree (vector-ref charcs-v i)))
+		  (loop (- i 1)))
+		(lexer-make-tree-lexer
+		 (vector counters
+			 <<EOF>>-action
+			 <<ERROR>>-action
+			 rules-actions
+			 'decision-trees
+			 nl-start
+			 no-nl-start
+			 v
+			 acc-v)
+		 IS))))))))
+
+; Fabrication d'un lexer a partir de code pre-genere
+(define lexer-make-code-lexer
+  (lambda (tables IS)
+    (let ((<<EOF>>-pre-action   (vector-ref tables 1))
+	  (<<ERROR>>-pre-action (vector-ref tables 2))
+	  (rules-pre-action     (vector-ref tables 3))
+	  (code                 (vector-ref tables 5)))
+      (code <<EOF>>-pre-action <<ERROR>>-pre-action rules-pre-action IS))))
+
+(define lexer-make-lexer
+  (lambda (tables IS)
+    (let ((automaton-type (vector-ref tables 4)))
+      (cond ((eq? automaton-type 'decision-trees)
+	     (lexer-make-tree-lexer tables IS))
+	    ((eq? automaton-type 'tagged-chars-lists)
+	     (lexer-make-char-lexer tables IS))
+	    ((eq? automaton-type 'code)
+	     (lexer-make-code-lexer tables IS))))))
+
+;
+; Table generated from the file twiki.l by SILex 1.0
+;
+
+(define lexer-default-table
+  (vector
+   'line
+   (lambda (yycontinue yygetc yyungetc)
+     (lambda (yytext yyline)
+                                (list 'end-of-input #f ) ;; yyline)
+       ))
+   (lambda (yycontinue yygetc yyungetc)
+     (lambda (yytext yyline)
+                                (lex-error (conc yyline " : illegal character ") (yygetc))
+       ))
+   (vector
+    #t
+    (lambda (yycontinue yygetc yyungetc)
+      (lambda (yytext yyline)
+                                (list 'opensq     yytext)
+        ))
+    #t
+    (lambda (yycontinue yygetc yyungetc)
+      (lambda (yytext yyline)
+                                (list 'closesq    yytext)
+        ))
+    #t
+    (lambda (yycontinue yygetc yyungetc)
+      (lambda (yytext yyline)
+                                (list 'opensquig  yytext)
+        ))
+    #t
+    (lambda (yycontinue yygetc yyungetc)
+      (lambda (yytext yyline)
+                                (list 'closesquig yytext)
+        ))
+    #t
+    (lambda (yycontinue yygetc yyungetc)
+      (lambda (yytext yyline)
+                                (list 'bang       yytext)
+        ))
+    #t
+    (lambda (yycontinue yygetc yyungetc)
+      (lambda (yytext yyline)
+                                (list 'plaintext  yytext)
+        )))
+   'decision-trees
+   0
+   0
+   '#((59 (35 (32 (9 err (11 1 err)) (33 1 (34 2 err))) (38 (= 36 err 1)
+    (44 (39 err 1) (45 err 1)))) (95 (92 (65 err (91 1 6)) (93 1 (94 5
+    err))) (123 (= 96 err 1) (125 (124 4 err) (126 3 err))))) (44 (35 (11
+    (9 err 1) (= 32 1 err)) (37 (36 1 err) (= 38 err 1))) (92 (59 (45 err
+    1) (65 err (91 1 err))) (96 (93 1 (95 err 1)) (97 err (123 1 err)))))
+    err err err err err)
+   '#((#f . #f) (5 . 5) (4 . 4) (3 . 3) (2 . 2) (1 . 1) (0 . 0))))
+
+;
+; User functions
+;
+
+(define lexer #f)
+
+(define lexer-get-line   #f)
+(define lexer-getc       #f)
+(define lexer-ungetc     #f)
+
+(define lexer-init
+  (lambda (input-type input)
+    (let ((IS (lexer-make-IS input-type input 'line)))
+      (set! lexer (lexer-make-lexer lexer-default-table IS))
+      (set! lexer-get-line   (lexer-get-func-line IS))
+      (set! lexer-getc       (lexer-get-func-getc IS))
+      (set! lexer-ungetc     (lexer-get-func-ungetc IS)))))

ADDED   stml2/modules/twiki/twiki.scm
Index: stml2/modules/twiki/twiki.scm
==================================================================
--- /dev/null
+++ stml2/modules/twiki/twiki.scm
@@ -0,0 +1,68 @@
+;; twiki module
+(require-extension silex sqlite3 regex posix)
+
+(include "twiki.l.scm")
+
+(define (twiki:open-db keys)
+  (let* ((fname   (twiki:keys->fname keys))
+	 (fexists (file-exists? fname))
+	 (db (dbi:open 'sqlite3 '((dbname . fname)))))
+    (if (not fexists)
+	(for-each 
+	 (lambda (sqry)
+	   (dbi:exec db sqry))
+	 '("CREATE TABLE dats     (id INTEGER PRIMARY KEY,md5sum TEXT,dat BLOB,type INTEGER);"
+	   "CREATE TABLE tiddlers (id INTEGER PRIMARY KEY,wiki_id INTEGER,name TEXT,rev INTEGER,dat_id INTEGER,created_on INTEGER,changed_on INTEGER,owner_id INTEGER);"
+	   "CREATE TABLE revs     (id INTEGER PRIMARY KEY,tag TEXT);"
+	   "CREATE TABLE wikis    (id INTEGER PRIMARY KEY,key_name TEXT,title TEXT,created_on INTEGER);")))
+    (sqlite3:set-busy-timeout!(dbi:db-conn db) 1000000)
+    db))
+	
+(define (twiki:view)
+  (s:div 'class "node"
+  (s:h1 "Twiki")
+  "Title, pictures, etc."
+   (let ()
+     "blah")))
+
+
+(define (twiki:wiki . keys)
+  (let ((key (conc keys)))
+    (twiki:view)))
+
+(define (twiki:extract-tiddlers dat)
+  (let* ((inp (open-input-string dat))
+	 (prev-state #f)
+	 (stack      (list 'start))
+	 (links      '())
+	 (currlnk    #f))
+    (lexer-init 'port inp)
+    (let loop ((token          (lexer)))
+      (let ((token-type (car token))
+	    (token-val  (cadr token))
+	    (state      (car  stack)))
+	(if (not (eq? prev-state state))
+	    (begin
+	      (print "state: " state)
+	      (set! prev-state state)))
+	(case token-type
+	  ('end-of-input       (print "Done")(close-input-port inp))
+	  ('twikilink-start
+	   (set! stack (cons 'twikilink-start stack))
+	   (loop (lexer)))
+	  ('twikilink-end
+	   (set! links (cons currlnk links))
+	   (set! stack (cdr stack))
+	   (loop (lexer)))
+	  ('twikitext
+	   (if (eq? state 'twikilink-start)
+	       (set! currlnk (cadr token))
+	       (print "Got " token))
+	   (loop (lexer)))
+	  ('anydat
+	   (loop (lexer)))
+	  (else
+	   (print "ERROR: unknown token " token " on line " (lexer-get-line))
+	   (loop (lexer))))))
+    links))
+     

ADDED   stml2/modules/twiki/twikiparser.scm
Index: stml2/modules/twiki/twikiparser.scm
==================================================================
--- /dev/null
+++ stml2/modules/twiki/twikiparser.scm
@@ -0,0 +1,457 @@
+
+(require-extension sqlite3 regex posix eformat silex stack regex)
+
+(define help "
+Usage: nldb [options]
+
+
+General
+  -h                      : this help
+
+Netlist data queries
+
+  -findpath start,end     : find path from start to end. % is a wildcard
+
+Managing netlist data
+
+  -load /path/to/netlist  : load a model into the db
+  -d dbname               : name of the .db file
+  -dump fname             : dump the netlist in to verilog file
+
+")
+
+(include "/nfs/an/home/mrwellan/stuff/tools/lnkmkr/args.scm")
+(include "verilog.l.scm")
+
+;; process args
+(define remargs (get-args (argv)
+			  (list "-load"
+				"-d"          "-dump" 
+				"-findpath")
+			  
+			  (list "-h"
+				)
+			  arg-hash
+			  0)) ;;
+
+(define dbpaths (list "testing.db"))
+
+(define dbpath #f)
+
+(if (get-arg "-d")
+    (set! dbpath (get-arg "-d"))
+    (for-each
+     (lambda (path)
+       (if (file-exists? path)
+	   (set! dbpath path)))
+     dbpaths))
+
+(if (and (not dbpath) (get-arg "-d"))
+    (begin
+      (print "Can't find db. " (get-arg "-d") " Try again or contact Matt!")
+      (exit 1)))
+
+(define dbexists (file-exists? dbpath))
+
+(define realuser (getenv "USER"))
+(define user realuser)
+
+(define db (sqlite3:open dbpath))
+(sqlite3:set-busy-timeout! db 1000000)
+
+(define (mk-tables)
+  (for-each
+   (lambda (sqlstmt)
+     (sqlite3:exec db sqlstmt))
+   (list "CREATE TABLE modules(id INTEGER PRIMARY KEY,name_id INTEGER);"
+	 "CREATE TABLE nets   (id INTEGER PRIMARY KEY,name_id INTEGER,module_id INTEGER);"
+	 "CREATE TABLE insts  (id INTEGER PRIMARY KEY,name_id INTEGER,module_id INTEGER,parent_id INTEGER);"
+	 "CREATE TABLE pins   (id INTEGER PRIMARY KEY,name_id INTEGER,module_id INTEGER,net_id INTEGER,type_id INTEGER);"
+	 "CREATE TABLE conns  (id INTEGER PRIMARY KEY,net_id  INTEGER,inst_id INTEGER,pin_id INTEGER);"
+	 "CREATE TABLE names  (id INTEGER PRIMARY KEY,name TEXT);"
+	 "CREATE TABLE types(id INTEGER PRIMARY KEY,type TEXT);"
+	 "INSERT INTO types VALUES(1, 'undef');"
+	 "INSERT INTO types VALUES(2, 'input');"
+	 "INSERT INTO types VALUES(3, 'output');"
+	 "INSERT INTO types VALUES(4, 'inout');"
+	 "INSERT INTO types VALUES(5, 'pwr');"
+	 "PRAGMA synchronous=OFF;")))
+
+(if (not dbexists)(mk-tables))
+
+;;======================================================================
+;; NETLIST READING
+;;======================================================================
+
+;; Use a stack to tracking state
+;;
+(define nldb:*stack* (make-stack))
+
+(define (nldb:read-files fnames) ;; read in a list of files
+  (for-each 
+   (lambda (fname)
+     (if (file-exists? fname)
+	 (nldb:read-file fname)))
+   fnames))
+
+;;======================================================================
+;; PRECOMPILED REGEXS
+;;======================================================================
+
+(define nldb:escaped-name     (regexp "^\\s*\\\\([^\\s]+)\\s*"))
+(define nldb:trailing-garbage (regexp "^\\s*([^\\s,;]+)[,;\\s]*$"))
+(define nldb:module-pin       (regexp "^\\s*([^\\s]+)\\s*([,\\s\\)]*)"))
+(define nldb:pins-end         (regexp "\\)\\s*;"))
+(define nldb:input-output     (regexp "\\s*(input|output)\\s+([^\\s]+)[\\s;,]"))
+
+;;                                           modname instname( .\pinname[35] (\netname ),
+(define nldb:instance         (regexp "^\\s*([^\\s]+)\\s+([^\\s]+)\\s*\\(\\s*\\.([^\\s]+)\\s*\\(\\s*([^\\s]+)\\s*\\)\\s*,"))
+(define nldb:inst-conn        (regexp "^\\s*\\.([^\\s]+)\\s*\\(\\s*([^\\s])+\\s+\\)\\s*([\\),;]+)"))
+
+;;                                                 module_name         netname (opt)
+(define nldb:module-regex (regexp "^\\s*module\\s+([^\\s]+)\\s*\\(\\s*([^\\s,]+\\s*,|)$"))
+
+;;======================================================================
+;; MISC
+;;======================================================================
+
+;; apply regex and set nldb:match-val
+(define nldb:match-val #f)
+(define (nldb:regex-match r l)
+  (let ((m (string-match r l)))
+    (set! nldb:match-val m) m))
+
+;; stmt can only return *one* value!!
+(define (nldb:sqlite3:get-one stmt . params)
+  (let ((sqlstmt (sqlite3:prepare db stmt))
+	(result  #f))
+    (apply sqlite3:for-each-row
+	   (lambda (x)
+	     (set! result x)) sqlstmt params)
+    (sqlite3:finalize! sqlstmt)
+    result))
+
+;;======================================================================
+;; CACHE
+;;======================================================================
+
+(define *cache*             (make-hash-table))
+(define *module-name-cache* (make-hash-table))
+
+(define (cache-get-module-hash module)
+  (sub-hash-create-get *cache* module))
+
+(define (sub-hash-create-get subhash key)
+  (let ((shash (hash-table-get/default subhash key)))
+    (if shash shash
+	(let ((newh (make-hash-table)))
+	  (hash-table-set! subhash key newh)
+	  newh))))
+
+;; (cache-set! "abc_adder" 'pin "addrin" 0)
+(define (cache-set! module objtype objname value)
+  (let* ((mhash (cache-get-module-hash module))
+	 (thash (sub-hash-create-get mhash objtype)))
+    (hash-table-set! thash objname value)))
+
+(define (cache-ref module objtype objname)
+  (let ((mhash (hash-table-ref/default *cache* module)))
+    (if mhash
+	(let ((ohash (hash-table-ref/default mhash objtype)))
+	  (if ohash
+	      (hash-table-ref/default ohash objname)
+	      #f))
+	#f)))
+    
+;;======================================================================
+;; NAMES
+;;======================================================================
+
+(define nldb:names-hash (make-hash-table))
+
+;; always sucessful. inserts name if not found
+(define (nldb:get-name-id name)
+  (let ((cached-id (hash-table-ref/default nldb:names-hash name #f)))
+    (if cached-id cached-id
+	(let ((id (nldb:sqlite3:get-one "SELECT id FROM names WHERE name=?;" name)))
+	  (if id
+	      (begin
+		(hash-table-set! nldb:names-hash name id )
+		id)
+	      (begin
+		(sqlite3:exec db "INSERT INTO names (name) VALUES (?);" name)
+		(nldb:get-name-id name)))))))
+
+(define (nldb:clean-name name)
+  (if (nldb:regex-match nldb:escaped-name name) ;; process escaped identifiers
+      (list-ref nldb:match-val 1)
+      (if (nldb:regex-match nldb:trailing-garbage name)
+	  (list-ref nldb:match-val 1)
+	  name)))
+
+;;======================================================================
+;; MODULES
+;;======================================================================
+
+;; add a module and return its id.
+(define (nldb:get-module-id name-id)
+  (let ((id  (nldb:sqlite3:get-one 
+	      "SELECT id FROM modules WHERE name_id=?;" name-id)))
+    (if id id
+	(begin
+	  (nldb:insert-module name-id)
+	  (nldb:get-module-id name-id))))) ;; now retrieve and return the id
+
+;; not safe to use outside of get-module-id - could add duplicates
+(define (nldb:insert-module name-id)
+  (sqlite3:exec db "INSERT INTO modules (name_id) VALUES (?);" name-id))
+
+;; module namespace is unique so this is ok, should check for redefining though.
+(define (nldb:get-module-by-name name)
+  (let ((module-id (hash-table-ref *module-name-cache* name)))
+    (if module-id module-id
+	(let ((mid (nldb:get-module-id (nldb:get-name-id name))))
+	  (hash-table-set! *module-name-cache* name mid)))))
+
+;;======================================================================
+;; PINS
+;;======================================================================
+
+(define (nldb:get-pin-id module-id name-id)
+  (nldb:sqlite3:get-one 
+   (string-append "SELECT id FROM pins WHERE module_id=? AND name_id=?;") 
+   module-id name-id))
+
+(define (nldb:add-pin module-id name-id type-id)
+  (let ((pin-id (nldb:get-pin-id module-id name-id)))
+    (if pin-id pin-id
+	(begin	
+	  (nldb:insert-pin module-id name-id type-id)
+	  (nldb:get-pin-id module-id name-id)))))
+
+(define (nldb:insert-pin module-id name-id type-id)
+  (sqlite3:exec db "INSERT INTO pins (module_id,name_id,type_id) VALUES (?,?,?);"
+		module-id name-id (if type-id type-id 0)))
+
+(define (nldb:set-pin-direction pin-id direction)
+  (sqlite3:exec db "UPDATE pins SET type_id=(SELECT id FROM types WHERE type=?) WHERE id=?;" direction pin-id))
+
+(define (nldb:set-pin-net pin-id net-id)
+  (sqlite3:exec db "UPDATE pins SET net_id=? WHERE id=?;" net-id pin-id))
+
+;;====================================================================
+;; CONNS
+;;======================================================================
+
+(define (nldb:get-conn-id inst-id pin-id)
+  ;; (if (not (and inst-id pin-id))(print "ERROR: nldb:get-conn-id called with bad params: inst-id " inst-id " pin-id " pin-id)
+  (nldb:sqlite3:get-one  "SELECT id FROM conns WHERE inst_id=? AND pin_id=?;" inst-id pin-id))
+
+(define (nldb:add-conn inst-id pin-id net-id)
+  ;;  (if (not (and inst-id pin-id net-id))(print "ERROR: nldb:add-conn called with bad params: inst-id " inst-id " pin-id " pin-id " net-id " net-id)
+  (let ((conn-id (nldb:get-conn-id inst-id pin-id)))
+    (if conn-id conn-id
+	(begin	
+	  (nldb:insert-conn inst-id pin-id net-id)
+	  (nldb:get-conn-id inst-id pin-id)))))
+
+(define (nldb:insert-conn inst-id pin-id net-id)
+  ;;  (if (not (and inst-id pin-id net-id))(print "ERROR: nldb:insert-conn called with bad params: inst-id " inst-id " pin-id " pin-id " net-id " net-id)
+  (sqlite3:exec db "INSERT INTO conns (inst_id,pin_id,net_id) VALUES (?,?,?);"
+		inst-id pin-id net-id ))
+
+;;======================================================================
+;; NET
+;;======================================================================
+
+(define (nldb:get-net-id module-id name-id)
+  (nldb:sqlite3:get-one "SELECT id FROM nets WHERE name_id=?;" name-id))
+
+(define (nldb:add-net module-id name-id)
+  (let ((net-id (nldb:get-net-id module-id name-id)))
+    (if net-id net-id
+	(begin
+	  (nldb:insert-net module-id name-id)
+	  (nldb:get-net-id module-id name-id)))))
+
+(define (nldb:insert-net module-id name-id)
+  (sqlite3:exec db "INSERT INTO nets (module_id,name_id) VALUES(?,?);" module-id name-id))
+
+;;======================================================================
+;; INSTANCES
+;;======================================================================
+
+(define (nldb:get-inst-id parent-id name-id)
+  (nldb:sqlite3:get-one "SELECT id FROM insts WHERE parent_id=? AND name_id=?;" parent-id name-id))
+
+;; sub-mod-id = type of instance, parent-id = where instantiated
+(define (nldb:add-inst module-id parent-id name-id)
+  (let ((inst-id (nldb:get-inst-id parent-id name-id))) ;; parent and name are enough to identify it
+    (if inst-id inst-id
+	(begin
+	  (nldb:insert-inst module-id parent-id name-id)
+	  (nldb:get-inst-id parent-id name-id)))))
+
+(define (nldb:insert-inst module-id parent-id name-id)
+  (sqlite3:exec db "INSERT INTO insts (module_id,parent_id,name_id) VALUES(?,?,?);" module-id parent-id name-id))
+
+;;======================================================================
+;; RECORD FOR STATE
+;;======================================================================
+
+(define *statevec* (make-vector 5))
+
+(define-inline (curr-pin-id)           (vector-ref  *statevec* 0))
+(define-inline (curr-inst-id)          (vector-ref  *statevec* 1))
+(define-inline (curr-module-id)        (vector-ref  *statevec* 2))
+(define-inline (curr-inst-module-id)   (vector-ref  *statevec* 3))
+
+(define-inline (set-curr-pin-id!         id)(vector-set! *statevec* 0 id))
+(define-inline (set-curr-inst-id!        id)(vector-set! *statevec* 1 id))
+(define-inline (set-curr-module-id!      id)(vector-set! *statevec* 2 id))
+(define-inline (set-curr-inst-module-id! id)(vector-set! *statevec* 3 id))
+
+;;======================================================================
+;; FILE I/O
+;;======================================================================
+
+;; Initialization and support routines for nldb:read-file
+(stack-push! nldb:*stack* 'start)
+(define nldb:esc-regex  (regexp "^\\\\([^\\s]*)\\s*$") )
+(define (nldb:clean-identifier token)
+  (let* ((t   (car token))
+	 (v   (cadr token))
+	 (ctm (string-match nldb:esc-regex v)))
+    (list 'identifier (list-ref ctm 1))))
+
+
+(define (nldb:read-file fname)
+  (let* ((inp (open-input-file fname))
+	 (prev-state #f))
+    (lexer-init 'port inp)
+    (let loop ((token          (lexer)))
+      (let ((token-type (car token))
+	    (token-val  (cadr token))
+	    (state      (stack-peek herc:*stack*)))
+	(if (not (eq? prev-state state))
+	    (begin
+	      (print "state: " state)
+	      (set! prev-state state)))
+	(case token-type
+	  ('end-of-input       (print "Done")(close-input-port inp))
+	  ('whitespace         (loop (lexer)))  ;; skip whitespace
+	  ('comment-begin      
+	   (stack-push! herc:*stack* 'comment )
+	   (loop (lexer)))
+	  ('comment-end        (stack-pop! herc:*stack*)(loop (lexer)))
+	  ('begin              (stack-push! herc:*stack* 'begin)(loop (lexer)))
+	  ('end                (stack-pop! herc:*stack*)(loop (lexer)))
+	  ('cell
+	   (case state
+	     ('begin
+	       (stack-push! herc:*stack* 'cell-name)
+	       (loop (lexer)))
+	     (else
+	      (loop (lexer)))))
+	  ('plainidentifier
+	   (case state
+	     ('cell-name
+
+	  ('statementend       (stack-pop! nldb:*stack*)(loop (lexer)))
+	  ('endparen           (stack-pop! nldb:*stack*)(loop (lexer)))
+	  ('endmodule          (stack-pop! nldb:*stack*)(loop (lexer)))
+
+	  ('startparen 
+	   (case state
+	     ('module-pins     (loop (lexer)))
+	     ('inst-def        (loop (lexer)))
+	     ('inst-conn-def   (loop (lexer)))
+	     ('pin-net         (loop (lexer)))
+	     (else             (print "ERROR: Didn't expect an open paren here! Line " (lexer-get-line)))))
+
+	  ('comma
+	   (case state
+	     ('module-pins     (loop (lexer)))
+	     ('input-pin       (loop (lexer)))
+	     ('output-pin      (loop (lexer)))
+	     ('wire            (loop (lexer)))
+	     ('inst-conn-def   (loop (lexer))) ;; (stack-pop! nldb:*stack*) (loop (lexer)))
+	     (else             (print "ERROR: Didn't expect a comma here! Line " (lexer-get-line)))))
+
+	  ('module 
+	   (case state
+	     ('start 
+	      (stack-push! nldb:*stack* 'module)      ;; we will be in a module
+	      (stack-push! nldb:*stack* 'module-def)) ;; starting in the def
+	     (else
+	      (print "ERROR: Didn't expect module declaration here! Line " (lexer-get-line))))
+	   (loop (lexer)))
+
+	  ('input 
+	   (case state
+	     ('module      (stack-push! nldb:*stack* 'input-pin))
+	     (else         (print "ERROR: Didn't expect \"input\" statement here! Linenum " (lexer-get-line))))
+	   (loop (lexer)))
+
+	  ('output
+	   (case state
+	     ('module      (stack-push! nldb:*stack* 'output-pin))
+	     (else         (print "ERROR: Didn't expect \"output\" statement here! Linenum " (lexer-get-line))))
+	   (loop (lexer)))
+	  
+	  ('inout
+	   (case state
+	     ('module      (stack-push! nldb:*stack* 'inout-pin))
+	     (else         (print "ERROR: Didn't expect \"inout\" statement here! Linenum " (lexer-get-line))))
+	   (loop (lexer)))
+
+	  ('pin 
+	   (case state
+	     ('inst-conn-def
+	      (let* ((pin-name    (substring token-val 1 (string-length token-val)))
+		     (pin-name-id (nldb:get-name-id pin-name))
+		     (pin-id      (nldb:add-pin (curr-module-id) pin-name-id #f)))
+		(stack-push! nldb:*stack* 'pin-net)
+		(set-curr-pin-id! pin-id)
+		(loop (lexer))))
+	     (else  (print "ERROR: Didn't expect pin here " token-val " Linenum: " (lexer-get-line)))))
+
+	  ('identifier
+	   (case state
+	     ('module  ;; this must be an instance, an identifier at the top level
+	      (let* ((inst-mod-id (nldb:get-module-by-name token-val)))
+		(set-curr-inst-module-id! inst-mod-id)
+		(stack-push! nldb:*stack* 'inst-def))
+	      (loop (lexer)))
+	     ('inst-def                  ;;     inst-module type  parent-id    inst-name-id
+	      (let* ((inst-id (nldb:add-inst (curr-inst-module-id)(curr-module-id)(nldb:get-name-id token-val))))
+		(set-curr-inst-id! inst-id))
+	      (stack-push! nldb:*stack* 'inst-conn-def)
+	      (loop (lexer)))
+	     ('module-def
+	      (let* ((m-id (nldb:get-module-by-name token-val)))
+		(set-curr-module-id! m-id))
+	      (stack-push! nldb:*stack* 'module-pins))
+	     ('module-pins
+	      (nldb:add-pin (curr-module-id) (nldb:get-name-id token-val) #f))
+	     ('input-pin
+	      (let ((pin-id (nldb:get-pin-id (curr-module-id) (nldb:get-name-id token-val))))
+		(nldb:set-pin-direction pin-id "input")))
+	     ('output-pin
+	      (let ((pin-id (nldb:get-pin-id (curr-module-id) (nldb:get-name-id token-val))))
+		(nldb:set-pin-direction pin-id "output")))
+	     ('inout-pin
+	      (let ((pin-id (nldb:get-pin-id (curr-module-id) (nldb:get-name-id token-val))))
+		(nldb:set-pin-direction pin-id "inout")))
+	     ('pin-net
+	      (let* ((net-name-id (nldb:get-name-id token-val))
+		     (net-id      (nldb:add-net (curr-inst-module-id) net-name-id)))
+		(nldb:add-conn (curr-inst-id) (curr-pin-id) net-id)))
+	     (else
+	      (print "ERROR: Didn't expect an identifier here! Token " token-val " Line " (lexer-get-line))))
+	   (loop (lexer)))
+
+	  (else
+	   (print "ERROR: unknown token " token " on line " (lexer-get-line))
+	   (loop (lexer))))))))
+     

ADDED   stml2/requirements.scm.template
Index: stml2/requirements.scm.template
==================================================================
--- /dev/null
+++ stml2/requirements.scm.template
@@ -0,0 +1,16 @@
+;; choose your db interface as appropriate
+(require-extension sqlite3)
+(import (prefix sqlite3 sqlite3:))
+
+;; (require-extension postgresql)
+;; (import (prefix postgresql pg:))
+
+;; (require-extension cgi-util)
+;; (require-extension cookie)
+(use posix)
+;; (require-extension proplist)
+(use regex)
+(use srfi-1) 
+;; (require-extension tinyclos)
+(use srfi-69)
+(use data-structures)

ADDED   stml2/rollup-pages.scm
Index: stml2/rollup-pages.scm
==================================================================
--- /dev/null
+++ stml2/rollup-pages.scm
@@ -0,0 +1,49 @@
+(use regex posix srfi-69 srfi-1)
+
+(define extract-rx (regexp "pages\\/(.*)_(view|ctrl).scm"))
+
+(define (print-page-wrapper lookup page)
+  (print "(define (pages:" page " session db shared)")
+  (if (hash-table-ref/default lookup (conc page "_ctrl") #f)
+      (print "(include \"pages/" page "_ctrl.scm\")"))
+  (if (hash-table-ref/default lookup (conc page "_view") #f)
+      (print "(include \"pages/" page "_view.scm\")"))
+  (print ")\n"))
+
+(let* ((views  (glob "pages/*_view.scm"))
+       (ctrls  (glob "pages/*_ctrl.scm"))
+       (all    (append views ctrls))
+       (lookup (make-hash-table))
+       (pages  (delete-duplicates
+		(map (lambda (x)
+		       (let* ((res  (string-match extract-rx x))
+			      (page (cadr res))
+			      (type (caddr res)))
+			 (hash-table-set! lookup (conc page "_" type) #t)
+			 (cadr res)))
+		     all))))
+  (if (null? all)(begin (print "No page files matching pages/*_(view|ctrl).scm")(exit)))
+  (print "Pages: " pages)
+  ;; first the individual rollup wrappers (used by the dynamic load)
+  (for-each 
+   (lambda (page)
+     (let ((pagefile  (conc "pages/" page ".scm")))
+       (print "page " page " ")
+       (if (not (file-exists? pagefile))
+	   (begin
+	     (with-output-to-file pagefile
+	       (lambda ()
+		 (print-page-wrapper lookup page)))
+	     (print " created"))
+	   (print " already created"))))
+   pages)
+  ;; then the monolithic rollup wrapper (used in compiling the single-executable)
+  (with-output-to-file "all_pages.scm"
+    (lambda ()
+      (for-each
+       (lambda (page)
+	 (print-page-wrapper lookup page))
+       pages))))
+
+
+  

ADDED   stml2/session.scm
Index: stml2/session.scm
==================================================================
--- /dev/null
+++ stml2/session.scm
@@ -0,0 +1,20 @@
+;; Copyright 2007-2011, 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 session))
+(module session
+    *
+  
+(import chicken scheme data-structures extras srfi-13 ports posix files srfi-1)
+
+(use (prefix dbi dbi:) srfi-69)
+(require-extension regex)
+(use cookie stmlcommon) ;; (declare (uses cookie))
+
+)

ADDED   stml2/sessions.sql
Index: stml2/sessions.sql
==================================================================
--- /dev/null
+++ stml2/sessions.sql
@@ -0,0 +1,5 @@
+CREATE TABLE session_vars (id integer primary key,  session_id integer, page text, key text, value text);
+
+CREATE TABLE sessions ( id integer primary key, session_key text); 
+	
+

ADDED   stml2/setup.scm
Index: stml2/setup.scm
==================================================================
--- /dev/null
+++ stml2/setup.scm
@@ -0,0 +1,21 @@
+;; Copyright 2007-2011, 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.
+
+(module setup
+    *
+(import chicken scheme data-structures extras srfi-13 ports posix)
+
+(uses session misc-stml)
+;; (declare (unit setup))se
+;; (declare (uses session))
+(require-extension srfi-69)
+(require-extension regex)
+
+
+)

ADDED   stml2/spiffyserver.scm
Index: stml2/spiffyserver.scm
==================================================================
--- /dev/null
+++ stml2/spiffyserver.scm
@@ -0,0 +1,13 @@
+;; This doesn't work yet
+;;
+(use spiffy cgi-handler)
+
+(spiffy-debug-mode #t)
+
+(spiffy-file-ext-handlers 
+ `(("drcdb" . ,(cgi-handler* "/path/to/drcdb"))))
+
+(spiffy-root-path "/path/to/web")
+
+(start-server location: (get-host-name)
+                init: noop)

ADDED   stml2/sqlite3.scm
Index: stml2/sqlite3.scm
==================================================================
--- /dev/null
+++ stml2/sqlite3.scm
@@ -0,0 +1,54 @@
+;; Copyright 2007-2011, 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.
+;;
+
+;; I used this to get a simple interactive sqlite editor on the nokia n800
+;; since I couldn't get sqlite3 to install (for reasons I can't remember).
+
+(use sqlite3)
+
+(define args (argv))
+(define num-args (length args))
+
+(define dbname #f)
+(define cmd    #f)
+
+(if (> num-args 1)
+  (set! dbname (cadr args))
+  (exit 0))
+
+(if (> num-args 2)
+  (set! cmd (caddr args)))
+
+(define db (sqlite3:open dbname))
+
+(define (interactive db)
+  (let ((prompt " > "))
+    (display prompt)
+  (let loop ((cmd (read-line)))
+    (cond 
+      ((> (string-length cmd) 0)
+       (process-cmd db cmd)
+       (display prompt)
+       (loop (read-line)))
+      (else
+	(loop (read-line)))))))
+ 
+(define (process-cmd db cmd)
+  (sqlite3:for-each-row
+    (lambda (a . b)
+      (print a " " (string-intersperse b " ")))
+    db cmd))
+
+(if cmd
+  (process-cmd db cmd)
+  (interactive db))
+
+(sqlite3:finalize! db)    
+

ADDED   stml2/stml.config.template
Index: stml2/stml.config.template
==================================================================
--- /dev/null
+++ stml2/stml.config.template
@@ -0,0 +1,8 @@
+'(sroot   "/path/to/{pages,models}/dir"
+  logfile "/tmp/stmlrun/logs.log"
+  dbtype  sqlite3
+  dbinit   ((dbname   . "test-stml.db")
+            (user     . "nobody")
+            (password . "Dapassword")
+            (host     . "localhost"))
+  domain  "192.168.1.150")

ADDED   stml2/stml2.meta
Index: stml2/stml2.meta
==================================================================
--- /dev/null
+++ stml2/stml2.meta
@@ -0,0 +1,20 @@
+(
+; Your egg's license:
+(license "LGPL")
+
+; Pick one from the list of categories (see below) for your egg and enter it
+; here.
+(category misc)
+
+; A list of eggs mpeg3 depends on.  If none, you can omit this declaration
+; altogether. If you are making an egg for chicken 3 and you need to use
+; procedures from the `files' unit, be sure to include the `files' egg in the
+; `needs' section (chicken versions < 3.4.0 don't provide the `files' unit).
+; `depends' is an alias to `needs'.
+(needs srfi-69)
+
+; A list of eggs required for TESTING ONLY.  See the `Tests' section.
+(test-depends test)
+
+(author "Matt Welland")
+(synopsis "Primitive argument processor."))

ADDED   stml2/stml2.scm
Index: stml2/stml2.scm
==================================================================
--- /dev/null
+++ stml2/stml2.scm
@@ -0,0 +1,2688 @@
+;; Copyright 2007-2011, 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.
+
+;; stml is a list of html strings
+
+;; (declare (unit stml))
+
+(module stml2
+    *
+
+(import chicken scheme data-structures extras srfi-13 ports posix srfi-69 files srfi-1) 
+
+(import cookie)
+(use (prefix dbi dbi:) (prefix crypt c:) typed-records)
+
+;; (declare (uses misc-stml))
+(use regex)
+
+;; The (usually global) sdat contains everything about the session
+;;
+(defstruct sdat
+  ;; database
+  (dbtype 'pg)
+  (dbinit #f)
+  (conn   #f)
+  ;; page info
+  (page "index")
+  (page-type 'html)
+  (toppage "index")
+  (curr-page    "index")
+  (content-type "Content-type: text/html; charset=iso-8859-1\n\n")
+  ;; forms and variables
+  (formdat      #f)
+  (params '())
+  (path-params '())
+  (session-key #f)
+  (pagedat     '())
+  (alt-page-dat #f)
+  (session-cookie #f)
+  (pagevars        (make-hash-table))
+  (pagevars-before (make-hash-table))
+  (sessionvars     (make-hash-table))
+  (sessionvars-before (make-hash-table))
+  (globalvars      (make-hash-table))
+  (globalvars-before (make-hash-table))
+  ;; ports and log file
+  (curr-err       #f)
+  (log-port       (current-error-port))
+  (logfile        "/tmp/stml.log")
+  (seen-pages     '())
+  (page-dir-style  'flat)
+  (debug-mode      #f)
+  (session-id      #f)
+  (request-method  #f)
+  (domain          "localhost")
+  (twikidir        #f)
+  (script          #f)
+  (force-ssl       #f)
+  (shared-hash     (make-hash-table))
+  ;; paths
+  (sroot         "./")
+  (models        #f)
+  (views         #f)
+)
+
+(define (sdat-set-if session configdat var settor)
+  (let ((val (s:find-param var configdat)))
+    (if val (settor session val))))
+
+(define (session:initialize session #!optional (configf #f))
+  ;; (let* ((rawconfigdat (session:read-config session configf))
+  ;;	 (configdat (if rawconfigdat (eval rawconfigdat) '())))
+    ;; (sdat-set-if session configdat 'sroot     sdat-root-set!)
+    ;; (sdat-set-if session configdat 'logfile   sdat-logfile-set!)
+    ;; (sdat-set-if session configdat 'dbtype    sdat-dbtype-set!)
+    ;; (sdat-set-if session configdat 'dbinit    sdat-dbinit-set!)
+    ;; (sdat-set-if session configdat 'domain    sdat-domain-set!)
+    ;; (sdat-set-if session configdat 'twikidir  sdat-twikidir-set!)
+    ;; (sdat-set-if session configdat 'page-dir-style sdat-page-set!)
+    ;; (sdat-set-if session configdat 'sroot sdat-root-set!)
+    ;; (sdat-set-if session configdat 'sroot sdat-root-set!)
+    ;; (sdat-set-if session configdat 'sroot sdat-root-set!)
+    ;; following are set always from config
+    ;; (sdat-page-dir-style-set! session (s:find-param 'page-dir-style configdat))
+  (let* ((rawconfigdat (session:read-config session configf))
+	 (configdat (if rawconfigdat (eval rawconfigdat) '()))
+	 (sroot     (s:find-param 'sroot    configdat))
+	 (models    (s:find-param 'models   configdat))
+	 (views     (s:find-param 'views    configdat))
+	 (logfile   (s:find-param 'logfile  configdat))
+	 (dbtype    (s:find-param 'dbtype   configdat))
+	 (dbinit    (s:find-param 'dbinit   configdat))
+	 (domain    (s:find-param 'domain   configdat))
+	 (twikidir  (s:find-param 'twikidir configdat))
+	 (page-dir  (s:find-param 'page-dir-style configdat))
+	 (debugmode (or (s:find-param 'debug-mode configdat)(s:find-param 'debugmode configdat)))
+         (script    (s:find-param 'script    configdat))
+	 (force-ssl (s:find-param 'force-ssl configdat)))
+    (if sroot    (sdat-sroot-set!      session sroot))
+    (if models   (sdat-models-set!     session models))
+    (if views    (sdat-views-set!      session views))
+    (if logfile  (sdat-logfile-set!    session logfile))
+    (if dbtype   (sdat-dbtype-set!     session dbtype))
+    (if dbinit   (sdat-dbinit-set!     session dbinit))
+    (if domain   (sdat-domain-set!     session domain))
+    (if twikidir (sdat-twikidir-set!   session twikidir))
+    (if debugmode (sdat-debug-mode-set! session debugmode))
+    (if script    (sdat-script-set!    session script))
+    (if force-ssl (sdat-force-ssl-set! session force-ssl))
+    (sdat-page-dir-style-set! session page-dir)
+    ;; (print "configdat: ")(pp configdat)
+    (if debugmode
+	(session:log session "sroot: " sroot " logfile: " logfile " dbtype: " dbtype 
+		     " dbinit: " dbinit " domain: " domain " page-dir-style: " page-dir))
+    ))
+
+;; extract various tokens from the parameter list
+;;   'key val => put in the params list
+;;   strings  => maintain order and add to the datalist <<== IMPORTANT
+(define (s:extract inlst)
+  (if (null? inlst) inlst
+      (let loop ((data '())
+                 (params '())
+                 (head (car inlst))
+                 (tail (cdr inlst)))
+        ;; (print "head=" head " tail=" tail)
+        (cond 
+         ((null? tail)
+          (if (symbol? head) ;; the last item is a param - borked
+              (s:log "ERROR: param with no value"))
+          (list (append data (list (s:any->string head))) params))
+         ((or (string? head)(list? head)(number? head))
+          (loop (append data (list  (s:any->string head))) params (car tail)   (cdr tail)))
+         ((symbol? head)
+          (let ((new-params (cons (list head (car tail)) params))
+                (new-tail  (cdr tail)))
+            (if (null? new-tail) ;; we are done, no more params etc.
+                (list data new-params)
+                (loop data new-params (car new-tail)(cdr new-tail)))))
+         (else
+          (s:log "WARNING: Malformed input, you have broken stml, remember that all stml calls should return a result (null list or empty string is ok):\n  head=" head 
+	          "\n  tail=" tail 
+                  "\n  inlst=" inlst 
+                  "\n  params=" params)
+	  (if (null? tail)
+	      (list data params)
+	      (loop data params (car tail)(cdr tail))))))))
+
+;; most tags can be handled by this routine
+(define (s:common-tag tagname args)
+  (let* ((inputs (s:extract args))
+         (data   (car inputs))
+         (params (s:process-params (cadr inputs))))
+    (list (conc "<" tagname params ">")
+          data
+          (conc "</" tagname ">"))))
+
+;; Suggestion: order these alphabetically
+(define (s:a      . args) (s:common-tag "A"      args))
+(define (s:b      . args) (s:common-tag "B"      args))
+(define (s:u      . args) (s:common-tag "U"      args))
+(define (s:big    . args) (s:common-tag "BIG"    args))
+(define (s:body   . args) (s:common-tag "BODY"   args))
+(define (s:button . args) (s:common-tag "BUTTON" args))
+(define (s:center . args) (s:common-tag "CENTER" args))
+(define (s:code   . args) (s:common-tag "CODE"   args))
+(define (s:div    . args) (s:common-tag "DIV"    args))
+(define (s:h1     . args) (s:common-tag "H1"     args))
+(define (s:h2     . args) (s:common-tag "H2"     args))
+(define (s:h3     . args) (s:common-tag "H3"     args))
+(define (s:h4     . args) (s:common-tag "H4"     args))
+(define (s:h5     . args) (s:common-tag "H5"     args))
+(define (s:head   . args) (s:common-tag "HEAD"   args))
+(define (s:html   . args) (s:common-tag "HTML"   args))
+(define (s:i      . args) (s:common-tag "I"      args))
+(define (s:img    . args) (s:common-tag "IMG"    args))
+(define (s:input  . args) (s:common-tag "INPUT"  args))
+(define (s:output . args) (s:common-tag "OUTPUT" args))
+(define (s:link   . args) (s:common-tag "LINK"   args))
+(define (s:p      . args) (s:common-tag "P"      args))
+(define (s:strong . args) (s:common-tag "STRONG" args))
+(define (s:table  . args) (s:common-tag "TABLE"  args))
+(define (s:tbody  . args) (s:common-tag "TBODY"  args))
+(define (s:thead  . args) (s:common-tag "THEAD"  args))
+(define (s:th     . args) (s:common-tag "TH"     args))
+(define (s:td     . args) (s:common-tag "TD"     args))
+(define (s:title  . args) (s:common-tag "TITLE"  args))
+(define (s:tr     . args) (s:common-tag "TR"     args))
+(define (s:small  . args) (s:common-tag "SMALL"  args))
+(define (s:quote  . args) (s:common-tag "QUOTE"  args))
+(define (s:hr     . args) (s:common-tag "HR"     args))
+(define (s:li     . args) (s:common-tag "LI"     args))
+(define (s:ul     . args) (s:common-tag "UL"     args))
+(define (s:ol     . args) (s:common-tag "OL"     args))
+(define (s:dl     . args) (s:common-tag "DL"     args))
+(define (s:dt     . args) (s:common-tag "DT"     args))
+(define (s:dd     . args) (s:common-tag "DD"     args))
+(define (s:pre    . args) (s:common-tag "PRE"    args))
+(define (s:span   . args) (s:common-tag "SPAN"   args))
+(define (s:label  . args) (s:common-tag "LABEL"  args))
+(define (s:script . args) (s:common-tag "SCRIPT" args))
+
+(define (s:dblquote  . args)
+  (let* ((inputs (s:extract args))
+         (data   (caar inputs))
+         (params (s:process-params (cadr inputs))))
+    (conc "&quot;" data "&quot;")))
+
+(define (s:br     . args) "<BR>") ;;  THIS MAY NOT WORK!!!! BR CAN (MISTAKENLY) GET PARAM TEXT
+;; (define (s:br     . args) (s:common-tag "BR"     args))
+(define (s:font   . args) (s:common-tag "FONT"   args))
+(define (s:err-font . args)
+  (s:b (s:font 'color "red" args)))
+
+(define (s:comment . args)
+  (let* ((inputs (s:extract args))
+         (data   (car inputs))
+         (params (s:process-params (cadr inputs))))
+    (list "<!--" data "-->")))
+
+(define (s:null   . args) ;; nop
+  (let* ((inputs (s:extract args))
+         (data   (car inputs))
+         (params (s:process-params (cadr inputs))))
+    (list data)))
+
+;; puts a nice box around a chunk of stuff
+(define (s:fieldset legend . args)
+  (list "<FIELDSET><LEGEND>" legend "</LEGEND>" args "</FIELDSET>"))
+
+;; given a string return the string if it is non-white space or &nbsp; otherwise
+(define (s:nbsp str)
+  (if (string-match "^\\s*$" str)
+      "&nbsp;"
+      str))
+
+;; USE 'page_override to override a linkto page from a button
+(define (s:form   . args)
+  ;; create a link for calling back into the current page and calling a specified 
+  ;; function
+  (let* ((action     (let ((v (s:find-param 'action args)))
+                       (if v v "default")))
+	 (id         (let ((i (s:find-param 'id args)))
+		       (if i i #f)))
+         (page       (let ((p (sdat-page s:session)))
+                       (if p p "home")))
+	 ;; (link       (session:link-to s:session page (if id
+         ;;                                                 (list 'action action 'id id)
+         ;;                                                 (list 'action action)))))
+	 (link       (if (string=? (substring action 0 5) "http:") ;; if first part of string is http:
+	        	 action
+	        	 (session:link-to s:session 
+	        			  page 
+	        			  (if id
+	        			      (list 'action action 'id id)
+	        			      (list 'action action))))))
+    ;; (script     (slot-ref s:session 'script))
+    ;; (action-str (string-append script "/" page "?action=" action)))
+    (s:common-tag "FORM" (append (s:remove-param-matching (s:remove-param-matching args 'action) 'id)
+                                 (list 'action link)))))
+
+;; look up the variable name (via the 'name tag) then inject the value from the session var
+;; replacing the 'value value if it is already there, adding it if it is not.
+(define (s:preserve tag args)
+  (let* ((var-name (s:find-param 'name args)) ;; name='varname'
+	 (value    (let ((v (s:get var-name)))
+		     (if v v #f)))
+	 (newargs  (append (s:remove-param-matching args 'value) (if value (list 'value value) '()))))
+    (s:common-tag tag newargs)))
+
+(define (s:input-preserve  . args)
+  (s:preserve "INPUT" args))
+
+;; text areas are done a little differently. The value is stored between the tags <textarea ...>the value goes here</textarea>
+(define (s:textarea-preserve . args)
+  (let* ((var-name (s:find-param 'name args))
+	 (value    (let ((v (s:get var-name)))
+		     (if v v #f))))
+    (s:common-tag "TEXTAREA" (if value (cons value args) args))))
+
+(define (s:option dat)
+  (let ((len      (length dat)))
+    (cond
+     ((eq? len 1)
+      (let ((item (car dat)))
+	(s:option (list item item item))))
+     ((eq? len 2)
+      (s:option (append dat (list (car dat)))))
+     (else
+      (let ((label    (car dat))
+	    (value    (cadr dat))
+	    (dispval  (caddr dat))
+	    (selected (if (> len 3)(cadddr dat) #f)))
+	(list (conc "<OPTION " 
+		    (if selected " selected " "")
+		    "label=\"" label
+		    "\" value=\"" value
+		    "\">" dispval "</OPTION>")))))))
+
+;; call only with (label (label value dispval [#t]) ...)
+;; NB// sadly this block is redundantly almost identical to the s:select
+;; fix that later ...
+(define (s:optgroup dat)
+  (let ((label (car dat))
+	(rem   (cdr dat)))
+    (if (null? rem)
+	(s:common-tag "OPTGROUP" `('label ,label))
+	(let loop ((hed (car rem))
+		   (tal (cdr rem))
+		   (res (list (conc "<OPTGROUP label=" label))))
+	  ;; (print "hed: " hed " tal: " tal " res: " res)
+	  (let ((new (append res (list (if (list? (cadr hed))
+					   (s:optgroup hed)
+					   (s:option hed))))))
+	    (if (null? tal)
+		(append new (list "</OPTGROUP>"))
+		(loop (car tal)(cdr tal) new)))))))
+    
+;; items is a hierarchial alist
+;; ( (label1 value1 dispval1 #t) ;; <== this one is selected
+;;   (label2 (label3 value2 dispval2)
+;;           (label4 value3 dispval3)))
+;;     
+;;  required arg is 'name
+(define (s:select items . args)
+  (if (null? items)
+      (s:common-tag "SELECT" args)
+      (let loop ((hed (car items))
+		 (tal (cdr items))
+		 (res '()))
+	;; (print "hed: " hed " tal: " tal " res: " res)
+	(let ((new (append res (list (if (and (> (length hed) 1)
+					      (list? (cadr hed)))
+					 (s:optgroup hed)
+					 (s:option hed))))))
+	  (if (null? tal)
+	      (s:common-tag "SELECT" (cons new args))
+	      (loop (car tal)(cdr tal) new))))))
+
+(define (s:color  . args)
+  "#00ff00")
+
+(define (s:print indent inlst)
+  (map (lambda (x)
+         (cond 
+          ((or (string? x)(symbol? x))
+           (print (conc (make-string (* indent 2) #\ ) (s:any->string x))))
+          ((list? x)
+           (s:print (+ indent 1) x))
+          (else
+           ;; (print "ERROR: Bad input 01") ;; why do anything with junk?
+           )))
+       inlst))
+
+;; Moved to misc-stml
+;;
+#;(define (s:cgi-out inlst)
+  (s:output (current-output-port) inlst))
+
+#;(define (s:output port inlst)
+  (map (lambda (x)
+	 (cond 
+	  ((string? x) (print x)) ;; (print x))
+	  ((symbol? x) (print x)) ;; (print x))
+	  ((list? x)   (s:output port x))
+	  (else ""
+	   ;; (print "ERROR: Bad input 02") ;; why do anything? don't output junk.
+	   )))
+       inlst))
+;  (if (> (length inlst) 2)
+;      (print)))
+
+#;(define (s:output-new port inlst)
+  (with-output-to-port port
+      (lambda ()
+	(map (lambda (x)
+	       (cond 
+		((string? x) (print x))
+		((symbol? x) (print x))
+		((list? x)   (s:output port x))
+		(else
+		 ;; (print "ERROR: Bad input 03")
+     )))
+	     inlst))))
+
+;;======================================================================
+;; Not sure where these should go
+;;======================================================================
+
+;; (include "requirements.scm"), dbi has autoload, should not need this any more.
+
+;;======================================================================
+;; setup - convience calls to functions wrapped with a global s:session
+;;======================================================================
+
+;; macros in sugar don't work, have to load in all files or use compiled mode?
+;;
+;; (include "sugar.scm")
+
+;; use this for getting data from page to page when scope and evals
+;; get in the way
+;; save data for use in the page generation here. Does NOT persist across page reads.
+
+(define *page-data* (make-hash-table))
+
+(define (s:lset! var val)
+  (hash-table-set! *page-data* var val))
+(define (s:lget var . default)
+  (hash-table-ref/default *page-data* var (if (null? default)
+					      #f
+					      (car default))))
+
+;; to obscure and indirect database ids use one time keys
+;;
+;;  (s:get-key 'n 1)     => "n99e1882" n=number 99e is the week number since 1970, remainder is random
+;;  (s:key->val "n1882") => 1
+;;
+;;  first letter is a type: n=number, s=string, b=boolean
+(define (s:get-key key-type val)
+  (let ((mkrandstr (lambda (innum)(number->string (random innum) 16)))
+	(week      (number->string (quotient (current-seconds) (* 7 24 60 60)) 16)))
+    (let loop ((siz 1000)
+	       (key (conc key-type week (mkrandstr 100)))
+	       (num 0))
+      (if (s:session-var-get key) ;; have a collision
+	  (loop (cond                 ;; in the unlikey event we have trouble getting a new var, keep increasing the size of the number
+		 ((< num 50)  100)
+		 ((< num 100) 1000)
+		 ((< num 200) 10000)
+		 ((< num 300) 100000)
+		 ((< num 400) 1000000) ;; can't imagine needing to get here. remember that this is for a single user
+		 (else 100000000))
+		(conc key-type (mkrandstr siz))
+		(+ num 1))
+	  (begin
+	    (s:session-var-set! key val)
+	    key)))))
+
+;; given a key Xnnnn, look up the stored value and convert it appropriately, then
+;; destroy the stored session var
+;;
+(define (s:key->val key)
+  (let ((val (s:session-var-get key))
+	(typ (string->symbol (substring key 0 1))))
+    (if val
+	(begin
+	  (s:session-var-del! key)
+	  ;; we take this opportunity to clean up old keyed session vars
+	  ;; if more than 100 vars, remove all that are over 1-2 weeks old
+					;(s:cleanup-session-vars)
+	  (case typ
+	    ((n)(string->number val))
+	    ((s) val)
+	    (else val)))
+	val)))
+  
+;; clean up session vars
+;;
+(define (s:cleanup-session-vars)
+  (let* ((session-vars (hash-table-keys (s:session-get-sessionvars)))
+	 (week-num     (quotient (current-seconds) (* 7 24 60 60)))
+	 (week         (number->string week-num  16)))
+    (if (> (length session-vars) 100)
+	(for-each
+	 (lambda (var)
+	   (if (> (string-length var) 5) ;; can't have keyed values with keys less than 5 characters long
+	       (let ((var-week (string->number (substring var 1 4) 16)))
+		 (if (and var-week
+			  (>= (- week-num var-week) 2))
+		     (s:session-var-del! var)))))
+	 session-vars))))
+
+;; inputs
+;;
+;; param: (dtype [tag1 tag2 ...])
+;; dtype:
+;;    'raw     : do no conversion
+;;    'number  : convert to number, return #f if fails
+;;    'escaped : use html-escape to protect the input
+;;
+(define (s:get-input key . params)
+  (session:get-input s:session key params))
+
+(define (s:get-input-keys)
+  (session:get-input-keys s:session))
+
+;; get-input else, get-param else #f
+;;
+(define (s:get-inp key . params)
+  (or (apply s:get-input key params)
+      (apply s:get-param key params)))
+
+(define (s:load-model model)
+  (session:load-model s:session model))
+
+(define (s:model-path)
+  (session:model-path s:session))
+
+;; share data between pages calls. NOTE: This is not persistent
+;; between cgi calls. Use sessionvars for that.
+;;
+(define (s:shared-hash)
+  (sdat-shared-hash s:session))
+
+(define (s:shared-set! key val)
+  (hash-table-set! (sdat-shared-hash s:session) key val))
+
+;; What to return when no value for key?
+;;
+(define (s:shared-get key)
+  (hash-table-ref/default (sdat-shared-hash s:session) key #f))
+
+;; http://foo.bar.com/pagename/p1/p2 => '("p1" "p2")
+;;  #### DEPRECATED ####
+(define (s:get-page-params)
+  (sdat-path-params s:session))
+
+(define (s:get-path-params)
+  (sdat-path-params s:session))
+	
+
+(define (s:db)
+  (sdat-conn s:session))
+
+;;======================================================================
+;; cgi and session stuff
+;;======================================================================
+
+;;(declare (uses cookie))
+;;(declare (uses html-filter))
+;;(declare (uses misc-stml))
+;;(declare (uses formdat))
+;;(declare (uses stml))
+;;(declare (uses session))
+;;(declare (uses setup)) ;; s:session gets created here
+;;(declare (uses sqltbl))
+;;(declare (uses keystore))
+
+;; given a list of symbols give the count of the matching symbol
+;; l => '(a b c)  (dumobj:indx a 'b) => 1
+(define (s:get-fieldnum lst field-name)
+  (let loop ((head (car lst))
+             (tail (cdr lst))
+             (fnum 0))
+    (if (eq? head field-name) fnum
+        (if (null? tail) #f
+            (loop (car tail)(cdr tail)(+ fnum 1))))))
+
+(define (s:fields->string lst)
+  (string-join (map symbol->string lst) ","))
+
+(define (s:vector-get-field vec field field-list)
+  (vector-ref vec (s:get-fieldnum field-list field)))
+
+;;======================================================================
+;;
+;;======================================================================
+
+;; moved to misc-stml
+;;
+#;(define (err:log . msg)
+  (with-output-to-port (current-error-port) ;; (slot-ref self 'logpt)
+    (lambda () 
+      (apply print msg))))
+
+(define (s:tidy-url url)
+  (if url
+      (let ((r1 (regexp "^http:\\/\\/"))
+            (r2 (regexp "^[ \\t]*$"))) ;; blank
+        (if (string-match r1 url) url
+            (if (string-match r2 url) #f ;; convert a blank to #f
+                (conc "http://" url))))
+      url))
+
+(define (s:lazy->num num)
+  (if (number? num) num
+      (if (string->number num) (string->number num)
+	    (if num 1 0)))) ;; wierd eh! yep, #f=>0 #t=>1 
+
+;;======================================================================
+;; D B
+;;======================================================================
+
+;; convert values to appropriate strings
+;;
+#;(define (s:sqlparam-val->string val)
+  (cond
+   ((list?   val)(string-join (map symbol->string val) ",")) ;; (a b c) => a,b,c
+   ((string? val)(conc "'" (dbi:escape-string val) "'"))
+   ((number? val)(number->string val))
+   ((symbol? val)(dbi:escape-string (symbol->string val)))
+   ((boolean? val)
+    (if val "TRUE" "FALSE"))  ;; should this be "TRUE" or 1?
+                              ;; should this be "FALSE" or 0 or NULL?
+   (else
+    (err:log "sqlparam: unknown type for value: " val)
+    "")))
+
+;; (sqlparam "INSERT INTO foo(name,age) VALUES(?,?);" "bob" 20)
+;; NB// 1. values only!! 
+;;      2. terminating semicolon required (used as part of logic)
+;;
+;; a=? 1 (number) => a=1
+;; a=? 1 (string) => a='1'
+;; a=? #f         => a=FALSE 
+;; a=? a (symbol) => a=a 
+;;
+#;(define (s:sqlparam query . args)
+  (let* ((query-parts (string-split query "?"))
+         (num-parts    (length query-parts))
+         (num-args    (length args)))
+    (if (not (= (+ num-args 1) num-parts))
+        (err:log "ERROR, sqlparam: wrong number of arguments or missing semicolon, " num-args " for query " query)
+        (if (= num-args 0) query
+            (let loop ((section (car query-parts))
+                       (tail    (cdr query-parts))
+                       (result  "")
+                       (arg     (car args))
+                       (argtail (cdr args)))
+              (let* ((valstr    (s:sqlparam-val->string arg))
+                     (newresult (conc result section valstr)))
+                (if (null? argtail) ;; we are done
+                    (conc newresult (car tail))
+                    (loop
+                     (car tail)
+                     (cdr tail)
+                     newresult
+                     (car argtail)
+                     (cdr argtail)))))))))
+
+;;======================================================================
+;; M I S C   S T R I N G   S T U F F
+;;======================================================================
+
+(define (s:string-downcase str)
+  (if (string? str)
+      (string-translate str "ABCDEFGHIJKLMNOPQRSTUVWXYZ" "abcdefghijklmnopqrstuvwxyz")
+      str)) 
+
+;; (define session:valid-chars "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789")
+#;(define session:valid-chars "abcdefghijklmnopqrstuvwxyz0123456789") ;; cookies are case insensitive.
+#;(define session:num-valid-chars (string-length session:valid-chars))
+
+#;(define (session:get-nth-char nth)
+  (substring session:valid-chars nth  (+ nth 1)))
+
+#;(define (session:get-rand-char)
+  (session:get-nth-char (random session:num-valid-chars)))
+
+#;(define (session:make-rand-string len)
+  (let loop ((res "")
+             (n   1))
+    (if (> n len) res
+        (loop (string-append res (session:get-rand-char))
+              (+ n 1)))))
+
+;; maybe replace above make-rand-string with this someday?
+;;
+#;(define (session:generic-make-rand-string len seed-string)
+  (let ((num-chars (string-length seed-string)))
+    (let loop ((res "")
+	       (n   1))
+      (let ((char-num (random num-chars)))
+	(if (> n len) res
+	    (loop (string-append res (substring seed-string char-num (+ char-num 1)))
+		  (+ n 1)))))))
+
+;; Rely on crypt egg's default settings being secure enough, accept
+;; backwards-compatible OpenSSL crypt passwords too.
+;;
+(define (s:crypt-passwd pw s)
+  (c:crypt pw (or s (c:crypt-gensalt))))
+
+(define (s:password-match? password crypted)
+  (let* ((salt (substring crypted 0 2))
+         (pcrypted (s:crypt-passwd password salt)))
+    ;; (s:log "INFO: pcrypted=" pcrypted " crypted=" crypted)
+    (and (string? password)
+         (string? pcrypted)
+         (string=? pcrypted crypted))))
+
+;; (read-line (open-input-pipe "echo foo | mkpasswd -S ab -s"))
+
+;; BUG: The regex implements a rule, but what rule? AH! usaztempe, get rid of this? No, this also looks for &key=value ...
+(define (s:validate-uri)
+  (let ((uri (get-environment-variable "REQUEST_URI"))
+	(qrs (get-environment-variable "QUERY_STRING")))
+    (if (not uri)
+	(set! uri qrs))
+    (if uri
+	(string-match 
+	 (regexp "^(/[a-z\\-\\._:0-9]*)*(|\\?([A-Za-z0-9_\\-\\+]+=[A-Za-z0-9_\\-\\.\\+]*&{0,1})*)$") uri)
+	(begin
+	  "REQUEST URI NOT AVAILABLE!"
+	  (let ((p (open-input-pipe "env")))
+	    (let loop ((l (read-line p))
+		       (res '()))
+	      (if (eof-object? l)
+		  res
+		  (loop (read-line p)(cons (list l "<BR>") res)))))
+	  #t))))
+
+;; moved to misc-stml
+;;
+;; anything except a list is converted to a string!!!
+#;(define (s:any->string val)
+  (cond
+   ((string? val) val)
+   ((number? val) (number->string val))
+   ((symbol? val) (symbol->string val))
+   ((eq? val #f) "")
+   ((eq? val #t) "TRUE")
+   ((list? val) val)
+   (else 
+    (let ((ostr (open-output-string)))
+      (with-output-to-port ostr
+	(lambda ()
+	  (display val)))
+      (get-output-string ostr)))))
+
+#;(define (s:any->number val)
+  (cond
+   ((number? val)  val)
+   ((string? val)  (string->number val))
+   ((symbol? val)  (string->number (symbol->string val)))
+   (else     #f)))
+
+;; NB// this is *illegal* pgint
+(define (s:illegal-pgint val)
+  (cond
+   ((> val 2147483647) 1)
+   ((< val -2147483648) -1)
+   (else #f)))
+
+(define (s:any->pgint val)
+  (let ((n (s:any->number val)))
+    (if n
+	(if (s:illegal-pgint n)
+	    #f
+	    n)
+	n)))
+
+;; string is a string and non-zero length
+(define (misc:non-zero-string str)
+  (if (and (string? str)
+           (> (string-length str) 0))
+      str
+      #f))
+
+;;======================================================================
+;; html-filter
+;;======================================================================
+(define (s:split-string strng delim)
+  (if (eq? (string-length strng) 0) (list strng)
+      (let loop ((head (make-string 1 (car (string->list strng))))
+		 (tail (cdr (string->list strng)))
+		 (dest '())
+		 (temp ""))
+	(cond ((equal? head delim)
+	       (set! dest (append dest (list temp)))
+	       (set! temp ""))
+	      ((null? head) 
+	       (set! dest (append dest (list temp))))
+	      (else (set! temp (string-append temp head)))) ;; end if
+	(cond ((null? tail)
+	       (set! dest (append dest (list temp))) dest)
+	      (else (loop (make-string 1 (car tail)) (cdr tail) dest temp))))))
+
+;; allowed-tags is a list of tags as symbols:
+;;   '(a b center p a)
+;; parsing is simplistic and the response conservative
+;; if a < is found without the tag and closing > then
+;; the < or > is replaced with &lt; or &gt; without 
+;; even trying hard to figure out if there is a legit tag 
+;; buried in the text somewhere.
+;; a list of strings is returned.
+;;
+;; NOTES
+;; 1. case is important in the allowed-tags list!
+;; 2. only "solid" tags are supported i.e. <a href="foo"> will not work?
+;;
+
+;; (s:cgi-out (eval (s:output (s:html-filter "hello<b>goodbye</b><b> eh" '(a b i))))
+
+;; strategy
+;; 1. convert \n to <linefeed>
+;; 2. Split on "<"
+;; 3. Split on ">"
+;; 4. Fix
+(define (s:html-filter input-text allowed-tags)
+  (let* ((toks   (s:str->toks input-text))
+	 (tmp    (s:toks->stml '(s:null) #f toks allowed-tags))
+	 (res    (car tmp))
+	 (nxttag (cadr tmp))
+	 (rem    (caddr tmp)))
+    res))
+
+(define (s:html-filter->string input-text allowed-tags)
+  (let ((ostr (open-output-string)))
+    ;;; (s:output-new ostr (s:html-filter input-text allowed-tags))
+    (s:output-new ostr (car (eval (s:html-filter input-text allowed-tags))))
+    (string-chomp (get-output-string ostr)))) ;; don't need the linefeed, could stop adding it ...
+	
+;;     (if (null? rem)
+;; 	res '())
+;; 	(s:toks->stml (if (list? res) res '()) #f rem allowed-tags))))
+
+(define (s:str->toks str)
+  (apply append (map (lambda (tok)
+		       (intersperse (s:split-string tok ">") ">")) 
+		     (intersperse (s:split-string str "<") "<"))))
+
+(define (s:tag->stml tag)
+  (string->symbol (string-append "s:" (symbol->string tag))))
+
+
+(define (s:toks->stml res tag rem allowed)
+  ;; (print "tag: " tag " rem: " rem)
+  (if (null? rem)
+      (list (append res (if tag
+			    (list (s:tag->stml tag))
+				'())) #f '() allowed) ;; the case of a lone tag 
+      ;; handle a starting tag
+      (let* ((tmp       (s:upto-tag rem allowed))
+	     (txt       (car tmp))      ;; this txt goes with tag!!!
+	     (nexttag   (cadr tmp))     ;; this is the NEXT DAMN tag!
+	     (begin-tag (caddr tmp))
+	     (newrem    (cadddr tmp)))
+	;; (print "txt:        " txt "\nnexttag:    " nexttag "\nbegin-tag:  " begin-tag "\nnewrem:     " newrem "\nres:        " res "\n")
+	(if begin-tag ;; nest the following stuff
+	    (let* ((childdat (s:toks->stml '() nexttag newrem allowed))
+		   (child    (car childdat))
+		   (newtag   (cadr childdat))
+		   (newrem2  (caddr childdat))
+		   (allowed  (cadddr childdat))) ;; ya, it shouldn't have changed
+	      (if tag 
+		  (s:toks->stml (append res (list (append (list (s:tag->stml tag)) child (list txt))))
+				newtag newrem2 allowed)
+		  (s:toks->stml (append res (list txt) child)
+				newtag newrem2 allowed)))
+	    ;; it must have been an end tag
+	    (list (append res (list 
+			       (if tag
+				   (list (s:tag->stml tag) txt)
+				   txt)))
+		  #f
+		  newrem
+		  allowed)))))
+
+
+;; "<" "b" ">"  => "<b>"
+;; "<"
+;; (define (s:rebuild-tags input-list)
+
+;; ("blah blah" "<" "b" ">" "more stuff" "<" "i" ">" ) 
+;;     => ("blah blah" b #t ( "more stuff" "<" "i" ">" ))
+;; ("blah blah" "<" "/b" ">" "more stuff" "<" "i" ">" ) 
+;;     => ("blah blah" b #f ( "more stuff" "<" "i" ">" ))
+(define (s:upto-tag inlst allowed-tags)
+  (if (null? inlst) inlst
+      (let loop ((tok  (car inlst))
+		 (tail (cdr inlst))
+		 (prel "")) ;; create a string or a list of string parts?
+	(if (string=? tok "<") ;; might have a tag
+	    (if (> (length tail) 1) ;; to be a tag, need tag and closing ">"
+		(let ((tag (car tail))
+		      (end (cadr tail))
+		      (rem (cddr tail))) 
+		  (if (string=? end ">") ;; yep, it is probably a tag
+		      (let* ((trim-tag (if  (string=? "/" (substring tag 0 1))
+					    (substring tag 1 (string-length tag)) #f))
+			     (tag-sym  (string->symbol (if trim-tag trim-tag tag))))
+			(if (member tag-sym allowed-tags)
+			    ;; have a valid tag, rebuild it and return the result
+			    (list prel tag-sym (if trim-tag #f #t) rem)
+			    ;; not a valid tag, convert "<" and ">" and add all to prel
+			    (let ((newprel (string-append prel "&lt;" tag "&gt;")))
+			      (if (null? rem)(list newprel #f #f '()) ;; return newprel - add #f #f ???
+				  (loop (car rem)(cdr rem) newprel)))))
+		      ;; so, it wasn't a tag
+		      (let ((newprel (string-append prel "&lt;" tag)))
+			(if (null? tail)
+			    (list newprel #f #f '())
+			    (loop (car rem)(cdr rem) newprel)))))
+		;; too short to be a tag
+		(list (apply string-append prel "&lt;" tail) #f #f '()))
+	    (if (null? tail) 
+		;; we're done
+		(list (string-append prel tok) #f #f '())
+		(loop (car tail)(cdr tail)(string-append prel tok)))))))
+
+
+(define (s:divy-up-cgi-str instr)
+  (map (lambda (x) (string-split x "=")) (string-split instr "&")))
+
+(define (s:decode-str instr)
+  (let* ((abc (string-substitute "\\+" " " instr #t))
+	 (toks (s:split-string abc "%")))
+    (if (< (length toks) 2) abc
+	(let loop ((head (cadr toks))
+		   (tail (cddr toks))
+		   (result (car toks)))
+	  (if (string=? head "")
+	      (if (null? tail)
+		  result
+		  (loop (car tail)(cdr tail) result))
+	      (let* ((key (substring head 0 2))
+		     (rem (substring head 2 (string-length head)))
+		     (num (string->number key 16))
+		     (ch  (if (and (number? num)
+                                   (exact? num))
+			      (integer->char num)
+			      #f)) ;; this is an error. I will probably regret this some day
+		     (chstr  (if ch (make-string 1 ch) ""))
+		     (newres (if ch
+				 (string-append result chstr rem)
+				 (string-append result head))))
+		;; (print "head: " head " num: " num " ch: |" ch "| chstr: " chstr)
+		(if (null? tail)
+		    newres
+		    (loop (car tail)(cdr tail) newres))))))))
+
+;; probably a bug:
+;;
+;; (s:process-cgi-input "=bar")
+;; => ((bar ""))
+;;
+(define (s:process-cgi-input instr)
+  (map (lambda (xy)
+         (list (string->symbol (s:decode-str (car xy)))
+               (if (eq? (length xy) 1) 
+                   ""
+                   (s:decode-str (cadr xy)))))
+         (s:divy-up-cgi-str instr)))
+
+;; for testing -- deletme
+;; (define blah "post_title=%2B%2B%2B%2B%2B%2B%2B%2B%2B%2B%2Bhello-------------+++++++++++%26%26%26%26%26%26%26%26%26%40%40%40%40%40%40%40%40%40&post_body=%2B%2B%2B%2B%2B%2B%2B%2B%2B%2B%2Bhello-------------+++++++++++%26%26%26%26%26%26%26%26%26%40%40%40%40%40%40%40%40%40%0D%0A%0D%0A%2B%2B%2B%2B%2B%2B%2B%2B%2B%2B%2Bhello-------------+++++++++++%26%26%26%26%26%26%26%26%26%40%40%40%40%40%40%40%40%40%0D%0A%0D%0A%0D%0A%2B%2B%2B%2B%2B%2B%2B%2B%2B%2B%2Bhello-------------+++++++++++%26%26%26%26%26%26%26%26%26%40%40%40%40%40%40%40%40%40&new_post=Submit")
+;; (define blah2 "post_title=5%25&post_body=and+10%25&new_post=Submit")
+
+;;======================================================================
+;; formdat
+;;======================================================================
+
+(define formdat:*debug* #f)
+
+;; Old data format was something like this. BUT! 
+;; Forms do not have names so the hierarcy is
+;; unnecessary (I think)
+;;
+;; hashtable
+;;   |-formname --> <formdat> 'form-name=formname
+;;   |                        'form-data=hashtable
+;;   |                                       | name => value
+;;
+;; New data format is only the <formdat> portion from above
+
+;; (define-class <formdat> ()
+;;    (form-data
+;;    ))
+(define (make-formdat:formdat)(vector (make-hash-table)))
+(define (formdat:formdat-get-data   vec)    (vector-ref  vec 0))
+(define (formdat:formdat-set-data!  vec val)(vector-set! vec 0 val))
+
+(define (formdat:initialize self)
+  (formdat:formdat-set-data! self (make-hash-table)))
+
+(define (formdat:get self key)
+  (hash-table-ref/default 
+   (formdat:formdat-get-data self)
+   (cond 
+    ((symbol? key) key)
+    ((string? key) (string->symbol key))
+    (else key))
+   #f))
+
+;; change to convert data to list and append val if already exists
+;; or is a list
+(define (formdat:set! self key val)
+  (let ((prev-val (formdat:get self key))
+        (ht       (formdat:formdat-get-data self)))
+    (if prev-val
+        (if (list? prev-val)
+            (hash-table-set! ht key (cons val prev-val))
+            (hash-table-set! ht key (list val prev-val)))
+        (hash-table-set! ht key val))
+    self))
+
+(define (formdat:keys self)
+  (hash-table-keys (formdat:formdat-get-data self)))
+
+(define (formdat:printall self printproc)
+  (printproc "formdat:printall " (formdat:keys self))
+  (for-each (lambda (k)
+	      (printproc k " => " (formdat:get self k)))
+	    (formdat:keys self)))
+
+(define (formdat:all->strings self)
+  (let ((res '()))
+    (for-each (lambda (k)
+                 (set! res (cons (conc k "=>" (formdat:get self k)) res)))
+              (formdat:keys self))
+        res))
+
+;; call with *one* of the lists in the list of lists created by CGI:url-unquote
+(define (formdat:load self formlist)
+  (let ((ht             (formdat:formdat-get-data self)))
+    (if (null? formlist) self ;; no values provided, return self for no good reason
+        (let loop ((head (car formlist))
+                   (tail (cdr formlist)))
+          (let ((key (car head))
+                (val (cdr head)))
+            ;; (err:log "key=" key " val=" val)
+	    (if (> (length val) 1)
+		(formdat:set! self key val)
+		(formdat:set! self key (car val)))
+            (if (null? tail) self   ;; we are done
+                (loop (car tail)(cdr tail))))))))
+
+;; get the header from datstr
+(define (formdat:read-header datstr) ;; datstr is an input string port
+  (let loop ((hs (read-line datstr))
+	     (header '()))
+    (if (or (eof-object? hs)
+	    (string=? hs ""))
+	header
+	(loop (read-line datstr)(append header (list hs))))))
+
+;; get the data up to the next key. if there is no key then return #f
+;; return (dat remdat)
+(define (formdat:read-dat dat key)
+  (let ((index (substring-index key dat))) ;; (string-search-positions key dat)))
+    (if (or (not index)
+	    (null? index)) ;; the key was not found
+	#f
+	(let* ((datstr (open-input-string dat))
+	       ;; (result (read-string (caar index) datstr))
+	       (result (read-string index datstr))
+	       (remdat (read-string #f datstr)))
+	  (close-input-port datstr)
+	  (list result remdat)))))
+
+ ;; inp is port to read data from, maxsize is max data allowed to read (total)
+(define (formdat:dat->list inp maxsize #!key (debug-port #f))
+  ;; read 1Meg chunks from the input port. If a block is not complete
+  ;; tack on the next 1Meg chunk as needed. Set up so the header is always
+  ;; at the beginning of the chunk
+  ;;-----------------------------29932024411502323332136214973
+  ;;Content-Disposition: form-data; name="input-picture"; filename="breadfruit.jpg"
+  ;;Content-Type: image/jpeg
+  (let loop ((dat (read-string 1000000 inp))
+	     (res '())
+	     (siz 0))
+    (if debug-port (format debug-port "dat: ~A\n" dat))
+    (if debug-port (format debug-port "eof: ~A\n" (eof-object? (read inp))))
+    
+    (if (> siz maxsize)
+	(begin
+	  (print "DATA TOO BIG")
+	  res)
+	(let* ((datstr (open-input-string dat))
+	       (header (formdat:read-header datstr))
+	       (key    (if (not (null? header))(car header) #f))
+	       (remdat (read-string #f datstr))          ;; used in next line, discard if got data, else revert to
+	       (alldat (if key (formdat:read-dat remdat key) #f))    ;; try to extract the data
+	       (thsdat (if alldat (car alldat)  #f))     ;; the data
+	       (newdat (if alldat (cadr alldat) #f))     ;; left over data, must process ...
+	       (thsres (list header thsdat))             ;; speculatively construct results
+	       (newres (append res (list thsres))))      ;; speculatively construct results
+	  (close-input-port datstr)
+	  (cond
+	   ;; either no header or single input
+	   ((and (not alldat)
+		 (or (null? header)
+		     (not (string-match formdat:delim-patt-rex (car header)))))
+	    ;; (print "Got here")
+	    (cons (list header "") res)) ;; note use header as dat and use "" as header????
+	   ;; didn't find end key in this block
+	   ((not alldat)
+	    (let ((mordat (read-string 1000000 inp)))
+	      (if (string=? mordat "") ;; there is no more data, discard results and use remdat as data, this input is broken
+		  (cons (list header remdat) res)
+		  (loop (string-append dat mordat) res (+ siz 2000000))))) ;; add the extra 1000000
+	   (alldat ;; got data, don't attempt to check if there is more, just loop and rely on (not alldat) to get more data
+	    (loop newdat newres (+ siz 1000000))))))))
+
+(define formdat:bin-data-disp-rex (regexp "^Content-Disposition:\\s+form-data;"))
+(define formdat:bin-data-name-rex (regexp "\\Wname=\"([^\"]+)\""))
+(define formdat:bin-file-name-rex (regexp "\\Wfilename=\"([^\"]+)\""))
+(define formdat:bin-file-type-rex (regexp "Content-Type:\\s+([^\\s]+)"))
+(define formdat:delim-patt-rex    (regexp "^\\-+[0-9]+\\-*$"))
+
+;; returns a hash with entries for all forms - could well use a proplist?
+(define (formdat:load-all)
+  (let ((request-method (get-environment-variable "REQUEST_METHOD")))
+    (if (and request-method
+	     (string=? request-method "POST"))
+	(formdat:load-all-port (current-input-port))
+	(make-formdat:formdat))))
+
+;; (s:process-cgi-input (caaar dat))
+(define (formdat:load-all-port inp)
+  (let* ((formdat        (make-formdat:formdat))
+	 (debugp         #f))
+			 ;; (open-output-file (conc "/tmp/delme-" (current-user-id) ".log"))))
+    ;; (write-string (read-string #f inp) #f debugp)  ;; destroys all data!
+    (formdat:initialize formdat)
+    (let ((alldats (formdat:dat->list inp 10e6 debug-port: debugp)))
+      
+      (if debugp (format debugp "formdat : alldats: ~A\n" alldats))
+
+      (let ((firstitem   (car alldats))
+	    (multipass #f)) 
+	(if (and (not (null? firstitem))
+		 (not (null? (car firstitem))))
+	    (if (string-match formdat:delim-patt-rex (caar firstitem))
+		(set! multipass #t)))
+	(if multipass
+	    ;; handle multi-part form
+	    (for-each (lambda (datlst)
+			(let* ((header (formdat:extract-header-info (car datlst)))
+			       (name   (if (assoc 'name header)
+					   (string->symbol (cadr (assoc 'name header)))
+					   "")) ;; grumble
+			       (fnamel  (assoc 'filename header))
+			       (content (assoc 'content header))
+			       (dat    (cadr datlst)))
+			  ;; (print "header: " header " name: " name " fnamel: " fnamel " content: " content) ;;  " dat: " (dat)
+			  (formdat:set! formdat 
+					name
+					(if fnamel 
+					    (list (cadr fnamel)
+						  (if content
+						      (cadr content)
+						      "unknown")
+						  (string->blob dat))
+					    dat))))
+		      alldats)
+	    ;; handle single part form
+	    ;; 	(if (and (string? name)
+	    ;; 		     (string=? name "")) ;; this is the short form input I guess
+	    ;; 		(let* ((datstr (caar datlst))
+	    ;; 		       (munged (s:process-cgi-input datstr)))
+	    ;; 		  (print "datstr: " datstr " munged: " munged)
+	    (if (and (not (null? alldats))
+		     (not (null? (car alldats)))
+		     (not (null? (caar alldats))))
+		(formdat:load formdat  (s:process-cgi-input (caaar alldats))))) ;; munged))
+	;;		    (format debugp "formdat : name: ~A content: ~A\n" name content)
+	(if debugp (close-output-port debugp))
+	;; (sdat-formdat-set! s:session formdat)
+	formdat))))
+		
+#|
+(define inp (open-input-file "tests/example.post.in"))
+(define dat (read-string #f inp))
+(define datstr (open-input-string dat))
+
+;; or
+
+(define inp (open-input-file "tests/example.post.binary.in"))
+(define dat (read-string #f inp))
+(define datstr (open-input-string dat))
+
+(formdat:read-header datstr)
+
+(define dat (formdat:dat->list inp 10e6))
+(close-input-port inp)
+|#
+  
+(define (formdat:extract-header-info header)
+  (if (null? header)
+      '()
+      (let loop ((hed (car header))
+		 (tal (cdr header))
+		 (res '()))
+	(if (string-match formdat:bin-data-disp-rex hed) ;; 
+	    (let* ((data-namem (string-match formdat:bin-data-name-rex hed))
+		   (file-namem (string-match formdat:bin-file-name-rex hed))
+		   (data-name  (if data-namem (cadr data-namem) #f))
+		   (this       (if file-namem
+				   (list (list 'name data-name)(list 'filename (cadr file-namem)))
+				   (list (list 'name data-name)))))
+	      (if (null? tal)
+		  (append res this)
+		  (loop (car tal)(cdr tal)(append res this))))
+	    (let ((content (string-match formdat:bin-file-type-rex hed))) ;; this is the stanza for the content type
+	      (if content
+		  (let ((newres (cons (list 'content (cadr content)) res)))
+		    (if (null? tal)
+			newres
+			(loop (car tal)(cdr tal) newres)))
+		  (if (null? tal)
+		      res
+		      (loop (car tal)(cdr tal) res)
+		      )))))))
+
+;;	      (let loop ((l       (read-line)) ;; (if (eq? mode 'norm)(read-line)(read-char)))
+;;			 (endline #f)
+;;			 (num     0))
+;;		;; (format debugp "~A\n" l)
+;;              (if (or (not (eof-object? l))
+;;		      (not (and (eq? mode 'bin)
+;;				(string=? l "")))) ;; if in bin mode empty string is end of file
+;;		  (case mode
+;;		    ((start)
+;;		     (set! mode 'norm)
+;;		     (if (string-match delim-patt-rex l)
+;;			 (begin
+;;			   (set! delim-string l)
+;;			   (set! delim-len    (string-length l))
+;;			   (loop (read-line) #f 0))
+;;			 (loop l #f 0)))
+;;		    ((norm)
+;;		     ;; I don't like how this gets checked on every single input. Must be a better way. FIXME
+;;		     (if (and (string-match bin-data-disp-rex l)
+;;			      (string-match bin-data-name-rex l)
+;;			      (string-match bin-file-name-rex l))
+;;			 (begin
+;;			   (set! data-name (cadr (string-match bin-data-name-rex l)))
+;;			   (set! file-name (cadr (string-match bin-file-name-rex l)))
+;;			   (set! mode 'content)
+;;			   (loop (read-line) #f num)))
+;;		     (let* ((dat  (s:process-cgi-input l))) ;; (CGI:url-unquote l))
+;;		       (format debugp "PROCESS-CGI-INPUT: ~A\n" (intersperse dat ","))
+;;		       (formdat:load formdat dat)
+;;		       (loop (read-line) #f num)))
+;;		    ((content)
+;;		     (if (string-match bin-file-type-rex l)
+;;			 (begin 
+;;			   (set! mode 'bin)
+;;			   (set! data-type (cadr (string-match bin-file-type-rex l)))
+;;			   (loop (read-string 1) #f num))))
+;;		    ((bin)
+;;		     ;; delim-string: \n"---------------12345"
+;;		     ;;                  012345678901234567890
+;;		     ;; endline:        "---------------12"
+;;		     ;; l = "3"
+;;		     ;; delim-len = 20
+;;		     ;; (substring  "---------------12345" 17 18) => "3"
+;;		     ;;
+;;		     (cond
+;;		       ;; haven't found the start of an endline, is the next char a newline?
+;;		      ((and (not endline)
+;;			    (string=? l "\n")) ;; required first character 
+;;		       (let ((newendline (open-output-string)))
+;;			 ;; (write-line l newendline) ;; discard the newline. add it back if don't have a lock on delim-string
+;;			 (loop (read-string 1) newendline (+ num 1))))
+;;		      ((not endline)
+;;		       (write-string l #f bin-dat)
+;;		       (loop (read-string 1) #f (+ num 1)))
+;;		      ;; string so far matches delim-string
+;;		      (endline
+;;		       (let* ((endstr (get-output-string endline))
+;;			      (endlen (string-length endstr)))
+;;			 (if (> endlen 0)
+;;			     (format debugp " delim: ~A\nendstr: ~A\n" delim-string endstr))
+;;			 (if (and (> delim-len endlen)
+;;				  (string=? l (substring delim-string endlen (+ endlen 1))))
+;;			     ;; yes, this character matches the next in the delim-string
+;;			     (if (eq? delim-len endlen) ;; have a match! Ignore that a newline is required. Lazy bugger.
+;;				 (let* ((fn      (string->symbol data-name)))
+;;				   (formdat:set! formdat fn (list file-name data-type (string->blob (get-output-string bin-dat))))
+;;				   (set! mode 'norm)
+;;				   (loop (read-line) #f 0))
+;;				 (begin
+;;				   (write-string l #f endline)
+;;				   (loop (read-string 1) endline (+ num 1))))
+;;			     ;; no, this character does NOT match the next in line in delim-string
+;;			     (begin
+;;			       (write-string "\n" #f bin-dat) ;; don't forget that newline we dropped
+;;			       (write-string endstr #f bin-dat)
+;;			       (write-string l #f bin-dat)
+;;			       (loop (read-string 1) #f (+ num 1))))))))
+;;		    )))))
+
+;;    (formdat:printall formdat (lambda (x)(write-line x debugp)))
+
+#|
+(define inp (open-input-file "/tmp/stmlrun/delme-33.log.keep-for-ref"))
+(define dat (read-string #f inp))
+(close-input-port inp)
+|#
+
+;;======================================================================
+;; use a table in your db called metadat to store key value pairs
+;;======================================================================
+
+
+(define (keystore:get db key)
+  (dbi:get-one db "SELECT value FROM metadata WHERE key=?;" key))
+
+(define (keystore:set! db key value)
+  (let ((curr-val (keystore:get db key)))
+    (if curr-val
+	(dbi:exec db "UPDATE metadata SET value=? WHERE key=?;" value key)
+	(dbi:exec db "INSERT INTO metadata (key,value) VALUES (?,?);" key value))))
+
+(define (keystore:del! db key)
+  (dbi:exec db "DELETE FROM metadata WHERE key=?;" key))
+
+;;======================================================================
+;; stuff from misc-stml.scm
+;;======================================================================
+
+;; moved to stmlcommon
+;; (bunch of stuff)
+
+;; moved from stmlcommon
+;;
+;; anything except a list is converted to a string!!!
+(define (s:any->string val)
+  (cond
+   ((string? val) val)
+   ((number? val) (number->string val))
+   ((symbol? val) (symbol->string val))
+   ((eq? val #f) "")
+   ((eq? val #t) "TRUE")
+   ((list? val) val)
+   (else 
+    (let ((ostr (open-output-string)))
+      (with-output-to-port ostr
+	(lambda ()
+	  (display val)))
+      (get-output-string ostr)))))
+
+(define (s:any->number val)
+  (cond
+   ((number? val)  val)
+   ((string? val)  (string->number val))
+   ((symbol? val)  (string->number (symbol->string val)))
+   (else     #f)))
+
+;; Moved from stmlcommon
+;;
+(define (s:cgi-out inlst)
+  (s:output-new (current-output-port) inlst))
+
+#;(define (s:output port inlst)
+  (map (lambda (x)
+	 (cond 
+	  ((string? x) (print x)) ;; (print x))
+	  ((symbol? x) (print x)) ;; (print x))
+	  ((list? x)   (s:output port x))
+	  (else ""
+	   ;; (print "ERROR: Bad input 02") ;; why do anything? don't output junk.
+	   )))
+       inlst))
+;  (if (> (length inlst) 2)
+;      (print)))
+
+(define (s:output-new port inlst)
+  (with-output-to-port port
+      (lambda ()
+	(map (lambda (x)
+	       (cond 
+		((string? x) (print x))
+		((symbol? x) (print x))
+		((list? x)   (s:output-new port x))
+		(else
+		 ;; (print "ERROR: Bad input 03")
+     )))
+	     inlst))))
+           
+(define (err:log . msg)
+  (with-output-to-port (current-error-port) ;; (slot-ref self 'logpt)
+    (lambda () 
+      (apply print msg))))
+
+;;======================================================================
+;; D B
+;;======================================================================
+
+;; convert values to appropriate strings
+;;
+(define (s:sqlparam-val->string val)
+  (cond
+   ((list?   val)(string-join (map symbol->string val) ",")) ;; (a b c) => a,b,c
+   ((string? val)(conc "'" (dbi:escape-string val) "'"))
+   ((number? val)(number->string val))
+   ((symbol? val)(dbi:escape-string (symbol->string val)))
+   ((boolean? val)
+    (if val "TRUE" "FALSE"))  ;; should this be "TRUE" or 1?
+                              ;; should this be "FALSE" or 0 or NULL?
+   (else
+    (err:log "sqlparam: unknown type for value: " val)
+    "")))
+
+;; (sqlparam "INSERT INTO foo(name,age) VALUES(?,?);" "bob" 20)
+;; NB// 1. values only!! 
+;;      2. terminating semicolon required (used as part of logic)
+;;
+;; a=? 1 (number) => a=1
+;; a=? 1 (string) => a='1'
+;; a=? #f         => a=FALSE 
+;; a=? a (symbol) => a=a 
+;;
+(define (s:sqlparam query . args)
+  (let* ((query-parts (string-split query "?"))
+         (num-parts    (length query-parts))
+         (num-args    (length args)))
+    (if (not (= (+ num-args 1) num-parts))
+        (err:log "ERROR, sqlparam: wrong number of arguments or missing semicolon, " num-args " for query " query)
+        (if (= num-args 0) query
+            (let loop ((section (car query-parts))
+                       (tail    (cdr query-parts))
+                       (result  "")
+                       (arg     (car args))
+                       (argtail (cdr args)))
+              (let* ((valstr    (s:sqlparam-val->string arg))
+                     (newresult (conc result section valstr)))
+                (if (null? argtail) ;; we are done
+                    (conc newresult (car tail))
+                    (loop
+                     (car tail)
+                     (cdr tail)
+                     newresult
+                     (car argtail)
+                     (cdr argtail)))))))))
+
+;; (define session:valid-chars "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789")
+(define session:valid-chars "abcdefghijklmnopqrstuvwxyz0123456789") ;; cookies are case insensitive.
+(define session:num-valid-chars (string-length session:valid-chars))
+
+(define (session:get-nth-char nth)
+  (substring session:valid-chars nth  (+ nth 1)))
+
+(define (session:get-rand-char)
+  (session:get-nth-char (random session:num-valid-chars)))
+
+(define (session:make-rand-string len)
+  (let loop ((res "")
+             (n   1))
+    (if (> n len) res
+        (loop (string-append res (session:get-rand-char))
+              (+ n 1)))))
+
+;; maybe replace above make-rand-string with this someday?
+;;
+(define (session:generic-make-rand-string len seed-string)
+  (let ((num-chars (string-length seed-string)))
+    (let loop ((res "")
+	       (n   1))
+      (let ((char-num (random num-chars)))
+	(if (> n len) res
+	    (loop (string-append res (substring seed-string char-num (+ char-num 1)))
+		  (+ n 1)))))))
+
+
+;;======================================================================
+;; P A R A M S
+;;======================================================================
+
+;; input: 'a ('a "val a" 'b "val b") => "val a"
+(define (s:find-param key param-lst)
+  (let loop ((head (car param-lst))
+	     (tail (cdr param-lst)))
+    (if (eq? head key)
+	(car tail)
+	(if (< (length tail) 2) #f
+	    (loop (cadr tail)(cddr tail))))))
+
+(define (s:param->string param)
+  (conc (symbol->string (car param)) "=" "\"" (cadr param) "\""))
+
+;; remove 'foo "bar" from ('foo "bar" 'bar "foo")
+(define (s:remove-param-matching params key)
+  (if (= (length params) 0)'() ;;  proper params list >= 2 items
+      (let loop ((head     (car params))
+                 (tail     (cdr params))
+                 (result   '()))
+        (if (symbol? head) ;; symbols have params
+            (let ((val     (car tail))
+                  (newtail (cdr tail)))
+              (if (eq? head key)  ;; get rid of this one
+                  (if (null? newtail) result
+                      (loop (car newtail)(cdr newtail) result))
+                  (let ((newresult (append result (list head val))))
+                    (if (null? newtail) newresult
+                        (loop (car newtail)(cdr newtail) newresult)))))
+            (let ((newresult (append result (list head))))
+              (if (null? tail) newresult
+                  (loop (car tail)(cdr tail) newresult)))))))
+
+(define (session:get-param-from params key)
+  (let ((r1 (regexp (conc "^" (s:any->string key) "=(.*)$"))))
+    (if (null? params) #f
+        (let loop ((head (car params))
+                   (tail (cdr params)))
+          (let ((match (string-match r1 head)))
+            (if match
+                (list-ref match 1)
+                (if (null? tail) #f
+                    (loop (car tail)(cdr tail)))))))))
+
+(define (s:process-params params)
+  (if (null? params) ""
+      (let loop ((res "")
+                 (head (car params))
+                 (tail (cdr params)))
+        (if (null? tail)
+            (conc res " " (s:param->string head))
+            (loop
+             (conc res " " (s:param->string head))
+             (car tail)
+             (cdr tail))))))
+
+;; remove key=var from (key=var key1=var1 key2=var2 ...)
+(define (k=v-params:remove-matching params key)
+  (if (= (length params) 0) params
+      (let ((r1 (regexp (conc "^" key "="))))
+        (let loop ((head (car params))
+                   (tail (cdr params))
+                   (result '()))
+          (if (string-match r1 head)
+              (if (null? tail) result
+                  (loop (car tail)(cdr tail) result))
+              (let ((newlst (cons head result)))
+                (if (null? tail) newlst
+                    (loop (car tail)(cdr tail) newlst))))))))
+
+;;======================================================================
+;; stuff pulled from session
+;;======================================================================
+
+
+;; sessions table
+;; id session_id session_key
+;; create table sessions (id serial not null,session-key text);
+
+;; session_vars table
+;; id session_id page_id key value
+;; create table session_vars (id serial not null,session_id integer,page text,key text,value text);
+
+;; TODO
+;;  Concept of order num incremented with each page access
+;;     if a branch is taken then a new session would need to be created
+;;
+
+;; make-vector-record session session dbtype dbinit conn params path-params session-key session-id domain toppage page curr-page content-type page-type sroot twikidir pagedat alt-page-dat pagevars pagevars-before sessionvars sessionvars-before globalvars globalvars-before logpt formdat request-method session-cookie curr-err log-port logfile seen-pages page-dir-style debugmode
+;; (define (make-sdat)(make-vector 36))
+;; (define (sdat-dbtype               vec)    (vector-ref  vec 0))
+;; (define (sdat-dbinit               vec)    (vector-ref  vec 1))
+;; (define (sdat-conn                 vec)    (vector-ref  vec 2))
+;; (define (sdat-pgconn               vec)    (vector-ref (vector-ref vec 2) 1))
+;; (define (sdat-params               vec)    (vector-ref  vec 3))
+;; (define (sdat-path-params          vec)    (vector-ref  vec 4))
+;; (define (sdat-session-key          vec)    (vector-ref  vec 5))
+;; (define (sdat-session-id           vec)    (vector-ref  vec 6))
+;; (define (sdat-domain               vec)    (vector-ref  vec 7))
+;; (define (sdat-toppage              vec)    (vector-ref  vec 8))
+;; (define (sdat-page                 vec)    (vector-ref  vec 9))
+;; (define (sdat-curr-page            vec)    (vector-ref  vec 10))
+;; (define (sdat-content-type         vec)    (vector-ref  vec 11))
+;; (define (sdat-page-type            vec)    (vector-ref  vec 12))
+;; (define (sdat-sroot                vec)    (vector-ref  vec 13))
+;; (define (sdat-twikidir             vec)    (vector-ref  vec 14))
+;; (define (sdat-pagedat              vec)    (vector-ref  vec 15))
+;; (define (sdat-alt-page-dat         vec)    (vector-ref  vec 16))
+;; (define (sdat-pagevars             vec)    (vector-ref  vec 17))
+;; (define (sdat-pagevars-before      vec)    (vector-ref  vec 18))
+;; (define (sdat-sessionvars          vec)    (vector-ref  vec 19))
+;; (define (sdat-sessionvars-before   vec)    (vector-ref  vec 20))
+;; (define (sdat-globalvars           vec)    (vector-ref  vec 21))
+;; (define (sdat-globalvars-before    vec)    (vector-ref  vec 22))
+;; (define (sdat-logpt                vec)    (vector-ref  vec 23))
+;; (define (sdat-formdat              vec)    (vector-ref  vec 24))
+;; (define (sdat-request-method       vec)    (vector-ref  vec 25))
+;; (define (sdat-session-cookie       vec)    (vector-ref  vec 26))
+;; (define (sdat-curr-err             vec)    (vector-ref  vec 27))
+;; (define (sdat-log-port             vec)    (vector-ref  vec 28))
+;; (define (sdat-logfile              vec)    (vector-ref  vec 29))
+;; (define (sdat-seen-pages           vec)    (vector-ref  vec 30))
+;; (define (sdat-page-dir-style       vec)    (vector-ref  vec 31))
+;; (define (sdat-debugmode            vec)    (vector-ref  vec 32))
+;; (define (sdat-shared-hash          vec)    (vector-ref  vec 33))
+;; (define (sdat-script               vec)    (vector-ref  vec 34))
+;; (define (sdat-force-ssl            vec)    (vector-ref  vec 35))
+;; 
+;; (define (session:get-shared vec varname)
+;;   (hash-table-ref/default (vector-ref vec 33) varname #f))
+;; 
+;; (define (sdat-dbtype-set!              vec val)(vector-set! vec 0 val))
+;; (define (sdat-dbinit-set!              vec val)(vector-set! vec 1 val))
+;; (define (sdat-conn-set!                vec val)(vector-set! vec 2 val))
+;; (define (sdat-params-set!              vec val)(vector-set! vec 3 val))
+;; (define (sdat-path-set-params!         vec val)(vector-set! vec 4 val))
+;; (define (sdat-session-set-key!         vec val)(vector-set! vec 5 val))
+;; (define (sdat-session-set-id!          vec val)(vector-set! vec 6 val))
+;; (define (sdat-domain-set!              vec val)(vector-set! vec 7 val))
+;; (define (sdat-toppage-set!             vec val)(vector-set! vec 8 val))
+;; (define (sdat-page-set!                vec val)(vector-set! vec 9 val))
+;; (define (sdat-curr-set-page!           vec val)(vector-set! vec 10 val))
+;; (define (sdat-content-set-type!        vec val)(vector-set! vec 11 val))
+;; (define (sdat-page-set-type!           vec val)(vector-set! vec 12 val))
+;; (define (sdat-sroot-set!               vec val)(vector-set! vec 13 val))
+;; (define (sdat-twikidir-set!            vec val)(vector-set! vec 14 val))
+;; (define (sdat-pagedat-set!             vec val)(vector-set! vec 15 val))
+;; (define (sdat-alt-set-page-dat!        vec val)(vector-set! vec 16 val))
+;; (define (sdat-pagevars-set!            vec val)(vector-set! vec 17 val))
+;; (define (sdat-pagevars-set-before!     vec val)(vector-set! vec 18 val))
+;; (define (sdat-sessionvars-set!         vec val)(vector-set! vec 19 val))
+;; (define (sdat-sessionvars-set-before!  vec val)(vector-set! vec 20 val))
+;; (define (sdat-globalvars-set!          vec val)(vector-set! vec 21 val))
+;; (define (sdat-globalvars-set-before!   vec val)(vector-set! vec 22 val))
+;; (define (sdat-logpt-set!               vec val)(vector-set! vec 23 val))
+;; (define (sdat-formdat-set!             vec val)(vector-set! vec 24 val))
+;; (define (sdat-request-set-method!      vec val)(vector-set! vec 25 val))
+;; (define (sdat-session-set-cookie!      vec val)(vector-set! vec 26 val))
+;; (define (sdat-curr-set-err!            vec val)(vector-set! vec 27 val))
+;; (define (sdat-log-set-port!            vec val)(vector-set! vec 28 val))
+;; (define (sdat-logfile-set!             vec val)(vector-set! vec 29 val))
+;; (define (sdat-seen-set-pages!          vec val)(vector-set! vec 30 val))
+;; (define (sdat-page-set-dir-style!      vec val)(vector-set! vec 31 val))
+;; (define (sdat-debugmode-set!           vec val)(vector-set! vec 32 val))
+;; (define (sdat-shared-set-hash!         vec val)(vector-set! vec 33 val))
+;; (define (sdat-script-set!              vec val)(vector-set! vec 34 val))
+;; (define (sdat-force-set-ssl!           vec val)(vector-set! vec 35 val))
+;; 
+;; (define (session:set-shared! vec varname val)
+;;   (hash-table-set! (vector-ref vec 33) varname val))
+
+;; The global session
+(define s:session (make-sdat))
+
+;; SPLIT INTO STRAIGHT FORWARD INIT AND COMPLEX INIT
+#;(define (session:initialize self #!optional (configf #f))
+  (sdat-dbtype-set! self      'pg)
+  (sdat-page-set! self        "home")        ;; these are defaults
+  (sdat-curr-set-page! self   "home")
+  (sdat-content-set-type! self "Content-type: text/html; charset=iso-8859-1\n\n")
+  (sdat-page-set-type! self   'html)
+  (sdat-toppage-set! self     "index")
+  (sdat-params-set! self      '())           ;;
+  (sdat-path-set-params! self '())
+  (sdat-session-set-key! self #f)
+  (sdat-pagedat-set! self     '())
+  (sdat-alt-set-page-dat! self #f)
+  (sdat-sroot-set! self       "./")
+  (sdat-session-set-cookie! self #f)
+  (sdat-curr-set-err! self #f)
+  (sdat-log-set-port! self (current-error-port))
+  (sdat-seen-set-pages! self '())
+  (sdat-page-set-dir-style! self #t) ;; #t : pages/<pagename>_(view|cntl).scm
+                                      ;; #f : pages/<pagename>/(view|control).scm 
+  (sdat-debugmode-set!          self #f)
+  			     
+  (sdat-pagevars-set!           self (make-hash-table))
+  (sdat-sessionvars-set!        self (make-hash-table))
+  (sdat-globalvars-set!         self (make-hash-table))
+  (sdat-pagevars-set-before!    self (make-hash-table))
+  (sdat-sessionvars-set-before! self (make-hash-table))
+  (sdat-globalvars-set-before!  self (make-hash-table))
+  (sdat-domain-set!             self "locahost")   ;; end of defaults
+  (sdat-script-set!             self #f)
+  (sdat-force-set-ssl!          self #f)
+  (let* ((rawconfigdat (session:read-config self configf))
+	 (configdat (if rawconfigdat (eval rawconfigdat) '()))
+	 (sroot     (s:find-param 'sroot    configdat))
+	 (logfile   (s:find-param 'logfile  configdat))
+	 (dbtype    (s:find-param 'dbtype   configdat))
+	 (dbinit    (s:find-param 'dbinit   configdat))
+	 (domain    (s:find-param 'domain   configdat))
+	 (twikidir  (s:find-param 'twikidir configdat))
+	 (page-dir  (s:find-param 'page-dir-style configdat))
+	 (debugmode (s:find-param 'debugmode configdat))
+         (script    (s:find-param 'script    configdat))
+	 (force-ssl (s:find-param 'force-ssl configdat)))
+    (if sroot    (sdat-sroot-set!    self sroot))
+    (if logfile  (sdat-logfile-set!  self logfile))
+    (if dbtype   (sdat-dbtype-set!   self dbtype))
+    (if dbinit   (sdat-dbinit-set!   self dbinit))
+    (if domain   (sdat-domain-set!   self domain))
+    (if twikidir (sdat-twikidir-set! self twikidir))
+    (if debugmode (sdat-debugmode-set! self debugmode))
+    (if script    (sdat-script-set!    self script))
+    (if force-ssl (sdat-force-set-ssl! self force-ssl))
+    (sdat-page-set-dir-style! self page-dir)
+    ;; (print "configdat: ")(pp configdat)
+    (if debugmode
+	(session:log self "sroot: " sroot " logfile: " logfile " dbtype: " dbtype 
+		     " dbinit: " dbinit " domain: " domain " page-dir-style: " page-dir))
+    )
+  (sdat-shared-set-hash! self (make-hash-table))
+  )
+
+;; Used for the strangely inconsistent handling of the config file. A better way is needed.
+;;
+;;   (let ((dbtype (sdat-dbtype self)))
+;;     (print "dbtype: " dbtype)
+;;     (sdat-dbtype-set! self (eval dbtype))))
+
+(define (session:setup self #!optional (configf #f))
+  (session:initialize self configf)
+  (let ((dbtype    (sdat-dbtype self))
+	(debugmode (sdat-debug-mode self))
+	(dbinit    (eval (sdat-dbinit self)))
+	(dbexists  #f))
+    (let ((dbfname (alist-ref 'dbname dbinit)))
+      (if debugmode (session:log self "session:setup dbfname=" dbfname ", dbtype=" dbtype ", dbinit=" dbinit))
+      (if (eq? dbtype 'sqlite3)
+	  ;; The 'auto method will distribute dbs across the disk using hash
+	  ;; of user host and user. TODO
+	  ;; (if (eq? dbfname 'auto) ;; This is the auto assignment of a db based on hash of IP
+	  (let ((dbpath (pathname-directory dbfname)))  ;; do a couple sanity checks here to make setting up easier
+	    (if debugmode (session:log self "INFO: setting up for sqlite3 db access to " dbfname))
+	    (if (not (file-write-access? dbpath))
+		(session:log self "WARNING: Cannot write to " dbpath)
+		(if debugmode (session:log self "INFO: " dbpath " is writeable")))
+	    (if (file-exists? dbfname)
+		(begin
+		  ;; (session:log self "setting dbexists to #t")
+		  (set! dbexists #t))))
+	  (if debugmode (session:log self "INFO: setting up for pg db access to account info " dbinit)))
+      (if debugmode (session:log self "dbtype: " dbtype " dbfname: " dbfname " dbexists: " dbexists)))
+    (sdat-conn-set! self (dbi:open dbtype dbinit))
+    (set! *db* (sdat-conn self))
+    (if (and (not dbexists)(eq? dbtype 'sqlite3))
+ 	(begin
+	  (print "WARNING: Setting up session db with sqlite3")
+	  (session:setup-db self)))
+    (session:process-url-path self)
+    (session:setup-session-key self)
+    ;; capture stdin if this is a POST
+    (sdat-request-method-set! self (get-environment-variable "REQUEST_METHOD"))
+    (sdat-formdat-set! self (formdat:load-all))))
+
+;; setup the db with session tables, works for sqlite only right now
+(define (session:setup-db self)
+  (let ((conn (sdat-conn self)))
+    (for-each 
+     (lambda (stmt)
+       (dbi:exec conn stmt))
+     (list "CREATE TABLE session_vars (id INTEGER PRIMARY KEY,session_id INTEGER,page TEXT,key TEXT,value TEXT);"
+	   "CREATE TABLE sessions (id INTEGER PRIMARY KEY,session_key TEXT,last_used TIMESTAMP);"
+           "CREATE TABLE metadata (id INTEGER PRIMARY KEY,key TEXT,value TEXT);"))))
+;;  ;; if we have a session_key look up the session-id and store it
+;;  (sdat-session-set-id! self (session:get-id self)))
+
+;; only set session-cookie when a new session is created
+(define (session:setup-session-key self)  
+  (let* ((sk  (session:extract-session-key self))
+         (sid (if sk (session:get-id self sk) #f)))
+    (if (not sid) ;; need a new key
+        (let* ((new-key (session:get-new-key self))
+               (new-sid (session:get-id self new-key)))
+          (sdat-session-key-set! self new-key)
+          (sdat-session-id-set! self new-sid)
+          (sdat-session-cookie-set! self (session:make-cookie self)))
+        (sdat-session-id-set! self sid))))
+
+(define (session:make-cookie self)
+  ;; (list (conc "session_key=" (sdat-session-key self) "; Path=/; Domain=." (sdat-domain self) "; Max-Age=" (* 86400 14) "; Version=1"))) 
+  ;; According to 
+  ;;    http://www.codemarvels.com/2010/11/apache-rewriterule-set-a-cookie-on-localhost/
+
+  ;;  Here are the 2 (often left out) requirements to set a cookie using
+  ;;  httpd-F�s rewrite rule (mod_rewrite), while working on localhost:-A
+  ;;
+  ;;  Use the IP 127.0.0.1 instead of localhost/machine-name as the
+  ;;  domain; e.g. [CO=someCookie:someValue:127.0.0.1:2:/], which says
+  ;;  create a cookie -Y�someCookie� with value �someValue� for the
+  ;;  domain �127.0.0.1$B!m(B having a life time of 2 mins, for any path in
+  ;;  the domain (path=/). (Obviously you will have to run the
+  ;;  application with this value in the URL)
+  ;;
+  ;;  To make a session cookie, limit the flag statement to just three
+  ;;  attributes: name, value and domain. e.g
+  ;;  [CO=someCookie:someValue:127.0.0.1] %G–%@ Any further
+  ;;  settings, apache writes an� expires� attribute for the set-cookie
+  ;;  header, which makes the cookie a persistent one (not really
+  ;;  persistent, as the expires value set is the current server time
+  ;;  %G–%@ so you don-F-F�t even get to see your cookie!)-A
+  (list (string-substitute 
+	 ";" "; " 
+	 (car (construct-cookie-string 
+	       ;; warning! messing up this itty bitty bit of code will cost much time!
+	       `(("session_key" ,(sdat-session-key self)
+		  expires: ,(+ (current-seconds) (* 14 86400)) 
+		  ;; max-age: (* 14 86400)
+		  path: "/" ;; 
+		  domain: ,(string-append "." (sdat-domain self))
+		  version: 1)) 0)))))
+
+;; look up a given session key and return the id if found, #f if not found
+(define (session:get-id self session-key)
+  ;; (let ((session-key (sdat-session-key self)))
+  (if session-key
+      (let ((query (string-append "SELECT id FROM sessions WHERE session_key='" session-key "'"))
+            (conn (sdat-conn self))
+            (result #f))
+	(dbi:for-each-row 
+	 (lambda (tuple)
+	   (set! result (vector-ref tuple 0)))
+	 conn query)
+	(if result (dbi:exec conn (conc "UPDATE sessions SET last_used=" (dbi:now conn) " WHERE session_key=?;") session-key))
+        result)
+      #f))
+
+;; 
+(define (session:process-url-path self)
+  (let ((path-info    (get-environment-variable "PATH_INFO"))
+	(query-string (get-environment-variable "QUERY_STRING")))
+    ;; (session:log self "path-info=" path-info " query-string=" query-string)
+    (if path-info
+	(let* ((parts    (string-split path-info "/"))
+	       (numparts (length parts)))
+	  (if (> numparts 0)
+	      (sdat-page-set! self (car parts)))
+	  ;; (session:log self "url-path=" url-path " parts=" parts)
+	  (if (> numparts 1)
+	      (sdat-path-params-set! self (cdr parts)))
+          (if query-string
+              (sdat-params-set! self (string-split query-string "&")))))))
+
+;; BUGGY!
+(define (session:get-new-key self)
+  (let ((conn   (sdat-conn self))
+        (tmpkey (session:make-rand-string 20))
+        (status #f))
+    (dbi:for-each-row (lambda (tuple)
+			(set! status #t))
+		      conn (string-append "INSERT INTO sessions (session_key) VALUES ('" tmpkey "')"))
+    tmpkey))
+
+;; returns session key IFF it is in the HTTP_COOKIE 
+(define (session:extract-session-key self)
+  (let ((http-cookie (get-environment-variable "HTTP_COOKIE")))
+    ;; (err:log "http-cookie: " http-cookie)
+    (if http-cookie
+        (session:extract-key-from-param self (string-split-fields  ";\\s+" http-cookie infix:) "session_key")
+        #f)))
+
+(define (session:get-session-id self session-key)
+  (let ((query "SELECT id FROM sessions WHERE session_key=?;")
+        (result #f))
+    ;;     (pg:query-for-each (lambda (tuple)
+    ;;                          (set! result (vector-ref tuple 0))) ;; (vector-ref tuple 0)))
+    ;;                        (s:sqlparam query session-key)
+    ;;                        (sdat-conn self))
+    ;;                        conn)
+    (dbi:for-each-row (lambda (tuple)
+			(set! result (vector-ref tuple 0))) ;; (vector-ref tuple 0)))
+		      (sdat-conn self)
+		      (s:sqlparam query session-key))
+    result))
+
+;; delete all records for a session
+;; 
+;; NEEDS TO BE TRANSACTIONIZED!
+;;
+(define (session:delete-session self session-key)
+  (let ((session-id (session:get-session-id self session-key))
+        (qry1        ;; (conc "BEGIN;"
+			  "DELETE FROM session_vars WHERE session_id=?;")
+	(qry2             "DELETE FROM sessions WHERE id=?;")
+		     ;;  "COMMIT;"))
+        (conn              (sdat-conn self)))
+    (if session-id
+        (begin
+          (dbi:exec conn qry1 session-id) ;; session-id)
+	  (dbi:exec conn qry2 session-id)
+	  ;; (session:initialize self)
+	  (session:setup self)))
+    (not (session:get-session-id self session-key))))
+
+;; (define (session:delete-session self session-key)
+;;   (let ((session-id (session:get-session-id self session-key))
+;;         (queries    (list "BEGIN;"
+;; 			  "DELETE FROM session_vars WHERE session_id=?;"
+;;                           "DELETE FROM sessions WHERE id=?;"
+;; 			  "COMMIT;"))
+;;         (conn              (sdat-conn self)))
+;;     (if session-id
+;;         (begin
+;;           (for-each
+;;            (lambda (query)
+;;              (dbi:exec conn query session-id))
+;; 	   queries)
+;; 	  (initialize self '())
+;; 	  (session:setup self)))
+;;     (not (session:get-session-id self session-key))))
+
+(define (session:extract-key self key)
+  (let ((params (sdat-params self)))
+    (session:extract-key-from-param self params key)))
+
+(define (session:extract-key-from-param self params key)
+  (let ((r1     (regexp (string-append "^" key "=([^=]+)$"))))
+    (err:log "INFO: Looking for " key " in " params)
+    (if (< (length params) 1) #f
+	(let loop ((head   (car params))
+		   (tail   (cdr params)))
+	  (let ((match (string-match r1 head)))
+	    (cond
+	     (match
+	      (let ((session-key (list-ref match 1)))
+		(err:log "INFO: Found session key=" session-key)
+		(sdat-session-key-set! self (list-ref match 1))
+		session-key))
+	     ((null? tail)
+	      #f)
+	     (else
+	      (loop (car tail)
+		    (cdr tail)))))))))
+
+(define (session:set-page! self page_name)
+  (sdat-page-set! self page_name))
+
+(define (session:close self)
+  (dbi:close (sdat-conn self)))
+;; (close-output-port (sdat-logpt self))
+
+(define (session:err-msg self msg)
+  (hash-table-set! (sdat-sessionvars self) "ERROR_MSG"
+		   (string-intersperse (map s:any->string msg) " ")))
+
+(define (session:prev-err self)
+  (let ((prev-err (hash-table-ref/default (sdat-sessionvars-before self) "ERROR_MSG" #f))
+	(curr-err (hash-table-ref/default (sdat-sessionvars self) "ERROR_MSG" #f)))
+    (if prev-err prev-err
+	(if curr-err curr-err #f))))
+
+;; session vars
+;; 1. keys are always a string NOT a symbol
+;; 2. values are always a string conversion is the responsibility of the 
+;;    consuming function (at least for now, I'd like to change this)
+
+;; set a session var for the current page
+;;
+(define (session:curr-page-set! self key value)
+  (hash-table-set! (sdat-pagevars self) (s:any->string key) (s:any->string value)))
+
+;; del a var for the current page
+;;
+(define (session:page-var-del! self key)
+  (hash-table-delete! (sdat-pagevars self) (s:any->string key)))
+
+;; get the appropriate hash given a page "*sessionvars*, *globalvars* or page
+;;
+(define (session:get-page-hash self page)
+  (if (string=? page "*sessionvars*")
+      (sdat-sessionvars self)
+      (if (string=? page "*globalvars*")
+	  (sdat-globalvars self)
+	  (sdat-pagevars self))))
+
+;; set a session var for a given page
+;;
+(define (session:set! self page key value)
+  (let ((ht (session:get-page-hash self page)))
+    (hash-table-set! ht (s:any->string key) (s:any->string value))))
+
+;; get session vars for the current page
+;;
+(define (session:page-get self key)
+  (hash-table-ref/default (sdat-pagevars self) key #f))
+
+;; get session vars for a specified page
+;;
+(define (session:get self page key params)
+  (let* ((ht  (session:get-page-hash self page))
+	 (res (hash-table-ref/default ht (s:any->string key) #f)))
+    (session:apply-type-preference res params)))
+
+;; delete a session var for a specified page
+;;
+(define (session:del! self page key)
+  (let ((ht (session:get-page-hash self page)))
+    (hash-table-delete! ht (s:any->string key))))
+
+;; get ALL keys for this page and store in the session pagevars hash
+;;
+(define (session:get-vars self)
+  (let ((session-id  (sdat-session-id self)))
+    (if (not session-id)
+	(err:log "ERROR: No session id in session object! session:get-vars")
+	(let* ((result             #f)
+	       (conn               (sdat-conn self))
+	       (pagevars-before    (sdat-pagevars-before self))
+	       (sessionvars-before (sdat-sessionvars-before self))
+	       (globalvars-before  (sdat-globalvars-before self))
+	       (pagevars           (sdat-pagevars self))
+	       (sessionvars        (sdat-sessionvars self))
+	       (globalvars         (sdat-globalvars self))
+	       (page-name          (sdat-page self))
+	       (session-key        (sdat-session-key self))
+	       (query              (string-append
+				    "SELECT key,value FROM session_vars INNER JOIN sessions ON session_vars.session_id=sessions.id "
+				    "WHERE session_key=? AND page=?;")))
+	  ;; first the page specific vars
+	  (dbi:for-each-row (lambda (tuple)
+			      (let ((k (vector-ref tuple 0))
+				    (v (vector-ref tuple 1)))
+				(hash-table-set! pagevars-before k v)
+				(hash-table-set! pagevars        k v)))
+			    conn
+			    (s:sqlparam query session-key page-name))
+	  ;; then the session specific vars
+	  (dbi:for-each-row (lambda (tuple)
+			      (let ((k (vector-ref tuple 0))
+				    (v (vector-ref tuple 1)))
+				(hash-table-set! sessionvars-before k v)
+				(hash-table-set! sessionvars        k v)))
+			    conn
+			    (s:sqlparam query session-key "*sessionvars*"))
+	  ;; and finally the global vars
+	  (dbi:for-each-row (lambda (tuple)
+			      (let ((k (vector-ref tuple 0))
+				    (v (vector-ref tuple 1)))
+				(hash-table-set! globalvars-before k v)
+				(hash-table-set! globalvars        k v)))
+			    conn
+			    (s:sqlparam query session-key "*globalvars"))
+	  ))))
+
+(define (session:save-vars self)
+  (let ((session-id  (sdat-session-id self)))
+    (if (not session-id)
+	(err:log "ERROR: No session id in session object! session:get-vars")
+	(let* ((status      #f)
+	       (conn        (sdat-conn self))
+	       (page-name   (sdat-page self))
+	       (del-query   "DELETE FROM session_vars WHERE session_id=? AND page=? AND key=?;")
+	       (ins-query   "INSERT INTO session_vars (session_id,page,key,value) VALUES(?,?,?,?);")
+	       (upd-query   "UPDATE session_vars set value=? WHERE key=? AND session_id=? AND page=?;")
+	       (changed-count 0))
+	  ;; save the delta only
+	  (for-each
+	   (lambda (page) ;; page is: "*globalvars*" "*sessionvars*" or otherstring
+	     (let* ((before-after-ht (cond
+				      ((string=? page "*sessionvars*")
+				       (vector (sdat-sessionvars self)
+					       (sdat-sessionvars-before self)))
+				       ((string=? page "*globalvars*")
+					(vector (sdat-globalvars self)
+						(sdat-globalvars-before self)))
+				       (else 
+					(vector (sdat-pagevars self)
+						(sdat-pagevars-before self)))))
+		    (master-ht   (vector-ref before-after-ht 0))
+		    (before-ht   (vector-ref before-after-ht 1))
+		    (master-keys (hash-table-keys master-ht))
+		    (before-keys (hash-table-keys before-ht))
+		    (all-keys (delete-duplicates (append master-keys before-keys))))
+	       (for-each 
+		(lambda (key)
+		  (let ((master-value (hash-table-ref/default master-ht key #f))
+			(before-value (hash-table-ref/default before-ht key #f)))
+		    (cond
+		     ;; before and after exist and value unchanged - do nothing
+		     ((and master-value before-value (equal? master-value before-value)))
+		     ;; before and after exist but are changed
+		     ((and master-value before-value)
+		      (dbi:for-each-row (lambda (tuple)
+					  (set! changed-count (+ changed-count 1)))
+					conn
+					(s:sqlparam upd-query master-value key session-id page)))
+		     ;; master-value no longer exists (i.e. #f) - remove item
+		     ((not master-value)
+		      (dbi:for-each-row (lambda (tuple)
+					  (set! changed-count (+ changed-count 1)))
+					conn
+					(s:sqlparam del-query session-id page key)))
+		     ;; before-value doesn't exist - insert a new value
+		     ((not before-value)
+		      (dbi:for-each-row (lambda (tuple)
+					  (set! changed-count (+ changed-count 1)))
+					conn
+					(s:sqlparam ins-query session-id page key master-value)))
+		     (else (err:log "Shouldn't get here")))))
+		all-keys))) ;; process all keys
+	   (list "*sessionvars*" "*globalvars*" page-name))))))
+
+;; (pg:sql-null-object? element)
+(define (session:read-config self #!optional (fname #f))
+  (let* ((cgi-path (pathname-directory (car (argv))))
+         (name     (or fname (string-append (if cgi-path (conc cgi-path "/") "") "." (pathname-file (car (argv))) ".config"))))
+    (if (not (file-exists? name))
+	(print name " not found at " (current-directory))
+	(let* ((fp (open-input-file name))
+	       (initargs (read fp)))
+	  (close-input-port fp)
+	  initargs))))
+
+;; call the controller if it exists
+;; 
+;; WARNING - this code needs a defense agains recursive calling!!!!!
+;;
+;;   I suggest a limit of 100 calls. Plenty for allowing multiple instances
+;;   of a page inside another page. 
+;;
+;; parts = 'both | 'control | 'view
+;;
+
+(define (files-read->string . files)
+  (string-intersperse 
+   (apply append (map file-read->string files)) "\n"))
+
+(define (file-read->string f) 
+  (let ((p (open-input-file f)))
+    (let loop ((hed (read-line p))
+	       (res '()))
+      (if (eof-object? hed)
+	  res
+	  (loop (read-line p)(append res (list hed)))))))
+
+(define (process-port p)
+  (let ((e (interaction-environment)))
+    (map 
+     (lambda (x)
+       (cond
+	((list? x) x)
+	((string? x) x)
+	(else '())))
+     (port-map (lambda (s)
+		 (eval s e))
+	       (lambda ()(read p))))))
+
+(define (session:process-file f)
+  (let* ((p    (open-input-file f))
+	 (dat  (process-port p)))
+    (close-input-port p)
+    dat))
+
+;; May 2011, putting all pages into one directory for the following reasons:
+;;   1. want filename to reflect page name (emacs limitation)
+;;   2. that's it! no other reason. could make it configurable ...
+;; page-dir-style is:
+;;  'stored   => stored in executable
+;;  'flat     => pages flat directory
+;;  'dir      => directory tree pages/<pagename>/{view,control}.scm
+;; parts:
+;;  'both     => load control and view (anything other than view or control and the default)
+;;  'view     => load view only
+;;  'control  => load control only
+(define (session:call-parts self page #!key (parts 'both))
+  (sdat-curr-page-set! self page)
+  (let* ((dir-style    (sdat-page-dir-style self));; (equal? (sdat-page-dir-style self) "onedir")) ;; flag #t for onedir, #f for old style
+	 (dir          (string-append (sdat-sroot self) 
+				      (if dir-style 
+					  (conc "/pages/")
+					  (conc "/pages/" page)))))
+    (case dir-style
+      ;; NB// Stored always loads both control and view
+      ((stored)
+       ((eval (string->symbol (conc "pages:" page))) 
+	self                         ;; the session
+	(sdat-conn self)         ;; the db connection
+	(sdat-shared-hash self)  ;; a shared hash table for passing data to/from page calls
+	))
+      ((flat)   
+       (let* ((so-file  (conc dir page ".so"))
+	      (scm-file (conc dir page ".scm"))
+	      (src-file (or (file-exists? so-file)
+			    (file-exists? scm-file))))
+	 (if src-file
+	     (begin
+	       (load src-file)
+	       ((eval (string->symbol (conc "pages:" page))) 
+		self                         ;; the session
+		(sdat-conn self)         ;; the db connection
+		(sdat-shared-hash self)  ;; a shared hash table for passing data to/from page calls
+		))
+	     (list "<p>Page not found " page " </p>"))))
+       ;; first the control
+       ;; (let ((control-file (conc "pages/" page "_ctrl.scm"))
+       ;;       (view-file    (conc "pages/" page "_view.scm")))
+       ;;   (if (and (file-exists? control-file)
+       ;;  	  (not (eq? parts 'view)))
+       ;;       (begin
+       ;;         (session:set-called! self page)
+       ;;         (load control-file)))
+       ;;   (if (file-exists? view-file)
+       ;;       (if (not (eq? parts 'control))
+       ;;  	 (session:process-file view-file))
+       ;;       (list "<p>Page not found " page " </p>")))
+      ((dir) "ERROR:  dir style not yet re-implemented")
+      (else
+       (list "ERROR: page-dir-style must be stored, dir or flat, got " dir-style)))))
+
+(define (session:call self page parts)
+  (session:call-parts self page 'both))
+
+(define (session:load-model self model)
+  (let* ((mpath     (session:model-path self))
+	 (model.scm (string-append mpath "/" model ".scm"))
+	 (model.so  (string-append mpath "/" model ".so")))
+    (if (file-exists? model.so)
+	(load model.so)
+	(if (file-exists? model.scm)
+	    (load model.scm)
+	    (s:log "ERROR: model " model.scm " not found")))))
+
+(define (session:model-path self)
+  (or (sdat-models self)
+      (string-append (sdat-sroot self) "/models/")))
+
+(define (session:pp-formdat self)
+  (let ((dat (formdat:all->strings (sdat-formdat self))))
+    (string-intersperse dat "<br> ")))
+
+(define (session:param->string params)
+  ;; (err:log "params=" params)
+  (if (< (length params) 1)
+      ""
+      (let loop ((key (car params))
+		 (val (cadr params))
+		 (tail (cddr params))
+		 (result '()))
+	(let ((newresult (cons (string-append (s:any->string key) "=" (s:any->string val))
+			       result)))
+	  (if (< (length tail) 1) ;; true if done
+	      (string-intersperse newresult "&")
+	      (loop (car tail)(cadr tail)(cddr tail) newresult))))))
+
+(define (session:link-to self page params)
+  (let* ((https-host   (get-environment-variable "HTTPS_HOST"))
+         (force-ssl    (sdat-force-ssl self))
+	 (server       (or https-host ;; Assuming HTTPS_HOST is only set if available
+			   (get-environment-variable "HTTP_HOST")
+			   (get-environment-variable "SERVER_NAME")
+			   (sdat-domain self)))
+         (force-script  (sdat-script self))
+	 (script        (or force-script
+			    (let ((script-name (string-split (get-environment-variable "SCRIPT_NAME") "/")))
+			      (if (> (length script-name) 1)
+				  (string-append (car script-name) "/" (cadr script-name))
+				  (get-environment-variable "SCRIPT_NAME"))))) ;; build script name from first two elements. This is a hangover from before I used ? in the URL.)
+         (session-key   (sdat-session-key self))
+	 (paramstr      (session:param->string params)))
+    (session:log self "server=" server " script=" script " page=" page)
+    (string-append (if (or https-host force-ssl)
+		      "https://"
+		      "http://")
+		   server "/" script "/" page "?" paramstr))) ;; "/sn=" session-key)))
+
+(define (session:cgi-out self)
+  (let* ((content  (list (sdat-content-type self))) ;; '("Content-type: text/html; charset=iso-8859-1\n\n"))
+	 (header   (let ((cookie (sdat-session-cookie self)))
+		     (if cookie
+			 (cons (string-append "Set-Cookie: " (car cookie))
+			       content)
+			 content)))
+	 (pagedat  (sdat-pagedat self)))
+    (s:cgi-out 
+     (cons header pagedat))))
+
+(define (session:log self . msg)
+  (with-output-to-port (sdat-log-port self) ;; (sdat-logpt self)
+    (lambda () 
+      (apply print msg))))
+
+;; escape, convert or return raw when given user input data that potentially
+;; could be malicious
+;;
+(define (session:apply-type-preference res params)
+  (let* ((dtype    (if (null? params)
+		       'escaped
+		       (car params)))
+	 (tags    (if (null? params)
+		      '()
+		      (cdr params))))
+    (case dtype
+      ((raw)     res)
+      ((number)  (if (string? res)(string->number res) #f))
+      ((escaped) (if (string? res)
+		     (s:html-filter->string res tags)
+		     res))
+      ((escaped-nl) (if (string? res) ;; escape \n and \r
+			(string-intersperse
+			 (string-split
+			  (string-intersperse
+			   (string-split (s:html-filter->string res tags) "\n")
+			   "\\n")
+			  "\r")
+			 "\\r")
+			res)) ;; should return #f if not a string and can't escape it?
+      (else      (if (string? res)
+		     (s:html-filter->string res '())
+		     res)))))
+
+#;(define (session:get-param-from params key)
+  (let ((r1 (regexp (conc "^" (s:any->string key) "=(.*)$"))))
+    (if (null? params) #f
+        (let loop ((head (car params))
+                   (tail (cdr params)))
+          (let ((match (string-match r1 head)))
+            (if match
+                (list-ref match 1)
+                (if (null? tail) #f
+                    (loop (car tail)(cdr tail)))))))))
+
+;; params are stored as list of key=val
+;;
+(define (session:get-param self key type-params)
+  ;; (session:log s:session "params=" (slot-ref s:session 'params))
+  (let* ((params (sdat-params self))
+	 (res    (session:get-param-from params key)))
+    (session:apply-type-preference res type-params)))
+
+;; This one will get the first value found regardless of form
+;; param: (dtype [tag1 tag2 ...])
+;; dtype:
+;;    'raw     : do no conversion
+;;    'number  : convert to number, return #f if fails
+;;    'escaped : use html-escape to protect the input -- this is the default
+;;
+(define (session:get-input self key params)
+  (let* ((dtype    (if (null? params)
+		       'escaped
+		       (car params)))
+	 (tags    (if (null? params)
+		      '()
+		      (cdr params)))
+	 (formdat (sdat-formdat self))
+	 (res     (if (not formdat) #f
+		      (if (or (string? key)(number? key)(symbol? key))
+			  (if (and (vector? formdat)
+				   (eq? (vector-length formdat) 1)
+				   (hash-table? (vector-ref formdat 0)))
+			      (formdat:get formdat key)
+			      (begin
+				(session:log self "ERROR: formdat: " formdat " is not of class <formdat>")
+				#f))
+			  (begin
+			    (session:log self "ERROR: bad key " key)
+			    #f)))))
+    (case dtype
+      ((raw)     res)
+      ((number)  (if (string? res)(string->number res) #f))
+      ((escaped) (if (string? res)
+		     (s:html-filter->string res tags)
+		     res))
+      (else      (if (string? res)
+		     (s:html-filter->string res '())
+		     res)))))
+
+;; This one will get the first value found regardless of form
+(define (session:get-input-keys self)
+  (let* ((formdat (sdat-formdat self)))
+    (if (not formdat) #f
+	(if (and (vector? formdat)
+		 (eq? (vector-length formdat) 1)
+		 (hash-table? (vector-ref formdat 0)))
+	    (formdat:keys formdat)
+	    (begin
+	      (session:log self "ERROR: formdat: " formdat " is not of class <formdat>")
+	      #f)))))
+
+(define (session:run-actions self)
+  (let* ((action    (session:get-param self 'action '(raw)))
+	 (page      (sdat-page self)))
+    ;; (print "action=" action " page=" page)
+    (if action
+	(let ((action-lst  (string-split action ".")))
+	  ;; (print "action-lst=" action-lst)
+	  (if (not (= (length action-lst) 2)) 
+	      (err:log "Action should be of form: module.action")
+	      (let* ((targ-page   (car action-lst))
+		     (proc-name   (string-append targ-page "-action"))
+		     (targ-action (cadr action-lst)))
+		;; (err:log "targ-page=" targ-page " proc-name=" proc-name " targ-action=" targ-action)
+
+		;; call here only if never called before
+		(if (session:never-called-page? self targ-page)
+		    (session:call-parts self targ-page 'control))
+		;;                    proc                         action    
+
+		(if #t ;; set to #t to see better error messages during debuggin :-)
+		    ((eval (string->symbol proc-name)) targ-action) ;; unsafe execution
+		    (condition-case ((eval (string->symbol proc-name)) targ-action)
+				    ((exn file) (s:log "file error"))
+				    ((exn i/o)  (s:log "i/o error"))
+				    ((exn )     (s:log "Action not implemented: " proc-name " action: " targ-action))
+				    (var ()     (s:log "Unknown Error"))))))))))
+
+(define (session:never-called-page? self page)
+  (session:log self "Checking for page: " page)
+  (not (member page (sdat-seen-pages self))))
+
+(define (session:set-called! self page)
+  (sdat-seen-pages-set! self (cons page (sdat-seen-pages self))))
+
+;;======================================================================
+;; Alternative data type delivery
+;;======================================================================
+
+(define (session:alt-out self)
+  (let ((dat (sdat-alt-page-dat self)))
+    ;; (s:log "dat is: " dat)
+    ;; (print "HTTP/1.1 200 OK")
+    (print "Date: " (time->string (seconds->utc-time (current-seconds))))
+    (print "Content-Type: " (sdat-content-type self))
+    (print "Accept-Ranges: bytes")
+    (print "Content-Length: " (if (blob? dat)
+				  (blob-size dat)
+				  0))
+    (print "Keep-Alive: timeout=15, max=100")
+    (print "Connection: Keep-Alive")
+    (print "")
+    (write-string (blob->string dat) #f (current-output-port))))
+
+;;======================================================================
+;; Orphaned functions
+;;======================================================================
+
+;; was in setup
+;;
+(define (s:log . msg)
+  (apply session:log s:session msg))
+
+
+;; Usage: (s:get-err s:big)
+(define (s:get-err wrapperfunc)
+  (let ((errmsg (sdat-curr-err s:session)))
+    (if errmsg ((if wrapperfunc
+                    wrapperfunc
+                    s:strong) errmsg) '())))
+(define (stml:cgi-session session #!optional (configf #f))
+  ;; (session:initialize session)
+  (session:setup session configf)
+  (session:get-vars session)
+
+  (sdat-log-port-set! session ;; (current-error-port))
+		      (open-output-file (sdat-logfile session) #:append))
+  (s:validate-inputs)
+  (change-directory (sdat-sroot session))
+  (session:run-actions session)
+  (sdat-pagedat-set! session
+		     (append (sdat-pagedat session)
+			     (s:call (sdat-toppage session))))
+  (if (eq? (sdat-page-type session) 'html) ;; default is html. 
+      (session:cgi-out session)
+      (session:alt-out session))
+  (session:save-vars session)
+  (session:close session))
+
+
+(define (s:validate-inputs)
+  (if (not (s:validate-uri))
+      (begin (s:error-page "Bad URI" (let ((ref (get-environment-variable "HTTP_REFERER")))
+				       (if ref
+					   (list "referred from" ref)
+					   "")))
+	     (exit))))
+
+(define (s:error-page . err)
+  (s:cgi-out (cons "Content-type: text/html; charset=iso-8859-1\n\n"
+		   (s:html (s:head 
+			    (s:title err)
+			    (s:body
+			     (s:h1 "ERROR")
+			     (s:p err)))))))           
+
+
+(define (stml:main proc #!optional (configf #f))
+  (handle-exceptions
+   exn   
+   (if (sdat-debug-mode s:session)
+       (begin
+	 (print "Content-type: text/html")
+	 (print "")
+	 (print "<html> <head> <title>EXCEPTION</title> </head> <body>")
+	 (print "   QUERY_STRING is: <b> " (get-environment-variable "QUERY_STRING") " </b> <br>")
+	 (print "<pre>")
+	 ;; (print "   EXCEPTION: " ((condition-property-accessor 'exn 'message) exn))
+	 (print-error-message exn)
+	 (print-call-chain)
+	 (print "</pre>")
+	 (print "<table>")
+	 (for-each (lambda (var)
+		     (print "<tr><td>" (car var) "</td><td>" (cdr var) "</td></tr>"))
+		   (get-environment-variables))
+	 (print "</table>")
+	 (print "</body></html>"))
+       (begin
+	 (with-output-to-file (conc "/tmp/stml-crash-" (current-process-id) ".log")
+	   (lambda ()
+	     (print "EXCEPTION")
+	     (print "   QUERY_STRING is: " (get-environment-variable "QUERY_STRING") )
+	     (print "")
+	     ;; (print "   EXCEPTION: " ((condition-property-accessor 'exn 'message) exn))
+	     (print-error-message exn)
+	     (print-call-chain)
+	     (print "")
+	     (for-each (lambda (var)
+			 (print (car var) "\t" (cdr var)))
+		       (get-environment-variables))))
+	 ;; return something useful to the user
+	 (print "Content-type: text/html")
+	 (print "")
+	 (print "<html> <head> <title>EXCEPTION</title> </head> <body>")
+	 (print "<h1>CRASH!</h1>")
+	 (print "   Please notify support at " (sdat-domain s:session) " that the error log is stml-crash-" (current-process-id) ".log</b> <br>")
+	 ;; (print "<pre>")
+	 ;; ;; (print "   EXCEPTION: " ((condition-property-accessor 'exn 'message) exn))
+	 ;; ;; (print-error-message exn)
+	 ;; ;; (print-call-chain)
+	 ;; (print "</pre>")
+	 ;; (print "<table>")
+	 ;; (for-each (lambda (var)
+	 ;; 	     (print "<tr><td>" (car var) "</td><td>" (cdr var) "</td></tr>"))
+	 ;; 	   (get-environment-variables))
+	 ;; (print "</table>")
+	 (print "</body></html>")))
+   (if proc (proc s:session) (stml:cgi-session s:session configf))
+ ;; (raise-error)
+ ;; (exit)
+   ))
+
+;; find out if we are in debugmode
+(define (s:debug-mode?)
+  (sdat-debug-mode s:session))
+
+(define (s:never-called-page? page)
+  (session:never-called-page? s:session page))
+
+(define (s:set-err . args)
+  (sdat-curr-err-set! s:session args))
+
+(define (s:current-page)
+  (sdat-page s:session))
+
+(define (s:delete-session)
+  (session:delete-session s:session (sdat-session-key s:session)))
+
+(define (s:call page . partsl)
+  (if (null? partsl)
+      (session:call s:session page #f)
+      (session:call s:session page (car partsl))))
+
+(define (s:link-to page . params)
+  (session:link-to s:session page params))
+
+(define (s:get-param key . type-params)
+  (session:get-param s:session key type-params))
+
+;; these are page local
+(define (s:get key) 
+  (session:page-get s:session key))
+
+(define (s:set! key val)
+  (session:curr-page-set! s:session key val))
+
+(define (s:del! key)
+  (session:page-var-del! s:session key))
+
+#;(define (s:get-n-del! key)
+  (let ((val (session:page-get s:session key)))
+    (session:del! s:session val key)
+    val))
+
+;; these are session wide
+(define (s:session-var-get key . params) 
+  (session:get s:session "*sessionvars*" key params))
+
+(define (s:session-var-set! key val)
+  (session:set! s:session "*sessionvars*" key val))
+
+(define (s:session-var-get-n-del! key)
+  (let ((val (session:page-get s:session key)))
+     (session:del! s:session "*sessionvars*" key)
+     val))
+
+(define (s:session-var-del! key)
+  (session:del! s:session "*sessionvars*" key))
+
+(define s:session-var-delete! s:session-var-del!)
+
+;; utility to get all vars as hash table
+(define (s:session-get-sessionvars)
+  (sdat-sessionvars s:session))
+
+;;======================================================================
+;; Sugar
+;;======================================================================
+;;
+;; (require 'syntax-case)
+;; 
+;; (define-syntax s:if-param
+;;   (syntax-rules ()
+;;     [(_ s x)   (if (s:get s) x (s:comment "s:if not"))]
+;;     [(_ s x y) (if (s:get s) x y)]))
+;; ;; 
+;; (define-syntax s:if-test
+;;   (syntax-rules ()
+;;     [(_ s x) (if   (string=? "yep" s)   x (list "s:if not"))]
+;;     [(_ s x y) (if (string=? "yep" s) x y)]))
+
+;; Some of these routines use:
+;;
+;;     http://www.cs.toronto.edu/~gfb/scheme/simple-macros.html
+;;
+;; Syntax for defining macros in a simple style similar to function definiton,
+;;  when there is a single pattern for the argument list and there are no keywords.
+;;
+;; (define-simple-syntax (name arg ...) body ...)
+;;
+
+(define-syntax define-simple-syntax
+  (syntax-rules ()
+    ((_ (name arg ...) body ...)
+     (define-syntax name (syntax-rules () ((name arg ...) (begin body ...)))))))
+
+;;======================================================================
+;; syntatic sugar items
+;;======================================================================
+
+;; We often seem to want to include stuff if a conditional is met
+;; otherwise not include it. This routine makes that slightly cleaner
+;; since using a pure if results in #<undefined> objects. (admittedly they 
+;; should be ignored but this is slightly cleaner I think). 
+;;
+;; NOTE: This has to be a macro or the true clause will be evaluated 
+;; whether "a" is true or false
+
+;; If a is true return b, else return '()
+(define-simple-syntax (s:if a b)
+  (if a b '()))
+
+
+;; Using the Simple-Syntax System
+;; 
+;; The syntax for defining macros in this system is similar to that for defining functions. In fact if the macro has a fixed number of arguments the syntax is identical. For example:
+;; 
+;;   ; Define a simple macro to add a value to a variable.
+;;   ;
+;;   (define-simple-syntax (+= variable value)
+;;     (set! variable (+ variable value)))
+;; 
+;;   ; Use it.
+;;   ;
+;;   (define v 2)
+;;   (+= v 7)
+;;   v ; => 9
+;; 
+;; For a fixed number of arguments followed by an unknown number of arguments we use ... after a single argument to represent the unknown number (possibly zero) of arguments. For example, let's revise our definition of += to allow zero or more values to be added:
+;; 
+;;   ; Define a simple macro to add a zero or more values to a variable
+;;   ;
+;;   (define-simple-syntax (+= variable value ...)
+;;     (set! variable (+ variable value ...)))
+;; 
+;;   ; Use it
+;;   ;
+;;   (define v 2)
+;;   (+= v 7)
+;;   v ; => 9
+;;   (+= v 3 4)
+;;   v ; => 16
+;;   (+= v)
+;;   v ; => 16
+;; 
+
+(define-simple-syntax (s:if-param varname first ...)
+  (if (s:get varname)
+      (begin
+	first
+	...)
+      '()))
+
+(define-simple-syntax (s:if-sessionvar varname first ...)
+  (if (s:session-var-get varname)
+      (begin
+	first
+	...)
+      '()))
+
+;; (define-macro (s:if-param varname ...)
+;;   (match dat
+;; 	 (()    '())
+;; 	 ((a)    `(if (s:get ,varname) ,a '()))
+;; 	 ((a b)  `(if (s:get ,varname) ,a ,b))))
+;; 
+;; (define-macro (s:if-sessionvar varname . dat)
+;;   (match dat
+;; 	 (()    '())
+;; 	 ((a)    `(if (s:session-var-get ,varname) ,a '()))
+;; 	 ((a b)  `(if (s:session-var-get ,varname) ,a ,b))))
+;; 
+
+)

ADDED   stml2/stml2.setup
Index: stml2/stml2.setup
==================================================================
--- /dev/null
+++ stml2/stml2.setup
@@ -0,0 +1,32 @@
+;; Copyright 2007-2010, 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 FITNlmESS FOR A PARTICULAR
+;;  PURPOSE.
+
+;;;; margs.setup
+
+;; compile the code into a dynamically loadable shared object
+;; (will generate margs.so)
+;; (compile -s margs.scm)
+
+;; Install as extension library
+
+;; handle cookies
+(standard-extension 'cookie       "0.5")
+;; (standard-extension 'stmlcommon   "0.5")
+(standard-extension 'stml2        "0.5")
+
+;; (standard-extension 'session      "0.5")
+;; (standard-extension 'misc-stml    "0.5") ;; moved to stmlcommon.scm
+;; (standard-extension 'html-filter  "0.5") ;; moved to stmlcommon.scm
+;; (standard-extension 'formdat      "0.5") ;; moved into stmlcommon.scm
+;; (standard-extension 'setup        "0.5") ;; moved into stmlcommon.scm
+;; (standard-extension 'keystore     "0.5") ;; moved into stmlcommon.scm
+;; (standard-extension 'sqltbl       "0.5") ;; eliminated
+
+;; (install-extension 'stml "stml.so")
+

ADDED   stml2/stmlcommon.scm
Index: stml2/stmlcommon.scm
==================================================================
--- /dev/null
+++ stml2/stmlcommon.scm
@@ -0,0 +1,20 @@
+;; Copyright 2007-2011, 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.
+
+;; (require-extension syntax-case)
+;; (declare (run-time-macros))
+
+(module stmlcommon
+    *
+
+(import  chicken scheme data-structures extras srfi-13 ports posix)
+
+(use (prefix dbi dbi:) regex (prefix crypt c:) srfi-69)
+
+)

ADDED   stml2/stmlmodule.scm
Index: stml2/stmlmodule.scm
==================================================================
--- /dev/null
+++ stml2/stmlmodule.scm
@@ -0,0 +1,14 @@
+;; Copyright 2007-2011, 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.
+
+;; (require-extension syntax-case)
+;; (declare (run-time-macros))
+
+(include "stmlcommon.scm")
+

ADDED   stml2/stmlrun.scm
Index: stml2/stmlrun.scm
==================================================================
--- /dev/null
+++ stml2/stmlrun.scm
@@ -0,0 +1,19 @@
+#!/usr/local/bin/csi -q
+
+;; Copyright 2007-2011, 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.
+
+;; (require-extension syntax-case)
+;; (declare (run-time-macros))
+
+;; (include "stmlcommon.scm")
+(require-library stml)
+
+
+(stml:main #f)

ADDED   stml2/sugar.scm
Index: stml2/sugar.scm
==================================================================
--- /dev/null
+++ stml2/sugar.scm
@@ -0,0 +1,113 @@
+;; Copyright 2007-2011, 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.
+;;
+
+;;======================================================================
+;; Sugar
+;;======================================================================
+;;
+;; (require 'syntax-case)
+;; 
+;; (define-syntax s:if-param
+;;   (syntax-rules ()
+;;     [(_ s x)   (if (s:get s) x (s:comment "s:if not"))]
+;;     [(_ s x y) (if (s:get s) x y)]))
+;; ;; 
+;; (define-syntax s:if-test
+;;   (syntax-rules ()
+;;     [(_ s x) (if   (string=? "yep" s)   x (list "s:if not"))]
+;;     [(_ s x y) (if (string=? "yep" s) x y)]))
+
+;; Some of these routines use:
+;;
+;;     http://www.cs.toronto.edu/~gfb/scheme/simple-macros.html
+;;
+;; Syntax for defining macros in a simple style similar to function definiton,
+;;  when there is a single pattern for the argument list and there are no keywords.
+;;
+;; (define-simple-syntax (name arg ...) body ...)
+;;
+
+(define-syntax define-simple-syntax
+  (syntax-rules ()
+    ((_ (name arg ...) body ...)
+     (define-syntax name (syntax-rules () ((name arg ...) (begin body ...)))))))
+
+;;======================================================================
+;; syntatic sugar items
+;;======================================================================
+
+;; We often seem to want to include stuff if a conditional is met
+;; otherwise not include it. This routine makes that slightly cleaner
+;; since using a pure if results in #<undefined> objects. (admittedly they 
+;; should be ignored but this is slightly cleaner I think). 
+;;
+;; NOTE: This has to be a macro or the true clause will be evaluated 
+;; whether "a" is true or false
+
+;; If a is true return b, else return '()
+(define-simple-syntax (s:if a b)
+  (if a b '()))
+
+
+;; Using the Simple-Syntax System
+;; 
+;; The syntax for defining macros in this system is similar to that for defining functions. In fact if the macro has a fixed number of arguments the syntax is identical. For example:
+;; 
+;;   ; Define a simple macro to add a value to a variable.
+;;   ;
+;;   (define-simple-syntax (+= variable value)
+;;     (set! variable (+ variable value)))
+;; 
+;;   ; Use it.
+;;   ;
+;;   (define v 2)
+;;   (+= v 7)
+;;   v ; => 9
+;; 
+;; For a fixed number of arguments followed by an unknown number of arguments we use ... after a single argument to represent the unknown number (possibly zero) of arguments. For example, let's revise our definition of += to allow zero or more values to be added:
+;; 
+;;   ; Define a simple macro to add a zero or more values to a variable
+;;   ;
+;;   (define-simple-syntax (+= variable value ...)
+;;     (set! variable (+ variable value ...)))
+;; 
+;;   ; Use it
+;;   ;
+;;   (define v 2)
+;;   (+= v 7)
+;;   v ; => 9
+;;   (+= v 3 4)
+;;   v ; => 16
+;;   (+= v)
+;;   v ; => 16
+;; 
+
+(define-simple-syntax (s:if-param varname first ...)
+  (if (s:get varname)
+      first
+      ...))
+
+(define-simple-syntax (s:if-sessionvar varname first ...)
+  (if (s:session-var-get varname)
+      first
+      ...))
+
+;; (define-macro (s:if-param varname ...)
+;;   (match dat
+;; 	 (()    '())
+;; 	 ((a)    `(if (s:get ,varname) ,a '()))
+;; 	 ((a b)  `(if (s:get ,varname) ,a ,b))))
+;; 
+;; (define-macro (s:if-sessionvar varname . dat)
+;;   (match dat
+;; 	 (()    '())
+;; 	 ((a)    `(if (s:session-var-get ,varname) ,a '()))
+;; 	 ((a b)  `(if (s:session-var-get ,varname) ,a ,b))))
+;; 

ADDED   stml2/test.scm
Index: stml2/test.scm
==================================================================
--- /dev/null
+++ stml2/test.scm
@@ -0,0 +1,22 @@
+(use test md5)
+
+(require-extension sqlite3)
+(import (prefix sqlite3 sqlite3:))
+
+(require-library dbi)
+
+;; (declare (uses stml))
+
+(include "requirements.scm")
+(include "cookie.scm")
+(include "misc-stml.scm")
+(include "formdat.scm")
+(include "stml.scm")
+(include "session.scm")
+(include "sqltbl.scm")
+(include "html-filter.scm")
+(include "keystore.scm")
+
+(define p (open-input-file "test.stml"))
+(print (process-port p))
+(close-input-port p)

ADDED   stml2/test.stml
Index: stml2/test.stml
==================================================================
--- /dev/null
+++ stml2/test.stml
@@ -0,0 +1,10 @@
+;; Copyright 2007-2008, Matthew Welland. Kiatoa.com All rights reserved.
+;; 
+;; index
+
+(list
+ (s:html
+  (s:head
+   (s:title "Kiatoa")
+   (s:link  'rel "stylesheet" 'type "text/css" 'href "/kiatoa/markup.css")
+   (s:link  'rel "stylesheet" 'type "text/css" 'href "/kiatoa/layout.css"))))

ADDED   stml2/tests/example.post.binary.in
Index: stml2/tests/example.post.binary.in
==================================================================
--- /dev/null
+++ stml2/tests/example.post.binary.in
cannot compute difference between binary files

ADDED   stml2/tests/example.post.in
Index: stml2/tests/example.post.in
==================================================================
--- /dev/null
+++ stml2/tests/example.post.in
@@ -0,0 +1,1 @@
+email-address=matt%3A1&password=Blah&form-name=login

ADDED   stml2/tests/models/test.scm
Index: stml2/tests/models/test.scm
==================================================================
--- /dev/null
+++ stml2/tests/models/test.scm
@@ -0,0 +1,11 @@
+;; Copyright 2007-2008, 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.
+;;
+
+;; models/test.scm

ADDED   stml2/tests/pages/test/control.scm
Index: stml2/tests/pages/test/control.scm
==================================================================
--- /dev/null
+++ stml2/tests/pages/test/control.scm
@@ -0,0 +1,11 @@
+;; Copyright 2007-2008, 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.
+;;
+
+;; pages/test/control.scm

ADDED   stml2/tests/pages/test/view.scm
Index: stml2/tests/pages/test/view.scm
==================================================================
--- /dev/null
+++ stml2/tests/pages/test/view.scm
@@ -0,0 +1,11 @@
+;; Copyright 2007-2008, 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.
+;;
+
+;; pages/test/view.scm

ADDED   stml2/tests/test.scm
Index: stml2/tests/test.scm
==================================================================
--- /dev/null
+++ stml2/tests/test.scm
@@ -0,0 +1,225 @@
+#!/usr/local/bin/csi -q 
+
+;; Copyright 2007-2008, 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 test md5)
+
+(require-extension sqlite3)
+(import (prefix sqlite3 sqlite3:))
+
+;; (require-library dbi)
+(use (prefix dbi dbi:))
+
+(load "./requirements.scm")
+(load "./cookie.scm")
+(load "./misc-stml.scm")
+(load "./formdat.scm")
+(load "./stml.scm")
+(load "./session.scm")
+(load "./sqltbl.scm")
+(load "./html-filter.scm")
+(load "./keystore.scm")
+
+;; Test the primitive dbi interface
+
+(system "rm -f tests/test.db")
+(define db (dbi:open 'sqlite3 '((dbname . "tests/test.db"))))
+(dbi:exec db "CREATE TABLE foo(id INTEGER PRIMARY KEY,name TEXT);")
+(dbi:exec db "INSERT INTO foo(name) VALUES(?);" "Matt")
+(dbi:for-each-row 
+ (lambda (tuple)
+   (print (vector-ref tuple 0) " " (vector-ref tuple 1)))
+ db "SELECT * FROM foo;")
+(test "dbi:get-one" "Matt" (dbi:get-one db "SELECT name FROM foo WHERE name='Matt';"))
+
+;; keystore
+(dbi:exec db "CREATE TABLE metadata (id INTEGER PRIMARY KEY,key TEXT,value TEXT);")
+
+(keystore:set! db "SCHEMA-VERSION" 1.2)
+(test "Keystore get" "1.2"  (keystore:get  db "SCHEMA-VERSION"))
+(keystore:del! db "SCHEMA-VERSION") 
+(test "Keystore get deleted" #f (keystore:get db "SCHEMA-VERSION"))
+
+(system "rm -f tests/test.db")
+
+;; create a session to work with")
+(setenv "REQUEST_URI" "/stmlrun?action=test.test")
+(setenv "SCRIPT_NAME" "/cgi-bin/stmlrun")
+(setenv "PATH_INFO" "/test")
+(setenv "QUERY_STRING" "action=test.test")
+(setenv "SERVER_NAME" "localhost")
+(setenv "REQUEST_METHOD" "GET")
+
+(load "./setup.scm")
+
+(s:validate-inputs)
+
+;; test session variables
+
+(session:get-vars s:session)
+(define nada "andnndhhshaas")
+(s:session-var-set! "nick" nada)
+(test "Session var set/get" nada  (s:session-var-get "nick"))
+(print "got here")
+(session:save-vars s:session)
+(session:get-vars  s:session)
+(test "Session var set/get after save/get" nada (s:session-var-get "nick"))
+(session:del! s:session "*sessionvars*" "nick")
+(test "Session var del"                    #f   (s:session-var-get "nick"))
+(session:save-vars s:session)
+(session:get-vars s:session)
+(s:session-var-set! "nick" nada)
+(session:save-vars s:session)
+
+;; (test "Session var del"                    #f   (s:session-var-get "nick"))
+
+;; test person
+
+(load "./tests/models/test.scm")
+
+(print "Session key is " (sdat-get-session-key s:session))
+
+(test "Delete session" #t (s:delete-session))
+
+(let ((fh (open-input-pipe "ls ./tests/pages/*/control.scm")))
+  (let loop ((l (read-line fh)))
+    (if (not (eof-object? l))
+        (begin
+          ;; (print "loading " l)
+          (load l)
+          (loop (read-line fh)))))
+  (close-input-port fh))
+
+;; Should have poll:poll defined now.
+(test "Make a random string" 2 (string-length (session:make-rand-string 2)))
+(test "Create an encrypted password using DES (backwards compat)" "abQ9KY.KfrYrc" (s:crypt-passwd "foo" "ab"))
+(test "Create an encrypted password using Blowfish" "$2a$12$GyoKHX/UOxMLGtwdSTr7EOF9KQzlyyyRqFTKx1YvLA3sMukbV4WBC" (s:crypt-passwd "foo" "$2a$12$GyoKHX/UOxMLGtwdSTr7EO"))
+
+(test "s:any->string on a hash-table" "#<hash-table>" (s:any->string (make-hash-table)))
+
+(define select-list
+  '((a b c)(d (e f g)(h i j #t))))
+(define result '("<SELECT name=\"efg\">" 
+		 ((("<OPTION label=\"a\" value=\"b\">c</OPTION>") 
+		   ("<OPTGROUP label=d" 
+		    ("<OPTION label=\"e\" value=\"f\">g</OPTION>")
+		    ("<OPTION  selected label=\"h\" value=\"i\">j</OPTION>") 
+		    "</OPTGROUP>")))
+		 "</SELECT>"))
+
+(test "Select list" result (s:select select-list 'name "efg"))
+
+;; Test modules
+
+(test "misc:non-zero-string \"\"" #f (misc:non-zero-string ""))
+(test "misc:non-zero-string #f" #f (misc:non-zero-string #f))
+(test "misc:non-zero-string 'blah" #f (misc:non-zero-string 'blah))
+
+;; forms
+(define form #f)
+(test "make <formdat>" #t (let ((f (make-formdat:formdat)))
+			    (set! form f)
+			    #t))
+(test "formdat: set!/get" "Yep!" (begin
+				   (formdat:set! form "blah" "Yep!")
+				   (formdat:get  form "blah")))
+
+(test "s:string->pgint"   123 (s:any->pgint "123"))
+(test "s:illegal-pgint (legal)"        #f (s:illegal-pgint 1011))
+(test "s:illegal-pgint (illegal big)"   1 (s:illegal-pgint  9999999999))
+(test "s:illegalpgint (illegal small)" -1 (s:illegal-pgint -9999999999))
+
+;; The twiki module
+
+;; clean up
+(system "rm -rf twikis/*")
+(load "modules/twiki/twiki-mod.scm")
+(define keys (list "blah" 1 'nada))
+(test "twiki:keys->key"  "blah 1 nada" (twiki:keys->key keys))
+(define key (twiki:keys->key keys))
+
+(define *tdb* #f)
+(test "twiki:open-db"   #t (let ((db (twiki:open-db key)))
+			     (set! *tdb* db)
+			     (if *tdb* #t #f)))
+(define wiki (make-twiki:wiki))
+(twiki:wiki-set-wid! wiki 1)
+(twiki:wiki-set-name! wiki "main")
+(twiki:wiki-set-perms! wiki '(r w))
+
+(test "twiki:dat->html" '("Hello" "<BR>") (twiki:dat->html "Hello" wiki))
+(test "twiki:keys->fname" '("twikis/Ymxha/CAxIG/5hZGE" "YmxhaCAxIG5hZGE_") ;; ("twikis/d99a2de9/6808493b/23770f70" "d99a2de96808493b23770f70c76dffe4")
+      (twiki:key->fname key))
+
+(test "twiki:name->wid"     1     (twiki:name->wid *tdb* "main"))
+(test "twiki:get-tiddlers-by-num" '() (twiki:get-tiddlers-by-num  *tdb* 0 (list 1 2 3)))
+(test "twiki:get-tiddlers-by-name" '() (twiki:get-tiddlers-by-name *tdb* 0 "MainMenu"))
+(test "twiki:get-tiddlers"  '()  (twiki:get-tiddlers *tdb* 0 (list "MainMenu")))
+(test "twiki:get-tiddlers"  '()  (twiki:get-tiddlers *tdb* 0 (list "MainMenu" "AnotherOne")))
+(test "twiki:wiki" "<TABLE>"     (car (twiki:wiki "main" (list "blah" 1 'nada))))
+(test "twiki:view"  "<DIV class=\"node\">" (car (twiki:view "" "" 0 (twiki:tiddler-make) wiki)))
+
+(test "s:td"              '("<TD>" (()) "</TD>") (s:td '()))
+;; (test "twiki:get-tiddlers-by-name" '() (twiki:get-tiddlers-by-name 1 "fred"))
+(test "twiki:tiddler-name->id" 1 (twiki:tiddler-name->id *tdb* "MainMenu"))
+(test "s:set! a var to #f"     ""
+      (begin (s:set! "BLAH" #f)
+	     (s:get "BLAH"))) ;; don't know if this one makes sense. Setting to #f should really delete the value
+(test "twiki:save-dat"           2        (twiki:save-dat *tdb* "dat" 0))
+(test "twiki:get-dat"            "dat"    (twiki:get-dat *tdb* 2))
+(test "twiki:get-dat"            #f       (twiki:get-dat *tdb* 5))
+;; (test "twiki:get-dat"      #f    (twiki:get-dat *tdb* #f))
+(test "twiki:save-tiddler"       #t       (twiki:save-tiddler *tdb* "heading" "body" "tags" key 0))
+;; (test "twiki:save-curr-tiddler"  #f       (twiki:save-curr-tiddler *tdb* 1))
+(test "twiki:edit-twiddler"      #t       (list? (twiki:edit-tiddler *tdb* key 0 0)))
+(test "twiki:maint_area"         "<DIV>"  (car (twiki:maint_area *tdb* 1 key wiki)))
+(test "twiki:pic_mgmt"           "<DIV>"  (car (twiki:pic_mgmt *tdb* 1 key)))
+
+;; get a blob jpg to process
+(define inp2 (open-input-file "tests/kiatoa.png"))
+(define dat  (string->blob (read-string #f inp2)))
+(close-input-port inp2)
+
+
+(test "twiki:save-pic"           #t       (twiki:save-pic *tdb* (list "mypic.jpg" "image/jpeg" dat) 0)) ;; (string->blob "testing eh!")))) 
+;; (test "twiki:save-pic-from-form" #f       (twiki:save-pic-from-form *tdb* 1))
+
+;; more tests on dats
+
+(define dat #f)
+(let ((inp (open-input-file "tests/kiatoa.png")))
+  (set! dat (read-string #f inp))
+  (close-input-port inp))
+(use md5)
+(define dat-md5 (md5:digest dat))
+(test "twiki:save-dat (binary)" 4        (twiki:save-dat *tdb* dat 1))
+(test "twiki:get-dat (binary)"  dat-md5  (let ((d (twiki:get-dat *tdb* 4)))
+					   (md5:digest d)))
+;; forms
+;; (define inp (open-input-file "tests/example.post.in"))
+;; (define dat (read-string #f inp))
+;; (define datstr (open-input-string dat))
+
+;; binary inputs
+(define inp (open-input-file "tests/example.post.binary.in"))
+(define dat #f)
+
+(test "formdat:load-all-port multipart" #t (let ((idat (formdat:load-all-port inp)))
+				   (set! dat idat)
+				   #t))
+(test "formdat:keys" '(picture-name input-picture "" submit-picture) (formdat:keys dat))
+
+(define inp (open-input-file "tests/example.post.in"))
+(test "formdat:load-all-port single part" #t (let ((idat (formdat:load-all-port inp)))
+				   (set! dat idat)
+				   #t))
+(test "formdat:keys" '(email-address form-name password) (formdat:keys dat))
+
+(close-input-port inp)

ADDED   stml2/testscript.sh
Index: stml2/testscript.sh
==================================================================
--- /dev/null
+++ stml2/testscript.sh
@@ -0,0 +1,7 @@
+export REQUEST_URI='/stmlrun?action=login.login'
+export SCRIPT_NAME=/cgi-bin/stmlrun
+export PATH_INFO=/classifieds
+export QUERY_STRING='action=login.login'
+export SERVER_NAME=localhost
+export REQUEST_METHOD=GET
+export HTTP_COOKIE='session_key=to09ipFJ9_2KXT96b2f9Q'

Index: subrun.scm
==================================================================
--- subrun.scm
+++ subrun.scm
@@ -43,15 +43,17 @@
   (if (and (common:file-exists? (conc test-run-dir "/subrun-area") )
            (common:file-exists? (conc test-run-dir "/testconfig.subrun") ))
       #t
       #f))
 
-(define (subrun:launch-dashboard test-run-dir)
+(define (subrun:launch-dashboard test-run-dir #!key (target #f)(runname #f))
   (if (subrun:subrun-test-initialized? test-run-dir)
-      (let* ((subarea (subrun:get-runarea test-run-dir)))
+      (let* ((subarea (subrun:get-runarea test-run-dir))
+	     (params  (conc (if target (conc " -target " target) "")
+			    (if runname (conc " -runname " runname) ""))))
         (if (and subarea (common:file-exists? subarea))
-            (system (conc "cd " subarea ";env -i PATH=$PATH DISPLAY=$DISPLAY HOME=$HOME USER=$USER dashboard &"))))))
+            (system (conc "cd " subarea ";env -i PATH=$PATH DISPLAY=$DISPLAY HOME=$HOME USER=$USER nbfake dashboard " params))))))
 
 (define (subrun:subrun-removed? test-run-dir)
   (if (subrun:subrun-test-initialized? test-run-dir)
       (let ((flagfile (conc test-run-dir "/subrun.removed")))
         (if (common:file-exists? flagfile)
@@ -209,11 +211,14 @@
                          (cons "-log" logfile)
                          (map (lambda (item)
                                 (if (equal? (car item) "-testpatt")
                                     (cons "-testpatt" testpatt)
                                     item))
-                                switch-alist-pre))))
+                              switch-alist-pre))))
+    (with-output-to-file "subrun-command-parts.sexp"
+      (lambda ()
+	(pp switch-alist)))
     switch-alist))
     ;; note - get precmd from subrun section
     ;;   apply to submegatest commands
 
 (define (subrun:get-log-path test-run-dir log-prefix)

Index: tasks.scm
==================================================================
--- tasks.scm
+++ tasks.scm
@@ -73,11 +73,11 @@
 		    (configf:lookup *configdat* "setup" "dbdir")
 		    (conc (common:get-linktree) "/.db"))))
     (handle-exceptions
      exn
      (begin
-       (debug:print-error 0 *default-log-port* "Couldn't create path to " dbdir)
+       (debug:print-error 0 *default-log-port* "Couldn't create path to " dbdir ", exn=" exn)
        (exit 1))
      (if (not (directory? dbdir))(create-directory dbdir #t)))
     dbdir))
 
 ;; If file exists AND
@@ -443,23 +443,23 @@
   (db:with-db
    dbstruct #f #t
    (lambda (db)
      (sqlite3:execute db (conc "DELETE FROM tasks_queue WHERE id IN (" task-ids ");")))))
 
-#;(define (tasks:process-queue dbstruct)
-  (let* ((task   (tasks:snag-a-task dbstruct))
-	 (action (if task (tasks:task-get-action task) #f)))
-    (if action (print "tasks:process-queue task: " task))
-    (if action
-	(case (string->symbol action)
-	  ((run)       (tasks:start-run     dbstruct task))
-	  ((remove)    (tasks:remove-runs   dbstruct task))
-	  ((lock)      (tasks:lock-runs     dbstruct task))
-	  ;; ((monitor)   (tasks:start-monitor db task))
-	  #;((rollup)    (tasks:rollup-runs   dbstruct task))
-	  ((updatemeta)(tasks:update-meta   dbstruct task))
-	  #;((kill)      (tasks:kill-monitors dbstruct task))))))
+;; (define (tasks:process-queue dbstruct)
+;;   (let* ((task   (tasks:snag-a-task dbstruct))
+;; 	 (action (if task (tasks:task-get-action task) #f)))
+;;     (if action (print "tasks:process-queue task: " task))
+;;     (if action
+;; 	(case (string->symbol action)
+;; 	  ((run)       (tasks:start-run     dbstruct task))
+;; 	  ((remove)    (tasks:remove-runs   dbstruct task))
+;; 	  ((lock)      (tasks:lock-runs     dbstruct task))
+;; 	  ;; ((monitor)   (tasks:start-monitor db task))
+;; 	  #;((rollup)    (tasks:rollup-runs   dbstruct task))
+;; 	  ((updatemeta)(tasks:update-meta   dbstruct task))
+;; 	  #;((kill)      (tasks:kill-monitors dbstruct task))))))
 
 (define (tasks:tasks->text tasks)
   (let ((fmtstr "~10a~10a~10a~12a~20a~12a~12a~10a"))
     (conc (format #f fmtstr "id" "action" "owner" "state" "target" "runname" "testpatts" "params") "\n"
 	  (string-intersperse 
@@ -742,11 +742,11 @@
 ;;
 (define (tasks:run-id->mtpg-run-id dbh cached-info run-id area-info smallest-last-update-time)
   (let* ((runs-ht (hash-table-ref cached-info 'runs))
 	 (runinf  (hash-table-ref/default runs-ht run-id #f))
          (area-id (vector-ref area-info 0)))
-       (if runinf
+    (if runinf
 	runinf ;; already cached
 	(let* ((run-dat    (rmt:get-run-info run-id))               ;; NOTE: get-run-info returns a vector < row header >
 	       (run-name   (rmt:get-run-name-from-id run-id))
 	       (row        (db:get-rows run-dat))                   ;; yes, this returns a single row
 	       (header     (db:get-header run-dat))
@@ -755,65 +755,65 @@
 	       (owner      (db:get-value-by-header row header "owner"))
 	       (event-time (db:get-value-by-header row header "event_time"))
 	       (comment    (db:get-value-by-header row header "comment"))
 	       (fail-count (db:get-value-by-header row header "fail_count"))
 	       (pass-count (db:get-value-by-header row header "pass_count"))
-         (db-contour (db:get-value-by-header row header "contour"))
+	       (db-contour (db:get-value-by-header row header "contour"))
 	       (contour    (if (args:get-arg "-prepend-contour") 
-                                 (if (and db-contour (not (equal? db-contour ""))  (string? db-contour )) 
-                                           (begin 
-                                            (debug:print-info 1 *default-log-port*  "db-contour") 
- 						db-contour)
-					    (args:get-arg "-contour"))))
-         (run-tag (if (args:get-arg "-run-tag")
+			       (if (and db-contour (not (equal? db-contour ""))  (string? db-contour )) 
+				   (begin 
+				     (debug:print-info 1 *default-log-port*  "db-contour") 
+				     db-contour)
+				   (args:get-arg "-contour"))))
+	       (run-tag (if (args:get-arg "-run-tag")
                             (args:get-arg "-run-tag")
-									""))
-         (last-update (db:get-value-by-header row header "last_update"))
+			    ""))
+	       (last-update (db:get-value-by-header row header "last_update"))
 	       (keytarg    (if (or (args:get-arg "-prepend-contour") (args:get-arg "-prefix-target"))
-	       			(conc "MT_CONTOUR/MT_AREA/" (string-intersperse (rmt:get-keys) "/")) (string-intersperse (rmt:get-keys) "/"))) ;; e.g. version/iteration/platform
+			       (conc "MT_CONTOUR/MT_AREA/" (string-intersperse (rmt:get-keys) "/")) (string-intersperse (rmt:get-keys) "/"))) ;; e.g. version/iteration/platform
 	       (target     (if (or (args:get-arg "-prepend-contour") (args:get-arg "-prefix-target")) 
-	       			(conc (or (args:get-arg "-prefix-target") (conc contour "/" (common:get-area-name) "/")) (rmt:get-target run-id)) (rmt:get-target run-id)))                 ;; e.g. v1.63/a3e1/ubuntu
+			       (conc (or (args:get-arg "-prefix-target") (conc contour "/" (common:get-area-name) "/")) (rmt:get-target run-id)) (rmt:get-target run-id)))                 ;; e.g. v1.63/a3e1/ubuntu
 	       (spec-id    (pgdb:get-ttype dbh keytarg))
 	       (publish-time (if (args:get-arg "-cp-eventtime-to-publishtime")
-                            event-time
-                           (current-seconds))) 
+				 event-time
+				 (current-seconds))) 
 	       (new-run-id (pgdb:get-run-id dbh spec-id target run-name area-id)))
-         (if new-run-id
-	         (begin ;; let ((run-record (pgdb:get-run-info dbh new-run-id))
-		        (hash-table-set! runs-ht run-id new-run-id)
+	  (if new-run-id
+	      (begin ;; let ((run-record (pgdb:get-run-info dbh new-run-id))
+		(hash-table-set! runs-ht run-id new-run-id)
 		;; ensure key fields are up to date
-     ;; if last_update == pgdb_last_update do not update smallest-last-update-time  
-    (let* ((pgdb-last-update (pgdb:get-run-last-update dbh new-run-id))
-           (smallest-time (hash-table-ref/default smallest-last-update-time "smallest-time" #f)))
-     (if (and  (> last-update pgdb-last-update) (or (not smallest-time) (< last-update smallest-time)))
-        (hash-table-set! smallest-last-update-time "smallest-time" last-update)))
+		;; if last_update == pgdb_last_update do not update smallest-last-update-time  
+		(let* ((pgdb-last-update (pgdb:get-run-last-update dbh new-run-id))
+		       (smallest-time (hash-table-ref/default smallest-last-update-time "smallest-time" #f)))
+		  (if (and  (> last-update pgdb-last-update) (or (not smallest-time) (< last-update smallest-time)))
+		      (hash-table-set! smallest-last-update-time "smallest-time" last-update)))
 		(pgdb:refresh-run-info
 		 dbh
 		 new-run-id
 		 state status owner event-time comment fail-count pass-count area-id last-update publish-time)
-     (debug:print-info 0 *default-log-port* "Working on run-id " run-id " pgdb-id "  new-run-id )
-     (if (not (equal? run-tag ""))
-      (task:add-run-tag dbh new-run-id run-tag))
+		(debug:print-info 0 *default-log-port* "Working on run-id " run-id " pgdb-id "  new-run-id )
+		(if (not (equal? run-tag ""))
+		    (task:add-run-tag dbh new-run-id run-tag))
 		new-run-id) 
-      
+	      
 	      (if (equal? state "deleted")
-          (begin 
-          (debug:print-info 1 *default-log-port*  "Warning: Run with id " run-id " was created after previous sync and deleted before the sync") #f)
-          (if (handle-exceptions
-		        exn
-		        (begin (print-call-chain)
-              (print ((condition-property-accessor 'exn 'message) exn))     
+		  (begin 
+		    (debug:print-info 1 *default-log-port*  "Warning: Run with id " run-id " was created after previous sync and deleted before the sync") #f)
+		  (if (handle-exceptions
+		       exn
+		       (begin (print-call-chain)
+			      (print ((condition-property-accessor 'exn 'message) exn))     
 			      #f)
-            
-            (pgdb:insert-run
-		     dbh
-		     spec-id target run-name state status owner event-time comment fail-count pass-count  area-id last-update publish-time))
-		       (let* ((smallest-time (hash-table-ref/default smallest-last-update-time "smallest-time" #f)))
-             (if (or (not smallest-time) (< last-update smallest-time))
-        				(hash-table-set! smallest-last-update-time "smallest-time" last-update))
-             (tasks:run-id->mtpg-run-id dbh cached-info run-id area-info smallest-last-update-time))
-		  #f)))))))
+		       
+		       (pgdb:insert-run
+			dbh
+			spec-id target run-name state status owner event-time comment fail-count pass-count  area-id last-update publish-time))
+		      (let* ((smallest-time (hash-table-ref/default smallest-last-update-time "smallest-time" #f)))
+			(if (or (not smallest-time) (< last-update smallest-time))
+			    (hash-table-set! smallest-last-update-time "smallest-time" last-update))
+			(tasks:run-id->mtpg-run-id dbh cached-info run-id area-info smallest-last-update-time))
+		      #f)))))))
 
 (define (task:add-run-tag dbh run-id tag) 
   (let* ((tag-info (pgdb:get-tag-info-by-name dbh tag)))
    (if (not tag-info)
      (begin   
@@ -1015,11 +1015,11 @@
 (define (tasks:sync-run-data dbh cached-info run-ids area-info smallest-last-update-time) 
   (for-each
      (lambda (run-id)
       (debug:print-info 1 *default-log-port*   "Check if run with " run-id " needs to be synced" )
        (tasks:run-id->mtpg-run-id dbh cached-info run-id area-info smallest-last-update-time))
-run-ids))
+     run-ids))
 
 
 ;; get runs changed since last sync
 ;; (define (tasks:sync-test-data dbh cached-info area-info)
 ;;   (let* ((

Index: tcmt.scm
==================================================================
--- tcmt.scm
+++ tcmt.scm
@@ -29,12 +29,13 @@
 ;; (trace-call-sites #t)
 
 (declare (uses margs))
 (declare (uses rmt))
 (declare (uses common))
-(declare (uses megatest-version))
+;; (declare (uses megatest-version))
 
+(include "megatest-version.scm")
 (include "megatest-fossil-hash.scm")
 (include "db_records.scm")
 
 (define origargs (cdr (argv)))
 (define remargs (args:get-args

Index: tests.scm
==================================================================
--- tests.scm
+++ tests.scm
@@ -20,14 +20,10 @@
 
 ;;======================================================================
 ;; Tests
 ;;======================================================================
 
-(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking tcp directory-utils)
-(import (prefix sqlite3 sqlite3:))
-(require-library stml)
-
 (declare (unit tests))
 (declare (uses lock-queue))
 (declare (uses db))
 (declare (uses tdb))
 (declare (uses common))
@@ -34,10 +30,15 @@
 ;; (declare (uses dcommon)) ;; needed for the steps processing
 (declare (uses items))
 (declare (uses runconfig))
 ;; (declare (uses sdb))
 (declare (uses server))
+;;(declare (uses stml2))
+
+(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking tcp directory-utils)
+(import (prefix sqlite3 sqlite3:))
+(use stml2)
 
 (include "common_records.scm")
 (include "key_records.scm")
 (include "db_records.scm")
 (include "run_records.scm")
@@ -271,24 +272,29 @@
            (new-patts (if (member waiton-test patts)
                           patts
                           (cons waiton-test patts))))
       (string-intersperse (delete-duplicates new-patts) ",")))))
 
+(define *glob-like-match-cache* (make-hash-table))
+(define (tests:cache-regexp str-in flag)
+  (let* ((key (conc str-in flag)))
+    (or (hash-table-ref/default *glob-like-match-cache* key #f)
+	(let* ((newrx (regexp str-in flag)))
+	  (hash-table-set! *glob-like-match-cache* key newrx)
+	  newrx))))
 
-  
 ;; tests:glob-like-match 
 (define (tests:glob-like-match patt str) 
-  (let ((like (substring-index "%" patt)))
-    (let* ((notpatt  (equal? (substring-index "~" patt) 0))
-	   (newpatt  (if notpatt (substring patt 1) patt))
-	   (finpatt  (if like
-			(string-substitute (regexp "%") ".*" newpatt #f)
-			(string-substitute (regexp "\\*") ".*" newpatt #f)))
-	   (res      #f))
-      ;; (print "tests:glob-like-match => notpatt: " notpatt ", newpatt: " newpatt ", finpatt: " finpatt)
-      (set! res (string-match (regexp finpatt (if like #t #f)) str))
-      (if notpatt (not res) res))))
+  (let* ((like     (substring-index "%" patt))
+	 (notpatt  (equal? (substring-index "~" patt) 0))
+	 (newpatt  (if notpatt (substring patt 1) patt))
+	 (finpatt  (if like
+		       (string-substitute (regexp "%") ".*" newpatt #f)
+		       (string-substitute (regexp "\\*") ".*" newpatt #f)))
+	 (rx       (tests:cache-regexp finpatt (if like #t #f)))
+	 (res      (string-match rx str)))
+    (if notpatt (not res) res)))
 
 ;; if itempath is #f then look only at the testname part
 ;;
 (define (tests:match patterns testname itempath #!key (required '()))
   (if (string? patterns)
@@ -546,11 +552,13 @@
 		  (tests:test-set-toplog! run-id test-name outputfilename))
 		;; didn't get the lock, check to see if current update started later than this 
 		;; update, if so we can exit without doing any work
 		(if (> my-start-time (handle-exceptions
 					 exn
-					 0
+				       (begin
+					 (print "failed to get mod time on " lockf ", exn=" exn)
+					 0)
 				       (file-modification-time lockf)))
 		    ;; we started since current re-gen in flight, delay a little and try again
 		    (begin
 		      (debug:print-info 1 *default-log-port* "Waiting to update " outputfilename ", another test currently updating it")
 		      (thread-sleep! (+ 5 (random 5))) ;; delay between 5 and 10 seconds
@@ -791,121 +799,121 @@
 ;; tests:genrate dashboard body 
 ;;
 
 (define (tests:dashboard-body page pg-size keys numkeys  total-runs linktree area-name get-prev-links get-next-links flag run-patt target-patt)
   (let* ((start (* page pg-size)) 
-	       ;(runsdat   (rmt:get-runs "%" pg-size start (map (lambda (x)(list x "%")) keys)))
+					;(runsdat   (rmt:get-runs "%" pg-size start (map (lambda (x)(list x "%")) keys)))
          (runsdat   (rmt:get-runs-by-patt  keys run-patt target-patt start pg-size #f 0 sort-order: "desc"))
-                    ; db:get-runs-by-patt   keys runnamepatt targpatt offset limit fields last-update   
-	       (header    (vector-ref runsdat 0))
-	       (runs      (vector-ref runsdat 1))
+					; db:get-runs-by-patt   keys runnamepatt targpatt offset limit fields last-update   
+	 (header    (vector-ref runsdat 0))
+	 (runs      (vector-ref runsdat 1))
          (ctr 0)
          (test-runs-hash (tests:get-rest-data runs header numkeys))
          (test-list (hash-table-keys test-runs-hash))) 
-  
-  (s:html tests:css-jscript-block (tests:css-jscript-block-cond flag)
-		   (s:title "Summary for " area-name)
-		   (s:body 'onload "addEvents();"
-                          (get-prev-links page linktree)
-                          (get-next-links page linktree total-runs)
-                           
-			   (s:h1 "Summary for " area-name)
-                           (s:h3 "Filter" )
-                           (s:input 'type "text"  'name "testname" 'id "testname" 'length "30" 'onkeyup "filtersome()")
-			   ;; top list
-         
-			   (s:table 'id "LinkedList1" 'border "1" 'cellspacing 0
-                            (map (lambda (key)
-				 (let* ((res (s:tr 'class "something" 
-				  (s:th key )
-                                   (map (lambda (run)
-                                   (s:th  (vector-ref run ctr)))
-                                  runs))))
-                             (set! ctr (+ ctr 1))
-                               res))
-                               keys)
-                               (s:tr
-				 (s:th "Run Name")
-                                  (map (lambda (run)
-                                   (s:th (db:get-value-by-header run header "runname")))
-                                  runs))
-                              
-                               (map (lambda (test-name)
-                                 (let* ((item-hash (hash-table-ref/default test-runs-hash test-name  #f))
-                                         (item-keys (sort (hash-table-keys item-hash) string<=?))) 
-                                          (map (lambda (item-name)  
+    
+    (s:html tests:css-jscript-block (tests:css-jscript-block-cond flag)
+	    (s:title "Summary for " area-name)
+	    (s:body 'onload "addEvents();"
+		    (get-prev-links page linktree)
+		    (get-next-links page linktree total-runs)
+		    
+		    (s:h1 "Summary for " area-name)
+		    (s:h3 "Filter" )
+		    (s:input 'type "text"  'name "testname" 'id "testname" 'length "30" 'onkeyup "filtersome()")
+		    ;; top list
+		    
+		    (s:table 'id "LinkedList1" 'border "1" 'cellspacing 0
+			     (map (lambda (key)
+				    (let* ((res (s:tr 'class "something" 
+						      (s:th key )
+						      (map (lambda (run)
+							     (s:th  (vector-ref run ctr)))
+							   runs))))
+				      (set! ctr (+ ctr 1))
+				      res))
+				  keys)
+			     (s:tr
+			      (s:th "Run Name")
+			      (map (lambda (run)
+				     (s:th (db:get-value-by-header run header "runname")))
+				   runs))
+			     
+			     (map (lambda (test-name)
+				    (let* ((item-hash (hash-table-ref/default test-runs-hash test-name  #f))
+					   (item-keys (sort (hash-table-keys item-hash) string<=?))) 
+				      (map (lambda (item-name)  
   		                             (let* ((res (s:tr  'class item-name
-				                         (s:td  item-name 'class "test" )
-                                                           (map (lambda (run)
-                                                               (let* ((run-test (hash-table-ref/default item-hash item-name  #f))
-                                                                      (run-id (db:get-value-by-header run header "id"))
-                                                                      (result (hash-table-ref/default run-test run-id "n/a"))
-                                                                      ;(relative-path (get-relative-path)) 
-                                                                      (status (if (string? result)
-									                                                            	result
-										                                                            (car result)))
-                                                                        (link (if (string? result)
-										                                                            result
-                                                                                (if (equal? flag #t) 
-                                                                                (s:a (car result) 'href (conc "./test_log?runid=" run-id "&testname="  item-name ))
-  																																						  (s:a (car result) 'href (string-substitute  (conc linktree "/")  "" (cadr result)  "-"))))))
-                                                                       (s:td  link 'class status)))
-                                                                runs))))
-                                                        res))
-                                                   item-keys)))
-                               test-list)))))) 
+								(s:td  item-name 'class "test" )
+								(map (lambda (run)
+								       (let* ((run-test (hash-table-ref/default item-hash item-name  #f))
+									      (run-id (db:get-value-by-header run header "id"))
+									      (result (hash-table-ref/default run-test run-id "n/a"))
+					;(relative-path (get-relative-path)) 
+									      (status (if (string? result)
+											  result
+											  (car result)))
+									      (link (if (string? result)
+											result
+											(if (equal? flag #t) 
+											    (s:a (car result) 'href (conc "./test_log?runid=" run-id "&testname="  item-name ))
+											    (s:a (car result) 'href (string-substitute  (conc linktree "/")  "" (cadr result)  "-"))))))
+									 (s:td  link 'class status)))
+								     runs))))
+					       res))
+					   item-keys)))
+				  test-list)))))) 
 
 ;; (tests:create-html-tree "test-index.html")
 ;;
 (define (tests:create-html-tree outf)
-   (let* ((lockfile  (conc outf ".lock"))
-	 			 (runs-to-process '())
+  (let* ((lockfile  (conc outf ".lock"))
+	 (runs-to-process '())
          (linktree  (common:get-linktree))
          (area-name (common:get-testsuite-name))
-	  		 (keys      (rmt:get-keys))
-	  		 (numkeys   (length keys))
+	 (keys      (rmt:get-keys))
+	 (numkeys   (length keys))
          (run-patt (or (args:get-arg "-run-patt")
-                        (args:get-arg "-runname")
-                        "%"))
+		       (args:get-arg "-runname")
+		       "%"))
          (target (or  (args:get-arg "-target-patt") 
-											(args:get-arg "-target")
+		      (args:get-arg "-target")
                       "%"))
          (targlist (string-split target "/"))
          (numtarg  (length targlist))  
          (targtweaked (if (> numkeys numtarg)
-			   								(append targlist (make-list (- numkeys numtarg) "%"))
-			  								targlist))
+			  (append targlist (make-list (- numkeys numtarg) "%"))
+			  targlist))
          (target-patt (string-join targtweaked "/"))
-         ;(total-runs  (rmt:get-num-runs "%")) ;;this needs to be changed to filter by target
-          (total-runs (rmt:get-runs-cnt-by-patt run-patt target-patt keys )) 
+					;(total-runs  (rmt:get-num-runs "%")) ;;this needs to be changed to filter by target
+	 (total-runs (rmt:get-runs-cnt-by-patt run-patt target-patt keys )) 
          (pg-size 10))
     (if (common:simple-file-lock lockfile)
         (begin
-         ;(print total-runs)    
-        (let loop ((page 0))
-	(let* ((oup       (open-output-file (or outf (conc linktree "/page" page ".html"))))
-               (get-prev-links (lambda (page linktree )   
-                            (let* ((link  (if (not (eq? page 0))
-                                   (s:a "&lt;&lt;prev" 'href (conc  "page" (- page 1) ".html"))
-                                   (s:a "" 'href (conc   "page"  page ".html")))))
-                               link)))
-               (get-next-links (lambda (page linktree total-runs)   
-                            (let* ((link  (if (> total-runs (+ 10 (* page pg-size)))
-                                   (s:a "next&gt;&gt;" 'href (conc  "page"  (+ page 1) ".html"))
-                                   (s:a "" 'href (conc   "page" page  ".html")))))
-                               link))) )
-          (print "total runs: " total-runs) 
-          (s:output-new
-	   			 oup
-	   					(tests:dashboard-body page pg-size keys numkeys total-runs linktree area-name get-prev-links get-next-links #f run-patt target-patt)) ;; update this function
-          (close-output-port oup)
-         ; (set! page (+ 1 page))
-          (if (> total-runs (* (+ 1 page) pg-size))
-           (loop (+ 1  page)))))
+					;(print total-runs)    
+	  (let loop ((page 0))
+	    (let* ((oup            (open-output-file (or outf (conc linktree "/page" page ".html"))))
+		   (get-prev-links (lambda (page linktree )   
+				     (let* ((link  (if (not (eq? page 0))
+						       (s:a "&lt;&lt;prev" 'href (conc  "page" (- page 1) ".html"))
+						       (s:a "" 'href (conc   "page"  page ".html")))))
+				       link)))
+		   (get-next-links (lambda (page linktree total-runs)   
+				     (let* ((link  (if (> total-runs (+ 10 (* page pg-size)))
+						       (s:a "next&gt;&gt;" 'href (conc  "page"  (+ page 1) ".html"))
+						       (s:a "" 'href (conc   "page" page  ".html")))))
+				       link))) )
+	      (print "total runs: " total-runs) 
+	      (s:output-new
+	       oup
+	       (tests:dashboard-body page pg-size keys numkeys total-runs linktree area-name get-prev-links get-next-links #f run-patt target-patt)) ;; update this function
+	      (close-output-port oup)
+					; (set! page (+ 1 page))
+	      (if (> total-runs (* (+ 1 page) pg-size))
+		  (loop (+ 1  page)))))
 	  (common:simple-file-release-lock lockfile))
-	            
-	#f)))
+	(begin
+	  (debug-print 0 *default-log-port* "Failed to get lock on file outf, lockfile: " lockfile) #f))))
 
 
 (define (tests:readlines filename)
   (call-with-input-file filename
     (lambda (p)
@@ -1498,13 +1506,15 @@
 	       (map (lambda (p)
 		      (if (directory-exists? p)
 			  (let ((glob-query (conc p "/" fnamepatt)))
 			    (handle-exceptions
 				exn
+			      (begin
+				(print "built-in glob on " glob-query ", failed, try using the shell. exn=" exn)
 				(with-input-from-pipe
-				    (conc "echo " glob-query)
-				  read-lines)  ;; we aren't going to try too hard. If glob breaks it is likely because someone tried to do */*/*.log or similar
+				 (conc "echo " glob-query)
+				 read-lines))  ;; we aren't going to try too hard. If glob breaks it is likely because someone tried to do */*/*.log or similar
 			      (glob glob-query)))
 			  '()))
 		    paths-from-db))
 	paths-from-db)))
 
@@ -1553,13 +1563,15 @@
 			    (common:file-exists? cache-file)))
 	 (cached-dat   (if (and (not force-create)
 				cache-exists
 				use-cache)
 			   (handle-exceptions
-			    exn
-			    #f ;; any issues, just give up with the cached version and re-read
-			    (configf:read-alist cache-file))
+			       exn
+			     (begin
+			       (debug:print 0 *default-log-port* "failed to read " cache-file ", exn=" exn)
+			       #f) ;; any issues, just give up with the cached version and re-read
+			     (configf:read-alist cache-file))
 			   #f))
          (test-full-name (if (and item-path (not (string-null? item-path)))
                              (conc test-name "/" item-path)
                              test-name)))
     (if cached-dat
@@ -1689,10 +1701,27 @@
 	;;   (map car (sort data (lambda (a b)
 	;;     		    (> (string->number (caddr a))(string->number (caddr b)))))))
 	;; ))
 	(sort all-tests sort-fn1)))) ;; avoid dealing with deleted tests, look at the hash table
 
+;; look up all waitons that are related to test "testname"
+;;
+(define (tests:get-mt-waitons testname flatten)
+  (let* ((mt-waitons    (configf:get-section *configdat* "waitons"))
+	 (my-waitons    (filter
+			 (lambda (x)
+			   (string-match (conc "^(" testname "|" testname"/.*)$") (car x)))
+			 mt-waitons)))
+    (if flatten
+	(map (lambda (w)
+	       (car (string-split w "/")))
+	     (apply append (map (lambda (x)
+				  (string-split (cadr x)))
+				my-waitons)))
+	my-waitons)))
+
+;; NOT USED
 (define (tests:easy-dot test-records outtype)
   (let-values (((fd temp-path) (file-mkstemp (conc "/tmp/" (current-user-name) ".XXXXXX"))))
     (let ((all-testnames (hash-table-keys test-records))
 	  (temp-port     (open-output-file* fd)))
       ;; (format temp-port "This file is ~A.~%" temp-path)
@@ -1700,15 +1729,17 @@
       (format temp-port "  size=4,8\n")
       ;; (format temp-port "   splines=none\n")
       (for-each
        (lambda (testname)
 	 (let* ((testrec (hash-table-ref test-records testname))
-		(waitons (or (tests:testqueue-get-waitons testrec) '())))
+		(waitons (or (tests:testqueue-get-waitons testrec) '()))
+		(my-mt-waitons (tests:get-mt-waitons testname #t)))
+	   ;; (print "my-mt-waitons=" my-mt-waitons)
 	   (for-each
 	    (lambda (waiton)
 	      (format temp-port (conc "   " waiton " -> " testname " [splines=ortho]\n")))
-	    waitons)))
+	    (append waitons my-mt-waitons))))
        all-testnames)
       (format temp-port "}\n")
       (close-output-port temp-port)
       (with-input-from-pipe
        (conc "env -i PATH=$PATH dot -T" outtype " < " temp-path)
@@ -1733,17 +1764,19 @@
 			      (conc " size=\"" (or sizex 11) "," (or sizey 11) "\";")
 			      " ratio=0.95;"
 			      )))
 	  (let* ((testrec (hash-table-ref test-records hed))
 		 (waitons (or (tests:testqueue-get-waitons testrec) '()))
+		 (my-mt-waitons (tests:get-mt-waitons hed #t))
+		 (all-waitons   (delete-duplicates (append waitons my-mt-waitons)))
 		 (newres  (append res
-				  (if (null? waitons)
+				  (if (null? all-waitons)
 				      (list (conc "   \"" hed "\" [shape=box];"))
 				      (map (lambda (waiton)
 					     (conc "   \"" waiton "\" -> \"" hed "\" [shape=box];"))
-					   waitons)
-				      ))))
+					   all-waitons)))))
+	    ;; (debug:print 0 *default-log-port* "For test "hed" got "all-waitons)
 	    (if (null? tal)
 		(append newres (list "}"))
 		(loop (car tal)(cdr tal) newres)
 		))))))
 
@@ -1761,27 +1794,34 @@
       (close-input-port inp)
       res)))
 
 ;; read data from tmp file or create if not exists
 ;; if exists regen in background
+;; mode: raw (return data as read) or munged (convert to list of lists and remove " from strings)
 ;;
-(define (tests:lazy-dot testrecords  outtype sizex sizey)
+(define (tests:lazy-dot testrecords  outtype sizex sizey mode)
   (let ((dfile (conc "/tmp/." (current-user-name) "-" (server:mk-signature) ".dot"))
 	(fname (conc "/tmp/." (current-user-name) "-" (server:mk-signature) ".dotdat")))
     (tests:write-dot-file testrecords dfile sizex sizey)
-    (if (common:file-exists? fname)
-	(let ((res (with-input-from-file fname
-		     (lambda ()
-		       (read-lines)))))
-	  (system (conc "env -i PATH=$PATH dot -T " outtype " < " dfile " > " fname "&"))
-	  res)
-	(begin
-	  (system (conc "env -i PATH=$PATH dot -T " outtype " < " dfile " > " fname))
-	  (with-input-from-file fname
-	    (lambda ()
-	      (read-lines)))))))
-	  
+    (let ((data (if (common:file-exists? fname)
+		    (let ((res (with-input-from-file fname
+				 (lambda ()
+				   (read-lines)))))
+		      (system (conc "env -i PATH=$PATH dot -T " outtype " < " dfile " > " fname "&"))
+		      res)
+		    (begin
+		      (system (conc "env -i PATH=$PATH dot -T " outtype " < " dfile " > " fname))
+		      (with-input-from-file fname
+			(lambda ()
+			  (read-lines)))))))
+      (if (eq? mode 'raw)
+	  data
+	  (map (lambda (inl)
+		 (map (lambda (s)
+			(string-substitute "\"" "" s #t))
+		      (string-split inl)))
+	       data)))))
 
 ;; for each test:
 ;;   
 (define (tests:filter-non-runnable run-id testkeynames testrecordshash)
   (let ((runnables '()))
@@ -1932,52 +1972,53 @@
 	 tdb
 	 "SELECT count(id) FROM test_rundat;")
 	res))
   0)
 
-(define (tests:update-central-meta-info run-id test-id cpuload diskfree minutes uname hostname)
-  (rmt:general-call 'update-test-rundat run-id test-id (current-seconds) (or cpuload -1)(or diskfree -1) -1 (or minutes -1))
-  (if (and cpuload diskfree)
-      (rmt:general-call 'update-cpuload-diskfree run-id cpuload diskfree test-id))
-  (if minutes 
-      (rmt:general-call 'update-run-duration run-id minutes test-id))
-  (if (and uname hostname)
-      (rmt:general-call 'update-uname-host run-id uname hostname test-id)))
+;; 
+(define (tests:update-central-meta-info run-id test-id cpuload diskfree minutes uname hostname #!key (update-db #f)(tmpfree #f))
+  (if (get-environment-variable "MT_TEST_RUN_DIR")
+      (let* ((dest-dir (conc (get-environment-variable "MT_TEST_RUN_DIR") "/.mt_data"))
+	     (or-dash  (lambda (instr)
+			 (cond
+			  ((not instr) "") ;; #f -> blank, indicates value unchanged since last measurement taken
+			  ((string? instr)(if (string-search " " instr) (conc "\"" instr "\"") instr))
+			  (else instr))))
+	     (file-new (not (directory-exists? dest-dir))))
+	(if file-new (create-directory dest-dir #t))
+	(let* ((outp (open-output-file (conc dest-dir "/test-run.dat") #:append)))
+	  (with-output-to-port outp
+	    (lambda ()
+	      (if file-new
+		  (print "epoch_time,run_id,test_id,cpuload,diskfree,tmpfree,run_minutes,hostname,uname"))
+	      (print (current-seconds) "," (or-dash run-id)   "," (or-dash test-id)  ","
+		     (or-dash cpuload) "," (or-dash diskfree) "," (or-dash tmpfree)  ","
+		     (or-dash minutes) "," (or-dash hostname) ","
+		     (or-dash uname)))) ;; put uname last as it has spaces in it
+	  (close-output-port outp)))
+      (begin
+	(rmt:general-call 'update-test-rundat run-id test-id (current-seconds) (or cpuload -1)(or diskfree -1) -1 (or minutes -1))))
+  (if update-db
+      (begin
+	(if (and cpuload diskfree)
+	    (rmt:general-call 'update-cpuload-diskfree run-id cpuload diskfree test-id))
+	(if minutes 
+	    (rmt:general-call 'update-run-duration run-id minutes test-id))
+	(if (and uname hostname)
+	    (rmt:general-call 'update-uname-host run-id uname hostname test-id)))))
   
 ;; This one is for running with no db access (i.e. via rmt: internally)
-(define (tests:set-full-meta-info db test-id run-id minutes work-area remtries)
+(define (tests:set-full-meta-info db test-id run-id minutes work-area remtries #!key (update-db #f))
 ;; (define (tests:set-full-meta-info test-id run-id minutes work-area)
 ;;  (let ((remtries 10))
   (let* ((cpuload  (get-cpu-load))
 	 (diskfree (get-df (current-directory)))
+	 (tmpfree  (get-df "/tmp"))
 	 (uname    (get-uname "-srvpio"))
 	 (hostname (get-host-name)))
-    (tests:update-central-meta-info run-id test-id cpuload diskfree minutes uname hostname)))
-    
-;; (define (tests:set-partial-meta-info test-id run-id minutes work-area)
-#;(define (tests:set-partial-meta-info test-id run-id minutes work-area remtries)
-  (let* ((cpuload  (get-cpu-load))
-	 (diskfree (get-df (current-directory)))
-	 (remtries 10))
-    (handle-exceptions
-     exn
-     (if (> remtries 0)
-	 (begin
-	   (print-call-chain (current-error-port))
-	   (debug:print-info 0 *default-log-port* "WARNING: failed to set meta info. Will try " remtries " more times")
-	   (set! remtries (- remtries 1))
-	   (thread-sleep! 10)
-	   (tests:set-full-meta-info db test-id run-id minutes work-area (- remtries 1)))
-	 (let ((err-status ((condition-property-accessor 'sqlite3 'status #f) exn)))
-	   (debug:print-error 0 *default-log-port* "tried for over a minute to update meta info and failed. Giving up")
-	   (debug:print 0 *default-log-port* "EXCEPTION: database probably overloaded or unreadable.")
-	   (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
-	   (debug:print 5 *default-log-port* "exn=" (condition->list exn))
-	   (debug:print 0 *default-log-port* " status:  " ((condition-property-accessor 'sqlite3 'status) exn))
-	   (print-call-chain (current-error-port))))
-     (tests:update-testdat-meta-info db test-id work-area cpuload diskfree minutes)
-  )))
+    (tests:update-central-meta-info run-id test-id cpuload diskfree minutes uname hostname update-db: update-db tmpfree: tmpfree)))
+    
 	 
 ;;======================================================================
 ;; A R C H I V I N G
 ;;======================================================================
 

Index: tests/unittests/all-api.scm
==================================================================
--- tests/unittests/all-api.scm
+++ tests/unittests/all-api.scm
@@ -116,11 +116,11 @@
 (test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'delete-run (list 2))) 0)) ;; delete a non-existant run
 (test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'update-run-stats (list 1 '()))) 0))
 (test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'get-main-run-stats (list 1 ))) 0))
 (test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'delete-old-deleted-test-records '())) 0))
 (test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'get-runs (list "%" 10 0 keypatts))) 0))
-(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'simple-get-runs (list "%" 10 0 keypatts))) 0))
+(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'simple-get-runs (list "%" 10 0 keypatts 0))) 0))
 (test #f #(#t (1))(api:execute-requests my-dbstruct (vector 'get-all-run-ids '())))
 (test #f #(#t ()) (api:execute-requests my-dbstruct (vector 'get-prev-run-ids '(1))))
 (test #f #(#t "JUSTFINE") (api:execute-requests my-dbstruct (vector 'get-run-status '(1))))
 (test #f #(#t "NEW") (api:execute-requests my-dbstruct (vector 'get-run-state '(1))))
 (test #f #(#t (("Totals" "UNKNOWN" 1) ("bar" "UNKNOWN" 1))) (api:execute-requests my-dbstruct (vector 'get-run-stats '())))

Index: tests/unittests/all-rmt.scm
==================================================================
--- tests/unittests/all-rmt.scm
+++ tests/unittests/all-rmt.scm
@@ -38,12 +38,12 @@
 (test #f #f (server:check-if-running toppath))           ;; these are used by server:start-and-wait
 (test #f #t (list? (server:get-list toppath)))
 (test #f '() (server:get-best '()))
 (test #f #t (common:simple-file-lock-and-wait "test.lock" expire-time: 15))
 (test #f "test.lock" (common:simple-file-release-lock "test.lock"))
-(test #f #t (server:get-best-guess-address (get-host-name)))
-(test #f #t (string? (common:get-homehost)))
+(test #f #t (string? (server:get-best-guess-address (get-host-name))))
+(test #f #t (string? (car (common:get-homehost))))
 
 ;; clean out any old running servers
 ;;
 (let ((servers (server:get-list toppath)))
   (print "Known servers: "  servers)
@@ -68,11 +68,11 @@
 (thread-sleep! 2)
 ;; (test #f #t (string? (server:start-and-wait *toppath*)))
 
 (test "setup for run" #t (begin (launch:setup)
  				(string? (getenv "MT_RUN_AREA_HOME"))))
-(test #f #t (client:setup-http toppath))
+(test #f #t (vector? (client:setup-http toppath)))
 (test #f #t (vector? (client:setup toppath)))
 
 (test #f #t (vector? (rmt:get-connection-info toppath))) ;; TODO: push areapath down.
 (test #f #t (string? (server:check-if-running ".")))
 ;; DEF (test #f #f (rmt:send-receive-no-auto-client-setup *runremote* 'get-keys #f '()))

Index: tree.scm
==================================================================
--- tree.scm
+++ tree.scm
@@ -27,17 +27,18 @@
 (import (prefix sqlite3 sqlite3:))
 
 (declare (unit tree))
 (declare (uses margs))
 (declare (uses launch))
-(declare (uses megatest-version))
+;; (declare (uses megatest-version))
 (declare (uses gutils))
 (declare (uses db))
 (declare (uses server))
 ;; (declare (uses synchash))
 (declare (uses dcommon))
 
+(include "megatest-version.scm")
 (include "common_records.scm")
 (include "db_records.scm")
 (include "key_records.scm")
 
 ;;======================================================================

ADDED   ulex.scm
Index: ulex.scm
==================================================================
--- /dev/null
+++ ulex.scm
@@ -0,0 +1,24 @@
+;;======================================================================
+;; Copyright 2019, Matthew Welland.
+;; 
+;; This file is part of Megatest.
+;; 
+;;     Megatest is free software: you can redistribute it and/or modify
+;;     it under the terms of the GNU General Public License as published by
+;;     the Free Software Foundation, either version 3 of the License, or
+;;     (at your option) any later version.
+;; 
+;;     Megatest is distributed in the hope that it will be useful,
+;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;     GNU General Public License for more details.
+;; 
+;;     You should have received a copy of the GNU General Public License
+;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
+
+;;======================================================================
+
+(declare (unit ulex))
+(declare (uses pkts))
+
+(include "ulex/ulex.scm")

ADDED   ulex/ulex.scm
Index: ulex/ulex.scm
==================================================================
--- /dev/null
+++ ulex/ulex.scm
@@ -0,0 +1,2252 @@
+;; ulex: Distributed sqlite3 db
+;;;
+;; Copyright (C) 2018 Matt Welland
+;; Redistribution and use in source and binary forms, with or without
+;; modification, is permitted.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS
+;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE
+;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
+;; OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
+;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
+;; USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
+;; DAMAGE.
+
+;;======================================================================
+;; ABOUT:
+;;   See README in the distribution at https://www.kiatoa.com/fossils/ulex
+;; NOTES:
+;;   Why sql-de-lite and not say, dbi?  - performance mostly, then simplicity.
+;;
+;;======================================================================
+
+(use mailbox)
+
+(module ulex
+ *
+
+(import scheme posix chicken data-structures ports extras files mailbox)
+(import srfi-18 pkts matchable regex
+	typed-records srfi-69 srfi-1
+	srfi-4 regex-case
+	(prefix sqlite3 sqlite3:)
+	foreign
+	tcp6
+	;; ulex-netutil
+	hostinfo
+	)
+
+;; make it a global? Well, it is local to area module
+
+(define *captain-pktspec*
+  `((captain (host     . h)
+	     (port     . p)
+	     (pid      . i)
+	     (ipaddr   . a)
+	     )
+    #;(data   (hostname . h)  ;; sender hostname
+	    (port     . p)  ;; sender port
+	    (ipaddr   . a)  ;; sender ip
+	    (hostkey  . k)  ;; sending host key - store info at server under this key
+	    (servkey  . s)  ;; server key - this needs to match at server end or reject the msg
+	    (format   . f)  ;; sb=serialized-base64, t=text, sx=sexpr, j=json
+	    (data     . d)  ;; base64 encoded slln data
+	    )))
+
+;; struct for keeping track of our world
+
+(defstruct udat
+  ;; captain info
+  (captain-address #f)
+  (captain-host    #f)
+  (captain-port    #f)
+  (captain-pid     #f)
+  (captain-lease   0)    ;; time (unix epoc) seconds when the lease is up
+  (ulex-dir        (conc (get-environment-variable "HOME") "/.ulex"))
+  (cpkts-dir       (conc (get-environment-variable "HOME") "/.ulex/pkts"))
+  (cpkt-spec       *captain-pktspec*)
+  ;; this processes info
+  (my-cpkt-key     #f)   ;; put Z card here when I create a pkt for myself as captain
+  (my-address      #f)
+  (my-hostname     #f)
+  (my-port         #f)
+  (my-pid          (current-process-id))
+  (my-dbs          '())
+  ;; server and handler thread
+  (serv-listener   #f)                 ;; this processes server info
+  (handler-thread  #f)
+  (mboxes          (make-hash-table))  ;; key => mbox
+  ;; other servers
+  (peers           (make-hash-table))  ;; host-port => peer record
+  (dbowners        (make-hash-table))  ;; dbfile => host-port
+  (handlers        (make-hash-table))  ;; dbfile => proc
+  ;; (outgoing-conns  (make-hash-table))  ;; host:port -> conn
+  (work-queue      (make-queue))       ;; most stuff goes here
+  ;; (fast-queue      (make-queue))       ;; super quick stuff goes here (e.g. ping)
+  (busy            #f)                 ;; is either of the queues busy, use to switch between queuing tasks or doing immediately
+  ;; app info
+  (appname         #f)
+  (dbtypes         (make-hash-table))  ;; this should be an alist but hash is easier. dbtype => [ initproc syncproc ]
+  ;; cookies
+  (cnum            0) ;; cookie num
+  )
+
+;;======================================================================
+;; NEW APPROACH
+;;======================================================================
+
+;;  start-server-find-port  ;; gotta have a server port ready from the very begining
+
+;; udata    - all the connection info, captain, server, ulex db etc. MUST BE PASSED IN
+;; dbpath   - full path and filename of the db to talk to or a symbol naming the db?
+;; callname - the remote call to execute
+;; params   - parameters to pass to the remote call
+;;
+(define (remote-call udata dbpath dbtype callname . params)
+  (start-server-find-port udata) ;; ensure we have a local server
+  (find-or-setup-captain udata)
+  ;; look at connect, process-request, send, send-receive
+  (let-values (((cookie-key host-port)(get-db-owner udata dbpath dbtype)))
+    (send-receive udata host-port callname cookie-key params)))
+
+;;======================================================================
+;; KEY FUNCTIONS - THESE ARE TOO BE EXPOSED AND USED
+;;======================================================================
+
+;; connection setup and management functions
+
+;; This is the basic setup command. Must always be
+;; called before connecting to a db using connect.
+;;
+;; find or become the captain
+;; setup and return a ulex object
+;;
+(define (find-or-setup-captain udata)
+  ;; see if we already have a captain and if the lease is ok
+  (if (and (udat-captain-address udata)
+	   (udat-captain-port    udata)
+	   (< (current-seconds) (udat-captain-lease udata)))
+      udata
+      (let* ((cpkts (get-all-captain-pkts udata)) ;; read captain pkts
+	     (captn (get-winning-pkt cpkts)))
+	(if captn
+	    (let* ((port   (alist-ref 'port   captn))
+		   (host   (alist-ref 'host   captn))
+		   (ipaddr (alist-ref 'ipaddr captn))
+		   (pid    (alist-ref 'pid    captn))
+		   (Z      (alist-ref 'Z      captn)))
+	      (udat-captain-address-set! udata ipaddr)
+	      (udat-captain-host-set!    udata host)
+	      (udat-captain-port-set!    udata port)
+	      (udat-captain-pid-set!     udata pid)
+	      (udat-captain-lease-set!   udata (+ (current-seconds) 10))
+	      (let-values (((success pingtime)(ping udata (conc ipaddr ":" port))))
+		(if success
+		    udata
+		    (begin
+		      (print "Found unreachable captain at " ipaddr ":" port ", removing pkt")
+		      (remove-captain-pkt udata captn)
+		      (find-or-setup-captain udata))))
+	      (begin
+		(setup-as-captain udata)  ;; this saves the thread to captain-thread and starts the thread
+		(find-or-setup-captain udata)))))))
+
+;; connect to a specific dbfile
+;;   - if already connected - return the dbowner host-port
+;;   - ask the captain who to talk to for this db
+;;   - put the entry in the dbowners hash as dbfile => host-port
+;;
+(define (connect udata dbfname dbtype)
+  (or (hash-table-ref/default (udat-dbowners udata) dbfname #f)
+      (let-values (((success dbowner-host-port)(get-db-owner udata dbfname dbtype)))
+	(if success
+	    (begin
+	      ;; just clobber the record, this is the new data no matter what
+	      (hash-table-set! (udat-dbowners udata) dbfname dbowner-host-port)
+	      dbowner-host-port)
+	    #f))))
+
+;; returns: success pingtime
+;;
+;; NOTE: causes the callee to store the info on this host along with the dbs this host currently owns
+;;
+(define (ping udata host-port)
+  (let* ((start  (current-milliseconds))
+	 (cookie (make-cookie udata))
+	 (dbs    (udat-my-dbs udata))
+	 (msg    (string-intersperse dbs " "))
+	 (res (send udata host-port 'ping cookie msg retval: #t))
+	 (delta (- (current-milliseconds) start)))
+    (values (equal? res cookie) delta)))
+
+;; returns: success pingtime
+;;
+;; NOTE: causes all references to this worker to be wiped out in the
+;; callee (ususally the captain)
+;;
+(define (goodbye-ping udata host-port)
+  (let* ((start  (current-milliseconds))
+	 (cookie (make-cookie udata))
+	 (dbs    (udat-my-dbs udata))
+	 (res (send udata host-port 'goodbye cookie "nomsg" retval: #t))
+	 (delta (- (current-milliseconds) start)))
+    (values (equal? res cookie) delta)))
+
+(define (goodbye-captain udata)
+  (let* ((host-port (udat-captain-host-port udata)))
+    (if host-port
+	(goodbye-ping udata host-port)
+	(values #f -1))))
+
+(define (get-db-owner udata dbname dbtype)
+  (let* ((host-port (udat-captain-host-port udata)))
+    (if host-port
+	(let* ((cookie (make-cookie udata))
+	       (msg    #f) ;; (conc dbname " " dbtype))
+	       (params `(,dbname ,dbtype))
+	       (res    (send udata host-port 'db-owner cookie msg
+			     params: params retval: #t)))
+	  (match (string-split res)
+	    ((retcookie owner-host-port)
+	     (values (equal? retcookie cookie) owner-host-port))))
+	(values #f -1))))
+
+;; called in ulex-handler to dispatch work, called on the workers side
+;;     calls (proc params data)
+;;     returns result with cookie
+;;
+;; pdat is the info of the caller, used to send the result data
+;; prockey is key into udat-handlers hash dereferencing a proc
+;; procparam is a first param handed to proc - often to do further derefrencing
+;; NOTE: params is intended to be a list of strings, encoding on data
+;;       is up to the user but data must be a single line
+;;
+(define (process-request udata pdat dbname cookie prockey procparam data)
+  (let* ((dbrec (ulex-open-db udata dbname))     ;; this will be a dbconn record, looks for in udata first
+	 (proc  (hash-table-ref udata prockey)))
+    (let* ((result (proc dbrec procparam data)))
+      result)))
+
+;; remote-request - send to remote to process in process-request
+;; uconn comes from a call to connect and can be used instead of calling connect again
+;; uconn is the host-port to call
+;; we send dbname to the worker so they know which file to open
+;; data must be a string with no newlines, it will be handed to the proc
+;; at the remote site unchanged. It is up to the user to encode/decode it's contents
+;;
+;;   rtype: immediate, read-only, normal, low-priority
+;; 
+(define (remote-request udata uconn rtype dbname prockey procparam data)
+  (let* ((cookie    (make-cookie udata)))
+    (send-receive udata uconn rtype cookie data `(,prockey procparam))))
+
+(define (ulex-open-db udata dbname)
+  #f)
+
+
+;;======================================================================
+;; Ulex db
+;;
+;;   - track who is captain, lease expire time
+;;   - track who owns what db, lease
+;;
+;;======================================================================
+
+;;
+;;
+(define (ulex-dbfname)
+  (let ((dbdir (conc (get-environment-variable "HOME") "/.ulex")))
+    (if (not (file-exists? dbdir))
+	(create-directory dbdir #t))
+    (conc dbdir "/network.db")))
+	 
+;; always goes in ~/.ulex/network.db
+;; role is captain, adjutant, node
+;;
+(define (ulexdb-setup)
+  (let* ((dbfname (ulex-dbfname))
+	 (have-db (file-exists? dbfname))
+	 (db      (sqlite3:open-database dbfname)))
+    (sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 136000))
+    (sqlite3:execute db "PRAGMA synchronous = 0;")
+    (if (not have-db)
+	(sqlite3:with-transaction
+	 db
+	 (lambda ()
+	   (for-each
+	    (lambda (stmt)
+	      (if stmt (sqlite3:execute db stmt)))
+	    `("CREATE TABLE IF NOT EXISTS nodes
+                 (id INTEGER PRIMARY KEY,
+                  role  TEXT NOT NULL,
+                  host  TEXT NOT NULL,
+                  port TEXT NOT NULL,
+                  ipadr TEXT NOT NULL,
+                  pid   INTEGER NOT NULL,
+                  zcard TEXT NOT NULL,
+                  regtime INTEGER DEFAULT (strftime('%s','now')),
+                  lease_thru INTEGER DEFAULT (strftime('%s','now')),
+                  last_update INTEGER DEFAULT (strftime('%s','now')));"
+	      "CREATE TRIGGER  IF NOT EXISTS update_nodes_trigger AFTER UPDATE ON nodes
+                             FOR EACH ROW
+                               BEGIN 
+                                 UPDATE nodes SET last_update=(strftime('%s','now'))
+                                   WHERE id=old.id;
+                               END;"
+	      "CREATE TABLE IF NOT EXISTS dbs
+                 (id INTEGER PRIMARY KEY,
+                  dbname TEXT NOT NULL,
+                  dbfile TEXT NOT NULL,
+                  dbtype TEXT NOT NULL,
+                  host_port TEXT NOT NULL,
+                  regtime INTEGER DEFAULT (strftime('%s','now')),
+                  lease_thru INTEGER DEFAULT (strftime('%s','now')),
+                  last_update INTEGER DEFAULT (strftime('%s','now')));"
+	      "CREATE TRIGGER  IF NOT EXISTS update_dbs_trigger AFTER UPDATE ON dbs
+                             FOR EACH ROW
+                               BEGIN 
+                                 UPDATE dbs SET last_update=(strftime('%s','now'))
+                                   WHERE id=old.id;
+                               END;")))))
+    db))
+
+(define (get-host-port-lease db dbfname)
+  (sqlite3:fold-row
+   (lambda (rem host-port lease-thru)
+     (list host-port lease-thru))
+   #f db "SELECT host_port,lease_thru FROM dbs WHERE dbfile = ?" dbfname))
+  
+(define (register-captain db host ipadr port pid zcard #!key (lease 20))
+  (let* ((dbfname (ulex-dbfname))
+	 (host-port  (conc host ":" port)))
+    (sqlite3:with-transaction
+     db
+     (lambda ()
+       (match (get-host-port-lease db dbfname)
+	 ((host-port lease-thru)
+	  (if (> (current-seconds) lease-thru)
+	      (begin
+		(sqlite3:execute db "UPDATE dbs SET host_port=?,lease_thru=? WHERE dbname=?"
+				 (conc host ":" port)
+				 (+ (current-seconds) lease)
+				 dbfname)
+		#t)
+	      #f))
+	 (#f  (sqlite3:execute db "INSERT INTO dbs (dbname,dbfile,dbtype,host_port,lease_thru) VALUES (?,?,?,?,?)"
+			       "captain" dbfname "captain" host-port (+ (current-seconds) lease)))
+	 (else (print "ERROR: Unrecognised result from fold-row")
+	       (exit 1)))))))
+							    
+;;======================================================================
+;; network utilities
+;;======================================================================
+
+(define (rate-ip ipaddr)
+  (regex-case ipaddr
+    ( "^127\\..*" _ 0 )
+    ( "^(10\\.0|192\\.168)\\..*" _ 1 )
+    ( else 2 ) ))
+
+;; Change this to bias for addresses with a reasonable broadcast value?
+;;
+(define (ip-pref-less? a b)
+  (> (rate-ip a) (rate-ip b)))
+  
+
+(define (get-my-best-address)
+  (let ((all-my-addresses (get-all-ips))
+        ;;(all-my-addresses-old (vector->list (hostinfo-addresses (hostname->hostinfo (get-host-name)))))
+        )
+    (cond
+     ((null? all-my-addresses)
+      (get-host-name))                                          ;; no interfaces?
+     ((eq? (length all-my-addresses) 1)
+      (car all-my-addresses))                      ;; only one to choose from, just go with it
+     
+     (else
+      (car (sort all-my-addresses ip-pref-less?)))
+     ;; (else 
+     ;;  (ip->string (car (filter (lambda (x)                      ;; take any but 127.
+     ;;    			 (not (eq? (u8vector-ref x 0) 127)))
+     ;;    		       all-my-addresses))))
+
+     )))
+
+(define (get-all-ips-sorted)
+  (sort (get-all-ips) ip-pref-less?))
+
+(define (get-all-ips)
+  (map ip->string (vector->list 
+		   (hostinfo-addresses
+		    (host-information (current-hostname))))))
+
+(define (udat-my-host-port udata)
+  (if (and (udat-my-address udata)(udat-my-port udata))
+      (conc (udat-my-address udata) ":" (udat-my-port udata))
+      #f))
+
+(define (udat-captain-host-port udata)
+  (if (and (udat-captain-address udata)(udat-captain-port udata))
+      (conc (udat-captain-address udata) ":" (udat-captain-port udata))
+      #f))
+
+(define (udat-get-peer udata host-port)
+  (hash-table-ref/default (udat-peers udata) host-port #f))
+
+;; struct for keeping track of others we are talking to
+
+(defstruct peer
+  (addr-port       #f)
+  (hostname        #f)
+  (pid             #f)
+  ;; (inp             #f)
+  ;; (oup             #f)
+  (dbs            '()) ;; list of databases this peer is currently handling
+  )
+
+(defstruct work
+  (peer-dat   #f)
+  (handlerkey #f)
+  (qrykey     #f)
+  (data       #f)
+  (start      (current-milliseconds)))
+
+#;(defstruct dbowner
+  (pdat        #f)
+  (last-update (current-seconds)))
+
+;;======================================================================
+;; Captain functions
+;;======================================================================
+
+;; NB// This needs to be started in a thread
+;;
+;; setup to be a captain
+;;   - local server MUST be started already
+;;   - create pkt
+;;   - start server port handler
+;;
+(define (setup-as-captain udata)
+  (if (create-captain-pkt udata)
+      (let* ((my-addr (udat-my-address udata))
+	     (my-port (udat-my-port    udata))
+	     (th (make-thread (lambda ()
+				(ulex-handler-loop udata)) "Captain handler")))
+	(udat-handler-thread-set! udata th)
+	(udat-captain-address-set! udata my-addr)
+	(udat-captain-port-set!    udata my-port)
+	(thread-start! th))
+      (begin
+	(print "ERROR: failed to create captain pkt")
+	#f)))
+
+;; given a pkts dir read 
+;;
+(define (get-all-captain-pkts udata)
+  (let* ((pktsdir       (let ((d (udat-cpkts-dir udata)))
+			  (if (file-exists? d)
+			      d
+			      (begin
+				(create-directory d #t)
+				d))))
+	 (all-pkt-files (glob (conc pktsdir "/*.pkt")))
+	 (pkt-spec      (udat-cpkt-spec udata)))
+    (map (lambda (pkt-file)
+	   (read-pkt->alist pkt-file pktspec: pkt-spec))
+	 all-pkt-files)))
+
+;; sort by D then Z, return one, choose the oldest then
+;; differentiate if needed using the Z key
+;;l
+(define (get-winning-pkt pkts)
+  (if (null? pkts)
+      #f
+      (car (sort pkts (lambda (a b)
+			(let ((ad (string->number (alist-ref 'D a)))
+			      (bd (string->number (alist-ref 'D b))))
+			  (if (eq? a b)
+			      (let ((az (alist-ref 'Z a))
+				    (bz (alist-ref 'Z b)))
+				(string>=? az bz))
+			      (> ad bd))))))))
+
+;; put the host, ip, port and pid into a pkt in
+;; the captain pkts dir
+;;  - assumes user has already fired up a server
+;;    which will be in the udata struct
+;;
+(define (create-captain-pkt udata)
+  (if (not (udat-serv-listener udata))
+      (begin
+	(print "ERROR: create-captain-pkt called with out a listener")
+	#f)
+      (let* ((pktdat `((port   . ,(udat-my-port udata))
+		       (host   . ,(udat-my-hostname udata))
+		       (ipaddr . ,(udat-my-address udata))
+		       (pid    . ,(udat-my-pid     udata))))
+	     (pktdir  (udat-cpkts-dir udata))
+	     (pktspec (udat-cpkt-spec udata))
+	     )
+	(udat-my-cpkt-key-set!
+	 udata
+	 (write-alist->pkt
+	  pktdir
+	  pktdat
+	  pktspec: pktspec
+	  ptype:   'captain))
+	(udat-my-cpkt-key udata))))
+
+;; remove pkt associated with captn (the Z key .pkt)
+;;
+(define (remove-captain-pkt udata captn)
+  (let ((Z       (alist-ref 'Z captn))
+	(cpktdir (udat-cpkts-dir udata)))
+    (delete-file* (conc cpktdir "/" Z ".pkt"))))
+
+;; call all known peers and tell them to delete their info on the captain
+;; thus forcing them to re-read pkts and connect to a new captain
+;; call this when the captain needs to exit and if an older captain is
+;; detected. Due to delays in sending file meta data in NFS multiple
+;; captains can be initiated in a "Storm of Captains", book soon to be
+;; on Amazon
+;;
+(define (drop-captain udata)
+  (let* ((peers (hash-table-keys (udat-peers udata)))
+	 (cookie (make-cookie udata)))
+    (for-each
+     (lambda (host-port)
+       (send udata host-port 'dropcaptain cookie "nomsg" retval: #t))
+     peers)))
+
+;;======================================================================
+;; server primitives
+;;======================================================================
+
+(define (make-cookie udata)
+  (let ((newcnum (+ (udat-cnum udata) 1)))
+    (udat-cnum-set! udata newcnum)
+    (conc (udat-my-address udata) ":"
+	  (udat-my-port    udata) "-"
+	  (udat-my-pid     udata) "-"
+	  newcnum)))
+
+;; create a tcp listener and return a populated udat struct with
+;; my port, address, hostname, pid etc.
+;; return #f if fail to find a port to allocate.
+;;
+;;  if udata-in is #f create the record
+;;  if there is already a serv-listener return the udata
+;;
+(define (start-server-find-port udata-in #!optional (port 4242))
+  (let ((udata (or udata-in (make-udat))))
+    (if (udat-serv-listener udata) ;; TODO - add check that the listener is alive and ready?
+	udata
+	(handle-exceptions
+	    exn
+	  (if (< port 65535)
+	      (start-server-find-port udata (+ port 1))
+	      #f)
+	  (connect-server udata port)))))
+
+(define (connect-server udata port)
+  ;; (tcp-listener-socket LISTENER)(socket-name so)
+  ;; sockaddr-address, sockaddr-port, sockaddr->string
+  (let* ((tlsn (tcp-listen port 1000 #f)) ;; (tcp-listen TCPPORT [BACKLOG [HOST]])
+	 (addr (get-my-best-address))) ;; (hostinfo-addresses (host-information (current-hostname)))
+    (udat-my-address-set!    udata addr)
+    (udat-my-port-set!       udata port)
+    (udat-my-hostname-set!   udata (get-host-name))
+    (udat-serv-listener-set! udata tlsn)
+    udata))
+
+(define (get-peer-dat udata host-port #!optional (hostname #f)(pid #f))
+  (let* ((pdat (or (udat-get-peer udata host-port)
+		   (handle-exceptions ;; ERROR - MAKE THIS EXCEPTION HANDLER MORE SPECIFIC
+		    exn
+		    #f
+		    (let ((npdat (make-peer addr-port: host-port)))
+		      (if hostname (peer-hostname-set! npdat hostname))
+		      (if pid (peer-pid-set! npdat pid))
+		      npdat)))))
+    pdat))
+
+;; send structured data to recipient
+;;
+;;  NOTE: qrykey is what was called the "cookie" previously
+;;
+;;     retval tells send to expect and wait for return data (one line) and return it or time out
+;;       this is for ping where we don't want to necessarily have set up our own server yet.
+;;
+(define (send udata host-port handler qrykey data
+	      #!key (hostname #f)(pid #f)(params '())(retval #f))
+  (let* ((my-host-port (udat-my-host-port udata))
+	 (isme         (equal? host-port my-host-port)) ;; am I calling
+							;; myself?
+	 (dat          (list
+			handler              ;; " "
+			my-host-port         ;; " "
+			(udat-my-pid  udata) ;; " "
+			qrykey
+			params ;;(if (null? params) "" (conc " "
+			       ;;(string-intersperse params " ")))
+			)))
+    ;; (print "send isme is " (if isme "true!" "false!") ",
+    ;; my-host-port: " my-host-port ", host-port: " host-port)
+    (if isme
+	(ulex-handler udata dat data)
+	(handle-exceptions ;; ERROR - MAKE THIS EXCEPTION HANDLER MORE
+			   ;; SPECIFIC
+	    exn
+	    #f 
+	  (let-values (((inp oup)(tcp-connect host-port)))
+	    ;;
+	    ;; CONTROL LINE:
+	    ;;    handlerkey host:port pid qrykey params ...
+	    ;;
+	    (let ((res
+		   (if (and inp oup)
+		       (let* ()
+			 (if my-host-port
+			     (begin
+			       (write dat  oup)
+			       (write data oup) ;; send as sexpr
+			       ;; (print "Sent dat: " dat " data: " data)
+			       (if retval
+				   (read inp)
+				   #t))
+			     (begin
+			       (print "ERROR: send called but no receiver has been setup. Please call setup first!")
+			       #f))
+			 ;; NOTE: DO NOT BE TEMPTED TO LOOK AT ANY DATA ON INP HERE!
+			 ;;       (there is a listener for handling that)
+			 )
+		       #f))) ;; #f means failed to connect and send
+	      (close-input-port inp)
+	      (close-output-port oup)
+	      res))))))
+
+;; send a request to the given host-port and register a mailbox in udata
+;; wait for the mailbox data and return it
+;;
+(define (send-receive udata host-port handler qrykey data #!key (hostname #f)(pid #f)(params '())(timeout 20))
+  (let ((mbox      (make-mailbox))
+	(mbox-time (current-milliseconds))
+	(mboxes    (udat-mboxes udata)))
+    (hash-table-set! mboxes qrykey mbox)
+    (if (send udata host-port handler qrykey data hostname: hostname pid: pid params: params)
+	(let* ((mbox-timeout-secs    timeout)
+	       (mbox-timeout-result 'MBOX_TIMEOUT)
+	       (res                  (mailbox-receive! mbox mbox-timeout-secs mbox-timeout-result))
+	       (mbox-receive-time    (current-milliseconds)))
+	  (hash-table-delete! mboxes qrykey)
+	  (if (eq? res 'MBOX_TIMEOUT)
+	      #f
+	      res))
+	#f))) ;; #f means failed to communicate
+
+;; 
+(define (ulex-handler udata controldat data)
+  (print "controldat: " controldat " data: " data)
+  (match controldat ;;  (string-split controldat)
+    ((handlerkey host-port pid qrykey params ...)
+     ;; (print "handlerkey: " handlerkey " host-port: " host-port " pid: " pid " qrykey: " qrykey " params: " params)
+     (case handlerkey ;; (string->symbol handlerkey)
+       ((ack)(print "Got ack!"))
+       ((ping) ;; special case - return result immediately on the same connection
+	(let* ((proc  (hash-table-ref/default (udat-handlers udata) 'ping #f))
+	       (val   (if proc (proc) "gotping"))
+	       (peer  (make-peer addr-port: host-port pid: pid))
+	       (dbshash (udat-dbowners udata)))
+	  (peer-dbs-set! peer params) ;; params for ping is list of dbs owned by pinger
+	  (for-each (lambda (dbfile)
+		      (hash-table-set! dbshash dbfile host-port)) ;; WRONG?
+		    params) ;; register each db in the dbshash
+	  (if (not (hash-table-exists? (udat-peers udata) host-port))
+	      (hash-table-set! (udat-peers udata) host-port peer)) ;; save the details of this caller in peers
+	  qrykey)) ;; End of ping
+       ((goodbye)
+	;; remove all traces of the caller in db ownership etc.
+	(let* ((peer  (hash-table-ref/default (udat-peers udata) host-port #f))
+	       (dbs   (if peer (peer-dbs peer) '()))
+	       (dbshash (udat-dbowners udata)))
+	  (for-each (lambda (dbfile)(hash-table-delete! dbshash dbfile)) dbs)
+	  (hash-table-delete! (udat-peers udata) host-port)
+	  qrykey))
+       ((dropcaptain)
+	;; remove all traces of the captain
+	(udat-captain-address-set! udata #f)
+	(udat-captain-host-set!    udata #f)
+	(udat-captain-port-set!    udata #f)
+	(udat-captain-pid-set!     udata #f)
+	qrykey)
+       ((rucaptain) ;; remote is asking if I'm the captain
+	(if (udat-my-cpkt-key udata) "yes" "no"))
+       ((db-owner) ;; given a db name who do I send my queries to
+	;; look up the file in handlers, if have an entry ping them to be sure
+	;; they are still alive and then return that host:port.
+	;; if no handler found or if the ping fails pick from peers the oldest that
+	;; is managing the fewest dbs
+	(match params
+	  ((dbfile dbtype)
+	   (let* ((owner-host-port (hash-table-ref/default (udat-dbowners udata) dbfile #f)))
+	     (if owner-host-port
+		 (conc qrykey " " owner-host-port)
+		 (let* ((pdat (or (hash-table-ref/default (udat-peers udata) host-port #f) ;; no owner - caller gets to own it!
+				  (make-peer addr-port: host-port pid: pid dbs: `(,dbfile)))))
+		   (hash-table-set! (udat-peers udata) host-port pdat)
+		   (hash-table-set! (udat-dbowners udata) dbfile host-port)
+		   (conc qrykey " " host-port)))))
+	  (else (conc qrykey " BADDATA"))))
+       ;; for work items:
+       ;;    handler is one of; immediate, read-only, read-write, high-priority
+       ((immediate read-only normal low-priority) ;; do this work immediately
+	;; host-port (caller), pid (caller), qrykey (cookie), params <= all from first line
+	;; data => a single line encoded however you want, or should I build json into it?
+	(print "handlerkey=" handlerkey)
+	(let* ((pdat (get-peer-dat udata host-port)))
+	  (match params ;; dbfile prockey procparam
+	    ((dbfile prockey procparam)
+	     (case handlerkey
+	       ((immediate read-only)
+		(process-request udata pdat dbfile qrykey prockey procparam data))
+	       ((normal low-priority) ;; split off later and add logic to support low priority
+		(add-to-work-queue udata pdat dbfile qrykey prockey procparam data))
+	       (else
+		#f)))
+	    (else
+	     (print "INFO: params=" params " handlerkey=" handlerkey " controldat=" controldat)
+	     #f))))
+       (else
+	;; (add-to-work-queue udata (get-peer-dat udata host-port) handlerkey qrykey data)
+	#f)))
+    (else
+     (print "BAD DATA? controldat=" controldat " data=" data)
+     #f)));; handles the incoming messages and dispatches to queues
+
+;;
+(define (ulex-handler-loop udata)
+  (let* ((serv-listener (udat-serv-listener udata)))
+    ;; data comes as two lines
+    ;;   handlerkey resp-addr:resp-port hostname pid qrykey [dbpath/dbfile.db]
+    ;;   data
+    (let loop ((state 'start))
+      (let-values (((inp oup)(tcp-accept serv-listener)))
+	(let* ((controldat (read inp))
+	       (data       (read inp))
+	       (resp       (ulex-handler udata controldat data)))
+	  (if resp (write resp oup))
+	  (close-input-port inp)
+	  (close-output-port oup))
+	(loop state)))))
+
+;; add a proc to the handler list, these are done symetrically (i.e. in all instances)
+;; so that the proc can be dereferenced remotely
+;;
+(define (register-handler udata key proc)
+  (hash-table-set! (udat-handlers udata) key proc))
+
+
+;;======================================================================
+;; work queues
+;;======================================================================
+
+(define (add-to-work-queue udata peer-dat handlerkey qrykey data)
+  (let ((wdat (make-work peer-dat: peer-dat handlerkey: handlerkey qrykey: qrykey data: data)))
+    (if (udat-busy udata)
+	(queue-add! (udat-work-queue udata) wdat)
+	(process-work udata wdat)) ;; passing in wdat tells process-work to first process the passed in wdat
+    ))
+
+(define (do-work udata wdat)
+  #f)
+
+(define (process-work udata #!optional wdat)
+  (if wdat (do-work udata wdat)) ;; process wdat
+  (let ((wqueue (udat-work-queue udata)))
+    (if (not (queue-empty? wqueue))
+	(let loop ((wd (queue-remove! wqueue)))
+	  (do-work udata wd)
+	  (if (not (queue-empty? wqueue))
+	      (loop (queue-remove! wqueue)))))))
+
+;;======================================================================
+;; Generic db handling
+;;   setup a inmem db instance
+;;   open connection to on-disk db
+;;   sync on-disk db to inmem
+;;   get lock in on-disk db for dbowner of this db
+;;   put sync-proc, init-proc, on-disk handle, inmem handle in dbconn stuct
+;;   return the stuct
+;;======================================================================
+
+(defstruct dbconn
+  (fname  #f)
+  (inmem  #f)
+  (conn   #f)
+  (sync   #f) ;; sync proc
+  (init   #f) ;; init proc
+  (lastsync (current-seconds))
+  )
+
+(defstruct dbinfo
+  (initproc #f)
+  (syncproc #f))
+
+;; open inmem and disk database
+;;   init with initproc
+;;   return db struct
+;;
+;;   appname; megatest, ulex or something else.
+;;
+(define (setup-db-connection udata fname-in appname dbtype)
+  (let* ((is-ulex (eq? appname 'ulex))
+	 (dbinf   (if is-ulex ;; ulex is a built-in special case
+		      (make-dbinfo initproc: ulexdb-init syncproc: ulexdb-sync)
+		      (hash-table-ref/default (udat-dbtypes udata) dbtype #f)))
+	 (initproc (dbinfo-initproc dbinf))
+	 (syncproc (dbinfo-syncproc dbinf))
+	 (fname   (if is-ulex
+		      (conc (udat-ulex-dir udata) "/ulex.db")
+		      fname-in))
+	 (inmem-db (open-and-initdb udata #f 'inmem (dbinfo-initproc dbinf)))
+	 (disk-db  (open-and-initdb udata fname 'disk (dbinfo-initproc dbinf))))
+    (make-dbconn inmem: inmem-db conn: disk-db sync: syncproc init: initproc)))
+
+;; dest='inmem or 'disk
+;;
+(define (open-and-initdb udata filename dest init-proc)
+  (let* ((inmem    (eq? dest 'inmem))
+	 (dbfile   (if inmem
+		       ":INMEM:"
+		       filename))
+	 (dbexists (if inmem #t (file-exists? dbfile)))
+	 (db       (sqlite3:open-database dbfile)))
+    (sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 136000))
+    (if (not dbexists)
+	(init-proc db))
+    db))
+
+
+;;======================================================================
+;; Previous Ulex db stuff
+;;======================================================================
+
+(define (ulexdb-init db inmem)
+  (sqlite3:with-transaction
+   db
+   (lambda ()
+     (for-each
+      (lambda (stmt)
+	(if stmt (sqlite3:execute db stmt)))
+      `("CREATE TABLE IF NOT EXISTS processes 
+                 (id INTEGER PRIMARY KEY,
+                  host  TEXT NOT NULL,
+                  ipadr TEXT NOT NULL,
+                  port  INTEGER NOT NULL,
+                  pid   INTEGER NOT NULL,
+                  regtime INTEGER DEFAULT (strftime('%s','now')),
+                  last_update INTEGER DEFAULT (strftime('%s','now')));"
+	(if inmem
+	    "CREATE TRIGGER  IF NOT EXISTS update_proces_trigger AFTER UPDATE ON processes
+                             FOR EACH ROW
+                               BEGIN 
+                                 UPDATE processes SET last_update=(strftime('%s','now'))
+                                   WHERE id=old.id;
+                               END;"
+	    #f))))))
+
+;; open databases, do initial sync
+(define (ulexdb-sync dbconndat udata)
+  #f)
+
+
+) ;; END OF ULEX
+
+
+;;; ;;======================================================================
+;;; ;; D E B U G   H E L P E R S
+;;; ;;======================================================================
+;;;     
+;;; (define (dbg> . args)
+;;;   (with-output-to-port (current-error-port)
+;;;     (lambda ()
+;;;       (apply print "dbg> " args))))
+;;; 
+;;; (define (debug-pp . args)
+;;;   (if (get-environment-variable "ULEX_DEBUG")
+;;;       (with-output-to-port (current-error-port)
+;;; 	(lambda ()
+;;; 	  (apply pp args)))))
+;;; 
+;;; (define *default-debug-port* (current-error-port))
+;;; 
+;;; (define (sdbg> fn stage-name stage-start stage-end start-time . message)
+;;;   (if (get-environment-variable "ULEX_DEBUG")
+;;;       (with-output-to-port *default-debug-port* 
+;;; 	(lambda ()
+;;; 	  (apply print "ulex:" fn " " stage-name " took " (- (if stage-end stage-end (current-milliseconds)) stage-start) " ms. "
+;;; 		 (if start-time
+;;; 		     (conc "total time " (- (current-milliseconds) start-time)
+;;; 			   " ms.")
+;;; 		     "")
+;;; 		 message
+;;; 		 )))))
+
+;;======================================================================
+;; M A C R O S
+;;======================================================================
+;; iup callbacks are not dumping the stack, this is a work-around
+;;
+
+;; Some of these routines use:
+;;
+;;     http://www.cs.toronto.edu/~gfb/scheme/simple-macros.html
+;;
+;; Syntax for defining macros in a simple style similar to function definiton,
+;;  when there is a single pattern for the argument list and there are no keywords.
+;;
+;; (define-simple-syntax (name arg ...) body ...)
+;;
+;; 
+;; (define-syntax define-simple-syntax
+;;   (syntax-rules ()
+;;     ((_ (name arg ...) body ...)
+;;      (define-syntax name (syntax-rules () ((name arg ...) (begin body ...)))))))
+;; 
+;; (define-simple-syntax (catch-and-dump proc procname)
+;;   (handle-exceptions
+;;    exn
+;;    (begin
+;;      (print-call-chain (current-error-port))
+;;      (with-output-to-port (current-error-port)
+;;        (lambda ()
+;;          (print ((condition-property-accessor 'exn 'message) exn))
+;;          (print "Callback error in " procname)
+;;          (print "Full condition info:\n" (condition->list exn)))))
+;;    (proc)))
+;; 
+;; 
+;;======================================================================
+;;  R E C O R D S
+;;======================================================================
+
+;;; ;; information about me as a server
+;;; ;;
+;;; (defstruct area
+;;;   ;; about this area
+;;;   (useportlogger #f)
+;;;   (lowport       32768)
+;;;   (server-type   'auto)  ;; auto=create up to five servers/pkts, main=create pkts, passive=no pkt (unless there are no pkts at all)
+;;;   (conn          #f)
+;;;   (port          #f)
+;;;   (myaddr        (get-my-best-address))
+;;;   pktid          ;; get pkt from hosts table if needed
+;;;   pktfile
+;;;   pktsdir
+;;;   dbdir
+;;;   (dbhandles     (make-hash-table)) ;; fname => list-of-dbh, NOTE: Should really never need more than one?
+;;;   (mutex         (make-mutex))
+;;;   (rtable        (make-hash-table)) ;; registration table of available actions
+;;;   (dbs           (make-hash-table)) ;; filename => random number, used for choosing what dbs I serve
+;;;   ;; about other servers
+;;;   (hosts         (make-hash-table)) ;; key => hostdat
+;;;   (hoststats     (make-hash-table)) ;; key => alist of fname => ( qcount . qtime )
+;;;   (reqs          (make-hash-table)) ;; uri => queue
+;;;   ;; work queues
+;;;   (wqueues       (make-hash-table)) ;; fname => qdat
+;;;   (stats         (make-hash-table)) ;; fname => totalqueries
+;;;   (last-srvup    (current-seconds)) ;; last time we updated the known servers
+;;;   (cookie2mbox   (make-hash-table)) ;; map cookie for outstanding request to mailbox of awaiting call
+;;;   (ready #f)
+;;;   (health        (make-hash-table)) ;; ipaddr:port => num failed pings since last good ping
+;;;   )
+;;; 
+;;; ;; host stats
+;;; ;;
+;;; (defstruct hostdat
+;;;   (pkt      #f)
+;;;   (dbload   (make-hash-table))  ;; "dbfile.db" => queries/min
+;;;   (hostload #f)                 ;; normalized load ( 5min load / numcpus )
+;;;   )
+;;; 
+;;; ;; dbdat
+;;; ;;
+;;; (defstruct dbdat
+;;;   (dbh    #f)
+;;;   (fname  #f)
+;;;   (write-access #f)
+;;;   (sths   (make-hash-table))  ;; hash mapping query strings to handles
+;;;   )
+;;; 
+;;; ;; qdat
+;;; ;;
+;;; (defstruct qdat
+;;;   (writeq  (make-queue))
+;;;   (readq   (make-queue))
+;;;   (rwq     (make-queue))
+;;;   (logq    (make-queue)) ;; do we need a queue for logging? yes, if we use sqlite3 db for logging
+;;;   (osshort (make-queue))
+;;;   (oslong  (make-queue))
+;;;   (misc    (make-queue)) ;; used for things like ping-full
+;;;   )
+;;; 
+;;; ;; calldat
+;;; ;;
+;;; (defstruct calldat
+;;;   (ctype 'dbwrite)
+;;;   (obj   #f)              ;; this would normally be an SQL statement e.g. SELECT, INSERT etc.
+;;;   (rtime (current-milliseconds)))
+;;; 
+;;; ;; make it a global? Well, it is local to area module
+;;; 
+;;; (define *pktspec*
+;;;   `((server (hostname . h)
+;;; 	    (port     . p)
+;;; 	    (pid      . i)
+;;; 	    (ipaddr   . a)
+;;; 	    )
+;;;     (data   (hostname . h)  ;; sender hostname
+;;; 	    (port     . p)  ;; sender port
+;;; 	    (ipaddr   . a)  ;; sender ip
+;;; 	    (hostkey  . k)  ;; sending host key - store info at server under this key
+;;; 	    (servkey  . s)  ;; server key - this needs to match at server end or reject the msg
+;;; 	    (format   . f)  ;; sb=serialized-base64, t=text, sx=sexpr, j=json
+;;; 	    (data     . d)  ;; base64 encoded slln data
+;;; 	    )))
+;;; 
+;;; ;; work item
+;;; ;;
+;;; (defstruct witem
+;;;   (rhost #f)   ;; return host
+;;;   (ripaddr #f) ;; return ipaddr
+;;;   (rport #f)   ;; return port
+;;;   (servkey #f) ;; the packet representing the client of this workitem, used by final send-message
+;;;   (rdat  #f)   ;; the request - usually an sql query, type is rdat
+;;;   (action #f)  ;; the action: immediate, dbwrite, dbread,oslong, osshort
+;;;   (cookie #f)  ;; cookie id for response
+;;;   (data   #f)  ;; the data payload, i.e. parameters
+;;;   (result #f)  ;; the result from processing the data
+;;;   (caller #f)) ;; the calling peer according to rpc itself
+;;; 
+;;; (define (trim-pktid pktid)
+;;;   (if (string? pktid)
+;;;       (substring pktid 0 4)
+;;;       "nopkt"))
+;;; 
+;;; (define (any->number num)
+;;;   (cond
+;;;    ((number? num) num)
+;;;    ((string? num) (string->number num))
+;;;    (else num)))
+;;; 
+;;; (use trace)
+;;; (trace-call-sites #t)
+;;; 
+;;; ;;======================================================================
+;;; ;; D A T A B A S E   H A N D L I N G 
+;;; ;;======================================================================
+;;; 
+;;; ;; look in dbhandles for a db, return it, else return #f
+;;; ;;
+;;; (define (get-dbh acfg fname)
+;;;   (let ((dbh-lst (hash-table-ref/default (area-dbhandles acfg) fname '())))
+;;;     (if (null? dbh-lst)
+;;; 	(begin
+;;; 	  ;; (print "opening db for " fname)
+;;; 	  (open-db acfg fname)) ;; Note that the handles get put back in the queue in the save-dbh calls
+;;; 	(let ((rem-lst (cdr dbh-lst)))
+;;; 	  ;; (print "re-using saved connection for " fname)
+;;; 	  (hash-table-set! (area-dbhandles acfg) fname rem-lst)
+;;; 	  (car dbh-lst)))))
+;;; 
+;;; (define (save-dbh acfg fname dbdat)
+;;;     ;; (print "saving dbh for " fname)
+;;;     (hash-table-set! (area-dbhandles acfg) fname (cons dbdat (hash-table-ref/default (area-dbhandles acfg) fname '()))))
+;;; 
+;;; ;; open the database, if never before opened init it. put the handle in the
+;;; ;; open db's hash table
+;;; ;; returns: the dbdat
+;;; ;;
+;;; (define (open-db acfg fname)
+;;;   (let* ((fullname     (conc (area-dbdir acfg) "/" fname))
+;;; 	 (exists       (file-exists? fullname))
+;;; 	 (write-access (if exists
+;;; 			   (file-write-access? fullname)
+;;; 			   (file-write-access? (area-dbdir acfg))))
+;;; 	 (db           (sqlite3:open-database fullname))
+;;; 	 (handler      (sqlite3:make-busy-timeout 136000))
+;;; 	 )
+;;;     (sqlite3:set-busy-handler! db handler)
+;;;     (sqlite3:execute db "PRAGMA synchronous = 0;")
+;;;     (if (not exists) ;; need to init the db
+;;; 	(if write-access
+;;; 	    (let ((isql (get-rsql acfg 'dbinitsql))) ;; get the init sql statements
+;;; 	      ;; (sqlite3:with-transaction
+;;; 	      ;;  db
+;;; 	      ;;  (lambda ()
+;;; 		 (if isql
+;;; 		     (for-each
+;;; 		      (lambda (sql)
+;;; 			(sqlite3:execute db sql))
+;;; 		      isql)))
+;;; 	    (print "ERROR: no write access to " (area-dbdir acfg))))
+;;;     (make-dbdat dbh: db fname: fname write-access: write-access)))
+;;; 
+;;; ;; This is a low-level command to retrieve or to prepare, save and return a prepared statment
+;;; ;; you must extract the db handle
+;;; ;;
+;;; (define (get-sth db cache stmt)
+;;;   (if (hash-table-exists? cache stmt)
+;;;       (begin
+;;; 	;; (print "Reusing cached stmt for " stmt)
+;;; 	(hash-table-ref/default cache stmt #f))
+;;;       (let ((sth (sqlite3:prepare db stmt)))
+;;; 	(hash-table-set! cache stmt sth)
+;;; 	;; (print "prepared stmt for " stmt)
+;;; 	sth)))
+;;; 
+;;; ;; a little more expensive but does all the tedious deferencing - only use if you don't already
+;;; ;; have dbdat and db sitting around
+;;; ;;
+;;; (define (full-get-sth acfg fname stmt)
+;;;   (let* ((dbdat  (get-dbh acfg fname))
+;;; 	 (db     (dbdat-dbh dbdat))
+;;; 	 (sths   (dbdat-sths dbdat)))
+;;;     (get-sth db sths stmt)))
+;;; 
+;;; ;; write to a db
+;;; ;; acfg: area data
+;;; ;; rdat: request data
+;;; ;; hdat: (host . port)
+;;; ;;
+;;; ;; (define (dbwrite acfg rdat hdat data-in)
+;;; ;;   (let* ((dbname (car data-in))
+;;; ;; 	 (dbdat  (get-dbh acfg dbname))
+;;; ;; 	 (db     (dbdat-dbh dbdat))
+;;; ;; 	 (sths   (dbdat-sths dbdat))
+;;; ;; 	 (stmt   (calldat-obj rdat))
+;;; ;; 	 (sth    (get-sth db sths stmt))
+;;; ;; 	 (data   (cdr data-in)))
+;;; ;;     (print "dbname: " dbname " acfg: " acfg " rdat: " (calldat->alist rdat) " hdat: " hdat " data: " data)
+;;; ;;     (print "dbdat: " (dbdat->alist dbdat))
+;;; ;;     (apply sqlite3:execute sth data)
+;;; ;;     (save-dbh acfg dbname dbdat)
+;;; ;;     #t
+;;; ;;     ))
+;;; 
+;;; (define (finalize-all-db-handles acfg)
+;;;   (let* ((dbhandles (area-dbhandles acfg))  ;; dbhandles is hash of fname ==> dbdat
+;;; 	 (num       0))
+;;;     (for-each
+;;;      (lambda (area-name)
+;;;        (print "Closing handles for " area-name)
+;;;        (let ((dbdats (hash-table-ref/default dbhandles area-name '())))
+;;; 	 (for-each
+;;; 	  (lambda (dbdat)
+;;; 	    ;; first close all statement handles
+;;; 	    (for-each
+;;; 	     (lambda (sth)
+;;; 	       (sqlite3:finalize! sth)
+;;; 	       (set! num (+ num 1)))
+;;; 	     (hash-table-values (dbdat-sths dbdat)))
+;;; 	    ;; now close the dbh
+;;; 	    (set! num (+ num 1))
+;;; 	    (sqlite3:finalize! (dbdat-dbh dbdat)))
+;;; 	  dbdats)))
+;;;      (hash-table-keys dbhandles))
+;;;     (print "FINALIZED " num " dbhandles")))
+;;; 
+;;; ;;======================================================================
+;;; ;; W O R K   Q U E U E   H A N D L I N G 
+;;; ;;======================================================================
+;;; 
+;;; (define (register-db-as-mine acfg dbname)
+;;;   (let ((ht (area-dbs acfg)))
+;;;     (if (not (hash-table-ref/default ht dbname #f))
+;;; 	(hash-table-set! ht dbname (random 10000)))))
+;;; 	
+;;; (define (work-queue-add acfg fname witem)
+;;;   (let* ((work-queue-start (current-milliseconds))
+;;; 	 (action           (witem-action witem)) ;; NB the action is the index into the rdat actions
+;;; 	 (qdat             (or (hash-table-ref/default (area-wqueues acfg) fname #f)
+;;; 			       (let ((newqdat (make-qdat)))
+;;; 				 (hash-table-set! (area-wqueues acfg) fname newqdat)
+;;; 				 newqdat)))
+;;; 	 (rdat             (hash-table-ref/default (area-rtable acfg) action #f)))
+;;;     (if rdat
+;;; 	(queue-add!
+;;; 	 (case (calldat-ctype rdat)
+;;; 	   ((dbwrite)   (register-db-as-mine acfg fname)(qdat-writeq qdat))
+;;; 	   ((dbread)    (register-db-as-mine acfg fname)(qdat-readq  qdat))
+;;; 	   ((dbrw)      (register-db-as-mine acfg fname)(qdat-rwq    qdat))
+;;; 	   ((oslong)    (qdat-oslong qdat))
+;;; 	   ((osshort)   (qdat-osshort qdat))
+;;; 	   ((full-ping) (qdat-misc  qdat))
+;;; 	   (else
+;;; 	    (print "ERROR: no queue for " action ". Adding to dbwrite queue.")
+;;; 	    (qdat-writeq qdat)))
+;;; 	 witem)
+;;; 	(case action
+;;; 	  ((full-ping)(qdat-misc qdat))
+;;; 	  (else
+;;; 	   (print "ERROR: No action " action " was registered"))))
+;;;     (sdbg> "work-queue-add" "queue-add" work-queue-start #f #f)
+;;;     #t)) ;; for now, simply return #t to indicate request got to the queue
+;;; 
+;;; (define (doqueue acfg q fname dbdat dbh)
+;;;   ;; (print "doqueue: " fname)
+;;;   (let* ((start-time (current-milliseconds))
+;;; 	 (qlen       (queue-length q)))
+;;;     (if (> qlen 1)
+;;; 	(print "Processing queue of length " qlen))
+;;;     (let loop ((count      0)
+;;; 	       (responses '()))
+;;;       (let ((delta (- (current-milliseconds) start-time)))
+;;; 	(if (or (queue-empty? q)
+;;; 		(> delta 400)) ;; stop working on this queue after 400ms have passed
+;;; 	    (list count delta responses) ;; return count, delta and responses list
+;;; 	    (let* ((witem  (queue-remove! q))
+;;; 		   (action (witem-action witem))
+;;; 		   (rdat   (witem-rdat   witem))
+;;; 		   (stmt   (calldat-obj rdat))
+;;; 		   (sth    (full-get-sth acfg fname stmt))
+;;; 		   (ctype  (calldat-ctype rdat))
+;;; 		   (data   (witem-data   witem))
+;;; 		   (cookie (witem-cookie witem)))
+;;; 	      ;; do the processing and save the result in witem-result
+;;; 	      (witem-result-set!
+;;; 	       witem
+;;; 	       (case ctype ;; action
+;;; 		 ((noblockwrite) ;; blind write, no ack of success returned
+;;; 		  (apply sqlite3:execute sth data)
+;;; 		  (sqlite3:last-insert-rowid dbh))
+;;; 		 ((dbwrite)      ;; blocking write   
+;;; 		  (apply sqlite3:execute sth data)
+;;; 		  #t)
+;;; 		 ((dbread) ;; TODO: consider breaking this up and shipping in pieces for large query
+;;; 		  (apply sqlite3:map-row (lambda x x) sth data))
+;;; 		 ((full-ping)  'full-ping)
+;;; 		 (else (print "Not ready for action " action) #f)))
+;;; 	      (loop (add1 count)
+;;; 		    (if cookie
+;;; 			(cons witem responses)
+;;; 			responses))))))))
+;;; 
+;;; ;; do up to 400ms of processing on each queue
+;;; ;; - the work-queue-processor will allow the max 1200ms of work to complete but it will flag as overloaded
+;;; ;; 
+;;; (define (process-db-queries acfg fname)
+;;;   (if (hash-table-exists? (area-wqueues acfg) fname)
+;;;       (let* ((process-db-queries-start-time (current-milliseconds))
+;;; 	     (qdat             (hash-table-ref/default (area-wqueues acfg) fname #f))
+;;; 	     (queue-sym->queue (lambda (queue-sym)
+;;; 				 (case queue-sym  ;; lookup the queue from qdat given a name (symbol)
+;;; 				   ((wqueue)  (qdat-writeq qdat))
+;;; 				   ((rqueue)  (qdat-readq  qdat))
+;;; 				   ((rwqueue) (qdat-rwq    qdat))
+;;; 				   ((misc)    (qdat-misc   qdat))
+;;; 				   (else #f))))
+;;; 	     (dbdat   (get-dbh acfg fname))
+;;; 	     (dbh     (if (dbdat? dbdat)(dbdat-dbh dbdat) #f))
+;;; 	     (nowtime (current-seconds)))
+;;; 	;; handle the queues that require a transaction
+;;; 	;;
+;;; 	(map ;; 
+;;; 	 (lambda (queue-sym)
+;;; 	   ;; (print "processing queue " queue-sym)
+;;; 	   (let* ((queue (queue-sym->queue queue-sym)))
+;;; 	     (if (not (queue-empty? queue))
+;;; 		 (let ((responses
+;;; 			(sqlite3:with-transaction ;; todo - catch exceptions...
+;;; 			 dbh
+;;; 			 (lambda ()
+;;; 			   (let* ((res (doqueue acfg queue fname dbdat dbh))) ;; this does the work!
+;;; 			     ;; (print "res=" res)
+;;; 			     (match res
+;;; 			      ((count delta responses)
+;;; 			       (update-stats acfg fname queue-sym delta count)
+;;; 			       (sdbg> "process-db-queries" "sqlite3-transaction" process-db-queries-start-time #f #f)
+;;; 			       responses) ;; return responses
+;;; 			      (else
+;;; 			       (print "ERROR: bad return data from doqueue " res)))
+;;; 			     )))))
+;;; 		   ;; having completed the transaction, send the responses.
+;;; 		   ;; (print "INFO: sending " (length responses) " responses.")
+;;; 		   (let loop ((responses-left responses))
+;;; 		     (cond
+;;; 		      ((null? responses-left)  #t)
+;;; 		      (else
+;;; 		       (let* ((witem    (car responses-left))
+;;; 			      (response (cdr responses-left)))  
+;;; 			 (call-deliver-response acfg (witem-ripaddr witem)(witem-rport witem)
+;;; 						(witem-cookie witem)(witem-result witem)))
+;;; 		       (loop (cdr responses-left))))))
+;;; 		 )))
+;;; 	 '(wqueue rwqueue rqueue))
+;;; 	
+;;; 	;; handle misc queue
+;;; 	;;
+;;; 	;; (print "processing misc queue")
+;;; 	(let ((queue (queue-sym->queue 'misc)))
+;;; 	  (doqueue acfg queue fname dbdat dbh))
+;;; 	;; ....
+;;; 	(save-dbh acfg fname dbdat)
+;;; 	#t ;; just to let the tests know we got here
+;;; 	)
+;;;       #f ;; nothing processed
+;;;       ))
+;;; 
+;;; ;; run all queues in parallel per db but sequentially per queue for that db.
+;;; ;;  - process the queues every 500 or so ms
+;;; ;;  - allow for long running queries to continue but all other activities for that
+;;; ;;    db will be blocked.
+;;; ;;
+;;; (define (work-queue-processor acfg)
+;;;   (let* ((threads (make-hash-table))) ;; fname => thread
+;;;     (let loop ((fnames      (hash-table-keys (area-wqueues acfg)))
+;;; 	       (target-time (+ (current-milliseconds) 50)))
+;;;       ;;(if (not (null? fnames))(print "Processing for these databases: " fnames))
+;;;       (for-each
+;;;        (lambda (fname)
+;;; 	 ;; (print "processing for " fname)
+;;; 	 ;;(process-db-queries acfg fname))
+;;; 	 (let ((th (hash-table-ref/default threads fname #f)))
+;;; 	   (if (and th (not (member (thread-state th) '(dead terminated))))
+;;; 	       (begin
+;;; 		 (print "WARNING: worker thread for " fname " is taking a long time.")
+;;; 		 (print "Thread is in state " (thread-state th)))
+;;; 	       (let ((th1 (make-thread (lambda ()
+;;; 					 ;; (catch-and-dump
+;;; 					 ;;  (lambda ()
+;;; 					    ;; (print "Process queries for " fname)
+;;; 					    (let ((start-time (current-milliseconds)))
+;;; 					      (process-db-queries acfg fname)
+;;; 					      ;; (thread-sleep! 0.01) ;; need the thread to take at least some time
+;;; 					      (hash-table-delete! threads fname)) ;; no mutexes?
+;;; 					    fname)
+;;; 					  "th1"))) ;; ))
+;;; 		 (hash-table-set! threads fname th1)
+;;; 		 (thread-start! th1)))))
+;;;        fnames)
+;;;       ;; (thread-sleep! 0.1) ;; give the threads some time to process requests
+;;;       ;; burn time until 400ms is up
+;;;       (let ((now-time (current-milliseconds)))
+;;; 	(if (< now-time target-time)
+;;; 	    (let ((delta (- target-time now-time)))
+;;; 	      (thread-sleep! (/ delta 1000)))))
+;;;       (loop (hash-table-keys (area-wqueues acfg))
+;;; 	    (+ (current-milliseconds) 50)))))
+;;; 
+;;; ;;======================================================================
+;;; ;; S T A T S   G A T H E R I N G
+;;; ;;======================================================================
+;;; 
+;;; (defstruct stat
+;;;   (qcount-avg  0)                  ;; coarse running average
+;;;   (qtime-avg   0)                  ;; coarse running average
+;;;   (qcount      0)                  ;; total
+;;;   (qtime       0)                  ;; total
+;;;   (last-qcount 0)                  ;; last 
+;;;   (last-qtime  0)                  ;; last
+;;;   (dbs        '())                 ;; list of db files handled by this node
+;;;   (when        0))                 ;; when the last query happened - seconds
+;;; 
+;;; 
+;;; (define (update-stats acfg fname bucket duration numqueries)
+;;;   (let* ((key   fname) ;; for now do not use bucket. Was: (conc fname "-" bucket)) ;; lazy but good enough
+;;; 	 (stats (or (hash-table-ref/default (area-stats acfg) key #f)
+;;; 		    (let ((newstats (make-stat)))
+;;; 		      (hash-table-set! (area-stats acfg) key newstats)
+;;; 		      newstats))))
+;;;     ;; when the last query happended (used to remove the fname from the active list)
+;;;     (stat-when-set! stats (current-seconds))
+;;;     ;; last values
+;;;     (stat-last-qcount-set! stats numqueries)
+;;;     (stat-last-qtime-set!  stats duration)
+;;;     ;; total over process lifetime
+;;;     (stat-qcount-set! stats (+ (stat-qcount stats) numqueries))
+;;;     (stat-qtime-set!  stats (+ (stat-qtime  stats) duration))
+;;;     ;; coarse average
+;;;     (stat-qcount-avg-set! stats (/ (+ (stat-qcount-avg stats) numqueries) 2))
+;;;     (stat-qtime-avg-set!  stats (/ (+ (stat-qtime-avg  stats) duration)   2))
+;;; 
+;;;     ;; here is where we add the stats for a given dbfile
+;;;     (if (not (member fname (stat-dbs stats)))
+;;; 	(stat-dbs-set! stats (cons fname (stat-dbs stats))))
+;;; 
+;;;     ))
+;;; 
+;;; ;;======================================================================
+;;; ;; S E R V E R   S T U F F 
+;;; ;;======================================================================
+;;; 
+;;; ;; this does NOT return!
+;;; ;;
+;;; (define (find-free-port-and-open acfg)
+;;;   (let ((port (or (area-port acfg) 3200)))
+;;;     (handle-exceptions
+;;; 	exn
+;;; 	(begin
+;;; 	  (print "INFO: cannot bind to port " (rpc:default-server-port) ", trying next port")
+;;; 	  (area-port-set! acfg (+ port 1))
+;;; 	  (find-free-port-and-open acfg))
+;;;       (rpc:default-server-port port)
+;;;       (area-port-set! acfg port)
+;;;       (tcp-read-timeout 120000)
+;;;       ;; ((rpc:make-server (tcp-listen port)) #t)
+;;;       (tcp-listen (rpc:default-server-port)
+;;;       ))))
+;;; 
+;;; ;; register this node by putting a packet into the pkts dir.
+;;; ;; look for other servers
+;;; ;; contact other servers and compile list of servers
+;;; ;; there are two types of server
+;;; ;;     main servers - dashboards, runners and dedicated servers - need pkt
+;;; ;;     passive servers - test executers, step calls, list-runs - no pkt
+;;; ;;
+;;; (define (register-node acfg hostip port-num)
+;;;   ;;(mutex-lock! (area-mutex acfg))
+;;;   (let* ((server-type  (area-server-type acfg)) ;; auto, main, passive (no pkt created)
+;;; 	 (best-ip      (or hostip (get-my-best-address)))
+;;; 	 (mtdir        (area-dbdir acfg))
+;;; 	 (pktdir       (area-pktsdir acfg))) ;; conc mtdir "/.server-pkts")))
+;;;     (print "Registering node " best-ip ":" port-num)
+;;;     (if (not mtdir) ;; require a home for this node to put or find databases
+;;; 	#f
+;;; 	(begin
+;;; 	  (if  (not (directory? pktdir))(create-directory pktdir))
+;;; 	  ;; server is started, now create pkt if needed
+;;; 	  (print "Starting server in " server-type " mode with port " port-num)
+;;; 	  (if (member server-type '(auto main)) ;; TODO: if auto, count number of servers registers, if > 3 then don't put out a pkt
+;;; 	      (begin
+;;; 		(area-pktid-set! acfg
+;;; 				 (write-alist->pkt
+;;; 				  pktdir 
+;;; 				  `((hostname . ,(get-host-name))
+;;; 				    (ipaddr   . ,best-ip)
+;;; 				    (port     . ,port-num)
+;;; 				    (pid      . ,(current-process-id)))
+;;; 				  pktspec: *pktspec*
+;;; 				  ptype:   'server))
+;;; 		(area-pktfile-set! acfg (conc pktdir "/" (area-pktid acfg) ".pkt"))))
+;;; 	  (area-port-set!    acfg port-num)
+;;; 	  #;(mutex-unlock! (area-mutex acfg))))))
+;;; 
+;;; (define *cookie-seqnum* 0)
+;;; (define (make-cookie key)
+;;;   (set! *cookie-seqnum* (add1 *cookie-seqnum*))
+;;;   ;;(print "MAKE COOKIE CALLED -- on "servkey"-"*cookie-seqnum*)
+;;;   (conc key "-" *cookie-seqnum*)
+;;;   )
+;;; 
+;;; ;; dispatch locally if possible
+;;; ;;
+;;; (define (call-deliver-response acfg ipaddr port cookie data)
+;;;   (if (and (equal? (area-myaddr acfg) ipaddr)
+;;; 	   (equal? (area-port     acfg) port))
+;;;       (deliver-response acfg cookie data)
+;;;       ((rpc:procedure 'response ipaddr port) cookie data)))
+;;; 
+;;; (define (deliver-response acfg cookie data)
+;;;   (let ((deliver-response-start (current-milliseconds)))
+;;;     (thread-start! (make-thread
+;;; 		    (lambda ()
+;;; 		      (let loop ((tries-left 5))
+;;; 			;;(print "TOP OF DELIVER_RESPONSE LOOP; triesleft="tries-left)
+;;; 			;;(pp (hash-table->alist (area-cookie2mbox acfg)))
+;;; 			(let* ((mbox (hash-table-ref/default (area-cookie2mbox acfg) cookie #f)))
+;;; 			  (cond
+;;; 			   ((eq? 0 tries-left)
+;;; 			    (print "ulex:deliver-response: I give up. Mailbox never appeared. cookie="cookie)
+;;; 			    )
+;;; 			   (mbox
+;;; 			    ;;(print "got mbox="mbox"  got data="data"  send.")
+;;; 			    (mailbox-send! mbox data))
+;;; 			   (else
+;;; 			    ;;(print "no mbox yet.  look for "cookie)
+;;; 			    (thread-sleep! (/ (- 6 tries-left) 10))
+;;; 			    (loop (sub1 tries-left))))))
+;;; 		      ;; (debug-pp (list (conc "ulex:deliver-response took " (- (current-milliseconds) deliver-response-start) " ms, cookie=" cookie " data=") data))
+;;; 		      (sdbg> "deliver-response" "mailbox-send" deliver-response-start #f #f cookie)
+;;; 		      )
+;;; 		    (conc "deliver-response thread for cookie="cookie))))
+;;;   #t)
+;;; 
+;;; ;; action:
+;;; ;;   immediate - quick actions, no need to put in queues
+;;; ;;   dbwrite   - put in dbwrite queue
+;;; ;;   dbread    - put in dbread queue
+;;; ;;   oslong    - os actions, e.g. du, that could take a long time
+;;; ;;   osshort   - os actions that should be quick, e.g. df
+;;; ;;
+;;; (define (request acfg from-ipaddr from-port servkey action cookie fname params) ;; std-peer-handler
+;;;   ;; NOTE: Use rpc:current-peer for getting return address
+;;;   (let* ((std-peer-handler-start (current-milliseconds))
+;;; 	 ;; (raw-data               (alist-ref 'data     dat))
+;;; 	 (rdat                   (hash-table-ref/default
+;;; 				  (area-rtable acfg) action #f)) ;; this looks up the sql query or other details indexed by the action
+;;; 	 (witem                  (make-witem ripaddr: from-ipaddr ;; rhost:   from-host   
+;;; 					     rport:   from-port   action:  action
+;;; 					     rdat:    rdat        cookie:  cookie
+;;; 					     servkey: servkey     data:    params ;; TODO - rename data to params
+;;; 					     caller:  (rpc:current-peer))))
+;;;     (if (not (equal? servkey (area-pktid acfg)))
+;;; 	`(#f . ,(conc "I don't know you servkey=" servkey ", pktid=" (area-pktid acfg))) ;; immediately return this
+;;; 	(let* ((ctype (if rdat 
+;;; 			  (calldat-ctype rdat) ;; is this necessary? these should be identical
+;;; 			  action)))
+;;; 	  (sdbg> "std-peer-handler" "immediate" std-peer-handler-start #f #f)
+;;; 	  (case ctype
+;;; 	    ;; (dbwrite acfg rdat (cons from-ipaddr from-port) data)))
+;;; 	    ((full-ping)  `(#t  "ack to full ping"        ,(work-queue-add acfg fname witem) ,cookie))
+;;; 	    ((response)   `(#t  "ack from requestor"      ,(deliver-response acfg fname params)))
+;;; 	    ((dbwrite)    `(#t  "db write submitted"      ,(work-queue-add acfg fname witem) ,cookie))
+;;; 	    ((dbread)     `(#t  "db read submitted"       ,(work-queue-add acfg fname witem) ,cookie  ))
+;;; 	    ((dbrw)       `(#t  "db read/write submitted" ,cookie))
+;;; 	    ((osshort)    `(#t  "os short submitted"      ,cookie))
+;;; 	    ((oslong)     `(#t  "os long submitted"       ,cookie))
+;;; 	    (else         `(#f  "unrecognised action"     ,ctype)))))))
+;;; 
+;;; ;; Call this to start the actual server
+;;; ;;
+;;; ;; start_server
+;;; ;;
+;;; ;;   mode: '
+;;; ;;   handler: proc which takes pktrecieved as argument
+;;; ;;
+;;; 
+;;; (define (start-server acfg)
+;;;   (let* ((conn (find-free-port-and-open acfg))
+;;; 	 (port (area-port acfg)))
+;;;     (rpc:publish-procedure!
+;;;      'delist-db
+;;;      (lambda (fname)
+;;;        (hash-table-delete! (area-dbs acfg) fname)))
+;;;     (rpc:publish-procedure!
+;;;      'calling-addr
+;;;      (lambda ()
+;;;        (rpc:current-peer)))
+;;;     (rpc:publish-procedure!
+;;;      'ping
+;;;      (lambda ()(real-ping acfg)))
+;;;     (rpc:publish-procedure!
+;;;      'request
+;;;      (lambda (from-addr from-port servkey action cookie dbname params)
+;;;        (request acfg from-addr from-port servkey action cookie dbname params)))
+;;;     (rpc:publish-procedure!
+;;;      'response
+;;;      (lambda (cookie res-dat)
+;;;        (deliver-response acfg cookie res-dat)))
+;;;     (area-ready-set! acfg #t)
+;;;     (area-conn-set! acfg conn)
+;;;     ((rpc:make-server conn) #f)));; ((tcp-listen (rpc:default-server-port)) #t)
+;;; 
+;;; 
+;;; (define (launch acfg) ;;  #!optional (proc std-peer-handler))
+;;;   (print "starting launch")
+;;;   (update-known-servers acfg) ;; gotta do this on every start (thus why limit number of publicised servers)
+;;;   #;(let ((original-handler (current-exception-handler))) ;; is th
+;;;     (lambda (exception)
+;;;       (server-exit-procedure)
+;;;       (original-handler exception)))
+;;;   (on-exit (lambda ()
+;;; 	     (shutdown acfg))) ;; (finalize-all-db-handles acfg)))
+;;;   ;; set up the rpc handler
+;;;   (let* ((th1  (make-thread
+;;; 		(lambda ()(start-server acfg))
+;;; 		"server thread"))
+;;; 	 (th2   (make-thread
+;;; 		 (lambda ()
+;;; 		   (print "th2 starting")
+;;; 		   (let loop ()
+;;; 		     (work-queue-processor acfg)
+;;; 		     (print "work-queue-processor crashed!")
+;;; 		     (loop)))
+;;; 		 "work queue thread")))
+;;;     (thread-start! th1)
+;;;     (thread-start! th2)
+;;;     (let loop ()
+;;;       (thread-sleep! 0.025)
+;;;       (if (area-ready acfg)
+;;; 	  #t
+;;; 	  (loop)))
+;;;     ;; attempt to fix my address
+;;;     (let* ((all-addr (get-all-ips-sorted)))	     ;; could use (tcp-addresses conn)?
+;;;       (let loop ((rem-addrs all-addr))
+;;; 	(if (null? rem-addrs)
+;;; 	    (begin
+;;; 	      (print "ERROR: Failed to figure out the ip address of myself as a server. Giving up.")
+;;; 	      (exit 1)) ;; BUG Changeme to raising an exception
+;;; 		
+;;; 	    (let* ((addr      (car rem-addrs))
+;;; 		   (good-addr (handle-exceptions
+;;; 				  exn
+;;; 				  #f
+;;; 				((rpc:procedure 'calling-addr addr (area-port acfg))))))
+;;; 	      (if good-addr
+;;; 		  (begin
+;;; 		    (print "Got good-addr of " good-addr)
+;;; 		    (area-myaddr-set! acfg good-addr))
+;;; 		  (loop (cdr rem-addrs)))))))
+;;;     (register-node acfg (area-myaddr acfg)(area-port acfg))
+;;;     (print "INFO: Server started on " (area-myaddr acfg) ":" (area-port acfg))
+;;;     ;; (update-known-servers acfg) ;; gotta do this on every start (thus why limit number of publicised servers)
+;;;     ))
+;;; 
+;;; (define (clear-server-pkt acfg)
+;;;   (let ((pktf (area-pktfile acfg)))
+;;;     (if pktf (delete-file* pktf))))
+;;; 
+;;; (define (shutdown acfg)
+;;;   (let (;;(conn (area-conn    acfg))
+;;; 	(pktf (area-pktfile acfg))
+;;; 	(port (area-port    acfg)))
+;;;     (if pktf (delete-file* pktf))
+;;;     (send-all "imshuttingdown")
+;;;     ;; (rpc:close-all-connections!) ;; don't know if this is actually needed
+;;;     (finalize-all-db-handles acfg)))
+;;; 
+;;; (define (send-all msg)
+;;;   #f)
+;;; 
+;;; ;; given a area record look up all the packets
+;;; ;;
+;;; (define (get-all-server-pkts acfg)
+;;;   (let ((all-pkt-files (glob (conc (area-pktsdir acfg) "/*.pkt"))))
+;;;     (map (lambda (pkt-file)
+;;; 	   (read-pkt->alist pkt-file pktspec: *pktspec*))
+;;; 	 all-pkt-files)))
+;;; 
+;;; #;((Z . "9a0212302295a19610d5796fce0370fa130758e9")
+;;;   (port . "34827")
+;;;   (pid . "28748")
+;;;   (hostname . "zeus")
+;;;   (T . "server")
+;;;   (D . "1549427032.0"))
+;;; 
+;;; #;(define (get-my-best-address)
+;;;   (let ((all-my-addresses (get-all-ips))) ;; (vector->list (hostinfo-addresses (hostname->hostinfo (get-host-name))))))
+;;;     (cond
+;;;      ((null? all-my-addresses)
+;;;       (get-host-name))                                          ;; no interfaces?
+;;;      ((eq? (length all-my-addresses) 1)
+;;;       (ip->string (car all-my-addresses)))                      ;; only one to choose from, just go with it
+;;;      (else 
+;;;       (ip->string (car (filter (lambda (x)                      ;; take any but 127.
+;;; 				 (not (eq? (u8vector-ref x 0) 127)))
+;;; 			       all-my-addresses)))))))
+;;; 
+;;; ;; whoami? I am my pkt
+;;; ;;
+;;; (define (whoami? acfg)
+;;;   (hash-table-ref/default (area-hosts acfg)(area-pktid acfg) #f))
+;;; 
+;;; ;;======================================================================
+;;; ;; "Client side" operations
+;;; ;;======================================================================
+;;; 
+;;; (define (safe-call call-key host port . params)
+;;;   (handle-exceptions
+;;;    exn
+;;;    (begin
+;;;      (print "Call " call-key " to " host ":" port " failed")
+;;;      #f)
+;;;    (apply (rpc:procedure call-key host port) params)))
+;;; 
+;;; ;; ;; convert to/from string / sexpr
+;;; ;; 
+;;; ;; (define (string->sexpr str)
+;;; ;;   (if (string? str)
+;;; ;;       (with-input-from-string str read)
+;;; ;;       str))
+;;; ;; 
+;;; ;; (define (sexpr->string s)
+;;; ;;   (with-output-to-string (lambda ()(write s))))
+;;; 
+;;; ;; is the server alive?
+;;; ;;
+;;; (define (ping acfg host port)
+;;;   (let* ((myaddr     (area-myaddr acfg))
+;;; 	 (myport     (area-port   acfg))
+;;; 	 (start-time (current-milliseconds))
+;;; 	 (res        (if (and (equal? myaddr host)
+;;; 			      (equal? myport port))
+;;; 			 (real-ping acfg)
+;;; 			 ((rpc:procedure 'ping host port)))))
+;;;     (cons (- (current-milliseconds) start-time)
+;;; 	  res)))
+;;; 
+;;; ;; returns ( ipaddr port alist-fname=>randnum )
+;;; (define (real-ping acfg)
+;;;   `(,(area-myaddr acfg) ,(area-port acfg) ,(get-host-stats acfg)))
+;;; 
+;;; ;; is the server alive AND the queues processing?
+;;; ;;
+;;; #;(define (full-ping acfg servpkt)
+;;;   (let* ((start-time (current-milliseconds))
+;;; 	 (res        (send-message acfg servpkt '(full-ping) 'full-ping)))
+;;;     (cons (- (current-milliseconds) start-time)
+;;; 	  res))) ;; (equal? res "got ping"))))
+;;; 
+;;; 
+;;; ;; look up all pkts and get the server id (the hash), port, host/ip
+;;; ;; store this info in acfg
+;;; ;; return the number of responsive servers found
+;;; ;;
+;;; ;; DO NOT VERIFY THAT THE SERVER IS ALIVE HERE. This is called at times where the current server is not yet alive and cannot ping itself
+;;; ;;
+;;; (define (update-known-servers acfg)
+;;;   ;; readll all pkts
+;;;   ;; foreach pkt; if it isn't me ping the server; if alive, add to hosts hash, else rm the pkt
+;;;   (let* ((start-time (current-milliseconds))
+;;; 	 (all-pkts  (delete-duplicates
+;;; 		     (append (get-all-server-pkts acfg)
+;;; 			     (hash-table-values (area-hosts acfg)))))
+;;; 	 (hostshash (area-hosts acfg))
+;;; 	 (my-id     (area-pktid acfg))
+;;; 	 (pktsdir   (area-pktsdir acfg)) ;; needed to remove pkts from non-responsive servers
+;;; 	 (numsrvs   0)
+;;; 	 (delpkt    (lambda (pktsdir sid)
+;;; 		      (print "clearing out server " sid)
+;;; 		      (delete-file* (conc pktsdir "/" sid ".pkt"))
+;;; 		      (hash-table-delete! hostshash sid))))
+;;;     (area-last-srvup-set! acfg (current-seconds))
+;;;     (for-each
+;;;      (lambda (servpkt)
+;;;        (if (list? servpkt)
+;;; 	   ;; (pp servpkt)
+;;; 	   (let* ((shost (alist-ref 'ipaddr servpkt))
+;;; 		  (sport (any->number (alist-ref 'port servpkt)))
+;;; 		  (res   (handle-exceptions
+;;; 			  exn
+;;; 			  (begin
+;;; 			    ;; (print "INFO: bad server on " shost ":" sport)
+;;; 			    #f)
+;;; 			  (ping acfg shost sport)))
+;;; 		  (sid   (alist-ref 'Z servpkt)) ;; Z code is our name for the server
+;;; 		  (url   (conc shost ":" sport))
+;;; 		  )
+;;; 	     #;(if (or (not res)
+;;; 		     (null? res))
+;;; 		 (begin
+;;; 		   (print "STRANGE: ping of " url " gave " res)))
+;;; 	     
+;;; 	     ;; (print "Got " res " from " shost ":" sport)
+;;; 	     (match res
+;;; 		    ((qduration . payload)
+;;; 		     ;; (print "Server pkt:" (alist-ref 'ipaddr servpkt) ":" (alist-ref 'port servpkt)
+;;; 		     ;;        (if payload
+;;; 		     ;;            "Success" "Fail"))
+;;; 		     (match payload
+;;; 			    ((host port stats)
+;;; 			     ;; (print "From " host ":" port " got stats: " stats)
+;;; 			     (if (and host port stats)
+;;; 				 (let ((url (conc host ":" port)))
+;;; 				   (hash-table-set! hostshash sid servpkt)
+;;; 				   ;; store based on host:port
+;;; 				   (hash-table-set! (area-hoststats acfg) sid stats))
+;;; 				 (print "missing data from the server, not sure what that means!"))
+;;; 			     (set! numsrvs (+ numsrvs 1)))
+;;; 			    (#f
+;;; 			     (print "Removing pkt " sid " due to #f from server or failed ping")
+;;; 			     (delpkt pktsdir sid))
+;;; 			    (else
+;;; 			     (print "Got ")(pp res)(print " from server ")(pp servpkt) " but response did not match (#f/#t . msg)")))
+;;; 		    (else
+;;; 		     ;; here we delete the pkt - can't reach the server, remove it
+;;; 		     ;; however this logic is inadequate. we should mark the server as checked
+;;; 		     ;; and not good, if it happens a second time - then remove the pkt
+;;; 		     ;; or something similar. I.e. don't be too quick to assume the server is wedged or dead
+;;; 		     ;; could be it is simply too busy to reply
+;;; 		     (let ((bad-pings (hash-table-ref/default (area-health acfg) url 0)))
+;;; 		       (if (> bad-pings 1) ;; two bad pings - remove pkt
+;;; 			   (begin
+;;; 			     (print "INFO: " bad-pings " bad responses from " url ", deleting pkt " sid)
+;;; 			     (delpkt pktsdir sid))
+;;; 			   (begin
+;;; 			     (print "INFO: " bad-pings " bad responses from " shost ":" sport " not deleting pkt yet")
+;;; 			     (hash-table-set! (area-health acfg)
+;;; 					      url
+;;; 					      (+ (hash-table-ref/default (area-health acfg) url 0) 1))
+;;; 			     ))
+;;; 		       ))))
+;;; 	   ;; servpkt is not actually a pkt?
+;;; 	   (begin
+;;; 	     (print "Bad pkt " servpkt))))
+;;;      all-pkts)
+;;;     (sdbg> "update-known-servers" "end" start-time #f #f " found " numsrvs
+;;; 	   " servers, pkts: " (map (lambda (p)
+;;; 				     (alist-ref 'Z p))
+;;; 				   all-pkts))
+;;;     numsrvs))
+;;; 
+;;; (defstruct srvstat
+;;;   (numfiles 0)   ;; number of db files handled by this server - subtract 1 for the db being currently looked at
+;;;   (randnum  #f)  ;; tie breaker number assigned to by the server itself - applies only to the db under consideration
+;;;   (pkt      #f)) ;; the server pkt
+;;; 
+;;; ;;(define (srv->srvstat srvpkt)
+;;;   
+;;; ;; Get the server best for given dbname and key
+;;; ;;
+;;; ;;   NOTE: key is not currently used. The key points to the kind of query, this may be useful for directing read-only queries.
+;;; ;;
+;;; (define (get-best-server acfg dbname key)
+;;;   (let* (;; (servers (hash-table-values (area-hosts acfg)))
+;;; 	 (servers     (area-hosts acfg))
+;;; 	 (skeys       (sort (hash-table-keys servers) string>=?)) ;; a stable listing
+;;; 	 (start-time  (current-milliseconds))
+;;; 	 (srvstats    (make-hash-table))  ;; srvid => srvstat
+;;; 	 (url         (conc (area-myaddr acfg) ":" (area-port acfg))))
+;;;     ;; (print "scores for " dbname ": " (map (lambda (k)(cons k (calc-server-score acfg dbname k))) skeys))
+;;;     (if (null? skeys)
+;;; 	(if (> (update-known-servers acfg) 0)
+;;; 	    (get-best-server acfg dbname key) ;; some risk of infinite loop here, TODO add try counter
+;;; 	    (begin
+;;; 	      (print "ERROR: no server found!") ;; since this process is also a server this should never happen
+;;; 	      #f))
+;;; 	(begin
+;;; 	  ;; (print "in get-best-server with skeys=" skeys)
+;;; 	  (if (> (- (current-seconds) (area-last-srvup acfg)) 10)
+;;; 	      (begin
+;;; 		(update-known-servers acfg)
+;;; 		(sdbg> "get-best-server" "update-known-servers" start-time #f #f)))
+;;; 
+;;; 	  ;; for each server look at the list of dbfiles, total number of dbs being handled
+;;; 	  ;; and the rand number, save the best host
+;;; 	  ;; also do a delist-db for each server dbfile not used
+;;; 	  (let* ((best-server       #f)
+;;; 		 (servers-to-delist (make-hash-table)))
+;;; 	    (for-each
+;;; 	     (lambda (srvid)
+;;; 	       (let* ((server    (hash-table-ref/default servers srvid #f))
+;;; 		      (stats     (hash-table-ref/default (area-hoststats acfg) srvid '(()))))
+;;; 		 ;; (print "stats: " stats)
+;;;  		 (if server
+;;; 		     (let* ((dbweights (car stats))
+;;; 			    (srvload   (length (filter (lambda (x)(not (equal? dbname (car x)))) dbweights)))
+;;; 			    (dbrec     (alist-ref dbname dbweights equal?))  ;; get the pair with fname . randscore
+;;; 			    (randnum   (if dbrec
+;;; 					   dbrec ;; (cdr dbrec)
+;;; 					   0)))
+;;; 		       (hash-table-set! srvstats srvid (make-srvstat numfiles: srvload randnum: randnum pkt: server))))))
+;;; 	     skeys)
+;;; 	    
+;;; 	    (let* ((sorted    (sort (hash-table-values srvstats) 
+;;; 				    (lambda (a b)
+;;; 				      (let ((numfiles-a (srvstat-numfiles a))
+;;; 					    (numfiles-b (srvstat-numfiles b))
+;;; 					    (randnum-a  (srvstat-randnum a))
+;;; 					    (randnum-b  (srvstat-randnum b)))
+;;; 					(if (< numfiles-a numfiles-b) ;; Note, I don't think adding an offset works here. Goal was only move file handling to a different server if it has 2 less
+;;; 					    #t
+;;; 					    (if (and (equal? numfiles-a numfiles-b)
+;;; 						     (< randnum-a randnum-b))
+;;; 						#t
+;;; 						#f))))))
+;;; 		   (best      (if (null? sorted)
+;;; 				  (begin
+;;; 				    (print "ERROR: should never be null due to self as server.")
+;;; 				    #f)
+;;; 				  (srvstat-pkt (car sorted)))))
+;;; 	      #;(print "SERVER(" url "): " dbname ": " (map (lambda (srv)
+;;; 							    (let ((p (srvstat-pkt srv)))
+;;; 							      (conc (alist-ref 'ipaddr p) ":" (alist-ref 'port p)
+;;; 								    "(" (srvstat-numfiles srv)","(srvstat-randnum srv)")")))
+;;; 							    sorted))
+;;; 	      best))))))
+;;;     
+;;;     ;; send out an "I'm about to exit notice to all known servers"
+;;;     ;;
+;;; (define (death-imminent acfg)
+;;;   '())
+;;; 
+;;; ;;======================================================================
+;;; ;; U L E X  -  T H E   I N T E R E S T I N G   S T U F F ! !
+;;; ;;======================================================================
+;;; 
+;;; ;; register a handler
+;;; ;;   NOTES:
+;;; ;;     dbinitsql   is reserved for a list of sql statements for initializing the db
+;;; ;;     dbinitfn    is reserved for a db init function, if exists called after dbinitsql
+;;; ;;     
+;;; (define (register acfg key obj #!optional (ctype 'dbwrite))
+;;;   (let ((ht (area-rtable acfg)))
+;;;     (if (hash-table-exists? ht key)
+;;; 	(print "WARNING: redefinition of entry " key))
+;;;     (hash-table-set! ht key (make-calldat obj: obj ctype: ctype))))
+;;; 
+;;; ;; usage: register-batch acfg '((key1 . sql1) (key2 . sql2) ... )
+;;; ;; NB// obj is often an sql query
+;;; ;;
+;;; (define (register-batch acfg ctype data)
+;;;   (let ((ht (area-rtable acfg)))
+;;;     (map (lambda (dat)
+;;; 	   (hash-table-set! ht (car dat)(make-calldat obj: (cdr dat) ctype: ctype)))
+;;; 	 data)))
+;;; 
+;;; (define (initialize-area-calls-from-specfile area specfile)
+;;;   (let* ((callspec (with-input-from-file specfile read )))
+;;;     (for-each (lambda (group)
+;;;                 (register-batch
+;;;                  area
+;;;                  (car group)
+;;;                  (cdr group)))
+;;;               callspec)))
+;;; 
+;;; ;; get-rentry
+;;; ;;
+;;; (define (get-rentry acfg key)
+;;;   (hash-table-ref/default (area-rtable acfg) key #f))
+;;; 
+;;; (define (get-rsql acfg key)
+;;;   (let ((cdat (get-rentry acfg key)))
+;;;     (if cdat
+;;; 	(calldat-obj cdat)
+;;; 	#f)))
+;;; 
+;;; 
+;;; 
+;;; ;; blocking call:
+;;; ;;    client                         server
+;;; ;;    ------                         ------
+;;; ;;    call()
+;;; ;;    send-message()
+;;; ;;    nmsg-send()
+;;; ;;                                   nmsg-receive()
+;;; ;;                                   nmsg-respond(ack,cookie)
+;;; ;;    ack, cookie
+;;; ;;    mbox-thread-wait(cookie)
+;;; ;;                                   nmsg-send(client,cookie,result)
+;;; ;;        nmsg-respond(ack)
+;;; ;;        return result
+;;; ;;
+;;; ;; reserved action:
+;;; ;;    'immediate
+;;; ;;    'dbinitsql
+;;; ;;
+;;; (define (call acfg dbname action params #!optional (count 0))
+;;;   (let* ((call-start-time     (current-milliseconds))
+;;; 	 (srv                 (get-best-server acfg dbname action))
+;;; 	 (post-get-start-time (current-milliseconds))
+;;; 	 (rdat                (hash-table-ref/default (area-rtable acfg) action #f))
+;;; 	 (myid                (trim-pktid (area-pktid acfg)))
+;;; 	 (srvid               (trim-pktid (alist-ref 'Z srv)))
+;;; 	 (cookie              (make-cookie myid)))
+;;;     (sdbg> "call" "get-best-server" call-start-time #f call-start-time " from: " myid " to server: " srvid " for " dbname " action: " action " params: " params " rdat: " rdat)
+;;;     (print "INFO: call to " (alist-ref 'ipaddr srv) ":" (alist-ref 'port srv) " from " (area-myaddr acfg) ":" (area-port acfg) " for " dbname)
+;;;     (if (and srv rdat) ;; need both to dispatch a request
+;;; 	(let* ((ripaddr  (alist-ref 'ipaddr srv))
+;;; 	       (rsrvid   (alist-ref 'Z srv))
+;;; 	       (rport    (any->number (alist-ref 'port   srv)))
+;;; 	       (res-full (if (and (equal? ripaddr (area-myaddr acfg))
+;;; 				  (equal? rport   (area-port acfg)))
+;;; 			     (request acfg ripaddr rport (area-pktid acfg) action cookie dbname params)
+;;; 			     (safe-call 'request ripaddr rport
+;;; 					(area-myaddr acfg)
+;;; 					(area-port   acfg)
+;;; 					#;(area-pktid acfg)
+;;; 					rsrvid
+;;; 					action cookie dbname params))))
+;;; 	  ;; (print "res-full: " res-full)
+;;; 	  (match res-full
+;;; 	    ((response-ok response-msg rem ...)
+;;; 	     (let* ((send-message-time (current-milliseconds))
+;;; 		    ;; (match res-full
+;;; 		    ;;  ((response-ok response-msg)
+;;; 		    ;; (response-ok  (car res-full))
+;;; 		    ;; (response-msg (cadr res-full)
+;;; 		    )
+;;; 	       ;; (res (take res-full 3))) ;; ctype == action, TODO: converge on one term <<=== what was this? BUG 
+;;; 	       ;; (print "ulex:call: send-message took " (- send-message-time post-get-start-time) " ms params=" params)
+;;; 	       (sdbg> "call" "send-message" post-get-start-time #f call-start-time)
+;;; 	       (cond
+;;; 		((not response-ok) #f)
+;;; 		((member response-msg '("db read submitted" "db write submitted"))
+;;; 		 (let* ((cookie-id   (cadddr res-full))
+;;; 			(mbox        (make-mailbox))
+;;; 			(mbox-time   (current-milliseconds)))
+;;; 		   (hash-table-set! (area-cookie2mbox acfg) cookie-id mbox)
+;;; 		   (let* ((mbox-timeout-secs    20)
+;;; 			  (mbox-timeout-result 'MBOX_TIMEOUT)
+;;; 			  (res                  (mailbox-receive! mbox mbox-timeout-secs mbox-timeout-result))
+;;; 			  (mbox-receive-time    (current-milliseconds)))
+;;; 		     (hash-table-delete! (area-cookie2mbox acfg) cookie-id)
+;;; 		     (sdbg> "call" "mailbox-receive" mbox-time #f call-start-time " from: " myid " to server: " srvid " for " dbname)
+;;; 		     ;; (print "ulex:call mailbox-receive took " (- mbox-receive-time mbox-time) "ms params=" params)
+;;; 		     res)))
+;;; 		(else
+;;; 		 (print "Unhandled response \""response-msg"\"")
+;;; 		 #f))
+;;; 	       ;; depending on what action (i.e. ctype) is we will block here waiting for
+;;; 	       ;; all the data (mechanism to be determined)
+;;; 	       ;;
+;;; 	       ;; if res is a "working on it" then wait
+;;; 	       ;;    wait for result
+;;; 	       ;; mailbox thread wait on 
+;;; 	       
+;;; 	       ;; if res is a "can't help you" then try a different server
+;;; 	       ;; if res is a "ack" (e.g. for one-shot requests) then return res
+;;; 	       ))
+;;; 	    (else
+;;; 	     (if (< count 10)
+;;; 		 (let* ((url (conc (alist-ref 'ipaddr srv) ":" (alist-ref 'port srv))))
+;;; 		   (thread-sleep! 1)
+;;; 		   (print "ERROR: Bad result from " url ", dbname: " dbname ", action: " action ", params: " params ". Trying again in 1 second.")
+;;; 		   (call acfg dbname action params (+ count 1)))
+;;; 		 (begin
+;;; 		   (error (conc "ERROR: " count " tries, still have improper response res-full=" res-full)))))))
+;;; 	(begin
+;;; 	  (if (not rdat)
+;;; 	      (print "ERROR: action " action " not registered.")
+;;; 	      (if (< count 10)
+;;; 		 (begin
+;;; 		   (thread-sleep! 1)
+;;; 		   (area-hosts-set! acfg (make-hash-table)) ;; clear out all known hosts
+;;; 		   (print "ERROR: no server found, srv=" srv ", trying again in 1 seconds")
+;;; 		   (call acfg dbname action params (+ count 1)))
+;;; 		 (begin
+;;; 		   (error (conc "ERROR: no server found after 10 tries, srv=" srv ", giving up."))
+;;; 		   #;(error "No server available"))))))))
+;;; 
+;;; 
+;;; ;;======================================================================
+;;; ;; U T I L I T I E S 
+;;; ;;======================================================================
+;;; 
+;;; ;; get a signature for identifing this process
+;;; ;;
+;;; (define (get-process-signature)
+;;;   (cons (get-host-name)(current-process-id)))
+;;; 
+;;; ;;======================================================================
+;;; ;; S Y S T E M   S T U F F
+;;; ;;======================================================================
+;;; 
+;;; ;; get normalized cpu load by reading from /proc/loadavg and
+;;; ;; /proc/cpuinfo return all three values and the number of real cpus
+;;; ;; and the number of threads returns alist '((adj-cpu-load
+;;; ;; . normalized-proc-load) ... etc.  keys: adj-proc-load,
+;;; ;; adj-core-load, 1m-load, 5m-load, 15m-load
+;;; ;;
+;;; (define (get-normalized-cpu-load)
+;;;   (let ((res (get-normalized-cpu-load-raw))
+;;; 	(default `((adj-proc-load . 2) ;; there is no right answer
+;;; 		   (adj-core-load . 2)
+;;; 		   (1m-load       . 2)
+;;; 		   (5m-load       . 0) ;; causes a large delta - thus causing default of throttling if stuff goes wrong
+;;; 		   (15m-load      . 0)
+;;; 		   (proc          . 1)
+;;; 		   (core          . 1)
+;;; 		   (phys          . 1)
+;;; 		   (error         . #t))))
+;;;     (cond
+;;;      ((and (list? res)
+;;; 	   (> (length res) 2))
+;;;       res)
+;;;      ((eq? res #f)   default) ;; add messages?
+;;;      ((eq? res #f) default)   ;; this would be the #eof
+;;;      (else default))))
+;;; 
+;;; (define (get-normalized-cpu-load-raw)
+;;;   (let* ((actual-host           (get-host-name))) ;; #f is localhost
+;;;     (let ((data  (append 
+;;; 		  (with-input-from-file "/proc/loadavg" read-lines)
+;;; 		  (with-input-from-file "/proc/cpuinfo" read-lines)
+;;; 		  (list "end")))
+;;; 	  (load-rx  (regexp "^([\\d\\.]+)\\s+([\\d\\.]+)\\s+([\\d\\.]+)\\s+.*$"))
+;;; 	  (proc-rx  (regexp "^processor\\s+:\\s+(\\d+)\\s*$"))
+;;; 	  (core-rx  (regexp "^core id\\s+:\\s+(\\d+)\\s*$"))
+;;; 	  (phys-rx  (regexp "^physical id\\s+:\\s+(\\d+)\\s*$"))
+;;; 	  (max-num  (lambda (p n)(max (string->number p) n))))
+;;;       ;; (print "data=" data)
+;;;       (if (null? data) ;; something went wrong
+;;; 	  #f
+;;; 	  (let loop ((hed      (car data))
+;;; 		     (tal      (cdr data))
+;;; 		     (loads    #f)
+;;; 		     (proc-num 0)  ;; processor includes threads
+;;; 		     (phys-num 0)  ;; physical chip on motherboard
+;;; 		     (core-num 0)) ;; core
+;;; 	    ;; (print hed ", " loads ", " proc-num ", " phys-num ", " core-num)
+;;; 	    (if (null? tal) ;; have all our data, calculate normalized load and return result
+;;; 		(let* ((act-proc (+ proc-num 1))
+;;; 		       (act-phys (+ phys-num 1))
+;;; 		       (act-core (+ core-num 1))
+;;; 		       (adj-proc-load (/ (car loads) act-proc))
+;;; 		       (adj-core-load (/ (car loads) act-core))
+;;; 		       (result
+;;; 			(append (list (cons 'adj-proc-load adj-proc-load)
+;;; 				      (cons 'adj-core-load adj-core-load))
+;;; 				(list (cons '1m-load (car loads))
+;;; 				      (cons '5m-load (cadr loads))
+;;; 				      (cons '15m-load (caddr loads)))
+;;; 				(list (cons 'proc act-proc)
+;;; 				      (cons 'core act-core)
+;;; 				      (cons 'phys act-phys)))))
+;;; 		  result)
+;;; 		(regex-case
+;;; 		    hed
+;;; 		  (load-rx  ( x l1 l5 l15 ) (loop (car tal)(cdr tal)(map string->number (list l1 l5 l15)) proc-num phys-num core-num))
+;;; 		  (proc-rx  ( x p         ) (loop (car tal)(cdr tal) loads           (max-num p proc-num) phys-num core-num))
+;;; 		  (phys-rx  ( x p         ) (loop (car tal)(cdr tal) loads           proc-num (max-num p phys-num) core-num))
+;;; 		  (core-rx  ( x c         ) (loop (car tal)(cdr tal) loads           proc-num phys-num (max-num c core-num)))
+;;; 		  (else 
+;;; 		   (begin
+;;; 		     ;; (print "NO MATCH: " hed)
+;;; 		     (loop (car tal)(cdr tal) loads proc-num phys-num core-num))))))))))
+;;; 
+;;; (define (get-host-stats acfg)
+;;;   (let ((stats-hash (area-stats acfg)))
+;;;     ;; use this opportunity to remove references to dbfiles which have not been accessed in a while
+;;;     (for-each
+;;;      (lambda (dbname)
+;;;        (let* ((stats       (hash-table-ref stats-hash dbname))
+;;; 	      (last-access (stat-when stats)))
+;;; 	 (if (and (> last-access 0)                             ;; if zero then there has been no access
+;;; 		  (> (- (current-seconds) last-access) 10))     ;; not used in ten seconds
+;;; 	     (begin
+;;; 	       (print "Removing " dbname " from stats list")
+;;; 	       (hash-table-delete! stats-hash dbname) ;; remove from stats hash
+;;; 	       (stat-dbs-set! stats (hash-table-keys stats))))))
+;;;      (hash-table-keys stats-hash))
+;;;     
+;;;     `(,(hash-table->alist (area-dbs acfg)) ;; dbname => randnum
+;;;       ,(map (lambda (dbname)  ;; dbname is the db name
+;;; 	      (cons dbname (stat-when (hash-table-ref stats-hash dbname))))
+;;; 	    (hash-table-keys stats-hash))
+;;;       (cpuload . ,(get-normalized-cpu-load)))))
+;;;     #;(stats   . ,(map (lambda (k) ;; create an alist from the stats data
+;;; 		       (cons k (stat->alist (hash-table-ref (area-stats acfg) k))))
+;;; 		     (hash-table-keys (area-stats acfg))))
+;;; 
+;;; #;(trace
+;;;  ;; assv
+;;;  ;; cdr
+;;;  ;; caar
+;;;  ;; ;; cdr
+;;;  ;; call
+;;;  ;; finalize-all-db-handles
+;;;  ;; get-all-server-pkts
+;;;  ;; get-normalized-cpu-load
+;;;  ;; get-normalized-cpu-load-raw
+;;;  ;; launch
+;;;  ;; nmsg-send
+;;;  ;; process-db-queries
+;;;  ;; receive-message
+;;;  ;; std-peer-handler
+;;;  ;; update-known-servers
+;;;  ;; work-queue-processor
+;;;  )
+;;; 
+;;; ;;======================================================================
+;;; ;; netutil
+;;; ;;   move this back to ulex-netutil.scm someday?
+;;; ;;======================================================================
+;;; 
+;;; ;; #include <stdio.h>
+;;; ;; #include <netinet/in.h>
+;;; ;; #include <string.h>
+;;; ;; #include <arpa/inet.h>
+;;; 
+;;; (foreign-declare "#include \"sys/types.h\"")
+;;; (foreign-declare "#include \"sys/socket.h\"")
+;;; (foreign-declare "#include \"ifaddrs.h\"")
+;;; (foreign-declare "#include \"arpa/inet.h\"")
+;;; 
+;;; ;; get IP addresses from ALL interfaces
+;;; (define get-all-ips
+;;;   (foreign-safe-lambda* scheme-object ()
+;;;     "
+;;; 
+;;; // from https://stackoverflow.com/questions/17909401/linux-c-get-default-interfaces-ip-address :
+;;; 
+;;; 
+;;;     C_word lst = C_SCHEME_END_OF_LIST, len, str, *a;
+;;; //    struct ifaddrs *ifa, *i;
+;;; //    struct sockaddr *sa;
+;;; 
+;;;     struct ifaddrs * ifAddrStruct = NULL;
+;;;     struct ifaddrs * ifa = NULL;
+;;;     void * tmpAddrPtr = NULL;
+;;; 
+;;;     if ( getifaddrs(&ifAddrStruct) != 0)
+;;;       C_return(C_SCHEME_FALSE);
+;;; 
+;;; //    for (i = ifa; i != NULL; i = i->ifa_next) {
+;;;     for (ifa = ifAddrStruct; ifa != NULL; ifa = ifa->ifa_next) {
+;;;         if (ifa->ifa_addr->sa_family==AF_INET) { // Check it is
+;;;             // a valid IPv4 address
+;;;             tmpAddrPtr = &((struct sockaddr_in *)ifa->ifa_addr)->sin_addr;
+;;;             char addressBuffer[INET_ADDRSTRLEN];
+;;;             inet_ntop(AF_INET, tmpAddrPtr, addressBuffer, INET_ADDRSTRLEN);
+;;; //            printf(\"%s IP Address %s\\n\", ifa->ifa_name, addressBuffer);
+;;;             len = strlen(addressBuffer);
+;;;             a = C_alloc(C_SIZEOF_PAIR + C_SIZEOF_STRING(len));
+;;;             str = C_string(&a, len, addressBuffer);
+;;;             lst = C_a_pair(&a, str, lst);
+;;;         } 
+;;; 
+;;; //        else if (ifa->ifa_addr->sa_family==AF_INET6) { // Check it is
+;;; //            // a valid IPv6 address
+;;; //            tmpAddrPtr = &((struct sockaddr_in6 *)ifa->ifa_addr)->sin6_addr;
+;;; //            char addressBuffer[INET6_ADDRSTRLEN];
+;;; //            inet_ntop(AF_INET6, tmpAddrPtr, addressBuffer, INET6_ADDRSTRLEN);
+;;; ////            printf(\"%s IP Address %s\\n\", ifa->ifa_name, addressBuffer);
+;;; //            len = strlen(addressBuffer);
+;;; //            a = C_alloc(C_SIZEOF_PAIR + C_SIZEOF_STRING(len));
+;;; //            str = C_string(&a, len, addressBuffer);
+;;; //            lst = C_a_pair(&a, str, lst);
+;;; //       }
+;;; 
+;;; //       else {
+;;; //         printf(\" not an IPv4 address\\n\");
+;;; //       }
+;;; 
+;;;     }
+;;; 
+;;;     freeifaddrs(ifa);
+;;;     C_return(lst);
+;;; 
+;;; "))
+;;; 
+;;; ;; Change this to bias for addresses with a reasonable broadcast value?
+;;; ;;
+;;; (define (ip-pref-less? a b)
+;;;   (let* ((rate (lambda (ipstr)
+;;;                  (regex-case ipstr
+;;;                              ( "^127\\." _ 0 )
+;;;                              ( "^(10\\.0|192\\.168\\.)\\..*" _ 1 )
+;;;                              ( else 2 ) ))))
+;;;     (< (rate a) (rate b))))
+;;;   
+;;; 
+;;; (define (get-my-best-address)
+;;;   (let ((all-my-addresses (get-all-ips))
+;;;         ;;(all-my-addresses-old (vector->list (hostinfo-addresses (hostname->hostinfo (get-host-name)))))
+;;;         )
+;;;     (cond
+;;;      ((null? all-my-addresses)
+;;;       (get-host-name))                                          ;; no interfaces?
+;;;      ((eq? (length all-my-addresses) 1)
+;;;       (car all-my-addresses))                      ;; only one to choose from, just go with it
+;;;      
+;;;      (else
+;;;       (car (sort all-my-addresses ip-pref-less?)))
+;;;      ;; (else 
+;;;      ;;  (ip->string (car (filter (lambda (x)                      ;; take any but 127.
+;;;      ;;    			 (not (eq? (u8vector-ref x 0) 127)))
+;;;      ;;    		       all-my-addresses))))
+;;; 
+;;;      )))
+;;; 
+;;; (define (get-all-ips-sorted)
+;;;   (sort (get-all-ips) ip-pref-less?))
+;;; 
+;;; 
+

ADDED   utils/Makefile.whodunit
Index: utils/Makefile.whodunit
==================================================================
--- /dev/null
+++ utils/Makefile.whodunit
@@ -0,0 +1,9 @@
+.DEFAULT : all
+
+all : whodunit
+
+clean : 
+	rm whodunit
+
+whodunit : whodunit.scm
+	csc -static -L -static -L -lm -L -ldl -L -lpthread -L -lssl -L -lcrypto -L -lz whodunit.scm -o whodunit 

Index: utils/mk_wrapper
==================================================================
--- utils/mk_wrapper
+++ utils/mk_wrapper
@@ -19,10 +19,11 @@
 
 prefix=$1
 cmd=$2
 target=$3
 cfgfile="$prefix/bin/.$(lsb_release -sr)/cfg.sh"
+libdir="$prefix/bin/.$(lsb_release -sr)/lib"
 
 # we wish to create a var in cfg.sh for finding sqlite3 executable
 chicken_bin_dir=$(dirname $(which csi))
 if [[ -e $chicken_bin_dir/sqlite3 ]];then
     sqlite3_exe=$chicken_bin_dir/sqlite3
@@ -30,19 +31,20 @@
     sqlite3_exe=$(which sqlite3)
 fi
 
 if [ "$LD_LIBRARY_PATH" != "" ];then
   echo "INFO: Using LD_LIBRARY_PATH=$LD_LIBRARY_PATH" >&2
+  echo "INFO: Writing $cfgfile" >&2
 ( cat << __EOF
 if [ -z \$MT_ORIG_ENV ]; then
     export MT_ORIG_ENV=\$( $prefix/bin/serialize-env )
 fi
 
 if [ "\$LD_LIBRARY_PATH" != "" ];then
-  export LD_LIBRARY_PATH=$LD_LIBRARY_PATH:\$LD_LIBRARY_PATH
+  export LD_LIBRARY_PATH=$LD_LIBRARY_PATH:\$LD_LIBRARY_PATH:$libdir
 else
-  export LD_LIBRARY_PATH=$LD_LIBRARY_PATH
+  export LD_LIBRARY_PATH=$LD_LIBRARY_PATH:$libdir
 fi
 
 export MT_SQLITE3_EXE=$sqlite3_exe
 __EOF
 ) > $cfgfile

ADDED   utils/mk_wrapper_tool
Index: utils/mk_wrapper_tool
==================================================================
--- /dev/null
+++ utils/mk_wrapper_tool
@@ -0,0 +1,101 @@
+#!/bin/bash
+
+#  Copyright 2006-2017, Matthew Welland.
+# 
+# This file is part of Megatest.
+# 
+#     Megatest is free software: you can redistribute it and/or modify
+#     it under the terms of the GNU General Public License as published by
+#     the Free Software Foundation, either version 3 of the License, or
+#     (at your option) any later version.
+# 
+#     Megatest is distributed in the hope that it will be useful,
+#     but WITHOUT ANY WARRANTY; without even the implied warranty of
+#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#     GNU General Public License for more details.
+# 
+#     You should have received a copy of the GNU General Public License
+#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
+
+prefix=$1
+cmd=$2
+target=$3
+cfgfile="$prefix/bin/.$(lsb_release -sr)/cfg.sh"
+
+# we wish to create a var in cfg.sh for finding sqlite3 executable
+chicken_bin_dir=$(dirname $(which csi))
+if [[ -e $chicken_bin_dir/sqlite3 ]];then
+    sqlite3_exe=$chicken_bin_dir/sqlite3
+else
+    sqlite3_exe=$(which sqlite3)
+fi
+
+if [ "$LD_LIBRARY_PATH" != "" ];then
+  echo "INFO: Using LD_LIBRARY_PATH=$LD_LIBRARY_PATH" >&2
+( cat << __EOF
+if [ -z \$MT_ORIG_ENV ]; then
+    export MT_ORIG_ENV=\$( $prefix/bin/serialize-env )
+fi
+
+if [ "\$LD_LIBRARY_PATH" != "" ];then
+  export LD_LIBRARY_PATH=$LD_LIBRARY_PATH:\$LD_LIBRARY_PATH
+else
+  export LD_LIBRARY_PATH=$LD_LIBRARY_PATH
+fi
+
+export MT_SQLITE3_EXE=$sqlite3_exe
+__EOF
+) > $cfgfile
+  echo 
+else
+  echo "INFO: LD_LIBRARY_PATH not set" >&2
+fi
+
+echo "#!/bin/bash" > $target
+
+if [[ $cmd =~ dboard ]]; then
+    cat >> $target <<'EOF'
+
+# # disable if not running on homehost
+# if [[ -e .homehost ]]; then
+#   homehostname=$( host `cat .homehost` | awk '{print $NF}' | sed 's/\.$//' )
+#   hostname=$( hostname -f )
+# 
+#   if [[ ! ($homehostname == $hostname) ]]; then
+#     echo "ERROR: this host ($hostname) is not the homehost ($homehostname) for this megatest run area.  Cannot start dashboard."
+#     echo "       Please log into homehost before launching dashboard."
+#     exit 1
+#   fi
+# fi
+
+# check that $DISPLAY is set
+if [[ -z $DISPLAY ]]; then
+   echo 'ERROR: $DISPLAY environment variable is not set; megatest dashboard requires X display address to be set in $DISPLAY.'
+   exit 1
+fi
+
+# check that $DISPLAY is proper
+if [[ -x $(which xdpyinfo  2>/dev/null) ]]; then
+  if ! xdpyinfo -display "$DISPLAY" &>/dev/null; then
+    echo 'ERROR: megatest dashboard cannot open display "'$DISPLAY'".  Please check $DISPLAY environment variable.'
+    exit 1
+  fi
+fi
+EOF
+
+fi
+
+cat >> $target << EOF 
+if [[ \$(ulimit -a | grep 'open files' | awk '{print \$4}') -gt 10000 ]];then ulimit -n 10000;fi
+EOF
+
+# echo "#!/bin/bash" > $target
+# echo "exec $prefix/bin/.\$(lsb_release -sr)/bin/$cmd \"\$@\"" >> $target
+
+echo "lsbr=\$(lsb_release -sr)" >> $target
+if [ "$LD_LIBRARY_PATH" != "" ];then
+  echo "source $prefix/bin/.\$lsbr/cfg.sh" >> $target
+fi
+
+# echo "if [[ -e \$lsbr ]];then source \$lsbr;fi" >> $target
+echo "exec $chicken_bin_dir/$cmd \"\$@\"" >> $target

Index: utils/remrun
==================================================================
--- utils/remrun
+++ utils/remrun
@@ -40,6 +40,12 @@
   exit
 fi
 
 export NBFAKE_HOST=$1
 shift
-exec nbfake $*
+cmd=""
+for var in $(env | egrep "^(PARENT_|MT_)"|cut -d= -f1);do
+  new_var="`echo ${!var}`"
+  cmd="$cmd export $var=$new_var;" 
+done
+cmd="$cmd $*"
+exec nbfake $cmd

ADDED   utils/softlock/Makefile
Index: utils/softlock/Makefile
==================================================================
--- /dev/null
+++ utils/softlock/Makefile
@@ -0,0 +1,11 @@
+#Need a chicken 5.1.0 with system-information egg installed in your path 
+
+.DEFAULT : all
+
+all : softlock
+
+softlock : softlock.scm
+	csc -static -L -static -L -lm -L -dl -L -lpthread -L -lcrypto -L -lz softlock.scm 
+
+clean: 
+	rm softlock *.o

ADDED   utils/softlock/softlock.scm
Index: utils/softlock/softlock.scm
==================================================================
--- /dev/null
+++ utils/softlock/softlock.scm
@@ -0,0 +1,135 @@
+;;======================================================================
+;; Copyright 2019, Matthew Welland.
+;; 
+;; This file is part of Megatest.
+;; 
+;;     Megatest is free software: you can redistribute it and/or modify
+;;     it under the terms of the GNU General Public License as published by
+;;     the Free Software Foundation, either version 3 of the License, or
+;;     (at your option) any later version.
+;; 
+;;     Megatest is distributed in the hope that it will be useful,
+;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;     GNU General Public License for more details.
+;; 
+;;     You should have received a copy of the GNU General Public License
+;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
+;;
+;;======================================================================
+
+(import (chicken string) 
+        (chicken pathname) 
+        system-information 
+        (chicken file posix) 
+        (chicken process-context posix) 
+        (chicken process-context) 
+        (chicken process) 
+        (chicken file posix) 
+        (chicken file) 
+        (chicken time) 
+        srfi-18
+)
+
+
+(if (< (length (command-line-arguments)) 2) ;; require at least lockfile command
+    (begin
+      (print "Usage: 
+softlock lockfile command args ...
+
+Softlock does weak, transient locking. This is useful to slow down a
+deluge of events that can overwhelm hardware or software systems.
+
+Locks are only good for one second, just enough time to spread events
+out.
+
+On NFS the Unix file locking mechanism works well but lock handling on
+the filers can be overwhelmed by many locks occuring quickly. Jobs
+that must use NFS file locks can use softlock to minimize the rate
+that the file locks are created, preventing the NFS filer from being
+swamped.
+
+Environment variables:
+
+  SOFTLOCK_DEBUG_MODE - if defined enable some messages
+
+WARNING: the file <lockfile>.softlock will be overwritten and removed by softlock!
+
+Part of the Megatest project http://www.kiatoa.com/fossils/megatest")
+      (exit 1)))
+
+(define (read-lock-file fname)
+  (handle-exceptions
+   exn
+   (begin
+     (if (get-environment-variable "SOFTLOCK_DEBUG_MODE")
+	 (print "Exception on reading lock file. exn=" exn))
+     #f)
+   (with-input-from-file fname
+     read-line)))
+
+(define (lock-file-old fname)
+  (and (file-exists? fname)
+       (> (- (current-seconds)(file-modification-time fname)) 1))) ;; hard coded to one second
+
+(define (check-locked-by-me fname mykey)
+  (if (file-exists? fname)
+      (let ((lock-data (read-lock-file fname)))
+	(if (and lock-data
+		 (equal? mykey lock-data))
+	    #t
+	    (not (lock-file-old fname)))) ;; if the lockfile is old we are NOT locked.
+      #f))
+		
+(define (check-locked-by-someone-else fname mykey)
+  (if (file-exists? fname)
+      (let ((lock-data (read-lock-file fname)))
+	(and lock-data
+	     (not (equal? mykey lock-data))
+	     (not (lock-file-old fname)))) ;; if the lockfile is old we are NOT locked.
+      #f))
+
+(define (take-lock fname mykey)
+  (with-output-to-file fname
+    (lambda ()
+      (print mykey))))
+
+(define (run-the-command command params)
+  (process-wait (process-run command params)))
+
+(let* ((lockfile (car (command-line-arguments)))
+       (fulllock (conc lockfile ".softlock")) ;; prevent accidentally removing important files
+       (lockfdir (pathname-directory lockfile))
+       (command  (cadr (command-line-arguments)))
+       (params   (cddr (command-line-arguments)))
+       (mykey    (conc (get-host-name) "-" (current-process-id))))
+  
+  ;; sanity checks
+  (cond
+   ((not lockfdir)
+    (print "ERROR: lock file parameter must include path component, e.g. ./mylock")
+    (exit 1))
+   ((not (file-writable? lockfdir))
+    (print "ERROR: Can not access directory for lock " lockfdir)
+    (exit 1))
+   ;; add more sanity checks here
+   )
+
+  (let loop ((remtries 10))
+    (if (> remtries 0)
+	(if (check-locked-by-someone-else fulllock mykey)
+	    (begin
+	      (print "... lock " fulllock " exists, waiting...")
+	      (thread-sleep! 1.9)
+	      (loop (- remtries 1)))
+	    (begin
+	      (take-lock fulllock mykey)
+	      (if (check-locked-by-me fulllock mykey)
+		  (run-the-command command params)
+		  (begin ;; didn't get the lock
+		    (thread-sleep! (+ 1.9 (/ 1 (+ 1 (random 20))))) ;; add some noise to prevent nyquist problems
+		    (loop (- remtries 1))))))
+	(begin
+	  (print "ERROR: not able to get the lock. Gonna take it and proceed...")
+	  (take-lock fulllock mykey)
+	  (run-the-command command params)))))

Index: utils/whodunit.scm
==================================================================
--- utils/whodunit.scm
+++ utils/whodunit.scm
@@ -13,11 +13,25 @@
 ;;     GNU General Public License for more details.
 ;; 
 ;;     You should have received a copy of the GNU General Public License
 ;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
 ;;
-(use posix srfi-69)
+(module whodunit
+
+ *
+
+
+(import 
+  (chicken process-context)
+  (chicken process)
+  (chicken string)
+  (chicken base)
+  (chicken sort)
+  (chicken io)
+  srfi-69
+  scheme
+)
 
 (define *numsamples* (or (and (> (length (argv)) 1)
                               (string->number (cadr (argv))))
                          3))
 
@@ -24,11 +38,11 @@
 (define (topdata)
   (with-input-from-pipe
    (conc "top -b -n " *numsamples* " -d 0.1")
    read-lines))
 
-(define (cleanup-data topdat)list
+(define (cleanup-data topdat)
   (let loop ((hed (car topdat))
               (tal (cdr topdat))
               (res '()))
     (let* ((line-list (string-split hed))
            (nums      (map (lambda (indat)(or (string->number indat) indat)) line-list))
@@ -37,29 +51,37 @@
            (new-res   (if not-data res (cons nums res))))
       (if (null? tal)
           new-res
           (loop (car tal)(cdr tal) new-res)))))
 
+
+;; sum up
+(define (sum-up data ht)
+  (for-each
+   (lambda (indat)
+     (let ((pid (car indat))
+           (usr (cadr indat))
+           (cpu (list-ref indat 8)))
+       (hash-table-set! ht usr (+ cpu (hash-table-ref/default ht usr 0)))))
+   data))
+
+(define (print-results userhash)
+  (for-each
+   (lambda (usr)
+     (let* ((usage (inexact->exact (round (/ (hash-table-ref userhash usr) *numsamples*)))))
+       (if (> usage 0)
+	   (print usr (if (< (string-length usr) 8) "\t\t" "\t") usage))))
+   (sort (hash-table-keys userhash)
+	 (lambda (a b)
+           (> (hash-table-ref userhash a)
+	      (hash-table-ref userhash b))))))
+  
+)
+(import whodunit srfi-69 (chicken sort))
+
 (print "Getting " *numsamples* " samples of cpu usage data.")
 (define data (cleanup-data (topdata)))
 (define pidhash  (make-hash-table))
 (define userhash (make-hash-table))
-
-;; sum up and normalize the 
-(for-each
- (lambda (indat)
-   (let ((pid (car indat))
-         (usr (cadr indat))
-         (cpu (list-ref indat 8)))
-     (hash-table-set! userhash usr (+ cpu (hash-table-ref/default userhash usr 0)))))
- data)
-
-(for-each
- (lambda (usr)
-   (print usr
-          (if (< (string-length usr) 8) "\t\t" "\t")
-          (inexact->exact (round (/ (hash-table-ref userhash usr) *numsamples*)))))
- (sort (hash-table-keys userhash)
-       (lambda (a b)
-         (> (hash-table-ref userhash a)
-            (hash-table-ref userhash b)))))
-
+(sum-up data userhash)
+
+(print-results userhash)