Overview
Comment: | rpc server starts now |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.62-rpc |
Files: | files | file ages | folders |
SHA1: |
0b9de1bde272d94b4e197c2c52e61867 |
User & Date: | bjbarcla on 2016-12-05 21:57:30 |
Other Links: | branch diff | manifest | tags |
Context
2016-12-05
| ||
22:08 | wip - client api does not abort due to api mismatch, but does not work either check-in: c913299f5d user: bjbarcla tags: v1.62-rpc | |
21:57 | rpc server starts now check-in: 0b9de1bde2 user: bjbarcla tags: v1.62-rpc | |
19:38 | rpc server starts now check-in: 7ce5c6cfb0 user: bjbarcla tags: v1.62-rpc | |
Changes
Modified client.scm from [2b55a1807a] to [60f2284e51].
︙ | ︙ | |||
50 51 52 53 54 55 56 | ((zmq) (zmq:client-connect iface port)) (else (debug:print 0 *default-log-port* "ERROR: transport " (remote-transport *runremote*) " not supported (5)") (exit)))) (define (client:setup run-id #!key (remaining-tries 10) (failed-connects 0)) (case (server:get-transport) | | > > | 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 | ((zmq) (zmq:client-connect iface port)) (else (debug:print 0 *default-log-port* "ERROR: transport " (remote-transport *runremote*) " not supported (5)") (exit)))) (define (client:setup run-id #!key (remaining-tries 10) (failed-connects 0)) (case (server:get-transport) ((rpc) (let ((res (rpc-transport:client-setup run-id remaining-tries: remaining-tries failed-connects: failed-connects))) (remote-conndat-set! *runremote* runremote-server-dat) res)) ((http)(client:setup-http run-id remaining-tries: remaining-tries failed-connects: failed-connects)) (else (debug:print 0 *default-log-port* "ERROR: transport " (remote-transport *runremote*) " not supported (6)") (exit)))) ;; (client:setup-rpc run-id)))) ;; (define (client:login-no-auto-setup server-info run-id) ;; (case (server:get-transport) |
︙ | ︙ | |||
154 155 156 157 158 159 160 161 162 163 164 165 166 167 | ;; 2. We are a run tests, list runs or other interactive process and we must figure out ;; *transport-type* and *runremote* from the monitor.db ;; ;; client:setup ;; ;; lookup_server, need to remove *runremote* stuff ;; (define (client:setup-http run-id #!key (remaining-tries 10) (failed-connects 0)) (debug:print-info 2 *default-log-port* "client:setup remaining-tries=" remaining-tries) (let* ((tdbdat (tasks:open-db))) (if (<= remaining-tries 0) (begin (debug:print-error 0 *default-log-port* "failed to start or connect to server for run-id " run-id) (exit 1)) | > > > > > > > > > > > > > > > > > > > > | 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 | ;; 2. We are a run tests, list runs or other interactive process and we must figure out ;; *transport-type* and *runremote* from the monitor.db ;; ;; client:setup ;; ;; lookup_server, need to remove *runremote* stuff ;; (define (client:setup-rpc run-id #!key (remaining-tries 10) (failed-connects 0)) (debug:print-info 2 *default-log-port* "client:setup-rpc remaining-tries=" remaining-tries) (let* ((server-dat (tasks:get-server (db:delay-if-busy (tasks:open-db)) run-id)) (num-available (tasks:num-in-available-state (db:delay-if-busy (tasks:open-db)) run-id))) (cond ((<= remaining-tries 0) (debug:print-error 0 *default-log-port* "failed to start or connect to server for run-id " run-id) (exit 1)) (server-dat (debug:print-info 4 *default-log-port* "client:setup-rpc server-dat=" server-dat ", remaining-tries=" remaining-tries) (rpc-transport:client-setup run-id server-dat remaining-tries: remaining-tries)) (else (if (< num-available 2) (server:try-running run-id)) (thread-sleep! (+ 2 (random (- 20 remaining-tries)))) ;; give server a little time to start up, randomize a little to avoid start storms. (client:setup run-id remaining-tries: (- remaining-tries 1)))))) (define (client:setup-http run-id #!key (remaining-tries 10) (failed-connects 0)) (debug:print-info 2 *default-log-port* "client:setup remaining-tries=" remaining-tries) (let* ((tdbdat (tasks:open-db))) (if (<= remaining-tries 0) (begin (debug:print-error 0 *default-log-port* "failed to start or connect to server for run-id " run-id) (exit 1)) |
︙ | ︙ |
Modified http-transport.scm from [400911ce2a] to [a4eeab2202].
︙ | ︙ | |||
333 334 335 336 337 338 339 | ;; ;; connect ;; (define (http-transport:client-connect iface port) (let* ((api-url (conc "http://" iface ":" port "/api")) (api-uri (uri-reference (conc "http://" iface ":" port "/api"))) (api-req (make-request method: 'POST uri: api-uri)) | | | 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 | ;; ;; connect ;; (define (http-transport:client-connect iface port) (let* ((api-url (conc "http://" iface ":" port "/api")) (api-uri (uri-reference (conc "http://" iface ":" port "/api"))) (api-req (make-request method: 'POST uri: api-uri)) (server-dat (vector iface port api-uri api-url api-req (current-seconds) 'http))) server-dat)) ;; 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 server-id run-id) ;; if none running or if > 20 seconds since |
︙ | ︙ |
Modified rpc-transport.scm from [fada9c4b7e] to [6ca03face9].
︙ | ︙ | |||
50 51 52 53 54 55 56 | (set! *last-db-access* (current-seconds)) ;; bump *last-db-access*; this will renew keep-running thread's lease on life for another (server:get-timeout) seconds ;;(BB> "in api-exec; last-db-access updated to "*last-db-access*) (mutex-unlock! *heartbeat-mutex*) res)) | < < < < < < < < < | 50 51 52 53 54 55 56 57 58 59 60 61 62 63 | (set! *last-db-access* (current-seconds)) ;; bump *last-db-access*; this will renew keep-running thread's lease on life for another (server:get-timeout) seconds ;;(BB> "in api-exec; last-db-access updated to "*last-db-access*) (mutex-unlock! *heartbeat-mutex*) res)) ;; retry an operation (depends on srfi-18) ;; ================== ;; idea here is to avoid spending time on coding retrying something. Trying to be generic here. ;; ;; Exception handling: ;; ------------------- ;; if evaluating the thunk results in exception, it will be retried. |
︙ | ︙ | |||
617 618 619 620 621 622 623 | #t) (begin (BB> "Self test fail. login-res="login-res" testing-res="testing-res" *toppath*="*toppath*) #f)) res)) | | | | < | | | 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 | #t) (begin (BB> "Self test fail. login-res="login-res" testing-res="testing-res" *toppath*="*toppath*) #f)) res)) (define (rpc-transport:client-setup run-id server-dat #!key (remaining-tries 10)) ;;(BB> "entered rpc-transport:client-setup with run-id="run-id" and server-dat="server-dat" and retries="remaining-tries) (tcp-buffer-size 0) (debug:print-info 0 *default-log-port* "rpc-transport:client-setup run-id="run-id" server-dat=" server-dat ", remaining-tries=" remaining-tries) (let* ((iface (tasks:hostinfo-get-interface server-dat)) (hostname (tasks:hostinfo-get-hostname server-dat)) (port (tasks:hostinfo-get-port server-dat)) (runremote-server-dat (vector iface port #f #f #f (current-seconds) 'rpc)) ;; http version := (vector iface port api-uri api-url api-req (current-seconds) 'http ) (ping-res (retry-thunk (lambda () ;; make 3 attempts to ping. ((rpc:procedure 'server:login iface port) *toppath*)) chatty: #f retries: 3))) ;; we got here from rmt:get-connection-info on the condition that *runremote* has no entry for run-id... (if ping-res (begin (debug:print-info 0 *default-log-port* "rpc-transport:client-setup CONNECTION ESTABLISHED run-id="run-id" server-dat=" server-dat) runremote-server-dat) (begin ;; login failed but have a server record, clean out the record and try again (debug:print-info 0 *default-log-port* "rpc-transport:client-setup UNABLE TO CONNECT run-id="run-id" server-dat=" server-dat) (tasks:kill-server-run-id run-id) (tasks:server-force-clean-run-record (db:delay-if-busy (tasks:open-db)) run-id iface port " rpc-transport:client-setup (server-dat = #t)") (if (> remaining-tries 2) (thread-sleep! (+ 1 (random 5))) ;; spread out the starts a little (thread-sleep! (+ 15 (random 20)))) ;; it isn't going well. give it plenty of time (server:try-running run-id) (thread-sleep! 5) ;; give server a little time to start up (client:setup run-id remaining-tries: (sub1 remaining-tries)))))) |