Index: Makefile
==================================================================
--- Makefile
+++ Makefile
@@ -20,11 +20,11 @@
SHELL=/bin/bash
PREFIX=$(PWD)
CSCOPTS=
INSTALL=install
SRCFILES = common.scm items.scm launch.scm \
- ods.scm runconfig.scm server.scm \
+ ods.scm runconfig.scm server.scm configf.scm \
db.scm keys.scm margs.scm megatest-version.scm \
process.scm runs.scm tasks.scm tests.scm genexample.scm \
http-transport.scm filedb.scm tdb.scm \
client.scm mt.scm \
ezsteps.scm lock-queue.scm sdb.scm \
@@ -69,14 +69,17 @@
# 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
+all : $(PREFIX)/bin/.$(ARCHSTR) tquery mtest dboard mtut
mtest: $(OFILES) readline-fix.scm megatest.o $(MOFILES) mofiles/ftail.o
csc $(CSCOPTS) $(OFILES) $(MOFILES) megatest.o -o mtest
+
+tquery: $(OFILES) readline-fix.scm tquery.o $(MOFILES) mofiles/ftail.o
+ csc $(CSCOPTS) $(OFILES) $(MOFILES) tquery.o -o tquery
showmtesthash:
@echo $(MTESTHASH)
dboard : $(OFILES) $(GOFILES) dashboard.scm $(MOFILES)
@@ -92,10 +95,11 @@
api.o \
archive.o \
cgisetup/models/pgdb.o \
client.o \
common.o \
+ configf.o \
db.o \
env.o \
http-transport.o \
items.o \
keys.o \
@@ -145,17 +149,17 @@
# $(PREFIX)/bin/revtagfsl : utils/revtagfsl.scm
# csc utils/revtagfsl.scm -o $(PREFIX)/bin/revtagfsl
# Special dependencies for the includes
tests.o db.o launch.o runs.o dashboard-tests.o dashboard-context-menu.o dashboard-guimonitor.o dashboard-main.o monitor.o dashboard.o \
-archive.o megatest.o : db_records.scm
+archive.o megatest.o tquery.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
+db.o ezsteps.o keys.o launch.o megatest.o tquery.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 dashboard-guimonitor.scm dashboard-tests.scm dashboard.scm db.scm dcommon.scm ezsteps.scm fs-transport.scm http-transport.scm index-tree.scm items.scm keys.scm launch.scm megatest.scm monitor.scm mt.scm newdashboard.scm runconfig.scm runs.scm server.scm tdb.scm tests.scm tree.scm : common_records.scm
+megatest.o tquery.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 tquery.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
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
@@ -170,12 +174,15 @@
csc $(CSCOPTS) -c $<
$(PREFIX)/bin/.$(ARCHSTR)/mtest : mtest utils/mk_wrapper
@echo Installing to PREFIX=$(PREFIX)
$(INSTALL) mtest $(PREFIX)/bin/.$(ARCHSTR)/mtest
+ $(INSTALL) tquery $(PREFIX)/bin/.$(ARCHSTR)/tquery
utils/mk_wrapper $(PREFIX) mtest $(PREFIX)/bin/megatest
+ utils/mk_wrapper $(PREFIX) tquery $(PREFIX)/bin/tquery
chmod a+x $(PREFIX)/bin/megatest
+ chmod a+x $(PREFIX)/bin/tquery
$(PREFIX)/bin/.$(ARCHSTR)/ndboard : ndboard
$(INSTALL) ndboard $(PREFIX)/bin/.$(ARCHSTR)/ndboard
$(PREFIX)/bin/newdashboard : $(PREFIX)/bin/.$(ARCHSTR)/ndboard utils/mk_wrapper
@@ -271,16 +278,16 @@
$(PREFIX)/bin/.$(ARCHSTR)/dboard : dboard $(FILES) utils/mk_wrapper
utils/mk_wrapper $(PREFIX) dboard $(PREFIX)/bin/dashboard
chmod a+x $(PREFIX)/bin/dashboard
$(INSTALL) dboard $(PREFIX)/bin/.$(ARCHSTR)/dboard
-install : $(PREFIX)/bin/.$(ARCHSTR) $(PREFIX)/bin/.$(ARCHSTR)/mtest $(PREFIX)/bin/megatest \
+install : $(PREFIX)/bin/.$(ARCHSTR) $(PREFIX)/bin/.$(ARCHSTR)/mtest $(PREFIX)/bin/megatest $(PREFIX)/bin/.$(ARCHSTR)/tquery $(PREFIX)/bin/tquery \
$(PREFIX)/bin/.$(ARCHSTR)/dboard $(PREFIX)/bin/dashboard $(HELPERS) $(PREFIX)/bin/nbfake \
$(PREFIX)/bin/nbfind $(PREFIX)/bin/loadrunner $(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)/bin/tcmt $(PREFIX)/share/db/mt-pg.sql $(PREFIX)/bin/.$(ARCHSTR)/tquery \
$(PREFIX)/share/js/jquery-3.1.0.slim.min.js
# $(PREFIX)/bin/.$(ARCHSTR)/ndboard
# $(PREFIX)/bin/newdashboard
@@ -297,11 +304,11 @@
$(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 dboard dboard.o megatest.o dashboard.o megatest-fossil-hash.* altdb.scm mofiles/*.o vg.o
+ rm -f $(OFILES) $(GOFILES) $(MOFILES) $(TCMTOBJS) $(PREFIX)/megatest $(PREFIX)/dashboard $(PREFIX)/tquery mtest tquery mtutil dboard dboard.o megatest.o dashboard.o megatest-fossil-hash.* altdb.scm mofiles/*.o vg.o
#======================================================================
# Make the records files
#======================================================================
@@ -340,11 +347,11 @@
deploytarg/dboard : $(OFILES) $(GOFILES) dashboard.scm deploytarg/apropos.so
csc -deploy $(OFILES) $(GOFILES) dashboard.scm -o deploytarg
mv deploytarg/deploytarg deploytarg/dboard
-# DATASHAREO=common.o process.o tree.o dcommon.o margs.o launch.o gutils.o db.o synchash.o server.o \
+# 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)
@@ -396,12 +403,12 @@
fi
if csi -ne '(use postgresql)';then \
echo "(use postgresql)(hash-table-set! *available-db* 'postgresql #t)" >> altdb.scm;\
fi
-portlogger-example : portlogger-example.scm api.o archive.o client.o common.o 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 dashboard-tests.o dashboard-context-menu.o db.o dcommon.o ezsteps.o filedb.o genexample.o gutils.o http-transport.o items.o keys.o launch.o lock-queue.o margs.o megatest-version.o mt.o ods.o portlogger.o process.o rmt.o rpc-transport.o runconfig.o runs.o sdb.o server.o synchash.o tasks.o tdb.o tests.o tree.o
+portlogger-example : portlogger-example.scm api.o archive.o client.o common.o configf.o dashboard-tests.o dashboard-context-menu.o db.o dcommon.o ezsteps.o filedb.o genexample.o gutils.o http-transport.o items.o keys.o launch.o lock-queue.o margs.o 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
Index: common.scm
==================================================================
--- common.scm
+++ common.scm
@@ -18,11 +18,11 @@
;;======================================================================
(use srfi-1 data-structures posix regex-case (prefix base64 base64:)
format dot-locking csv-xml z3 ;; sql-de-lite
- hostinfo md5 message-digest typed-records directory-utils stack
+ s11n hostinfo md5 message-digest typed-records directory-utils stack
matchable regex posix (srfi 18) extras ;; tcp
(prefix nanomsg nmsg:)
(prefix sqlite3 sqlite3:)
pkts (prefix dbi dbi:)
)
@@ -1462,10 +1462,13 @@
(lambda ()
(read-line)))))
(define (get-cpu-load #!key (remote-host #f))
(car (common:get-cpu-load remote-host)))
+
+(define (get-cpu-load-original #!key (remote-host #f))
+ (car (common:get-cpu-load-original remote-host)))
;; (let* ((load-res (process:cmd-run->list "uptime"))
;; (load-rx (regexp "load average:\\s+(\\d+)"))
;; (cpu-load #f))
;; (for-each (lambda (l)
;; (let ((match (string-search load-rx l)))
@@ -1502,13 +1505,18 @@
(handle-exceptions
exn
#f
(with-output-to-file fullpath (lambda ()(pp dat))))))
+(define (common:get-cpu-load remote-host)
+ (let ((al (common:get-normalized-cpu-load remote-host)))
+ (list (alist-ref '1m-load al) (alist-ref '5m-load al) (alist-ref '15m-load al)))
+ ;;(common:get-cpu-load-original remote-host)
+)
;; get cpu load by reading from /proc/loadavg, return all three values
;;
-(define (common:get-cpu-load remote-host)
+(define (common:get-cpu-load-original remote-host)
(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))
@@ -1523,11 +1531,51 @@
;; 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))
+ (if (file-exists? (pathname-expand "~/.megatest/tquery"))
+ (begin
+ (with-input-from-file (pathname-expand "~/.megatest/tquery")
+ (lambda()
+ (set! tqfilecontents (read-string))
+ ))
+ (set! tqfileparts (string-split (string-trim-both tqfilecontents) ":"))
+ ;;(print "TQuery host: " (car tqfileparts))
+ ;;(print "TQuery port " (cadr tqfileparts))
+ ;;(print "Getting normalized cpu load for : " remote-host " via " (car tqfileparts) ":" (cadr tqfileparts))
+ )
+ (begin
+ (process-run "nbfake /p/fdk/gwa/jmoon18/fossil/megatest/tquery -server -")
+ (sleep 5)
+ )
+ )
+ (handle-exceptions exn
+ (lambda()
+ ;;(print "Need to start tquery server here:")
+ (process-run "nbfake /p/fdk/gwa/jmoon18/fossil/megatest/tquery -server -")
+ (sleep 5)
+ (common:get-normalized-cpu-load remote-host)
+ )
+ (define-values (i o) (tcp-connect (car tqfileparts) (string->number (cadr tqfileparts))))
+ ;;(define-values (i o) (tcp-connect "plxcas102" 9000))
+ (write-line (conc "adj-cpuload-full:" (if remote-host remote-host (get-host-name))) o)
+ ;;(write-line "adj-cpuload-full:plxcm5005" o)
+ (with-input-from-string (read-line i) read)
+ )
+
+ ;;(define new-al with-input-from-string (read-line i) read)
+ ;;new-al
+ ;;(set! loadstring (read-string i))
+ ;;(with-input-from-string loadstring read)
+ ;;`((adj-proc-load 3.0)
+ ;; (adj-core-load 3.2))
+)
+
+
+(define (common:get-normalized-cpu-load-original remote-host)
+ (let ((res (common:get-normalized-cpu-load-raw-original remote-host))
(default `((adj-proc-load . 2) ;; there is no right answer
(adj-core-load . 2)
(1m-load . 2)
(5m-load . 0) ;; causes a large delta - thus causing default of throttling if stuff goes wrong
(15m-load . 0)
@@ -1541,11 +1589,11 @@
res)
((eq? res #f) default) ;; add messages?
((eq? res #f) default) ;; this would be the #eof
(else default))))
-(define (common:get-normalized-cpu-load-raw remote-host)
+(define (common:get-normalized-cpu-load-raw-original remote-host)
(let* ((actual-host (or remote-host (get-host-name)))) ;; #f is localhost
(or (common:get-cached-info actual-host "normalized-load")
(let ((data (if remote-host
(with-input-from-pipe
(conc "ssh " remote-host " cat /proc/loadavg;cat /proc/cpuinfo;echo end")
@@ -1757,10 +1805,14 @@
(hh (if hh-dat (car hh-dat) #f))
(numcpus (common:get-num-cpus hh)))
(common:wait-for-normalized-load maxload msg hh)))
(define (common:get-num-cpus remote-host)
+ (alist-ref 'core (common:get-normalized-cpu-load remote-host))
+)
+
+(define (common:get-num-cpus-orig remote-host)
(let* ((actual-host (or remote-host (get-host-name))))
(or (common:get-cached-info actual-host "num-cpus" age: 86400) ;; hosts had better not be changing the number of cpus too often!
(let* ((proc (lambda ()
(let loop ((numcpu 0)
(inl (read-line)))
Index: http-transport.scm
==================================================================
--- http-transport.scm
+++ http-transport.scm
@@ -22,11 +22,11 @@
(use srfi-1 posix regex regex-case srfi-69 hostinfo md5 message-digest posix-extras)
(use spiffy uri-common intarweb http-client spiffy-request-vars intarweb spiffy-directory-listing)
;; Configurations for server
-(tcp-buffer-size 2048)
+;;(tcp-buffer-size 2048)
(max-connections 2048)
(declare (unit http-transport))
(declare (uses common))
ADDED tquery.scm
Index: tquery.scm
==================================================================
--- /dev/null
+++ tquery.scm
@@ -0,0 +1,598 @@
+;; 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 .
+;;
+
+;; (include "common.scm")
+;; (include "megatest-version.scm")
+
+;; fake out readline usage of toplevel-command
+(define (toplevel-command . a) #f)
+
+(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (prefix base64 base64:)
+ readline apropos json http-client directory-utils typed-records
+ http-client srfi-18 extras format tcp tcp-server pathname-expand s11n)
+
+;; Added for csv stuff - will be removed
+;;
+(use sparse-vectors)
+
+(require-library mutils)
+
+;; (use zmq)
+
+(declare (uses common))
+(declare (uses megatest-version))
+(declare (uses margs))
+(declare (uses runs))
+(declare (uses launch))
+(declare (uses server))
+(declare (uses client))
+(declare (uses tests))
+(declare (uses genexample))
+;; (declare (uses daemon))
+(declare (uses db))
+;; (declare (uses dcommon))
+
+(declare (uses tdb))
+(declare (uses mt))
+(declare (uses api))
+(declare (uses tasks)) ;; only used for debugging.
+(declare (uses env))
+(declare (uses diff-report))
+(declare (uses ftail))
+(import ftail)
+
+(define *db* #f) ;; this is only for the repl, do not use in general!!!!
+
+(include "common_records.scm")
+(include "key_records.scm")
+(include "db_records.scm")
+(include "run_records.scm")
+(include "megatest-fossil-hash.scm")
+
+(define *usage-log-file* #f) ;; put path to file for logging usage in this var in the ~/.megatestrc file
+(define *usage-use-seconds* #t) ;; for Epoc seconds in usage logging change this to #t in ~/.megatestrc file
+
+;; load the ~/.megatestrc file, put (use trace)(trace-call-sites #t)(trace function-you-want-to-trace) in this file
+;;
+(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.megatestrc")))
+ (if (common:file-exists? debugcontrolf)
+ (load debugcontrolf)))
+
+;; usage logging, careful with this, it is not designed to deal with all real world challenges!
+;;
+(if (and *usage-log-file*
+ (file-write-access? *usage-log-file*))
+ (with-output-to-file
+ *usage-log-file*
+ (lambda ()
+ (print
+ (if *usage-use-seconds*
+ (current-seconds)
+ (time->string
+ (seconds->local-time (current-seconds))
+ "%Yww%V.%w %H:%M:%S"))
+ " "
+ (current-user-name) " "
+ (current-directory) " "
+ "\"" (string-intersperse (argv) " ") "\""))
+ #:append))
+
+;; Disabled help items
+;; -rollup : (currently disabled) fill run (set by :runname) with latest test(s)
+;; from prior runs with same keys
+;; -daemonize : fork into background and disconnect from stdin/out
+
+(define help (conc "
+Megatest, documentation at http://www.kiatoa.com/fossils/megatest
+ version " megatest-version "
+ license GPL, Copyright Matt Welland 2006-2017
+
+Usage: megatest [options]
+ -h : this help
+ -manual : show the Megatest user manual
+ -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.
+ -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
+ -lock : lock run specified by target and runname
+ -unlock : unlock run specified by target and runname
+ -set-run-status status : sets status for run to status, requires -target and -runname
+ -get-run-status : gets status for run specified by target and runname
+ -run-wait : wait on run specified by target and runname
+ -preclean : remove the existing test directory before running the test
+ -clean-cache : remove the cached megatest.config and runconfigs.config files
+ -no-cache : do not use the cached config files.
+ -one-pass : launch as many tests as you can but do not wait for more to be ready
+ -remove-keep N : remove all but N most recent runs per target; use '-actions, -age, -precmd'
+ -age : 120d,3h,20m to apply only to runs older than the
+ specified age. NB// M=month, m=minute
+ -actions : print,remove-runs,archive to specify action to take
+ -precmd : insert a wrapper command in front of the commands run
+
+Selectors (e.g. use for -runtests, -remove-runs, -set-state-status, -list-runs etc.)
+ -target key1/key2/... : run for key1, key2, etc.
+ -reqtarg key1/key2/... : run for key1, key2, etc. but key1/key2 must be in runconfigs
+ -testpatt patt1/patt2,patt3/... : % is wildcard
+ -runname : required, name for this particular test run
+ -state : Applies to runs, tests or steps depending on context
+ -status : Applies to runs, tests or steps depending on context
+ -modepatt key : load testpatt from in runconfigs instead of default TESTPATT if -testpatt and -tagexpr are not specified
+ -tagexpr tag1,tag2%,.. : select tests with tags matching expression
+
+
+Test helpers (for use inside tests)
+ -step stepname
+ -test-status : set the state and status of a test (use :state and :status)
+ -setlog logfname : set the path/filename to the final log relative to the test
+ directory. may be used with -test-status
+ -set-toplog logfname : set the overall log for a suite of sub-tests
+ -summarize-items : for an itemized test create a summary html
+ -m comment : insert a comment for this test
+
+Test data capture
+ -set-values : update or set values in the testdata table
+ :category : set the category field (optional)
+ :variable : set the variable name (optional)
+ :value : value measured (required)
+ :expected : value expected (required)
+ :tol : |value-expect| <= tol (required, can be <, >, >=, <= or number)
+ :units : name of the units for value, expected_value etc. (optional)
+ -load-test-data : read test specific data for storage in the test_data table
+ from standard in. Each line is comma delimited with four
+ fields category,variable,value,comment
+
+Queries
+ -list-runs patt : list runs matching pattern \"patt\", % is the wildcard
+ -show-keys : show the keys used in this megatest setup
+ -test-files targpatt : get the most recent test path/file matching targpatt e.g. %/% or '*.log'
+ returns list sorted by age ascending, see examples below
+ -test-paths : get the test paths matching target, runname, item and test
+ patterns.
+ -list-disks : list the disks available for storing runs
+ -list-targets : list the targets in runconfigs.config
+ -list-db-targets : list the target combinations used in the db
+ -show-config : dump the internal representation of the megatest.config file
+ -show-runconfig : dump the internal representation of the runconfigs.config file
+ -dumpmode MODE : dump in MODE format instead of sexpr, MODE=json,ini,sexp etc. (add -debug 0,9 to see which file contributes each line)
+ -show-cmdinfo : dump the command info for a test (run in test environment)
+ -section sectionName
+ -var varName : for config and runconfig lookup value for sectionName varName
+ -since N : get list of runs changed since time N (Unix seconds)
+ -fields fieldspec : fields to include in json dump; runs:id,runame+tests:testname+steps
+ -sort fieldname : in -list-runs sort tests by this field
+ -testdata-csv [categorypatt/]varpatt : dump testdata for given category
+
+Misc
+ -start-dir path : switch to this directory before running megatest
+ -contour cname : add a level of hierarcy to the linktree and run paths
+ -area-tag tagname : add a tag to an area while syncking to pgdb
+ -rebuild-db : bring the database schema up to date
+ -cleanup-db : remove any orphan records, vacuum the db
+ -import-megatest.db : push data from megatest.db to cache db files in /tmp/$USER
+ -sync-to-megatest.db : pull data from cache files in /tmp/$USER to megatest.db
+ -sync-to dest : sync to new postgresql central style database
+ -update-meta : update the tests metadata for all tests
+ -setvars VAR1=val1,VAR2=val2 : Add environment variables to a run NB// these are
+ overwritten by values set in config files.
+ -server -|hostname : start the server (reduces contention on megatest.db), use
+ - to automatically figure out hostname
+ -transport http|rpc : use http or rpc for transport (default is http)
+ -log logfile : send stdout and stderr to logfile
+ -list-servers : list the servers
+ -kill-servers : kill all servers
+ -repl : start a repl (useful for extending megatest)
+ -load file.scm : load and run file.scm
+ -mark-incompletes : find and mark incomplete tests
+ -ping run-id|host:port : ping server, exit with 0 if found
+ -debug N|N,M,O... : enable debug 0-N or N and M and O ...
+ -config fname : override the megatest.config file with fname
+ -append-config fname : append fname to the megatest.config file
+
+Utilities
+ -env2file fname : write the environment to fname.csh and fname.sh
+ -envcap a : save current variables labeled as context 'a' in file envdat.db
+ -envdelta a-b : output enviroment delta from context a to context b to -o fname
+ set the output mode with -dumpmode csh, bash or ini
+ note: ini format will use calls to use curr and minimize path
+ -refdb2dat refdb : convert refdb to sexp or to format specified by s-dumpmode
+ 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
+ -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 -target-patt -dumpmode
+ -list-test-time : list time requered to complete each test in a run. It following following arguments
+ -runname -target -dumpmode
+
+
+
+
+Diff report
+ -diff-rep : generate diff report (must include -src-target, -src-runname, -target, -runname
+ and either -diff-email or -diff-html)
+ -src-target
+ -src-runname
+ -diff-email : comma separated list of email addresses to send diff report
+ -diff-html : path to html file to generate
+
+Spreadsheet generation
+ -extract-ods fname.ods : extract an open document spreadsheet from the database
+ -pathmod path : insert path, i.e. path/runame/itempath/logfile.html
+ will clear the field if no rundir/testname/itempath/logfile
+ if it contains forward slashes the path will be converted
+ to windows style
+Getting started
+ -create-megatest-area : create a skeleton megatest area. You will be prompted for paths
+ -create-test testname : create a skeleton megatest test. You will be prompted for info
+
+Examples
+
+# Get test path, use '.' to get a single path or a specific path/file pattern
+megatest -test-files 'logs/*.log' -target ubuntu/n%/no% -runname w49% -testpatt test_mt%
+
+Called as " (string-intersperse (argv) " ") "
+Version " megatest-version ", built from " megatest-fossil-hash ))
+
+;; -gui : start a gui interface
+;; -config fname : override the runconfigs file with fname
+
+;; process args
+(define remargs (args:get-args
+ (argv)
+ (list "-runtests" ;; run a specific test
+ "-config" ;; override the config file name
+ "-append-config"
+ "-execute" ;; run the command encoded in the base64 parameter
+ "-step"
+ "-target"
+ "-reqtarg"
+ ":runname"
+ "-runname"
+ ":state"
+ "-state"
+ ":status"
+ "-status"
+ "-list-runs"
+ "-testdata-csv"
+ "-testpatt"
+ "--modepatt"
+ "-modepatt"
+ "-tagexpr"
+ "-itempatt"
+ "-setlog"
+ "-set-toplog"
+ "-runstep"
+ "-logpro"
+ "-m"
+ "-rerun"
+ "-days"
+ "-rename-run"
+ "-to"
+ ;; values and messages
+ ":category"
+ ":variable"
+ ":value"
+ ":expected"
+ ":tol"
+ ":units"
+ ;; misc
+ "-start-dir"
+ "-run-patt"
+ "-target-patt"
+ "-contour"
+ "-area-tag"
+ "-server"
+ "-transport"
+ "-port"
+ "-extract-ods"
+ "-pathmod"
+ "-env2file"
+ "-envcap"
+ "-envdelta"
+ "-setvars"
+ "-set-state-status"
+
+ ;; move runs stuff here
+ "-remove-keep"
+ "-set-run-status"
+ "-age"
+ "-archive"
+ "-actions"
+ "-precmd"
+
+ "-debug" ;; for *verbosity* > 2
+ "-create-test"
+ "-override-timeout"
+ "-test-files" ;; -test-paths is for listing all
+ "-load" ;; load and exectute a scheme file
+ "-section"
+ "-var"
+ "-dumpmode"
+ "-run-id"
+ "-ping"
+ "-refdb2dat"
+ "-o"
+ "-log"
+ "-since"
+ "-fields"
+ "-recover-test" ;; run-id,test-id - used internally to recover a test stuck in RUNNING state
+ "-sort"
+ "-target-db"
+ "-source-db"
+ "-prefix-target"
+
+ "-src-target"
+ "-src-runname"
+ "-diff-email"
+ "-sync-to"
+ "-pgsync"
+ "-diff-html"
+ )
+ (list "-h" "-help" "--help"
+ "-manual"
+ "-version"
+ "-force"
+ "-xterm"
+ "-showkeys"
+ "-show-keys"
+ "-test-status"
+ "-set-values"
+ "-load-test-data"
+ "-summarize-items"
+ "-gui"
+ "-daemonize"
+ "-preclean"
+ "-rerun-clean"
+ "-rerun-all"
+ "-clean-cache"
+ "-no-cache"
+ "-cache-db"
+ "-use-db-cache"
+ "-prepend-contour"
+ ;; misc
+ "-repl"
+ "-lock"
+ "-unlock"
+ "-list-servers"
+ "-kill-servers"
+ "-run-wait" ;; wait on a run to complete (i.e. no RUNNING)
+ "-one-pass" ;;
+ "-local" ;; run some commands using local db access
+ "-generate-html"
+ "-generate-html-structure"
+ "-list-run-time"
+ "-list-test-time"
+ ;; misc queries
+ "-list-disks"
+ "-list-targets"
+ "-list-db-targets"
+ "-show-runconfig"
+ "-show-config"
+ "-show-cmdinfo"
+ "-get-run-status"
+
+ ;; queries
+ "-test-paths" ;; get path(s) to a test, ordered by youngest first
+
+ "-runall" ;; run all tests, respects -testpatt, defaults to %
+ "-run" ;; alias for -runall
+ "-remove-runs"
+ "-keep-records" ;; use with -remove-runs to remove only the run data
+ "-rebuild-db"
+ "-cleanup-db"
+ "-rollup"
+ "-update-meta"
+ "-create-megatest-area"
+ "-mark-incompletes"
+
+ "-convert-to-norm"
+ "-convert-to-old"
+ "-import-megatest.db"
+ "-sync-to-megatest.db"
+ "-logging"
+ "-v" ;; verbose 2, more than normal (normal is 1)
+ "-q" ;; quiet 0, errors/warnings only
+
+ "-diff-rep"
+ )
+ args:arg-hash
+ 0))
+
+;; Add args that use remargs here
+;;
+(if (and (not (null? remargs))
+ (not (or
+ (args:get-arg "-runstep")
+ (args:get-arg "-envcap")
+ (args:get-arg "-envdelta")
+ )
+ ))
+ (debug:print-error 0 *default-log-port* "Unrecognised arguments: " (string-intersperse (if (list? remargs) remargs (argv)) " ")))
+
+;; before doing anything else change to the start-dir if provided
+;;
+
+;; bracket open-output-file with code to make leading directory if it does not exist and handle exceptions
+(define (open-logfile logpath)
+ (condition-case
+ (let* ((log-dir (or (pathname-directory logpath) ".")))
+ (if (not (directory-exists? log-dir))
+ (system (conc "mkdir -p " log-dir)))
+ (open-output-file logpath))
+ (exn ()
+ (debug:print-error 0 *default-log-port* "Could not open log file for write: "logpath)
+ (define *didsomething* #t)
+ (exit 1))))
+
+(define (is-port-in-use port-num)
+ (let* ((ret #f))
+ (let-values (((inp oup pid)
+ (process "netstat" (list "-tulpn" ))))
+ (let loop ((inl (read-line inp)))
+ (if (not (eof-object? inl))
+ (begin
+ (if (string-search (regexp (conc ":" port-num)) inl)
+ (begin
+ ;(print "Output: " inl)
+ (set! ret #t))
+ (loop (read-line inp)))))))
+ret))
+
+(define (start-nn-server portnum )
+ (let ((rep (nn-socket 'rep)))
+ (handle-exceptions
+ exn
+ (let ((emsg ((condition-property-accessor 'exn 'message) exn)))
+ (print "ERROR: Failed to start server \"" emsg "\"")
+ (exit 1))
+
+ (nn-bind rep (conc "tcp://*:" portnum)))
+ rep))
+
+(define (get-free-port port-num)
+ (let loop ((cur-port port-num))
+ (if (not (is-port-in-use cur-port))
+ cur-port
+ (loop (+ 1 cur-port))
+ )
+ )
+)
+
+(print "PORT: " (get-free-port 9000))
+
+(defstruct host-load stamp cores cpuload adj-cpu-load load-alist)
+(define *host-loads* (make-hash-table))
+;;(let ((p (make-host-load stamp: 1 cores: 4 cpuload: 42 adj-cpu-load: 42)))
+;; (hash-table-set! *host-loads* "plxcas102" p)
+;;)
+(if (args:get-arg "-server")
+ ;;(repl)
+ (handle-exceptions
+ exn
+ (print "ERROR-New: " ((condition-property-accessor 'exn 'message) exn))
+ (let ((port (get-free-port 9000))
+ (host (get-host-name)))
+ (with-output-to-file (pathname-expand "~/.megatest/tquery")
+ (lambda() (print host ":" port))
+ )
+ (print "Starting Nanomsg port - New - " port)
+ ((make-tcp-server (tcp-listen port) (lambda()
+ (let ((instr (read-line)))
+ (write-line (conc "Instr: " instr) (current-error-port))
+ (case (string->symbol (car (string-split instr ":")))
+ ((cpuload)
+ (if (hash-table-ref/default *host-loads* (cadr (string-split instr ":")) #f)
+ (begin
+ (write-line "Found it in hash!" (current-error-port))
+ (let ((inl (number->string (host-load-cpuload (hash-table-ref/default *host-loads* (cadr (string-split instr ":")) #f)))))
+ (write-line (conc "Sending Cached Value: " inl) ( current-error-port))
+ (print inl)
+ )
+ )
+ (begin (hash-table-set! *host-loads* (cadr (string-split instr ":")) (make-host-load stamp: (current-seconds) cores: 4 cpuload: (car (common:get-cpu-load-original (cadr (string-split instr ":")))) adj-cpu-load: 11 load-alist: (common:get-normalized-cpu-load-original (cadr (string-split instr ":")))))
+ (let ((inl (number->string (host-load-cpuload (hash-table-ref/default *host-loads* (cadr (string-split instr ":")) #f)))))
+ (write-line (conc "Sending Fresh Value: " inl) (current-error-port))
+ (print inl)
+ )
+ ;;(print (host-load-cpuload (hash-table-ref/default *host-loads* (cadr (string-split instr ":")) #f)))
+ ;;(nn-send rep (host-load-cpuload (hash-table-ref/default *host-loads* (cadr (string-split instr ":")) #f)))
+ )
+ )
+ )
+ ((adj-cpuload)
+ (if (hash-table-ref/default *host-loads* (cadr (string-split instr ":")) #f)
+ (begin
+ (write-line "Found it in hash!" (current-error-port))
+ (let ((inl (number->string (alist-ref 'adj-proc-load (host-load-load-alist (hash-table-ref/default *host-loads* (cadr (string-split instr ":")) #f))))))
+ (write-line (conc "Sending Cached Value: " inl) (current-error-port))
+ (print inl)
+ )
+ )
+ (begin (hash-table-set! *host-loads* (cadr (string-split instr ":")) (make-host-load stamp: (current-seconds) cores: 4 cpuload: (car (common:get-cpu-load-original (cadr (string-split instr ":")))) adj-cpu-load: 11 load-alist: (common:get-normalized-cpu-load-original (cadr (string-split instr ":")))))
+ (let ((inl (number->string (alist-ref 'adj-proc-load (host-load-load-alist (hash-table-ref/default *host-loads* (cadr (string-split instr ":")) #f))))))
+ (write-line (conc "Sending Fresh Value: " inl) (current-error-port))
+ (print inl)
+ (write-line inl (current-error-port))
+ )
+ ;;(print (host-load-cpuload (hash-table-ref/default *host-loads* (cadr (string-split instr ":")) #f)))
+ ;;(nn-send rep (host-load-cpuload (hash-table-ref/default *host-loads* (cadr (string-split instr ":")) #f)))
+ )))
+ ((adj-cpuload-full)
+ (if (hash-table-ref/default *host-loads* (cadr (string-split instr ":")) #f)
+ (begin
+ (write-line "Found it in hash!" (current-error-port))
+ (let ((inl (host-load-load-alist (hash-table-ref/default *host-loads* (cadr (string-split instr ":")) #f))))
+ (write-line (conc "Sending Cached Value: " inl) (current-error-port))
+ (print inl)
+ )
+ )
+ (begin (hash-table-set! *host-loads* (cadr (string-split instr ":")) (make-host-load stamp: (current-seconds) cores: 4 cpuload: (car (common:get-cpu-load-original (cadr (string-split instr ":")))) adj-cpu-load: 11 load-alist: (with-output-to-string (lambda() (write (common:get-normalized-cpu-load-original (cadr (string-split instr ":"))))))))
+ (write-line "Not in hash!" (current-error-port))
+ (let ((inl (host-load-load-alist (hash-table-ref/default *host-loads* (cadr (string-split instr ":")) #f))))
+ (write-line (conc "Sending Fresh Value: " inl) (current-error-port))
+ ;;(print (with-output-to-string (lambda() (write inl))))
+ (print inl)
+ (write-line inl (current-error-port))
+ )
+ )))
+ ((bob)
+ (print (alist-ref 'adj-proc-load (host-load-cpuload (hash-table-ref/default *host-loads* "plxcm5005" #f))))
+ )
+ ((whoami)
+ (print "tquery")
+ )
+ )
+ (for-each (lambda(l)
+ (if (> (current-seconds) (+ (host-load-stamp (hash-table-ref/default *host-loads* l #f)) 30))
+ (begin
+ ;; (print "Expired!")
+ (hash-table-delete! *host-loads* l) )
+ )
+ ;;(print l (host-load-stamp (hash-table-ref/default *host-loads* l #f)))
+ )
+ (hash-table-keys *host-loads*)
+ )
+ ))))
+ )
+ ))
+
+(if (or (args:get-arg "-h")
+ (args:get-arg "-help")
+ (args:get-arg "--help"))
+ (begin
+ (print help)
+ (exit)))
+
+(if (args:get-arg "-version")
+ (begin
+ (print (common:version-signature)) ;; (print megatest-version)
+ (exit)))
+