Megatest

SHELL=/bin/bash
PREFIX=$(PWD)
CSCOPTS=
INSTALL=install
SRCFILES =

# all : $(PREFIX)/bin/.$(ARCHSTR) mtest dboard mtut ndboard
all : $(PREFIX)/bin/.$(ARCHSTR) mtest dboard mtserve
# add dboard mtut and tcmt back later

# Configuration stuff
transport-flavor :
	@echo Creating transport-flavor with full as flavor. Options include: full, simple
	echo full > transport-flavor

	csc $(CSCOPTS) -c $< $(MOFILES)

$(PREFIX)/bin/.$(ARCHSTR)/mtest : mtest utils/mk_wrapper
	@echo Installing to PREFIX=$(PREFIX)
	$(INSTALL) mtest $(PREFIX)/bin/.$(ARCHSTR)/mtest
	utils/mk_wrapper $(PREFIX) mtest $(PREFIX)/bin/megatest
	chmod a+x $(PREFIX)/bin/megatest

$(PREFIX)/bin/.$(ARCHSTR)/mtserve : mtserve utils/mk_wrapper
	@echo Installing to PREFIX=$(PREFIX)
	$(INSTALL) mtserve $(PREFIX)/bin/.$(ARCHSTR)/mtserve
	utils/mk_wrapper $(PREFIX) mtserve $(PREFIX)/bin/mtserver
	chmod a+x $(PREFIX)/bin/mtserver

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

#          $(PREFIX)/bin/.$(ARCHSTR)/mtexec $(PREFIX)/bin/mtexec $(PREFIX)/bin/serialize-env \
#  $(PREFIX)/bin/viewscreen  $(PREFIX)/bin/mtutil \
#          $(PREFIX)/bin/.$(ARCHSTR)/lib/libpangox-1.0.so \
#          $(PREFIX)/bin/.$(ARCHSTR)/lib/libpangox-1.0.so.0 \
#          $(PREFIX)/bin/.$(ARCHSTR)/lib/libxcb-xlib.so.0
#  $(PREFIX)/bin/tcmt

$(PREFIX)/bin/megatest : $(PREFIX)/bin/.$(ARCHSTR)/mtest
$(PREFIX)/bin/mtserver : $(PREFIX)/bin/.$(ARCHSTR)/mtserve

install : $(PREFIX)/bin/.$(ARCHSTR) $(PREFIX)/bin/.$(ARCHSTR)/mtest \
	  $(PREFIX)/bin/megatest $(PREFIX)/bin/mtserver \
          $(HELPERS) $(PREFIX)/bin/nbfake \
	  $(PREFIX)/bin/serialize-env \
	  $(PREFIX)/bin/nbfind $(PREFIX)/bin/mtrunner $(PREFIX)/bin/mt_xterm \
	  $(PREFIX)/share/docs/megatest_manual.html $(PREFIX)/bin/remrun \
	  $(PREFIX)/share/db/mt-pg.sql \
          $(PREFIX)/share/js/jquery-3.1.0.slim.min.js \
	  $(PREFIX)/bin/.$(ARCHSTR)/dboard $(PREFIX)/bin/dashboard \

	 (logd        (conc apath "/logs")) 
	 (logf        (conc logd "/server-launch-";;(current-process-id)
			    (seconds->year-work-week/day-time-fname (current-seconds))
			    "-"cleandbname".log"))
	 (logf2       (conc logd "/server-"
			    (seconds->year-work-week/day-time-fname (current-seconds))
			    "-"cleandbname"-"))
	 (cmd  (conc "nbfake mtserver -server - -area "apath" -db "dbname)
		     ;; " -autolog "logf2 ;; the side log did not help. Ended up with two logs and the pid in the name was not that useful.
		     ))
    (if (not (directory-exists? logd))
	(create-directory logd #t))
    (system (conc "NBFAKE_LOG="logf" "cmd))))

;; special function to get server

;; (include "call-with-environment-variables/call-with-environment-variables.scm")

