Index: client.scm ================================================================== --- client.scm +++ client.scm @@ -74,10 +74,13 @@ (remote-iface runremote) ":" (remote-port runremote)) #f)) +;; if successfully connected to a server runremote will be populated with appropriate info. +;; the result returned should not be used other than as an indicator of success +;; (define (client:setup areapath runremote #!key (remaining-tries 100) (failed-connects 0)(area-dat #f)) (mutex-lock! *rmt-mutex*) (let ((res (client:setup-http areapath runremote remaining-tries: remaining-tries failed-connects: failed-connects area-dat: area-dat))) (mutex-unlock! *rmt-mutex*) res)) @@ -92,11 +95,11 @@ ;; ;; Alternatively here, we can get the list of candidate servers and work our way ;; through them searching for a good one. ;; (let* ((server-dat (server:choose-server areapath 'best))) ;; list host port start-time server-id pid -;; (runremote (or area-dat *runremote*))) +;; (runremote (or runremote *runremote*))) (if (not server-dat) ;; no server found (begin (if (< remaining-tries 99)(thread-sleep! 1)) ;; obviously it needs time (client:setup-http areapath runremote remaining-tries: (- remaining-tries 1))) (match server-dat Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -327,11 +327,10 @@ (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 (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 @@ -249,11 +249,11 @@ (res (vector #f "uninitialized")) (success #t) (sparams (db:obj->string params transport: 'http)) (server-id (remote-server-id runremote))) (debug:print-info 11 *default-log-port* "cmd=" cmd " fullurl=" fullurl " server-id=" server-id " current time:" (current-seconds)) - + (assert fullurl "FATAL: http-transposrt:client-api-send-receive remote-api-req not set") ;; set up the http-client here (max-retry-attempts 1) ;; consider all requests indempotent (retry-request? (lambda (request) #f)) @@ -337,17 +337,19 @@ (handle-exceptions exn (begin (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 (and (args:any-defined? "-server" "-execute" "-run") - api-dat) + (if (not (args:get-arg "-server")) (begin ;; NOTE: Verify this actually ever gets hit. Jan 16, 2023. - (debug:print-info 0 *default-log-port* "Closing connections to "api-dat) - (close-connection! api-dat))) - (remote-conndat-set! runremote #f) - #t)) + (if api-dat + (begin + (debug:print-info 0 *default-log-port* "Closing connections to "api-dat) + (close-connection! api-dat))) + (remote-api-req-set! runremote #f) ;; use api-req as a flag for a working connection + #t) + #f))) #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 @@ -44,11 +44,11 @@ ;; 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) + (remote-api-req runremote) #f))) (if cinfo cinfo (if (server:check-if-running areapath) (client:setup areapath runremote) @@ -114,12 +114,12 @@ (begin (set! *runremote* (make-remote)) (let* ((server-info (remote-server-info *runremote*))) (if server-info (begin - (remote-server-url-set! *runremote* (server:record->url server-info)) - (remote-server-id-set! *runremote* (server:record->id server-info))))) + (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 ;; DOT SET_HOMEHOST; // leaving off - doesn't really add to the clarity ;; DOT MUTEXLOCK -> SET_HOMEHOST [label="no homehost?"]; ;; DOT SET_HOMEHOST -> MUTEXLOCK; @@ -129,16 +129,16 @@ (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) (cond - #;((> (- (current-seconds)(remote-connect-time runremote)) 180) ;; reconnect to server every 180 seconds - (debug:print 0 *default-log-port* "Forcing reconnect to server(s) due to 180 second timeout.") - (set! *runremote* #f) - ;; BUG: close-connections should go here? - (mutex-unlock! *rmt-mutex*) - (rmt:send-receive cmd rid params attemptnum: 1 area-dat: area-dat)) + ;; ((> (- (current-seconds)(remote-connect-time runremote)) 180) ;; reconnect to server every 180 seconds + ;; (debug:print 0 *default-log-port* "Forcing reconnect to server(s) due to 180 second timeout.") + ;; (set! *runremote* #f) + ;; ;; BUG: close-connections should go here? + ;; (mutex-unlock! *rmt-mutex*) + ;; (rmt:send-receive cmd rid params attemptnum: 1 area-dat: area-dat)) ;;DOT EXIT; ;;DOT MUTEXLOCK -> EXIT [label="> 15 attempts"]; {rank=same "case 1" "EXIT" } ;; give up if more than 150 attempts ((> attemptnum 150) @@ -176,11 +176,10 @@ (+ (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, forcing new connection.") (http-transport:close-connections runremote) ;; moving this setting of runremote conndat to #f to inside the http-transport:close-connections - ;; (remote-conndat-set! runremote #f) ;; invalidate the connection, thus forcing a new connection. (mutex-unlock! *rmt-mutex*) (rmt:send-receive cmd rid params attemptnum: attemptnum)) ;;DOT CASE5 [label="local\nread"]; ;;DOT MUTEXLOCK -> CASE5 [label="server not required,\non homehost,\nread-only query"]; {rank=same "case 5" CASE5}; @@ -254,18 +253,18 @@ ;;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-req 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-req runremote)))) ;; and no connection + (debug:print-info 12 *default-log-port* "rmt:send-receive, case 9, hh-dat: " (remote-hh-dat runremote) " conndat: " (remote-api-req 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 + (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";