Megatest

;;                    db:*
;;
;; NB// Runs on the server as part of the server loop
;;
(define (api:process-request dbstruct indat) ;; the $ is the request vars proc
  (let* ((cmd-in  (alist-ref 'cmd indat)) ;; ($ 'cmd))
	 (cmd     (if (string? cmd-in)(string->symbol cmd-in) cmd-in))
	 (params  (alist-ref 'params indat))
         (key     (alist-ref 'key indat))    ;; TODO - add this back
	 )
    (debug:print 0 *default-log-port* "cmd:" cmd " with params " params ", key " key)
    (if (equal? key *my-signature*) ;; TODO - get real key involved
	(begin
	  (set! *api-process-request-count* (+ *api-process-request-count* 1))
	  (let* ((res (api:execute-requests dbstruct cmd params))) 
	    (debug:print 0 *default-log-port* "res:" res)
	    #;(if (not success)
		(debug:print 0 *default-log-port* "ERROR: success flag is #f for " cmd " with params " params))
	    (if (> *api-process-request-count* *max-api-process-requests*)
		(set! *max-api-process-requests* *api-process-request-count*))
	    (set! *api-process-request-count* (- *api-process-request-count* 1))
	    (sexpr->string res)))
	(begin
	  (debug:print 0 *default-log-port*   "Server refused to process request. Sever id mismatch. recived " key " expected:  " *my-signature* ".\nOther arguments recived: cmd=" cmd " params = " params) 
	  (conc "Server refused to process request server signature mismatch: " key ", " *my-signature*)))))

)

;; sometime in the future
;;
(define (rmt:send-receive-real remote apath dbname cmd params)
  (let* ((conn (rmt:get-conn remote apath dbname)))
    (assert conn "FATAL: rmt:send-receive-real called without the needed channels opened")
    (rmt:send-receive-setup conn)
    (let* ((key     #f)
	   (payload `((cmd . ,cmd)
		      (key . ,(rmt:conn-srvpkt conn))
		      (params . ,params)))
	   (res      (begin
		       (write payload (rmt:conn-outport conn))
		       (with-input-from-port
			   (rmt:conn-inport conn)
			 read))))
      res)))
;;  (if (string? res)
;; 	  (string->sexpr res)
;; 	  res))))



;; 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-conn remote apath dbname)))
;;     (assert conn "FATAL: Unable to connect to db "apath"/"dbname)
;;     #;(let* ((res      (with-input-from-request
;; 		      (rmt:conn->uri conn "api") 
;; 		      `((params . (,apath ,dbname)))
;; 		      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"))
    (for-each (lambda (cmd)
		(let ((cmd-dat (hash-table-ref *db-stats* cmd)))

	  (servdat-host-set! *server-info* ipaddrstr)
	  (servdat-port-set! *server-info* port)
	  (servdat-status-set! *server-info* 'trying-port)
	  (servdat-trynum-set! *server-info* (+ (servdat-trynum *server-info*) 1)))
	(set! *server-info* (make-servdat host: ipaddrstr port: port)))
    (let* ((l        (rmt:try-start-server ipaddrstr port))
	   (dbstruct #f))
      (let oloop ()
	(let-values (((i o) (tcp-accept l)))
	  ;; (write-line "Hello!" o)
	  (let loop ((indat (read i)))
	    (if (eof-object? indat)
		(begin
		  (close-input-port i)
		  (close-output-port o)
		  (oloop))
		(let* ((res (api:process-request dbstruct indat)))
		  (case res
		    ((quit)
		     (close-input-port i)
		     (close-output-port o))
		    (else
		     (set! *db-last-access* (current-seconds))
		     (write res o)
		     (loop (read i))))))))))
    (let* ((portnum (servdat-port *server-info*)))
      (portlogger:open-run-close portlogger:set-port portnum "released")
      (debug:print 1 *default-log-port* "INFO: server has been stopped"))))

(define (rmt:try-start-server ipaddrstr portnum)
  (if *server-info*
      (begin
	(servdat-host-set! *server-info* ipaddrstr)
	(servdat-port-set! *server-info* portnum)
	(servdat-status-set! *server-info* 'trying-port)

		      (tcp-connect host port))))
    (if (and i o)
	(begin
	  (write `((cmd . ping)
		   (key . ,key)
		   (params . ())) o)
	  (let ((res (with-input-from-port i
		       read)))
	    (close-output-port o)
	    (close-input-port i)
	    res))
;; 	    (if (string? res)
;; 		(string->sexpr res)
;; 		res)))
	(begin ;; connection failed
	  (debug:print-info 0 *default-log-port* "Server at "host":"port" is not responding.")
	  #f))))
 	      
;; (define (loop-test host port data) ;; server-address is host:port
;;   ;; ping the server and ask it
;;   ;; if it ready
;;   ;; (let* ((sdat (servdat-init #f host port #f)))
;;   ;;   (http-transport:send-receive sdat "abc" 'ping '())))
;;   (let* ((payload (sexpr->string data))
;; 	 (res     (with-input-from-request
;; 		   (conc "http://"host":"port"/loop-test")
;; 		   `((data . ,payload))
;; 		   read-string)))
;;   (string->sexpr 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
;;
(define (get-viable-servers serv-pkts dbpath)
  (let loop ((tail serv-pkts)