74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
;;
(define (rmt:get-connection-info run-id area-dat #!key (remote #f))
(let ((cinfo (common:get-remote remote run-id)))
(if cinfo
cinfo
;; NB// can cache the answer for server running for 10 seconds ...
;; ;; (and (not (rmt:write-frequency-over-limit? cmd run-id))
(if (tasks:server-running-or-starting? (db:delay-if-busy (tasks:open-db area-dat)) run-id)
(client:setup run-id area-dat remote: remote)
#f))))
(define (rmt:discard-old-connections area-dat)
;; clean out old connections
(mutex-lock! *db-multi-sync-mutex*)
(let ((remote (megatest:area-remote area-dat))
|
|
|
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
;;
(define (rmt:get-connection-info run-id area-dat #!key (remote #f))
(let ((cinfo (common:get-remote remote run-id)))
(if cinfo
cinfo
;; NB// can cache the answer for server running for 10 seconds ...
;; ;; (and (not (rmt:write-frequency-over-limit? cmd run-id))
(if (tasks:server-running-or-starting? (db:delay-if-busy (tasks:open-db area-dat) area-dat) run-id)
(client:setup run-id area-dat remote: remote)
#f))))
(define (rmt:discard-old-connections area-dat)
;; clean out old connections
(mutex-lock! *db-multi-sync-mutex*)
(let ((remote (megatest:area-remote area-dat))
|
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
|
(if (and faststart (equal? faststart "no"))
(begin
(tasks:start-and-wait-for-server (db:delay-if-busy (tasks:open-db area-dat)) run-id 10)
(thread-sleep! (random 5)) ;; give some time to settle and minimize collison?
(rmt:send-receive cmd rid params area-dat attemptnum: (+ attemptnum 1)))
(begin
(server:kind-run run-id area-dat)
(rmt:open-qry-close-locally cmd run-id params area-dat))))
(begin
;; (debug:print 0 "ERROR: Communication failed!")
;; (mutex-unlock! *send-receive-mutex*)
;; (exit)
(rmt:open-qry-close-locally cmd run-id params area-dat)
)))))
(define (rmt:update-db-stats run-id rawcmd params duration)
(mutex-lock! *db-stats-mutex*)
(handle-exceptions
exn
(begin
|
|
|
|
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
|
(if (and faststart (equal? faststart "no"))
(begin
(tasks:start-and-wait-for-server (db:delay-if-busy (tasks:open-db area-dat)) run-id 10)
(thread-sleep! (random 5)) ;; give some time to settle and minimize collison?
(rmt:send-receive cmd rid params area-dat attemptnum: (+ attemptnum 1)))
(begin
(server:kind-run run-id area-dat)
(rmt:open-qry-close-locally cmd run-id area-dat params area-dat))))
(begin
;; (debug:print 0 "ERROR: Communication failed!")
;; (mutex-unlock! *send-receive-mutex*)
;; (exit)
(rmt:open-qry-close-locally cmd run-id area-dat params area-dat)
)))))
(define (rmt:update-db-stats run-id rawcmd params duration)
(mutex-lock! *db-stats-mutex*)
(handle-exceptions
exn
(begin
|
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
|
(if (> tot 10)
(cons newmax-cmd currmax)
(cons 'none 0))
(loop (car tal)(cdr tal) newmax-cmd currmax)))))))
(mutex-unlock! *db-stats-mutex*)
res))
(define (rmt:open-qry-close-locally cmd run-id params #!key (remretries 5))
(let* ((dbstruct-local (if *dbstruct-db*
*dbstruct-db*
(let* ((dbdir (db:dbfile-path #f))
(db (make-dbr:dbstruct path: dbdir local: #t)))
(set! *dbstruct-db* db)
db)))
(db-file-path (db:dbfile-path 0))
;; (read-only (not (file-read-access? db-file-path)))
(start (current-milliseconds))
(resdat (api:execute-requests dbstruct-local (vector (symbol->string cmd) params)))
(success (vector-ref resdat 0))
(res (vector-ref resdat 1))
(duration (- (current-milliseconds) start)))
(if (not success)
(if (> remretries 0)
(begin
(debug:print 0 "ERROR: local query failed. Trying again.")
(thread-sleep! (/ (random 5000) 1000)) ;; some random delay
(rmt:open-qry-close-locally cmd run-id params remretries: (- remretries 1)))
(begin
(debug:print 0 "ERROR: too many retries in rmt:open-qry-close-locally, giving up")
#f))
(begin
(rmt:update-db-stats run-id cmd params duration)
;; mark this run as dirty if this was a write
(if (not (member cmd api:read-only-queries))
|
|
|
|
|
|
|
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
|
(if (> tot 10)
(cons newmax-cmd currmax)
(cons 'none 0))
(loop (car tal)(cdr tal) newmax-cmd currmax)))))))
(mutex-unlock! *db-stats-mutex*)
res))
(define (rmt:open-qry-close-locally cmd run-id area-dat params #!key (remretries 5))
(let* ((dbstruct-local (if *dbstruct-db*
*dbstruct-db*
(let* ((dbdir (db:dbfile-path #f area-dat))
(db (make-dbr:dbstruct path: dbdir local: #t)))
(set! *dbstruct-db* db)
db)))
(db-file-path (db:dbfile-path 0 area-dat))
;; (read-only (not (file-read-access? db-file-path)))
(start (current-milliseconds))
(resdat (api:execute-requests dbstruct-local area-dat (vector (symbol->string cmd) params)))
(success (vector-ref resdat 0))
(res (vector-ref resdat 1))
(duration (- (current-milliseconds) start)))
(if (not success)
(if (> remretries 0)
(begin
(debug:print 0 "ERROR: local query failed. Trying again.")
(thread-sleep! (/ (random 5000) 1000)) ;; some random delay
(rmt:open-qry-close-locally cmd run-id area-dat params remretries: (- remretries 1)))
(begin
(debug:print 0 "ERROR: too many retries in rmt:open-qry-close-locally, giving up")
#f))
(begin
(rmt:update-db-stats run-id cmd params duration)
;; mark this run as dirty if this was a write
(if (not (member cmd api:read-only-queries))
|