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]

#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

# 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 ods.scm runconfig.scm	\
           server.scm configf.scm db.scm keys.scm margs.scm		\
           megatest-version.scm process.scm runs.scm tasks.scm		\
           tests.scm genexample.scm http-transport.scm filedb.scm	\
           tdb.scm client.scm mt.scm ezsteps.scm lock-queue.scm		\

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

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



ARCHSTR=$(shell if [[ -e /usr/bin/sw_vers ]]; then /usr/bin/sw_vers -productVersion; else lsb_release -sr; fi)


PNGFILES = $(shell cd docs/manual;ls *png)


all : $(PREFIX)/bin/.$(ARCHSTR) mtest dboard mtut tcmt



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) $(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 \

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)/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)/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)/bin/mtut : mtut
	$(INSTALL) mtut $(PREFIX)/bin/.$(ARCHSTR)/bin/mtut

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

$(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)/bin/mtexec : mtexec
	$(INSTALL) mtexec $(PREFIX)/bin/.$(ARCHSTR)/bin/mtexec

$(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)/bin/tcmt : tcmt
	$(INSTALL) tcmt $(PREFIX)/bin/.$(ARCHSTR)/bin/tcmt

$(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/mt_laststep : utils/mt_laststep
	$(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)/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 : $(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) : 
	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

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

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

TODO
====




WW15
. syscheck; touch file in home, tmp, runs, links and start xterm [DONE]
. fill newview matrix with data, filter pipeline gui elements 
. improve [script], especially indent handling

WW16
. split db into megatest.db (runs etc.) db/<something>.db
. release basic newview implementation

.. -get-data, -put-data                    [DONE]
.. get and put to specific paths





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.

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

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

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

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

#  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

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

    (lambda ()(list (read)(read)(read))))))

