Overview
Comment: | Fixes to keep servers running to sync back changes to megatest.db from /tmp/ ... db files |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.63 |
Files: | files | file ages | folders |
SHA1: |
471ca93f41e56ecce7f96eb53a423f86 |
User & Date: | mrwellan on 2016-12-21 15:26:54 |
Other Links: | branch diff | manifest | tags |
Context
2016-12-22
| ||
12:37 | found a hanging scenario check-in: 0fa3e0acbf user: bjbarcla tags: v1.63 | |
2016-12-21
| ||
15:26 | Fixes to keep servers running to sync back changes to megatest.db from /tmp/ ... db files check-in: 471ca93f41 user: mrwellan tags: v1.63 | |
12:49 | merged in -mode and -tagexpr support check-in: 848bdf7c97 user: bjbarcla tags: v1.63 | |
2016-12-20
| ||
16:23 | added -mode and -tagexpr options Closed-Leaf check-in: 38b7f592d7 user: bjbarcla tags: v1.63-tag-mode | |
Changes
Modified common.scm from [67dd2f50c8] to [79d2280f3c].
︙ | ︙ | |||
88 89 90 91 92 93 94 | ;; db stats (define *db-stats* (make-hash-table)) ;; hash of vectors < count duration-total > (define *db-stats-mutex* (make-mutex)) ;; db access (define *db-last-access* (current-seconds)) ;; last db access, used in server (define *db-write-access* #t) ;; db sync | < | | 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 | ;; db stats (define *db-stats* (make-hash-table)) ;; hash of vectors < count duration-total > (define *db-stats-mutex* (make-mutex)) ;; db access (define *db-last-access* (current-seconds)) ;; last db access, used in server (define *db-write-access* #t) ;; db sync (define *db-last-sync* 0) ;; last time the sync to megatest.db happened (define *db-sync-in-progress* #f) ;; if there is a sync in progress do not try to start another (define *db-multi-sync-mutex* (make-mutex)) ;; protect access to *db-sync-in-progress*, *db-last-sync* ;; task db (define *task-db* #f) ;; (vector db path-to-db) (define *db-access-allowed* #t) ;; flag to allow access (define *db-access-mutex* (make-mutex)) (define *db-cache-path* #f) ;; SERVER |
︙ | ︙ | |||
537 538 539 540 541 542 543 | (message-digest-string (md5-primitive) *toppath*)) ;;====================================================================== ;; E X I T H A N D L I N G ;;====================================================================== (define (common:run-sync?) | | | | | | > > | 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 | (message-digest-string (md5-primitive) *toppath*)) ;;====================================================================== ;; E X I T H A N D L I N G ;;====================================================================== (define (common:run-sync?) (and (common:on-homehost?) (args:get-arg "-server"))) ;; (let ((ohh (common:on-homehost?)) ;; (srv (args:get-arg "-server"))) ;; (and ohh srv))) ;; (debug:print-info 0 *default-log-port* "common:run-sync? ohh=" ohh ", srv=" srv) ;;;; run-ids ;; if #f use *db-local-sync* : or 'local-sync-flags ;; if #t use timestamps : or 'timestamps (define (common:sync-to-megatest.db dbstruct) (let ((start-time (current-seconds)) (res (db:multi-db-sync dbstruct 'new2old))) |
︙ | ︙ | |||
571 572 573 574 575 576 577 | (if legacy-sync (let ((dbstruct (db:setup))) (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*) | > | | 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 | (if legacy-sync (let ((dbstruct (db:setup))) (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*) (should-sync (> (- (current-seconds) *db-last-sync*) 5)) ;; sync every five seconds minimum (will-sync (and (or need-sync should-sync) (not sync-in-progress))) (start-time (current-seconds))) ;; (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)) |
︙ | ︙ | |||
615 616 617 618 619 620 621 622 623 624 625 626 627 628 | (thread-sleep! 1) (delay-loop (+ count 1)))) (loop))) (if (common:low-noise-print 30) (debug:print-info 0 *default-log-port* "Exiting watchdog timer, *time-to-exit* = " *time-to-exit*))))))) (define (std-exit-procedure) (let ((no-hurry (if *time-to-exit* ;; hurry up #f (begin (set! *time-to-exit* #t) #t)))) (debug:print-info 4 *default-log-port* "starting exit process, finalizing databases.") (if (and no-hurry (debug:debug-mode 18)) | > | 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 | (thread-sleep! 1) (delay-loop (+ count 1)))) (loop))) (if (common:low-noise-print 30) (debug:print-info 0 *default-log-port* "Exiting watchdog timer, *time-to-exit* = " *time-to-exit*))))))) (define (std-exit-procedure) (on-exit (lambda () #t)) (let ((no-hurry (if *time-to-exit* ;; hurry up #f (begin (set! *time-to-exit* #t) #t)))) (debug:print-info 4 *default-log-port* "starting exit process, finalizing databases.") (if (and no-hurry (debug:debug-mode 18)) |
︙ | ︙ |
Modified db.scm from [ff97966612] to [31eac1d5ff].
︙ | ︙ | |||
333 334 335 336 337 338 339 340 341 342 343 344 345 346 | (debug:print-info 4 *default-log-port* "Syncing for run-id: " run-id) (mutex-lock! *db-multi-sync-mutex*) (let ((update_info (cons (if force-sync 0 *db-last-sync*) "last_update"))) (mutex-unlock! *db-multi-sync-mutex*) (db:sync-tables (db:sync-all-tables-list dbstruct) update_info tmpdb refndb mtdb)) (mutex-lock! *db-multi-sync-mutex*) (set! *db-last-sync* start-t) (mutex-unlock! *db-multi-sync-mutex*))) ;; close all opened run-id dbs (define (db:close-all dbstruct) (if (dbr:dbstruct? dbstruct) (begin ;; (db:sync-touched dbstruct 0 force-sync: #t) ;; NO. Do not do this here. Instead we rely on a server to be started when there are writes, even if the server itself is not going to be used as a server. | > | 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 | (debug:print-info 4 *default-log-port* "Syncing for run-id: " run-id) (mutex-lock! *db-multi-sync-mutex*) (let ((update_info (cons (if force-sync 0 *db-last-sync*) "last_update"))) (mutex-unlock! *db-multi-sync-mutex*) (db:sync-tables (db:sync-all-tables-list dbstruct) update_info tmpdb refndb mtdb)) (mutex-lock! *db-multi-sync-mutex*) (set! *db-last-sync* start-t) (set! *db-last-access* start-t) (mutex-unlock! *db-multi-sync-mutex*))) ;; close all opened run-id dbs (define (db:close-all dbstruct) (if (dbr:dbstruct? dbstruct) (begin ;; (db:sync-touched dbstruct 0 force-sync: #t) ;; NO. Do not do this here. Instead we rely on a server to be started when there are writes, even if the server itself is not going to be used as a server. |
︙ | ︙ |
Modified rmt.scm from [9a729a7a42] to [7e5abf90aa].
︙ | ︙ | |||
247 248 249 250 251 252 253 | #f)) (begin ;; (rmt:update-db-stats run-id cmd params duration) ;; mark this run as dirty if this was a write, the watchdog is responsible for syncing it (if qry-is-write (let ((start-time (current-seconds))) (mutex-lock! *db-multi-sync-mutex*) | | | 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 | #f)) (begin ;; (rmt:update-db-stats run-id cmd params duration) ;; mark this run as dirty if this was a write, the watchdog is responsible for syncing it (if qry-is-write (let ((start-time (current-seconds))) (mutex-lock! *db-multi-sync-mutex*) (set! *db-last-access* start-time) ;; THIS IS PROBABLY USELESS? (we are on a client) (mutex-unlock! *db-multi-sync-mutex*))))) res)) (define (rmt:send-receive-no-auto-client-setup connection-info cmd run-id params) (let* ((run-id (if run-id run-id 0)) (res (handle-exceptions exn |
︙ | ︙ |