Index: client.scm ================================================================== --- client.scm +++ client.scm @@ -104,11 +104,11 @@ (debug:print-info 4 *default-log-port* "client:setup server-dat=" server-dat ", remaining-tries=" remaining-tries) (if (not runremote) (begin ;; Here we are creating a runremote where there was none or it was clobbered with #f ;; - (set! runremote (make-remote)) + (set! runremote (make-and-init-remote)) (let* ((server-info (server:check-if-running areapath))) (remote-server-info-set! runremote server-info) (if server-info (begin (remote-server-url-set! runremote (server:record->url server-info)) Index: rmt.scm ================================================================== --- rmt.scm +++ rmt.scm @@ -66,10 +66,15 @@ (cdr hh-dat) (begin (debug:print-info 0 *default-log-port* "hh-dat="hh-dat) #f)))) +(define (make-and-init-remote areapath) + (case (rmt:transport-mode) + ((http)(make-remote)) + ((tcp) (tt:make-remote areapath)) + (else #f))) ;;====================================================================== (define *send-receive-mutex* (make-mutex)) ;; should have separate mutex per run-id @@ -110,29 +115,37 @@ (runremote (or area-dat *runremote*)) (attemptnum (+ 1 attemptnum)) (readonly-mode (rmtmod:calc-ro-mode runremote *toppath*))) + (case (rmt:transport-mode) + ((http)(http-transport-handler runremote cmd rid params attemptnum area-dat areapath readonly-mode)) + ((tcp) (tcp-transport-handler runremote cmd rid params attemptnum area-dat areapath readonly-mode))))) + +(define (tcp-transport-handler runremote cmd rid params attemptnum area-dat areapath readonly-mode) + (if (not runremote) + (let* ((newremote (make-and-init-remote))) + (set! *runremote* newremote) + (set! runremote newremote))) + (let* ((dbfname (conc (dbfile:run-id->dbnum run-id)".db"))) ;;(dbfile:run-id->path areapath run-id))) + (tt:handler runremote cmd rid params attemptnum area-dat areapath readonly-mode dbfname))) + +(define (http-transport-handler runremote cmd rid params attemptnum area-dat areapath readonly-mode) ;; DOT INIT_RUNREMOTE; // leaving off - doesn't really add to the clarity ;; DOT MUTEXLOCK -> INIT_RUNREMOTE [label="no remote?"]; ;; DOT INIT_RUNREMOTE -> MUTEXLOCK; ;; ensure we have a record for our connection for given area (if (not runremote) ;; can remove this one. should never get here. (begin - (set! *runremote* (make-remote)) + (set! *runremote* (make-and-init-remote areapath)) (let* ((server-info (remote-server-info *runremote*))) - (if server-info + (if server-info (begin (remote-server-url-set! *runremote* (server:record->url server-info)) (remote-server-id-set! *runremote* (server:record->id server-info))))) (set! runremote *runremote*))) ;; new runremote will come from this on next iteration - (case (rmt:transport-mode) - ((http)(http-transport-handler runremote cmd rid params attemptnum area-dat areapath readonly-mode)) - ((tcp) (tcp-transport-handler runremote cmd rid params attemptnum area-dat areapath readonly-mode))))) - -(define (http-transport-handler runremote cmd rid params attemptnum area-dat areapath readonly-mode) ;; DOT SET_HOMEHOST; // leaving off - doesn't really add to the clarity ;; DOT MUTEXLOCK -> SET_HOMEHOST [label="no homehost?"]; ;; DOT SET_HOMEHOST -> MUTEXLOCK; ;; ensure we have a homehost record (if (or (not (pair? (remote-hh-dat runremote))) ;; not on homehost Index: server.scm ================================================================== --- server.scm +++ server.scm @@ -676,11 +676,11 @@ (else #f)))) (cond ((and (list? host-port) (eq? (length host-port) 2)) - (let* ((myrunremote (make-remote)) + (let* ((myrunremote (make-and-init-remote *toppath*)) (iface (car host-port)) (port (cadr host-port)) (server-dat (client:connect iface port server-id myrunremote)) (login-res (rmt:login-no-auto-client-setup myrunremote))) (http-transport:close-connections myrunremote) Index: tcp-transportmod.scm ================================================================== --- tcp-transportmod.scm +++ tcp-transportmod.scm @@ -39,29 +39,74 @@ ports commonmod ;; debugprint ) + +;;====================================================================== +;; client +;;====================================================================== ;; (define keep-age-param (make-parameter 10)) ;; qif file age, if over move to attic (defstruct tt (area #f) + (conns (make-hash-table)) ;; dbfname -> conn ) +(define (tt:make-remote areapath) + (make-tt area: areapath)) + +(define (tt:handler runremote cmd rid params attemptnum area-dat areapath readonly-mode dbfname) + ;; NOTE: areapath is passed in and in tt struct. We'll use passed in value for now. + (let* ((conn (hash-table-ref/default (tt-conns runremote) dbfname #f))) + (if conn + ;; have connection, call the server + (let* ((res (tt:send-receive runremote conn cmd rid params))) + (cond + ((member res '(busy starting)) + (thread-sleep! 1) + (tt:handler runremote cmd rid params attemptnum area-dat areapath readonly-mode dbfname)) + (else + res))) + ;; no conn yet, find and or start and find a server + (let* ((server (tt:find-server areapath dbfname))) + (if server + (let* ((conn (tt:server-connect server))) + (hash-table-set! (tt-conns runremote) dbfname conn) + (tt:handler runremote cmd rid params attemptnum area-dat areapath readonly-mode dbfname)) + ;; no server, try to start one + (begin + (tt:start-server areapath dbfname) + (thread-sleep! 1) + (tt:handler runremote cmd rid params attemptnum area-dat areapath readonly-mode dbfname))))))) + (define (tt:bid-for-servership run-id) #f) (define (tt:get-current-server run-id) #f) -(define (tt:send-receive ttdat run-id cmd params) +(define (tt:send-receive ttdat conn cmd run-id params) #f) + +;;====================================================================== +;; server +;;====================================================================== (define (tt:sync-dbs ttdat) #f) + +(define (tt:start-server ttdat) + #f) + +(define (tt:server-connect ttdat) + #f) + +(define (tt:find-server ttdat) + #f) (define (tt:shutdown-server ttdat) #f)