24
25
26
27
28
29
30
31
32
33
34
35
36
37
|
(declare (uses common))
(declare (uses db))
(declare (uses tests))
(declare (uses tasks)) ;; tasks are where stuff is maintained about what is running.
(declare (uses server))
(declare (uses daemon))
(declare (uses portlogger))
(include "common_records.scm")
(include "db_records.scm")
(define (http-transport:make-server-url hostport)
(if (not hostport)
#f
|
>
|
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
|
(declare (uses common))
(declare (uses db))
(declare (uses tests))
(declare (uses tasks)) ;; tasks are where stuff is maintained about what is running.
(declare (uses server))
(declare (uses daemon))
(declare (uses portlogger))
(declare (uses rmt))
(include "common_records.scm")
(include "db_records.scm")
(define (http-transport:make-server-url hostport)
(if (not hostport)
#f
|
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
|
(http-transport:server-dat-get-api-req serverdat)
(begin
(debug:print 0 *default-log-port* "FATAL ERROR: http-transport:client-api-send-receive called with no server info")
(exit 1))))
(res #f)
(success #t)
(sparams (db:obj->string params transport: 'http)))
;; (condition-case
;; handle-exceptions
;; exn
;; (if (> numretries 0)
;; (begin
;; (mutex-unlock! *http-mutex*)
;; (thread-sleep! 1)
;; (handle-exceptions
;; exn
;; (debug:print 0 *default-log-port* "WARNING: closing connections failed. Server at " fullurl " almost certainly dead")
;; (close-all-connections!))
;; (debug:print 0 *default-log-port* "WARNING: Failed to communicate with server, trying again, numretries left: " numretries)
;; (http-transport:client-api-send-receive run-id serverdat cmd sparams numretries: (- numretries 1)))
;; (begin
;; (mutex-unlock! *http-mutex*)
;; (tasks:kill-server-run-id run-id)
;; #f))
;; (begin
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
218
219
220
221
222
223
224
225
226
227
228
229
230
231
|
(http-transport:server-dat-get-api-req serverdat)
(begin
(debug:print 0 *default-log-port* "FATAL ERROR: http-transport:client-api-send-receive called with no server info")
(exit 1))))
(res #f)
(success #t)
(sparams (db:obj->string params transport: 'http)))
(debug:print-info 11 *default-log-port* "fullurl=" fullurl ", cmd=" cmd ", params=" params ", run-id=" run-id "\n")
;; set up the http-client here
(max-retry-attempts 1)
;; consider all requests indempotent
(retry-request? (lambda (request)
#f))
;; send the data and get the response
|
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
|
(db:string->obj
(handle-exceptions
exn
(begin
(set! success #f)
(debug:print 0 *default-log-port* "WARNING: failure in with-input-from-request to " fullurl ".")
(debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
(set! *runremote* #f) ;; (hash-table-delete! *runremote* run-id)
|
>
|
|
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
|
(db:string->obj
(handle-exceptions
exn
(begin
(set! success #f)
(debug:print 0 *default-log-port* "WARNING: failure in with-input-from-request to " fullurl ".")
(debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
(if *runremote*
(remote-conndat-set! *runremote* #f))
;; Killing associated server to allow clean retry.")
;; (tasks:kill-server-run-id run-id) ;; better to kill the server in the logic that called this routine?
(mutex-unlock! *http-mutex*)
;;; (signal (make-composite-condition
;;; (make-property-condition 'commfail 'message "failed to connect to server")))
;;; "communications failed"
(db:obj->string #f))
|
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
|
(make-property-condition
'timeout
'message "nmsg-transport:client-api-send-receive-raw timed out talking to server")))))))
;; careful closing of connections stored in *runremote*
;;
(define (http-transport:close-connections run-id)
(let* ((server-dat *runremote*)) ;; (hash-table-ref/default *runremote* run-id #f)))
(if (vector? server-dat)
(let ((api-dat (http-transport:server-dat-get-api-uri server-dat)))
(close-connection! api-dat)
#t)
#f)))
|
>
>
|
|
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
|
(make-property-condition
'timeout
'message "nmsg-transport:client-api-send-receive-raw timed out talking to server")))))))
;; careful closing of connections stored in *runremote*
;;
(define (http-transport:close-connections run-id)
(let* ((server-dat (if *runremote*
(remote-conndat *runremote*)
#f))) ;; (hash-table-ref/default *runremote* run-id #f)))
(if (vector? server-dat)
(let ((api-dat (http-transport:server-dat-get-api-uri server-dat)))
(close-connection! api-dat)
#t)
#f)))
|