Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -327,11 +327,11 @@ (server-id #f) (server-info #f) ;; (if *toppath* (server:check-if-running *toppath*) #f)) (last-server-check 0) ;; last time we checked to see if the server was alive (connect-time (current-seconds)) ;; when we first connected (last-access (current-seconds)) ;; last time we talked to server - (conndat #f) ;; iface port api-uri api-url api-req seconds server-id + ;; (conndat #f) ;; iface port api-uri api-url api-req seconds server-id (server-timeout (server:expiration-timeout)) (force-server #f) (ro-mode #f) (ro-mode-checked #f) ;; flag that indicates we have checked for ro-mode Index: http-transport.scm ================================================================== --- http-transport.scm +++ http-transport.scm @@ -340,11 +340,15 @@ (print-call-chain *default-log-port*) (debug:print-error 0 *default-log-port* " closing connection failed with error: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn)) (if (args:any-defined? "-server" "-execute" "-run") (debug:print-info 0 *default-log-port* "Closing connections to "api-dat)) (if api-dat (close-connection! api-dat)) - (remote-conndat-set! runremote #f) + + ;; Would it be better to set *runremote* to #f? I don't think so. But we may + ;; need to clear more of the runremote fields + (remote-api-url-set! runremote #f) ;; used as a flag for connection up and running + #t)) #f)) ;; 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. Index: rmt.scm ================================================================== --- rmt.scm +++ rmt.scm @@ -43,18 +43,19 @@ ;; if a server is either running or in the process of starting call client:setup ;; else return #f to let the calling proc know that there is no server available ;; (define (rmt:get-connection-info areapath runremote) ;; TODO: push areapath down. - (let* ((cinfo (if (remote? runremote) - (remote-conndat runremote) + (let* ((cinfo (if (and (remote? runremote) + (remote-api-url runremote)) ;; we have a connection + runremote #f))) - (if cinfo - cinfo - (if (server:check-if-running areapath) - (client:setup areapath runremote) - #f)))) + (if cinfo + cinfo + (if (server:check-if-running areapath) + (client:setup areapath runremote) + #f)))) (define (rmt:on-homehost? runremote) (let* ((hh-dat (remote-hh-dat runremote))) (if (pair? hh-dat) (cdr hh-dat) @@ -122,11 +123,12 @@ ;; 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 (not (pair? (remote-hh-dat runremote))) ;; not on homehost + (if (or (not (pair? (remote-hh-dat runremote))) ;; not on homehost + (not (cdr (remote-hh-dat runremote)))) ;; not on homehost (thread-sleep! 0.1) ;; since we shouldn't get here, delay a little (let ((hh-data (server:choose-server areapath 'homehost))) (remote-hh-dat-set! runremote (or hh-data (cons #f #f))))) ;;(print "BB> readonly-mode is "readonly-mode" dbfile is "dbfile) @@ -169,11 +171,11 @@ ;;DOT CASE4 [label="reset\nconnection"]; ;;DOT MUTEXLOCK -> CASE4 [label="have connection,\nlast_access > expire_time"]; {rank=same "case 4" CASE4} ;;DOT CASE4 -> "rmt:send-receive"; ;; reset the connection if it has been unused too long ((and runremote - (remote-conndat runremote) + (remote-api-url runremote) (> (current-seconds) ;; if it has been more than server-timeout seconds since last contact, close this connection and start a new on (+ (remote-last-access runremote) (remote-server-timeout runremote)))) (debug:print-info 0 *default-log-port* "Connection to " (remote-server-url runremote) " expired due to no accesses in " (remote-server-timeout runremote) " seconds, forcing new connection.") (http-transport:close-connections runremote) @@ -254,18 +256,19 @@ ;;DOT CASE9 [label="force server\nnot on homehost"]; ;;DOT MUTEXLOCK -> CASE9 [label="no connection\nand either require server\nor not on homehost"]; {rank=same "case 9" CASE9}; ;;DOT CASE9 -> "start\nserver" -> "rmt:send-receive"; ((or (and (remote-force-server runremote) ;; we are forcing a server and don't yet have a connection to one - (not (remote-conndat runremote))) + (not (remote-api-url runremote))) (and (not (cdr (remote-hh-dat runremote))) ;; not on a homehost - (not (remote-conndat runremote)))) ;; and no connection - (debug:print-info 12 *default-log-port* "rmt:send-receive, case 9, hh-dat: " (remote-hh-dat runremote) " conndat: " (remote-conndat runremote)) + (not (remote-api-url runremote)))) ;; and no connection + (debug:print-info 12 *default-log-port* "rmt:send-receive, case 9, hh-dat: " (remote-hh-dat runremote) " runremote: " (remote->alist runremote)) (mutex-unlock! *rmt-mutex*) (if (not (server:check-if-running *toppath*)) ;; who knows, maybe one has started up? (server:start-and-wait *toppath*)) - (remote-conndat-set! runremote (rmt:get-connection-info *toppath* runremote)) ;; calls client:setup which calls client:setup-http + ;; was: (remote-conndat-set! runremote (rmt:get-connection-info *toppath* runremote)) ;; calls client:setup which calls client:setup-http + (set! runremote (rmt:get-connection-info *toppath* runremote)) ;; calls client:setup which calls client:setup-http (rmt:send-receive cmd rid params attemptnum: attemptnum)) ;; TODO: add back-off timeout as ;;DOT CASE10 [label="on homehost"]; ;;DOT MUTEXLOCK -> CASE10 [label="server not required,\non homehost"]; {rank=same "case 10" CASE10}; ;;DOT CASE10 -> "rmt:open-qry-close-locally"; @@ -289,11 +292,11 @@ (define (extras-case-11 *default-log-port* runremote cmd params attemptnum rid) ;; (mutex-unlock! *rmt-mutex*) (debug:print-info 12 *default-log-port* "rmt:send-receive, case 9") ;; (mutex-lock! *rmt-mutex*) - (let* ((conninfo (remote-conndat runremote)) + (let* (;; (conninfo (remote-conndat runremote)) (dat-in (condition-case ;; handling here has ;; caused a lot of ;; problems. However it ;; is needed to deal with ;; attemtped @@ -309,17 +312,18 @@ (> (vector-length dat-in) 1)) dat-in (vector #f (conc "communications fail (type 2), dat-in=" dat-in)))) (success (if (vector? dat) (vector-ref dat 0) #f)) (res (if (vector? dat) (vector-ref dat 1) #f))) - (if (and (vector? conninfo) (< 5 (vector-length conninfo))) + (if (and (remote? runremote) + (remote-api-url runremote)) ;; (and (vector? conninfo) (< 5 (vector-length conninfo))) (remote-last-access-set! runremote (current-seconds)) ;; refresh access time (begin - (debug:print 0 *default-log-port* "INFO: Should not get here! conninfo=" conninfo) - (set! conninfo #f) + (debug:print 0 *default-log-port* "INFO: Should not get here! runremote="(remote->alist runremote)) + ;; (set! conninfo #f) (http-transport:close-connections runremote))) - (debug:print-info 13 *default-log-port* "rmt:send-receive, case 9. conninfo=" conninfo " dat=" dat " runremote = " runremote) + (debug:print-info 13 *default-log-port* "rmt:send-receive, case 9. runremote=" (remote->alist runremote) " dat=" dat " runremote = " runremote) (mutex-unlock! *rmt-mutex*) (if success ;; success only tells us that the transport was ;; successful, have to examine the data to see if ;; there was a detected issue at the other end (extras-transport-succeded *default-log-port* *rmt-mutex* attemptnum runremote res params rid cmd)