77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
(connection-info (hash-table-ref/default *runremote* run-id #f)))
;; the nmsg method does the encoding under the hood (the http method should be changed to do this also)
(if connection-info ;; if we already have a connection for this run-id, use that precendent
;; use the server if have connection info
(let* ((transport-type (vector-ref connection-info 6))) ;; BB: assumes all transport-type'-servertdat vector's item 6 ids transport type
transport-type)
;; otherwise pick the global default as preference.
*transport-type*)))
(define *send-receive-mutex* (make-mutex)) ;; should have separate mutex per run-id
;; RA => e.g. usage (rmt:send-receive 'get-var #f (list varname))
;;
(define (rmt:send-receive cmd rid params #!key (attemptnum 1)) ;; start attemptnum at 1 so the modulo below works as expected
|
|
|
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
(connection-info (hash-table-ref/default *runremote* run-id #f)))
;; the nmsg method does the encoding under the hood (the http method should be changed to do this also)
(if connection-info ;; if we already have a connection for this run-id, use that precendent
;; use the server if have connection info
(let* ((transport-type (vector-ref connection-info 6))) ;; BB: assumes all transport-type'-servertdat vector's item 6 ids transport type
transport-type)
;; otherwise pick the global default as preference. (set in common.scm)
*transport-type*)))
(define *send-receive-mutex* (make-mutex)) ;; should have separate mutex per run-id
;; RA => e.g. usage (rmt:send-receive 'get-var #f (list varname))
;;
(define (rmt:send-receive cmd rid params #!key (attemptnum 1)) ;; start attemptnum at 1 so the modulo below works as expected
|
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
|
;; Here, we make request to remote server
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(dat (case transport-type ;; BB: replaced *transport-type* global with run-id specific transport-type
((http)(condition-case
(http-transport:client-api-send-receive run-id connection-info cmd params)
((commfail)(vector #f "communications fail"))
((exn)(vector #f "other fail"))))
;;((rpc) (rpc-transport:client-api-send-receive run-id connection-info cmd params)) ;; BB: let us error out for now
(else
(debug:print-error 0 *default-log-port* "(1) Transport [" transport-type
"] specified for run-id [" run-id
"] is not implemented in rmt:send-receive. Cannot proceed.")
(vector #f (conc "transport ["transport-type"] unimplemented")))))
(success (if (vector? dat) (vector-ref dat 0) #f))
(res (if (vector? dat) (vector-ref dat 1) #f)))
(if (vector? connection-info)(http-transport:server-dat-update-last-access connection-info)) ;; BB> BBTODO: make this generic, not http transport specific.
(if success
(begin
;; (mutex-unlock! *send-receive-mutex*)
(case transport-type
((http rpc) res) ;; (db:string->obj res))
(else
(debug:print-error 0 *default-log-port* "(2) Transport [" transport-type
"] specified for run-id [" run-id
"] is not implemented in rmt:send-receive. Cannot proceed. Also unexpected since this branch follows success which would follow a suported transport...")
#f)
;; ((nmsg) res)
(begin ;; let ((new-connection-info (client:setup run-id)))
(debug:print 0 *default-log-port* "WARNING: Communication failed, trying call to rmt:send-receive again.")
(case transport-type
((http)
(hash-table-delete! *runremote* run-id) ;; don't keep using the same connection
;; NOTE: killing server causes this process to block forever. No idea why. Dec 2.
;; (if (eq? (modulo attemptnum 5) 0)
;; (tasks:kill-server-run-id run-id tag: "api-send-receive-failed"))
;; (mutex-unlock! *send-receive-mutex*) ;; close the mutex here to allow other threads access to communications
(tasks:start-and-wait-for-server (tasks:open-db) run-id 15)
;; (nmsg-transport:client-api-send-receive run-id connection-info cmd param remtries: (- remtries 1))))))
|
|
|
<
|
|
|
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
|
;; Here, we make request to remote server
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(dat (case transport-type ;; BB: replaced *transport-type* global with run-id specific transport-type
((http)(condition-case
(http-transport:client-api-send-receive run-id connection-info cmd params)
((commfail)(vector #f "communications fail"))
((exn)(vector #f "other fail"))))
((rpc) (rpc-transport:client-api-send-receive run-id connection-info cmd params)) ;; BB: let us error out for now
(else
(debug:print-error 0 *default-log-port* "(1) Transport [" transport-type
"] specified for run-id [" run-id
"] is not implemented in rmt:send-receive. Cannot proceed." (symbol? transport-type))
(vector #f (conc "transport ["transport-type"] unimplemented")))))
(success (if (vector? dat) (vector-ref dat 0) #f))
(res (if (vector? dat) (vector-ref dat 1) #f)))
(if (vector? connection-info)(http-transport:server-dat-update-last-access connection-info)) ;; BB> BBTODO: make this generic, not http transport specific.
(if success
(begin
;; (mutex-unlock! *send-receive-mutex*)
(case transport-type
((http rpc) res) ;; (db:string->obj res))
(else
(debug:print-error 0 *default-log-port* "(2) Transport [" transport-type
"] specified for run-id [" run-id
"] is not implemented in rmt:send-receive. Cannot proceed. Also unexpected since this branch follows success which would follow a suported transport...")
#f)
)) ;; (vector-ref res 1)))
;; no success...
(begin ;; let ((new-connection-info (client:setup run-id)))
(debug:print 0 *default-log-port* "WARNING: Communication failed, trying call to rmt:send-receive again.")
(case transport-type
((http rpc)
(hash-table-delete! *runremote* run-id) ;; don't keep using the same connection
;; NOTE: killing server causes this process to block forever. No idea why. Dec 2.
;; (if (eq? (modulo attemptnum 5) 0)
;; (tasks:kill-server-run-id run-id tag: "api-send-receive-failed"))
;; (mutex-unlock! *send-receive-mutex*) ;; close the mutex here to allow other threads access to communications
(tasks:start-and-wait-for-server (tasks:open-db) run-id 15)
;; (nmsg-transport:client-api-send-receive run-id connection-info cmd param remtries: (- remtries 1))))))
|