Overview
| Comment: | Try Brandon's idea of using sqlite3 dump to sync to legacy megatest.db |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.65-dump-for-sync |
| Files: | files | file ages | folders |
| SHA1: |
542079c7788ff8d2567da82ebf00032a |
| User & Date: | matt on 2019-02-07 22:53:25 |
| Other Links: | branch diff | manifest | tags |
Context
|
2019-02-08
| ||
| 14:29 | Added MT_SQLITE3_EXE var check-in: 20b2810c40 user: mrwellan tags: v1.65-dump-for-sync | |
|
2019-02-07
| ||
| 22:53 | Try Brandon's idea of using sqlite3 dump to sync to legacy megatest.db check-in: 542079c778 user: matt tags: v1.65-dump-for-sync | |
| 17:16 | coordinate multiple servers such that only one server will be syncing exclusively at any given momemt\ check-in: 31c8ca7f78 user: bjbarcla tags: v1.65 | |
Changes
Modified megatest.scm from [170ba13932] to [6ab2ef604b].
| ︙ | ︙ | |||
2291 2292 2293 2294 2295 2296 2297 |
'adj-testids
'old2new
;; 'new2old
)
(set! *didsomething* #t)))
(if (args:get-arg "-sync-to-megatest.db")
| > > > > > | | | > > > > | > | 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 |
'adj-testids
'old2new
;; 'new2old
)
(set! *didsomething* #t)))
(if (args:get-arg "-sync-to-megatest.db")
(let* ((dbstruct (db:setup #f))
(tmpdbpth (cdr (dbr:dbstruct-tmpdb dbstruct)))
(lockfile (conc tmpdbpth ".lock"))
(locked (common:simple-file-lock lockfile))
(res (if locked
(db:multi-db-sync
dbstruct
'new2old)
#f)))
(if res
(begin
(common:simple-file-release-lock lockfile)
(print "Synced " res " records to megatest.db"))
(print "Skipping sync, there is a sync in progress."))
(set! *didsomething* #t)))
(if (args:get-arg "-sync-to")
(let ((toppath (launch:setup)))
(tasks:sync-to-postgres *configdat* (args:get-arg "-sync-to"))
(set! *didsomething* #t)))
|
| ︙ | ︙ |
Modified server.scm from [e8ffc74269] to [4e67ff8c04].
| ︙ | ︙ | |||
480 481 482 483 484 485 486 |
;; NOTE: This can fail when there is no mention of the host in /etc/hosts. FIXME
(vector->list (hostinfo-addresses (hostname->hostinfo hostname))))
(string-intersperse
(map number->string
(u8vector->list
(if res res (hostname->ip hostname)))) ".")))
| | | | | | | | | | | | | | | | | | < < < < < < < < < < < < < < | | | < < | < | < | | > > | | < < < < < < | < < < < < < < < < | < | < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < | | > | | < < < < < | | | | | | | | | | | | | | | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 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 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 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 687 688 689 |
;; NOTE: This can fail when there is no mention of the host in /etc/hosts. FIXME
(vector->list (hostinfo-addresses (hostname->hostinfo hostname))))
(string-intersperse
(map number->string
(u8vector->list
(if res res (hostname->ip hostname)))) ".")))
;; (define server:sync-lock-token "SERVER_SYNC_LOCK")
;; (define (server:release-sync-lock)
;; (db:no-sync-del! *no-sync-db* server:sync-lock-token))
;; (define (server:have-sync-lock?)
;; (let* ((have-lock-pair (db:no-sync-get-lock *no-sync-db* server:sync-lock-token))
;; (have-lock? (car have-lock-pair))
;; (lock-time (cdr have-lock-pair))
;; (lock-age (- (current-seconds) lock-time)))
;; (cond
;; (have-lock? #t)
;; ((>lock-age
;; (* 3 (configf:lookup-number *configdat* "server" "minimum-intersync-delay" default: 180)))
;; (server:release-sync-lock)
;; (server:have-sync-lock?))
;; (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"))))
(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
(delete-file* staging-file)
(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&"))
))
;; 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*)
(if (and (not *time-to-exit*)
(< count 6)) ;; was 11, changing to 4.
(begin
(thread-sleep! 1)
(delay-loop (+ count 1))))
(if (not *time-to-exit*) (loop))))
;; time to exit, close the no-sync db here
;; (db:no-sync-close-db no-sync-db)
(if (common:low-noise-print 30)
(debug:print-info 0 *default-log-port* "Exiting watchdog timer, *time-to-exit* = " *time-to-exit*" pid="(current-process-id)
))))))
;; (let ((legacy-sync (common:run-sync?)))
;; (sync-stale-seconds (configf:lookup-number *configdat* "server" "sync-stale-seconds" default: 300))
;; (debug-mode (debug:debug-mode 1))
;; (last-time (current-seconds))
;; (no-sync-db (db:open-no-sync-db))
;; (sync-duration 0) ;; run time of the sync in milliseconds
;; ;;(this-wd-num (begin (mutex-lock! *wdnum*mutex) (let ((x *wdnum*)) (set! *wdnum* (add1 *wdnum*)) (mutex-unlock! *wdnum*mutex) x)))
;; )
;; (set! *no-sync-db* no-sync-db) ;; make the no sync db available to api calls
;; (debug:print-info 2 *default-log-port* "Periodic sync thread started.")
;; (debug:print-info 3 *default-log-port* "watchdog starting. legacy-sync is " legacy-sync" pid="(current-process-id) );; " this-wd-num="this-wd-num)
;; (if (and legacy-sync (not *time-to-exit*))
;; (let* (;;(dbstruct (db:setup))
;; (mtdb (dbr:dbstruct-mtdb dbstruct))
;; (mtpath (db:dbdat-get-path mtdb))
;; (tmp-area (common:get-db-tmp-area))
;; (lockfile (conc tmp-area "/megatest.db.lock"))
;; (start-file (conc tmp-area "/.start-sync"))
;; (end-file (conc tmp-area "/.end-sync")))
;; (debug:print-info 0 *default-log-port* "Server running, periodic sync started.")
;; (let loop ()
;; ;; sync for filesystem local db writes
;; ;;
;;
;; (mutex-lock! *db-multi-sync-mutex*)
;; (let* ((need-sync (>= *db-last-access* *db-last-sync*)) ;; no sync since last write
;; (sync-in-progress *db-sync-in-progress*)
;;
;; (min-intersync-delay (configf:lookup-number *configdat* "server" "minimum-intersync-delay" default: 5))
;; (should-sync (and (not *time-to-exit*)
;; (> (- (current-seconds) *db-last-sync*) min-intersync-delay))) ;; sync every five seconds minimum, deprecated logic, can probably be removed
;; (start-time (current-seconds))
;; (cpu-load-adj (alist-ref 'adj-proc-load (common:get-normalized-cpu-load #f)))
;; (mt-mod-time (file-modification-time mtpath))
;; (last-sync-start (if (common:file-exists? start-file)
;; (file-modification-time start-file)
;; 0))
;; (last-sync-end (if (common:file-exists? end-file)
;; (file-modification-time end-file)
;; 10))
;; (sync-period (+ 3 (* cpu-load-adj 30))) ;; as adjusted load increases increase the sync period
;; (recently-synced (and (< (- start-time mt-mod-time) sync-period) ;; not useful if sync didn't modify megatest.db!
;; (< mt-mod-time last-sync-start)))
;; (sync-done (<= last-sync-start last-sync-end))
;; (sync-stale (> start-time (+ last-sync-start sync-stale-seconds)))
;; (will-sync-pre (and (not *time-to-exit*) ;; do not start a sync if we are in the process of exiting
;; have-lock?
;; (or need-sync should-sync)
;; (or sync-done sync-stale)
;; (not sync-in-progress)
;; (not recently-synced)))
;; (will-sync (if will-sync-pre
;; ;; delay get lock until we decide to sync
;; #t ;; (server:have-sync-lock?)
;; #f)))
;; ;; if another server is syncing, postpone sync
;; (if (and will-sync-pre (not will-sync))
;; (set! *db-last-sync* start-time))
;; (debug:print-info 13 *default-log-port* "WD writable-watchdog top of loop. need-sync="need-sync" sync-in-progress=" sync-in-progress
;; " should-sync="should-sync" start-time="start-time" mt-mod-time="mt-mod-time" recently-synced="recently-synced" will-sync="will-sync
;; " sync-done=" sync-done " sync-period=" sync-period)
;; (if (and (> sync-period 5)
;; (common:low-noise-print 30 "sync-period"))
;; (debug:print-info 0 *default-log-port* "Increased sync period due to long sync times, sync took: " sync-period " seconds."))
;; ;; (if recently-synced (debug:print-info 0 *default-log-port* "Skipping sync due to recently-synced flag=" recently-synced))
;; ;; (debug:print-info 0 *default-log-port* "need-sync: " need-sync " sync-in-progress: " sync-in-progress " should-sync: " should-sync " will-sync: " will-sync)
;; (if will-sync (set! *db-sync-in-progress* #t))
;; (mutex-unlock! *db-multi-sync-mutex*)
;; (if will-sync
;; (let (;; (max-sync-duration (configf:lookup-number *configdat* "server" "max-sync-duration")) ;; KEEPING THIS AVAILABLE BUT SHOULD NOT USE, I'M PRETTY SURE IT DOES NOT WORK!
;; (sync-start (current-milliseconds)))
;; (with-output-to-file start-file (lambda ()(print (current-process-id))))
;;
;; ;; put lock here
;;
;; ;; (if (or (not max-sync-duration)
;; ;; (< sync-duration max-sync-duration)) ;; NOTE: db:sync-to-megatest.db keeps track of time of last sync and syncs incrementally
;; (let ((res (db:sync-to-megatest.db dbstruct no-sync-db: no-sync-db))) ;; did we sync any data? If so need to set the db touched flag to keep the server alive
;; (set! sync-duration (- (current-milliseconds) sync-start))
;; (if (> res 0) ;; some records were transferred, keep the db alive
;; (begin
;; (mutex-lock! *heartbeat-mutex*)
;; (set! *db-last-access* (current-seconds))
;; (mutex-unlock! *heartbeat-mutex*)
;; (debug:print-info 0 *default-log-port* "sync called, " res " records transferred."))
;; (debug:print-info 2 *default-log-port* "sync called but zero records transferred")))))
;; ;; ;; TODO: factor this next routine out into a function
;; ;; (with-input-from-pipe ;; this should not block other threads but need to verify this
;; ;; (conc "megatest -sync-to-megatest.db -m testsuite:" (common:get-area-name) ":" *toppath*)
;; ;; (lambda ()
;; ;; (let loop ((inl (read-line))
;; ;; (res #f))
;; ;; (if (eof-object? inl)
;; ;; (begin
;; ;; (set! sync-duration (- (current-milliseconds) sync-start))
;; ;; (cond
;; ;; ((not res)
;; ;; (debug:print 0 *default-log-port* "ERROR: sync from /tmp db to megatest.db appears to have failed. Recommended that you stop your runs and run \"megatest -cleanup-db\""))
;; ;; ((> res 0)
;; ;; (mutex-lock! *heartbeat-mutex*)
;; ;; (set! *db-last-access* (current-seconds))
;; ;; (mutex-unlock! *heartbeat-mutex*))))
;; ;; (let ((num-synced (let ((matches (string-match "^Synced (\\d+).*$" inl)))
;; ;; (if matches
;; ;; (string->number (cadr matches))
;; ;; #f))))
;; ;; (loop (read-line)
;; ;; (or num-synced res))))))))))
;; (if will-sync
;; (begin
;; (mutex-lock! *db-multi-sync-mutex*)
;; (set! *db-sync-in-progress* #f)
;; (set! *db-last-sync* start-time)
;; (with-output-to-file end-file (lambda ()(print (current-process-id))))
;;
;; ;; release lock here
;; ;; (server:release-sync-lock)
;; (mutex-unlock! *db-multi-sync-mutex*)))
;; (if (and debug-mode
;; (> (- start-time last-time) 60))
;; (begin
;; (set! last-time start-time)
;; (debug:print-info 4 *default-log-port* "timestamp -> " (seconds->time-string (current-seconds)) ", time since start -> " (seconds->hr-min-sec (- (current-seconds) *time-zero*))))))
;;
;; ;; 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*)
;;
;; (if (and (not *time-to-exit*)
;; (< count 6)) ;; was 11, changing to 4.
;; (begin
;; (thread-sleep! 1)
;; (delay-loop (+ count 1))))
;; (if (not *time-to-exit*) (loop))))
;; ;; time to exit, close the no-sync db here
;; (db:no-sync-close-db no-sync-db)
;; (if (common:low-noise-print 30)
;; (debug:print-info 0 *default-log-port* "Exiting watchdog timer, *time-to-exit* = " *time-to-exit*" pid="(current-process-id) ))))))) ;;" this-wd-num="this-wd-num)))))))
|