Overview
Comment: | wip |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.6584-ck5 |
Files: | files | file ages | folders |
SHA1: |
064cde8cf9ba75845d372a57b7b86e60 |
User & Date: | matt on 2021-05-03 23:33:00 |
Other Links: | branch diff | manifest | tags |
Context
2021-05-05
| ||
05:45 | Prepped unit tests for adding basicserver tests. check-in: 2d52196991 user: matt tags: v1.6584-ck5 | |
2021-05-03
| ||
23:33 | wip check-in: 064cde8cf9 user: matt tags: v1.6584-ck5 | |
2021-05-02
| ||
23:50 | wip check-in: 3c5e874d19 user: matt tags: v1.6584-ck5 | |
Changes
Modified apimod.scm from [ef19086eeb] to [dc1a92b44f].
︙ | ︙ | |||
403 404 405 406 407 408 409 | ;; (define (api:process-request dbstruct $) ;; the $ is the request vars proc (debug:print 4 *default-log-port* "server-id:" *server-id*) (let* ((cmd ($ 'cmd)) (paramsj ($ 'params)) (key ($ 'key)) (params (db:string->obj paramsj transport: 'http))) ;; incoming data from the POST (or is it a GET?) | | | 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 | ;; (define (api:process-request dbstruct $) ;; the $ is the request vars proc (debug:print 4 *default-log-port* "server-id:" *server-id*) (let* ((cmd ($ 'cmd)) (paramsj ($ 'params)) (key ($ 'key)) (params (db:string->obj paramsj transport: 'http))) ;; incoming data from the POST (or is it a GET?) (debug:print 0 *default-log-port* "cmd:" cmd " with params " params "key " key) (if (equal? key *server-id*) (begin (set! *api-process-request-count* (+ *api-process-request-count* 1)) (let* ((resdat (api:execute-requests dbstruct (vector cmd params))) ;; process the request, resdat = #( flag result ) (success (vector-ref resdat 0)) (res (vector-ref resdat 1))) ;; (vector flag payload), get the payload, ignore the flag (why?) (debug:print 4 *default-log-port* "res:" res) |
︙ | ︙ | |||
428 429 430 431 432 433 434 435 | ;; (boolean? res)) ;; res ;; (list "ERROR, not string, list, number or boolean" 1 cmd params res))))) (db:obj->string res transport: 'http))) (begin (debug:print 0 *default-log-port* "Server refused to process request. Sever id mismatch. recived " key " expected: " *server-id* ".\nOther arguments recived: cmd=" cmd " params = " params) (db:obj->string (conc "Server refused to process request server-id mismatch: " key ", " *server-id*) transport: 'http))))) | | < | 428 429 430 431 432 433 434 435 436 | ;; (boolean? res)) ;; res ;; (list "ERROR, not string, list, number or boolean" 1 cmd params res))))) (db:obj->string res transport: 'http))) (begin (debug:print 0 *default-log-port* "Server refused to process request. Sever id mismatch. recived " key " expected: " *server-id* ".\nOther arguments recived: cmd=" cmd " params = " params) (db:obj->string (conc "Server refused to process request server-id mismatch: " key ", " *server-id*) transport: 'http))))) ) |
Modified http-transportmod.scm from [dff08aec04] to [7d98658692].
︙ | ︙ | |||
313 314 315 316 317 318 319 | (let* ((send-recieve (lambda () (set! res (vector #t ;; success (with-input-from-request (servdat-api-uri sdat) (list (cons 'key qry-key) | | | | 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 | (let* ((send-recieve (lambda () (set! res (vector #t ;; success (with-input-from-request (servdat-api-uri sdat) (list (cons 'key qry-key) ;; (cons 'srvid (servdat-uuid sdat)) (cons 'cmd cmd) (cons 'params sparams)) read-string))))) ;; or read-string? (time-out (lambda () (thread-sleep! 45) (debug:print 0 *default-log-port* "WARNING: send-receive took more than 45 seconds!!") #f)) (th1 (make-thread send-recieve "with-input-from-request")) (th2 (make-thread time-out "time out"))) (thread-start! th1) |
︙ | ︙ | |||
389 390 391 392 393 394 395 | ;; (define (servdat-init sdat-in iface port uuid) (let* ((sdat (or sdat-in (make-servdat)))) (if uuid (servdat-uuid-set! sdat uuid)) (servdat-host-set! sdat iface) (servdat-port-set! sdat port) (servdat-api-url-set! sdat (conc "http://" iface ":" port "/api")) | | | 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 | ;; (define (servdat-init sdat-in iface port uuid) (let* ((sdat (or sdat-in (make-servdat)))) (if uuid (servdat-uuid-set! sdat uuid)) (servdat-host-set! sdat iface) (servdat-port-set! sdat port) (servdat-api-url-set! sdat (conc "http://" iface ":" port "/api")) (servdat-api-uri-set! sdat (uri-reference (servdat-api-url sdat))) (servdat-api-req-set! sdat (make-request method: 'POST uri: (servdat-api-uri sdat))) ;; set up the http-client parameters (max-retry-attempts 1) ;; consider all requests indempotent (retry-request? (lambda (request) #f)) |
︙ | ︙ |
Modified rmtmod.scm from [f4d2b319a7] to [47299d0079].
︙ | ︙ | |||
160 161 162 163 164 165 166 167 168 169 170 171 172 173 | (fullname #f) (hostport #f) (lastmsg 0) (expires 0)) ;; replaces *runremote* (define *rmt:remote* (make-rmt:remote)) ;; do we have a connection to apath dbname and ;; is it not expired? then return it ;; ;; else setup a connection ;; ;; if that fails, return '(#f "some reason") ;; NB// convert to raising an exception | > > > | 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 | (fullname #f) (hostport #f) (lastmsg 0) (expires 0)) ;; replaces *runremote* (define *rmt:remote* (make-rmt:remote)) ;; set up the api proc, seems like there should be a better place for this? (api-proc api:process-request) ;; do we have a connection to apath dbname and ;; is it not expired? then return it ;; ;; else setup a connection ;; ;; if that fails, return '(#f "some reason") ;; NB// convert to raising an exception |
︙ | ︙ | |||
198 199 200 201 202 203 204 | (system (conc "nbfake megatest -server - -area "apath " -db "dbname)) (thread-sleep! 1.5) (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)) | > > | | 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 | (system (conc "nbfake megatest -server - -area "apath " -db "dbname)) (thread-sleep! 1.5) (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)) (srvready (server-ready? ipaddr port)) (fullpath (db:dbname->path apath dbname))) (if srvready (hash-table-set! (rmt:remote-conns remote) fullpath (make-rmt:conn apath: apath dbname: dbname |
︙ | ︙ |