Megatest

Diff
Login

Differences From Artifact [9d03c1c19f]:

To Artifact [f8890a14ba]:


160
161
162
163
164
165
166




167
168
169
170
171
172
173
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177







+
+
+
+







;; S E R V E R   U T I L I T I E S 
;;======================================================================

;;======================================================================
;; C L I E N T S
;;======================================================================

(define *http-mutex* (make-mutex))

;; (system "megatest -list-servers | grep alive || megatest -server - -daemonize && sleep 4")

;; <html>
;; <head></head>
;; <body>1 Hello, world! Goodbye Dolly</body></html>
;; Send msg to serverdat and receive result
(define (http-transport:client-send-receive serverdat msg)
  (let* (;; (url        (http-transport:make-server-url serverdat))
	 (fullurl    (caddr serverdat)) ;; (conc url "/ctrl")) ;; (conc url "/?dat=" msg)))
189
190
191
192
193
194
195

196
197
198
199
200









201

202

203
204
205
206
207
208
209
193
194
195
196
197
198
199
200
201
202
203


204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223







+



-
-
+
+
+
+
+
+
+
+
+

+

+







			 #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 ()
			      (mutex-lock! *http-mutex*)
			      (set! res (with-input-from-request 
					 fullurl 
					 (list (cons 'dat msg)) 
					 read-string))))
	      (th1 (make-thread send-recieve "with-input-from-request")))
					 read-string))
			      (close-all-connections!) 
			      (mutex-unlock! *http-mutex*)))
	      (time-out     (lambda ()
			      (thread-sleep! 5)
			      (if (not res)
				  (debug:print 0 "ERROR: communication with the server timed out. Exiting."))))
	      (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)
	 (let ((match (string-search (regexp "<body>(.*)<.body>") res)))
	   (debug:print-info 11 "match=" match)
	   (let ((final (cadr match)))
	     (debug:print-info 11 "final=" final)
	     final)))))))