Overview
| Comment: | Added sync file age checking to -db2db |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.80 |
| Files: | files | file ages | folders |
| SHA1: |
72065b6c5e063123ab01ea9e519e4bc4 |
| User & Date: | mmgraham on 2023-09-25 19:04:20 |
| Other Links: | branch diff | manifest | tags |
Context
|
2023-10-06
| ||
| 16:56 | Fixed dbmod:attach-sync so that it works for the non-id rows. Adjusted some log messages. Removed old lock files check-in: 1e29e5e90e user: mmgraham tags: v1.80 | |
|
2023-09-29
| ||
| 08:17 | Merged fork check-in: 35feb6b8db user: mrwellan tags: v1.80-processes | |
|
2023-09-25
| ||
| 19:04 | Added sync file age checking to -db2db check-in: 72065b6c5e user: mmgraham tags: v1.80 | |
| 19:02 | Corrected 20 second age check for sync lock file. Added exception handler for a sqlite3:with-transaction. check-in: 8f8169ac4d user: mmgraham tags: v1.80 | |
Changes
Modified megatest.scm from [1f71e9af9c] to [429d7d2934].
| ︙ | ︙ | |||
984 985 986 987 988 989 990 |
(set! *didsomething* #t)))
(if (args:get-arg "-list-servers")
(let* ((tl (launch:setup)) ;; need this to initialize *toppath*
(servdir (tt:get-servinfo-dir *toppath*))
(servfiles (glob (conc servdir "/*:*.db")))
(fmtstr "~10a~22a~10a~25a~25a~8a\n")
| | | 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 |
(set! *didsomething* #t)))
(if (args:get-arg "-list-servers")
(let* ((tl (launch:setup)) ;; need this to initialize *toppath*
(servdir (tt:get-servinfo-dir *toppath*))
(servfiles (glob (conc servdir "/*:*.db")))
(fmtstr "~10a~22a~10a~25a~25a~8a\n")
(dbfiles (append (glob (conc *toppath* "/.mtdb/main.db")) (glob (conc *toppath* "/.mtdb/?.db"))(glob (conc *toppath* "/.mtdb/??.db"))))
(ttdat (make-tt areapath: *toppath*))
)
(format #t fmtstr "DB" "host:port" "PID" "age" "last mod" "state")
(for-each
(lambda (dbfile)
(let* (
(dbfname (conc (pathname-file dbfile) ".db"))
|
| ︙ | ︙ | |||
1042 1043 1044 1045 1046 1047 1048 |
(if (args:get-arg "-kill-servers")
(let* ((tl (launch:setup)) ;; need this to initialize *toppath*
(servdir (tt:get-servinfo-dir *toppath*))
(servfiles (glob (conc servdir "/*:*.db")))
(fmtstr "~10a~22a~10a~25a~25a~8a\n")
| | | 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 |
(if (args:get-arg "-kill-servers")
(let* ((tl (launch:setup)) ;; need this to initialize *toppath*
(servdir (tt:get-servinfo-dir *toppath*))
(servfiles (glob (conc servdir "/*:*.db")))
(fmtstr "~10a~22a~10a~25a~25a~8a\n")
(dbfiles (append (glob (conc *toppath* "/.mtdb/main.db")) (glob (conc *toppath* "/.mtdb/?.db"))(glob (conc *toppath* "/.mtdb/??.db"))))
(ttdat (make-tt areapath: *toppath*))
)
(format #t fmtstr "DB" "host:port" "PID" "age" "last mod" "state")
(for-each
(lambda (dbfile)
(let* (
(dbfname (conc (pathname-file dbfile) ".db"))
|
| ︙ | ︙ | |||
1072 1073 1074 1075 1076 1077 1078 |
(age (seconds->hr-min-sec (- (current-seconds) (list-ref sinfo 2))))
(last-mod (seconds->string (list-ref sinfo 2)))
(killed (system (conc "ssh " host " kill " pid " > /dev/null")))
(dummy2 (sleep 1))
(state (if (> (system (conc "ssh " host " ps " pid " > /dev/null")) 0) "dead" "alive"))
)
(format #t fmtstr db (conc host ":" port) pid age last-mod state)
| | | 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 |
(age (seconds->hr-min-sec (- (current-seconds) (list-ref sinfo 2))))
(last-mod (seconds->string (list-ref sinfo 2)))
(killed (system (conc "ssh " host " kill " pid " > /dev/null")))
(dummy2 (sleep 1))
(state (if (> (system (conc "ssh " host " ps " pid " > /dev/null")) 0) "dead" "alive"))
)
(format #t fmtstr db (conc host ":" port) pid age last-mod state)
(system (conc "rm " sfile))
)
)
sinfos
)
)
)
sfiles
|
| ︙ | ︙ | |||
2653 2654 2655 2656 2657 2658 2659 | (file-copy src-db dest-db) 1) (let ((res (dbmod:db-to-db-sync src-db dest-db last-update (dbfile:db-init-proc) keys))) (if res (debug:print-info 0 *default-log-port* "Synced " res " records from "src-db" to "dest-db) (debug:print-info 0 *default-log-port* "No sync due to permissions or other issue.")) res)))) | | > > > > > > > > | | > | > > > | 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 |
(file-copy src-db dest-db)
1)
(let ((res (dbmod:db-to-db-sync src-db dest-db last-update (dbfile:db-init-proc) keys)))
(if res
(debug:print-info 0 *default-log-port* "Synced " res " records from "src-db" to "dest-db)
(debug:print-info 0 *default-log-port* "No sync due to permissions or other issue."))
res))))
(start-time (current-seconds))
(synclock-mod-time (if (file-exists? lockfile)
(handle-exceptions
exn
#f
(file-modification-time synclock-file))
#f))
(age (if synclock-mod-time (- (current-seconds) synclock-mod-time) 1000))
)
(if (and src-db dest-db)
(if (file-exists? src-db)
(if (and (file-exists? lockfile) (< age 20))
(debug:print 0 *default-log-port* "Lock "lockfile" exists, skipping sync...")
(begin
(dbfile:with-simple-file-lock
lockfile
(lambda ()
(let loop ((last-changed (current-seconds))
(last-update 0))
(let* ((changes (handle-exceptions
exn
(begin
(debug:print 0 *default-log-port* "Exception in sync: "(condition->list exn))
(delete-file lockfile)
(exit))
(thesync last-update)))
(now-time (current-seconds)))
(if (and sync-period sync-timeout) ;;
(if (and (< (- now-time start-time) 600) ;; hard limit on how long we run for
(> sync-timeout (- now-time last-changed)))
(begin
(if sync-period (thread-sleep! sync-period))
(loop (if (> changes 0) now-time last-changed) now-time))))))))
(debug:print 0 *default-log-port* "Releasing lock file " lockfile)
)
)
(debug:print 0 *default-log-port* "No sync due to unreadble or non-existant source file"src-db))
(debug:print 0 *default-log-port* "Usage for -db2db; -to and -from must be specified"))
(set! *didsomething* #t)))
(if (args:get-arg "-list-test-time")
(let* ((toppath (launch:setup)))
(task:get-test-times)
|
| ︙ | ︙ |
Modified tcp-transportmod.scm from [896ad94c25] to [c1e45ba013].
| ︙ | ︙ | |||
481 482 483 484 485 486 487 488 489 490 491 492 493 494 | "tcp-server-thread")) (run-thread (make-thread (lambda () (tt:keep-running ttdat dbfname dbstruct))))) (thread-start! tcp-thread) (thread-start! run-thread) (thread-join! run-thread) ;; run thread will exit on timeout or other conditions (exit)))))) (define (tt:keep-running ttdat dbfname dbstruct) ;; verfiy conn for ready ;; listener socket has been started by this stage ;; wait for a port before creating the registration file ;; | > | 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 |
"tcp-server-thread"))
(run-thread (make-thread
(lambda ()
(tt:keep-running ttdat dbfname dbstruct)))))
(thread-start! tcp-thread)
(thread-start! run-thread)
(thread-join! run-thread) ;; run thread will exit on timeout or other conditions
(debug:print 0 *default-log-port* "Exiting now.")
(exit))))))
(define (tt:keep-running ttdat dbfname dbstruct)
;; verfiy conn for ready
;; listener socket has been started by this stage
;; wait for a port before creating the registration file
;;
|
| ︙ | ︙ | |||
597 598 599 600 601 602 603 |
(dbr:dbstruct-last-update-set! dbstruct curr-secs))))
(if (< (- (current-seconds) (tt-last-access ttdat)) (tt-server-timeout-param))
(begin
(thread-sleep! 5)
(loop)))))
(cleanup)
| | | 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 |
(dbr:dbstruct-last-update-set! dbstruct curr-secs))))
(if (< (- (current-seconds) (tt-last-access ttdat)) (tt-server-timeout-param))
(begin
(thread-sleep! 5)
(loop)))))
(cleanup)
(debug:print 0 *default-log-port* "INFO: Server timed out, exiting from tt:keep-running.")))
;; ;; given an already set up uconn start the cmd-loop
;; ;;
;; (define (tt:cmd-loop ttdat)
;; (let* ((serv-listener (-socket uconn))
;; (listener (lambda ()
|
| ︙ | ︙ |