242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
|
(debug:print-error 0 *default-log-port* "call to rpc-transport:server-dat-update-last-access with non-vector!!"))))
(define *api-exec-ht* (make-hash-table))
;; let's see if caching the rpc stub curbs thread-profusion on server side
(define (rpc-transport:get-api-exec iface port)
(let* ((lu (hash-table-ref/default *api-exec-ht* '(iface . port) #f)))
(if lu
lu
(let ((res (rpc:procedure 'api-exec iface port)))
(hash-table-set! *api-exec-ht* '(iface . port) res)
res))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; this client-side procedure makes rpc call to server and returns result
;;
(define (rpc-transport:client-api-send-receive run-id serverdat cmd params #!key (numretries 3))
(BB> "entered nsport:client-api-send-receive with run-id="run-id " serverdat="serverdat" cmd="cmd" params="params" numretries="numretries)
(if (not (vector? serverdat))
(begin
(BB> "WHAT?? for run-id="run-id", serverdat="serverdat)
(print-call-chain)
(exit 1)))
(let* ((iface (rpc-transport:server-dat-get-iface serverdat))
(port (rpc-transport:server-dat-get-port serverdat))
(res #f)
(api-exec (rpc-transport:get-api-exec iface port))
(send-receive (lambda ()
(tcp-buffer-size 0)
(set! res (retry-thunk
(lambda ()
(condition-case
;;(vector #t (run-remote cmd params))
(vector 'success (api-exec cmd params))
|
|
|
|
|
|
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
|
(debug:print-error 0 *default-log-port* "call to rpc-transport:server-dat-update-last-access with non-vector!!"))))
(define *api-exec-ht* (make-hash-table))
;; let's see if caching the rpc stub curbs thread-profusion on server side
(define (rpc-transport:get-api-exec iface port)
(let* ((lu (hash-table-ref/default *api-exec-ht* (cons iface port) #f)))
(if lu
lu
(let ((res (rpc:procedure 'api-exec iface port)))
(hash-table-set! *api-exec-ht* (cons iface port) res)
res))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; this client-side procedure makes rpc call to server and returns result
;;
(define (rpc-transport:client-api-send-receive run-id serverdat cmd params #!key (numretries 3))
(BB> "entered rpc-transport:client-api-send-receive with run-id="run-id " serverdat="serverdat" cmd="cmd" params="params" numretries="numretries)
(if (not (vector? serverdat))
(begin
(BB> "WHAT?? for run-id="run-id", serverdat="serverdat)
(print-call-chain)
(exit 1)))
(let* ((iface (rpc-transport:server-dat-get-iface serverdat))
(port (rpc-transport:server-dat-get-port serverdat))
(res #f)
(api-exec (rpc-transport:get-api-exec iface port)) ;; chached by host/port. may need to clear...
(send-receive (lambda ()
(tcp-buffer-size 0)
(set! res (retry-thunk
(lambda ()
(condition-case
;;(vector #t (run-remote cmd params))
(vector 'success (api-exec cmd params))
|
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
|
(thread-terminate! th2)
(BB> "alt got res="res)
(debug:print-info 11 *default-log-port* "got res=" res)
(if (vector? res)
(case (vector-ref res 0)
((success) (vector #t (vector-ref res 1)))
((comms-fail)
(debug:print 0 *default-log-port* "WARNING: comms failure for rpc request")
;;(debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
(vector #f (vector-ref res 1)))
(else
(debug:print-error 0 *default-log-port* "error occured at server, info=" (vector-ref res 1))
(debug:print 0 *default-log-port* " client call chain:")
(print-call-chain (current-error-port))
(debug:print 0 *default-log-port* " server call chain:")
|
|
|
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
|
(thread-terminate! th2)
(BB> "alt got res="res)
(debug:print-info 11 *default-log-port* "got res=" res)
(if (vector? res)
(case (vector-ref res 0)
((success) (vector #t (vector-ref res 1)))
((comms-fail)
(debug:print 0 *default-log-port* "WARNING: comms failure for rpc request >>"res"<<")
;;(debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
(vector #f (vector-ref res 1)))
(else
(debug:print-error 0 *default-log-port* "error occured at server, info=" (vector-ref res 1))
(debug:print 0 *default-log-port* " client call chain:")
(print-call-chain (current-error-port))
(debug:print 0 *default-log-port* " server call chain:")
|