@@ -41,220 +41,43 @@ ;;====================================================================== ;; S U P P O R T F U N C T I O N S ;;====================================================================== -;; 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 #!key (area-dat #f)) ;; TODO: push areapath down. - (let* ((runremote (or area-dat *runremote*)) - (cinfo (if (remote? runremote) - (remote-conndat runremote) - #f))) - (if cinfo - cinfo - (if (server:check-if-running areapath) - (client:setup areapath) - #f)))) - (define *send-receive-mutex* (make-mutex)) ;; should have separate mutex per run-id - +(define *runremote* (make-remote)) ;; this entry point can decide based on cmd whether to dispatch to old api calls via remote or via ulex ;; (define (rmt:send-receive cmd rid params #!key (attemptnum 1)(area-dat #f)) (let* ((areapath *toppath*);; TODO - resolve from dbstruct to be compatible with multiple areas (runremote (or area-dat *runremote*))) ;; ensure we have a record for our connection for given area - (if (not runremote) ;; can remove this one. should never get here. + (if (not (remote-hh-dat runremote)) (begin - (set! *runremote* (make-remote)) - (set! runremote *runremote*) (remote-server-timeout-set! runremote (server:expiration-timeout)) - (remote-hh-dat-set! runremote (common:get-homehost )) + (remote-hh-dat-set! runremote (common:get-homehost)) )) ;; new runremote will come from this on next iteration - - (if (member cmd '(blah)) - (begin - (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 areapath))) - (rmtmod:send-receive-ulex ulex:conn cmd rid params attemptnum area-dat))) - (rmt:send-receive-orig *default-log-port* runremote *rmt-mutex* areapath *db-multi-sync-mutex* cmd rid params attemptnum: attemptnum area-dat: area-dat ro-queries: api:read-only-queries)))) - -;; RA => e.g. usage (rmt:send-receive 'get-var #f (list varname)) -;; -;; add multi-sync-mutex -;; -(define (rmt:send-receive-orig log-port runremote rmt-mutex toppath multi-sync-mutex 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) - - ;; 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))) - - ;; ensure we have a homehost record - (if (not (pair? (remote-hh-dat runremote))) ;; not on homehost + + ;; ensure we have a homehost record, do this here instead of in -orig + (if (or (not (remote-hh-dat runremote)) + (not (pair? (remote-hh-dat runremote)))) ;; not on homehost (remote-hh-dat-set! runremote (common:get-homehost))) - - ;;(print "BB> readonly-mode is "readonly-mode" dbfile is "dbfile) - (cond - ;; give up if more than 15 attempts - ((> attemptnum 15) - (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 log-port "rmt:send-receive, case 2") - (rmt:open-qry-close-locally log-port multi-sync-mutex cmd 0 params ro-queries: api:read-only-queries) - ) - - ;; readonly mode, write request. Do nothing, return #f - (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) - ;; - ;; reset the connection if it has been unused too long - ((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 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 log-port runremote rmt-mutex toppath multi-sync-mutex 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 log-port "rmt:send-receive, case 5") - (rmt:open-qry-close-locally log-port multi-sync-mutex cmd 0 params ro-queries: api:read-only-queries)) - - ;; 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 log-port "rmt:send-receive, case 6") - (rmt:send-receive-orig log-port runremote rmt-mutex toppath multi-sync-mutex 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 log-port "rmt:send-receive, case 4.1") - (rmt:open-qry-close-locally log-port multi-sync-mutex cmd 0 params ro-queries: api:read-only-queries)) - - ;; 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 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)))) - (remote-force-server-set! runremote (common:force-server?)) - ;; (mutex-unlock! rmt-mutex) - (debug:print-info 12 log-port "rmt:send-receive, case 8.1") - (rmt:open-qry-close-locally log-port multi-sync-mutex cmd 0 params ro-queries: api:read-only-queries)) - - ((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 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 multi-sync-mutex 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 log-port "rmt:send-receive, case 10") - (rmt:open-qry-close-locally log-port multi-sync-mutex cmd (if rid rid 0) params ro-queries: api:read-only-queries)) - - ;; not on homehost, do server query - (else (extras-case-11 log-port runremote cmd params attemptnum rid))))) + + (if (member cmd '(blah)) + (begin + (mutex-lock! *send-receive-mutex*) + (let ((ulex:conn (remote-ulex:conn runremote))) + (if (not ulex:conn)(remote-ulex:conn-set! runremote (rmtmod:setup-ulex areapath))) + (rmtmod:send-receive-ulex ulex:conn cmd rid params attemptnum area-dat))) + (rmt:send-receive-orig *default-log-port* runremote *rmt-mutex* areapath *db-multi-sync-mutex* cmd rid params attemptnum: attemptnum area-dat: area-dat ro-queries: api:read-only-queries)))) ;; 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) - ;; (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)) - (dat (case (remote-transport runremote) - ((http) (condition-case ;; handling here has - ;; caused a lot of - ;; problems. However it - ;; is needed to deal with - ;; attemtped - ;; communication to - ;; servers that have gone - ;; away - (http-transport:client-api-send-receive 0 conninfo cmd params) - ((commfail)(vector #f "communications fail")) - ((exn)(vector #f "other fail" (print-call-chain))))) - (else - (debug:print 0 *default-log-port* "ERROR: transport " (remote-transport runremote) " not supported") - (exit)))) - (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))) - (http-transport:server-dat-update-last-access conninfo) ;; refresh access time - (begin - (debug:print 0 *default-log-port* "INFO: Should not get here! conninfo=" conninfo) - (set! conninfo #f) - (remote-conndat-set! *runremote* #f) ;; NOTE: *runremote* is global copy of runremote. Purpose: factor out global. - (http-transport:close-connections area-dat: runremote))) - (debug:print-info 13 *default-log-port* "rmt:send-receive, case 9. conninfo=" conninfo " 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) - (extras-transport-failed *default-log-port* *rmt-mutex* attemptnum runremote cmd rid params) - ))) - ;; (define (rmt:update-db-stats run-id rawcmd params duration) ;; (mutex-lock! *db-stats-mutex*) ;; (handle-exceptions ;; exn ;; (begin @@ -864,13 +687,16 @@ (rmt:send-receive 'test-set-archive-block-id run-id (list run-id test-id archive-block-id))) (define (rmt:test-get-archive-block-info archive-block-id) (rmt:send-receive 'test-get-archive-block-info #f (list archive-block-id))) -(set-functions rmt:send-receive remote-server-url-set! - http-transport:close-connections remote-conndat-set! - debug:print debug:print-info - debug:print-error - remote-ro-mode remote-ro-mode-set! - remote-ro-mode-checked-set! remote-ro-mode-checked - #f #f - api:execute-requests api:read-only-queries) +(set-functions http-transport:client-api-send-receive ;; a + http-transport:close-connections ;; b + api:execute-requests ;; c + api:read-only-queries ;; d + client:setup ;; e + server:kind-run ;; f + server:start-and-wait ;; g + server:check-if-running ;; h + server:ping ;; i + common:force-server? ;; j + )