Index: client.scm ================================================================== --- client.scm +++ client.scm @@ -56,10 +56,13 @@ (define (client:setup areapath #!key (remaining-tries 100) (failed-connects 0)) (case (server:get-transport) ((rpc) (rpc-transport:client-setup remaining-tries: remaining-tries failed-connects: failed-connects)) ;;(client:setup-rpc run-id)) ((http)(client:setup-http *runremote* areapath remaining-tries: remaining-tries failed-connects: failed-connects)) (else (rpc-transport:client-setup remaining-tries: remaining-tries failed-connects: failed-connects)))) ;; (client:setup-rpc run-id)))) + +(set-fn 'client:setup client:setup) + ;; Do all the connection work, look up the transport type and set up the ;; connection if required. ;; ;; There are two scenarios. Index: rmt.scm ================================================================== --- rmt.scm +++ rmt.scm @@ -29,10 +29,17 @@ (import rmtmod) (set-fn 'server:expiration-timeout server:expiration-timeout) (set-fn 'common:get-homehost common:get-homehost) (set-fn 'server:check-if-running server:check-if-running) (set-fn 'api:execute-requests api:execute-requests) +(set-fn 'http-transport:close-connections http-transport:close-connections ) +(set-fn 'http-transport:client-api-send-receive http-transport:client-api-send-receive) +(set-fn 'server:kind-run server:kind-run) +(set-fn 'server:start-and-wait server:start-and-wait) +(set-fn 'server:check-if-running server:check-if-running) +(set-fn 'server:ping server:ping ) +(set-fn 'common:force-server? common:force-server? ) ;; ;; THESE ARE ALL CALLED ON THE CLIENT SIDE!!! ;; @@ -688,11 +695,11 @@ (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 http-transport:client-api-send-receive ;; a +#;(set-functions http-transport:client-api-send-receive ;; a http-transport:close-connections ;; b api:execute-requests ;; c #f client:setup ;; e server:kind-run ;; f Index: rmtmod.scm ================================================================== --- rmtmod.scm +++ rmtmod.scm @@ -31,22 +31,22 @@ (include "common_records.scm") ;; Hack to make these functions visible to the refactored code, goal is to eliminate these over time. ;; (define (rmt:send-receive . params) #f) -(define (http-transport:close-connections . params) #f) -;; from remote defstruct in common.scm -;; (define (api:execute-requests . params) #f) -(define (http-transport:client-api-send-receive . params) #f) -(define (client:setup . params) #f) -(define (server:kind-run . params) #f) -(define (server:start-and-wait . params) #f) -(define (server:check-if-running . params) #f) -(define (server:ping . params) #f) -(define (common:force-server? . params) #f) +;; (define (http-transport:close-connections . params) #f) +;; ;; from remote defstruct in common.scm +;; ;; (define (api:execute-requests . params) #f) +;; (define (http-transport:client-api-send-receive . params) #f) +;; (define (client:setup . params) #f) +;; (define (server:kind-run . params) #f) +;; (define (server:start-and-wait . params) #f) +;; (define (server:check-if-running . params) #f) +;; (define (server:ping . params) #f) +;; (define (common:force-server? . params) #f) ;; 'send-receive rmt:send-receive ... -(define (set-functions . alldata) +#;(define (set-functions . alldata) (match alldata ((a b c d e f g h i j) ;; e f g h i j k l) (set! http-transport:client-api-send-receive a) (set! http-transport:close-connections b) @@ -127,11 +127,11 @@ (define (extras-transport-failed log-port rmt-mutex attemptnum runremote areapath cmd rid params alldat) (debug:print 0 log-port "WARNING: communication failed. Trying again, try num: " attemptnum) ;;(mutex-lock! rmt-mutex) (remote-conndat-set! runremote #f) - (http-transport:close-connections area-dat: runremote) + (exec-fn 'http-transport:close-connections area-dat: runremote) (remote-server-url-set! runremote #f) ;;(mutex-unlock! rmt-mutex) (debug:print-info 12 log-port "rmt:send-receive, case 9.1") (rmt:send-receive-orig log-port runremote rmt-mutex areapath cmd rid params alldat attemptnum: (+ attemptnum 1))) @@ -155,11 +155,11 @@ ;; want to ease off ;; the queries (let ((wait-delay (+ attemptnum (* attemptnum 10)))) (debug:print 0 log-port "WARNING: server is overloaded. Delaying " wait-delay " seconds and trying call again.") ;;(mutex-lock! rmt-mutex) - (http-transport:close-connections area-dat: runremote) + (exec-fn 'http-transport:close-connections area-dat: runremote) ;; (set! *runremote* #f) ;; force starting over (remote-server-url-set! runremote #f) ;; I am hoping this will force a redo on server connection. NOT TESTED ;;(mutex-unlock! rmt-mutex) (thread-sleep! wait-delay) (rmt:send-receive-orig log-port runremote rmt-mutex areapath cmd rid params alldat attemptnum: (+ attemptnum 1))) @@ -216,11 +216,11 @@ (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) + (exec-fn '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 alldat attemptnum: attemptnum)) @@ -235,13 +235,13 @@ ;; 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. + (not (exec-fn 'server:ping (remote-server-url runremote)))) ;; server has died. NOTE: this is not a cheap call! Need better approach. ;; (set! *runremote* (make-remote)) ;; WARNING - broken this. - (remote-force-server-set! runremote (common:force-server?)) + (remote-force-server-set! runremote (exec-fn '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 alldat attemptnum: attemptnum)) ;; on homehost and this is a write, we already have a server @@ -257,17 +257,17 @@ ((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 + (let ((server-url (exec-fn '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?)) + (if (exec-fn 'common:force-server?) + (exec-fn 'server:start-and-wait toppath) + (exec-fn 'server:kind-run toppath)))) + (remote-force-server-set! runremote (exec-fn '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 alldat)) ((or (and (remote-force-server runremote) ;; we are forcing a server and don't yet have a connection to one @@ -274,12 +274,12 @@ (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)) + (if (not (exec-fn 'server:check-if-running toppath)) ;; who knows, maybe one has started up? + (exec-fn 'server:start-and-wait toppath)) (remote-conndat-set! runremote (rmt:get-connection-info runremote 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 alldat attemptnum: attemptnum)) ;; TODO: add back-off timeout as ;; all set up if get this far, dispatch the query ((and (not (remote-force-server runremote)) @@ -303,11 +303,11 @@ ;; is needed to deal with ;; attemtped ;; communication to ;; servers that have gone ;; away - (http-transport:client-api-send-receive 0 conninfo cmd params) + (exec-fn '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 log-port "ERROR: transport " (remote-transport runremote) " not supported") (exit)))) @@ -317,11 +317,11 @@ (http-transport:server-dat-update-last-access conninfo) ;; refresh access time (begin (debug:print 0 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))) + (exec-fn 'http-transport:close-connections area-dat: runremote))) (debug:print-info 13 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 @@ -337,12 +337,12 @@ (cinfo (if (remote? runremote) (remote-conndat runremote) #f))) (if cinfo cinfo - (if (server:check-if-running areapath) - (client:setup runremote areapath) + (if (exec-fn 'server:check-if-running areapath) + (exec-fn 'client:setup runremote areapath) #f)))) ;;====================================================================== Index: tests/unittests/all-rmt.scm ================================================================== --- tests/unittests/all-rmt.scm +++ tests/unittests/all-rmt.scm @@ -68,11 +68,11 @@ (thread-sleep! 2) ;; (test #f #t (string? (server:start-and-wait *toppath*))) (test "setup for run" #t (begin (launch:setup) (string? (getenv "MT_RUN_AREA_HOME")))) -(test #f #t (client:setup-http toppath)) +(test #f #t (client:setup-http *runremote* toppath)) (test #f #t (vector? (client:setup toppath))) (test #f #t (vector? (rmt:get-connection-info toppath))) ;; TODO: push areapath down. (test #f #t (string? (server:check-if-running "."))) ;; DEF (test #f #f (rmt:send-receive-no-auto-client-setup *runremote* 'get-keys #f '()))