Megatest

;;
;; TODO: This is unnecessarily re-creating the record in the hash table
;;
(define (rmt:open-main-connection remdat apath)
  (let* ((fullpath (db:dbname->path apath "/.db/main.db"))
	 (conns    (servdat-conns remdat))
	 (conn     (hash-table-ref/default conns fullpath #f)) ;; TODO - create call for this
	 (myconn   (if *db-serv-info*
		       (servdat-uconn *db-serv-info*)
		       (let* ((th1 (make-thread (lambda ()(rmt:run (get-host-name))) "non-db mode server")))
			 (thread-start! th1)

			 (let loop ((count 0))
			   (assert (< count 30) "FATAL: responder failed to initialize in rmt:open-main-connection")
			   (if (not *db-serv-info*)

			       (begin
				 (thread-sleep! 1)
				 (loop (+ count 1)))
			       (begin
				 (servdat-mode-set! *db-serv-info* 'non-db)
				 (servdat-uconn *db-serv-info*))))))))

    (cond



     ((and conn                                             ;; conn is NOT a socket, just saying ...
	   (< (current-seconds) (conndat-expires conn)))
      #t) ;; we are current and good to go - we'll deal elsewhere with a server that was killed or died 
     ((and conn
	   (>= (current-seconds)(conndat-expires conn)))
      (debug:print-info 0 *default-log-port* "connection to "fullpath" server expired. Reconnecting.")
      (hash-table-set! conns fullpath #f) ;; clean up
      (rmt:open-main-connection remdat apath))
     (else
      ;; Below we will find or create and connect to main
      (let* ((dbname         (db:run-id->dbname #f))
	     (the-srv        (rmt:find-main-server myconn apath dbname))
	     (start-main-srv (lambda () ;; call IF there is no the-srv found
			       (mutex-lock! *connstart-mutex*)

;; (define *localmode* #t)
(define *localmode* #f)
(define *dbstruct* (make-dbr:dbstruct))

;; Defaults to current area
;;
(define (rmt:send-receive cmd rid params #!key (attemptnum 1)(area-dat #f))
  ;; (if (not *remotedat*)(set! *remotedat* (make-remotedat)))
  (let* ((apath      *toppath*)
	 (sinfo      *db-serv-info*)
	 (dbname     (db:run-id->dbname rid)))
    (if *localmode*
	(let* ((dbdat    (dbr:dbstruct-get-dbdat *dbstruct* dbname))
	       (indat    `((cmd . ,cmd)(params . ,params))))
	  (api:execute-requests *dbstruct* cmd params)
	  ;; (api:process-request *dbstruct* indat)
	  ;; (api:process-request dbdat indat)
	  )
	(begin
	  (rmt:open-main-connection sinfo apath)
	  (if rid (rmt:general-open-connection sinfo apath dbname))
	  (rmt:send-receive-real sinfo apath dbname 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 sinfo apath dbname cmd params)
  (let* ((cdat (rmt:get-conn sinfo apath dbname)))
    (assert cdat "FATAL: rmt:send-receive-real called without the needed channels opened")
    (let* ((key     #f)
	   #;(payload `(,cmd ;; (cmd    . ,cmd)(key    .
		      ,(conndat-srvkey cdat)
		      ,params))
	   (uconn    (servdat-uconn sinfo))
	   (res      (send-receive uconn (conndat-hostport cdat) cmd params))) ;; payload)))
      (if (member res '("#<unspecified>")) ;; TODO - fix this in string->sexpr
	  #f
	  res))))

;; db is at apath/.db/dbname, rid is an intermediary solution and will be removed
;; sometime in the future.

	
(define (server-ready? uconn host-port key) ;; server-address is host:port
  (let* ((params `((cmd . ping)(key . ,key)))
	 (data `((cmd . ping)
		 (key . ,key)
		 (params . ,params))) ;; I don't get it.
	 (res  (send-receive uconn host-port 'ping data)))
    (if res
	(car res)
	res)))


; from the pkts return servers associated with dbpath
;; NOTE: Only one can be alive - have to check on each
;;       in the list of pkts returned
;;
(define (get-viable-servers serv-pkts dbpath)
  (let loop ((tail serv-pkts)

(import rmtmod trace http-client apimod dbmod
	launchmod srfi-69 ulex system-information)

(trace-call-sites #t)
(trace
 ;; get-the-server
 ;; db:get-dbdat
 rmt:find-main-server
;;  rmt:send-receive-real
;;  rmt:send-receive
 ;; sexpr->string
 server-ready?
 ;; rmt:register-server
 api:run-server-process
 rmt:open-main-connection
 ;; rmt:general-open-connection
 ;; rmt:get-conny
 ;; common:watchdog
 ;; rmt:find-main-server
 ;; get-all-server-pkts
 ;; get-viable-servers
 ;; get-best-candidate

;; switch to *db-serv-info* instead of *servdat*
(define *uconn* (servdat-uconn *db-serv-info*))
(print "*uconn*: " *uconn*)
(test #f #t (ulex-listener? (servdat-uconn *db-serv-info*)))
(test #f #t (string? (udat-host-port *uconn*)))

(run-in-thread
 (test #f #t (server-ready? *uconn* (udat-host-port *uconn*) (servdat-uuid *db-serv-info*))))
  
(test #f #t (rmt:open-main-connection *db-serv-info* *toppath*))
;; (pp (hash-table->alist (remotedat-conns *db-serv-info*)))
(test #f #t (conndat? (rmt:get-conn *db-serv-info* *toppath* ".db/main.db")))
(exit)

(define *main*  (rmt:get-conn *db-serv-info* *toppath* ".db/main.db"))

;; (for-each (lambda (tdat)
;; 	    (test #f tdat (loop-test (rmt:conn-ipaddr *main*)
;; 				     (rmt:conn-port *main*) tdat)))
;; 	  (list 'a
;; 		'(a "b" 123 1.23 )))
(test #f #t (rmt:send-receive 'ping #f 'hello))

(define *db* (db:setup ".db/main.db"))

;; these let me cut and paste from source easily
(define apath *toppath*)
(define dbname ".db/2.db")
(define remote *db-serv-info*)
(define keyvals  '(("SYSTEM" "a")("RELEASE" "b")))


(test #f '() (string->sexpr "()"))
(test #f 'server-started (api:execute-requests *db* 'get-server (list *toppath* ".db/2.db")))
(set! *dbstruct-db* #f)

(exit)

	      (close-output-port oup)
	      res)))))) ;; res will always be 'ack

;; send a request to the given host-port and register a mailbox in udata
;; wait for the mailbox data and return it
;;
(define (send-receive uconn host-port cmd data)




  (let* ((cmbox     (get-cmbox uconn)) ;; would it be better to keep a stack of mboxes to reuse?
	 (qrykey    (car cmbox))
	 (mbox      (cdr cmbox))
	 (mbox-time (current-milliseconds)))
    (if (eq? (send uconn host-port qrykey cmd data) 'ack)
	(let* ((mbox-timeout-secs    120) ;; timeout)


	       (mbox-timeout-result 'MBOX_TIMEOUT)
	       (res                  (mailbox-receive! mbox mbox-timeout-secs mbox-timeout-result))
	       (mbox-receive-time    (current-milliseconds)))

	  (if (eq? res 'MBOX_TIMEOUT)


	      #f  ;; convert to raising exception?
	      res))
	(begin
	  (print "ERROR: Communication failed?")
	  #f)))) ;; #f means failed to communicate

;;======================================================================
;; responder side
;;======================================================================

;; take a request, rdat, and if not immediate put it in the work queue
;;
;; Reserved cmds; ack ping goodbye response
;;
(define (ulex-handler uconn rdat)
  (assert (list? rdat) "FATAL: ulex-handler give rdat as not list")
  (match rdat ;;  (string-split controldat)
    ((rem-host-port qrykey cmd params)
     ;; (print "ulex-handler got: "rem-host-port" qrykey: "qrykey" cmd: "cmd" params: "params)
     (let ((mbox (hash-table-ref/default (udat-mboxes uconn) qrykey #f)))
       (case cmd
	 ;; ((ack )(print "Got ack! But why? Should NOT get here.") 'ack)
	 ((ping)
	  ;; (print "Got Ping!")
	  (add-to-work-queue uconn rdat)
	 'ack)
	 ((goodbye)
	  ;; just clear out references to the caller
	  (add-to-work-queue uconn rdat)
	  'ack)
	 ((response) ;; this is a result from remote processing, send it as mail ...
	  (if mbox