Overview
Comment: | v1.80-notbetter |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | v1.80-refactor |
Files: | files | file ages | folders |
SHA1: |
5287e5010549a396eba77c113c70da1e |
User & Date: | matt on 2023-01-16 21:42:29 |
Other Links: | branch diff | manifest | tags |
Context
2023-01-16
| ||
21:42 | v1.80-notbetter Leaf check-in: 5287e50105 user: matt tags: v1.80-refactor | |
15:53 | Most sqlite3: calls now prepared and cached. check-in: bcf8145611 user: matt tags: v1.80-refactor | |
Changes
Modified client.scm from [754a2985af] to [0b5cc73e0c].
︙ | ︙ | |||
72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 | (remote-port runremote)) (conc "http://" (remote-iface runremote) ":" (remote-port runremote)) #f)) (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)) (define (client:setup-http areapath runremote #!key (remaining-tries 100) (failed-connects 0)) (debug:print-info 2 *default-log-port* "client:setup remaining-tries=" remaining-tries) (server:start-and-wait areapath) (if (<= remaining-tries 0) (begin (debug:print-error 0 *default-log-port* "failed to start or connect to server") (exit 1)) ;; ;; 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 | > > > | | 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 | (remote-port runremote)) (conc "http://" (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)) (define (client:setup-http areapath runremote #!key (remaining-tries 100) (failed-connects 0)) (debug:print-info 2 *default-log-port* "client:setup remaining-tries=" remaining-tries) (server:start-and-wait areapath) (if (<= remaining-tries 0) (begin (debug:print-error 0 *default-log-port* "failed to start or connect to server") (exit 1)) ;; ;; 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 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 ((host port start-time server-id pid) (debug:print-info 4 *default-log-port* "client:setup server-dat=" server-dat ", remaining-tries=" remaining-tries) |
︙ | ︙ |
Modified common.scm from [55cc68e51c] to [9b791ab862].
︙ | ︙ | |||
325 326 327 328 329 330 331 | res)) (server-url #f) ;; (server:check-if-running *toppath*) #f)) (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 | < | 325 326 327 328 329 330 331 332 333 334 335 336 337 338 | res)) (server-url #f) ;; (server:check-if-running *toppath*) #f)) (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 (server-timeout (server:expiration-timeout)) (force-server #f) (ro-mode #f) (ro-mode-checked #f) ;; flag that indicates we have checked for ro-mode ;; conndat stuff (iface #f) ;; TODO: Consolidate this data with server-url and server-info above |
︙ | ︙ |
Modified http-transport.scm from [5e153aef1a] to [7e9b604002].
︙ | ︙ | |||
247 248 249 250 251 252 253 | (assert (remote? runremote) "FATAL: http-transport:client-api-send-receive called with serverdat="serverdat) (let* ((fullurl (remote-api-req runremote)) (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)) | | | 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 | (assert (remote? runremote) "FATAL: http-transport:client-api-send-receive called with serverdat="serverdat) (let* ((fullurl (remote-api-req runremote)) (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)) ;; send the data and get the response ;; extract the needed info from the http data and |
︙ | ︙ | |||
335 336 337 338 339 340 341 | (if (remote? runremote) (let ((api-dat (remote-api-uri runremote))) (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)) | | < > > | | > | 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 | (if (remote? runremote) (let ((api-dat (remote-api-uri runremote))) (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 (not (args:get-arg "-server")) (begin ;; NOTE: Verify this actually ever gets hit. Jan 16, 2023. (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. ;; (define (http-transport:keep-running) ;; if none running or if > 20 seconds since |
︙ | ︙ |
Modified rmt.scm from [599b82a5a9] to [7863d0d68f].
︙ | ︙ | |||
42 43 44 45 46 47 48 | ;;====================================================================== ;; 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) | | | 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 | ;;====================================================================== ;; 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-api-req runremote) #f))) (if cinfo cinfo (if (server:check-if-running areapath) (client:setup areapath runremote) #f)))) |
︙ | ︙ | |||
127 128 129 130 131 132 133 | (if (not (pair? (remote-hh-dat runremote))) ;; not on homehost (thread-sleep! 0.1) ;; since we shouldn't get here, delay a little (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 | | | | | | | | 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 | (if (not (pair? (remote-hh-dat runremote))) ;; not on homehost (thread-sleep! 0.1) ;; since we shouldn't get here, delay a little (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)) ;;DOT EXIT; ;;DOT MUTEXLOCK -> EXIT [label="> 15 attempts"]; {rank=same "case 1" "EXIT" } ;; give up if more than 150 attempts ((> attemptnum 150) (debug:print 0 *default-log-port* "ERROR: 150 tries to start/connect to server. Giving up.") (exit 1)) |
︙ | ︙ | |||
174 175 176 177 178 179 180 | ;; (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 (+ (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 | < | 174 175 176 177 178 179 180 181 182 183 184 185 186 187 | ;; (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 (+ (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 (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}; ;;DOT CASE5 -> "rmt:open-qry-close-locally"; |
︙ | ︙ | |||
252 253 254 255 256 257 258 | (debug:print-info 12 *default-log-port* "rmt:send-receive, case 8.1") (rmt:open-qry-close-locally cmd 0 params))) ;;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 | | | | | | 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 | (debug:print-info 12 *default-log-port* "rmt:send-receive, case 8.1") (rmt:open-qry-close-locally cmd 0 params))) ;;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-api-req runremote))) (and (not (cdr (remote-hh-dat runremote))) ;; not on a homehost (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*)) (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"; ;; all set up if get this far, dispatch the query ((and (not (remote-force-server runremote)) |
︙ | ︙ |