;; get cpu load by reading from /proc/loadavg, return all three values
;;
(define (common:get-cpu-load remote-host)
  (handle-exceptions
   exn
   '(-99 -99 -99)
   (let* ((actual-hostname (or remote-host (get-host-name) "localhost")))
     (or (common:get-cached-info actual-hostname "cpu-load")
	 (let ((result (if remote-host
			   (map (lambda (res)
				  (if (eof-object? res) 9e99 res))
			        (with-input-from-pipe 
				 (conc "ssh " remote-host " cat /proc/loadavg")
				 (lambda ()(list (read)(read)(read)))))
			   (with-input-from-file "/proc/loadavg" 
			     (lambda ()(list (read)(read)(read)))))))
	   (match
	    result
	    ((l1 l2 l3)
	     (if (and (number? l1)
		      (number? l2)
		      (number? l3))
		 (begin
		   (common:write-cached-info actual-hostname "cpu-load" result)
		   result)
		 '(-1 -1 -1))) ;; -1 is bad result
	    (else '(-2 -2 -2))))))))

;; get normalized cpu load by reading from /proc/loadavg and /proc/cpuinfo return all three values and the number of real cpus and the number of threads
;; returns alist '((adj-cpu-load . normalized-proc-load) ... etc.
;;  keys: adj-proc-load, adj-core-load, 1m-load, 5m-load, 15m-load
;;
(define (common:get-normalized-cpu-load remote-host)
  (let ((res (common:get-normalized-cpu-load-raw remote-host))

	  (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)(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
		      (max maxload-in 0.5))) ;; so maxload must be greater than 0.5 for now BUG - FIXME?
	 (first   (car loadavg))
	 (next    (cadr loadavg))
	 (adjmaxload (* maxload (max 1 numcpus))) ;; possible bug where
					       ;; numcpus (or could be
					       ;; maxload) is zero,
					       ;; crude fallback is to
					       ;; at least use 1
	 (loadjmp (- first 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 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 adjmaxload)
	   (> count 0))
      (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))
     (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))))

		       ((#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") "yes")))
		(string-substitute "\\s+$" "" res)
		res))))))

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

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

(declare (uses subrun))

(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")

(define (dboard:launch-testpanel run-id test-id)
  (let* ((dboardexe (common:find-local-megatest "dashboard"))
         (cmd (conc dboardexe







                    " -test " run-id "," test-id
                    " &")))
    (system cmd)))


(define (dashboard:run-menu-items  run-id test-id target runname test-name testpatt item-test-path test-info)
  (list
   (iup:menu-item

			"-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-draw-state (make-hash-table)) ;; use for keeping state of the test canvas
	 (test-patterns-textbox  #f))
    (hash-table-set! tests-draw-state 'first-time #t)
    ;; (hash-table-set! tests-draw-state 'scalef 1)
    (tests:get-full-data test-names test-records '() all-tests-registry)
    (set! sorted-testnames (tests:sort-by-priority-and-waiton test-records))
    
    ;; refer to (dboard:tabdat-keys tabdat), (dboard:tabdat-dbkeys tabdat) for keys
    (let* ((result
	    (iup:vbox
	     (dcommon:command-execution-control tabdat)
	     (iup:split
	      #:orientation "VERTICAL" ;; "HORIZONTAL"
	      #:value 200
	      ;; 

	 (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 fields text boxes are used
						       ;; and not the info from the tree
						       (mark-for-update runs-dat)
						       (update-search commondat runs-dat x val))))))
				 (set! i (+ i 1))
				 res))
			     keynames)))))
    (let loop ((testnum  0)
	       (res      '()))
      (cond
       ((>= testnum ntests)
	;; now lftlst will be an hbox with the test keys and the test name labels
	(set! lftlst
	      (append
	       lftlst
	       (list
		(iup:hbox
		 #:expand "HORIZONTAL"
		 (iup:valuator
		  #:valuechanged_cb
		  (lambda (obj)
		    (let ((val (string->number (iup:attribute obj "VALUE")))
			  (oldmax  (string->number (iup:attribute obj "MAX")))
			  (newmax  (* 10 (length (dboard:tabdat-all-test-names runs-dat)))))
		      (dboard:commondat-please-update-set! commondat #t)
		      (dboard:tabdat-start-test-offset-set! runs-dat
							    (inexact->exact (round (/ val 10))))
		      (debug:print 6 *default-log-port*
				   "(dboard:tabdat-start-test-offset runs-dat) "
				   (dboard:tabdat-start-test-offset runs-dat) " val: " val
				   " newmax: " newmax " oldmax: " oldmax)
		      (if (< val 10)
			  (iup:attribute-set! obj "MAX" newmax))
		      ))
		  #:expand "VERTICAL" 
		  #:orientation "VERTICAL"
		  #:min 0
		  #:step 0.01)
		 (apply iup:vbox (reverse res)))))))
       (else
	(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)))))) 
	  (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    '()))

			    (apply iup:hbox (reverse hdrlst))
			    (apply iup:hbox (reverse bdylst))
			    (dashboard:runs-horizontal-slider runs-dat))))
			 controls
			 ))
	     (views-cfgdat (common:load-views-config))
	     (additional-tabnames '())
	     (tab-start-num       5)   ;; DON'T FORGET TO UPDATE THIS WHEN CHANGING THE STANDARD TABS BELOW
	     ;; (data (dboard:tabdat-init (make-d:data)))
	     (additional-views 	;; process views-dat
	      (let ((tab-num tab-start-num)
		    (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. "
					   "Please consult the documenation and update ~/.mtviews.config or "
					   *toppath* "/.mtviews.config")
			 (case (string->symbol cfgtype)
			   ;; user supplied source for a tab
			   ;;
			   ((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)))))
		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:run-controls commondat runcontrols-dat tab-num: 3)
			  (dashboard:run-times commondat runtimes-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

    (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

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

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

<!DOCTYPE html>
<html lang="en">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
<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; }

.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; vertical-align: text-bottom; }
a.image:visited { color: white; }

dl {
  margin-top: 0.8em;
  margin-bottom: 0.8em;
}
dt {

/*
 * xhtml11 specific
 *
 * */







div.tableblock {
  margin-top: 1.0em;
  margin-bottom: 1.5em;
}
div.tableblock > table {
  border: 3px solid #527bbd;
}

/*
 * html5 specific
 *
 * */







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

<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 class="content monospaced">
<pre>[triggers]
COMPLETED/ xterm -e bash -s --</pre>
</div></div>
<div class="admonitionblock">
<table><tr>
<td class="icon">
<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>
</div>
</div>
<div id="footnotes"><hr></div>
<div id="footer">
<div id="footer-text">
Version 1.0<br>
Last updated
 2020-05-06 12:11:12 UTC
</div>
</div>
</body>
</html>

# script that takes path as parameter and returns number of bytes available:
free-space-script check-space.sh
-------------------

Trim trailing spaces
~~~~~~~~~~~~~~~~~~~~

NOTE: As of Megatest version v1.6548 trim-trailing-spaces defaults to yes.

------------------
[configf:settings trim-trailing-spaces no]
#                 |<== next line padded with spaces to here
DEFAULT_INDENT
[configf:settings trim-trailing-spaces no]
------------------

The variable DEFAULT_INDENT would be a string of 3 spaces

Job Submission Control
~~~~~~~~~~~~~~~~~~~~~~

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

~~~~~~~~~~~~~~~~~~~

-------------------
# A normal waiton waits for the prior tests to be COMPLETED 
# and PASS, CHECK or WAIVED
waiton test1 test2
-------------------

NOTE: Dynamic waiton lists must be capable of being calculated at the
beginning of a run. This is because Megatest walks the tree of waitons
to create the list of tests to execute.

.This works
-------------------
waiton [system somescript.sh]
-------------------

.This does NOT work (the full context for the test is not available so #{shell ...} is NOT enabled to evaluate.
-------------------
waiton #{shell somescript.sh}
-------------------

.This does NOT work
-------------------
waiton [system somescript_that_depends_on_a_prior_test.sh]
-------------------

Mode
~~~~

The default (i.e. if mode is not specified) is normal. All pre-dependent tests
must be COMPLETED and PASS, CHECK or WAIVED before the test will start

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

	   (remote-megatest (configf:lookup *configdat* "setup" "executable"))
	   (run-time-limit  (or (configf:lookup  tconfig   "requirements" "runtimelim")
				(configf:lookup  *configdat* "setup" "runtimelim")))
	   ;; FIXME SOMEDAY: not good how this is so obtuse, this hack is to 
	   ;;                allow running from dashboard. Extract the path
	   ;;                from the called megatest and convert dashboard
	   ;;             	  or dboard to megatest
	   (local-megatest  (common:find-local-megatest))








	   (launcher        (common:get-launcher *configdat* test-name item-path)) ;; (configf:lookup *configdat* "jobtools"     "launcher"))
	   (test-sig        (conc (common:get-testsuite-name) ":" test-name ":" item-path)) ;; (item-list->path itemdat))) ;; test-path is the full path including the item-path
	   (work-area       #f)
	   (toptest-work-area #f) ;; for iterated tests the top test contains data relevant for all
	   (diskpath   #f)
	   (cmdparms   #f)
	   (fullcmd    #f) ;; (define a (with-output-to-string (lambda ()(write x))))

;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;; Always use two or four digit decimal
;; 1.01, 1.02...1.10,1.11,1.1101 ... 1.99,2.00..

(declare (unit megatest-version))

(define megatest-version 1.6601)

  -version                : print megatest version (currently " megatest-version ")

Launching and managing runs
  -run                    : run all tests or as specified by -testpatt
  -remove-runs            : remove the data for a run, requires -runname and -testpatt
                            Optionally use :state and :status, use -keep-records to remove only
                            the run data. Use -kill-wait to override the 10 second
                            per test wait after kill delay (e.g. -kill-wait 0). 
  -kill-runs              : kill existing run(s) (all incomplete tests killed)
  -kill-rerun             : kill an existing run (all incomplete tests killed and run is rerun)
  -set-state-status X,Y   : set state to X and status to Y, requires controls per -remove-runs
  -rerun FAIL,WARN...     : force re-run for tests with specificed status(s)
  -rerun-clean            : set all tests not COMPLETED+PASS,WARN,WAIVED to NOT_STARTED,n/a
                            and then run the specified testpatt with -preclean
  -rerun-all              : set all tests to NOT_STARTED,n/a and run with -preclean

                            formats: perl, ruby, sqlite3, csv (for csv the -o param
                            will substitute %s for the sheet name in generating 
                            multiple sheets)
  -o                      : output file for refdb2dat (defaults to stdout)
  -archive cmd            : archive runs specified by selectors to one of disks specified
                            in the [archive-disks] section.
                            cmd: keep-html, restore, save, save-remove, get (use 
                            -dest to set destination), -include path1,path2... to get or save specific files

  -generate-html          : create a simple html dashboard for browsing your runs
  -generate-html-structure  : create a top level html veiw to list targets/runs and a Run view within each run directory.  
  -list-run-time          : list time requered to complete runs. It supports following switches
                            -run-patt <patt> -target-patt <patt> -dumpmode <csv,json,plain-text>
  -list-test-time	  : list time requered to complete each test in a run. It following following arguments
                            -runname <patt> -target <patt> -dumpmode <csv,json,plain-text>
  -syscheck               : do some very basic checks; write access and space in tmp, home, runs, links and 

			"-setvars"
			"-set-state-status"

                        ;; move runs stuff here
                        "-remove-keep"           
			"-set-run-status"
			"-age"

			;; archive 
			"-archive"
			"-actions"
			"-precmd"
			"-include"
			"-exclude-rx"
			"-exclude-rx-from"
			
			"-debug" ;; for *verbosity* > 2
			"-create-test"
			"-override-timeout"
			"-test-files"  ;; -test-paths is for listing all
			"-load"        ;; load and exectute a scheme file
			"-section"

                                        (if (null? tal)
                                            (loop new-test-dat tal)
                                            (loop (car tal)(append tal (list new-test-dat)))))
                                      (begin
                                        (set! lasttpath (db:test-get-rundir new-test-dat)) ;; remember this path for run removal
                                        (if (file-exists? lasttpath) 
                                          (set! lastrealpath (resolve-pathname lasttpath))
                                          (set! lastrealpath lasttpath))

                                        (runs:remove-test-directory new-test-dat mode) ;; 'remove-all)

                                        (if (not (null? tal))
                                            (loop (car tal)(cdr tal)))))))
				(rmt:update-run-stats run-id (rmt:get-raw-run-stats run-id)))
                               ((kill-runs)
                                ;; RUNNING -> KILLREQ

fi

cat >> $target << EOF 
if [[ \$(ulimit -a | grep 'open files' | awk '{print \$4}') -gt 10000 ]];then ulimit -n 10000;fi
EOF

# echo "#!/bin/bash" > $target
# echo "exec $prefix/bin/.\$(lsb_release -sr)/bin/$cmd \"\$@\"" >> $target

echo "lsbr=\$(lsb_release -sr)" >> $target
if [ "$LD_LIBRARY_PATH" != "" ];then
  echo "source $prefix/bin/.\$lsbr/cfg.sh" >> $target
fi

# echo "if [[ -e \$lsbr ]];then source \$lsbr;fi" >> $target
echo "exec $prefix/bin/.\$lsbr/bin/$cmd \"\$@\"" >> $target

#!/bin/bash

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

prefix=$1
cmd=$2
target=$3
cfgfile="$prefix/bin/.$(lsb_release -sr)/cfg.sh"

# we wish to create a var in cfg.sh for finding sqlite3 executable
chicken_bin_dir=$(dirname $(which csi))
if [[ -e $chicken_bin_dir/sqlite3 ]];then
    sqlite3_exe=$chicken_bin_dir/sqlite3
else
    sqlite3_exe=$(which sqlite3)
fi

if [ "$LD_LIBRARY_PATH" != "" ];then
  echo "INFO: Using LD_LIBRARY_PATH=$LD_LIBRARY_PATH" >&2
( cat << __EOF
if [ -z \$MT_ORIG_ENV ]; then
    export MT_ORIG_ENV=\$( $prefix/bin/serialize-env )
fi

if [ "\$LD_LIBRARY_PATH" != "" ];then
  export LD_LIBRARY_PATH=$LD_LIBRARY_PATH:\$LD_LIBRARY_PATH
else
  export LD_LIBRARY_PATH=$LD_LIBRARY_PATH
fi

export MT_SQLITE3_EXE=$sqlite3_exe
__EOF
) > $cfgfile
  echo 
else
  echo "INFO: LD_LIBRARY_PATH not set" >&2
fi

echo "#!/bin/bash" > $target

if [[ $cmd =~ dboard ]]; then
    cat >> $target <<'EOF'

# # disable if not running on homehost
# if [[ -e .homehost ]]; then
#   homehostname=$( host `cat .homehost` | awk '{print $NF}' | sed 's/\.$//' )
#   hostname=$( hostname -f )
# 
#   if [[ ! ($homehostname == $hostname) ]]; then
#     echo "ERROR: this host ($hostname) is not the homehost ($homehostname) for this megatest run area.  Cannot start dashboard."
#     echo "       Please log into homehost before launching dashboard."
#     exit 1
#   fi
# fi

# check that $DISPLAY is set
if [[ -z $DISPLAY ]]; then
   echo 'ERROR: $DISPLAY environment variable is not set; megatest dashboard requires X display address to be set in $DISPLAY.'
   exit 1
fi

# check that $DISPLAY is proper
if [[ -x $(which xdpyinfo  2>/dev/null) ]]; then
  if ! xdpyinfo -display "$DISPLAY" &>/dev/null; then
    echo 'ERROR: megatest dashboard cannot open display "'$DISPLAY'".  Please check $DISPLAY environment variable.'
    exit 1
  fi
fi
EOF

fi

cat >> $target << EOF 
if [[ \$(ulimit -a | grep 'open files' | awk '{print \$4}') -gt 10000 ]];then ulimit -n 10000;fi
EOF

# echo "#!/bin/bash" > $target
# echo "exec $prefix/bin/.\$(lsb_release -sr)/bin/$cmd \"\$@\"" >> $target

echo "lsbr=\$(lsb_release -sr)" >> $target
if [ "$LD_LIBRARY_PATH" != "" ];then
  echo "source $prefix/bin/.\$lsbr/cfg.sh" >> $target
fi

# echo "if [[ -e \$lsbr ]];then source \$lsbr;fi" >> $target
echo "exec $chicken_bin_dir/$cmd \"\$@\"" >> $target