65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
|
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
|
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
|
(if (tasks:server-running-or-starting? (db:delay-if-busy (tasks:open-db)) run-id)
(client:setup run-id)
#f))))
(define (rmt:send-receive cmd rid params #!key (attemptnum 0))
;; clean out old connections
(mutex-lock! *db-multi-sync-mutex*)
(let ((expire-time (- (current-seconds) 60)))
(for-each
(lambda (run-id)
(let ((connection (hash-table-ref/default *runremote* run-id #f)))
(if (and connection
(< (http-transport:server-dat-get-last-access connection) expire-time))
(begin
(debug:print-info 0 "Discarding connection to server for run-id " run-id ", too long between accesses")
;; SHOULD CLOSE THE CONNECTION HERE
(hash-table-delete! *runremote* run-id)))))
(hash-table-keys *runremote*)))
;; (let ((expire-time (- (current-seconds) 60)))
;; (for-each
;; (lambda (run-id)
;; (let ((connection (hash-table-ref/default *runremote* run-id #f)))
;; (if (and connection
;; (< (http-transport:server-dat-get-last-access connection) expire-time))
;; (begin
;; (debug:print-info 0 "Discarding connection to server for run-id " run-id ", too long between accesses")
;; ;; SHOULD CLOSE THE CONNECTION HERE
;; (hash-table-delete! *runremote* run-id)))))
;; (hash-table-keys *runremote*)))
(mutex-unlock! *db-multi-sync-mutex*)
(let* ((run-id (if rid rid 0))
(connection-info (rmt:get-connection-info run-id))
(jparams (db:obj->string params)))
;; the nmsg method does the encoding under the hood (the http method should be changed to do this also)
(if connection-info
;; use the server if have connection info
|
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
|
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
;; (nmsg-transport:client-api-send-receive run-id connection-info cmd param remtries: (- remtries 1))))))
;; no longer killing the server in http-transport:client-api-send-receive
;; may kill it here but what are the criteria?
;; start with three calls then kill server
;; (if (eq? attemptnum 3)(tasks:kill-server-run-id run-id))
;; (thread-sleep! 2)
(rmt:send-receive cmd run-id params attemptnum: (+ attemptnum 1))))))
(if (and (< attemptnum 10)
(tasks:need-server run-id))
(begin
(tasks:start-and-wait-for-server (db:delay-if-busy (tasks:open-db)) run-id 10)
(hash-table-delete! *runremote* run-id)
(client:setup run-id)
(rmt:send-receive cmd rid params attemptnum: (+ attemptnum 1)))
(rmt:open-qry-close-locally cmd run-id params))))
(rmt:send-receive cmd run-id params attemptnum: (+ attemptnum 1)))))
;; no connection info? try to start a server
(if (and (< attemptnum 10)
(tasks:need-server run-id))
(begin
(tasks:start-and-wait-for-server (db:delay-if-busy (tasks:open-db)) run-id 10)
(hash-table-delete! *runremote* run-id)
(client:setup run-id)
(thread-sleep! (random 5)) ;; give some time to settle and minimize collison?
(rmt:send-receive cmd rid params attemptnum: (+ attemptnum 1)))
(begin
(debug:print 0 "ERROR: Communication failed!")
(exit)
;; (rmt:open-qry-close-locally cmd run-id params))))
)))))
(define (rmt:update-db-stats run-id rawcmd params duration)
(mutex-lock! *db-stats-mutex*)
(handle-exceptions
exn
(begin
(debug:print 0 "WARNING: stats collection failed in update-db-stats")
|