Megatest

;; stored (for now) in *db-serv-info*
;;
(defstruct servdat
  (host #f)
  (port #f)
  (uuid #f)
  (dbfile #f)
  (uconn   #f) ;; this is the listener for this process
  (mode    #f)
  (status 'starting)
  (trynum 0) ;; count the number of ports we've tried
  (conns  (make-hash-table)) ;; apath/dbname => conndat
  ) 

(define *db-serv-info* #f)

(define (servdat->url sdat)
  (conc (servdat-host sdat)":"(servdat-port sdat)))

;; db servers contact info
;;
(defstruct conndat

;;
(define (rmt:open-main-connection remdat apath)
  (let* ((fullpath (db:dbname->path apath ".db/main.db"))
	 (conns    (servdat-conns remdat))
	 (conn     (rmt:get-conn remdat apath ".db/main.db")) ;; (hash-table-ref/default conns fullpath #f)) ;; TODO - create call for this
	 (myconn   (servdat-uconn remdat)))
    (cond
     ((not myconn)
      (servdat-uconn-set! remdat (make-udat))
      (rmt:open-main-connection remdat apath))
     ((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)))

;; Defaults to current area
;;
(define (rmt:send-receive cmd rid params #!key (attemptnum 1)(area-dat #f))
  (let* ((apath      *toppath*)
	 (sinfo      *db-serv-info*)
	 (dbname     (db:run-id->dbname rid)))
    (if (not *db-serv-info*)
	(begin
	  (set! *db-serv-info* (make-servdat))
	  (set! sinfo *db-serv-info*)))
    (rmt:open-main-connection sinfo apath)
    (if rid (rmt:general-open-connection sinfo apath dbname))
    ;; (if (not (member cmd '(log-to-main)))
    ;;     (debug:print-info 0 *default-log-port* "rmt:send-receive "cmd" params="params))
    (let* ((cdat (rmt:get-conn sinfo apath dbname)))
      (assert cdat "FATAL: rmt:send-receive-real called without the needed channels opened")
      (let* ((uconn    (servdat-uconn sinfo)) ;; get the interface to ulex

	
(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 (eq? res 'ping-ack) ;; yep, likely it is who we want on the other end
	res
	#f)))
;; (begin (debug:print-info 0 *default-log-port* "server-ready? => "res) #f))))

; 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

				   (if (string>=? best-z candidate-z)
				       best
				       candidate))))) ;; use Z card as tie breaker
	      (if (null? tail)
		  new-best
		  (loop (cdr tail) new-best)))))))
	  

;;======================================================================
;; END NEW SERVER METHOD
;;======================================================================

;; sdat must be defined and the host and port set and the same as previous
;;
(define (host-port-is-stable? sdat old-host old-port)
  (and sdat
       (let ((new-host (servdat-host sdat))
	     (new-port (servdat-port sdat)))
	 (and new-host
	      new-port
	      (equal? new-host old-host)
	      (equal? new-port old-port)))))

;; if .db/main.db check the pkts
;; 
(define (rmt:wait-for-server pkts-dir db-file server-key)
  (let* ((sdat *db-serv-info*))
    (let loop ((start-time (current-milliseconds))
	       (changed    #t)
	       (last-sdat  "not this")
	       (last-host  #f)
	       (last-port  #f))
      (begin ;; let ((sdat #f))
	(thread-sleep! 0.01)
	(debug:print-info 0 *default-log-port* "Waiting for server alive signature")
	(mutex-lock! *heartbeat-mutex*)
	(set! sdat *db-serv-info*)
	(mutex-unlock! *heartbeat-mutex*)
	(if (and sdat
		 (not changed)
		 (>= (- (current-milliseconds) start-time) 100))
	    (let* ((uconn (servdat-uconn sdat)))
	      (servdat-status-set! sdat 'iface-stable)
	      (debug:print-info 0 *default-log-port* "Received server alive signature, now attempting to lock in server")
	      ;; create a server pkt in *toppath*/.meta/srvpkts
	      
	      ;; TODO:
	      ;;   1. change sdat to stuct

		      (delete-pkt)
		      (thread-sleep! 0.2)
		      (exit)))
		sdat))
	    (begin ;; sdat not yet contains server info
	      (debug:print-info 0 *default-log-port* "Still waiting, last-sdat=" last-sdat)
	      (thread-sleep! 0.1)
	      (if (> (- (current-milliseconds) start-time) 120000) ;; been waiting for two minutes
		  (begin
		    (debug:print-error 0 *default-log-port* "transport appears to have died, exiting server")
		    (exit))
		  (loop start-time
			(not (host-port-is-stable? sdat last-host last-port))
			sdat
			(servdat-host sdat)

;; udat struct, used by both caller and callee
;; instantiated as uconn by convention
;;
(defstruct udat
  ;; the listener side
  (port #f)
  (host-port #f) ;; my host:port
  (socket #f)
  ;; the peers
  (peers  (make-hash-table)) ;; host:port->peer
  ;; work handling
  (work-queue (make-mailbox))
  (work-proc  #f)                ;; set by user
  (cnum       0)                 ;; cookie number

;;
(define (do-work uconn rdat)
  (let* () ;; get it each time - conceivebly it could change
    ;; put this following into a do-work procedure
    (match rdat
      ((rem-host-port qrykey cmd params)
       (case cmd
	 ((ping) 'ping-ack) ;; bypass calling the proc
	 (else
	  (let* ((proc       (udat-work-proc uconn))
		 (start-time (current-milliseconds))
		 (result     (proc rem-host-port qrykey cmd params))
		 (end-time   (current-milliseconds))
		 (run-time   (- end-time start-time)))
	    result))))
      (else
       (print "ERROR: rdat "rdat", did not match rem-host-port qrykey cmd params")))))

;;======================================================================
;; misc utils
;;======================================================================

(define (pp-uconn uconn)
  (pp (udat->alist uconn)))


;;======================================================================
;; network utilities
;;======================================================================

;; NOTE: Look at address-info egg as alternative to some of this

(define (rate-ip ipaddr)