Megatest

  (set! *http-connections-next-cleanup* (+ (current-seconds) 10))
  (mutex-unlock! *http-mutex*))

(define (http-transport:inc-requests-and-prep-to-close-all-connections)
  (mutex-lock! *http-mutex*)
  (set! *http-requests-in-progress* (+ 1 *http-requests-in-progress*)))

;; Turn off proxy handling
(define (http-transport:client-turn-off-proxy)
  (determine-proxy (constantly #f))) ;; From (chicken base)

;; serverdat contains uuid to be used for connection validation
;;
;; NOTE: serverdat must be initialized once by servdat-init
;; NOTE: serverdat must be initialized or created by servdat-init
;;
(define (http-transport:send-receive serverdat cmd params #!key (numretries 3))
(define (http-transport:send-receive sdat qry-key cmd params #!key (numretries 3))
  (let* ((fullurl    (servdat-api-uri serverdat)) ;; gets uri for /api
	 (res        #f)
  (let* ((res        #f)
	 (success    #t)
         (server-id  (servdat-uuid serverdat)))
       ;; set up the http-client here
    (max-retry-attempts 1)
    ;; consider all requests indempotent
    (retry-request? (lambda (request)
	 (sparams    (with-output-to-string
		       (lambda ()(write params)))))
		      #f))
    ;; send the data and get the response extract the needed info from
    ;; the http data and process and return it.
    (let* ((send-recieve (lambda ()
			   (set! res
				 (vector
				  #t ;; success
				  (with-input-from-request
				   fullurl 
				   (list (cons 'key server-id)
				   (servdat-api-uri sdat)
				   (list (cons 'key qry-key)
					 (cons 'srvid (servdat-uuid sdat))
					 (cons 'cmd cmd)
					 (cons 'params params))
					 (cons 'params sparams))
				   read)))))
	      (time-out     (lambda ()
			      (thread-sleep! 45)
			      (debug:print 0 *default-log-port* "WARNING: send-receive took more than 45 seconds!!")
			      #f))
	      (th1 (make-thread send-recieve "with-input-from-request"))
	      (th2 (make-thread time-out     "time out")))
	 (thread-start! th1)
	 (thread-start! th2)
	 (thread-join! th1)
	 (close-idle-connections!)
	 (thread-terminate! th2)
	 (if (string? res)
	     (with-input-from-string res
	       (lambda () read))
      res)))
	     res))))

;; careful closing of connections stored in *runremote*
;;
(define (http-transport:close-connections #!key (area-dat #f))
  (debug:print-info 0 *default-log-port* "http-transport:close-connections doesn't do anything now!"))
  (let* ((runremote  (or area-dat *runremote*))
	 (server-dat (if runremote
                         (remote-conndat runremote)
                         #f))) ;; (hash-table-ref/default *runremote* run-id #f)))
    (if (vector? server-dat)
	(let ((api-dat (http-transport:server-dat-get-api-uri server-dat)))
	  (handle-exceptions
	    exn
	    (begin
	      (print-call-chain *default-log-port*)
	      (debug:print-error 0 *default-log-port* " closing connection failed with error: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn))
	    (close-connection! api-dat)
            ;;(close-idle-connections!)
	    #t))
	#f)))
;;   (let* ((runremote  (or area-dat *runremote*))
;; 	 (server-dat (if runremote
;;                          (remote-conndat runremote)
;;                          #f))) ;; (hash-table-ref/default *runremote* run-id #f)))
;;     (if (vector? server-dat)
;; 	(let ((api-dat (http-transport:server-dat-get-api-uri server-dat)))
;; 	  (handle-exceptions
;; 	    exn
;; 	    (begin
;; 	      (print-call-chain *default-log-port*)
;; 	      (debug:print-error 0 *default-log-port* " closing connection failed with error: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn))
;; 	    (close-connection! api-dat)
;;             ;;(close-idle-connections!)
;; 	    #t))
;; 	#f)))


(define (make-http-transport:server-dat)(make-vector 6))
(define (http-transport:server-dat-get-iface         vec)    (vector-ref  vec 0))
(define (http-transport:server-dat-get-port          vec)    (vector-ref  vec 1))
(define (http-transport:server-dat-get-api-uri       vec)    (vector-ref  vec 2))
(define (http-transport:server-dat-get-api-url       vec)    (vector-ref  vec 3))

(define (http-transport:server-dat-update-last-access vec)
  (if (vector? vec)
      (vector-set! vec 5 (current-seconds))
      (begin
	(print-call-chain (current-error-port))
	(debug:print-error 0 *default-log-port* "call to http-transport:server-dat-update-last-access with non-vector!!"))))

;;
;; connect
;; initialize servdat for client side, setup needed parameters
;; pass in #f as sdat-in to create sdat
;;
(define (http-transport:client-connect iface port server-id) 
  (let* ((api-url      (conc "http://" iface ":" port "/api"))
	 (api-uri      (uri-reference (conc "http://" iface ":" port "/api")))
	 (api-req      (make-request method: 'POST uri: api-uri))
	 (server-dat   (vector iface port api-uri api-url api-req (current-seconds) server-id)))
    server-dat))

;; initialize servdat for client side
(define (servdat-init sdat-in iface port uuid)
  (let* ((sdat (or sdat-in (make-servdat))))
    (if uuid (servdat-uuid-set! sdat uuid))
    (servdat-host-set! sdat iface)
    (servdat-port-set! sdat port)
    (servdat-api-url-set! sdat (conc "http://" iface ":" port "/api"))
    (servdat-api-uri-set! sdat (uri-reference (servdat->url sdat)))
    (servdat-api-req-set! sdat (make-request method: 'POST
					     uri: (servdat-api-uri sdat)))
    ;; set up the http-client parameters
    (max-retry-attempts 1)
    ;; consider all requests indempotent
    (retry-request? (lambda (request)
		      #f))
    (determine-proxy (constantly #f))
    sdat))
   sdat))

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

;; only use for main.db - need to re-write some of this :(
;;

	   (read-pkt->alist pkt-file pktspec: pktspec))
	 all-pkt-files)))

(define (server-address srv-pkt)
  (conc (alist-ref 'host srv-pkt) ":"
	(alist-ref 'port srv-pkt)))
	
(define (server-ready? server-address)
(define (server-ready? host port) ;; server-address is host:port
  ;; ping the server and ask it
  ;; if it ready
  #f)
  (let* ((sdat (servdat-init #f host port #f)))
    (http-transport:send-receive sdat 'ping '())))

;; 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)

;; from viable servers get one that is alive and ready
;;
(define (get-the-server serv-pkts dbpath)
  (let loop ((tail serv-pkts))
    (if (null? tail)
	#f
	(let* ((spkt (car tail))
	       (host (alist-ref 'host spkt))
	       (port (alist-ref 'port spkt))
	       (addr (server-address spkt)))
	  (if (server-ready? addr)
	  (if (server-ready? host port)
	      spkt
	      (loop (cdr tail)))))))

;; am I the "first" in line server? I.e. my D card is smallest
;; use Z card as tie breaker
;;
(define (get-best-candidate serv-pkts dbpath)

		     (viables      (get-viable-servers all-pkts db-file))
		     (best-srv     (get-best-candidate viables db-file))
		     (best-srv-key (if best-srv (alist-ref 'servkey best-srv) #f)))
		(debug:print 0 *default-log-port* "best-srv-key: "best-srv-key", server-key: "server-key)
		;; am I the best-srv, compare server-keys to know
		(if (equal? best-srv-key server-key)
		    (if (get-lock-db sdat db-file) ;; (db:get-iam-server-lock *dbstruct-db* *toppath* run-id)
			(begin
			(debug:print 0 *default-log-port* "I'm the server!")
			(servdat-dbfile-set! sdat db-file))
		    (begin
		      (debug:print 0 *default-log-port* "I'm not the server, exiting.")
		      (bdat-time-to-exit-set! *bdat* #t)
		      (thread-sleep! 0.2)
		      (exit)))
		(begin
		  (debug:print 0 *default-log-port*
			       "Keys do not match "best-srv-key", "server-key", exiting.")
		  (bdat-time-to-exit-set! *bdat* #t)
		  (thread-sleep! 0.2)
		  (exit)))
	      sdat))
	(begin
	  (debug:print-info 0 *default-log-port* "Still waiting, last-sdat=" last-sdat)
	  (sleep 4)
	  (if (> (- (current-seconds) start-time) 120) ;; been waiting for two minutes
	      (begin
		(debug:print-error 0 *default-log-port* "transport appears to have died, exiting server")
		(exit))
	      (loop start-time
		    (equal? sdat last-sdat)
		    sdat)))))))
			  (debug:print 0 *default-log-port* "I'm the server!")
			  (servdat-dbfile-set! sdat db-file))
			(begin
			  (debug:print 0 *default-log-port* "I'm not the server, exiting.")
			  (bdat-time-to-exit-set! *bdat* #t)
			  (thread-sleep! 0.2)
			  (exit)))
		    (begin
		      (debug:print 0 *default-log-port*
				   "Keys do not match "best-srv-key", "server-key", exiting.")
		      (bdat-time-to-exit-set! *bdat* #t)
		      (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)
	      (sleep 4)
	      (if (> (- (current-seconds) start-time) 120) ;; been waiting for two minutes
		  (begin
		    (debug:print-error 0 *default-log-port* "transport appears to have died, exiting server")
		    (exit))
		  (loop start-time
			(equal? sdat last-sdat)
			sdat))))))))

;; run http-transport:keep-running in a parallel thread to monitor that the db is being 
;; used and to shutdown after sometime if it is not.
;;
(define (http-transport:keep-running dbname) 
  ;; if none running or if > 20 seconds since 
  ;; server last used then start shutdown