34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
|
;; grep define ../rmt.scm | grep rmt: |perl -pi -e 's/\(define\s+\((\S+)\W.*$/\1/'|sort -u
;;======================================================================
;; S U P P O R T F U N C T I O N S
;;======================================================================
;;
(define (rmt:write-frequency-over-limit? cmd run-id)
(and (not (member cmd api:read-only-queries))
(let* ((tmprec (hash-table-ref/default *write-frequency* run-id #f))
(record (if tmprec tmprec
(let ((v (vector (current-seconds) 0)))
(hash-table-set! *write-frequency* run-id v)
v)))
(count (+ 1 (vector-ref record 1)))
(start (vector-ref record 0))
(queries-per-second (/ (* count 1.0)
(max (- (current-seconds) start) 1))))
(vector-set! record 1 count)
(if (and (> count 10)
(> queries-per-second 10))
(begin
(debug:print-info 1 *default-log-port* "db write rate too high, starting a server, count=" count " start=" start " run-id=" run-id " queries-per-second=" queries-per-second)
#t)
#f))))
;; NB// can cache the answer for server running for 10 seconds ...
;; ;; (and (not (rmt:write-frequency-over-limit? cmd run-id))
|
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
|
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
|
-
+
-
+
+
-
-
+
+
+
|
;; no connection info? try to start a server, or access locally if no
;; server and the query is read-only
;;
;; Note: The tasks db was checked for a server in starting mode in the rmt:get-connection-info call
;;
(if (and (< attemptnum 15)
(member cmd api:write-queries))
(let ((faststart (configf:lookup *configdat* "server" "faststart")))
(let ((homehost (common:get-homehost))) ;; faststart (configf:lookup *configdat* "server" "faststart")))
(hash-table-delete! *runremote* run-id)
;; (mutex-unlock! *send-receive-mutex*)
(if (and faststart (equal? faststart "no"))
(if (not (cdr homehost)) ;; we always require a server if not on homehost ;; (and faststart (equal? faststart "no"))
(begin
(tasks:start-and-wait-for-server (db:delay-if-busy (tasks:open-db)) run-id 10)
(thread-sleep! (random 5)) ;; give some time to settle and minimize collison?
(rmt:send-receive cmd rid params attemptnum: (+ attemptnum 1)))
;; NB - probably can remove the query time stuff but need to discuss it ....
(let ((start-time (current-milliseconds))
(max-query (string->number (or (configf:lookup *configdat* "server" "server-query-threshold")
"300")))
(newres (rmt:open-qry-close-locally cmd run-id params)))
(let ((delta (- (current-milliseconds) start-time)))
(if (> delta max-query)
(begin
(debug:print-info 0 *default-log-port* "Starting server as query time " delta " is over the limit of " max-query)
(server:kind-run run-id)))
(debug:print-info 0 *default-log-port* "WARNING: long query times, you may have an overloaded homehost.") ;; Starting server as query time " delta " is over the limit of " max-query)
;; (server:kind-run run-id)))
))
;; return the result!
newres)
)))
(begin
;; (debug:print-error 0 *default-log-port* "Communication failed!")
;; (mutex-unlock! *send-receive-mutex*)
;; (exit)
|