Overview
Comment: | wip |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.6584-tcp6 |
Files: | files | file ages | folders |
SHA1: |
fba10f42b6017520943e7dc0596ab6dc |
User & Date: | matt on 2021-06-01 08:40:29 |
Other Links: | branch diff | manifest | tags |
Context
2021-06-05
| ||
02:49 | Simplified server/client signature check-in: fd69de34fe user: matt tags: v1.6584-tcp6 | |
2021-06-01
| ||
08:40 | wip check-in: fba10f42b6 user: matt tags: v1.6584-tcp6 | |
05:43 | wip, getting closer to tcp6 based approach working check-in: 0dbc0e6225 user: matt tags: v1.6584-tcp6 | |
Changes
Modified apimod.scm from [bcadf5a9f5] to [b45d00b8af].
︙ | ︙ | |||
409 410 411 412 413 414 415 | (debug:print 0 *default-log-port* "server-id:" *server-id*) (let* ((cmd-in (alist-ref 'cmd indat)) ;; ($ 'cmd)) (cmd (if (string? cmd-in)(string->symbol cmd-in) cmd-in)) (params (string->sexpr (alist-ref 'params indat))) (key (alist-ref 'key indat)) ;; TODO - add this back ) (debug:print 0 *default-log-port* "cmd:" cmd " with params " params "key " key) | | | 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 | (debug:print 0 *default-log-port* "server-id:" *server-id*) (let* ((cmd-in (alist-ref 'cmd indat)) ;; ($ 'cmd)) (cmd (if (string? cmd-in)(string->symbol cmd-in) cmd-in)) (params (string->sexpr (alist-ref 'params indat))) (key (alist-ref 'key indat)) ;; TODO - add this back ) (debug:print 0 *default-log-port* "cmd:" cmd " with params " params "key " key) (if (equal? key *server-id*) ;; TODO - get real key involved (begin (set! *api-process-request-count* (+ *api-process-request-count* 1)) (let* ((res (api:execute-requests dbstruct cmd params))) (debug:print 0 *default-log-port* "res:" res) #;(if (not success) (debug:print 0 *default-log-port* "ERROR: success flag is #f for " cmd " with params " params)) (if (> *api-process-request-count* *max-api-process-requests*) |
︙ | ︙ |
Modified rmtmod.scm from [3c6fe3273a] to [96f313d98a].
︙ | ︙ | |||
147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 | (apath #f) (dbname #f) (fullname #f) (hostport #f) (ipaddr #f) (port #f) (srvpkt #f) (lastmsg 0) (expires 0) (inport #f) (outport #f)) ;;====================================================================== ;; S U P P O R T F U N C T I O N S ;;====================================================================== ;; replaces *runremote* (define *rmt:remote* (make-rmt:remote)) | > > > > > > > > > | 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 | (apath #f) (dbname #f) (fullname #f) (hostport #f) (ipaddr #f) (port #f) (srvpkt #f) (srvkey #f) (lastmsg 0) (expires 0) (inport #f) (outport #f)) (define *srvpktspec* `((server (host . h) (port . p) (servkey . k) (pid . i) (ipaddr . a) (dbpath . d)))) ;;====================================================================== ;; S U P P O R T F U N C T I O N S ;;====================================================================== ;; replaces *runremote* (define *rmt:remote* (make-rmt:remote)) |
︙ | ︙ | |||
208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 | (thread-sleep! 4) (rmt:open-main-connection remote apath) ;; TODO: Add limit to number of tries ))) (if the-srv ;; yes, we have a server, now try connecting to it (let* ((srv-addr (server-address the-srv)) (ipaddr (alist-ref 'ipaddr the-srv)) (port (alist-ref 'port the-srv)) (fullpath (db:dbname->path apath dbname)) (srvready (server-ready? ipaddr port fullpath))) (if srvready (begin (hash-table-set! (rmt:remote-conns remote) dbname ;; fullpath ;; yes, I'd prefer it to be fullpath - FIXME later (make-rmt:conn apath: apath dbname: dbname fullname: fullpath hostport: srv-addr ipaddr: ipaddr port: port srvpkt: the-srv lastmsg: (current-seconds) expires: (+ (current-seconds) 60) ;; this needs to be gathered during the ping )) #t) (start-main-srv))) (start-main-srv)))) | > > | 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 | (thread-sleep! 4) (rmt:open-main-connection remote apath) ;; TODO: Add limit to number of tries ))) (if the-srv ;; yes, we have a server, now try connecting to it (let* ((srv-addr (server-address the-srv)) (ipaddr (alist-ref 'ipaddr the-srv)) (port (alist-ref 'port the-srv)) (srv-key (alist-ref 'srvkey the-srv)) (fullpath (db:dbname->path apath dbname)) (srvready (server-ready? ipaddr port fullpath))) (if srvready (begin (hash-table-set! (rmt:remote-conns remote) dbname ;; fullpath ;; yes, I'd prefer it to be fullpath - FIXME later (make-rmt:conn apath: apath dbname: dbname fullname: fullpath hostport: srv-addr ipaddr: ipaddr port: port srvpkt: the-srv srvkey: srv-key lastmsg: (current-seconds) expires: (+ (current-seconds) 60) ;; this needs to be gathered during the ping )) #t) (start-main-srv))) (start-main-srv)))) |
︙ | ︙ | |||
272 273 274 275 276 277 278 | (dbname (db:run-id->dbname rid))) (rmt:general-open-connection conns apath dbname) (rmt:send-receive-real conns apath dbname cmd params))) (define (rmt:send-receive-setup conn) (if (not (rmt:conn-inport conn)) (let-values (((i o) (tcp-connect (rmt:conn-ipaddr conn) | | | | 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 | (dbname (db:run-id->dbname rid))) (rmt:general-open-connection conns apath dbname) (rmt:send-receive-real conns apath dbname cmd params))) (define (rmt:send-receive-setup conn) (if (not (rmt:conn-inport conn)) (let-values (((i o) (tcp-connect (rmt:conn-ipaddr conn) (rmt:conn-port conn)))) (rmt:conn-inport-set! conn i) (rmt:conn-outport-set! conn o)))) ;; db is at apath/.db/dbname, rid is an intermediary solution and will be removed ;; sometime in the future ;; (define (rmt:send-receive-real remote apath dbname cmd params) (let* ((conn (rmt:get-conn remote apath dbname))) (assert conn "FATAL: rmt:send-receive-real called without the needed channels opened") (rmt:send-receive-setup conn) (let* ((key #f) (payload (sexpr->string `((cmd . ,cmd) (key . ,(rmt:conn-srvpkt conn)) (params . ,params)))) (res (begin (write payload (rmt:conn-outport conn)) (with-input-from-port (rmt:conn-inport conn) read-string)))) (if (string? res) |
︙ | ︙ | |||
1759 1760 1761 1762 1763 1764 1765 | (define (get-lock-db sdat dbfile) (let* ((dbh (db:open-run-db dbfile db:initialize-db)) (res (db:get-iam-server-lock dbh dbfile))) (sqlite3:finalize! dbh) res)) | < < < < < < < < | 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 | (define (get-lock-db sdat dbfile) (let* ((dbh (db:open-run-db dbfile db:initialize-db)) (res (db:get-iam-server-lock dbh dbfile))) (sqlite3:finalize! dbh) res)) (define (register-server pkts-dir pkt-spec host port servkey ipaddr dbpath) (let* ((pkt-dat `((host . ,host) (port . ,port) (servkey . ,servkey) (pid . ,(current-process-id)) (ipaddr . ,ipaddr) (dbpath . ,dbpath))) |
︙ | ︙ |