(setenv "MT_TESTSUITENAME" (common:get-testsuite-name)))
(begin
(debug:print-error 0 *default-log-port* "failed to find the top path to your Megatest area.")
(set! *toppath* #f) ;; force it to be false so we return #f
#f))
;; needed by various transport and db modules
(dbfile:testsuite-name (get-testsuite-name *toppath* *configdat*))
(dbfile:testsuite-name (common:get-testsuite-name)) ;; (get-testsuite-name *toppath* *configdat*))
;; one more attempt to cache the configs for future reading
(let* ((cachefiles (launch:get-cache-file-paths areapath toppath target mtconfig))
(mtcachef (car cachefiles))
(rccachef (cdr cachefiles)))
;; trap exception due to stale NFS handle -- Error: (open-output-file) cannot open file - Stale NFS file handle: "...somepath.../.runconfigs.cfg-1.6427-7d1e789cb3f62f9cde719a4865bb51b3c17ea853" - ticket 220546342
;; Start the server - can be done in conjunction with -runall or -runtests (one day...)
;; we start the server if not running else start the client thread
;;======================================================================
;; Server? Start up here.
;;
(if (args:get-arg "-server")
(let* ((run-id (args:get-arg-number "-run-id"))
(tl (launch:setup)))
(let* ((run-id (args:get-arg "-run-id"))
(dbfname (args:get-arg "-db"))
(tl (launch:setup)))
(case (rmt:transport-mode)
((http)(http-transport:launch))
((tcp)
(debug:print 0 *default-log-port* "INFO: Running using tcp method.")
(if run-id
(tt:start-server tl run-id (dbmod:run-id->dbfname run-id) api:dispatch-request)
(tt:start-server tl run-id dbfname api:dispatch-request)
(begin
(debug:print 0 *default-log-port* "ERROR: transport mode is tcp - -run-id is required.")
(exit 1))))
(else (debug:print 0 *default-log-port* "ERROR: rmt:transport-mode value not recognised "(rmt:transport-mode))))
(set! *didsomething* #t)))
;; The adjutant is a bit different, it does NOT run (launch:setup) as it is not necessarily tied to