Megatest

     readline apropos json directory-utils typed-records
     srfi-18 extras format (prefix pkts pkts:))

(declare (uses common))
(declare (uses megatest-version))
(declare (uses margs))
(declare (uses server))
(declare (uses rmt))

;; (declare (uses daemon))

(declare (uses db))
(import db)

(declare (uses portlogger))
(import portlogger)

Usage: mtserver [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
  -server main|passive    : start the server in \"main\" mode or \"passive\" mode

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

			"-log"
			)
 		 (list  "-h" "-help" "--help"
			"-manual"
			"-version"
		        "-list-servers"
			"-kill-servers"
			"-repl"
                        "-v" ;; verbose 2, more than normal (normal is 1)
			"-q" ;; quiet 0, errors/warnings only

                        "-diff-rep"
                        )
		 args:arg-hash
		 0))

        (let ((fullpath (common:real-path (args:get-arg "-start-dir"))))
          (setenv "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))))






;; The watchdog is to keep an eye on things like db sync etc.
;;


(define *watchdog* (make-thread
		    (lambda ()
		      (handle-exceptions
			  exn
			  (begin
			    (print-call-chain)
			    (print " message: " ((condition-property-accessor 'exn 'message) exn)))
			(common:watchdog)))
		    "Watchdog thread"))

;;======================================================================
;; Strive for clean exit handling
;;======================================================================

(define (server-exit-procedure)
  (on-exit (lambda ()
	     ;; close the databases, ensure the pkt is removed!
	     
	     (server:shutdown)
	     0)))

;; Copied from the SDL2 examples.
;;
;; Schedule quit! to be automatically called when your program exits normally.
(on-exit server-exit-procedure)

;; Install a custom exception handler that will call quit! and then
;; call the original exception handler. This ensures that quit! will
;; be called even if an unhandled exception reaches the top level.
(current-exception-handler
 (let ((original-handler (current-exception-handler)))
   (lambda (exception)
     (server-exit-procedure)
     (original-handler exception))))

;;(if (not (args:get-arg "-server"))
;;    (thread-start! *watchdog*)) ;; if starting a server; wait till we get to running state before kicking off watchdog
#;(let* ((no-watchdog-args
       '("-list-runs"
         "-testdata-csv"
         "-list-servers"
         "-server"
         "-list-disks"
         "-list-targets"
         "-show-runconfig"

        (define *didsomething* #t)  
        (exit 1))))

;; this segment will run launch:setup only if -log is not set. This is fairly safe as servers are not
;; manually started and thus should never be started in a non-megatest area. Thus no need to handle situation
;; where (launch:setup) returns #f?
;;
#;(if (or (args:get-arg "-log")(args:get-arg "-server")) ;; redirect the log always when a server
    (handle-exceptions
	exn
	(begin
	  (print "ERROR: Failed to switch to log output. " ((condition-property-accessor 'exn 'message) exn))
	  )
      (let* ((tl   (or (args:get-arg "-log")(launch:setup)))   ;; run launch:setup if -server, ensure we do NOT run launch:setup if -log specified
	     (logf (or (args:get-arg "-log") ;; use -log unless we are a server, then craft a logfile name

(if (args:get-arg "-version")
    (begin
      (print (common:version-signature)) ;; (print megatest-version)
      (exit)))

(define *didsomething* #f)

;; ready? start the server
;;
(if (args:get-arg "-server")
    (let ((mode (string->symbol (args:get-arg "-server"))))
      (if (not (server:launch mode)) ;; opens the port, drops the pkt, contacts other servers and then waits for messages
	  (exit 1))))

(if (args:get-arg "-repl")
    (begin
      ;; user will have to start the server manually
      (print "Run: (server:start-nmsg 'main) to start the server")
      (import extras) ;; might not be needed
      ;; (import csi)
      (import readline)
      (import apropos)
      (import portlogger)
      ;; (import (prefix sqlite3 sqlite3:)) ;; doesn't work ...
      
      (install-history-file (get-environment-variable "HOME") ".megatest_history") ;;  [homedir] [filename] [nlines])
      (current-input-port (make-readline-port "megatest> "))
      (repl)
      (set! *didsomething* #t)))