Index: rmtmod.scm
==================================================================
--- rmtmod.scm
+++ rmtmod.scm
@@ -1496,11 +1496,11 @@
   (args:get-arg "-server"))
 
 ;; called in megatest.scm, host-port is string hostname:port
 ;;
 ;; NOTE: This is NOT called directly from clients as not all transports support a client running
-;;       in the same process as the server.
+;;       in the same process as the server. 
 ;;
 (define (server:ping host port server-id #!key (do-exit #f))
   (server-ready? host port "nokey yet"))
 
 ;;======================================================================
@@ -1521,17 +1521,19 @@
 ;;             -> http-transport:try-start-server -> http-transport:try-start-server (until success)
 
 (define (http-get-function fnkey)
   (hash-table-ref/default *http-functions* fnkey (lambda () "nothing here yet")))
 
-(define (http-handle-api dbstruct $)
-  (if (api-proc)
-      ((api-proc) dbstruct $) ;; ($) => alist
-      'no-api-proc-set))
-
-(define (rmt:launch-server hostn port)
-  (let* ((l        (tcp-listen port))
+#;(define (rmt:launch-server hostn port)
+   (if *server-info*
+	(begin
+	  (servdat-host-set! *server-info* hostn)
+	  (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: portnum)))
+   (let* ((l        (tcp-listen port))
 	 (dbstruct #f))
     (let-values (((i o) (tcp-accept l)))
       ;; (write-line "Hello!" o)
       (let loop ((indat (read i)))
 	(let* ((res (api:process-request dbstruct indat)))
@@ -1540,157 +1542,94 @@
 	     (close-input-port i)
 	     (close-output-port o))
 	    (else
 	     (write res o))))))))
 
-#;(define (http-transport:run hostn)
-  ;; Configurations for server
-  (tcp-buffer-size 2048)
-  (max-connections 2048) 
+(define (rmt:run hostn)
+  ;;  ;; Configurations for server
+  ;;  (tcp-buffer-size 2048)
+  ;;  (max-connections 2048) 
   (debug:print 2 *default-log-port* "Attempting to start the server ...")
   (let* ((db              #f) ;;        (open-db)) ;; we don't want the server to be opening and closing the db unnecesarily
 	 (hostname        (get-host-name))
 	 (ipaddrstr       (let ((ipstr (if (string=? "-" hostn)
 					   ;; (string-intersperse (map number->string (u8vector->list (hostname->ip hostname))) ".")
 					   (server:get-best-guess-address hostname)
 					   #f)))
 			    (if ipstr ipstr hostn))) ;; hostname))) 
-	 (start-port      (portlogger:open-run-close portlogger:find-port))
+	 (port            (portlogger:open-run-close portlogger:find-port))
 	 (link-tree-path  (common:get-linktree))
 	 (tmp-area        (common:get-db-tmp-area))
 	 #;(start-file      (conc tmp-area "/.server-start")))
-    (debug:print-info 0 *default-log-port* "portlogger recommended port: " start-port)
-    ;; set some parameters for the server
-    (root-path     (if link-tree-path 
-		       link-tree-path
-		       (current-directory))) ;; WARNING: SECURITY HOLE. FIX ASAP!
-    (handle-directory spiffy-directory-listing)
-    #;(handle-exception (lambda (exn chain)
-			(signal (make-composite-condition
-				 (make-property-condition 
-				  'server
-				  'message "server error")))))
-
-    ;; Setup the web server and a /ctrl interface
-    ;;
-    (vhost-map `(((* any) . ,(lambda (continue)
-			       ;; open the db on the first call 
-				 ;; This is were we set up the database connections
-			       (let* (($   (request-vars source: 'both))
-				      ;; (dat ($ 'dat))
-				      (res #f))
-				 (cond
-				  ((equal? (uri-path (request-uri (current-request)))
-					   '(/ "api"))
-				   (debug:print 0 *default-log-port* "In api request $=" $)
-				   (send-response ;; the $ is the request vars proc
-				    body: (http-handle-api *dbstruct-db* $)
-				    headers: '((content-type text/plain)))
-				   (set! *db-last-access* (current-seconds)))
-				  ((equal? (uri-path (request-uri (current-request))) 
-					   '(/ "ping"))
-				   (send-response body: (conc *toppath*"/"(args:get-arg "-db"))
-						  headers: '((content-type text/plain))))
-				  ((equal? (uri-path (request-uri (current-request))) 
-					   '(/ "loop-test"))
-				   (send-response body: (alist-ref 'data ($))
-						  headers: '((content-type text/plain))))
-				  ((equal? (uri-path (request-uri (current-request))) 
-					   '(/ ""))
-				   (send-response body: ((http-get-function 'http-transport:main-page))))
-				  ((equal? (uri-path (request-uri (current-request))) 
-					   '(/ "json_api"))
-				   (send-response body: ((http-get-function 'http-transport:main-page))))
-				  ((equal? (uri-path (request-uri (current-request))) 
-					   '(/ "runs"))
-				   (send-response body: ((http-get-function 'http-transport:main-page))))
-				  ((equal? (uri-path (request-uri (current-request))) 
-					   '(/ any))
-				   (send-response body: "hey there!\n"
-						  headers: '((content-type text/plain))))
-				  ((equal? (uri-path (request-uri (current-request))) 
-					   '(/ "hey"))
-				   (send-response body: "hey there!\n" 
-						  headers: '((content-type text/plain))))
-                                  ((equal? (uri-path (request-uri (current-request))) 
-					   '(/ "jquery3.1.0.js"))
-				   (send-response body: ((http-get-function 'http-transport:show-jquery))
-						  headers: '((content-type application/javascript))))
-                                  ((equal? (uri-path (request-uri (current-request))) 
-					   '(/ "test_log"))
-				   (send-response body: ((http-get-function 'http-transport:html-test-log) $) 
-						  headers: '((content-type text/HTML))))    
-                                  ((equal? (uri-path (request-uri (current-request))) 
-					   '(/ "dashboard"))
-				   (send-response body: ((http-get-function 'http-transport:html-dboard) $)
-						  headers: '((content-type text/HTML)))) 
-				  (else (continue))))))))
-    (http-transport:try-start-server ipaddrstr start-port)))
-
-;; This is recursively run by http-transport:run until sucessful, it then runs until server is stopped
-;;
-#;(define (http-transport:try-start-server ipaddrstr portnum)
-  (let ((config-hostname (configf:lookup *configdat* "server" "hostname"))
-	(config-use-proxy (equal? (configf:lookup *configdat* "client" "use-http_proxy") "yes")))
-    (if (not config-use-proxy)
-	(determine-proxy (constantly #f)))
-	;; any error in following steps will result in a retry
+    (debug:print-info 0 *default-log-port* "portlogger recommended port: " port)
     (if *server-info*
 	(begin
 	  (servdat-host-set! *server-info* ipaddrstr)
-	  (servdat-port-set! *server-info* portnum)
+	  (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: portnum)))
-    (debug:print-info 0 *default-log-port* "http-transport:try-start-server time="
-		      (seconds->time-string (current-seconds))
-		      " ipaddrsstr=" ipaddrstr
-		      " portnum=" portnum
-		      " config-hostname=" config-hostname)
-    (handle-exceptions
-	exn
-	(begin
-	  (print-error-message exn)
-	  (if (< portnum 64000)
-	      (begin 
-		(debug:print 0 *default-log-port* "WARNING: attempt to start server failed. Trying again ...")
-		(debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
-		(debug:print 5 *default-log-port* "exn=" (condition->list exn))
-		(portlogger:open-run-close portlogger:set-failed portnum)
-		(debug:print 0 *default-log-port* "WARNING: failed to start on portnum: " portnum ", trying next port")
-		(thread-sleep! 0.1)
-		
-		;; get_next_port goes here
-		(http-transport:try-start-server ipaddrstr
-						 (portlogger:open-run-close portlogger:find-port)))
-	      (begin
-		(print "ERROR: Tried and tried but could not start the server"))))
-	;; any error in following steps will result in a retry
-	(if *server-info*
-	    (servdat-status-set! *server-info* 'starting)
-	    (set! *server-info* (make-servdat host: ipaddrstr port: portnum)))
-	
-	(debug:print 0 *default-log-port* "INFO: Trying to start server on " ipaddrstr ":" portnum)
-	;; This starts the spiffy server
-	;; NEED WAY TO SET IP TO #f TO BIND ALL
-	;; (start-server bind-address: ipaddrstr port: portnum)
-	(if config-hostname ;; this is a hint to bind directly
-	    (start-server port: portnum bind-address: (if (equal? config-hostname "-")
-							  ipaddrstr
-							  config-hostname))
-	    (start-server port: portnum))
+	(set! *server-info* (make-servdat host: ipaddrstr port: port)))
+    (let* ((l        (rmt:try-start-server ipaddrstr port))
+	   (dbstruct #f))
+      (let-values (((i o) (tcp-accept l)))
+      ;; (write-line "Hello!" o)
+      (let loop ((indat (read i)))
+	(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)))))
+      (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"))))
+	(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)
+	(servdat-trynum-set! *server-info* (+ (servdat-trynum *server-info*) 1)))
+      (set! *server-info* (make-servdat host: ipaddrstr port: portnum)))
+  (debug:print-info 0 *default-log-port* "rmt:try-start-server time="
+		    (seconds->time-string (current-seconds))
+		    " ipaddrsstr=" ipaddrstr
+		    " portnum=" portnum)
+  (handle-exceptions
+   exn
+   (begin
+     (print-error-message exn)
+     (if (< portnum 64000)
+	 (begin 
+	   (debug:print 0 *default-log-port* "WARNING: attempt to start server failed. Trying again ...")
+	   (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
+	   (debug:print 5 *default-log-port* "exn=" (condition->list exn))
+	   (portlogger:open-run-close portlogger:set-failed portnum)
+	   (debug:print 0 *default-log-port* "WARNING: failed to start on portnum: " portnum ", trying next port")
+	   ;; (thread-sleep! 0.1)
+	   (rmt:try-start-server ipaddrstr
+				 (portlogger:open-run-close portlogger:find-port)))
+	 (begin
+	   (print "ERROR: Tried and tried but could not start the server"))))
+   ;; any error in following steps will result in a retry
+   (if *server-info*
+       (servdat-status-set! *server-info* 'starting)
+       (set! *server-info* (make-servdat host: ipaddrstr port: portnum)))
+   
+   (debug:print 0 *default-log-port* "INFO: Trying to start server on " ipaddrstr ":" portnum)
+   (tcp-listen portnum)))
 
 ;;======================================================================
 ;; S E R V E R   U T I L I T I E S 
 ;;======================================================================
 
 ;;======================================================================
 ;; C L I E N T S
 ;;======================================================================
-
 
 (define (http-transport:get-time-to-cleanup)
   (let ((res #f))
     (mutex-lock! *http-mutex*)
     (set! res (> (current-seconds) *http-connections-next-cleanup*))
@@ -1719,11 +1658,12 @@
     (if (> *http-requests-in-progress* 0)
 	(if (> etime (current-seconds))
 	    (begin
 	      (thread-sleep! 0.052)
 	      (loop etime))
-	    (debug:print-error 0 *default-log-port* "requests still in progress after 5 seconds of waiting. I'm going to pass on cleaning up http connections"))
+	    (debug:print-error 0 *default-log-port*
+			       "requests still in progress after 5 seconds of waiting. I'm going to pass on cleaning up http connections"))
 	#;(close-idle-connections!)))
   (set! *http-connections-next-cleanup* (+ (current-seconds) 10))
   (mutex-unlock! *http-mutex*))
 
 (define (http-transport:inc-requests-and-prep-to-close-all-connections)
@@ -2064,12 +2004,12 @@
 	 ((or (not (equal? last-host curr-host))
 	      (not (equal? last-port curr-port)))
 	  (debug:print-info 0 *default-log-port* "WARNING: interface changed, refreshing iface and port info")
 	  (thread-sleep! 0.25)
 	  (loop curr-host curr-port (+ tries 1)))
-	 ((< (- (current-seconds) stime) 3) ;; keep up the looping until at least 3 seconds have passed
-	  (thread-sleep! 1)
+	 ((< (- (current-seconds) stime) 1) ;; keep up the looping until at least 3 seconds have passed
+	  (thread-sleep! 0.5)
 	  (loop curr-host curr-port (+ tries 1)))
 	 (else
 	  (if (not *server-id*)(set! *server-id* (server:mk-signature)))
 	  (servdat-status-set! *server-info* 'interface-stable)
 	  (debug:print 0 *default-log-port*
@@ -2081,11 +2021,11 @@
 	  #t))))))
 
 ;; 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) 
+(define (rmt:keep-running dbname) 
   ;; if none running or if > 20 seconds since 
   ;; server last used then start shutdown
   ;; This thread waits for the server to come alive
   (debug:print-info 0 *default-log-port* "Starting the sync-back, keep alive thread in server")
 
@@ -2217,27 +2157,19 @@
 ;; all routes though here end in exit ...
 ;;
 ;; This is the point at which servers are started
 ;;
 (define (rmt:server-launch dbname)
-  ;;(let* ((tmp-area            (common:get-db-tmp-area))
-  ;;       (server-start        (conc tmp-area "/.server-start"))
-  ;;       (server-started      (conc tmp-area "/.server-started"))
-  ;;       (start-time          (common:lazy-modification-time server-start))
-  ;;       (started-time        (common:lazy-modification-time server-started))
-  ;;       (server-starting     (< start-time started-time)) ;; if start-time is less than started-time then a server is still starting
-  ;;       (start-time-old      (> (- (current-seconds) start-time) 5))
-  #;(let* ((th2 (make-thread (lambda ()
+  (let* ((th2 (make-thread (lambda ()
 			     (debug:print-info 0 *default-log-port* "Server run thread started")
-			     (http-transport:run 
-			      (if (args:get-arg "-server")
-				  (args:get-arg "-server")
-				  "-")
-			      )) "Server run"))
+			     (rmt:run (if (args:get-arg "-server")
+					  (args:get-arg "-server")
+					  "-")
+				      )) "Server run"))
 	 (th3 (make-thread (lambda ()
 			     (debug:print-info 0 *default-log-port* "Server monitor thread started")
-			     (http-transport:keep-running dbname)
+			     (rmt:keep-running dbname)
 			     "Keep running"))))
     (thread-start! th2)
     (thread-sleep! 0.252) ;; give the server time to settle before starting the keep-running monitor.
     (thread-start! th3)
     (set! *didsomething* #t)
@@ -2260,10 +2192,14 @@
   (if *my-client-signature* *my-client-signature*
       (let ((sig (server:mk-signature)))
         (set! *my-client-signature* sig)
         *my-client-signature*)))
 
+;;======================================================================
+;; S E R V E R   U T I L I T I E S 
+;;======================================================================
+
 ;; run ping in separate process, safest way in some cases
 ;;
 #;(define (server:ping-server ifaceport)
   (with-input-from-pipe 
    (conc (common:get-megatest-exe) " -ping " ifaceport)
@@ -2275,18 +2211,10 @@
 	     ((NOREPLY)  #f)
 	     ((LOGIN_OK) #t)
 	     (else       #f))
 	   (loop (read-line) inl))))))
 
-
-;;======================================================================
-;; S E R V E R
-;;======================================================================
-;;======================================================================
-;; S E R V E R   U T I L I T I E S 
-;;======================================================================
-
 ;; NOT USED (well, ok, reference in rpc-transport but otherwise not used).
 ;;
 #;(define (server:login toppath)
   (lambda (toppath)
     (set! *db-last-access* (current-seconds)) ;; might not be needed.
@@ -2311,5 +2239,72 @@
 ;;      (else #f))))
 
 
 
 )
+
+;;======================================================================
+;; A T T I C
+;;======================================================================
+
+
+    ;; (handle-directory spiffy-directory-listing)
+;; #;(handle-exception (lambda (exn chain)
+;; 			(signal (make-composite-condition
+;; 				 (make-property-condition 
+;; 				  'server
+;; 				  'message "server error")))))
+;; 
+;; ;; Setup the web server and a /ctrl interface
+;; ;;
+;; (vhost-map `(((* any) . ,(lambda (continue)
+;; 			       ;; open the db on the first call 
+;; 				 ;; This is were we set up the database connections
+;; 			       (let* (($   (request-vars source: 'both))
+;; 				      ;; (dat ($ 'dat))
+;; 				      (res #f))
+;; 				 (cond
+;; 				  ((equal? (uri-path (request-uri (current-request)))
+;; 					   '(/ "api"))
+;; 				   (debug:print 0 *default-log-port* "In api request $=" $)
+;; 				   (send-response ;; the $ is the request vars proc
+;; 				    body: (http-handle-api *dbstruct-db* $)
+;; 				    headers: '((content-type text/plain)))
+;; 				   (set! *db-last-access* (current-seconds)))
+;; 				  ((equal? (uri-path (request-uri (current-request))) 
+;; 					   '(/ "ping"))
+;; 				   (send-response body: (conc *toppath*"/"(args:get-arg "-db"))
+;; 						  headers: '((content-type text/plain))))
+;; 				  ((equal? (uri-path (request-uri (current-request))) 
+;; 					   '(/ "loop-test"))
+;; 				   (send-response body: (alist-ref 'data ($))
+;; 						  headers: '((content-type text/plain))))
+;; 				  ((equal? (uri-path (request-uri (current-request))) 
+;; 					   '(/ ""))
+;; 				   (send-response body: ((http-get-function 'http-transport:main-page))))
+;; 				  ((equal? (uri-path (request-uri (current-request))) 
+;; 					   '(/ "json_api"))
+;; 				   (send-response body: ((http-get-function 'http-transport:main-page))))
+;; 				  ((equal? (uri-path (request-uri (current-request))) 
+;; 					   '(/ "runs"))
+;; 				   (send-response body: ((http-get-function 'http-transport:main-page))))
+;; 				  ((equal? (uri-path (request-uri (current-request))) 
+;; 					   '(/ any))
+;; 				   (send-response body: "hey there!\n"
+;; 						  headers: '((content-type text/plain))))
+;; 				  ((equal? (uri-path (request-uri (current-request))) 
+;; 					   '(/ "hey"))
+;; 				   (send-response body: "hey there!\n" 
+;; 						  headers: '((content-type text/plain))))
+;;                               ((equal? (uri-path (request-uri (current-request))) 
+;; 					   '(/ "jquery3.1.0.js"))
+;; 				   (send-response body: ((http-get-function 'http-transport:show-jquery))
+;; 						  headers: '((content-type application/javascript))))
+;;                               ((equal? (uri-path (request-uri (current-request))) 
+;; 					   '(/ "test_log"))
+;; 				   (send-response body: ((http-get-function 'http-transport:html-test-log) $) 
+;; 						  headers: '((content-type text/HTML))))    
+;;                               ((equal? (uri-path (request-uri (current-request))) 
+;; 					   '(/ "dashboard"))
+;; 				   (send-response body: ((http-get-function 'http-transport:html-dboard) $)
+;; 						  headers: '((content-type text/HTML)))) 
+;; 				  (else (continue))))))))