Megatest

Check-in [4a2103f62b]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Trimmed out some junk code and fixed some logic in the server start up sequencing
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | re-re-factor-server
Files: files | file ages | folders
SHA1: 4a2103f62bb7f92bedb3de95259ab912d345b8cd
User & Date: matt on 2014-02-17 19:36:02
Other Links: branch diff | manifest | tags
Context
2014-02-17
21:11
Completed server re-write check-in: cd8a4f1a41 user: matt tags: re-re-factor-server
19:36
Trimmed out some junk code and fixed some logic in the server start up sequencing check-in: 4a2103f62b user: matt tags: re-re-factor-server
18:26
Partially completed rework of server/client logic check-in: 2b3405f60c user: matt tags: re-re-factor-server
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified http-transport.scm from [af9b9bb667] to [7e052a2b1c].

︙︙
216
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
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
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
311
312
313
314
315
316
317

(define (http-transport:inc-requests-and-prep-to-close-all-connections)
  (mutex-lock! *http-mutex*)
  (set! *http-requests-in-progress* (+ 1 *http-requests-in-progress*)))

;; Send "cmd" with json payload "params" to serverdat and receive result
;;
(define (http-transport:client-api-send-receive run-id serverdat cmd params #!key (numretries 30))
  ;; (let loop ((sdat  serverdat)
  ;;            (tries 10))
  ;;   (if (not sdat) ;; get #f, something went wrong. try starting the server again and reconnecting
  ;;       (begin
  ;;         ;; try to restart the server and then reconnect
  ;;         ;; (hash-table-delete! *runremote* run-id) ;; this should be taken care of by client:setup
  ;;         (thread-sleep! 1)
  ;;         (if (> tries 0)
  ;;             (let ((newsdat (client:setup run-id)))
  ;;       	(set! serverdat newsdat)
  ;;       	(loop newsdat (- tries 1)))
  ;;             (debug:print 0 "ERROR: could not connect to or start a server for run-id " run-id)))))
  ;; (debug:print 0 "serverdat=" serverdat)
  (let* ((fullurl    (if (list? serverdat)
			 (cadddr serverdat) ;; this is the uri for /api
			 (begin
			   (debug:print 0 "FATAL ERROR: http-transport:client-api-send-receive called with no server info")
			   (exit 1))))
	 (res        #f))
    (handle-exceptions
     exn
     #f
     ;; (begin
       ;; TODO: Send this output to a log file so it isn't lost when running as daemon
       ;; (if (> numretries 0)
	;;    ;; on the zeroeth retry do not print the error message - this allows the call to be used as a ping (no junk on output).
	;;    (begin
	;;      (print "ERROR IN http-transport:client-api-send-receive " ((condition-property-accessor 'exn 'message) exn))
	;;      ;; try to restart the server and then reconnect
	;;      ;; (hash-table-delete! *runremote* run-id)
	;;      ;; (client:setup run-id)
	;;      ;; (http-transport:client-api-send-receive run-id serverdat cmd params numretries: (- numretries 1)))
	;;      #f) ;; simply return #f to indicate failure. The caller will need to do the retry.
	;;    #f))
     (begin
       (debug:print-info 11 "fullurl=" fullurl ", cmd=" cmd ", params=" params ", run-id=" run-id "\n")
       ;; set up the http-client here
       (max-retry-attempts 5)
       ;; consider all requests indempotent
       (retry-request? (lambda (request)
			 #t))   ;;  		 (thread-sleep! (/ (if (> numretries 100) 100 numretries) 10))
       ;; (set! numretries (- numretries 1))
       ;;  		 #t))
       ;; send the data and get the response
       ;; extract the needed info from the http data and 
       ;; process and return it.

       ;; (with-input-from-request "http://localhost/echo-service"
       ;;                  '((test . "value")) read-string)

       (let* ((send-recieve (lambda ()
			;;       (let ((dat #f)
			;; 	    (cleanup (http-transport:get-time-to-cleanup)))
			;; 	(if cleanup 
			;; 	    (http-transport:inc-requests-and-prep-to-close-all-connections)
			;; 	    (http-transport:inc-requests-count))
			;; 	;; Do the actual data transfer NB// KEPP THIS IN SYNC WITH http-transport:client-send-receive
				 (mutex-lock! *http-mutex*)
				 (set! res (with-input-from-request ;; was dat
					   fullurl 
					   (list (cons 'key "thekey")
						 (cons 'cmd cmd)
						 (cons 'params params))
					   read-string))
				 ;; Shouldn't this be a call to the managed call-all-connections stuff above?
				(close-all-connections!)
				(mutex-unlock! *http-mutex*)
				))
	                          ;; (if cleanup
				  ;;   ;; mutex already set
				  ;;   (begin
				  ;;     (set! res dat)
				  ;;     (http-transport:dec-requests-count-and-close-all-connections))
				  ;;   (http-transport:dec-requests-count
				  ;;    (lambda ()
				  ;;      (set! res dat)))))))
	      (time-out     (lambda ()
			      (thread-sleep! 45)
			      #f))
			      ;; (if (not res)
			      ;;     (begin
			      ;;       (debug:print 0 "WARNING: communication with the server timed out.")
			      ;;       (mutex-unlock! *http-mutex*)
			      ;;       (http-transport:client-api-send-receive run-id serverdat cmd params numretries: (- numretries 1))
			      ;;       (if (< numretries 3) ;; on last try just exit
			      ;;   	(begin
			      ;;   	  (debug:print 0 "ERROR: communication with the server timed out. Giving up.")
			      ;;   	  (exit 1)))))))
	      (th1 (make-thread send-recieve "with-input-from-request"))
	      (th2 (make-thread time-out     "time out")))
	 (thread-start! th1)
	 (thread-start! th2)
	 (thread-join! th1)
	 (thread-terminate! th2)
	 (debug:print-info 11 "got res=" res)








<
<
<
<
<
<
<
<
<
<
<
<
<









<
<
<
<
<
<
<
<
<
<
<
<






<
<
|



<
<
<
<

<
<
<
<
<
<
|
|
|
|
|
|
|
|
|
|
|
<
<
<
<
<
<
<
<



<
<
<
<
<
<
<
<
<








216
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
247
248
249
250
251
252
253








254
255
256









257
258
259
260
261
262
263

(define (http-transport:inc-requests-and-prep-to-close-all-connections)
  (mutex-lock! *http-mutex*)
  (set! *http-requests-in-progress* (+ 1 *http-requests-in-progress*)))

;; Send "cmd" with json payload "params" to serverdat and receive result
;;
(define (http-transport:client-api-send-receive run-id serverdat cmd params #!key (numretries 30))













  (let* ((fullurl    (if (list? serverdat)
			 (cadddr serverdat) ;; this is the uri for /api
			 (begin
			   (debug:print 0 "FATAL ERROR: http-transport:client-api-send-receive called with no server info")
			   (exit 1))))
	 (res        #f))
    (handle-exceptions
     exn
     #f












     (begin
       (debug:print-info 11 "fullurl=" fullurl ", cmd=" cmd ", params=" params ", run-id=" run-id "\n")
       ;; set up the http-client here
       (max-retry-attempts 5)
       ;; consider all requests indempotent
       (retry-request? (lambda (request)


			 #t))
       ;; send the data and get the response
       ;; extract the needed info from the http data and 
       ;; process and return it.




       (let* ((send-recieve (lambda ()






			      (mutex-lock! *http-mutex*)
			      (set! res (with-input-from-request ;; was dat
					 fullurl 
					 (list (cons 'key "thekey")
					       (cons 'cmd cmd)
					       (cons 'params params))
					 read-string))
			      ;; Shouldn't this be a call to the managed call-all-connections stuff above?
			      (close-all-connections!)
			      (mutex-unlock! *http-mutex*)
			      ))








	      (time-out     (lambda ()
			      (thread-sleep! 45)
			      #f))









	      (th1 (make-thread send-recieve "with-input-from-request"))
	      (th2 (make-thread time-out     "time out")))
	 (thread-start! th1)
	 (thread-start! th2)
	 (thread-join! th1)
	 (thread-terminate! th2)
	 (debug:print-info 11 "got res=" res)
︙︙

Modified rmt.scm from [37aacb2dec] to [deb40682ce].

︙︙
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65

	  (rmt:send-receive-no-auto-client-setup connection-info cmd run-id params)))))

(define (rmt:send-receive-no-auto-client-setup connection-info cmd run-id params)
  (let* ((jparams         (db:obj->string params)) ;; (rmt:dat->json-str params))
	 (res (http-transport:client-api-send-receive run-id connection-info cmd jparams numretries: 3)))
    (if res
	(db:string->obj res) ;; (rmt:json-str->dat res)
	(let ((connection-info (client:setup run-id)))
	  ;; something went wrong, try setting up the client again and then resend
	  (debug:print 0 "WARNING: Communication failed, trying call to http-transport:client-api-send-receive again.")
	  (rmt:send-receive-no-auto-client-setup connection-info cmd run-id params)))))

;; Wrap json library for strings (why the ports crap in the first place?)
(define (rmt:dat->json-str dat)
  (with-output-to-string 
    (lambda ()
      (json-write dat))))









|
<
<
|








48
49
50
51
52
53
54
55


56
57
58
59
60
61
62
63

	  (rmt:send-receive-no-auto-client-setup connection-info cmd run-id params)))))

(define (rmt:send-receive-no-auto-client-setup connection-info cmd run-id params)
  (let* ((jparams         (db:obj->string params)) ;; (rmt:dat->json-str params))
	 (res (http-transport:client-api-send-receive run-id connection-info cmd jparams numretries: 3)))
    (if res
	(db:string->obj res) ;; (rmt:json-str->dat res)
	;; this one does NOT keep trying


	res)))

;; Wrap json library for strings (why the ports crap in the first place?)
(define (rmt:dat->json-str dat)
  (with-output-to-string 
    (lambda ()
      (json-write dat))))
︙︙

Modified tasks.scm from [a457dae400] to [c13323f697].

︙︙
90
91
92
93
94
95
96

97
98
99
100
101
102
103

(define (tasks:hostinfo-get-pubport     vec)    (vector-ref  vec 3))
(define (tasks:hostinfo-get-transport   vec)    (vector-ref  vec 4))
(define (tasks:hostinfo-get-pid         vec)    (vector-ref  vec 5))
(define (tasks:hostinfo-get-hostname    vec)    (vector-ref  vec 6))

(define (tasks:server-lock-slot mdb run-id)
  (tasks:server-clean-out-old-records-for-run-id mdb run-id)

  (if (< (tasks:num-in-available-state mdb run-id) 4)
      (begin 
	(tasks:server-set-available mdb run-id)
	(thread-sleep! 2) ;; Try removing this. It may not be needed.
	(tasks:server-am-i-the-server? mdb run-id))
      #f))      
	








>








90
91
92
93
94
95
96
97
98
99
100
101
102
103
104

(define (tasks:hostinfo-get-pubport     vec)    (vector-ref  vec 3))
(define (tasks:hostinfo-get-transport   vec)    (vector-ref  vec 4))
(define (tasks:hostinfo-get-pid         vec)    (vector-ref  vec 5))
(define (tasks:hostinfo-get-hostname    vec)    (vector-ref  vec 6))

(define (tasks:server-lock-slot mdb run-id)
  (tasks:server-clean-out-old-records-for-run-id mdb run-id)
  (server:check-if-running run-id)
  (if (< (tasks:num-in-available-state mdb run-id) 4)
      (begin 
	(tasks:server-set-available mdb run-id)
	(thread-sleep! 2) ;; Try removing this. It may not be needed.
	(tasks:server-am-i-the-server? mdb run-id))
      #f))
︙︙

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