Megatest

Diff
Login

Differences From Artifact [ef90d475fb]:

To Artifact [599b82a5a9]:


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

318
319
320

321
322
323
324
325
326
327
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
318
319
320
321
322
323
324







-
-
+








-









-
+


-
+
-

-
+







;; bunch of small functions factored out of send-receive to make debug easier
;;

(define (extras-case-11 *default-log-port* runremote cmd params attemptnum rid)
  ;; (mutex-unlock! *rmt-mutex*)
  (debug:print-info 12 *default-log-port* "rmt:send-receive, case  9")
  ;; (mutex-lock! *rmt-mutex*)
  (let* ((conninfo (remote-conndat runremote))
	 (dat-in  (condition-case ;; handling here has
  (let* ((dat-in  (condition-case ;; handling here has
			     ;; caused a lot of
			     ;; problems. However it
			     ;; is needed to deal with
			     ;; attemtped
			     ;; communication to
			     ;; servers that have gone
			     ;; away
			     (http-transport:client-api-send-receive 0 runremote cmd params)
			     ;; (http-transport:client-api-send-receive 0 conninfo cmd params runremote)
			     ((servermismatch)  (vector #f "Server id mismatch" ))
			     ((commfail)(vector #f "communications fail"))
			     ((exn)(vector #f "other fail" (print-call-chain)))))
	 (dat      (if (and (vector? dat-in) ;; ... check it is a correct size
			    (> (vector-length dat-in) 1))
		       dat-in
		       (vector #f (conc "communications fail (type 2), dat-in=" dat-in))))
	 (success  (if (vector? dat) (vector-ref dat 0) #f))
	 (res      (if (vector? dat) (vector-ref dat 1) #f)))
    (if (and (vector? conninfo) (< 5 (vector-length conninfo)))
    (if (remote? runremote)
	(remote-last-access-set! runremote (current-seconds)) ;; refresh access time
	(begin
	  (debug:print 0 *default-log-port* "INFO: Should not get here! conninfo=" conninfo)
	  (debug:print 0 *default-log-port* "INFO: Should not get here! runremote="runremote)
	  (set! conninfo #f)
	  (http-transport:close-connections runremote)))
    (debug:print-info 13 *default-log-port* "rmt:send-receive, case  9. conninfo=" conninfo " dat=" dat " runremote = " runremote)
    (debug:print-info 13 *default-log-port* "rmt:send-receive, case  9. runremote="runremote " dat=" dat)
    (mutex-unlock! *rmt-mutex*)
    (if success ;; success only tells us that the transport was
	;; successful, have to examine the data to see if
	;; there was a detected issue at the other end
	(extras-transport-succeded *default-log-port* *rmt-mutex* attemptnum runremote res params rid cmd)
	(begin
           (debug:print-error 0 *default-log-port* " dat=" dat)