Megatest

#  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]

# make install CSCOPTS='-accumulate-profile -profile-name $(PWD)/profile-ww$(shell date +%V.%u)'
# 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 \
SRCFILES = common.scm items.scm launch.scm ods.scm runconfig.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 \
           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	\
   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 
           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


# 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
# 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		\
GUISRCF  = dashboard-context-menu.scm dashboard-tests.scm dashboard-guimonitor.scm gutils.scm dcommon.scm tree.scm vg.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

mofiles/%.o : %.scm
	mkdir -p mofiles
	csc $(CSCOPTS) -J -c $< -o mofiles/$*.o
mofiles/%.o  %.import.scm : %.scm
	@[ -e mofiles ] || mkdir -p mofiles
	csc $(CSCOPTS) -I $* -J -c $< -o mofiles/$*.o
	@touch $*.import.scm # ensure it is touched after the .o is made

ADTLSCR=mt_laststep mt_runstep mt_ezstep
HELPERS=$(addprefix $(PREFIX)/bin/,$(ADTLSCR))
DEPLOYHELPERS=$(addprefix deploytarg/,$(ADTLSCR))
MTESTHASH=$(shell fossil info|grep checkout:| awk '{print $$2}')

ifeq ($(MTESTHASH),)
$(error MTESTHASH is broken!)
endif

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 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)
	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)
	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
	csc $(CSCOPTS) $(OFILES) $(MOFILES) mtut.scm -o mtut

include makefile.inc

TCMTOBJS = \
	api.o \
	archive.o \
	cgisetup/models/pgdb.o \
	client.o \
	common.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 \
	subrun.o

#        mofiles/commonmod.o \

tcmt : $(TCMTOBJS) tcmt.scm
	csc $(CSCOPTS) $(TCMTOBJS) tcmt.scm -o tcmt
	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
	mkdir -p $(PREFIX)/share/docs
	$(INSTALL) docs/manual/megatest_manual.html $(PREFIX)/share/docs/megatest_manual.html
	for png in $(PNGFILES);do $(INSTALL) docs/manual/$$png $(PREFIX)/share/docs/$$png;done

# add a fake dependency so this doens't copy everytime
$(PREFIX)/share/js/jquery-3.1.0.slim.min.js : # .fslckout
	mkdir -p $(PREFIX)/share/js
	fossil wiki export java-script-lib > $(PREFIX)/share/js/jquery-3.1.0.slim.min.js

$(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)
# Special dependencies for the includes
#	csc $(CSCOPTS) $(OFILES) $(GOFILES) multi-dboard.scm -o multi-dboard

# 
common.o : mofiles/commonmod.o

# $(PREFIX)/bin/revtagfsl : utils/revtagfsl.scm
#	csc utils/revtagfsl.scm -o $(PREFIX)/bin/revtagfsl

tests.o db.o launch.o runs.o dashboard-tests.o				\
# 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
dashboard-context-menu.o dashboard-guimonitor.o dashboard-main.o	\
monitor.o dashboard.o archive.o megatest.o : db_records.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

common_records.scm : altdb.scm

mofiles/stml2.o : mofiles/cookie.o
configf.o : mofiles/commonmod.o

vg.o dashboard.o : vg_records.scm

dcommon.o : run_records.scm
# Temporary while transitioning to new routine
# runs.o : run-tests-queue-classic.scm  run-tests-queue-new.scm

mofiles/stml2.o : mofiles/cookie.o

# special include based modules
mofiles/pkts.o      : pkts/pkts.scm
# 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

# for the modularized stuff
mofiles/rmtmod.o : mofiles/commonmod.o
rmt.o : mofiles/ducttape-lib.o mofiles/pkts.o mofiles/stml2.o mofiles/mutils.o mofiles/mtargs.o

megatest-fossil-hash.scm : $(SRCFILES) megatest.scm *_records.scm
	echo "(define megatest-fossil-hash \"$(MTESTHASH)\")" > megatest-fossil-hash.new
	if ! diff -q megatest-fossil-hash.new megatest-fossil-hash.scm ; then echo copying .new to .scm;cp -f megatest-fossil-hash.new megatest-fossil-hash.scm;fi

$(OFILES) $(GOFILES) : common_records.scm 

# This having the full list of MOFILES cause everything to be rebuilt every time.
#
%.o : %.scm $(MOFILES)
	csc $(CSCOPTS) -c $< $(MOFILES)

$(PREFIX)/bin/.$(ARCHSTR)/mtest : mtest utils/mk_wrapper
# %.o : %.scm $(MOFILES)
# 	csc $(CSCOPTS) -c $< $(MOFILES)
#
%.o : %.scm
	csc $(CSCOPTS) -c $<

# specific rules for .o files that genuninely depend on mofiles/something
#
megatest.o : megatest.scm stml2.o mutils.o commonmod.o
	csc $(CSCOPTS) -c megatest.scm stml2.o mutils.o commonmod.o

dashboard.o : dashboard.scm stml2.o mutils.o commonmod.o dbmod.o
	csc $(CSCOPTS) -c megatest.scm stml2.o mutils.o commonmod.o dbmod.o

common.o : megatest.scm mofiles/commonmod.o common.scm
	csc $(CSCOPTS) -c common.scm mofiles/commonmod.o

configf.o : configf.scm mofiles/commonmod.o
	csc $(CSCOPTS) -c configf.scm mofiles/commonmod.o

$(PREFIX)/bin/.$(ARCHSTR)/bin/mtest : mtest 
	@echo Installing to PREFIX=$(PREFIX)
	$(INSTALL) mtest $(PREFIX)/bin/.$(ARCHSTR)/mtest
	$(INSTALL) mtest $(PREFIX)/bin/.$(ARCHSTR)/bin/mtest

$(PREFIX)/bin/megatest : $(PREFIX)/bin/.$(ARCHSTR)/bin/mtest utils/mk_wrapper
	utils/mk_wrapper $(PREFIX) mtest $(PREFIX)/bin/megatest
	chmod a+x $(PREFIX)/bin/megatest

$(PREFIX)/bin/.$(ARCHSTR)/ndboard : ndboard
	$(INSTALL) ndboard $(PREFIX)/bin/.$(ARCHSTR)/ndboard
$(PREFIX)/bin/.$(ARCHSTR)/bin/ndboard : ndboard
	$(INSTALL) ndboard $(PREFIX)/bin/.$(ARCHSTR)/bin/ndboard

$(PREFIX)/bin/newdashboard : $(PREFIX)/bin/.$(ARCHSTR)/ndboard utils/mk_wrapper
	utils/mk_wrapper $(PREFIX) ndboard $(PREFIX)/bin/newdashboard
	chmod a+x $(PREFIX)/bin/newdashboard

# mtutil

$(PREFIX)/bin/.$(ARCHSTR)/mtut : mtut
	$(INSTALL) mtut $(PREFIX)/bin/.$(ARCHSTR)/mtut
$(PREFIX)/bin/.$(ARCHSTR)/bin/mtut : mtut
	$(INSTALL) mtut $(PREFIX)/bin/.$(ARCHSTR)/bin/mtut

install-mtut : mtut
	$(INSTALL) mtut $(PREFIX)/bin/mtut

$(PREFIX)/bin/mtutil : $(PREFIX)/bin/.$(ARCHSTR)/mtut utils/mk_wrapper
$(PREFIX)/bin/mtutil : $(PREFIX)/bin/.$(ARCHSTR)/bin/mtut utils/mk_wrapper
	utils/mk_wrapper $(PREFIX) mtut $(PREFIX)/bin/mtutil
	chmod a+x $(PREFIX)/bin/mtutil

# mtexec

mtexec: $(OFILES) $(MOFILES) megatest-fossil-hash.scm mtexec.scm
	csc $(CSCOPTS) $(OFILES) $(MOFILES) mtexec.scm -o mtexec

$(PREFIX)/bin/.$(ARCHSTR)/mtexec : mtexec
	$(INSTALL) mtexec $(PREFIX)/bin/.$(ARCHSTR)/mtexec
$(PREFIX)/bin/.$(ARCHSTR)/bin/mtexec : mtexec
	$(INSTALL) mtexec $(PREFIX)/bin/.$(ARCHSTR)/bin/mtexec

$(PREFIX)/bin/mtexec : $(PREFIX)/bin/.$(ARCHSTR)/mtexec utils/mk_wrapper
$(PREFIX)/bin/mtexec : $(PREFIX)/bin/.$(ARCHSTR)/bin/mtexec utils/mk_wrapper
	utils/mk_wrapper $(PREFIX) mtexec $(PREFIX)/bin/mtexec
	chmod a+x $(PREFIX)/bin/mtexec

# tcmt

$(PREFIX)/bin/.$(ARCHSTR)/tcmt : tcmt
	$(INSTALL) tcmt $(PREFIX)/bin/.$(ARCHSTR)/tcmt
$(PREFIX)/bin/.$(ARCHSTR)/bin/tcmt : tcmt
	$(INSTALL) tcmt $(PREFIX)/bin/.$(ARCHSTR)/bin/tcmt

$(PREFIX)/bin/tcmt : $(PREFIX)/bin/.$(ARCHSTR)/tcmt utils/mk_wrapper
$(PREFIX)/bin/tcmt : $(PREFIX)/bin/.$(ARCHSTR)/bin/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
	$(INSTALL) $< $@
	chmod a+x $@

	$(INSTALL) $< $@
	chmod a+x $@

