Megatest

;; do we have a connection to apath dbname and
;; is it not expired? then return it
;;
;; else setup a connection
;;
;; if that fails, return '(#f "some reason") ;; NB// convert to raising an exception
;;
(define (rmt:get-connection remote apath dbname)
(define (rmt:get-conn remote apath dbname)
  (let* ((fullname (db:dbname->path apath dbname)) ;; we'll switch to full name later
	 (conn     (hash-table-ref/default (rmt:remote-conns remote) dbname #f)))
    (if (and conn
	     (< (current-seconds) (rmt:conn-expires conn)))
	conn
	#f)))

				  lastmsg: (current-seconds)
				  expires: (+ (current-seconds) 60) ;; this needs to be gathered during the ping
				  ))
		#t)
	      (start-main-srv)))
	(start-main-srv))))

(define (rmt:main-open-connection remote apath)
  (rmt:open-main-connection remote apath)
  (rmt:get-connection remote apath (db:run-id->dbname #f)))

;; NB// remote is a rmt:remote struct
;;
(define (rmt:general-open-connection remote apath dbname #!key (num-tries 5))
  (cond
  (let  ((mainconn (rmt:get-connection remote apath (db:run-id->dbname #f))))
   ((not (rmt:get-conn remote apath (db:run-id->dbname #f))) ;; no channel open to main? 
    ;; (debug:print 0 *default-log-port* "remote: " remote)
    (if (not mainconn)
	(begin
	  (rmt:open-main-connection remote apath)
	  (thread-sleep! 2)
	  (rmt:general-open-connection remote apath dbname))
    (rmt:open-main-connection remote apath)
    (thread-sleep! 2)
    (rmt:general-open-connection remote apath dbname))
	;; we have a connection to main, ask for contact info for dbname
	(let* ((res (rmt:send-receive-real remote apath dbname 'get-server #f `(,apath ,dbname))))
	  (case res
	    ((server-started)
	     (if (> num-tries 0)
		 (begin
		   (thread-sleep! 2)
		   (rmt:general-open-connection remote apath dbname
						num-tries: (- num-tries 1)))
		 'failed))
	    
	    (else
	     (debug:print-info 0 *default-log-port* "Unexpected result: " res)
	     res))))))
   ((not (rmt:get-conn remote apath dbname))                 ;; no channel open to dbname?     
    (let* ((res (rmt:send-receive-real remote apath dbname #f 'get-server `(,apath ,dbname))))
      (case res
	((server-started)
	 (if (> num-tries 0)
	     (begin
	       (thread-sleep! 2)
	       (rmt:general-open-connection remote apath dbname
					      num-tries: (- num-tries 1)))
	     (begin
	       (debug:print-error 0 *default-log-port* "Failed to start servers needed or open channel to "apath", "dbname)
	       (exit 1))))
	(else
	 (debug:print-info 0 *default-log-port* "Unexpected result: " res)
	 res))))))

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

;; Defaults to current area
;;
(define (rmt:send-receive cmd rid params #!key (attemptnum 1)(area-dat #f))
  (if (not *rmt:remote*)(set! *rmt:remote* (make-rmt:remote)))
  (let* ((apath *toppath*)
	 (conns *rmt:remote*)
	 (dbname (db:run-id->dbname rid)))
    (rmt:general-open-connection conns apath dbname)
    (rmt:send-receive-real conns apath dbname rid cmd params)))

;; db is at apath/.db/dbname, rid is an intermediary solution and will be removed
;; sometime in the future
;;
(define (rmt:send-receive-real remote apath dbname rid cmd params)
  (let* ((conn (rmt:get-connection remote apath dbname)))
    (if conn
  (let* ((conn (rmt:get-conn remote apath dbname)))
    (assert conn "FATAL: rmt:send-receive-real called without the needed channels opened")
	(let* (;; (host    (rmt:conn-ipaddr conn))
	       ;; (port    (rmt:conn-port   conn))
	       (payload (sexpr->string params))
	       (res      (with-input-from-request
			  (rmt:conn->uri conn "api")
			  `((params . ,payload)
			    (cmd    . ,cmd)
			    (key    . "nokey"))
			  read-string)))
	  (if (string? res)
	      (string->sexpr res)
	      res))
    (let* ((payload (sexpr->string params))
	   (res      (with-input-from-request
		      (rmt:conn->uri conn "api")
		      `((params . ,payload)
			(cmd    . ,cmd)
			(key    . "nokey"))
		      read-string)))
      (if (string? res)
	  (string->sexpr res)
	  res))))
	;; no conn yet, start it up
	(begin
	  (rmt:general-open-connection remote apath dbname)
	  (rmt:send-receive-real remote apath dbname rid cmd params)))))

;; db is at apath/.db/dbname, rid is an intermediary solution and will be removed
;; sometime in the future.
;;
;; Purpose - call the main.db server and request a server be started
;; for the given area path and dbname
;;
(define (rmt:send-receive-server-start remote apath dbname)
  (let* ((conn (rmt:get-connection remote apath dbname)))
  (let* ((conn (rmt:get-conn remote apath dbname)))
    (assert conn "FATAL: Unable to connect to db "apath"/"dbname)
    (let* (;; (host    (rmt:conn-ipaddr conn))
	   ;; (port    (rmt:conn-port   conn))
	   ;; (payload (sexpr->string params))
	   (res      (with-input-from-request
		      (rmt:conn->uri conn "api") ;; (conc "http://"host":"port"/api")
		      `((params . (,apath ,dbname))
    (let* ((res      (with-input-from-request
		      (rmt:conn->uri conn "api") 
		      `((params . (,apath ,dbname)))
			;; (cmd    . ,cmd)
			#;(key    . "nokey"))
		      read-string)))
      (string->sexpr res))))

(define (rmt:print-db-stats)
  (let ((fmtstr "~40a~7-d~9-d~20,2-f")) ;; "~20,2-f"
    (debug:print 18 *default-log-port* "DB Stats\n========")
    (debug:print 18 *default-log-port* (format #f "~40a~8a~10a~10a" "Cmd" "Count" "TotTime" "Avg"))