Overview
| Comment: | Added timeout on no server. Auto starts a server on timeout |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | refactor-http-transport |
| Files: | files | file ages | folders |
| SHA1: |
bf5639be892d205124841a184976bb5a |
| User & Date: | matt on 2013-05-08 00:34:52 |
| 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 | |
| 00:34 | Added timeout on no server. Auto starts a server on timeout Closed-Leaf check-in: bf5639be89 user: matt tags: refactor-http-transport | |
|
2013-05-07
| ||
| 23:06 | Refactor http transport check-in: b662cb0a51 user: matt tags: refactor-http-transport | |
Changes
Modified client.scm from [0cd46ef301] to [8b3b6e88e1].
| ︙ | ︙ | |||
73 74 75 76 77 78 79 |
(string->symbol (tasks:hostinfo-get-transport hostinfo))
'fs))
;; ;; DEBUG STUFF
;; (if (eq? *transport-type* 'fs)(begin (print "ERROR!!!!!!! refusing to run with transport " *transport-type*)(exit 99)))
(debug:print-info 11 "Using transport type of " *transport-type* (if hostinfo (conc " to connect to " hostinfo) ""))
(case *transport-type*
| | > > > > > > | 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 |
(string->symbol (tasks:hostinfo-get-transport hostinfo))
'fs))
;; ;; DEBUG STUFF
;; (if (eq? *transport-type* 'fs)(begin (print "ERROR!!!!!!! refusing to run with transport " *transport-type*)(exit 99)))
(debug:print-info 11 "Using transport type of " *transport-type* (if hostinfo (conc " to connect to " hostinfo) ""))
(case *transport-type*
((fs) ;; (if (not *megatest-db*)(set! *megatest-db* (open-db))))
;; we are not doing fs any longer. let's cheat and start up a server
(set! *transport-type* #f)
(system "megatest -list-servers | grep alive || megatest -server - -daemonize && sleep 3")
(thread-sleep! 1)
(if (> numtries 0)
(client:setup numtries: (- numtries 1))))
((http)
(http-transport:client-connect (tasks:hostinfo-get-interface hostinfo)
(tasks:hostinfo-get-port hostinfo)))
((zmq)
(zmq-transport:client-connect (tasks:hostinfo-get-interface hostinfo)
(tasks:hostinfo-get-port hostinfo)
(tasks:hostinfo-get-pubport hostinfo)))
|
| ︙ | ︙ |
Modified db.scm from [98d99ca28b] to [113f8f5bae].
| ︙ | ︙ | |||
1262 1263 1264 1265 1266 1267 1268 |
(query-sig (message-digest-string (md5-primitive) (conc qtype immediate params)))
(zdat (db:obj->string (vector client-sig qtype immediate query-sig params (current-seconds))))) ;; (with-output-to-string (lambda ()(serialize params))))
(debug:print-info 11 "zdat=" zdat)
(let* ((res #f)
(rawdat (http-transport:client-send-receive serverdat zdat))
(tmp #f))
(debug:print-info 11 "Sent " zdat ", received " rawdat)
| > > | | > > > | 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 |
(query-sig (message-digest-string (md5-primitive) (conc qtype immediate params)))
(zdat (db:obj->string (vector client-sig qtype immediate query-sig params (current-seconds))))) ;; (with-output-to-string (lambda ()(serialize params))))
(debug:print-info 11 "zdat=" zdat)
(let* ((res #f)
(rawdat (http-transport:client-send-receive serverdat zdat))
(tmp #f))
(debug:print-info 11 "Sent " zdat ", received " rawdat)
(if rawdat
(begin
(set! tmp (db:string->obj rawdat))
(vector-ref tmp 2))
(begin
(debug:print 0 "ERROR: Communication with the server failed. Exiting if possible")
(exit 1))))))
((zmq)
(handle-exceptions
exn
(begin
(debug:print-info 0 "cdb:client-call timeout or error. Trying again in 5 seconds")
(thread-sleep! 5)
(if (> numretries 0)(apply cdb:client-call serverdat qtype immediate (- numretries 1) params)))
|
| ︙ | ︙ |
Modified http-transport.scm from [9d03c1c19f] to [f8890a14ba].
| ︙ | ︙ | |||
160 161 162 163 164 165 166 167 168 169 170 171 172 173 | ;; 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 (caddr serverdat)) ;; (conc url "/ctrl")) ;; (conc url "/?dat=" msg))) | > > > > | 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 |
#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 ()
(set! res (with-input-from-request
fullurl
(list (cons 'dat msg))
| > | > > > > > > | > > > | 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))
(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)))))))
|
| ︙ | ︙ |