$(PREFIX)/bin/nbfind : utils/nbfind
	$(INSTALL) $< $@
	chmod a+x $@

$(PREFIX)/bin/loadrunner : utils/loadrunner
$(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
	$(INSTALL) $< $@
	chmod a+x $@

deploytarg/nbfind : utils/nbfind
	$(INSTALL) $< $@
	chmod a+x $@

$(PREFIX)/bin/mtest-reaper: helpers/mtest-reaper.scm helpers/ducttape-lib.scm helpers/inteldate.scm helpers/mimetypes.scm
	make -C helpers $@ PREFIX=$(PREFIX) INSTALL=$(INSTALL) ARCHSTR=$(ARCHSTR)

mtest-reaper: $(PREFIX)/bin/mtest-reaper

# install dashboard as dboard so wrapper script can be called dashboard
$(PREFIX)/bin/.$(ARCHSTR)/dboard : dboard $(FILES) utils/mk_wrapper
$(PREFIX)/bin/.$(ARCHSTR)/bin/dboard : dboard $(FILES) 
	$(INSTALL) dboard $(PREFIX)/bin/.$(ARCHSTR)/bin/dboard

$(PREFIX)/bin/dashboard : $(PREFIX)/bin/.$(ARCHSTR)/bin/dboard utils/mk_wrapper
	utils/mk_wrapper $(PREFIX) dboard $(PREFIX)/bin/dashboard
	chmod a+x $(PREFIX)/bin/dashboard
	$(INSTALL) dboard $(PREFIX)/bin/.$(ARCHSTR)/dboard

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/loadrunner $(PREFIX)/bin/viewscreen $(PREFIX)/bin/mt_xterm \
install : $(PREFIX)/bin/.$(ARCHSTR) $(PREFIX)/bin/.$(ARCHSTR)/bin/mtest $(PREFIX)/bin/megatest \
          $(PREFIX)/bin/.$(ARCHSTR)/bin/dboard $(PREFIX)/bin/dashboard $(HELPERS) $(PREFIX)/bin/nbfake \
          $(PREFIX)/bin/.$(ARCHSTR)/bin/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)/bin/newdashboard

$(PREFIX)/bin/.$(ARCHSTR) : 
	mkdir -p $(PREFIX)/bin/.$(ARCHSTR)
	mkdir -p $(PREFIX)/bin/.$(ARCHSTR)/bin
	mkdir -p $(PREFIX)/bin/.$(ARCHSTR)/lib

test: tests/tests.scm
	cd tests;csi -I .. -b -n tests.scm

ext-tests/.fslckout : $(MTQA_FOSSIL)
	mkdir -p ext-tests
	cd ext-tests;fossil open --nested $(MTQA_FOSSIL)