(module mtserve
	*

  (import scheme

	  chicken.base
;;	  chicken.bitwise
;;	  chicken.condition
;;	  ;; chicken.csi
;;	  chicken.eval
;;	  chicken.file
;;	  chicken.file.posix
;;	  chicken.format
;;	  chicken.io
;;	  chicken.irregex
;;	  chicken.pathname
;;	  chicken.port
;;	  chicken.pretty-print
;;	  chicken.process
	  chicken.process-context
;;	  chicken.process-context.posix
;;	  chicken.process.signal
;;	  chicken.random
;;	  chicken.repl
;;	  chicken.sort
	  chicken.string
;;	  chicken.tcp
;;	  chicken.time
;;	  chicken.time.posix
;;	  
;;	  (prefix base64 base64:)
;;	  (prefix sqlite3 sqlite3:)
;;	  (prefix sxml-modifications sxml-)

;;	  system-information
;;	  typed-records
;;	  uri-common
;;	  z3
;;	  
;;	  srfi-1
;;	  srfi-4
	  srfi-18
;;	  srfi-13
;;	  srfi-98
;;	  srfi-69
;;
;;	  ;; local modules
;;	  autoload
;;	  adjutant
;;	  csv-xml
;;	  ;; hostinfo
;;	  mtver
;;	  mutils
;;	  cookie
;;	  csv-xml
;;	  ducttape-lib
	  (prefix mtargs args:)
;;	  pkts
;;	  stml2
;;	  (prefix dbi dbi:)
;;
;;	  apimod
;;	  archivemod
;;	  bigmod
	  commonmod
;;	  configfmod
;;	  dbmod
	  debugprint
;;	  ezstepsmod
	  launchmod
;;	  processmod
;;	  rmtmod
;;	  runsmod
;;	  servermod
;;	  tasksmod
;;	  testsmod
	  dbmgrmod
;;	  
;;	  ulex
	  )

;;   ;; ulex parameters
;;   (work-method 'direct)
;;   (return-method 'direct)

;; (include "tests.scm")
;; (include "genexample.scm")
;; (include "tdb.scm")
;; (include "env.scm")
;; (include "diff-report.scm")
;; (include "ods.scm")
;; 

  ;; 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"
      			  ;; "-dest"
 			  ;; "-source" 
 			  ;; "-time-stamp" 
      			  ;; ;; values and messages
      			  ;; ":category"
      			  ;; ":variable"
      			  ;; ":value"
      			  ;; ":expected"
      			  ;; ":tol"
      			  ;; ":units"
			  ;; 
      			  ;; ;; misc
      			  ;; "-start-dir"
 			  ;; "-run-patt"
 			  ;; "-target-patt"   
      			  ;; "-contour"
 			  ;; "-area-tag"  
 			  ;; "-area"  
      			  ;; "-run-tag"
      			  "-server"
 			  "-db"            ;; file name for setting up a server
      			  ;; "-adjutant"
      			  ;; "-transport"
      			  ;; "-port"
      			  ;; "-extract-ods"
      			  ;; "-pathmod"
      			  ;; "-env2file"
      			  ;; "-envcap"
      			  ;; "-envdelta"
      			  ;; "-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
      			  ;; "-debug-noprop"
      			  ;; "-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"
 			  ;; "-autolog"
 			  ;; "-sync-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"
      			  ;; "-kill-wait"    ;; wait this long before removing test (default is 10 sec)
 			  ;; "-diff-html"
			  ;; 
      			  ;; ;; wizards, area capture, setup new ...
      			  ;; "-extract-skeleton"
      			  )
       		   (list  "-h" "-help" "--help"
      			  ;; "-manual"
      			  "-version"
      		          ;; "-force"
      		          ;; "-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"
      			  ;; "-cp-eventtime-to-publishtime"
                          ;; "-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"
      			  ;; "-list-waivers"
			  ;; 
      			  ;; ;; 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"
                          ;; "-kill-runs"
                          ;; "-kill-rerun"
                          ;; "-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"
 			  ;; "-sync-brute-force"
      			  ;; "-logging"
      			  ;; "-v" ;; verbose 2, more than normal (normal is 1)
      			  ;; "-q" ;; quiet 0, errors/warnings only
			  ;; 
                          ;; "-diff-rep"
			  ;; 
      			  ;; "-syscheck"
      			  ;; "-obfuscate"
      			  ;; junk placeholder
      			  ;; "-:p"
      			  
                          )
      		   args:arg-hash
      		   0))
  
  ;; Add args that use remargs here
  ;;
  (if (not (null? remargs))
      (debug:print-error 0 *default-log-port* "Unrecognised arguments: " (string-intersperse (if (list? remargs) remargs (argv))  " ")))
  
  ;; 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") "/.mtserverc")))
    (if (common:file-exists? debugcontrolf)
	(load debugcontrolf)))
  
  ;; before doing anything else change to the start-dir if provided
  ;;
  (if (args:get-arg "-start-dir")
      (if (common:file-exists? (args:get-arg "-start-dir"))
          (let ((fullpath (common:real-path (args:get-arg "-start-dir"))))
            (set-environment-variable! "PWD" fullpath)
            (change-directory fullpath))
      	  (begin
      	    (debug:print-error 0 *default-log-port* "non-existant start dir " (args:get-arg "-start-dir") " specified, exiting.")
      	    (exit 1))))
  

  (define (main)
    (debug:setup)
    (make-and-init-bigdata) 
    (let ((tl        (launch:setup))
 	  (dbname    (args:get-arg "-db")))
      (if dbname
	  (rmt:server-launch dbname)
	  (debug:print 0 *default-log-port* "Usage: mtserve -db <dbpath/file>.db"))))
  #;(set! *didsomething* #t)
  
  
  (thread-join!
   (thread-start!
    (make-thread main)))

)

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

			    (s 0)) ;; sum
		   (let ((start-time (current-milliseconds))
			 (run-id     (+ r (make-run-id))))
		     (rmt:register-test run-id "test1" (conc "item_" i))
		     (thread-sleep! 0.01)
		     (let* ((qry-time (- (current-milliseconds) start-time))
			    (tot-query-time (+ qry-time s))
			    (avg-query-time (* 1.0 (/ tot-query-time (max i 1)))))
		       (if (> qry-time 500)
			   (print "WARNING: rmt:register-test took more than 500ms, "qry-time"ms, i="i", avg-query-time="avg-query-time))
		       (if (eq? (modulo i 100) 0)
			   (print "For run-id="run-id", "(rmt:get-keys-write)" num tests registered="i" avg-query-time="avg-query-time))
		       (if (< i 500)
			   (loop r (+ i 1) tot-query-time)
			   (if (< r 100)
			       (let* ((start-time (current-milliseconds)))
				 (print "rmt:get-keys "(rmt:get-keys)" in "(- (current-milliseconds) start-time))
				 ;;                                          run-id testpatt states statuses offset limit not-in sort-by sort-order qryvals last-update mode
				 (print "Got "(length (rmt:get-tests-for-run run-id "%"     '()    '()       #f      #f    #f     #f      #f         #f      0           #f))" tests for run "run-id)
				 (print "Average query time: "avg-query-time)
				 (loop (+ r 1) 0 tot-query-time))))))))
	       )))
    (thread-start! th1)
    (thread-join! th1)))

(run)

	(if (and (not is-main)
		 (common:low-noise-print 60 "servdat-status"))
	    (debug:print-info 0 *default-log-port* "servdat-status is " (servdat-status *db-serv-info*)))

	(mutex-lock! *heartbeat-mutex*)
	;; set up the database handle
	(if (not *dbstruct-db*) ;; no db opened yet, open the db and register with main if appropriate
	      (let ((watchdog #f)) ;; (bdat-watchdog *bdat*)))
		(debug:print 0 *default-log-port* "SERVER: dbprep")
		(db:setup dbname) ;; sets *dbstruct-db* as side effect
		(servdat-status-set! *db-serv-info* 'db-opened)
		;; IFF I'm not main, call into main and register self
		(if (not is-main)
		    (let ((res (rmt:register-server sinfo
						    *toppath* iface port