︙ | | | ︙ | |
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
|
(define (dbfile:print-err . params)
(with-output-to-port
(current-error-port)
(lambda ()
(apply print params))))
(define (dbfile:cautious-open-database fname init-proc sync-mode journal-mode #!optional (tries-left 500))
(let* ((busy-file (conc fname"-journal"))
(delay-time (* (- 51 tries-left) 1.1))
(write-access (file-write-access? fname))
(dir-access (file-write-access? (pathname-directory fname)))
(retry (lambda ()
(thread-sleep! delay-time)
(if (> tries-left 0)
(dbfile:cautious-open-database fname init-proc
sync-mode: sync-mode journal-mode: journal-mode
(- tries-left 1))))))
(assert (>= tries-left 0) (conc "FATAL: too many attempts in dbfile:cautious-open-database of "fname", giving up."))
(if (and (file-write-access? fname)
(file-exists? busy-file))
(begin
(if (common:low-noise-print 120 busy-file)
(dbfile:print-err "INFO: dbfile:cautious-open-database: journal file "
busy-file" exists, trying again in few seconds."))
(thread-sleep! 1)
(if (eq? tries-left 2)
(begin
(dbfile:print-err "INFO: forcing journal rollup "busy-file)
(dbfile:brute-force-salvage-db fname)))
(dbfile:cautious-open-database fname init-proc sync-mode: sync-mode journal-mode: journal-mode (- tries-left 1)))
(let* ((result (condition-case
(if dir-access
(dbfile:with-simple-file-lock
(conc fname ".lock")
(lambda ()
(let* ((db-exists (file-exists? fname))
|
|
|
|
|
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
|
(define (dbfile:print-err . params)
(with-output-to-port
(current-error-port)
(lambda ()
(apply print params))))
(define (dbfile:cautious-open-database fname init-proc sync-mode journal-mode #!optional (tries-left 500))
(let* ((busy-file (conc fname "-journal"))
(delay-time (* (- 51 tries-left) 1.1))
(write-access (file-write-access? fname))
(dir-access (file-write-access? (pathname-directory fname)))
(retry (lambda ()
(thread-sleep! delay-time)
(if (> tries-left 0)
(dbfile:cautious-open-database fname init-proc
sync-mode journal-mode
(- tries-left 1))))))
(assert (>= tries-left 0) (conc "FATAL: too many attempts in dbfile:cautious-open-database of "fname", giving up."))
(if (and (file-write-access? fname)
(file-exists? busy-file))
(begin
(if (common:low-noise-print 120 busy-file)
(dbfile:print-err "INFO: dbfile:cautious-open-database: journal file "
busy-file" exists, trying again in few seconds."))
(thread-sleep! 1)
(if (eq? tries-left 2)
(begin
(dbfile:print-err "INFO: forcing journal rollup "busy-file)
(dbfile:brute-force-salvage-db fname)))
(dbfile:cautious-open-database fname init-proc sync-mode journal-mode (- tries-left 1)))
(let* ((result (condition-case
(if dir-access
(dbfile:with-simple-file-lock
(conc fname ".lock")
(lambda ()
(let* ((db-exists (file-exists? fname))
|
︙ | | | ︙ | |
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
|
(dbfile:print-err "INFO: db:lock-and-delta-sync copying db "runid" at "(current-seconds))
(set! *db-sync-in-progress* #t)
(db:sync-touched dbstruct runid keys dbinit)
(set! *db-sync-in-progress* #f)
(delete-file* lock-file)
#t)
(begin
(dbfile:print-err "INFO: could not get lock for " from-db-file ", sync likely in progress.")
#f
))))
;; ;; Get a lock from the no-sync-db for the from-db, then delta sync the from-db to the to-db, otherwise return #f
;; ;;
;; (define (db:lock-and-delta-sync-orig no-sync-db dbstruct from-db-file runid keys dbinit)
;; (assert (not *db-sync-in-progress*) "FATAL: db:lock-and-sync called while a sync is in progress.")
|
>
|
|
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
|
(dbfile:print-err "INFO: db:lock-and-delta-sync copying db "runid" at "(current-seconds))
(set! *db-sync-in-progress* #t)
(db:sync-touched dbstruct runid keys dbinit)
(set! *db-sync-in-progress* #f)
(delete-file* lock-file)
#t)
(begin
(if (common:low-noise-print 120 (conc "no lock "from-db-file))
(dbfile:print-err "INFO: could not get lock for " from-db-file ", sync likely in progress."))
#f
))))
;; ;; Get a lock from the no-sync-db for the from-db, then delta sync the from-db to the to-db, otherwise return #f
;; ;;
;; (define (db:lock-and-delta-sync-orig no-sync-db dbstruct from-db-file runid keys dbinit)
;; (assert (not *db-sync-in-progress*) "FATAL: db:lock-and-sync called while a sync is in progress.")
|
︙ | | | ︙ | |
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
|
'("owner" #f)
'("description" #f)
'("reviewed" #f)
'("iterated" #f)
'("avg_runtime" #f)
'("avg_disk" #f)
'("tags" #f)
'("jobgroup" #f)))))
(define (db:sync-all-tables-list dbstruct keys)
(append (db:sync-main-list dbstruct keys)
db:sync-tests-only))
;; tbls is ( ("tablename" ( "field1" [#f|proc1] ) ( "field2" [#f|proc2] ) .... ) )
;; db's are dbdat's
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
|
'("owner" #f)
'("description" #f)
'("reviewed" #f)
'("iterated" #f)
'("avg_runtime" #f)
'("avg_disk" #f)
'("tags" #f)
'("jobgroup" #f))
(list "tasks_queue"
'("id" #f)
'("action" #f)
'("owner" #f)
'("state" #f)
'("target" #f)
'("name" #f)
'("testpatt" #f)
'("keylock" #f)
'("params" #f)
'("creation_time" #f)
'("execution_time" #f))
)))
(define (db:sync-all-tables-list dbstruct keys)
(append (db:sync-main-list dbstruct keys)
db:sync-tests-only))
;; tbls is ( ("tablename" ( "field1" [#f|proc1] ) ( "field2" [#f|proc2] ) .... ) )
;; db's are dbdat's
|
︙ | | | ︙ | |
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
|
(define dbfile:db-init-proc (make-parameter #f))
;; (db:with-db dbstruct run-id sqlite3:exec "select blah fgrom blaz;")
;; r/w is a flag to indicate if the db is modified by this query #t = yes, #f = no
;;
(define (db:with-db dbstruct run-id r/w proc . params)
(let* ((use-mutex (> *api-process-request-count* 25)) ;; risk of db corruption
(have-struct (dbr:dbstruct? dbstruct))
(dbdat (if have-struct ;; this stuff just allows us to call with a db handle directly
(db:open-db dbstruct run-id (dbfile:db-init-proc)) ;; (dbfile:get-subdb dbstruct run-id)
#f))
(db (if have-struct ;; this stuff just allows us to call with a db handle directly
(dbr:dbdat-dbh dbdat)
dbstruct))
(fname (if dbdat
(dbr:dbdat-dbfile dbdat)
"nofilenameavailable"))
(jfile (conc fname"-journal"))
#;(subdb (if have-struct
(dbfile:get-subdb dbstruct run-id)
#f))
) ;; was 25
(if (file-exists? jfile)
(begin
(dbfile:print-err "INFO: "jfile" exists, delaying to reduce database load")
(thread-sleep! 0.2)))
(if (and use-mutex
(common:low-noise-print 120 "over-50-parallel-api-requests"))
(dbfile:print-err *api-process-request-count* " parallel api requests being processed in process "
|
>
>
>
|
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
|
(define dbfile:db-init-proc (make-parameter #f))
;; (db:with-db dbstruct run-id sqlite3:exec "select blah fgrom blaz;")
;; r/w is a flag to indicate if the db is modified by this query #t = yes, #f = no
;;
(define (db:with-db dbstruct run-id r/w proc . params)
(assert dbstruct "FATAL: db:with-db called with dbstruct "#f)
(assert (dbr:dbstruct? dbstruct) "FATAL: dbstruct is "dbstruct)
(let* ((use-mutex (> *api-process-request-count* 25)) ;; risk of db corruption
(have-struct (dbr:dbstruct? dbstruct))
(dbdat (if have-struct ;; this stuff just allows us to call with a db handle directly
(db:open-db dbstruct run-id (dbfile:db-init-proc)) ;; (dbfile:get-subdb dbstruct run-id)
#f))
(db (if have-struct ;; this stuff just allows us to call with a db handle directly
(dbr:dbdat-dbh dbdat)
dbstruct))
(fname (if dbdat
(dbr:dbdat-dbfile dbdat)
"nofilenameavailable"))
(jfile (conc fname"-journal"))
#;(subdb (if have-struct
(dbfile:get-subdb dbstruct run-id)
#f))
) ;; was 25
(assert (sqlite3:database? db) "FATAL: db:with-db, db is not a database, db="db", fname="fname)
(if (file-exists? jfile)
(begin
(dbfile:print-err "INFO: "jfile" exists, delaying to reduce database load")
(thread-sleep! 0.2)))
(if (and use-mutex
(common:low-noise-print 120 "over-50-parallel-api-requests"))
(dbfile:print-err *api-process-request-count* " parallel api requests being processed in process "
|
︙ | | | ︙ | |