$(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 -rf share

	rm -f $(OFILES) $(GOFILES) $(MOFILES) $(TCMTOBJS)		\
            $(PREFIX)/megatest $(PREFIX)/dashboard mtest mtutil mtut	\
            tcmt readline-fix.scm serialize-env dboard dboard.o		\
#======================================================================
# Make the records files
            megatest.o dashboard.o megatest-fossil-hash.* altdb.scm	\
            mofiles/*.o vg.o cookie.o dashboard-main.o	\
#======================================================================

# vg_records.scm : records.sh
#	./records.sh
            ducttape-lib.o ftail.o mutils.o pkts.o rmtmod.o stml2.o	\
            tcmt.o
	rm -rf share

#======================================================================
# Deploy section (not complete yet)
#======================================================================

# Eggs to install (straightforward ones)
EGGS=matchable readline aokpropos 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

$(DEPLOYHELPERS) : utils/mt_*
	$(INSTALL) $< $@
	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

sd : datashare-testing/sd

	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;\
	fi

altdb.scm :
	echo ";; optional alternate db setup" > altdb.scm
	echo "(define *available-db* (make-hash-table))" >> altdb.scm
	if  csi -ne '(use mysql-client)';then \
           echo "(use mysql-client)(hash-table-set! *available-db* 'mysql #t)" >> altdb.scm; \
	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

# 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

buildmanual:
	cd docs/manual && make

wikipage=plan
editwiki:
	cd docs/manual && ../../utils/editwiki $(wikipage)

viewmanual:
	arora docs/manual/megatest_manual.html

targets:
	@grep : Makefile | perl -ne '/^([A-Za-z0-9_-]+):/ && print "$$1\n"'


unit :
	cd tests;make unit

#======================================================================
# Attic
#======================================================================

# 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

# 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

# wikipage=plan
# editwiki:
#	cd docs/manual && ../../utils/editwiki $(wikipage)

# 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 \

# 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

# 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

#	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

#======================================================================
# Make the records files
#======================================================================

# vg_records.scm : records.sh
#	./records.sh

# $(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 $@

# ARCHSTR=$(shell uname -m)_$(shell uname -r)
# BASH_MACHTYPE=$(shell bash -c "echo \$$MACHTYPE")
# ARCHSTR=$(BASH_MACHTYPE)_$(shell lsb_release -sr)

INFO: (0) Number non-cached queries 74289
INFO: (0) Average non-cached time   1055.09826488444 ms
INFO: (0) Server shutdown complete. Exiting

Start: 0 at Sun Apr 28 22:18:25 MST 2013
Max:  52 at Sun Apr 28 23:06:59 MST 2013
End:   6 at Sun Apr 28 23:47:51 MST 2013

========================================================================

#     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".
      Do not make changes in the wiki, they will be lost!

See the file "DONE" to see completed items.
FIXME
====

.dump
----------------
WARNING: disk disk0 at path "/mfs/tmp/archive" is not a directory - ignoring it.

Warning (#<thread: archive-bup-thread>): in thread: unbound variable: block-id

        Call history:

        common.scm:693: hash-table-ref/default    
        common.scm:694: current-seconds   
        common.scm:697: hash-table-set!   
        common.scm:2232: debug:print      
        common_records.scm:140: debug:debug-mode          
        common_records.scm:141: with-output-to-port       
        common.scm:2245: directory?       
        common.scm:2246: common:low-noise-print   
        common.scm:692: g2022     
        common.scm:692: g2022     
        common.scm:692: string-intersperse        
        common.scm:693: hash-table-ref/default    
        common.scm:694: current-seconds   
        common.scm:2261: debug:print      
        common_records.scm:140: debug:debug-mode          
        archive.scm:125: debug:print            <--
INFO: (0) Estimating disk space usage for scriptinc/: 184

Error: uncaught exception: #<condition: (exn runtime)>

        Call history:

        common.scm:1299: ##sys#get-keyword        
        common.scm:1299: call-with-current-continuation   
        common.scm:1299: with-exception-handler   
        common.scm:1299: ##sys#call-with-values   
        common.scm:1304: thunk    
        common.scm:1310: file-exists?     
        common.scm:1299: k2554    
        common.scm:1299: g2558    
        runs.scm:2438: common:get-disk-space-used         
        common.scm:2128: conc     
        common.scm:2128: with-input-from-pipe     
        runs.scm:2438: debug:print-info   
        common_records.scm:235: debug:debug-mode          
        common_records.scm:236: port?     
        common_records.scm:236: with-output-to-port       
        runs.scm:2443: thread-join!             <--
Press any key to continue
----------------

TODO
====

WW15
. fill newview matrix with data, filter pipeline gui elements
. improve [script], especially indent handling
. Dashboard should resist running from non-homehost

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
. Jenkins junit XML support
. 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?
.. Move main.db to global?
.. [ run-id.db inmemdb last-mod last-read last-sync inuse ]
. Re-work all queries to use run-id to dereference server
. Open main.db directly in calls to -runtests etc. No need to talk remote?
. remove common:faux-lock

;;======================================================================
;; 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
	regex srfi-1)

(define (adjutant-run)
  (print "Running the adjutant!"))

)

    get-run-times
    get-targets
    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
    simple-get-runs
    get-num-runs

                   ;; RUNS
                   ((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))
                   ((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))
                   ((get-num-runs)                 (apply db:get-num-runs dbstruct params))
                   ((get-runs-cnt-by-patt)         (apply db:get-runs-cnt-by-patt dbstruct params))

	(hash-table-ref blockid-cache key)
	(let* ((pscript     (configf:lookup *configdat* "archive" "pathscript"))
	       (pscript-cmd (conc pscript " " testsuite-name " " target " " run-name " " test-name))
	       (apath       (if pscript
				(handle-exceptions
				 exn
				 (begin
				   (debug:print 0 "ERROR: script \"" pscript-cmd "\" failed to run properly.")
				   (debug:print 0 *default-log-port* "ERROR: script \"" pscript-cmd "\" failed to run properly.")
				   (exit 1))
				 (with-input-from-pipe
				  pscript-cmd
				  read-line))
				#f)) ;; this is the user-calculated archive path
	       (adisks    (archive:get-archive-disks))
	       (best-disk (common:get-disk-with-most-free-space adisks dneeded)))

		     (archive-path  (conc bdisk-path "/" archive-name))
		     (block-id      (rmt:archive-register-block-name bdisk-id archive-path)))
		;;   (allocation-id (rmt:archive-allocate-testsuite/area-to-block block-id testsuite-name area-key)))
		(if block-id ;; (and block-id allocation-id)
		    (let ((res (cons block-id archive-path)))
		      (hash-table-set! blockid-cache key res)
		      res)
		    (begin
		      (debug:print 0 *default-log-port* "WARNING: no disk found for " target ", " run-name ", " test-name ",  archive-path=" archive-path)
		    #f))
	      #f)) ;; no best disk found
		      #f)))
	      (begin
		(debug:print 0 *default-log-port* "WARNING: no disk found for " target ", " run-name ", " test-name ", block-id=" block-id)
		#f)))))) ;; no best disk found
	  )))

;; archive - run bup
;;
;; 1. create the bup dir if not exists
;; 2. start the du of each directory
;; 3. gen index
;; 4. save

				     (substring test-physical-path
						0
						partial-path-index)
				     #f))
	      ;; we need our archive dir checked for every test to enable folks who want to store other ways.
	      (archive-info (archive:allocate-new-archive-block blockid-cache *toppath* tsname min-space target run-name test-name))
	      (archive-dir  (if archive-info (cdr archive-info) #f))
	      (archive-id   (if archive-info (car archive-info) -1))
	      (archive-id   (if archive-info (car archive-info) -1)))

	      )
	 
	 (if (not archive-dir) ;; no archive disk found, this is fatal
	     (begin
	       (debug:print 0 *default-log-port* "FATAL: No archive disks found. Please add disks with at least "
			    min-space " MB space to the [archive-disks] section of megatest.config")
	       (debug:print 0 *default-log-port* "       use [archive] minspace to specify minimum available space")
	       (debug:print 0 *default-log-port* "   disks: "

     (lambda (test-base)
       (let* ((disk-group (hash-table-ref disk-groups test-base))
	      (arch-group (hash-table-ref arch-groups test-base))
	      (arch-info  (car arch-group)) ;; don't know yet how this will work, can I get more than one possibility?
	      (archive-id    (car arch-info))
	      (archive-dir   (cdr arch-info)))
	 (debug:print 0 *default-log-port* "Processing disk-group " test-base)
	 (let* ((test-paths (hash-table-ref disk-groups test-base)))
	 (let* ((test-paths-in (hash-table-ref disk-groups test-base))
		(test-paths    (if (args:get-arg "-include")
				   (let ((subpaths (string-split (args:get-arg "-include") ",")))
				     (apply append
					    (map (lambda (p)
						   (map (lambda (subp)
							  (conc p "/" subp))
							subpaths))
						 test-paths-in)))
				   test-paths-in)))
	   (if (not (common:file-exists? archive-dir))
	       (create-directory archive-dir #t))
	   (case archiver
	     ((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)

	       (hash-table-ref test-groups test-base))))
	   ;; (mutex-unlock! bup-mutex)
	   (for-each
	    (lambda (test-dat)
	      (let ((test-id           (db:test-get-id        test-dat))
		    (run-id            (db:test-get-run_id    test-dat)))
		(rmt:test-set-archive-block-id run-id test-id archive-id)
		(if (member archive-command '("save-remove"))
		    (runs:remove-test-directory test-dat 'archive-remove))))
		(if (member (symbol->string archive-command) '("save-remove"))
                    (begin 
                     (debug:print-info 0 *default-log-port* "remove testdat")
		    (runs:remove-test-directory test-dat 'archive-remove)))))
	    (hash-table-ref test-groups test-base)))))
       (hash-table-keys disk-groups))
    #t))

(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
  ;;

	      (mutex-unlock! rp-mutex)
	      (new-test-physical-path  (conc best-disk "/" test-partial-path))
	      (archive-block-id        (db:test-get-archived 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-internal-path   (conc (common:get-testsuite-name) "-" run-id "/latest/" test-partial-path))
	      (include-paths           (args:get-arg "-include"))
	      (exclude-pattern         (args:get-arg "-exclude-rx"))
	      (exclude-file            (args:get-arg "-exclude-rx-from")))
	 
	 ;; 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))

		 (debug:print-info 0 *default-log-port* "Restoring archived data to " new-test-physical-path " from archive in " archive-path " ... " archive-internal-path)
		 ;; (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))))
     (filter vector? tests))))
	 

(define (common:get-youngest-test tests)
  (if (null? tests)
      #f
      (let ((res #f))
	(for-each
	 (lambda (test-dat)
	   (let ((event-time (db:test-get-event_time test-dat)))
	     (if (or (not res)
		     (> event-time (db:test-get-event_time res)))
		 (set! res test-dat))))
	 tests)
	res)))
	   
;; from an archive get a specific path - works ONLY with bup for now
;;
(define (archive:bup-get-data archive-command run-id-in run-name-in tests rp-mutex bup-mutex)
  (if (null? tests)
      (debug:print-info 0 *default-log-port* "get-data called with no matching tests to operate on.")
      
      (let* ((bup-exe      (or (configf:lookup *configdat* "archive" "bup") "bup"))
	     (linktree     (common:get-linktree)) ;; (configf:lookup *configdat* "setup" "linktree")))
	     ;; (test-dat     (common:get-youngest-test tests))
	     (destpath     (args:get-arg "-dest")))
	(cond
	 ((null? tests)
	  (debug:print-error 0 *default-log-port*
			     "No test matching provided target, runname pattern and test pattern found."))
	 ((file-exists? destpath)
	  (debug:print-error 0 *default-log-port*
			     "Destination path alread exists! Please remove it before running get."))
	 (else
	  (let loop ((rem-tests tests))
	    (let* ((test-dat          (common:get-youngest-test rem-tests))
		   (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))
		   (run-name          (rmt:get-run-name-from-id run-id))
		   (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)))
		   ;; note the trailing slash to get the dir inspite of it being a link
		   (test-path         (conc linktree "/" test-partial-path))
		   (archive-block-id        (db:test-get-archived 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)
						#f))
		   (archive-internal-path   (conc (common:get-testsuite-name) "-" run-id
						  "/latest/" 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 (and archive-path ;; no point in proceeding if there is no actual archive
		       (not toplevel/children))
		  (begin
		    (let* ((bup-restore-params (append (list "-d" archive-path "restore" "-C" (or destpath "data"))
						       ;; " " ;; What is the empty string for?
						       (if include-paths
							   (map (lambda (p)
								  (conc archive-internal-path "/" p))
								(string-split include-paths ","))
							   (list archive-internal-path)))))
		      (debug:print-info 0 *default-log-port* "Restoring archived data to " (or destpath "data")
					" from archive in " archive-path " ... " archive-internal-path)
		      (run-n-wait bup-exe params: bup-restore-params print-cmd: #t)))
		  (let ((new-rem-tests (filter (lambda (tdat)
						 (or (not (eq? (db:test-get-id tdat) test-id))
						     (not (eq? (db:test-get-run_id tdat) run-id))))
					       rem-tests) ))
		    (debug:print-info 0 *default-log-port*
				      "No archive path in the record for run-id=" run-id
				      " test-id=" test-id ", skipping.")
		    (if (null? new-rem-tests)
			(begin
			  (debug:print-info 0 *default-log-port* "No archives found for " target "/" run-name "...")
			  #f)
			(loop new-rem-tests)))))))))))
  

;;  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/>.

(use json)
(use ducttape-lib)

(define (get-last-runname area-path target)
  (let* ((run-data     (with-input-from-pipe (conc "megatest -list-runs % -target " target " -fields runs:runname,event_time -dumpmode sexpr -start-dir " area-path)
			 read)))
    (if (or (not run-data)
	    (null? run-data))
	#f
	(let* ((name-time    (let ((dat (map cdadr (alist-ref target run-data equal?)))) ;; (("runname" . "2017w07.0-0047") ("event_time" . "1487490424"))
			       ;; (print "dat=" dat)
			       (map (lambda (item)
				      (cons (alist-ref "runname" item equal?)
					    (string->number (alist-ref "event_time" item equal?))))
				    dat)))
	       (sorted       (sort name-time (lambda (a b)(> (cdr a)(cdr b)))))
	       (last-name    (if (null? sorted)
				 #f
				 (caar sorted))))
	  last-name))))

(define (str-first-char->number str)
  (char->integer (string-ref str 0)))
 
;; example of how to set up and write target mappers
;; NOTE: maps a *list* of targets!
;;
;; (? target run-name area area-path reason contour mode-patt)
;;
(add-target-mapper 'prefix-contour 
		   (lambda (runkey area contour)
		     (print "target: " runkey)
		     (list (conc contour "/" runkey))))
#;(add-target-mapper 'prefix-area-contour
		   (lambda (target run-name area area-path reason contour mode-patt)
		     (conc area "/" contour "/" target)))
  
(add-runname-mapper 'corporate-ww
		    (lambda (target run-name area area-path reason contour mode-patt)
		      (print "corporate-ww called with: target=" target " run-name=" run-name " area=" area " area-path=" area-path " reason=" reason " contour=" contour " mode-patt=" mode-patt)
		      (let* ((last-name   (get-last-runname area-path target))
			     (last-letter (let* ((ch (if (string? last-name)
							 (let ((len (string-length last-name)))
							   (substring last-name (- len 1) len))
							 "a"))
						 (chnum (str-first-char->number ch))
						 (a     (str-first-char->number "a"))
						 (z     (str-first-char->number "z")))
					    (if (and (>= chnum a)(<= chnum z))
						chnum
						#f)))
			     (next-letter (if last-letter
					      (list->string
					       (list
						(integer->char
						 (+ last-letter 1)))) ;; surely there is an easier way?
					      "a")))
			;; (print "last-name: " last-name " last-letter: " last-letter " next-letter: " next-letter)
			(conc (seconds->wwdate (current-seconds)) next-letter))))

(add-runname-mapper 'auto
		    (lambda (target run-name area area-path reason contour mode-patt)
		      "auto-eh"))

;; run only areas where first letter of area name is "a"
;;
(add-area-checker 'first-letter-a
                  (lambda (area target contour)
                    (string-match "^a.*$" area)))

#  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/>.

## commented out due to a bug in v1.6501 in mtutil
[fields]
a text
b text
c text

[default]
# usercode    .mtutil.scm
# areafilter  area-to-run
# targtrans   generic-target-translator
# runtrans    generic-runname-translator
usercode    .mtutil.scm
# areafilter  area-to-run
targtrans   prefix-contour-broken
# runtrans    generic-runname-translator

[setup]
pktsdirs /mfs/home/matt/orion_automation/pkts

[areas]

#         path-to-area   map-target-script(future, optional)
# someqa     path=../megatestqa/someqa; targtrans=somefunc; areafilter=area-to-run
# targtrans is name of scheme proc stored in .mtutil.scm, which lives in PWD where mtutil is run
#           the target translator can return: a/target OR (list/of targets/to apply/run)
#           OR #f i.e. run nothing

# ext-tests path=ext-tests; targtrans=prefix-contour;


ext       path=/mfs/home/matt/automation_areas/megatest/ext-tests; targtrans=prefix-contour

[contours]
#     selector=tag-expr/mode-patt
quick areas=ext;    selector=/QUICKPATT
# quick2 areafn=check-area; selector=/QUICKPATT
full  areas=ext
# quick areas=fullrun,ext-tests; selector=QUICKPATT/quick
# full  areas=fullrun,ext-tests; selector=MAXPATT/
# short areas=fullrun,ext-tests; selector=MAXPATT/
# all   areas=fullrun,ext-tests
# snazy selector=QUICKPATT/

[nopurpose]

[access]
ext matt:admin mattw:owner

[accesstypes]
admin run rerun resume remove set-ss rerun-clean
owner run rerun resume remove rerun-all
badguy set-ss

[setup]
maxload 1.2

[listeners]
localhost:12345  contact=matt@kiatoa.com
localhost:54321  contact=matt@kiatoa.com

[listener]
script nbfake echo


[server]
timeout 1

[include local.config]

#  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/>.

# To get emacs font highlighing in the various megatest configs do this:
#
# Install emacs-goodies-el:
#    sudo apt install emacs-goodies-el
# Add to your ~/.emacs file:
#    (add-to-list 'auto-mode-alist '("config\\'" . conf-space-mode))
#

# example of a cron entry to run sync using db spec pgdb, with pgdb setting in file local.config
#
[a/b/c]
# all:scheduled:sync     cron=  0/5 * * * *;dbdest=pgdb;appendconf=/nfs/phoebe/disk1/home/mfs/matt/.sysmaint/local.config
# quick:scheduled:sync   cron=  0/5 * * * *;dbdest=pgdb;appendconf=/nfs/phoebe/disk1/home/mfs/matt/.sysmaint/local.config
# fast:scheduled:sync-prepend cron=  0/1 * * * *;dbdest=pgdb;appendconf=/mfs/matt/.sysmaint/local.config

# [scriptinc ./gentargets.sh #{getenv USER}]
# [v1.23/45/67]

# tip will be replaced with hashkey?

# [%/%/%] doesn't work

[/.*/]

