Megatest

#!/bin/bash

(killall mtest -v;sleep 1;killall mtest -v -9;rm tests/simplerun/logs/*;rm tests/basicserver.log) &
ck5 make install
wait 
ck5 make unit

;; NOTE: http-transport:launch is the entry point
;;          -> http-transport:run
;;             -> 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 (http-transport: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

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

(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)))
	      
; 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 (rmt:send-receive-real remote apath dbname rid cmd params)
  (let* ((conn (rmt:get-connection remote apath dbname)))
    (assert conn "FATAL: Unable to connect to db "apath"/"dbname)
    (let* (;; (host    (rmt:conn-ipaddr conn))
	   ;; (port    (rmt:conn-port   conn))
	   (payload (sexpr->string params))
	   (res      (with-input-from-request
		      (rmt:conn->uri conn "api")
		      `((params . ,payload)
			(cmd    . ,cmd)
			(key    . "nokey"))
		      read-string)))
      (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
;;
(define (rmt:send-receive-server-start remote apath dbname)
  (let* ((conn (rmt:get-connection remote apath dbname)))
    (assert conn "FATAL: Unable to connect to db "apath"/"dbname)

;;  ./rununittest.sh server 1;(cd simplerun;megatest -stop-server 0)

(import rmtmod trace http-transportmod http-client apimod dbmod)
(trace-call-sites #t)
(trace
 ;; db:get-dbdat
 ;; rmt:find-main-server
 rmt:send-receive-real
 sexpr->string
 )

(test #f #t (rmt:remote? (let ((r (make-rmt:remote)))
			   (set! *rmt:remote* r)
			   r)))
(test #f #f (rmt:get-connection *rmt:remote* *toppath* ".db/main.db"))
(test #f #f (rmt:find-main-server *toppath* ".db/main.db"))
(test #f #t (rmt:open-main-connection *rmt:remote* *toppath*))
(pp (hash-table->alist (rmt:remote-conns *rmt:remote*)))
(test #f #t (rmt:conn? (rmt:get-connection *rmt:remote* *toppath* ".db/main.db")))

(define *main*  (rmt:get-connection *rmt:remote* *toppath* ".db/main.db"))

(for-each (lambda (tdat)
	    (test #f tdat (loop-test (rmt:conn-ipaddr *main*)
				     (rmt:conn-port *main*) tdat)))
	  (list 'a
		'(a "b" 123 1.23 )))
(test #f #f (rmt:send-receive 'ping #f 'hello))
(trace
 rmt:send-receive
 with-input-from-request
 rmt:get-connection
 with-input-from-request
 )