Index: rmtmod.scm
==================================================================
--- rmtmod.scm
+++ rmtmod.scm
@@ -206,11 +206,11 @@
;;
;; else setup a connection
;;
;; if that fails, return '(#f "some reason") ;; NB// convert to raising an exception
;;
-(define (rmt:get-connection remote apath dbname)
+(define (rmt:get-conn remote apath dbname)
(let* ((fullname (db:dbname->path apath dbname)) ;; we'll switch to full name later
(conn (hash-table-ref/default (rmt:remote-conns remote) dbname #f)))
(if (and conn
(< (current-seconds) (rmt:conn-expires conn)))
conn
@@ -258,38 +258,33 @@
))
#t)
(start-main-srv)))
(start-main-srv))))
-(define (rmt:main-open-connection remote apath)
- (rmt:open-main-connection remote apath)
- (rmt:get-connection remote apath (db:run-id->dbname #f)))
-
;; NB// remote is a rmt:remote struct
;;
(define (rmt:general-open-connection remote apath dbname #!key (num-tries 5))
- (let ((mainconn (rmt:get-connection remote apath (db:run-id->dbname #f))))
- ;; (debug:print 0 *default-log-port* "remote: " remote)
- (if (not mainconn)
- (begin
- (rmt:open-main-connection remote apath)
- (thread-sleep! 2)
- (rmt:general-open-connection remote apath dbname))
- ;; we have a connection to main, ask for contact info for dbname
- (let* ((res (rmt:send-receive-real remote apath dbname 'get-server #f `(,apath ,dbname))))
- (case res
- ((server-started)
- (if (> num-tries 0)
- (begin
- (thread-sleep! 2)
- (rmt:general-open-connection remote apath dbname
- num-tries: (- num-tries 1)))
- 'failed))
-
- (else
- (debug:print-info 0 *default-log-port* "Unexpected result: " res)
- res))))))
+ (cond
+ ((not (rmt:get-conn remote apath (db:run-id->dbname #f))) ;; no channel open to main?
+ (rmt:open-main-connection remote apath)
+ (thread-sleep! 2)
+ (rmt:general-open-connection remote apath dbname))
+ ((not (rmt:get-conn remote apath dbname)) ;; no channel open to dbname?
+ (let* ((res (rmt:send-receive-real remote apath dbname #f 'get-server `(,apath ,dbname))))
+ (case res
+ ((server-started)
+ (if (> num-tries 0)
+ (begin
+ (thread-sleep! 2)
+ (rmt:general-open-connection remote apath dbname
+ num-tries: (- num-tries 1)))
+ (begin
+ (debug:print-error 0 *default-log-port* "Failed to start servers needed or open channel to "apath", "dbname)
+ (exit 1))))
+ (else
+ (debug:print-info 0 *default-log-port* "Unexpected result: " res)
+ res))))))
;;======================================================================
;; Defaults to current area
;;
@@ -296,52 +291,42 @@
(define (rmt:send-receive cmd rid params #!key (attemptnum 1)(area-dat #f))
(if (not *rmt:remote*)(set! *rmt:remote* (make-rmt:remote)))
(let* ((apath *toppath*)
(conns *rmt:remote*)
(dbname (db:run-id->dbname rid)))
+ (rmt:general-open-connection conns apath dbname)
(rmt:send-receive-real conns apath dbname rid cmd params)))
;; 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 rid cmd params)
- (let* ((conn (rmt:get-connection remote apath dbname)))
- (if conn
- (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))
- ;; no conn yet, start it up
- (begin
- (rmt:general-open-connection remote apath dbname)
- (rmt:send-receive-real remote apath dbname rid cmd params)))))
+ (let* ((conn (rmt:get-conn remote apath dbname)))
+ (assert conn "FATAL: rmt:send-receive-real called without the needed channels opened")
+ (let* ((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.
;;
;; 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-connection remote apath dbname)))
+ (let* ((conn (rmt:get-conn 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") ;; (conc "http://"host":"port"/api")
- `((params . (,apath ,dbname))
- ;; (cmd . ,cmd)
- #;(key . "nokey"))
+ (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"
Index: tests/unittests/basicserver.scm
==================================================================
--- tests/unittests/basicserver.scm
+++ tests/unittests/basicserver.scm
@@ -33,11 +33,11 @@
;; sexpr->string
;; server-ready?
;; rmt:register-server
;; rmt:open-main-connection
;; rmt:general-open-connection
- ;; rmt:get-connection
+ ;; rmt:get-conny
;; common:watchdog
;; rmt:find-main-server
;; get-all-server-pkts
;; get-viable-servers
;; get-best-candidate
@@ -45,29 +45,37 @@
)
(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:get-conn *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")))
+(test #f #t (rmt:conn? (rmt:get-conn *rmt:remote* *toppath* ".db/main.db")))
-(define *main* (rmt:get-connection *rmt:remote* *toppath* ".db/main.db"))
+(define *main* (rmt:get-conn *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 #t (number? (rmt:send-receive 'ping #f 'hello)))
(define *db* (db:setup #f))
+
+;; these let me cut and paste from source easily
+(define apath *toppath*)
+(define dbname ".db/1.db")
+(define remote *rmt:remote*)
+
(test #f 'server-started (api:execute-requests *db* 'get-server (list *toppath* ".db/1.db")))
(set! *dbstruct-db* #f)
-(test #f 'server-started (rmt:general-open-connection *rmt:remote* *toppath* ".db/1.db"))
+(test #f #t (rmt:open-main-connection remote apath))
+(test #f 'server-started (rmt:send-receive-real remote apath ".db/main.db" #f 'get-server `(,apath ,dbname)))
+
(thread-sleep! 2)
(test #f 'server-started (rmt:general-open-connection *rmt:remote* *toppath* ".db/1.db"))
(test #f '("SYSTEM" "RELEASE") (rmt:get-keys))
(test #f 1 (rmt:register-run '(("SYSTEM" "a")("RELEASE" "b")) "run1" "new" "n/a" "justme" #f))