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: |
9681d9715434c5935a55845e7316701e |
| 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
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 |
;; S E R V E R U T I L I T I E S
;;======================================================================
;;======================================================================
;; C L I E N T S
;;======================================================================
;; <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
| > > > > | | > > > | 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)))
(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)))))))
|
| ︙ | ︙ |