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
|
(when (eq? (modulo attemptnum 5) 0)
(debug:print-error 0 *default-log-port* "rmt:send-receive did not succeed after "(sub1 attemptnum)" tries. Aborting. (cmd="cmd" rid="rid" param="params)
(exit 1))
(mutex-lock! *rmt:srmutex*) ;; deadlock is here!
;; expire connections
(let ((expire-time (- (current-seconds) (server:get-timeout) 10))) ;; don't forget the 10 second margin
(for-each
(lambda (run-id)
(let ((connection (rmt:get-cinfo run-id)))
(if (and (vector? connection)
(< (http-transport:server-dat-get-last-access connection) expire-time)) ;; BB> BBTODO: make this generic, not http transport specific.
(begin
(debug:print-info 0 *default-log-port* "Discarding connection to server for run-id " run-id ", too long between accesses")
(hash-table-delete! *runremote* run-id)))))
(hash-table-keys *runremote*)))
(let* ((run-id (if rid rid 0))
(connection-info (rmt:get-connection-info-start-server-if-none run-id)))
;; the nmsg method does the encoding under the hood (the http method should be changed to do this also)
(BB> "in rmt:send-receive; run-id="run-id";;connection-info="connection-info)
(if connection-info
;; use the server if have connection info
(let* ((transport-type (rmt:run-id->transport-type run-id))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Here, we make request to remote server
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
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
|
(when (eq? (modulo attemptnum 5) 0)
(debug:print-error 0 *default-log-port* "rmt:send-receive did not succeed after "(sub1 attemptnum)" tries. Aborting. (cmd="cmd" rid="rid" param="params)
(exit 1))
(mutex-lock! *rmt:srmutex*) ;; deadlock is here!
;; expire connections
(let ((expire-time (- (current-seconds) (server:get-timeout) 60))) ;; don't forget the 60 second margin
(for-each
(lambda (run-id)
(let ((connection (rmt:get-cinfo run-id)))
(if (and (vector? connection)
(< (http-transport:server-dat-get-last-access connection) expire-time)) ;; BB> BBTODO: make this generic, not http transport specific.
(begin
(debug:print-info 0 *default-log-port* "Discarding connection to server for run-id " run-id ", too long between accesses")
(hash-table-delete! *runremote* run-id)))))
(hash-table-keys *runremote*)))
(let* ((run-id (if rid rid 0))
(connection-info (rmt:get-connection-info-start-server-if-none run-id)))
;; the nmsg method does the encoding under the hood (the http method should be changed to do this also)
;;(BB> "in rmt:send-receive; run-id="run-id";;connection-info="connection-info)
(if connection-info
;; use the server if have connection info
(let* ((transport-type (rmt:run-id->transport-type run-id))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Here, we make request to remote server
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
|
"] 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)))
(BB> "in rmt:send-receive; transport-type="transport-type" success="success" connection-info="connection-info" res="res " dat="dat)
(if (and success (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! *rmt:srmutex*)
;; (mutex-unlock! *send-receive-mutex*)
(case transport-type
|
|
|
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
|
"] 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)))
;;(BB> "in rmt:send-receive; transport-type="transport-type" success="success" connection-info="connection-info" res="res " dat="dat)
(if (and success (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! *rmt:srmutex*)
;; (mutex-unlock! *send-receive-mutex*)
(case transport-type
|