Overview
| Comment: | Factor out http-transport aspect of rmt.scm in preparation for adding tcp-transport.scm |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.80-dbperf |
| Files: | files | file ages | folders |
| SHA1: |
bce6a00a7023f9a22d7456678d7b1fd4 |
| User & Date: | matt on 2023-02-10 09:48:25 |
| Other Links: | branch diff | manifest | tags |
Context
|
2023-02-10
| ||
| 21:06 | Merging pretty good branch v1.80-dbperf to v1.80 check-in: 7170e5f43b user: matt tags: v1.80 | |
| 09:48 | Factor out http-transport aspect of rmt.scm in preparation for adding tcp-transport.scm Closed-Leaf check-in: bce6a00a70 user: matt tags: v1.80-dbperf | |
|
2023-02-06
| ||
| 19:35 | Squashed v1.80-dbperformance into one commit check-in: 6c7b8be468 user: matt tags: v1.80-dbperf | |
Changes
Modified common.scm from [fc85f532b1] to [fd6e725fd9].
| ︙ | ︙ | |||
315 316 317 318 319 320 321 322 323 324 325 326 327 328 |
(else "FAIL")))
(define (common:logpro-exit-code->test-status exit-code)
(status-sym->string (common:logpro-exit-code->status-sym exit-code)))
;;
(defstruct remote
(hh-dat (let ((res (or (server:choose-server *toppath* 'homehost)
(cons #f #f))))
(assert (pair? res)(conc "FATAL: hh-dat should be a pair, got "res))
res))
(server-url #f) ;; (server:check-if-running *toppath*) #f))
(server-id #f)
(server-info #f) ;; (if *toppath* (server:check-if-running *toppath*) #f))
| > > > > > | 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 |
(else "FAIL")))
(define (common:logpro-exit-code->test-status exit-code)
(status-sym->string (common:logpro-exit-code->status-sym exit-code)))
;;
(defstruct remote
;; transport to be used
;; http - use http-transport
;; http-read-cached - use http-transport for writes but in-mem cached for reads
(rmode 'http)
(hh-dat (let ((res (or (server:choose-server *toppath* 'homehost)
(cons #f #f))))
(assert (pair? res)(conc "FATAL: hh-dat should be a pair, got "res))
res))
(server-url #f) ;; (server:check-if-running *toppath*) #f))
(server-id #f)
(server-info #f) ;; (if *toppath* (server:check-if-running *toppath*) #f))
|
| ︙ | ︙ | |||
1365 1366 1367 1368 1369 1370 1371 |
#t
#f))
(else
(debug:print 0 *default-log-port* "ERROR: Bad server force setting " force-setting ", forcing server.")
#t)))) ;; default to requiring server
(if force-result
(begin
| | | 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 |
#t
#f))
(else
(debug:print 0 *default-log-port* "ERROR: Bad server force setting " force-setting ", forcing server.")
#t)))) ;; default to requiring server
(if force-result
(begin
(debug:print-info 0 *default-log-port* "ATTENTION! Forcing use of server, force setting is \"" force-setting "\".")
#t)
#f)))
;;======================================================================
;; M I S C L I S T S
;;======================================================================
|
| ︙ | ︙ |
Modified rmt.scm from [22216f2b37] to [a2b373e5f1].
| ︙ | ︙ | |||
117 118 119 120 121 122 123 124 125 126 127 128 129 130 |
(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 (or (not (pair? (remote-hh-dat runremote))) ;; not on homehost
(not (cdr (remote-hh-dat runremote)))) ;; not on homehost
(thread-sleep! 0.1) ;; since we shouldn't get here, delay a little
| > > > | 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 |
(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
(http-transport-handler runremote cmd rid params attemptnum area-dat areapath readonly-mode)))
(define (http-transport-handler runremote cmd rid params attemptnum area-dat areapath readonly-mode)
;; 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 (or (not (pair? (remote-hh-dat runremote))) ;; not on homehost
(not (cdr (remote-hh-dat runremote)))) ;; not on homehost
(thread-sleep! 0.1) ;; since we shouldn't get here, delay a little
|
| ︙ | ︙ | |||
280 281 282 283 284 285 286 |
(rmt:open-qry-close-locally cmd (if rid rid 0) params))
;;DOT CASE11 [label="send_receive"];
;;DOT MUTEXLOCK -> CASE11 [label="else"]; {rank=same "case 11" CASE11};
;;DOT CASE11 -> "rmt:send-receive" [label="call failed"];
;;DOT CASE11 -> "RESULT" [label="call succeeded"];
;; not on homehost, do server query
| | | 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 |
(rmt:open-qry-close-locally cmd (if rid rid 0) params))
;;DOT CASE11 [label="send_receive"];
;;DOT MUTEXLOCK -> CASE11 [label="else"]; {rank=same "case 11" CASE11};
;;DOT CASE11 -> "rmt:send-receive" [label="call failed"];
;;DOT CASE11 -> "RESULT" [label="call succeeded"];
;; not on homehost, do server query
(else (extras-case-11 *default-log-port* runremote cmd params attemptnum rid))))
;;DOT }
;; 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*)
|
| ︙ | ︙ |