Overview
Comment: | wip |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.80-tcp-inmem |
Files: | files | file ages | folders |
SHA1: |
444956dd030f43f6e164ba3bfa733edf |
User & Date: | matt on 2023-02-12 16:39:47 |
Other Links: | branch diff | manifest | tags |
Context
2023-02-12
| ||
20:21 | wip check-in: 278a10af86 user: matt tags: v1.80-tcp-inmem | |
16:39 | wip check-in: 444956dd03 user: matt tags: v1.80-tcp-inmem | |
10:52 | wip - start tcp/inmem check-in: 1a2eb25cb6 user: matt tags: v1.80-tcp-inmem | |
Changes
Modified client.scm from [6913337164] to [732bd78865].
︙ | ︙ | |||
102 103 104 105 106 107 108 | (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) (if (not runremote) (begin ;; Here we are creating a runremote where there was none or it was clobbered with #f ;; | | | 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 | (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) (if (not runremote) (begin ;; Here we are creating a runremote where there was none or it was clobbered with #f ;; (set! runremote (make-and-init-remote)) (let* ((server-info (server:check-if-running areapath))) (remote-server-info-set! runremote server-info) (if server-info (begin (remote-server-url-set! runremote (server:record->url server-info)) (remote-server-id-set! runremote (server:record->id server-info))))))) ;; at this point we have a runremote |
︙ | ︙ |
Modified rmt.scm from [56f3e59ce5] to [eb5ba03d8d].
︙ | ︙ | |||
64 65 66 67 68 69 70 71 72 73 74 75 76 77 | (let* ((hh-dat (remote-hh-dat runremote))) (if (pair? hh-dat) (cdr hh-dat) (begin (debug:print-info 0 *default-log-port* "hh-dat="hh-dat) #f)))) ;;====================================================================== (define *send-receive-mutex* (make-mutex)) ;; should have separate mutex per run-id ;; RA => e.g. usage (rmt:send-receive 'get-var #f (list varname)) ;; | > > > > > | 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 | (let* ((hh-dat (remote-hh-dat runremote))) (if (pair? hh-dat) (cdr hh-dat) (begin (debug:print-info 0 *default-log-port* "hh-dat="hh-dat) #f)))) (define (make-and-init-remote areapath) (case (rmt:transport-mode) ((http)(make-remote)) ((tcp) (tt:make-remote areapath)) (else #f))) ;;====================================================================== (define *send-receive-mutex* (make-mutex)) ;; should have separate mutex per run-id ;; RA => e.g. usage (rmt:send-receive 'get-var #f (list varname)) ;; |
︙ | ︙ | |||
108 109 110 111 112 113 114 115 116 117 118 119 120 | (let* ((start-time (current-seconds)) ;; snapshot time so all use cases get same value (areapath *toppath*);; TODO - resolve from dbstruct to be compatible with multiple areas (runremote (or area-dat *runremote*)) (attemptnum (+ 1 attemptnum)) (readonly-mode (rmtmod:calc-ro-mode runremote *toppath*))) ;; DOT INIT_RUNREMOTE; // leaving off - doesn't really add to the clarity ;; DOT MUTEXLOCK -> INIT_RUNREMOTE [label="no remote?"]; ;; DOT INIT_RUNREMOTE -> MUTEXLOCK; ;; ensure we have a record for our connection for given area (if (not runremote) ;; can remove this one. should never get here. (begin | > > > > > > > > > > > > > | | < < < < < | 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 147 148 149 150 151 152 153 | (let* ((start-time (current-seconds)) ;; snapshot time so all use cases get same value (areapath *toppath*);; TODO - resolve from dbstruct to be compatible with multiple areas (runremote (or area-dat *runremote*)) (attemptnum (+ 1 attemptnum)) (readonly-mode (rmtmod:calc-ro-mode runremote *toppath*))) (case (rmt:transport-mode) ((http)(http-transport-handler runremote cmd rid params attemptnum area-dat areapath readonly-mode)) ((tcp) (tcp-transport-handler runremote cmd rid params attemptnum area-dat areapath readonly-mode))))) (define (tcp-transport-handler runremote cmd rid params attemptnum area-dat areapath readonly-mode) (if (not runremote) (let* ((newremote (make-and-init-remote))) (set! *runremote* newremote) (set! runremote newremote))) (let* ((dbfname (conc (dbfile:run-id->dbnum run-id)".db"))) ;;(dbfile:run-id->path areapath run-id))) (tt:handler runremote cmd rid params attemptnum area-dat areapath readonly-mode dbfname))) (define (http-transport-handler runremote cmd rid params attemptnum area-dat areapath readonly-mode) ;; DOT INIT_RUNREMOTE; // leaving off - doesn't really add to the clarity ;; DOT MUTEXLOCK -> INIT_RUNREMOTE [label="no remote?"]; ;; DOT INIT_RUNREMOTE -> MUTEXLOCK; ;; 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-and-init-remote areapath)) (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 |
︙ | ︙ |
Modified server.scm from [1c00c07593] to [7750b95739].
︙ | ︙ | |||
674 675 676 677 678 679 680 | (list (car slst)(string->number (cadr slst))) #f))) (else #f)))) (cond ((and (list? host-port) (eq? (length host-port) 2)) | | | 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 | (list (car slst)(string->number (cadr slst))) #f))) (else #f)))) (cond ((and (list? host-port) (eq? (length host-port) 2)) (let* ((myrunremote (make-and-init-remote *toppath*)) (iface (car host-port)) (port (cadr host-port)) (server-dat (client:connect iface port server-id myrunremote)) (login-res (rmt:login-no-auto-client-setup myrunremote))) (http-transport:close-connections myrunremote) (if (and (list? login-res) (car login-res)) |
︙ | ︙ |
Modified tcp-transportmod.scm from [1b6d5ad8f5] to [43c7c98ef5].
︙ | ︙ | |||
37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 | stack files ports commonmod ;; debugprint ) ;; (define keep-age-param (make-parameter 10)) ;; qif file age, if over move to attic (defstruct tt (area #f) ) (define (tt:bid-for-servership run-id) #f) (define (tt:get-current-server run-id) #f) | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > > > > > > > > > > > > | 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 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 108 109 110 111 112 113 114 | stack files ports commonmod ;; debugprint ) ;;====================================================================== ;; client ;;====================================================================== ;; (define keep-age-param (make-parameter 10)) ;; qif file age, if over move to attic (defstruct tt (area #f) (conns (make-hash-table)) ;; dbfname -> conn ) (define (tt:make-remote areapath) (make-tt area: areapath)) (define (tt:handler runremote cmd rid params attemptnum area-dat areapath readonly-mode dbfname) ;; NOTE: areapath is passed in and in tt struct. We'll use passed in value for now. (let* ((conn (hash-table-ref/default (tt-conns runremote) dbfname #f))) (if conn ;; have connection, call the server (let* ((res (tt:send-receive runremote conn cmd rid params))) (cond ((member res '(busy starting)) (thread-sleep! 1) (tt:handler runremote cmd rid params attemptnum area-dat areapath readonly-mode dbfname)) (else res))) ;; no conn yet, find and or start and find a server (let* ((server (tt:find-server areapath dbfname))) (if server (let* ((conn (tt:server-connect server))) (hash-table-set! (tt-conns runremote) dbfname conn) (tt:handler runremote cmd rid params attemptnum area-dat areapath readonly-mode dbfname)) ;; no server, try to start one (begin (tt:start-server areapath dbfname) (thread-sleep! 1) (tt:handler runremote cmd rid params attemptnum area-dat areapath readonly-mode dbfname))))))) (define (tt:bid-for-servership run-id) #f) (define (tt:get-current-server run-id) #f) (define (tt:send-receive ttdat conn cmd run-id params) #f) ;;====================================================================== ;; server ;;====================================================================== (define (tt:sync-dbs ttdat) #f) (define (tt:start-server ttdat) #f) (define (tt:server-connect ttdat) #f) (define (tt:find-server ttdat) #f) (define (tt:shutdown-server ttdat) #f) ) |