Megatest

Diff
Login

Differences From Artifact [36b97a3388]:

To Artifact [e77ae27b79]:


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
			 #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.
       (let* ((send-recieve (lambda ()
			      (let ((dat #f)
				    (cleanup (http-transport:get-time-to-cleanup)))
				(if cleanup 
				    (begin
				      (debug:print-info 0 "Running cleanup mode")
				      (http-transport:inc-requests-and-prep-to-close-all-connections))
				    (http-transport:inc-requests-count))
				;; Do the actual data transfer

				(set! dat (with-input-from-request 
					   fullurl 
					   (list (cons 'dat msg)) 
					   read-string))



				(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)
			      (if (not res)
				  (begin
				    (debug:print 0 "WARNING: communication with the server timed out.")
				    (mutex-unlock! *http-mutex*)
				    (http-transport:client-send-receive serverdat msg numretries: (- numretries 1))







|
|
|
|
|
|
|
|
>
|



>
>
>
|
|
|
|
|
|
|
|







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
			 #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.
       (let* ((send-recieve (lambda ()
			      ;; (let ((dat #f)
			      ;;       (cleanup (http-transport:get-time-to-cleanup)))
			      ;;   (if cleanup 
			      ;;       (begin
			      ;;         (debug:print-info 0 "Running cleanup mode")
			      ;;         (http-transport:inc-requests-and-prep-to-close-all-connections))
			      ;;       (http-transport:inc-requests-count))
			      ;;   ;; Do the actual data transfer
			      (mutex-lock! *http-mutex*) ;; Hypothesis is that this was *not* the bottleneck
			      (set! res (with-input-from-request ;; was set! dat
					   fullurl 
					   (list (cons 'dat msg)) 
					   read-string))
			      (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)
			      (if (not res)
				  (begin
				    (debug:print 0 "WARNING: communication with the server timed out.")
				    (mutex-unlock! *http-mutex*)
				    (http-transport:client-send-receive serverdat msg numretries: (- numretries 1))
334
335
336
337
338
339
340
341
342
343
344
345
346

347
348
349
350
351
352



353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
       ;; 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

				(set! dat (with-input-from-request 
					   fullurl 
					   (list (cons 'key "thekey")
						 (cons 'cmd cmd)
						 (cons 'params params))
					   read-string))



				(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)
			      (if (not res)
				  (begin
				    (debug:print 0 "WARNING: communication with the server timed out.")
				    (mutex-unlock! *http-mutex*)
				    (http-transport:client-api-send-receive serverdat cmd params numretries: (- numretries 1))







|
|
|
|
|
|
>
|





>
>
>
|
|
|
|
|
|
|
|







338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
       ;; 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))
				(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)
			      (if (not res)
				  (begin
				    (debug:print 0 "WARNING: communication with the server timed out.")
				    (mutex-unlock! *http-mutex*)
				    (http-transport:client-api-send-receive serverdat cmd params numretries: (- numretries 1))