Megatest

  -mark-incompletes       : find and mark incomplete tests
  -ping run-id|host:port  : ping server, exit with 0 if found
  -debug N|N,M,O...       : enable debug 0-N or N and M and O ...
  -debug-noprop N|M,M,O...: enable debug but do not propagate to subprocesses via MT_DEBUG
  -config fname           : override the megatest.config file with fname
  -append-config fname    : append fname to the megatest.config file
  -import-sexpr fname     : import a sexpr file (use -list-runs % -dumpmode sexpr to create)
  -remove-dbs all         : remove Megatest DBs before importing sexpr. (Use only with -import-sexpr)
  -regen-testfiles        : regenerate scripts and logpro files from testconfig, run in test context
  
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

			"-pathmod"
			"-env2file"
			"-envcap"
			"-envdelta"
			"-setvars"
			"-set-state-status"
			"-import-sexpr"
                        "-remove-dbs" ;; to be used only with -import-sexpr to remove megatest dbs first.
			"-period"  ;; sync period in seconds
			"-timeout" ;; exit sync if timeout in seconds exceeded since last change

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

                        "-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"
			"-regen-testfiles"
			
			;; misc queries
			"-list-disks"
			"-list-targets"
			"-list-db-targets"
			"-show-runconfig"
			"-show-config"

    (let* (;; (run-id     (args:get-arg "-run-id"))
	   (dbfname    (args:get-arg "-db"))
	   (tl         (launch:setup))
	   (keys       (keys:config-get-fields *configdat*)))
      (case (rmt:transport-mode)
	((tcp)
	 (let* ((timeout    (server:expiration-timeout)))
	   (debug:print 0 *default-log-port* "INFO: megatest -server starting on " (get-host-name) " for " dbfname " using tcp method with timeout of "timeout)
	   (tt-server-timeout-param timeout)
	   (thread-start! (make-thread api:print-db-stats "print-db-stats"))
	   (if dbfname
	       (tt:start-server tl #f dbfname api:tcp-dispatch-request-make-handler keys)
	       (begin
		 (debug:print 0 *default-log-port* "ERROR: transport mode is tcp - -db is required.")
		 (exit 1)))))
	(else (debug:print 0 *default-log-port* "ERROR: rmt:transport-mode value not recognised "(rmt:transport-mode))))
      (set! *didsomething* #t)))

  )
)




(if (args:get-arg "-kill-servers")
  
  (let* ((tl (launch:setup)) ;; need this to initialize *toppath*
        (servdir (tt:get-servinfo-dir *toppath*))
        (servfiles (glob (conc servdir "/*:*.db")))
        (fmtstr  "~10a~22a~10a~25a~25a~8a\n")
        (dbfiles (if (file-exists? (conc *toppath* "/.mtdb/main.db")) (append (glob (conc *toppath* "/.mtdb/main.db")) (glob (conc *toppath* "/.mtdb/?.db"))(glob (conc *toppath* "/.mtdb/??.db"))) '()))
        (ttdat (make-tt areapath: *toppath*))
     )
     (format #t fmtstr "DB" "host:port" "PID" "age" "last mod" "state")
     (for-each
        (lambda (dbfile)
          (let* (
            (dbfname (conc (pathname-file dbfile) ".db"))

                ) 
              )
              sfiles
            )
          )
       )
       dbfiles
     )
     ;; remove this db, because otherwise metadata contains records for old servers, and this causes a problem with db:no-sync-get-lock-with-id.
     (if (file-exists? (conc *toppath* "/.mtdb/no-sync.db"))
       (delete-file (conc *toppath* "/.mtdb/no-sync.db"))
     )
     (set! *didsomething* #t)
     (exit)  
  )
)

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

	   (let* ((db       #f)
		  ;; DO NOT run remote
		  (paths    (tests:test-get-paths-matching keys target (args:get-arg "-test-files"))))
	     (for-each (lambda (path)
			 (print path))
		       paths))))))

;;======================================================================
;; Utils for test areas
;;======================================================================

