250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
|
(sparams (db:obj->string params transport: 'http))
(runremote (or area-dat *runremote*))
(server-id (if (vector? serverdat)
(http-transport:server-dat-get-server-id serverdat)
(begin
(debug:print 0 *default-log-port* "FATAL ERROR: http-transport:client-api-send-receive called with no server info")
(exit 1)))))
;(debug:print-info 0 *default-log-port* "fullurl=" fullurl ", cmd=" cmd ", params=" params ", run-id=" run-id "\n runremote=" runremote " serverdat=" serverdat " server-id" server-id "current time:" (current-seconds) )
;(debug:print-info 0 *default-log-port* "cmd=" cmd " fullurl=" fullurl " server-id=" server-id " current time:" (current-seconds))
;; 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
|
<
|
|
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
|
(sparams (db:obj->string params transport: 'http))
(runremote (or area-dat *runremote*))
(server-id (if (vector? serverdat)
(http-transport:server-dat-get-server-id serverdat)
(begin
(debug:print 0 *default-log-port* "FATAL ERROR: http-transport:client-api-send-receive called with no server info")
(exit 1)))))
(debug:print-info 11 *default-log-port* "cmd=" cmd " fullurl=" fullurl " server-id=" server-id " current time:" (current-seconds))
;; 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
|
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
|
success
(db:string->obj
(handle-exceptions
exn
(let ((call-chain (get-call-chain))
(msg ((condition-property-accessor 'exn 'message) exn)))
(set! success #f)
(if (debug:debug-mode 3)
(debug:print-info 0 *default-log-port* "couldn't talk to server, trying again ...")
(begin
(debug:print 0 *default-log-port* "WARNING: failure in with-input-from-request to " fullurl ".")
(debug:print 0 *default-log-port* " message: " msg ", exn=" exn)
(debug:print 0 *default-log-port* " cmd: " cmd " params: " params " key:" (or server-id "thekey"))
(debug:print 0 *default-log-port* " call-chain: " call-chain)))
(if runremote
|
|
|
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
|
success
(db:string->obj
(handle-exceptions
exn
(let ((call-chain (get-call-chain))
(msg ((condition-property-accessor 'exn 'message) exn)))
(set! success #f)
(if (debug:debug-mode 1)
(debug:print-info 0 *default-log-port* "couldn't talk to server, trying again ...")
(begin
(debug:print 0 *default-log-port* "WARNING: failure in with-input-from-request to " fullurl ".")
(debug:print 0 *default-log-port* " message: " msg ", exn=" exn)
(debug:print 0 *default-log-port* " cmd: " cmd " params: " params " key:" (or server-id "thekey"))
(debug:print 0 *default-log-port* " call-chain: " call-chain)))
(if runremote
|
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
|
(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)
(vector-set! res 0 success)
(thread-terminate! th2)
(debug:print-info 0 *default-log-port* "got res=" res)
(if (vector? res)
(if (vector-ref res 0) ;; this is the first flag or the second flag?
res ;; this is the *inner* vector? seriously? why?
(if (debug:debug-mode 11)
(let ((call-chain (get-call-chain))) ;; note: this code also called in nmsg-transport - consider consolidating it
(print-call-chain (current-error-port))
(debug:print-error 11 *default-log-port* "error above occured at server, res=" res) ;; " message: " ((condition-property-accessor 'exn 'message) exn))
|
<
|
311
312
313
314
315
316
317
318
319
320
321
322
323
324
|
(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)
(vector-set! res 0 success)
(thread-terminate! th2)
(if (vector? res)
(if (vector-ref res 0) ;; this is the first flag or the second flag?
res ;; this is the *inner* vector? seriously? why?
(if (debug:debug-mode 11)
(let ((call-chain (get-call-chain))) ;; note: this code also called in nmsg-transport - consider consolidating it
(print-call-chain (current-error-port))
(debug:print-error 11 *default-log-port* "error above occured at server, res=" res) ;; " message: " ((condition-property-accessor 'exn 'message) exn))
|