Megatest

Check-in [0b9de1bde2]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
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: 0b9de1bde272d94b4e197c2c52e61867d17bdab7
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
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified client.scm from [2b55a1807a] to [60f2284e51].

︙
50
51
52
53
54
55
56
57



58
59
60
61
62
63
64

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) (rpc-transport:client-setup run-id remaining-tries: remaining-tries failed-connects: failed-connects)) ;;(client:setup-rpc run-id))
    ((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

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
340

341
342
343
344
345
346
347

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))))
	 (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
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72

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))


  ;; (handle-exceptions
  ;;  exn
  ;;  (begin
  ;;    (debug:print 0 *default-log-port* "Remote failed for " proc " " params " exn="exn)
  ;;    (apply (eval (string->symbol procstr)) params))
  ;;  ;; (if *runremote*
  ;;  ;;    (apply (eval (string->symbol (conc "remote:" procstr))) params)
  ;;  (apply (eval (string->symbol procstr)) params)))

;; 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
624
625


626
627

628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647

648
649
650
651
652


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 (remtries 10))
  ;;(BB> "entered rpc-transport:client-setup with run-id="run-id" and server-dat="server-dat" and retries="remtries)
(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=" remtries)
  (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)
          (rmt:set-cinfo run-id runremote-server-dat) ;; (hash-table-set! *runremote* run-id runremote-server-dat)  ;; side-effect - *runremote* cache init fpr rmt:*
          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 (> remtries 2)
          (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 remtries))))))
          (client:setup run-id remaining-tries: (sub1 remaining-tries))))))

This page was generated in about 0.121s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00