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