50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
|
+
+
+
+
+
+
+
+
+
|
(remote-conndat runremote)
#f)))
(if cinfo
cinfo
(if (server:check-if-running areapath)
(client:setup areapath)
#f))))
(define (rmt:on-homehost? runremote)
(let* ((hh-dat (remote-hh-dat runremote)))
(if (pair? hh-dat)
(cdr hh-dat)
(begin
(debug:print-info 0 *default-log-port* "hh-dat="hh-dat)
#f))))
;;======================================================================
(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))
;;
|
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
+
-
+
|
;; DOT SET_HOMEHOST; // leaving off - doesn't really add to the clarity
;; DOT MUTEXLOCK -> SET_HOMEHOST [label="no homehost?"];
;; DOT SET_HOMEHOST -> MUTEXLOCK;
;; ensure we have a homehost record
(if (not (pair? (remote-hh-dat runremote))) ;; not on homehost
(thread-sleep! 0.1) ;; since we shouldn't get here, delay a little
(let ((hh-data (server:choose-server areapath 'homehost)))
(remote-hh-dat-set! runremote (common:get-homehost)))
(remote-hh-dat-set! runremote (or hh-data (cons #f #f)))))
;;(print "BB> readonly-mode is "readonly-mode" dbfile is "dbfile)
(cond
#;((> (- (current-seconds)(remote-connect-time runremote)) 180) ;; reconnect to server every 180 seconds
(debug:print 0 *default-log-port* "Forcing reconnect to server(s) due to 180 second timeout.")
(set! *runremote* #f)
;; BUG: close-connections should go here?
|
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
|
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
|
-
+
+
+
+
-
+
|
;;DOT CASE5 [label="local\nread"];
;;DOT MUTEXLOCK -> CASE5 [label="server not required,\non homehost,\nread-only query"]; {rank=same "case 5" CASE5};
;;DOT CASE5 -> "rmt:open-qry-close-locally";
;; on homehost and this is a read
((and (not (remote-force-server runremote)) ;; honor forced use of server, i.e. server NOT required
(cdr (remote-hh-dat runremote)) ;; on homehost
(rmt:on-homehost? runremote)
(member cmd api:read-only-queries)) ;; this is a read
(mutex-unlock! *rmt-mutex*)
(debug:print-info 12 *default-log-port* "rmt:send-receive, case 5")
(rmt:open-qry-close-locally cmd 0 params))
;;DOT CASE6 [label="init\nremote"];
;;DOT MUTEXLOCK -> CASE6 [label="on homehost,\nwrite query,\nhave server,\ncan't reach it"]; {rank=same "case 6" CASE6};
;;DOT CASE6 -> "rmt:send-receive";
;; on homehost and this is a write, we already have a server, but server has died
;; reinstate this keep-alive section but inject a time condition into the (add ...
((and (cdr (remote-hh-dat runremote)) ;; on homehost
#;((and (cdr (remote-hh-dat runremote)) ;; on homehost
(not (member cmd api:read-only-queries)) ;; this is a write
(remote-server-url runremote) ;; have a server
(not (server:ping (remote-server-url runremote) (remote-server-id runremote)))) ;; server has died. NOTE: this is not a cheap call! Need better approach.
(debug:print 0 *default-log-port* "WARNING: server appears to have died, trying to reconnect, case 6")
(http-transport:close-connections area-dat: runremote) ;; make sure to clean up
(set! *runremote* (make-remote))
(let* ((server-info (remote-server-info *runremote*)))
|