| ︙ | | |
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
77
|
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
77
78
79
80
81
82
83
|
+
+
+
+
+
+
-
-
+
+
-
-
+
+
|
ports
commonmod
)
;; (import debugprint)
;; Parameters
(define num-run-dbs (make-parameter 10))
;;======================================================================
;; R E C O R D S
;;======================================================================
;; (define-record simple-run target id runname state status owner event_time)
;; a single Megatest area with it's multiple dbs is
;; managed in a dbstruct
;;
(defstruct dbr:dbstruct
(areapath #f)
(homehost #f)
(tmppath #f)
(read-only #f)
(subdbs (make-hash-table))
)
;; NOTE: Need one dbr:subdb per main.db, 1.db ...
;;
(defstruct dbr:subdb
(dbname #f) ;; .megatest/1.db
(mtdbfile #f) ;; mtrah/.megatest/1.db
(dbname #f) ;; " *dbdir* "/1.db
(mtdbfile #f) ;; mtrah/" *dbdir* "/1.db
(mtdbdat #f) ;; only need one of these for syncing
;; (dbdats (make-hash-table)) ;; id => dbdat
(tmpdbfile #f) ;; /tmp/.../.megatest/1.db
;; (refndbfile #f) ;; /tmp/.../.megatest/1.db_ref
(tmpdbfile #f) ;; /tmp/.../" *dbdir* "/1.db
;; (refndbfile #f) ;; /tmp/.../" *dbdir* "/1.db_ref
(dbstack (make-stack)) ;; stack for tmp dbr:dbdat,
(homehost #f) ;; not used yet
(on-homehost #f) ;; not used yet
(read-only #f)
(last-sync 0)
(last-write (current-seconds))
) ;; goal is to converge on one struct for an area but for now it is too confusing
|
| ︙ | | |
91
92
93
94
95
96
97
98
99
100
101
102
103
104
|
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
|
+
|
(define *db-sync-in-progress* #f)
(define *db-with-db-mutex* (make-mutex))
(define *max-api-process-requests* 0)
(define *api-process-request-count* 0)
(define *db-write-access* #t)
(define *db-last-sync* 0) ;; last time the sync to megatest.db happened
(define *db-multi-sync-mutex* (make-mutex)) ;; protect access to *db-sync-in-progress*, *db-last-sync*
(define *dbdir* ".mtdb")
(define (db:generic-error-printout exn . message)
(print-call-chain (current-error-port))
(apply dbfile:print-err message)
(dbfile:print-err
", error: " ((condition-property-accessor 'exn 'message) exn)
", arguments: " ((condition-property-accessor 'exn 'arguments) exn)
|
| ︙ | | |
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
|
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
|
-
-
+
+
|
(define (db:dbname->path apath dbname)
(conc apath"/"dbname))
;; POTENTIAL BUG: this implementation could produce a db file if run-id is neither #f or a number
(define (dbfile:run-id->dbname run-id)
(cond
((number? run-id) (conc ".megatest/" (modulo run-id 100) ".db"))
((not run-id) (conc ".megatest/main.db"))
((number? run-id) (conc *dbdir* "/" (modulo run-id (num-run-dbs)) ".db"))
((not run-id) (conc *dbdir* "/main.db"))
(else run-id)))
;; Make the dbstruct, setup up auxillary db's and call for main db at least once
;;
;; called in http-transport and replicated in rmt.scm for *local* access.
;;
(define (dbfile:setup do-sync areapath tmppath)
|
| ︙ | | |
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
|
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
|
-
+
+
-
+
|
(sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 30000))
(if sync-mode
(sqlite3:execute db (conc "PRAGMA synchronous = "sync-mode";")))
(if journal-mode
(sqlite3:execute db (conc "PRAGMA journal_mode = "journal-mode";")))
(if (and init-proc (not db-exists))
(init-proc db))
db)))
db))
expire-time: 30)
(begin
(if (file-exists? fname )
(let ((db (sqlite3:open-database fname)))
;; pragmas synchronous not needed because this db is used read-only
;; (sqlite3:execute db (conc "PRAGMA synchronous = "mode";")
(sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 30000)) ;; read-only but still need timeout
db )
(print "file doesn't exist: " fname))))
(print "cautious-open-database: file doesn't exist: " fname))))
(exn (io-error)
(dbfile:print-err exn "ERROR: i/o error with " fname ". Check permissions, disk space etc. and try again.")
(retry))
(exn (corrupt)
(dbfile:print-err exn "ERROR: database " fname " is corrupt. Repair it to proceed.")
(retry))
(exn (busy)
|
| ︙ | | |
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
|
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
|
-
+
+
+
|
(sqlite3:for-each-row
(lambda (a . b)
(set! fromdat (cons (apply vector a b) fromdat))
(if (> (length fromdat) batch-len)
(begin
(set! fromdats (cons fromdat fromdats))
(set! fromdat '())
(set! totrecords (+ totrecords 1)))
(set! totrecords (+ totrecords 1))
(thread-sleep! 2)
)
)
)
(dbr:dbdat-dbh fromdb)
full-sel)
)
)
|
| ︙ | | |
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
|
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
|
+
+
-
+
+
+
|
(thread-sleep! 0.25)
(if (file-exists? fname)
(handle-exceptions exn
#f
(with-input-from-file fname
(lambda ()
(equal? key-string (read-line)))))
(begin
(dbfile:print-err "dbfile:simple-file-lock created " fname " but it was gone 0.25 seconds later")
#f)
#f
)
)
)
)
)
)
(define (dbfile:simple-file-lock-and-wait fname #!key (expire-time 300))
(let ((end-time (+ expire-time (current-seconds))))
|
| ︙ | | |