Megatest

Check-in [9681d97154]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Added mutex and close-all-connections to http transport
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.54
Files: files | file ages | folders
SHA1: 9681d9715434c5935a55845e7316701e9731cff7
User & Date: matt on 2013-05-07 23:40:13
Other Links: branch diff | manifest | tags
Context
2013-05-08
00:42
Merged in refactoring of http-transport check-in: 8c3d4217c8 user: matt tags: v1.54
2013-05-07
23:40
Added mutex and close-all-connections to http transport check-in: 9681d97154 user: matt tags: v1.54
2013-05-06
15:37
Bumped version to v1.5422 check-in: 1037acdf73 user: mrwellan tags: v1.54, v1.5422
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified http-transport.scm from [fe6673ff15] to [768cc35d08].

︙
160
161
162
163
164
165
166


167
168
169
170
171
172
173
174
175
176


177
178


179
180
181
182
183
184
185
186
187
188
189

190
191
192
193
194


195
196
197
198
199
200
201

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


181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208








+
+










+
+
-
-
+
+











+





+
+








;; 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))

;; <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    (conc url "/ctrl")) ;; (conc url "/?dat=" msg)))
	 (numretries 0))     
    (handle-exceptions
     exn
     (begin 
       (debug:print  0 "WARNING: possible communication error")
     (if (< numretries 200)
	 (http-transport:client-send-receive serverdat msg))
       (if (< numretries 200)
	   (http-transport:client-send-receive serverdat msg)))
     (begin
       (debug:print-info 11 "fullurl=" fullurl "\n")
       ;; set up the http-client here
       (max-retry-attempts 100)
       (retry-request? (lambda (request)
			 (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.
       (mutex-lock! *http-mutex*)
       (let* ((res   (with-input-from-request fullurl 
					      ;; #f
					      ;; msg 
					      (list (cons 'dat msg)) 
					      read-string)))
	 (close-all-connections!) 
	 (mutex-unlock! *http-mutex*)
	 (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)))))))
︙

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