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)))) |
︙ | ︙ | |||
112 113 114 115 116 117 118 | ;; ensure we have a record for our connection for given area (if (not runremote) ;; can remove this one. should never get here. (begin (set! *runremote* (make-remote)) (let* ((server-info (remote-server-info *runremote*))) (if server-info (begin | | | | | | | | | | 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 | ;; ensure we have a record for our connection for given area (if (not runremote) ;; can remove this one. should never get here. (begin (set! *runremote* (make-remote)) (let* ((server-info (remote-server-info *runremote*))) (if server-info (begin (remote-server-url-set! *runremote* (server:record->url server-info)) (remote-server-id-set! *runremote* (server:record->id server-info))))) (set! runremote *runremote*))) ;; new runremote will come from this on next iteration ;; DOT SET_HOMEHOST; // leaving off - doesn't really add to the clarity ;; DOT MUTEXLOCK -> SET_HOMEHOST [label="no homehost?"]; ;; DOT SET_HOMEHOST -> MUTEXLOCK; ;; 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 (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)) |
︙ | ︙ |