Overview
Comment: | All work-arounds in place. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.65-wip |
Files: | files | file ages | folders |
SHA1: |
129edccbd5f34d3128bbb177bd104bad |
User & Date: | mrwellan on 2019-10-14 16:52:17 |
Other Links: | branch diff | manifest | tags |
Context
2019-10-15
| ||
04:29 | Added mod files (but they are not used yet). check-in: fc8c642fb9 user: matt tags: v1.65-wip | |
2019-10-14
| ||
16:52 | All work-arounds in place. check-in: 129edccbd5 user: mrwellan tags: v1.65-wip | |
15:45 | Mostly working eh. check-in: a1f5573562 user: mrwellan tags: v1.65-wip | |
Changes
Modified client.scm from [a2fb10e089] to [e9fa0c3f2e].
︙ | ︙ | |||
54 55 56 57 58 59 60 61 62 63 64 65 66 67 | (else (rpc:client-connect iface port)))) (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)))) ;; Do all the connection work, look up the transport type and set up the ;; connection if required. ;; ;; There are two scenarios. ;; 1. We are a test manager and we received *transport-type* and *runremote* via cmdline ;; 2. We are a run tests, list runs or other interactive process and we must figure out | > > > | 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 | (else (rpc:client-connect iface port)))) (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. ;; 1. We are a test manager and we received *transport-type* and *runremote* via cmdline ;; 2. We are a run tests, list runs or other interactive process and we must figure out |
︙ | ︙ |
Modified rmt.scm from [22e7a4ebaa] to [3b9540724d].
︙ | ︙ | |||
27 28 29 30 31 32 33 34 35 36 37 38 39 40 | (declare (uses rmtmod)) (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) ;; ;; THESE ARE ALL CALLED ON THE CLIENT SIDE!!! ;; ;; generate entries for ~/.megatestrc with the following ;; | > > > > > > > | 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 | (declare (uses rmtmod)) (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!!! ;; ;; generate entries for ~/.megatestrc with the following ;; |
︙ | ︙ | |||
686 687 688 689 690 691 692 | (define (rmt:test-set-archive-block-id run-id test-id archive-block-id) (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))) | | | 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 | (define (rmt:test-set-archive-block-id run-id test-id archive-block-id) (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 http-transport:close-connections ;; b api:execute-requests ;; c #f client:setup ;; e server:kind-run ;; f server:start-and-wait ;; g server:check-if-running ;; h server:ping ;; i common:force-server? ;; j ) |
Modified rmtmod.scm from [aaea546575] to [798b93ee00].
︙ | ︙ | |||
29 30 31 32 33 34 35 | (import commonmod) (use (prefix ulex ulex:)) (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) | | | | | | | | | | | | | 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 | (import commonmod) (use (prefix ulex ulex:)) (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) ;; 'send-receive rmt:send-receive ... #;(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) ;; (set! api:execute-requests c) ;; d |
︙ | ︙ | |||
125 126 127 128 129 130 131 | (debug:print 0 log-port "WARNING: write transaction requested on a readonly area. cmd="cmd" params="params) #f) (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) | | | 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 | (debug:print 0 log-port "WARNING: write transaction requested on a readonly area. cmd="cmd" params="params) #f) (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) (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))) (define (extras-transport-succeded log-port rmt-mutex attemptnum runremote areapath res params rid cmd alldat) (if (and (vector? res) |
︙ | ︙ | |||
153 154 155 156 157 158 159 | ;; server is ;; overloaded and we ;; 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) | | | 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 | ;; server is ;; overloaded and we ;; 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) (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))) res)) ;; All good, return res |
︙ | ︙ | |||
214 215 216 217 218 219 220 | ;; 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.") | | | | | | | | | | | | 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 | ;; 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.") (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)) ;; on homehost and this is a read ((and (not (remote-force-server runremote)) ;; honor forced use of server, i.e. server NOT required (pair? (remote-hh-dat runremote)) (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 alldat)) ;; 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 (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 (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 ((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 alldat)) ;; 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 (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 (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 (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 (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)) (cdr (remote-hh-dat runremote))) ;; we are on homehost ;;(mutex-unlock! rmt-mutex) |
︙ | ︙ | |||
301 302 303 304 305 306 307 | ;; caused a lot of ;; problems. However it ;; is needed to deal with ;; attemtped ;; communication to ;; servers that have gone ;; away | | | | | | 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 | ;; caused a lot of ;; problems. However it ;; is needed to deal with ;; attemtped ;; communication to ;; servers that have gone ;; away (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)))) (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 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. (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 (extras-transport-succeded log-port rmt-mutex attemptnum runremote areapath res params rid cmd alldat) (extras-transport-failed log-port rmt-mutex attemptnum runremote areapath cmd rid params alldat) ))) ;; 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 runremote 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 (exec-fn 'server:check-if-running areapath) (exec-fn 'client:setup runremote areapath) #f)))) ;;====================================================================== ;; ulex and steps stuff ;;====================================================================== |
︙ | ︙ |
Modified tests/unittests/all-rmt.scm from [3c7b17d5c4] to [2224634ff2].
︙ | ︙ | |||
66 67 68 69 70 71 72 | ;; let's start up a server the mechanical way (system "nbfake megatest -server -") (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")))) | | | 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 | ;; let's start up a server the mechanical way (system "nbfake megatest -server -") (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 *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 '())) ;; DEF (rmt:kill-server run-id) ;; DEF (rmt:start-server run-id) |
︙ | ︙ |