Megatest

Changes On Branch 4125fe9193bad10a
Login

Changes In Branch server-robustness Excluding Merge-Ins

This is equivalent to a diff from a0d9704d2f to 4125fe9193

2015-03-09
05:19
Merging better-html-update-control to v1.60 check-in: bd663b5d13 user: matt tags: v1.60
05:18
Attempt to improve server recovery in bad situations Closed-Leaf check-in: 4125fe9193 user: matt tags: server-robustness
2015-03-04
18:42
Better method for locking on html update check-in: 150c672a53 user: mrwellan tags: better-html-update-control
08:41
Moved delay in can-run-more-tests out of the main path check-in: a0d9704d2f user: mrwellan tags: v1.60
06:55
Merged in the static-html branch check-in: 16e4ac3a73 user: mrwellan tags: v1.60

Modified http-transport.scm from [c3c2fc0fe7] to [45038c07c5].

270
271
272
273
274
275
276
277







278
279
280
281
282
283
284
270
271
272
273
274
275
276

277
278
279
280
281
282
283
284
285
286
287
288
289
290







-
+
+
+
+
+
+
+







					   exn
					   (begin
					     (set! success #f)
					     (debug:print 0 "WARNING: failure in with-input-from-request to " fullurl ".")
					     (debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
					     (hash-table-delete! *runremote* run-id)
					     ;; Killing associated server to allow clean retry.")
					     (tasks:kill-server-run-id run-id)  ;; better to kill the server in the logic that called this routine?
					     ;; (tasks:kill-server-run-id run-id)  ;; better to kill the server in the logic that called this routine?

					     ;; could try to start server here, if sucessful, retry the call to with-input-from-request
					     ;; otherwise - raise the error

					     ;; (rmt:start-server run-id)
					     
					     (mutex-unlock! *http-mutex*)
					     (signal (make-composite-condition
						      (make-property-condition 'commfail 'message "failed to connect to server")))
					     "communications failed")
					   (with-input-from-request ;; was dat
					    fullurl 
					    (list (cons 'key "thekey")

Modified rmt.scm from [fbb21771c9] to [96ad5c0ce1].

106
107
108
109
110
111
112








113

114
115
116
117
118
119
120
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120

121
122
123
124
125
126
127
128







+
+
+
+
+
+
+
+
-
+







	 (connection-info (rmt:get-connection-info run-id)))
    ;; the nmsg method does the encoding under the hood (the http method should be changed to do this also)
    (if connection-info
	;; use the server if have connection info
	(let* ((dat     (case *transport-type*
			  ((http)(condition-case
				  (http-transport:client-api-send-receive run-id connection-info cmd params)
				  ((commfail)
				   (if (< attemptnum 5)
				       (begin
					 (debug:print 0 "Trying again, try number " attemptnum)
					 (hash-table-delete! *runremote* run-id)
					 (rmt:send-receive cmd rid params attemptnum: (+ attemptnum 1)))
				       (begin
					 (debug:print 0 "Giving up, try number " attemptnum)
				  ((commfail)(vector #f "communications fail"))
					 (vector #f "communications fail"))))
				  ((exn)(vector #f "other fail"))))
			  ((nmsg)(condition-case
				  (nmsg-transport:client-api-send-receive run-id connection-info cmd params)
				  ((timeout)(vector #f "timeout talking to server"))))
			  (else  (exit))))
	       (success (if (vector? dat) (vector-ref dat 0) #f))
	       (res     (if (vector? dat) (vector-ref dat 1) #f)))
257
258
259
260
261
262
263


264

265
266
267
268
269
270
271
265
266
267
268
269
270
271
272
273

274
275
276
277
278
279
280
281







+
+
-
+







	  res))))

(define (rmt:send-receive-no-auto-client-setup connection-info cmd run-id params)
  (let* ((run-id   (if run-id run-id 0))
	 ;; (jparams  (db:obj->string params)) ;; (rmt:dat->json-str params))
	 (res  	   (handle-exceptions
		    exn
		    (begin
		      (debug:print 0 "Failed in rmt:send-receive-no-auto-client-setup, cmd=" cmd ", run-id=" run-id ", params=" params)
		    #f
		       #f)
		    (http-transport:client-api-send-receive run-id connection-info cmd params))))
;;		    ((commfail) (vector #f "communications fail")))))
    (if (and res (vector-ref res 0))
	(vector-ref res 1) ;;; YES!! THIS IS CORRECT!! CHANGE IT HERE, THEN CHANGE rmt:send-receive ALSO!!!
	#f)))
;; 	(db:string->obj (vector-ref dat 1))
;; 	(begin