180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
|
soc)))
(success #t)
(dat (vector "ping" our-key))
(result (condition-case
(nmsg-transport:client-api-send-receive-raw req dat timeout: timeout)
((timeout)(set! success #f) #f)))
(key (if success
(vector-ref result 1)
#f)))
(debug:print 0 "success=" success ", key=" key ", expected-key=" expected-key ", equal? " (equal? key expected-key))
(if (and success
(or (not expected-key) ;; just getting a reply is good enough then
(equal? key expected-key)))
(if return-socket
req
|
|
|
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
|
soc)))
(success #t)
(dat (vector "ping" our-key))
(result (condition-case
(nmsg-transport:client-api-send-receive-raw req dat timeout: timeout)
((timeout)(set! success #f) #f)))
(key (if success
(safe-vector-ref result 1)
#f)))
(debug:print 0 "success=" success ", key=" key ", expected-key=" expected-key ", equal? " (equal? key expected-key))
(if (and success
(or (not expected-key) ;; just getting a reply is good enough then
(equal? key expected-key)))
(if return-socket
req
|
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
|
(thread-start! timeout)
(thread-start! send-recv)
(thread-join! send-recv)
(if success (thread-terminate! timeout)))
;; raise timeout error if timed out
(if success
(if (and (vector? result)
(vector-ref result 0)) ;; did it fail at the server?
result ;; nope, all good
(begin
(debug:print 0 "ERROR: error occured at server, info=" (vector-ref result 2))
(debug:print 0 " client call chain:")
(print-call-chain (current-error-port))
(debug:print 0 " server call chain:")
(pp (vector-ref result 1) (current-error-port))
(signal (vector-ref result 0))))
(signal (make-composite-condition
(make-property-condition 'timeout 'message "nmsg-transport:client-api-send-receive-raw timed out talking to server"))))))
;; run nmsg-transport:keep-running in a parallel thread to monitor that the db is being
;; used and to shutdown after sometime if it is not.
;;
(define (nmsg-transport:keep-running server-id run-id)
|
|
|
|
|
|
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
|
(thread-start! timeout)
(thread-start! send-recv)
(thread-join! send-recv)
(if success (thread-terminate! timeout)))
;; raise timeout error if timed out
(if success
(if (and (vector? result)
(safe-vector-ref result 0)) ;; did it fail at the server?
result ;; nope, all good
(begin
(debug:print 0 "ERROR: error occured at server, info=" (safe-vector-ref result 2))
(debug:print 0 " client call chain:")
(print-call-chain (current-error-port))
(debug:print 0 " server call chain:")
(pp (safe-vector-ref result 1) (current-error-port))
(signal (safe-vector-ref result 0))))
(signal (make-composite-condition
(make-property-condition 'timeout 'message "nmsg-transport:client-api-send-receive-raw timed out talking to server"))))))
;; run nmsg-transport:keep-running in a parallel thread to monitor that the db is being
;; used and to shutdown after sometime if it is not.
;;
(define (nmsg-transport:keep-running server-id run-id)
|
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
|
(define (nmsg-transport:client-api-send-receive run-id connection-info cmd param #!key (remtries 5))
;; NB// In the html version of this routine there is a call to
;; tasks:kill-server-run-id when there is an exception
(mutex-lock! *http-mutex*)
(let* ((packet (vector cmd param))
(reqsoc (http-transport:server-dat-get-socket connection-info))
(res (nmsg-transport:client-api-send-receive-raw reqsoc packet)))
;; (status (vector-ref rawres 0))
;; (result (vector-ref rawres 1)))
(mutex-unlock! *http-mutex*)
res)) ;; (vector status (if status (db:string->obj result transport: 'nmsg) result))))
;;======================================================================
;; J U N K
;;======================================================================
|
|
|
|
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
|
(define (nmsg-transport:client-api-send-receive run-id connection-info cmd param #!key (remtries 5))
;; NB// In the html version of this routine there is a call to
;; tasks:kill-server-run-id when there is an exception
(mutex-lock! *http-mutex*)
(let* ((packet (vector cmd param))
(reqsoc (http-transport:server-dat-get-socket connection-info))
(res (nmsg-transport:client-api-send-receive-raw reqsoc packet)))
;; (status (safe-vector-ref rawres 0))
;; (result (safe-vector-ref rawres 1)))
(mutex-unlock! *http-mutex*)
res)) ;; (vector status (if status (db:string->obj result transport: 'nmsg) result))))
;;======================================================================
;; J U N K
;;======================================================================
|