670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
|
(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 "ERROR: could not get lock for " from-db-file " from no-sync-db")
#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.")
;; (dbfile:print-err *default-log-port* "db:lock-and-delta-sync")
(let* ((lockdat (db:no-sync-get-lock-timeout no-sync-db from-db-file 60))
(gotlock (car lockdat))
(locktime (cdr lockdat)))
;; (debug:print-info 3 *default-log-port* "db:lock-and-delta-sync: got lock?")
(if gotlock
(begin
(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)
(db:no-sync-del! no-sync-db from-db-file)
#t)
(begin
(dbfile:print-err "ERROR: could not get lock for " from-db-file " from no-sync-db")
#f
))))
;; sync run from tmp disk to nfs disk if touched
;;
;; call with dbinit=db:initialize-main-db
;;
(define (db:sync-touched dbstruct run-id keys #!key dbinit (force-sync #f))
(dbfile:print-err "db:sync-touched Syncing: " (conc (if run-id run-id "main") ".db"))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
|
(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.")
;; ;; (dbfile:print-err *default-log-port* "db:lock-and-delta-sync")
;; (let* ((lockdat (db:no-sync-get-lock-timeout no-sync-db from-db-file 60))
;; (gotlock (car lockdat))
;; (locktime (cdr lockdat)))
;; ;; (debug:print-info 3 *default-log-port* "db:lock-and-delta-sync: got lock?")
;;
;; (if gotlock
;; (begin
;; (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)
;; (db:no-sync-del! no-sync-db from-db-file)
;; #t)
;; (begin
;; (dbfile:print-err "ERROR: could not get lock for " from-db-file " from no-sync-db")
;; #f
;; ))))
;; sync run from tmp disk to nfs disk if touched
;;
;; call with dbinit=db:initialize-main-db
;;
(define (db:sync-touched dbstruct run-id keys #!key dbinit (force-sync #f))
(dbfile:print-err "db:sync-touched Syncing: " (conc (if run-id run-id "main") ".db"))
|