[v1.65/tip/dev]
# file:   files changes since last run trigger new run
# script: script is called with unix seconds as last parameter (other parameters are preserved)
#
# contour:sensetype:action params            data
# commented out for debug

quick:file:run             runtrans=auto;         glob=/nfs/orion/disk1/mfs_home/home/matt/automation_areas/megatest/*.scm foo.touchme
# snazy:file:run             runtrans=corporate-ww; glob=/home/matt/data/megatest/*.scm
# short:file:run       runtrans=short;        glob=/home/matt/data/megatest/*.scm

# script returns change-time (unix epoch), new-target-name, run-name
#
# quick:script:run           checkfossil = http://www.kiatoa.com/fossils/megatest v1.63;\
#                            checkfossil = http://www.kiatoa.com/fossils/megatest_qa trunk

# # fossil based trigger
# #
quick:fossil:run           http://www.kiatoa.com/fossils/megatest=v1.65;\
                           http://www.kiatoa.com/fossils/megatest_qa=trunk

# field          allowed values
# -----          --------------
# minute         0-59
# hour           0-23
# day of month   1-31
# month          1-12 (or names, future development)
# day of week    0-7 (0 or 7 is Sun, or, future development, use names)

# actions:
#  run     - run a testsuite
#  clean   - clear out runs
#  archive - archive runs

# quick:scheduled:run     cron=47  * * * * ;run-name=auto
# quick:scheduled:archive cron=15 20 * * * ;run-name=%;target=%/%/%

# [%]
# # every friday at midnight clean "all" tests over 7d
# all:scheduled:clean     cron=  0  0 0 0 5;run-name=%;age=7d   

[v1.65/tip/dev]
# # file:   files changes since last run trigger new run
# # script: script is called with unix seconds as last parameter (other parameters are preserved)
# #
# # contour:sensetype:action params            data
# quick:file:run             run-name=auto;glob=*.scm
# quick:file:clean           run-name=auto;
# quick:script:run           run-name=auto;script=checkfossil.sh v1.63
# 
# # field          allowed values
# # -----          --------------
# # minute         0-59
# # hour           0-23
# # day of month   1-31
# # month          1-12 (or names, future development)
# # day of week    0-7 (0 or 7 is Sun, or, future development, use names)
# 
# # actions:
# #  run     - run a testsuite
# #  clean   - clear out runs
# #  archive - archive runs
# 
quick:scheduled:run     cron=47  * * * * ;run-name=auto
# quick:scheduled:archive cron=15 20 * * * ;run-name=% ; 
#

[%/%/%]
# # every friday at midnight clean "all" tests over 7d
all:scheduled:clean     cron=  0  0 0 0 5;run-name=%;age=7d   
# 

source /opt/chicken/4.13.0_18.04_WW45/setup-chicken4x.sh 
export PATH=/mfs/home/matt/orion_automation/bin:$PATH

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

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 : $(CHICKEN_PREFIX)/bin/sqlite3 $(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 $(EGGSTARG2)
	utils/mk_wrapper_tool $(PREFIX) $* $(PREFIX)/bin/$*
	chmod a+x $(PREFIX)/bin/$*

$(PREFIX)/bin :
	mkdir -p $(PREFIX)/bin $(CHICKEN_PREFIX)/bin

chicken : $(PREFIX)/bin $(CHICKEN_PREFIX)/bin/csi  binwrappers
	@echo "Fake target to build prefix chicken"

binwrappers : $(CKBIN_WRAPPERS)

postgresql.done : $(CHICKEN_PREFIX)/bin/pg_config
	CSC_OPTIONS="-I$(CHICKEN_PREFIX)/include -L$(CHICKEN_PREFIX)/lib -L$(CHICKEN_PREFIX)/lib64" $(CHICKEN_PREFIX)/bin/chicken-install postgresql > postgresql.done

nanomsg.done : $(CHICKEN_PREFIX)/lib/libnanomsg.so
	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

sqlite3.done :
	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

;;======================================================================

(use srfi-1 data-structures posix regex-case (prefix base64 base64:)
     format dot-locking csv-xml z3 udp ;; sql-de-lite
     hostinfo md5 message-digest typed-records directory-utils stack
     matchable regex posix (srfi 18) extras ;; tcp 
     (prefix nanomsg nmsg:)
     ;; (prefix nanomsg nmsg:)
     (prefix sqlite3 sqlite3:)
     pkts (prefix dbi dbi:)
     (prefix dbi dbi:)
     )

(declare (unit common))
(declare (uses commonmod))
(import (prefix commonmod cmod:))

(import commonmod)
(import pkts)

(include "common_records.scm")


;; (require-library margs)
;; (include "margs.scm")

            (caddr argv))
           (else (car argv))))
         (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 )
     ( 3 . check )
     ( 4 . waived )

	(max-allowed (string->number (or (configf:lookup *configdat* "setup" "max-logfiles") "300")))) ;; name -> age
    (if (not (directory-exists? "logs"))(create-directory "logs"))
    (directory-fold 
     (lambda (file rem)
       (handle-exceptions
	exn
	(begin
	  (debug:print-info 0 *default-log-port* "unable to rotate log " file ", probably handled by another process.")
	  (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
	  (print-call-chain (current-error-port)))
	  (debug:print-info 2 *default-log-port* "unable to rotate log " file ", probably handled by another process, this is safe to ignore.")
	  (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)))
	  (hash-table-set! all-files file mod-time)
	  (if (or (and (string-match "^.*.log" file)
		       (> (file-size fullname) 200000))
		  (and (string-match "^server-.*.log" file)

   (read (open-input-string (z3:decode-buffer (base64:base64-decode instr))))))

;; dot-locking egg seems not to work, using this for now
;; if lock is older than expire-time then remove it and try again
;; to get the lock
;;
(define (common:simple-file-lock fname #!key (expire-time 300))
  (let ((fmod-time (handle-exceptions
		       ext
		     (current-seconds)
		     (file-modification-time fname))))
    (if (common:file-exists? fname)
	(if (> (- (current-seconds)(file-modification-time fname)) expire-time)
	(if (> (- (current-seconds) fmod-time) expire-time)
	    (begin
              (handle-exceptions exn #f (delete-file* fname))	
	      (handle-exceptions exn #f (delete-file* fname))	
	      (common:simple-file-lock fname expire-time: expire-time))
	    #f)
	(let ((key-string (conc (get-host-name) "-" (current-process-id))))
	  (with-output-to-file fname
	    (lambda ()
	      (print key-string)))
	  (thread-sleep! 0.25)
	  (if (common:file-exists? fname)
	      (handle-exceptions exn
                #f 
                (with-input-from-file fname
	  	  (lambda ()
		    (equal? key-string (read-line)))))
	      #f))))
	      #f)))))

(define (common:simple-file-lock-and-wait fname #!key (expire-time 300))
  (let ((end-time (+ expire-time (current-seconds))))
    (let loop ((got-lock (common:simple-file-lock fname expire-time: expire-time)))
      (if got-lock
	  #t
	  (if (> end-time (current-seconds))

    (if val val default)))

(define (assoc/default key lst . default)
  (let ((res (assoc key lst)))
    (if res (cadr res)(if (null? default) #f (car default)))))

(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)))))
  (cmod:get-testsuite-name *toppath* *configdat*))

;; safe getting of toppath
(define (common:get-toppath areapath)
  (or *toppath*
      (if areapath
	  (begin
	    (set! *toppath* areapath)
	    (setenv "MT_RUN_AREA_HOME" areapath)
	    areapath)
	  #f)
      (if (getenv "MT_RUN_AREA_HOME")
	  (begin
	    (set! *toppath* (getenv "MT_RUN_AREA_HOME"))
	    *toppath*)
	  #f)
      ;; last resort, look for megatest.config
      (let loop ((thepath (realpath ".")))
	(if (file-exists? (conc thepath "/megatest.config"))
	    thepath
	    (if (equal? thepath "/")
		(begin
		  (debug:print-error 0 *default-log-port* "Unable to find megatest home directory.")
		  #f)
		(loop (pathname-directory thepath)))))
      ))

(define common:get-area-name common:get-testsuite-name)

(define (common:get-db-tmp-area . junk)
  (if *db-cache-path*
      *db-cache-path*
      (if *toppath* ;; common:get-create-writeable-dir

;; use bash to expand a glob. Does NOT handle paths with spaces!
;;
(define (common:bash-glob instr)
  (string-split
   (with-input-from-pipe
       (conc "/bin/bash -c \"echo " instr "\"")
     read-line)))
       read-line)))

;;======================================================================
;; Some safety net stuff
;;======================================================================

;; return input if it is a list or return null
(define (common:list-or-null inlst #!key (ovrd #f)(message #f))
  (if (list? inlst)
      inlst
      (begin
	(if message (debug:print-error 0 *default-log-port* message))
	(or ovrd '()))))
  
;;======================================================================
;; T A R G E T S  ,   S T A T E ,   S T A T U S ,   
;;                    R U N N A M E    A N D   T E S T P A T T
;;======================================================================

;; (map print (map car (hash-table->alist (read-config "runconfigs.config" #f #t))))

       path-string
       #f)))

(define (common:get-linktree)
  (or (getenv "MT_LINKTREE")
      (if *configdat*
	  (configf:lookup *configdat* "setup" "linktree")
	  #f)
	  (if *toppath*
	      (conc *toppath* "/lt")
	      #f))))
      (if (or *toppath* (getenv "MT_RUN_AREA_HOME"))
	  (conc (or *toppath* (getenv "MT_RUN_AREA_HOME")) "/lt")
	  #f)
      (let* ((tp (common:get-toppath #f))
	     (lt (conc tp "/lt")))
	(if (not tp)(debug:print 0 *default-log-port* "WARNING: cannot calculate best path for linktree, using " lt))
	lt)))

(define (common:args-get-runname)
  (let ((res (or (args:get-arg "-runname")
		 (args:get-arg ":runname")
		 (getenv "MT_RUNNAME"))))
    ;; (if res (set-environment-variable "MT_RUNNAME" res)) ;; not sure if this is a good idea. side effect and all ...
    res))

		    (if (> curr-rownum rownum) curr-rownum rownum)
		    (if (> curr-colnum colnum) curr-colnum colnum)
		    ))))))

;; if it looks like a number -> convert it to a number, else return it
;;
(define (common:lazy-convert inval)
  (let* ((as-num (if (string? inval)(string->number inval) #f)))
    (or as-num inval)))
  (cmod:lazy-convert inval))

;; convert string a=1; b=2; c=a silly thing; d=
;; to '((a . 1)(b . 2)(c . "a silly thing")(d . ""))
;;
(define (common: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 (common:lazy-convert inval) inval))))
  (cmod:val->alist val #!key (convert #f)))
		   (else f))))
	     val-list)
	'())))

;;======================================================================
;; S Y S T E M   S T U F F
;;======================================================================

;; lazy-safe get file mod time. on any error (file not existing etc.) return 0
;;

;; 			    (set! cpu-load newval))))))
;; 	      (car load-res))
;;     cpu-load))

;; 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 5))
  (let* ((fullpath (conc *toppath* "/.sysdata/" key "-" dtype ".log")))
    (if (and (file-exists? fullpath)
	     (file-read-access? fullpath))
	(handle-exceptions
	 exn
	 #f
	 (debug:print 2 *default-log-port* "reading file " fullpath)
	 (let ((real-age (- (current-seconds)(file-change-time fullpath)))) 
	   (if (< real-age age)
	       (with-input-from-file fullpath read)
	       (begin
		 (debug:print 1 *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))))
(define (common:get-cached-info key dtype #!key (age 10))
  (if *toppath*
      (let* ((fullpath (conc *toppath* "/.sysdata/" key "-" dtype ".log")))
	(if (and (file-exists? fullpath)
		 (file-read-access? fullpath))
	    (handle-exceptions
	     exn
	     #f
	     (debug:print 2 *default-log-port* "reading file " fullpath)
	     (let ((real-age (- (current-seconds)(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))
		   (begin
		     (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))
 
(define (common:write-cached-info key dtype dat)
  (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))))))
      (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)))))
      #f))

(define (common:raw-get-remote-host-load remote-host)
  (handle-exceptions
   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)
   '(-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)))))
		   (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
;;
(define (common:get-normalized-cpu-load remote-host)
  (let ((res (common:get-normalized-cpu-load-raw remote-host))

(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)
			       (begin
				 (common:write-cached-info actual-host "num-cpus" numcpu)
				 numcpu)
			       (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)
	      (common:write-cached-info actual-host "num-cpus" result))
	  result))))

;; wait for normalized cpu load to drop below maxload
;;
(define (common:wait-for-normalized-load maxload msg remote-host)
(define (common:wait-for-normalized-load maxload 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 maxload 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))
	      #f)))))

;; 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))
(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)
		      (max maxload-in 0.5))) ;; so maxload must be greater than 0.5 for now BUG - FIXME?
			  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
	 (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 next))
	 ;; 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 adjload) ))  )));; add some randomness to the time to break any alignment where netbatch dumps many jobs to machines simultaneously
    (debug:print-info 1 *default-log-port* "Checking cpuload on " (or remote-host "localhost") ", maxload: " maxload
		      ", load: " first ", adjload: " adjload ", loadjmp: " loadjmp)
         (adjwait (min (+ 300 (random 10)) (abs (* (+ (random 10)
						      (/ (- 1000 count) 10)
						      waitdelay)
						   (- first adjmaxload) ))  )))
    ;; 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 ", adjmaxload: " adjmaxload ", loadjmp: " loadjmp))
    (cond
     ((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)))
     ((and (> first adjload)
     ((and (> first adjmaxload)
	   (> 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 ""))
      (debug:print-info 0 *default-log-port*
			"server start delayed " adjwait
			" seconds due to load " first
			" exceeding max of " adjmaxload
			" 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)))))
      (common:wait-for-cpuload maxload numcpus waitdelay count: (- count 1) msg: msg remote-host: remote-host))
     (else
      (if (> num-tries 0)
	  (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"
	(caar uname-res))))

	  dirpath)))

;; check space in dbdir and in megatest dir
;; returns: ok/not dbspace required-space
;;
(define (common:check-db-dir-space)
  (let* ((required (string->number 
                    ;; default is 1GB (or actually a billion bytes) This is the number of 1 kB blocks.
		    (or (configf:lookup *configdat* "setup" "dbdir-space-required")
			"100000")))
			"1000000")))
	 (dbdir    (common:get-db-tmp-area)) ;; (db:get-dbdir))
	 (tdbspace (common:check-space-in-dir dbdir required))
	 (mdbspace (common:check-space-in-dir *toppath* required)))
    (sort (list tdbspace mdbspace) (lambda (a b)
				     (< (cadr a)(cadr b))))))
    
;; check available space in dbdir, exit if insufficient

	(begin
	  (debug:print-error 0 *default-log-port* "Insufficient space in " dbdir ", require " required ", have " dbspace  ", exiting now.")
	  (exit 1)))))
  
;; paths is list of lists ((name path) ... )
;;
(define (common:get-disk-with-most-free-space disks minsize)
  (let ((best     #f)
  (let* ((best     #f)
	(bestsize 0)
        (default-min-inodes-string "1000000")
        (default-min-inodes (string->number default-min-inodes-string))
        (min-inodes (or (string->number (if (configf:lookup *configdat* "setup" "min_inodes") (configf:lookup *configdat* "setup" "min_inodes") "0")) 0)))
        (min-inodes (or (string->number (if (configf:lookup *configdat* "setup" "min_inodes") (configf:lookup *configdat* "setup" "min_inodes") default-min-inodes-string)) default-min-inodes)))

    (for-each 
     (lambda (disk-num)
       (let* ((dirpath    (cadr (assoc disk-num disks)))
	      (freespc    (cond
			   ((not (directory? dirpath))
			    (if (common:low-noise-print 300 "disks not a dir " disk-num)
				(debug:print 0 *default-log-port* "WARNING: disk " disk-num " at path \"" dirpath "\" is not a directory - ignoring it."))

			    (if (common:low-noise-print 300 "disks not a proper path " disk-num)
				(debug:print 0 *default-log-port* "WARNING: disk " disk-num " at path \"" dirpath "\" is not a fully qualified path - ignoring it."))
			    -1)
			   (else
			    (get-free-inodes dirpath))))
             ;;(free-inodes (get-free-inodes dirpath))
             )
             (debug:print 2 *default-log-port* "INFO: disk " disk-num " path " dirpath " free space " freespc " free inodes " free-inodes)
	 (if (and (> freespc bestsize)(> free-inodes min-inodes ))
	     (begin
	       (set! best     (cons disk-num dirpath))
	       (set! bestsize freespc)))
        ;;(print "Processing: " disk-num " bestsize: " bestsize " best: " best " freespc: " freespc " min-inodes: " min-inodes " free-inodes: " free-inodes)
      ))
     (map car disks))

;;======================================================================

(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
;;
;;======================================================================

;;======================================================================
;; 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)
;;   (set! debug:print-info dbgpinfo))

;;======================================================================
;; 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.
;;     GNnU 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/>.

;;======================================================================

;;======================================================================
;; Config file handling
;;======================================================================

(use regex regex-case) ;;  directory-utils)
(use regex regex-case matchable) ;;  directory-utils)
(declare (unit configf))
(declare (uses process))
(declare (uses env))
(declare (uses keys))
(declare (uses commonmod))

(import (prefix commonmod cmod:))

(include "common_records.scm")

;; return list (path fullpath configname)
(define (find-config configname #!key (toppath #f))
  (if toppath
      (let ((cfname (conc toppath "/" configname)))

				((getenv gv)  (conc "(lambda (ht)(get-environment-variable \"" cmd "\"))"))
				((mtrah)      (conc "(lambda (ht)"
                                                    "    (let ((extra \"" cmd "\"))"
						    "       (conc (or *toppath* (get-environment-variable \"MT_RUN_AREA_HOME\"))"
						    "             (if (string-null? extra) \"\" \"/\")"
						    "             extra)))"))
				((get g)   
				 (let* ((parts (string-split cmd))
				 (match (string-split cmd)
					(sect  (car parts))
					(var   (cadr parts)))
				   (conc "(lambda (ht)(configf:lookup ht \"" sect "\" \"" var "\"))")))
					((sect var)(conc "(lambda (ht)(configf:lookup ht \"" sect "\" \"" var "\"))"))
					(else
					 (debug:print-error 0 *default-log-port* "#{get ...} used with only one parameter, \"" cmd "\", two needed.")
					 "(lambda (ht) #f)")))
				((runconfigs-get rget) (conc "(lambda (ht)(runconfigs-get ht \"" cmd "\"))"))
				;; ((rget)           (conc "(lambda (ht)(runconfigs-get ht \"" cmd "\"))"))
				(else "(lambda (ht)(print \"ERROR\") \"ERROR\")"))))
		;; (print "fullcmd=" fullcmd)
		(handle-exceptions
		 exn
		 (begin

		       ((#t #f)
			(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")))
		     (not (equal? (hash-table-ref/default settings "trim-trailing-spaces" "no") "yes")))
		(string-substitute "\\s+$" "" res)
		res))))))

(define (configf:cfgdat->env-alist section cfgdat-ht allow-system)
  (filter
   (lambda (pair)
     (let* ((var (car pair))

    (if toppath (change-directory toppath)) 
    (if (and toppath pathenvvar)(setenv pathenvvar toppath))
    (let ((configdat  (if configfile 
			  (read-config configfile #f #t environ-patt: environ-patt post-section-procs: (list (cons "^fields$" set-fields)) #f))))
      (if toppath (change-directory curr-dir))
      (list configdat toppath configfile fname))))

(define (configf: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))

;; use to have definitive setting:
;;  [foo]
;;  var yes
;;
;;  (configf:var-is? cfgdat "foo" "var" "yes") => #t
;;
(define (configf:var-is? cfgdat section var expected-val)
  (equal? (configf:lookup cfgdat section var) expected-val))

(define config-lookup configf:lookup)
;; (define config-lookup configf:lookup)
(define configf:read-file read-config)

(define (configf:lookup  cfgdat section var)
  (cmod:lookup cfgdat section var))

;; 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))
         (res (if val

#!/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 "CHICKEN_PREFIX=$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
    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"

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

(declare (uses subrun))

(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
  (let* ((dboardexe (common:find-local-megatest "dashboard"))
         (cmd (conc dboardexe
         ;;       (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
                    " -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)
  (list
   (iup:menu-item

(use format)

(require-library iup)
(import (prefix iup iup:))

(use canvas-draw)
(import canvas-draw-iup)
(use ducttape-lib)
(import ducttape-lib)
(use sqlite3 srfi-1 posix regex regex-case srfi-69 typed-records sparse-vectors) ;; defstruct
(import (prefix sqlite3 sqlite3:))

(declare (uses common))
(declare (uses margs))
(declare (uses keys))
(declare (uses items))

(declare (uses dashboard-context-menu))
(declare (uses vg))
(declare (uses subrun))
;; (declare (uses dashboard-main))
(declare (uses megatest-version))
(declare (uses mt))

(declare (uses dbmod))
(import (prefix dbmod dbmod:))
(declare (uses commonmod))
(import (prefix commonmod cmod:))

(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "task_records.scm")
(include "megatest-fossil-hash.scm")
(include "vg_records.scm")

			"-main"
			"-v"
			"-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
(if (not (args:get-arg "-test"))
    (begin

  ((tests-by-name (make-hash-table)) : hash-table) ;; hash of testfullname => testdat
  key-vals
  ((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?
                       (lambda (tabdat-item)
                         (filter

 ;;	 (dboard:tabdat-logs-textbox-set! tabdat logs-tb)
 ;;	 logs-tb))

;; 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 ()
				;; 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"
		  ))
	 (tb
          (iup:treebox
           #:value 0
           #:title "Runs"     ;;  was #:name -- iup 3.19 changed
			      ;;  this... "Changed: [DEPRECATED
           #: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."
			      ;;  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.
                        (dboard:tabdat-prev-run-id-set!
                         tabdat
                         (dboard:tabdat-curr-run-id tabdat))
                        (dboard:tabdat-curr-run-id-set! tabdat run-id)
                        (dboard:tabdat-view-changed-set! tabdat #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:tabdat-runs-tree-set! tabdat tb)
    (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))))
      txtbox
      tb
      ))))

;;======================================================================
;; R U N   C O N T R O L S
;;======================================================================
;;
;; A gui for launching tests
;;

;;
;; display and manage a single run at a time

(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 
;; 					     (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "test-name" "%/%")
;; 					     (hash-table-keys (dboard:tabdat-state-ignore-hash tabdat))  ;; '()

				      (debug:print 6 *default-log-port* "(dboard:tabdat-start-run-offset tabdat) " (dboard:tabdat-start-run-offset tabdat) " maxruns: " maxruns ", val: " val " oldmax: " oldmax)
				      (iup:attribute-set! obj "MAX" (* maxruns 10))))
		#: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))
	 (keynames        (dboard:tabdat-dbkeys runs-dat))
	 (nkeys           (length keynames))

	 (btn-height      (dboard:tabdat-runs-btn-height runs-dat))
	 (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))
    
    ;; 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 "%"
					    #: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
	(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)))))))
		 #: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)
	       (keyvec  (make-vector nkeys))
	       (res    '()))

		    (result  '()))
		(for-each
		 (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. "
				     "\" is missing needed sections. Please consult the documenation and update ~/.mtviews.config or " *toppath* "/.mtviews.config")
					   "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")

	;; set the tab names for user added tabs
	(for-each
	 (lambda (tab-info)
	   (iup:attribute-set! tabs (conc "TABTITLE" (car tab-info)) (cdr tab-info)))
	 additional-tabnames)
	
	(iup:attribute-set! tabs "BGCOLOR" "190 190 190")
	;; 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
	 tabs
	 ;; controls

       fres))))

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

;;======================================================================
;; The heavy lifting starts here
;;======================================================================

	(dboard:commondat-uidat-set! commondat (make-dashboard-buttons commondat))
	(dboard:commondat-curr-tab-num-set! commondat 0)
	(dboard:commondat-add-updater 
	 commondat 
	 (lambda ()
	   (dashboard:runs-tab-updater commondat 1))
	 tab-num: 1)
	(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))
			     (set! update-is-running (dboard:commondat-updating commondat))
			     (if (not update-is-running)

    (sqlite3:for-each-row
     (lambda (id)
       (set! res id))
     db
     "SELECT id FROM archive_blocks WHERE archive_disk_id=? AND disk_path=?;"
     bdisk-id archive-path)
    (if res ;; record exists, update du if applicable and return res
	(begin
	  (if du (sqlite3:execute db "UPDATE archive_blocks SET last_du=?,last_du_time=(strftime('%s','now'))
	(if du (sqlite3:execute db "UPDATE archive_blocks SET last_du=?,last_du_time=(strftime('%s','now'))
                                          WHERE archive_disk_id=? AND disk_path=?;"
				   bdisk-id archive-path du))
				bdisk-id archive-path du))
	  res)
	(begin
	  (sqlite3:execute db "INSERT OR REPLACE INTO archive_blocks (archive_disk_id,disk_path,last_du)
                                                        VALUES (?,?,?);"
			   bdisk-id archive-path (or du 0))
	  (db:archive-register-block-name dbstruct bdisk-id archive-path du: du)))
	  (set! res (db:archive-register-block-name dbstruct bdisk-id archive-path du: du))))
    (stack-push! (dbr:dbstruct-dbstack dbstruct) dbdat)
    res))


;; The "archived" field in tests is overloaded; 0 = not archived, > 0 archived in block with given id
;;
(define (db:test-set-archive-block-id dbstruct run-id test-id archive-block-id)

           #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)
          (debug:print 0 *default-log-port* "ERROR: run-dir is " run-dir)
          #f
          )
          (with-input-from-file infile read-lines)
       )
  )
)




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

(define (db:find-and-mark-incomplete dbstruct run-id ovr-deadtime)
  (let* ((incompleted '())
	 (oldlaunched '())
	 (toplevels   '())
          ;; The default running-deadtime is 720 seconds = 12 minutes.
          ;; "(running-deadtime-default (+ server-start-allowance (* 2 launch-monitor-period)))" = 200 + (2 * (200 + 30 + 30))
         (deadtime-trim (or ovr-deadtime (configf:lookup-number *configdat* "setup" "deadtime")))
         (server-start-allowance 200)
         (server-overloaded-budget 200)
         (launch-monitor-off-time (or (configf:lookup-number *configdat* "setup" "test-stats-update-period") 30))
         (launch-monitor-on-time-budget 30)
         (launch-monitor-period (+ launch-monitor-off-time launch-monitor-on-time-budget server-overloaded-budget))
         (remotehoststart-deadtime-default (+ server-start-allowance server-overloaded-budget 30))
         (remotehoststart-deadtime (or deadtime-trim remotehoststart-deadtime-default))
         (running-deadtime-default (+ server-start-allowance (* 2 launch-monitor-period)))
         (running-deadtime (or deadtime-trim running-deadtime-default)) ;; two minutes (30 seconds between updates, this leaves 3x grace period)
         )
    (debug:print-info 4  *default-log-port* "running-deadtime = " running-deadtime)
    (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)

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

              ;;      			(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
                (lambda (test-id)
                  (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."))
                  ;;(db:test-set-state-status dbstruct run-id test-id "COMPLETED" "DEAD" "Test stopped responding while in RUNNING or REMOTEHOSTSTART; presumed dead.")) ;; fix for one aspect of Randy's ticket 1405717332 ;; TODO - fix problem where test goes to COMPLETED/DEAD while in progress, only later to go to COMPLETED/PASS.  ref ticket 220546828
                all-ids))))))))
                  (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))
			   (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)))
			    (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.")
				(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.")))))))
		  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) ",")

		       (lambda (key)
			 (set! res (cons key res)))
		       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))
                 (tal (cdr header))
                 (n   0))

(define-record simple-run target id runname state status owner event_time)
(define-record-printer (simple-run x out)
  (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 "||'/'||"))
	   (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)
		     (set! res (cons (make-simple-run target id runname state status owner event_time) res)))
		   db

	  (vector-ref inrec 2) ;; testname
	  (vector-ref inrec 4) ;; state
	  (vector-ref inrec 5) ;; status
	  -1 "" -1 -1 "" "-" 
	  (vector-ref inrec 3) ;; item-path
	  -1 "-" "-"))

(define (db:get-tests-for-run-state-status dbstruct run-id testpatt)
#;(define (db:get-tests-for-run-state-status dbstruct run-id testpatt)
  (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 ") ") ""))))
    (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)))
		   db 
		   qry
		   run-id)))
    res))

(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,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: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
		   (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)
		  (sqlite3:for-each-row
		   (lambda (run-id testname item-path state status)

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

)

(declare (unit diff-report))
(declare (uses common))
(declare (uses rmt))
         
(include "common_records.scm")
(use matchable)
(use fmt)
(use ducttape-lib)
(import ducttape-lib)
(define css "")

(define (diff:tests-mindat->hash tests-mindat)
  (let* ((res (make-hash-table)))
    (for-each
     (lambda (item)
       (let* ((test-name+item-path (cons (list-ref item 0) (list-ref item 1)))

----------------

Hint: You can browse the archive using bup commands directly.

----------------
bup -d /path/to/bup/archive ftp
----------------

Pass Data from Test to Test
~~~~~~~~~~~~~~~~~~~~~~~~~~~

.To save the data call archive save within your test:
----------------
megatest -archive save
----------------

.To retrieve the data call archive get using patterns as needed
----------------
# Put the retrieved data into /tmp
DESTPATH=/tmp/$USER/$MT_TARGET/$MT_RUN_NAME/$MT_TESTNAME/$MT_ITEMPATH/my_data
mkdir -p $DESTPATH
megatest -archive get -runname % -dest $DESTPATH
----------------


Submit jobs to Host Types based on Test Name
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

.In megatest.config
------------------------
[host-types]

Installation
------------

Dependencies
~~~~~~~~~~~~

Chicken scheme and a number of "eggs" are required for building
Megatest. In the v1.66 and beyond assistance to create the build
system is built into the Makefile.
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.

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

<!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. */
body {
  font-family: Georgia,serif;

ul, ol, li > p {
  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;
}
#email {

div.exampleblock > div.content {
  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;
}
dt {

/*
 * 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 {
  border: 3px solid #527bbd;
}

/*
 * 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 {
  font-weight: bold;
  color: #527bbd;

body.manpage div.sectionbody {
  margin-left: 3em;
}

@media print {
  body.manpage div#toc { display: none; }
}


@media screen {
  body {
    max-width: 50em; /* approximately 80 characters wide */
    margin-left: 16em;
  }

  #toc {

</script>
</head>
<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>
<div id="content">
<div class="sect1">
<h2 id="_preface">Preface</h2>
<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
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

<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
of any team doing continuous integration 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>

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.</p></div>
</div>
</div>
</div>
<div class="sect1">
<h2 id="_overview">Overview</h2>
<div class="sectionbody">
<div class="sect2">
<h3 id="_stand_alone_megatest_area">Stand-alone Megatest Area</h3>
<div class="paragraph"><p>A single, stand-alone, Megatest based testsuite or "area" is
sufficient for most validation, automation and build problems.</p></div>
<div class="imageblock">
<div class="content">
<img src="megatest-stand-alone-area.png" alt="Static">
</div>
</div>
<div class="paragraph"><p>Megatest is designed as a distributed or decoupled system. This means
you can run the areas stand-alone with no additional
infrastructure. I.e. there are no databases, web servers or other
centralized resources needed. However as your needs grow you can
integrate multiple areas into a bigger system.</p></div>
<div class="sect3">
<h4 id="_component_descriptions">Component Descriptions</h4>
<div class="olist arabic"><ol class="arabic">
<li>
<p>
Multi-area dashboard and xterm. A gui (the dashboard) is usually the
  best option for controlling and launching runs but all operations
  can also be done from the commandline. Note: The not yet released
  multi-area dashboard replaces the old dashboard for browsing and
  controlling runs but for managing a single area the old dashboard
  works very well.
</p>
</li>
<li>
<p>
Area/testsuite. This is your testsuite or automation definition and
  consists of the information in megatest.config, runconfigs.config
  and your testconfigs along with any custom scripting that can&#8217;t be
  done with the native Megatest features.
</p>
</li>
<li>
<p>
If your testsuite or build automation is too large to run on a
  single instance you can distribute your jobs into a compute server
  pool. The only current requirements are password-less ssh access and
  a network filesystem.
</p>
</li>
</ol></div>
</div>
</div>
<div class="sect2">
<h3 id="_full_system_architecture">Full System Architecture</h3>
<div class="imageblock">
<div class="content">
<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">
<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>
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>
<div class="sectionbody">
<div class="listingblock">

<div class="paragraph"><p>Hint: You can browse the archive using bup commands directly.</p></div>
<div class="listingblock">
<div class="content monospaced">
<pre>bup -d /path/to/bup/archive ftp</pre>
</div></div>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_pass_data_from_test_to_test">Pass Data from Test to Test</h3>
<div class="listingblock">
<div class="title">To save the data call archive save within your test:</div>
<div class="content monospaced">
<pre>megatest -archive save</pre>
</div></div>
<div class="listingblock">
<div class="title">To retrieve the data call archive get using patterns as needed</div>
<div class="content monospaced">
<pre># Put the retrieved data into /tmp
DESTPATH=/tmp/$USER/$MT_TARGET/$MT_RUN_NAME/$MT_TESTNAME/$MT_ITEMPATH/my_data
mkdir -p $DESTPATH
megatest -archive get -runname % -dest $DESTPATH</pre>
</div></div>
</div>
<div class="sect2">
<h3 id="_submit_jobs_to_host_types_based_on_test_name">Submit jobs to Host Types based on Test Name</h3>
<div class="listingblock">
<div class="title">In megatest.config</div>
<div class="content monospaced">
<pre>[host-types]

# script that takes path as parameter and returns number of bytes available:
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>
<div class="listingblock">
<div class="title">In megatest.config</div>

# tabled
[itemstable]
A x y
B 1 2

# Yields x/1 y/2</pre>
</div></div>
<div class="listingblock">
<div class="title">Or use files</div>
<div class="content monospaced">
<pre>[itemopts]
slash path/to/file/with/items
# or
space path/to/file/with/items</pre>
</div></div>
<div class="listingblock">
<div class="title">File format for / delimited</div>
<div class="content monospaced">
<pre>key1/key2/key3
val1/val2/val2
...</pre>
</div></div>
<div class="listingblock">
<div class="title">File format for space delimited</div>
<div class="content monospaced">
<pre>key1 key2 key3
val1 val2 val2
...</pre>
</div></div>
</div>
<div class="sect2">
<h3 id="_requirements_section">Requirements section</h3>
<div class="listingblock">
<div class="title">Header</div>
<div class="content monospaced">
<pre>[requirements]</pre>
</div></div>
</div>
<div class="sect2">
<h3 id="_wait_on_other_tests">Wait on Other Tests</h3>
<div class="listingblock">
<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>
<div class="listingblock">
<div class="content monospaced">

</div></div>
<div class="paragraph"><p>To transfer the environment to the next step you can do the following:</p></div>
<div class="listingblock">
<div class="title">Propagate environment to next step</div>
<div class="content monospaced">
<pre>$MT_MEGATEST -env2file .ezsteps/${stepname}</pre>
</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>
<div class="content monospaced">
<pre>[scripts]
loaddb #!/bin/bash
  sqlite3 $1 &lt;&lt;EOF
  .mode tabs
  .import $2 data
  .q
  EOF</pre>
</div></div>
<div class="paragraph"><p>The above snippet results in the creation of an executable script
called "loaddb" in the test directory. NOTE: every line in the script
must be prefixed with the exact same number of spaces. Lines beginning
with a # will not work as expected. Currently you cannot indent
intermediate lines.</p></div>
<div class="listingblock">
<div class="title">Full example with ezsteps, logpro rules, scripts etc.</div>
<div class="content monospaced">
<pre># You can include a common file
#
[include #{getenv MT_RUN_AREA_HOME}/global-testconfig.inc]

# Use "var" for a scratch pad
#
[var]
dumpsql select * from data;
sepstr .....................................

# NOT IMPLEMENTED YET!
#
[ezsteps-addendum]
prescript something.sh
postscript something2.sh

# Add additional steps here. Format is "stepname script"
[ezsteps]
importdb loaddb prod.db prod.sql
dumpprod dumpdata prod.db "#{get var dumpsql}"
diff (echo "prod#{get var sepstr}test";diff --side-by-side \
     dumpprod.log reference.log ;echo DIFFDONE)

[scripts]
loaddb #!/bin/bash
  sqlite3 $1 &lt;&lt;EOF
  .mode tabs
  .import $2 data
  .q
  EOF

dumpdata #!/bin/bash
  sqlite3 $1 &lt;&lt;EOF
  .separator ,
  $2
  .q
  EOF

# Test requirements are specified here
[requirements]
waiton setup
priority 0

# Iteration for your test is controlled by the items section
# The complicated if is needed to allow processing of the config for the dashboard when there are no actual runs.
[items]
THINGNAME [system generatethings.sh | sort -u]

# Logpro rules for each step can be captured here in the testconfig
# note: The ;; after the stepname and the leading whitespace are required
#
[logpro]
inputdb ;;
  (expect:ignore   in "LogFileBody"  &lt; 99 "Ignore error in comments"      #/^\/\/.*error/)
  (expect:warning  in "LogFileBody"  = 0 "Any warning"                    #/warn/)
  (expect:required in "LogFileBody"  &gt; 0 "Some data found"                #/^[a-z]{3,4}[0-9]+_r.*/)

diff ;;
  (expect:ignore   in "LogFileBody"  &lt; 99 "Ignore error in comments"      #/^\/\/.*error/)
  (expect:warning  in "LogFileBody"  = 0 "Any warning"                    #/warn/)
  (expect:error    in "LogFileBody"  = 0 "&lt; or &gt; indicate missing entry"  (list #/(&lt;|&gt;)/   #/error/i))
  (expect:error    in "LogFileBody"  = 0 "Difference in data"             (list #/\s+\|\s+/ #/error/i))
  (expect:required in "LogFileBody"  &gt; 0 "DIFFDONE Marker found"          #/DIFFDONE/)
  (expect:required in "LogFileBody"  &gt; 0 "Some things found"              #/^[a-z]{3,4}[0-9]+_r.*/)

# NOT IMPLEMENTED YET!
#
## Also: enhance logpro to take list of command files: file1,file2...
[waivers]
createprod{target=%78/%/%/%} ;;
  (disable:required "DIFFDONE Marker found")
  (disable:error    "Some error")
  (expect:waive  in "LogFileBody" &lt; 99 "Waive if failed due to version" #/\w+3\.6.*/)

# test_meta is a section for storing additional data on your test
[test_meta]
author matt
owner  matt
description Compare things
tags tagone,tagtwo
reviewed never</pre>
</div></div>
</div>
<div class="sect2">
<h3 id="_triggers">Triggers</h3>
<div class="paragraph"><p>In your testconfig or megatest.config triggers can be specified</p></div>
<div class="listingblock">
<div class="title">Triggers spec</div>
<div class="content monospaced">

<div class="content monospaced">
<pre>[triggers]
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
but since triggers can be called in various contexts not all variables are
available at all times. The trigger script should check for the variable and

<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>
<div class="sectionbody">
</div>
</div>
</div>
<div id="footnotes"><hr></div>
<div id="footer">
<div id="footer-text">
Version 1.0<br>
Last updated 2019-07-09 14:27:38 PDT
Version 1.5<br>
Last updated 2020-07-22 14:21:46 PDT
 2020-06-16 23:02:26 MST
</div>
</div>
</body>
</html>

The Megatest Users Manual
=========================
Matt Welland <matt@kiatoa.com>
v1.0, April 2012
v1.5, June 2020
:doctype: book


[preface]
Preface
-------

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
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

-------------

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
of any team doing continuous integration 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 Design Philosophy
--------------------------

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.

include::overview.txt[]

include::plan.txt[]

include::installation.txt[]

include::getting_started.txt[]

include::study_plan.txt[]

------------------

["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
// ================
// One or more optional appendixes go here at section level zero.

Overview
--------

Stand-alone Megatest Area
~~~~~~~~~~~~~~~~~~~~~~~~~

A single, stand-alone, Megatest based testsuite or "area" is
sufficient for most validation, automation and build problems.

image::megatest-stand-alone-area.png[Static,300]

Megatest is designed as a distributed or decoupled system. This means
you can run the areas stand-alone with no additional
infrastructure. I.e. there are no databases, web servers or other
centralized resources needed. However as your needs grow you can
integrate multiple areas into a bigger system.

Component Descriptions
^^^^^^^^^^^^^^^^^^^^^^

. Multi-area dashboard and xterm. A gui (the dashboard) is usually the
  best option for controlling and launching runs but all operations
  can also be done from the commandline. Note: The not yet released
  multi-area dashboard replaces the old dashboard for browsing and
  controlling runs but for managing a single area the old dashboard
  works very well.
 
. Area/testsuite. This is your testsuite or automation definition and
  consists of the information in megatest.config, runconfigs.config
  and your testconfigs along with any custom scripting that can't be
  done with the native Megatest features.

. If your testsuite or build automation is too large to run on a
  single instance you can distribute your jobs into a compute server
  pool. The only current requirements are password-less ssh access and
  a network filesystem.

Full System Architecture
~~~~~~~~~~~~~~~~~~~~~~~~

image::megatest-system-architecture.png[Static,300]

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
//     (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-2012, Matthew Welland.
// Copyright 2006-2020, Matthew Welland.

TODO / Road Map
---------------
Note 1: This road-map continues to evolve and subject to change without notice.

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
Here is a smattering of ideas for Megatest 2.0
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

. Multi-area dashboard view

Tests Support

. Add variable $MT_RUNPATH = $MT_LINKTREE/$MT_TARGET/$MT_RUNNAME
. Improve [script], especially indent handling
----------------
[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.

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
Add ability to move runs to other Areas (overlaps with overflow db system)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

*Purpose*: allow shrinking megatest.db data by moving runs to an alternate
 Megatest area with same keys.
. 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 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
. accessing the data would be by running dashboard in the satellite area
. future versions of Megatest dashboard should support displaying areas in a
  merged way.
. 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

Eliminate ties to homehost (part of overflow db system)
RFC M02: Move data into completed-runs.db
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

*Purpose*: shrink megatest.db data to enable lower load and higher performance.

. Server creates captain pkt
*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
. Create a lock in the db
. Migrate the /tmp cache db to the current host
. Update the .homehost file
. Remove the lock

. Relinquish db when done
*Branch*: This work not yet started

Architecture Refactor
~~~~~~~~~~~~~~~~~~~~~

Tasks - better management of run manager processes etc.
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
. 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#]
. 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?)
// 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
// 
 
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
 
// 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%
 . 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%
// 
// 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
// ~~~~

 . 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.
// 
// . 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
 . 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
// 
// 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)
 . 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
// ..	Install Makefile (in progress, needed for Mike to install on VMs)
// ..	Added option to compile IUP (needed for VMs)
// .	Server side run launching
 . 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).
 . 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
 . Gui panels for editing megatest.config and runconfigs.config
 . Fully isolated tests (no use of NFS to see regression area files)
 . Windows version