Megatest

		#t)
	      (start-main-srv)))
	(start-main-srv))))

;; NB// remote is a rmt:remote struct
;;
(define (rmt:general-open-connection remote apath dbname #!key (num-tries 5))
  (let ((mdbname (db:run-id->dbname #f)))

    (cond
     ((not (rmt:get-conn remote apath mdbname)) ;; no channel open to main? 

      (rmt:open-main-connection remote apath)
      (thread-sleep! 2)
      (rmt:general-open-connection remote apath mdbname))
     ((not (rmt:get-conn remote apath dbname))                 ;; no channel open to dbname?     
      (let* ((res (rmt:send-receive-real remote apath mdbname 'get-server `(,apath ,dbname))))
	(case res
	  ((server-started)

  
;; 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 cmd params)
  (let* ((conn (rmt:get-conn remote apath dbname)))
    (assert conn "FATAL: rmt:send-receive-real called without the needed channels opened")
    (pp (rmt:conn->alist conn))
    ;; (rmt:send-receive-setup conn)
;;     (let-values (((i o) (tcp-connect (rmt:conn-ipaddr conn)
;; 				     (rmt:conn-port conn))))
    (let* ((key     #f)
	   (host    (rmt:conn-ipaddr conn))
	   (port    (rmt:conn-port   conn))
	   (payload `((cmd    . ,cmd)
		      (key    . ,(rmt:conn-srvkey conn))
		      (params . ,params)))
	   (res      (open-send-receive-nn (conc host":"port)
					   (sexpr->string payload))))
      ;; begin
	;; 		 (write payload o) ;; (rmt:conn-outport conn))
	;; 		 (with-input-from-port
	;; 		     i ;; (rmt:conn-inport conn)
	;; 		   read))))
	;; (close-input-port i)
	;; (close-output-port o)
      (string->sexpr 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)))
		  (debug:print 18 *default-log-port* (format #f fmtstr cmd (vector-ref cmd-dat 0) (vector-ref cmd-dat 1) (/ (vector-ref cmd-dat 1)(vector-ref cmd-dat 0))))))
	      (sort (hash-table-keys *db-stats*)
		    (lambda (a b)
		      (> (vector-ref (hash-table-ref *db-stats* a) 0)

			 (bdat-time-to-exit-set! *bdat* #t)
			 #t))))
    (debug:print-info 4 *default-log-port* "starting exit process, finalizing databases.")
    (if (and no-hurry (debug:debug-mode 18))
	(rmt:print-db-stats))
    (let ((th1 (make-thread (lambda () ;; thread for cleaning up, give it five seconds
                              (if *server-info*
				  (let ((pkt-file (conc (get-pkts-dir *toppath*)
							"/" (servdat-uuid *server-info*)
							".pkt"))
					(dbfile   (servdat-dbfile *server-info*)))
				    (if dbfile
					(begin

					  ;; do a final sync here
					  
					(if (string-match ".*/main.db$" dbfile)

					    (begin

					      (debug:print-info 0 *default-log-port* "removing pkt "pkt-file)
					      (delete-file* pkt-file)
					      (debug:print-info 0 *default-log-port* "Releasing lock for "dbfile)
					      (db:with-lock-db (servdat-dbfile *server-info*)
							       (lambda (dbh dbfile)
								 (db:release-lock dbh dbfile))))
					    (let* ((sdat *server-info*)) ;; we have a run-id server
					      (rmt:send-receive-real *rmt:remote* *toppath*
								     (db:run-id->dbname #f)
								     'deregister-server
								     `(,(servdat-uuid sdat)
								       ,(current-process-id)
								       ,(servdat-host sdat)   ;; iface
								       ,(servdat-port sdat)))))))))
			      (if *dbstruct-db* (db:close-all *dbstruct-db*)) ;; one second allocated
			      (if (bdat-task-db *bdat*)    ;; TODO: Check that this is correct for task db
				  (let ((db (cdr (bdat-task-db *bdat*))))
				    (if (sqlite3:database? db)
					(begin
					  (sqlite3:interrupt! db)
					  (sqlite3:finalize! db #t)
					  (bdat-task-db-set! *bdat* #f)))))
                              #;(http-client#close-idle-connections!)
                              (if (not (eq? *default-log-port* (current-error-port)))
                                  (close-output-port *default-log-port*))
			      (set! *default-log-port* (current-error-port))) "Cleanup db exit thread"))
	  (th2 (make-thread (lambda ()
			      (debug:print 4 *default-log-port* "Attempting clean exit. Please be patient and wait a few seconds...")
			      (if no-hurry
                                  (begin
                                    (thread-sleep! 5)) ;; give the clean up few seconds to do it's stuff
                                  (begin
      				  (thread-sleep! 2)))
      			      (debug:print 4 *default-log-port* " ... done")
      			      )
			    "clean exit")))
      (thread-start! th1)
      (thread-start! th2)
      (thread-join! th1)
      )

		    (exit))
		  (loop start-time
			(equal? sdat last-sdat)
			sdat))))))))

(define (rmt:register-server remote apath iface port server-key dbname)
  (rmt:open-main-connection remote apath) ;; we need a channel to main.db
  (rmt:send-receive-real remote apath ;; params: host port servkey pid ipaddr dbpath
			 (db:run-id->dbname #f) 'register-server `(,iface

								   ,port
								   ,server-key
								   ,(current-process-id)
								   ,iface
								   ,apath
								   ,dbname)))

(define (http-transport:wait-for-stable-interface #!optional (num-tries-allowed 100))
  ;; wait until *server-info* stops changing
  (let* ((stime (current-seconds)))
    (let loop ((last-host  #f)
	       (last-port  #f)
	       (tries 0))

    ;; this is our forever loop
    (let* ((iface             (servdat-host *server-info*))
	   (port              (servdat-port *server-info*)))
      (let loop ((count         0)
		 (bad-sync-count 0)
		 (start-time     (current-milliseconds)))
	
	(if (not is-main)

	    (debug:print-info 0 *default-log-port* "servdat-status is " (servdat-status *server-info*)))

	;; set up the database handle
	(mutex-lock! *heartbeat-mutex*)
	(if (not *dbstruct-db*) ;; no db opened yet, open the db and register with main if appropriate
	    (let ((watchdog (bdat-watchdog *bdat*)))		 
	      (debug:print 0 *default-log-port* "SERVER: dbprep")