Index: rmt.scm ================================================================== --- rmt.scm +++ rmt.scm @@ -76,31 +76,31 @@ (mutex-lock! *send-receive-mutex*) (if (not *runremote*)(set! *runremote* (make-remote))) (let ((ulex:conn (remote-ulex:conn *runremote*))) (if (not ulex:conn)(remote-ulex:conn-set! *runremote* (rmtmod:setup-ulex *toppath*))) (rmtmod:send-receive-ulex ulex:conn cmd rid params attemptnum area-dat))) - (rmt:send-receive-orig runremote *rmt-mutex* areapath cmd rid params attemptnum: attemptnum area-dat: area-dat)))) + (rmt:send-receive-orig *default-log-port* runremote *rmt-mutex* areapath cmd rid params attemptnum: attemptnum area-dat: area-dat)))) ;; RA => e.g. usage (rmt:send-receive 'get-var #f (list varname)) ;; -(define (rmt:send-receive-orig runremote rmt-mutex toppath cmd rid params #!key (attemptnum 1)(area-dat #f)) ;; start attemptnum at 1 so the modulo below works as expected +(define (rmt:send-receive-orig log-port runremote rmt-mutex toppath cmd rid params #!key (attemptnum 1)(area-dat #f)) ;; start attemptnum at 1 so the modulo below works as expected #;(common:telemetry-log (conc "rmt:"(->string cmd)) payload: `((rid . ,rid) (params . ,params))) ;; do all the prep locked under the rmt-mutex - (mutex-lock! *rmt-mutex*) + (mutex-lock! rmt-mutex) ;; 1. check if server is started IFF cmd is a write OR if we are not on the homehost, store in runremote ;; 2. check the age of the connections. refresh the connection if it is older than timeout-20 seconds. ;; 3. do the query, if on homehost use local access ;; (let* ((start-time (current-seconds)) ;; snapshot time so all use cases get same value - (readonly-mode (rmtmod:calc-ro-mode runremote *toppath*))) + (readonly-mode (rmtmod:calc-ro-mode runremote toppath))) ;; ensure we have a homehost record (if (not (pair? (remote-hh-dat runremote))) ;; not on homehost (thread-sleep! 0.1) ;; since we shouldn't get here, delay a little (remote-hh-dat-set! runremote (common:get-homehost))) @@ -107,23 +107,23 @@ ;;(print "BB> readonly-mode is "readonly-mode" dbfile is "dbfile) (cond ;; give up if more than 15 attempts ((> attemptnum 15) - (debug:print 0 *default-log-port* "ERROR: 15 tries to start/connect to server. Giving up.") + (debug:print 0 log-port "ERROR: 15 tries to start/connect to server. Giving up.") (exit 1)) ;; readonly mode, read request- handle it - case 2 ((and readonly-mode (member cmd api:read-only-queries)) - (mutex-unlock! *rmt-mutex*) - (debug:print-info 12 *default-log-port* "rmt:send-receive, case 2") + (mutex-unlock! rmt-mutex) + (debug:print-info 12 log-port "rmt:send-receive, case 2") (rmt:open-qry-close-locally cmd 0 params) ) ;; readonly mode, write request. Do nothing, return #f - (readonly-mode (extras-readonly-mode *rmt-mutex* *default-log-port* cmd params)) + (readonly-mode (extras-readonly-mode rmt-mutex log-port cmd params)) ;; This block was for pre-emptively resetting the connection if there had been no communication for some time. ;; I don't think it adds any value. If the server is not there, just fail and start a new connection. ;; also, the expire-time calculation might not be correct. We want, time-since-last-server-access > (server:get-timeout) ;; @@ -131,82 +131,82 @@ ((and runremote (remote-conndat runremote) (> (current-seconds) ;; if it has been more than server-timeout seconds since last contact, close this connection and start a new on (+ (http-transport:server-dat-get-last-access (remote-conndat 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.") + (debug:print-info 0 log-port "Connection to " (remote-server-url runremote) " expired due to no accesses, forcing new connection.") (http-transport:close-connections area-dat: runremote) (remote-conndat-set! runremote #f) ;; invalidate the connection, thus forcing a new connection. - (mutex-unlock! *rmt-mutex*) - (rmt:send-receive-orig runremote rmt-mutex toppath cmd rid params attemptnum: attemptnum)) + (mutex-unlock! rmt-mutex) + (rmt:send-receive-orig log-port runremote rmt-mutex toppath cmd rid params attemptnum: attemptnum)) ;; on homehost and this is a read ((and (not (remote-force-server runremote)) ;; honor forced use of server, i.e. server NOT required (cdr (remote-hh-dat runremote)) ;; on homehost (member cmd api:read-only-queries)) ;; this is a read - (mutex-unlock! *rmt-mutex*) - (debug:print-info 12 *default-log-port* "rmt:send-receive, case 5") + (mutex-unlock! rmt-mutex) + (debug:print-info 12 log-port "rmt:send-receive, case 5") (rmt:open-qry-close-locally cmd 0 params)) ;; on homehost and this is a write, we already have a server, but server has died ((and (cdr (remote-hh-dat runremote)) ;; on homehost (not (member cmd api:read-only-queries)) ;; this is a write (remote-server-url runremote) ;; have a server (not (server:ping (remote-server-url runremote)))) ;; server has died. NOTE: this is not a cheap call! Need better approach. (set! *runremote* (make-remote)) (remote-force-server-set! runremote (common:force-server?)) - (mutex-unlock! *rmt-mutex*) - (debug:print-info 12 *default-log-port* "rmt:send-receive, case 6") - (rmt:send-receive-orig runremote rmt-mutex toppath cmd rid params attemptnum: attemptnum)) + (mutex-unlock! rmt-mutex) + (debug:print-info 12 log-port "rmt:send-receive, case 6") + (rmt:send-receive-orig log-port runremote rmt-mutex toppath cmd rid params attemptnum: attemptnum)) ;; on homehost and this is a write, we already have a server ((and (not (remote-force-server runremote)) ;; honor forced use of server, i.e. server NOT required (cdr (remote-hh-dat runremote)) ;; on homehost (not (member cmd api:read-only-queries)) ;; this is a write (remote-server-url runremote)) ;; have a server - (mutex-unlock! *rmt-mutex*) - (debug:print-info 12 *default-log-port* "rmt:send-receive, case 4.1") + (mutex-unlock! rmt-mutex) + (debug:print-info 12 log-port "rmt:send-receive, case 4.1") (rmt:open-qry-close-locally cmd 0 params)) ;; on homehost, no server contact made and this is a write, passively start a server ((and (not (remote-force-server runremote)) ;; honor forced use of server, i.e. server NOT required (cdr (remote-hh-dat runremote)) ;; have homehost (not (remote-server-url runremote)) ;; no connection yet (not (member cmd api:read-only-queries))) ;; not a read-only query - (debug:print-info 12 *default-log-port* "rmt:send-receive, case 8") - (let ((server-url (server:check-if-running *toppath*))) ;; (server:read-dotserver->url *toppath*))) ;; (server:check-if-running *toppath*))) ;; Do NOT want to run server:check-if-running - very expensive to do for every write call + (debug:print-info 12 log-port "rmt:send-receive, case 8") + (let ((server-url (server:check-if-running toppath))) ;; (server:read-dotserver->url toppath))) ;; (server:check-if-running toppath))) ;; Do NOT want to run server:check-if-running - very expensive to do for every write call (if server-url (remote-server-url-set! runremote server-url) ;; the string can be consumed by the client setup if needed (if (common:force-server?) - (server:start-and-wait *toppath*) - (server:kind-run *toppath*)))) + (server:start-and-wait toppath) + (server:kind-run toppath)))) (remote-force-server-set! runremote (common:force-server?)) - (mutex-unlock! *rmt-mutex*) - (debug:print-info 12 *default-log-port* "rmt:send-receive, case 8.1") + (mutex-unlock! rmt-mutex) + (debug:print-info 12 log-port "rmt:send-receive, case 8.1") (rmt:open-qry-close-locally cmd 0 params)) ((or (and (remote-force-server runremote) ;; we are forcing a server and don't yet have a connection to one (not (remote-conndat 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)) - (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*)) ;; calls client:setup which calls client:setup-http - (rmt:send-receive-orig runremote rmt-mutex toppath cmd rid params attemptnum: attemptnum)) ;; TODO: add back-off timeout as + (debug:print-info 12 log-port "rmt:send-receive, case 9, hh-dat: " (remote-hh-dat runremote) " conndat: " (remote-conndat 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)) ;; calls client:setup which calls client:setup-http + (rmt:send-receive-orig log-port runremote rmt-mutex toppath cmd rid params attemptnum: attemptnum)) ;; TODO: add back-off timeout as ;; all set up if get this far, dispatch the query ((and (not (remote-force-server runremote)) (cdr (remote-hh-dat runremote))) ;; we are on homehost - (mutex-unlock! *rmt-mutex*) - (debug:print-info 12 *default-log-port* "rmt:send-receive, case 10") + (mutex-unlock! rmt-mutex) + (debug:print-info 12 log-port "rmt:send-receive, case 10") (rmt:open-qry-close-locally cmd (if rid rid 0) params)) ;; not on homehost, do server query - (else (extras-case-11 *default-log-port* runremote cmd params attemptnum rid))))) + (else (extras-case-11 log-port runremote cmd params attemptnum rid))))) ;; bunch of small functions factored out of send-receive to make debug easier ;; (define (extras-case-11 *default-log-port* runremote cmd params attemptnum rid)