513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
|
(mtdbfile (conc *toppath* "/megatest.db"))
(lockfile (conc tmp-db ".lock"))
(sync-cmd (conc sqlite-exe" " tmp-db " .dump | "sqlite-exe" " staging-file "&>"sync-log))
(min-intersync-delay (configf:lookup-number *configdat* "server" "minimum-intersync-delay" default: 30)))
(if (and (not (args:get-arg "-sync-to-megatest.db")) ;; conditions under which we do not run the sync
(args:get-arg "-server"))
(let loop ()
(thread-sleep! min-intersync-delay)
(if (common:simple-file-lock lockfile)
(begin
(if (not (configf:lookup *configdat* "server" "disable-db-snapshot"))
(common:snapshot-file mtdbfile subdir: ".db-snapshot"))
(delete-file* staging-file)
(let ((start-time (current-milliseconds))
(res (system sync-cmd)))
(cond
((eq? 0 res)
(delete-file* (conc mtdbfile ".backup"))
(system (conc "/bin/mv " staging-file " " mtdbfile))
(debug:print 1 *default-log-port* "INFO: ["(common:human-time)"] SYNC took "(/ (- (current-milliseconds) start-time))" sec")
#t)
(else
(system (conc "/bin/cp "sync-log" "sync-log".fail"))
(debug:print 0 *default-log-port* "ERROR: ["(common:human-time)"] Sync failed. See log at "sync-log".fail")
(if (file-exists? (conc mtdbfile ".backup"))
(system (conc "/bin/cp "mtdbfile ".backup " mtdbfile)))))
(common:simple-file-release-lock lockfile)))
;; else
(debug:print 1 *default-log-port* "INFO: ["(common:human-time)"] other sync in progres; not syncing.")
) ;; end if got lockfile
;; 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*)
|
>
|
|
|
|
|
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
|
(mtdbfile (conc *toppath* "/megatest.db"))
(lockfile (conc tmp-db ".lock"))
(sync-cmd (conc sqlite-exe" " tmp-db " .dump | "sqlite-exe" " staging-file "&>"sync-log))
(min-intersync-delay (configf:lookup-number *configdat* "server" "minimum-intersync-delay" default: 30)))
(if (and (not (args:get-arg "-sync-to-megatest.db")) ;; conditions under which we do not run the sync
(args:get-arg "-server"))
(let loop ()
(debug:print 0 *default-log-port* "INFO: syncer thread sleeping for server.minimum-intersync-delay seconds ["min-intersync-delay"]")
(thread-sleep! min-intersync-delay)
(if (common:simple-file-lock lockfile)
(begin
(if (not (configf:lookup *configdat* "server" "disable-db-snapshot"))
(common:snapshot-file mtdbfile subdir: ".db-snapshot"))
(delete-file* staging-file)
(let* ((start-time (current-milliseconds))
(res (system sync-cmd)))
(cond
((eq? 0 res)
(delete-file* (conc mtdbfile ".backup"))
(system (conc "/bin/mv " staging-file " " mtdbfile))
(debug:print 1 *default-log-port* "INFO: ["(common:human-time)"] pid="(current-process-id)" SYNC took "(/ (- (current-milliseconds) start-time) 1000)" sec")
#t)
(else
(system (conc "/bin/cp "sync-log" "sync-log".fail"))
(debug:print 0 *default-log-port* "ERROR: ["(common:human-time)"] Sync failed. See log at "sync-log".fail")
(if (file-exists? (conc mtdbfile ".backup"))
(system (conc "/bin/cp "mtdbfile ".backup " mtdbfile)))))
(common:simple-file-release-lock lockfile)))
;; else
(debug:print 1 *default-log-port* "INFO: ["(common:human-time)"] pid="(current-process-id)" other SYNC in progress; not syncing.")
) ;; end if got lockfile
;; 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*)
|