Megatest

    (else   (rpc:client-connect  iface port))))

(define (client:setup areapath #!key (remaining-tries 100) (failed-connects 0))
  (case (server:get-transport)
    ((rpc) (rpc-transport:client-setup remaining-tries: remaining-tries failed-connects: failed-connects)) ;;(client:setup-rpc run-id))
    ((http)(client:setup-http *runremote* areapath remaining-tries: remaining-tries failed-connects: failed-connects))
    (else  (rpc-transport:client-setup remaining-tries: remaining-tries failed-connects: failed-connects)))) ;; (client:setup-rpc run-id))))

(set-fn 'client:setup client:setup)


;; Do all the connection work, look up the transport type and set up the
;; connection if required.
;;
;; There are two scenarios. 
;;   1. We are a test manager and we received *transport-type* and *runremote* via cmdline
;;   2. We are a run tests, list runs or other interactive process and we must figure out

(declare (uses rmtmod))

(import rmtmod)
(set-fn 'server:expiration-timeout server:expiration-timeout)
(set-fn 'common:get-homehost       common:get-homehost)
(set-fn 'server:check-if-running   server:check-if-running)
(set-fn 'api:execute-requests      api:execute-requests)
(set-fn 'http-transport:close-connections  http-transport:close-connections )
(set-fn 'http-transport:client-api-send-receive http-transport:client-api-send-receive)
(set-fn 'server:kind-run  server:kind-run)
(set-fn 'server:start-and-wait server:start-and-wait)
(set-fn 'server:check-if-running server:check-if-running)
(set-fn 'server:ping server:ping )
(set-fn 'common:force-server? common:force-server? )

;;
;; THESE ARE ALL CALLED ON THE CLIENT SIDE!!!
;;

;; generate entries for ~/.megatestrc with the following
;;

(define (rmt:test-set-archive-block-id run-id test-id archive-block-id)
  (rmt:send-receive 'test-set-archive-block-id run-id (list run-id test-id archive-block-id)))

(define (rmt:test-get-archive-block-info archive-block-id)
  (rmt:send-receive 'test-get-archive-block-info #f (list archive-block-id)))

(set-functions http-transport:client-api-send-receive  ;; a
#;(set-functions http-transport:client-api-send-receive  ;; a
	       http-transport:close-connections	       ;; b
	       api:execute-requests                    ;; c
	       #f
	       client:setup                            ;; e
	       server:kind-run                         ;; f
	       server:start-and-wait                   ;; g
	       server:check-if-running                 ;; h
	       server:ping                             ;; i
	       common:force-server?                    ;; j
	       )

(import commonmod)
(use (prefix ulex ulex:))

(include "common_records.scm")

;; Hack to make these functions visible to the refactored code, goal is to eliminate these over time.
;; (define (rmt:send-receive . params) #f)
(define (http-transport:close-connections . params) #f)
;; from remote defstruct in common.scm
;; (define (api:execute-requests . params) #f)
(define (http-transport:client-api-send-receive . params) #f)
(define (client:setup . params) #f)
(define (server:kind-run . params) #f)
(define (server:start-and-wait . params) #f)
(define (server:check-if-running . params) #f)
(define (server:ping . params) #f)
(define (common:force-server? . params) #f)
;; (define (http-transport:close-connections . params) #f)
;; ;; from remote defstruct in common.scm
;; ;; (define (api:execute-requests . params) #f)
;; (define (http-transport:client-api-send-receive . params) #f)
;; (define (client:setup . params) #f)
;; (define (server:kind-run . params) #f)
;; (define (server:start-and-wait . params) #f)
;; (define (server:check-if-running . params) #f)
;; (define (server:ping . params) #f)
;; (define (common:force-server? . params) #f)
;; 'send-receive rmt:send-receive ...
(define (set-functions . alldata)
#;(define (set-functions . alldata)
  (match
   alldata
   ((a b c d e f g h i j) ;; e f g h i j k l)
    (set! http-transport:client-api-send-receive a)
    (set! http-transport:close-connections       b)
    ;; (set! api:execute-requests                   c)
    ;; d

  (debug:print 0 log-port "WARNING: write transaction requested on a readonly area.  cmd="cmd" params="params)
  #f)

(define (extras-transport-failed log-port rmt-mutex attemptnum runremote areapath cmd rid params alldat)
  (debug:print 0 log-port "WARNING: communication failed. Trying again, try num: " attemptnum)
  ;;(mutex-lock! rmt-mutex)
  (remote-conndat-set!    runremote #f)
  (http-transport:close-connections area-dat: runremote)
  (exec-fn 'http-transport:close-connections area-dat: runremote)
  (remote-server-url-set! runremote #f)
  ;;(mutex-unlock! rmt-mutex)
  (debug:print-info 12 log-port "rmt:send-receive, case  9.1")
  (rmt:send-receive-orig log-port runremote rmt-mutex areapath cmd rid params alldat attemptnum: (+ attemptnum 1)))
  
(define (extras-transport-succeded log-port rmt-mutex attemptnum runremote areapath res params rid cmd alldat)
  (if (and (vector? res)

						 ;; server is
						 ;; overloaded and we
						 ;; want to ease off
						 ;; the queries
      (let ((wait-delay (+ attemptnum (* attemptnum 10))))
	(debug:print 0 log-port "WARNING: server is overloaded. Delaying " wait-delay " seconds and trying call again.")
	;;(mutex-lock! rmt-mutex)
	(http-transport:close-connections area-dat: runremote)
	(exec-fn 'http-transport:close-connections area-dat: runremote)
	;; (set! *runremote* #f) ;; force starting over
	(remote-server-url-set! runremote #f) ;; I am hoping this will force a redo on server connection. NOT TESTED
	;;(mutex-unlock! rmt-mutex)
	(thread-sleep! wait-delay)
	(rmt:send-receive-orig log-port runremote rmt-mutex areapath cmd rid params alldat attemptnum: (+ attemptnum 1)))
      res)) ;; All good, return res

     ;; reset the connection if it has been unused too long
     ((and runremote
           (remote-conndat runremote)
	   (> (current-seconds) ;; if it has been more than server-timeout seconds since last contact, close this connection and start a new on
	      (+ (http-transport:server-dat-get-last-access (remote-conndat runremote))
		 (remote-server-timeout runremote))))
      (debug:print-info 0 log-port "Connection to " (remote-server-url runremote) " expired due to no accesses, forcing new connection.")
      (http-transport:close-connections area-dat: runremote)
      (exec-fn 'http-transport:close-connections area-dat: runremote)
      (remote-conndat-set! runremote #f) ;; invalidate the connection, thus forcing a new connection.
      ;; (mutex-unlock! rmt-mutex)
      (rmt:send-receive-orig log-port runremote rmt-mutex toppath multi-sync-mutex cmd rid params alldat attemptnum: attemptnum))
     

     ;; on homehost and this is a read
     ((and (not (remote-force-server runremote)) ;; honor forced use of server, i.e. server NOT required
	   (pair? (remote-hh-dat runremote))
	   (cdr (remote-hh-dat runremote))       ;; on homehost
           (member cmd api:read-only-queries))   ;; this is a read
      ;; (mutex-unlock! rmt-mutex)
      (debug:print-info 12 log-port "rmt:send-receive, case  5")
      (rmt:open-qry-close-locally log-port multi-sync-mutex cmd 0 params alldat))

     ;; on homehost and this is a write, we already have a server, but server has died
     ((and (cdr (remote-hh-dat runremote))           ;; on homehost
           (not (member cmd api:read-only-queries))  ;; this is a write
           (remote-server-url runremote)             ;; have a server
           (not (server:ping (remote-server-url runremote))))  ;; server has died. NOTE: this is not a cheap call! Need better approach.
           (not (exec-fn 'server:ping (remote-server-url runremote))))  ;; server has died. NOTE: this is not a cheap call! Need better approach.
      ;; (set! *runremote* (make-remote)) ;; WARNING - broken this.
      (remote-force-server-set! runremote (common:force-server?))
      (remote-force-server-set! runremote (exec-fn 'common:force-server?))
      ;; (mutex-unlock! rmt-mutex)
      (debug:print-info 12 log-port "rmt:send-receive, case  6")
      (rmt:send-receive-orig log-port runremote rmt-mutex toppath  multi-sync-mutex cmd rid params alldat attemptnum: attemptnum))

     ;; on homehost and this is a write, we already have a server
     ((and (not (remote-force-server runremote))     ;; honor forced use of server, i.e. server NOT required
	   (cdr (remote-hh-dat runremote))           ;; on homehost
           (not (member cmd api:read-only-queries))  ;; this is a write
           (remote-server-url runremote))            ;; have a server
      ;;(mutex-unlock! rmt-mutex)
      (debug:print-info 12 log-port "rmt:send-receive, case  4.1")
      (rmt:open-qry-close-locally  log-port multi-sync-mutex cmd 0 params alldat))

     ;;  on homehost, no server contact made and this is a write, passively start a server 
     ((and (not (remote-force-server runremote))     ;; honor forced use of server, i.e. server NOT required
	   (cdr (remote-hh-dat runremote))           ;; have homehost
           (not (remote-server-url runremote))       ;; no connection yet
	   (not (member cmd api:read-only-queries))) ;; not a read-only query
      (debug:print-info 12 log-port "rmt:send-receive, case  8")
      (let ((server-url  (server:check-if-running toppath))) ;; (server:read-dotserver->url toppath))) ;; (server:check-if-running toppath))) ;; Do NOT want to run server:check-if-running - very expensive to do for every write call
      (let ((server-url  (exec-fn 'server:check-if-running toppath))) ;; (server:read-dotserver->url toppath))) ;; (server:check-if-running toppath))) ;; Do NOT want to run server:check-if-running - very expensive to do for every write call
	(if server-url
	    (remote-server-url-set! runremote server-url) ;; the string can be consumed by the client setup if needed
	    (if (common:force-server?)
		(server:start-and-wait toppath)
		(server:kind-run toppath))))
      (remote-force-server-set! runremote (common:force-server?))
	    (if (exec-fn 'common:force-server?)
		(exec-fn 'server:start-and-wait toppath)
		(exec-fn 'server:kind-run toppath))))
      (remote-force-server-set! runremote (exec-fn 'common:force-server?))
      ;; (mutex-unlock! rmt-mutex)
      (debug:print-info 12 log-port "rmt:send-receive, case  8.1")
      (rmt:open-qry-close-locally  log-port multi-sync-mutex cmd 0 params alldat))

     ((or (and (remote-force-server runremote)              ;; we are forcing a server and don't yet have a connection to one
	       (not (remote-conndat runremote)))
	  (and (not (cdr (remote-hh-dat runremote)))        ;; not on a homehost 
	       (not (remote-conndat runremote))))           ;; and no connection
      (debug:print-info 12 log-port "rmt:send-receive, case 9, hh-dat: " (remote-hh-dat runremote) " conndat: " (remote-conndat runremote))
      ;;(mutex-unlock! rmt-mutex)
      (if (not (server:check-if-running toppath)) ;; who knows, maybe one has started up?
	  (server:start-and-wait toppath))
      (if (not (exec-fn 'server:check-if-running toppath)) ;; who knows, maybe one has started up?
	  (exec-fn 'server:start-and-wait toppath))
      (remote-conndat-set! runremote (rmt:get-connection-info runremote toppath)) ;; calls client:setup which calls client:setup-http
      (rmt:send-receive-orig log-port runremote rmt-mutex toppath multi-sync-mutex cmd rid params alldat attemptnum: attemptnum)) ;; TODO: add back-off timeout as

     ;; all set up if get this far, dispatch the query
     ((and (not (remote-force-server runremote))
	   (cdr (remote-hh-dat runremote))) ;; we are on homehost
      ;;(mutex-unlock! rmt-mutex)

					     ;; caused a lot of
					     ;; problems. However it
					     ;; is needed to deal with
					     ;; attemtped
					     ;; communication to
					     ;; servers that have gone
					     ;; away
			      (http-transport:client-api-send-receive 0 conninfo cmd params)
			      (exec-fn 'http-transport:client-api-send-receive 0 conninfo cmd params)
			      ((commfail)(vector #f "communications fail"))
			      ((exn)(vector #f "other fail" (print-call-chain)))))
		     (else
		      (debug:print 0 log-port "ERROR: transport " (remote-transport runremote) " not supported")
		      (exit))))
	 (success  (if (vector? dat) (vector-ref dat 0) #f))
	 (res      (if (vector? dat) (vector-ref dat 1) #f)))
    (if (and (vector? conninfo) (< 5 (vector-length conninfo)))
	(http-transport:server-dat-update-last-access conninfo) ;; refresh access time
	(begin
	  (debug:print 0 log-port "INFO: Should not get here! conninfo=" conninfo)
	  (set! conninfo #f)
	  (remote-conndat-set! runremote #f) ;; NOTE: *runremote* is global copy of runremote. Purpose: factor out global.
	  (http-transport:close-connections  area-dat: runremote)))
	  (exec-fn 'http-transport:close-connections  area-dat: runremote)))
    (debug:print-info 13 log-port "rmt:send-receive, case  9. conninfo=" conninfo " dat=" dat " runremote = " runremote)
    ;; (mutex-unlock! rmt-mutex)
    (if success ;; success only tells us that the transport was
	;; successful, have to examine the data to see if
	;; there was a detected issue at the other end
	(extras-transport-succeded log-port rmt-mutex attemptnum runremote areapath res params rid cmd alldat)
	(extras-transport-failed log-port rmt-mutex attemptnum runremote areapath cmd rid params alldat)
	)))

;; if a server is either running or in the process of starting call client:setup
;; else return #f to let the calling proc know that there is no server available
;;
(define (rmt:get-connection-info runremote areapath #!key (area-dat #f)) ;; TODO: push areapath down.
  (let* (;; (runremote (or area-dat runremote))
	 (cinfo     (if (remote? runremote)
			(remote-conndat runremote)
			#f)))
	  (if cinfo
	      cinfo
	      (if (server:check-if-running areapath)
		  (client:setup runremote areapath)
	      (if (exec-fn 'server:check-if-running areapath)
		  (exec-fn 'client:setup runremote areapath)
		  #f))))



;;======================================================================
;; ulex and steps stuff
;;======================================================================

;; let's start up a server the mechanical way
(system "nbfake megatest -server -")
(thread-sleep! 2)
;; (test #f #t (string? (server:start-and-wait *toppath*)))

(test "setup for run" #t (begin (launch:setup)
 				(string? (getenv "MT_RUN_AREA_HOME"))))
(test #f #t (client:setup-http toppath))
(test #f #t (client:setup-http *runremote* toppath))
(test #f #t (vector? (client:setup toppath)))

(test #f #t (vector? (rmt:get-connection-info toppath))) ;; TODO: push areapath down.
(test #f #t (string? (server:check-if-running ".")))
;; DEF (test #f #f (rmt:send-receive-no-auto-client-setup *runremote* 'get-keys #f '()))
;; DEF (rmt:kill-server run-id)
;; DEF (rmt:start-server run-id)