| ︙ | | |
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
|
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
|
-
-
+
+
-
-
-
+
-
-
-
-
-
+
+
-
-
+
+
+
+
|
;; if run-id is a string treat it as a filename
;; if db already open - return inmem
;; if db not open, open inmem, rundb and sync then return inmem
;; inuse gets set automatically for rundb's
;;
;; (define db:get-db db:get-subdb)
;; (define (db:get-db subdb #;dbstruct run-id) ;; RENAME TO db:get-dbh
;; ;; (let* ((subdb (dbfile:get-subdb dbstruct run-id)))
;; (if (stack? (dbr:subdb-dbstack subdb))
;; (if (stack-empty? (dbr:subdb-dbstack subdb))
;; (let* ((dbname (db:run-id->dbname run-id))
;; (newdb (db:open-megatest-db path: (db:dbfile-path)
;; name: dbname)))
;; ;; NOTE: pushing on the stack only happens AFTER the handle has been used
;; ;; (stack-push! (dbr:dbstruct-dbstack dbstruct) newdb)
;; newdb)
;; (stack-pop! (dbr:subdb-dbstack subdb)))
;; (db:open-db subdb run-id))) ;; )
|
| ︙ | | |
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
|
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(use-mutex (> *api-process-request-count* 25))) ;; was 25
(if (and use-mutex
(common:low-noise-print 120 "over-50-parallel-api-requests"))
(debug:print-info 0 *default-log-port* *api-process-request-count* " parallel api requests being processed in process " (current-process-id) ", throttling access"))
(if (common:low-noise-print 600 (conc "parallel-api-requests" *max-api-process-requests*))
(debug:print-info 2 *default-log-port* "Parallel api request count: " *api-process-request-count* " max parallel requests: " *max-api-process-requests*))
(condition-case
(begin
(if use-mutex (mutex-lock! *db-with-db-mutex*))
(let ((res (apply proc dbdat db params)))
(if use-mutex (mutex-unlock! *db-with-db-mutex*))
;; (if (vector? dbstruct)(db:done-with dbstruct run-id r/w))
(if dbdat (stack-push! (dbr:subdb-dbstack subdb) dbdat))
res))
(exn (io-error)
(db:generic-error-printout exn "ERROR: i/o error with " fname ". Check permissions, disk space etc. and try again."))
(exn (corrupt)
(db:generic-error-printout exn "ERROR: database " fname " is corrupt. Repair it to proceed."))
(exn (busy)
(db:generic-error-printout exn "ERROR: database " fname
" is locked. Try copying to another location, remove original and copy back."))
(exn (permission)(db:generic-error-printout exn "ERROR: database " fname " has some permissions problem."))
(exn ()
(db:generic-error-printout exn "ERROR: Unknown error with database " fname " message: "
((condition-property-accessor 'exn 'message) exn))))))
|
| ︙ | | |
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
|
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(db:with-db dbstruct #f #t
(lambda (dbdat db)
(sqlite3:execute db "DELETE FROM metadat WHERE var=?;" var))))
;;======================================================================
;; no-sync.db - small bits of data to be shared between servers
;;======================================================================
(define (db:no-sync-db db-in)
(if db-in
db-in
(if *no-sync-db*
*no-sync-db*
(begin
(mutex-lock! *db-access-mutex*)
(let ((dbpath (common:get-db-tmp-area))
(db (dbfile:open-no-sync-db dbpath)))
(set! *no-sync-db* db)
(mutex-unlock! *db-access-mutex*)
db)))))
(define (with-no-sync-db proc)
(let* ((db (db:no-sync-db *no-sync-db*)))
(proc db)))
(define (db:open-no-sync-db)
(dbfile:open-no-sync-db (db:dbfile-path)))
(define (db:no-sync-close-db db stmt-cache)
(db:safely-close-sqlite3-db db stmt-cache))
|
| ︙ | | |
5007
5008
5009
5010
5011
5012
5013
5014
5015
5016
5017
5018
5019
5020
5021
5022
|
5021
5022
5023
5024
5025
5026
5027
5028
5029
5030
5031
5032
5033
5034
5035
5036
5037
5038
5039
5040
5041
5042
5043
5044
|
+
-
-
+
+
+
+
+
+
+
+
+
|
(dbfiles (glob (conc tmp-area"/.db/*.db")))
(sync-durations (make-hash-table)))
;; (debug:print-info 0 *default-log-port* "lock-and-sync, dbfiles: "dbfiles)
(for-each
(lambda (file)
(let* ((fname (conc (pathname-file file) ".db"))
(fulln (conc *toppath*"/.db/"fname))
(time1 (if (file-exists? file)
(time1 (file-modification-time file))
(time2 (file-modification-time fulln))
(file-modification-time file)
(begin
(debug:print-info 0 *default-log-port* "Sync - I do not see file "file)
1)))
(time2 (if (file-exists? fulln)
(file-modification-time fulln)
(begin
(debug:print-info 0 *default-log-port* "Sync - I do not see file "fulln)
0)))
(changed (> time1 time2))
(do-cp (cond
((not (file-exists? fulln)) ;; shouldn't happen, but this might recover
(debug:print-info 0 *default-log-port* "File "fulln" not found! Copying "fname" to "fulln)
#t)
(changed ;; (and changed
;; (> (- (current-seconds) time1) 3)) ;; if file is changed and three seconds have passed.
|
| ︙ | | |
5059
5060
5061
5062
5063
5064
5065
5066
5067
5068
5069
5070
5071
5072
5073
|
5081
5082
5083
5084
5085
5086
5087
5088
5089
5090
5091
5092
5093
5094
5095
5096
5097
|
+
+
-
+
|
(if (and legacy-sync (not *time-to-exit*))
(begin
(debug:print-info 0 *default-log-port* "Server running, periodic copy-based sync started.")
(let loop ()
;; run the sync and print out durations
(let* ((changed (db:run-lock-and-sync no-sync-db)))
(if (not (null? changed))
(debug:print-info 0 *default-log-port* "Sync durations: "(db:run-lock-and-sync no-sync-db))
(debug:print-info 0 *default-log-port* "Sync durations: "changed)))
;; keep going unless time to exit
;;
(if (not *time-to-exit*)
(let delay-loop ((count 0))
;;(debug:print-info 13 *default-log-port* "delay-loop top; count="count" pid="(current-process-id)" this-wd-num="this-wd-num" *time-to-exit*="*time-to-exit*)
(if (and (not *time-to-exit*)
|
| ︙ | | |