501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
|
;; (else #f))))
;; moving this here as it needs access to db and cannot be in common.
;;
(define (server:writable-watchdog dbstruct)
(thread-sleep! 10) ;; delay for startup
(let* ((legacy-sync (common:run-sync?))
(tmp-area (common:get-db-tmp-area))
(tmp-db (conc tmp-area "/megatest.db"))
(staging-file (conc *toppath* "/.megatest.db"))
(mtdbfile (conc *toppath* "/megatest.db"))
(lockfile (conc tmp-db ".lock"))
(cmdline (conc "megatest -sync-to-megatest.db "
(if (args:get-arg "-log")
(conc " -log " (args:get-arg "-log"))
(conc *toppath* "/logs/sync-" (current-process-id) "-" (get-host-name) ".log"))))
(system (conc "sqlite3 " tmp-db " .dump | sqlite3 " staging-file))
(delete-file* (conc mtdbfile ".backup"))
(system (conc "mv " staging-file " " mtdbfile))
;; (system "megatest -sync-to-megatest.db&"))
))
|
>
>
|
<
<
<
>
>
>
|
>
>
|
|
>
>
>
>
|
<
|
501
502
503
504
505
506
507
508
509
510
511
512
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
|
;; (else #f))))
;; moving this here as it needs access to db and cannot be in common.
;;
(define (server:writable-watchdog dbstruct)
(thread-sleep! 10) ;; delay for startup
(let* ((legacy-sync (common:run-sync?))
(sqlite-exe (or (get-shell-env-var "MT_SQLITE3_EXE"))) ;; defined in cfg.sh
(sync-log (or (args:get-arg "-sync-log") (conc *toppath* "/logs/sync-" (current-process-id) "-" (get-host-name) ".log")))
(tmp-area (common:get-db-tmp-area))
(tmp-db (conc tmp-area "/megatest.db"))
(staging-file (conc *toppath* "/.megatest.db"))
(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 (not (common:file-exists? 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: SYNC took "(/ (- (current-milliseconds) start-time))" sec")
#t)
(else
(debug:print 0 *default-log-port* "ERROR: Sync failed. See log at "sync-log)
(system (conc "mv "mtdbfile ".backup" mtdbfile)))))))
;; 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*)
|