(if (args:get-arg "-regen-testfiles")
    (if (getenv "MT_TEST_RUN_DIR")
	(begin
	  (launch:setup)
	  (change-directory (getenv "MT_TEST_RUN_DIR"))
	  (let* ((testname (getenv "MT_TEST_NAME"))
		 (itempath (getenv "MT_ITEMPATH")))
	    (launch:extract-scripts-logpro (getenv "MT_TEST_RUN_DIR") testname itempath #f))
	  (set! *didsomething* #t))
	(debug:print 0 *default-log-port* "ERROR: Must run -regen-testfiles in a test environment (i.e. test xterm from dashboard)")))
		 	  
;;======================================================================
;; Archive tests
;;======================================================================
;; Archive tests matching target, runname, and testpatt
(if (equal? (args:get-arg "-archive") "replicate-db")
    (begin
          ;; check if source
          ;; check if megatest.db exist
         (launch:setup)
         (if (not (args:get-arg "-source"))
             (begin 
             (debug:print-info 1 *default-log-port* "Missing required argument -source <archive path>")
             (exit 1)))
         (if (common:file-exists? (conc  *toppath* "/megatest.db"))
             (begin  
               (debug:print-info 1 *default-log-port* "File " (conc  *toppath* "/megatest.db") " already exists. Please remove it before trying to replicate db")
               (exit 1)))
         (if (and (common:make-tmpdir-name *toppath* "") (> (length (directory   (common:make-tmpdir-name *toppath* "") #f)) 0))
           (begin
           (debug:print-info 1 *default-log-port* (common:make-tmpdir-name *toppath* "") " not empty. Please remove it before trying to replicate db")
           (exit 1)))    
          ;; check if timestamp 
          (let* ((source (args:get-arg "-source"))
                (src     (if (not (equal? (substring source 0 1) "/"))
                             (conc (current-directory) "/" source)
                             source))
                (ts (if (args:get-arg "-time-stamp")   (args:get-arg "-time-stamp") "latest")))

    (begin
      (if (not (launch:setup))
	  (begin
	    (debug:print 0 *default-log-port* "Failed to setup, exiting") 
	    (exit 1)))
      ;; keep this one local
      ;; (open-run-close patch-db #f)
      (let ((dbstructs (db:setup)))
        (common:cleanup-db dbstructs full: #t))
      (set! *didsomething* #t)))

(if (args:get-arg "-cleanup-db")
    (begin
      (if (not (launch:setup))
	  (begin
	    (debug:print 0 *default-log-port* "Failed to setup, exiting") 
	    (exit 1)))

;;      (if (not (server:choose-server *toppath* 'home?))
;;	  (begin
;;	    (debug:print 0 *default-log-port* "Servers are not running on this host or no servers alive. Cannot run cleanup-db")
;;	    (exit 1)))

      (let ((dbstructs (db:setup)))
        (common:cleanup-db dbstructs))
      (set! *didsomething* #t)))

(if (args:get-arg "-mark-incompletes")
    (begin
      (if (not (launch:setup))
	  (begin

	(args:get-arg "-repl")
	(args:get-arg "-load"))
    (let* ((toppath (launch:setup))
	   (dbstructs (if (and toppath
			       ;; NOTE: server:choose-server is starting a server
			       ;;   either add equivalent for tcp mode or ????
                               #;(server:choose-server toppath 'home?))
                          (db:setup)
                          #f))) ;; make-dbr:dbstruct path: toppath local: (args:get-arg "-local")) #f)))
      (if *toppath*
	  (cond
	   ((getenv "MT_RUNSCRIPT")
	    ;; How to run megatest scripts
	    ;;
	    ;; #!/bin/bash

;; ;; ;; redo me        (list "uname" "rundir" "final_logf" "comment"))
;; ;; ;; redo me       (set! *didsomething* #t)))

(if (args:get-arg "-import-megatest.db")
    (begin
      (launch:setup)
      (db:multi-db-sync 
       (db:setup)
       'killservers
       'dejunk
       'adj-testids
       'old2new
       )
      (set! *didsomething* #t)))

(if (args:get-arg "-import-sexpr")
 (let*(
   (toppath (launch:setup))
   (tmppath (common:make-tmpdir-name toppath "")))
   (if (file-exists? (conc toppath "/.mtdb")) 
     (if (args:get-arg "-remove-dbs")
       (let* ((dbfiles (conc toppath "/.mtdb/* " tmppath "/*")))
        (debug:print 0 *default-log-port* "Removing db files: " dbfiles)
        (system (conc "rm -rvf " dbfiles))
       )
       (begin
         (debug:print 0 *default-log-port* "ERROR: Cannot import sexpr with an existing DB present.")
         (debug:print 0 *default-log-port* "Add '-remove-dbs all'  to remove the current Megatest DBs.")
         (set! *didsomething* #t)
         (exit)
       )
     )
     (debug:print 0 *default-log-port* "Did not find " (conc toppath "/.mtdb"))
   )
   (db:setup)
   (rmt:import-sexpr (args:get-arg "-import-sexpr"))
   (set! *didsomething* #t)))

(if (args:get-arg "-sync-to-megatest.db")
    (let* ((duh      (launch:setup))
	   (dbstruct (db:setup))
	   (tmpdbpth (dbr:dbstruct-tmppath dbstruct))
	   (lockfile (conc tmpdbpth ".lock"))
	   (locked   (common:simple-file-lock lockfile)) 
	   (res      (if locked
			 (db:multi-db-sync 
			  dbstruct
			  'new2old)
			 #f)))
      (if res
	  (begin
	    (common:simple-file-release-lock lockfile)
	    (debug:print 0 *default-log-port* "Synced " res " records to megatest.db"))
	  (debug:print 0 *default-log-port* "Skipping sync, there is a sync in progress."))
      (set! *didsomething* #t)))

(if (args:get-arg "-sync-to")
    (let ((toppath (launch:setup)))
      (tasks:sync-to-postgres *configdat* (args:get-arg "-sync-to"))
      (set! *didsomething* #t)))


;; use with -from and -to
;;
(if (args:get-arg "-db2db")
    (let* ((duh         (launch:setup))
	   (src-db      (args:get-arg "-from"))
	   (dest-db     (args:get-arg "-to"))
	   ;; (sync-period (args:get-arg-number "-period"))
	   ;; (sync-timeout (args:get-arg-number "-timeout"))
	   (sync-period-in  (args:get-arg "-period"))
	   (sync-timeout-in (args:get-arg "-timeout"))
	   (sync-period     (if sync-period-in (string->number sync-period-in) #f))
	   (sync-timeout    (if sync-timeout-in (string->number sync-timeout-in) #f))
	   (lockfile    (conc dest-db".sync-lock"))
	   (keys        (db:get-keys #f))
	   (thesync     (lambda (last-update)
			  (debug:print-info 0 *default-log-port* "Attempting to sync data from "src-db" to "dest-db"...")
			  (debug:print-info 0 *default-log-port* "PID = " (current-process-id))
			  (if (not (file-exists? dest-db))
			      (begin
				(debug:print 0 *default-log-port* "Using copy to create "dest-db" from "src-db)
				(file-copy src-db dest-db)
				1)
			      (let ((res (dbmod:db-to-db-sync src-db dest-db last-update (dbfile:db-init-proc) keys)))
				(if res
				    (debug:print-info 2 *default-log-port* "Synced " res " records from "src-db" to "dest-db)
				    (debug:print-info 0 *default-log-port* "No sync due to permissions or other issue."))
				res))))
	   (start-time  (current-seconds))
           (synclock-mod-time (if (file-exists? lockfile)
             (handle-exceptions
		 exn
	       #f
	       (file-modification-time synclock-file))
	     #f))
            (age (if synclock-mod-time (- (current-seconds) synclock-mod-time) 1000))
           )
      (if (and src-db dest-db)
	  (if (file-exists? src-db)
	      (if (and (file-exists? lockfile) (< age 20))
		    (debug:print 0 *default-log-port* "Lock "lockfile" exists, skipping sync...")
                 (begin
                  (if (file-exists? lockfile)
                    (begin
                    (debug:print 0 *default-log-port* "Deleting old lock file " lockfile)
                    (delete-file lockfile)
                    )
                  )
		  (dbfile:with-simple-file-lock
		   lockfile
		   (lambda ()
		     (let loop ((last-changed (current-seconds))
				(last-update  0))
		       (let* ((changes (handle-exceptions
					   exn
					   (begin
					     (debug:print 0 *default-log-port* "Exception in sync: "(condition->list exn))
					     (delete-file lockfile)
					     (exit))
					 (thesync last-update)))
			      (now-time (current-seconds)))
			 (if (and sync-period sync-timeout) ;; 
			     (if (and (< (- now-time start-time) 600) ;; hard limit on how long we run for
				      (>  sync-timeout (- now-time last-changed)))
				 (begin
				   (if sync-period (thread-sleep! sync-period))
				   (loop (if (> changes 0) now-time last-changed) now-time))))))))
                        (debug:print 0 *default-log-port* "Releasing lock file " lockfile)
                   )
               )
	      (debug:print 0 *default-log-port* "No sync due to unreadble or non-existant source file"src-db))
	  (debug:print 0 *default-log-port* "Usage for -db2db; -to and -from must be specified"))
      (set! *didsomething* #t)))

(if (args:get-arg "-list-test-time")
     (let* ((toppath (launch:setup)))