Changes In Branch v1.63-readonly Through [c08f1fdbe0] Excluding Merge-Ins
This is equivalent to a diff from 3a9b974528 to c08f1fdbe0
2017-02-17
| ||
17:10 | add spreadsheet check-in: fa9ace95d6 user: bjbarcla tags: v1.63-readonly | |
16:19 | wip check-in: c08f1fdbe0 user: bjbarcla tags: v1.63-readonly | |
13:53 | wip check-in: 5b3c4129c4 user: bjbarcla tags: v1.63-readonly | |
2017-02-15
| ||
23:32 | Fix for mixed run data in html output. NOTE: somewhat speculative. I was unable to reproduce the problem and verify the fix. check-in: 09715bb136 user: matt tags: v1.63 | |
2017-02-14
| ||
15:17 | Create new branch named "v1.63-readonly" check-in: 78ff598411 user: bjbarcla tags: v1.63-readonly | |
14:48 | Fixed underscores visibility in test names check-in: 3a9b974528 user: ritikaag tags: v1.63 | |
14:43 | Changed default btn-height check-in: 2876b98759 user: ritikaag tags: v1.63-run-times | |
2017-02-10
| ||
15:16 | Added some brief info on wildcards in runconfigs to the user manual check-in: 39f84a3f86 user: mrwellan tags: v1.63 | |
Modified common.scm from [ef963426c3] to [55464285e8].
︙ | ︙ | |||
582 583 584 585 586 587 588 | (define *wdnum* 0) (define *wdnum*mutex (make-mutex)) ;; currently the primary job of the watchdog is to run the sync back to megatest.db from the db in /tmp ;; if we are on the homehost and we are a server (by definition we are on the homehost if we are a server) ;; | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | 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 | (define *wdnum* 0) (define *wdnum*mutex (make-mutex)) ;; currently the primary job of the watchdog is to run the sync back to megatest.db from the db in /tmp ;; if we are on the homehost and we are a server (by definition we are on the homehost if we are a server) ;; (define (common:readonly-watchdog dbstruct) (thread-sleep! 0.05) ;; delay for startup ;; sync megatest.db to /tmp/.../megatst.db (let ((sync-cool-off-duration 3) (golden-mtdb (dbr:dbstruct-mtdb dbstruct)) (golden-mtpath (db:dbdat-get-path mtdb)) (tmp-mtdb (dbr:dbstruct-tmpdb dbstruct)) (tmp-mtpath (db:dbdat-get-path mtdb))) (debug:print-info 0 *default-log-port* "Read-only periodic sync thread started.") (let loop ((last-sync-time 0)) (let* ((duration-since-last-sync (- (current-seconds) last-sync-time))) (if (and (not *time-to-exit*) (< duration-since-last-sync sync-cool-off-duration)) (thread-sleep! (- sync-cool-off-duration duration-since-last-sync))) (if (not *time-to-exit*) (let ((golden-mtdb-mtime (file-modification-time golden-mtpath)) (tmp-mtdb-mtime (file-modification-time tmp-mtpath))) (if (> golden-mtdb-mtime tmp-mtdb-mtime) (let ((res (db:multi-db-sync dbstruct 'old2new))) (debug:print-info 0 *default-log-port* "rosync called, " res " records transferred.")) (loop (current-seconds))) #t)))) (debug:print-info 0 *default-log-port* "Exiting readonly-watchdog timer, *time-to-exit* = " *time-to-exit*" pid="(current-process-id)" mtpath="golden-mtpath))) (define (common:writable-watchdog dbstruct) (thread-sleep! 0.05) ;; delay for startup (let ((legacy-sync (common:run-sync?)) (debug-mode (debug:debug-mode 1)) (last-time (current-seconds)) (this-wd-num (begin (mutex-lock! *wdnum*mutex) (let ((x *wdnum*)) (set! *wdnum* (add1 *wdnum*)) (mutex-unlock! *wdnum*mutex) x)))) (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))) (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*) |
︙ | ︙ | |||
647 648 649 650 651 652 653 654 655 656 657 658 659 660 | (< count 4)) ;; was 11, changing to 4. (begin (thread-sleep! 1) (delay-loop (+ count 1)))) (if (not *time-to-exit*) (loop)))) (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))))))) (define (std-exit-procedure) (on-exit (lambda () 0)) ;;(BB> "std-exit-procedure called; *time-to-exit*="*time-to-exit*) (let ((no-hurry (if *time-to-exit* ;; hurry up #f (begin | > > > > > > > > | 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 | (< count 4)) ;; was 11, changing to 4. (begin (thread-sleep! 1) (delay-loop (+ count 1)))) (if (not *time-to-exit*) (loop)))) (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))))))) ;; TODO: for multiple areas, we will have multiple watchdogs; and multiple threads to manage (define (common:watchdog) (let ((dbstruct (db:setup))) (if (dbstruct-readonly dbstruct) (common:readonly-watchdog dbstruct) (common:writable-watchdog dbstruct)))) (define (std-exit-procedure) (on-exit (lambda () 0)) ;;(BB> "std-exit-procedure called; *time-to-exit*="*time-to-exit*) (let ((no-hurry (if *time-to-exit* ;; hurry up #f (begin |
︙ | ︙ |
Modified db.scm from [cf38571740] to [a942af1057].
︙ | ︙ | |||
40 41 42 43 44 45 46 | ;; R E C O R D S ;;====================================================================== ;; each db entry is a pair ( db . dbfilepath ) ;; I propose this record evolves into the area record ;; (defstruct dbr:dbstruct | | > | 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 | ;; R E C O R D S ;;====================================================================== ;; each db entry is a pair ( db . dbfilepath ) ;; I propose this record evolves into the area record ;; (defstruct dbr:dbstruct (tmpdb #f) (dbstack #f) ;; stack for tmp db handles, do not initialize with a stack (mtdb #f) (refndb #f) (homehost #f) ;; not used yet (on-homehost #f) ;; not used yet (read-only #f) ) ;; goal is to converge on one struct for an area but for now it is too confusing ;; record for keeping state,status and count for doing roll-ups in ;; iterated tests ;; (defstruct dbr:counts |
︙ | ︙ | |||
267 268 269 270 271 272 273 | ;; (dbr:dbstruct-olddb-set! dbstruct olddb) ;; ;;; (mutex-unlock! *rundb-mutex*) ;;; why did we need a mutex on opening db's? ;; (db:sync-tables db:sync-tests-only *megatest-db* db) ;; db)) ;; This routine creates the db if not already present. It is only called if the db is not already opened ;; | | | > > | | | 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 | ;; (dbr:dbstruct-olddb-set! dbstruct olddb) ;; ;;; (mutex-unlock! *rundb-mutex*) ;;; why did we need a mutex on opening db's? ;; (db:sync-tables db:sync-tests-only *megatest-db* db) ;; db)) ;; This routine creates the db if not already present. It is only called if the db is not already opened ;; (define (db:open-db dbstruct #!key (areapath #f)) ;; TODO: actually use areapath (let ((tmpdb-stack (dbr:dbstruct-dbstack dbstruct))) ;; RA => Returns the first reference in dbstruct (if (stack? tmpdb-stack) (db:get-db tmpdb-stack) ;; get previously opened db (will create new db handle if all in the stack are already used (let* ((dbpath (db:dbfile-path)) ;; 0)) (dbexists (file-exists? dbpath)) (dbfexists (file-exists? (conc dbpath "/megatest.db"))) (tmpdb (db:open-megatest-db path: dbpath)) ;; lock-create-open dbpath db:initialize-main-db)) (mtdb (db:open-megatest-db)) (refndb (db:open-megatest-db path: dbpath name: "megatest_ref.db")) (write-access (file-write-access? dbpath))) (if (and dbexists (not write-access)) (begin (set! *db-write-access* #f) (dbr:dbstruct-readonly-set! dbstruct #t))) (dbr:dbstruct-mtdb-set! dbstruct mtdb) (dbr:dbstruct-tmpdb-set! dbstruct tmpdb) (dbr:dbstruct-dbstack-set! dbstruct (make-stack)) ;; BB: why a stack? Why would the number of db's be indeterminate? Is this a legacy of 1.db 2.db .. ? (stack-push! (dbr:dbstruct-dbstack dbstruct) tmpdb) ;; olddb is already a (cons db path) (dbr:dbstruct-refndb-set! dbstruct refndb) ;; (mutex-unlock! *rundb-mutex*) (if (and (not dbfexists) write-access) ;; *db-write-access*) ;; did not have a prior db and do have write access (begin (debug:print 0 *default-log-port* "filling db " (db:dbdat-get-path tmpdb) " with data from " (db:dbdat-get-path mtdb)) (db:sync-tables (db:sync-all-tables-list dbstruct) #f mtdb refndb tmpdb)) (debug:print 0 *default-log-port* " db, " (db:dbdat-get-path tmpdb) " already exists, not propogating data from " (db:dbdat-get-path mtdb))) ;; (db:multi-db-sync dbstruct 'old2new)) ;; migrate data from megatest.db automatically tmpdb)))) ;; Make the dbstruct, setup up auxillary db's and call for main db at least once ;; ;; called in http-transport and replicated in rmt.scm for *local* access. ;; (define (db:setup #!key (areapath #f)) (or *dbstruct-db* ;; TODO: when multiple areas are supported, this optimization will be a hazard (if (common:on-homehost?) (let* ((dbstruct (make-dbr:dbstruct))) (db:open-db dbstruct areapath: areapath) (set! *dbstruct-db* dbstruct) dbstruct) (begin (debug:print 0 *default-log-port* "ERROR: attempt to open database when not on homehost. Exiting. Homehost: " (common:get-homehost)) |
︙ | ︙ | |||
559 560 561 562 563 564 565 566 567 568 569 570 571 572 | (cond ((not fromdb) (debug:print 3 *default-log-port* "WARNING: db:sync-tables called with fromdb missing") -1) ((not todb) (debug:print 3 *default-log-port* "WARNING: db:sync-tables called with todb missing") -2) ((not (sqlite3:database? (db:dbdat-get-db fromdb))) (debug:print-error 0 *default-log-port* "db:sync-tables called with fromdb not a database " fromdb) -3) ((not (sqlite3:database? (db:dbdat-get-db todb))) (debug:print-error 0 *default-log-port* "db:sync-tables called with todb not a database " todb) -4) (else (let ((stmts (make-hash-table)) ;; table-field => stmt (all-stmts '()) ;; ( ( stmt1 value1 ) ( stml2 value2 )) (numrecs (make-hash-table)) (start-time (current-milliseconds)) (tot-count 0)) (for-each ;; table | > > > > > > > > > > > > > > > | 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 | (cond ((not fromdb) (debug:print 3 *default-log-port* "WARNING: db:sync-tables called with fromdb missing") -1) ((not todb) (debug:print 3 *default-log-port* "WARNING: db:sync-tables called with todb missing") -2) ((not (sqlite3:database? (db:dbdat-get-db fromdb))) (debug:print-error 0 *default-log-port* "db:sync-tables called with fromdb not a database " fromdb) -3) ((not (sqlite3:database? (db:dbdat-get-db todb))) (debug:print-error 0 *default-log-port* "db:sync-tables called with todb not a database " todb) -4) ((not (file-write-access? (cadr todb))) (debug:print-error 0 *default-log-port* "db:sync-tables called with todb not a read-only database " todb) -5) ((not (null? (let ((readonly-slave-dbs (filter (lambda (dbdat) (not (file-write-access? (cadr todb)))) slave-dbs))) (for-each (lambda (bad-dbdat) (debug:print-error 0 *default-log-port* "db:sync-tables called with todb not a read-only database " bad-dbdat)) readonly-slave-dbs) readonly-slave-dbs))) -6) (else (let ((stmts (make-hash-table)) ;; table-field => stmt (all-stmts '()) ;; ( ( stmt1 value1 ) ( stml2 value2 )) (numrecs (make-hash-table)) (start-time (current-milliseconds)) (tot-count 0)) (for-each ;; table |
︙ | ︙ | |||
809 810 811 812 813 814 815 | )))) ;; options: ;; ;; 'killservers - kills all servers ;; 'dejunk - removes junk records ;; 'adj-testids - move test-ids into correct ranges | | | < | 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 | )))) ;; options: ;; ;; 'killservers - kills all servers ;; 'dejunk - removes junk records ;; 'adj-testids - move test-ids into correct ranges ;; 'old2new - sync megatest.db to /tmp/.../megatest.db and /tmp/.../megatest_ref.db ;; 'new2old - sync /tmp/.../megatest.db to megatest.db and /tmp/.../megatest_ref.db (and update data_synced) ;; 'closeall - close all opened dbs ;; 'schema - attempt to apply schema changes ;; run-ids: '(1 2 3 ...) or #f (for all) ;; (define (db:multi-db-sync dbstruct . options) (if (not (launch:setup)) (debug:print 0 *default-log-port* "ERROR: not able to setup up for megatest.") (let* ((mtdb (dbr:dbstruct-mtdb dbstruct)) (tmpdb (db:get-db dbstruct)) |
︙ | ︙ | |||
856 857 858 859 860 861 862 | ;; (db:delay-if-busy mtdb) ;; (db:prep-megatest.db-for-migration mtdb))) ;; sync runs, test_meta etc. ;; (if (member 'old2new options) ;; (begin | > | > > | 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 | ;; (db:delay-if-busy mtdb) ;; (db:prep-megatest.db-for-migration mtdb))) ;; sync runs, test_meta etc. ;; (if (member 'old2new options) ;; (begin (set! data-synced (+ (db:sync-tables (db:sync-all-tables-list dbstruct) #f mtdb tmpdb refndb) data-synced))) ;; (db:sync-main-list mtdb) mtdb (db:get-db dbstruct #f)) ;; (for-each ;; (lambda (run-id) ;; (db:delay-if-busy mtdb) ;; (let ((testrecs (db:get-all-tests-info-by-run-id mtdb run-id))) ;; ;; (dbstruct (if toppath (make-dbr:dbstruct path: toppath local: #t) #f))) ;; (debug:print 0 *default-log-port* "INFO: Propagating " (length testrecs) " records for run-id=" run-id " to run specific db") ;; (db:replace-test-records dbstruct run-id testrecs) ;; (sqlite3:finalize! (db:dbdat-get-db (dbr:dbstruct-rundb dbstruct))))) ;; run-ids))) ;; now ensure all newdb data are synced to megatest.db ;; do not use the run-ids list passed in to the function ;; (if (member 'new2old options) (set! data-synced (+ (db:sync-tables (db:sync-all-tables-list dbstruct) #f tmpdb refndb mtdb) data-synced))) (if (member 'fixschema options) (begin (db:patch-schema-maindb (db:dbdat-get-db mtdb)) (db:patch-schema-maindb (db:dbdat-get-db tmpdb)) (db:patch-schema-maindb (db:dbdat-get-db refndb)) |
︙ | ︙ |
Modified megatest.scm from [14c2234bc7] to [9779cbfe05].
︙ | ︙ | |||
362 363 364 365 366 367 368 369 370 371 372 373 374 375 | ;; immediately set MT_TARGET if -reqtarg or -target are available ;; (let ((targ (or (args:get-arg "-reqtarg")(args:get-arg "-target")))) (if targ (setenv "MT_TARGET" targ))) ;; The watchdog is to keep an eye on things like db sync etc. ;; (define *watchdog* (make-thread common:watchdog "Watchdog thread")) (if (not (args:get-arg "-server")) (thread-start! *watchdog*)) ;; if starting a server; wait till we get to running state before kicking off watchdog ;; bracket open-output-file with code to make leading directory if it does not exist and handle exceptions (define (open-logfile logpath) | > > | 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 | ;; immediately set MT_TARGET if -reqtarg or -target are available ;; (let ((targ (or (args:get-arg "-reqtarg")(args:get-arg "-target")))) (if targ (setenv "MT_TARGET" targ))) ;; The watchdog is to keep an eye on things like db sync etc. ;; ;; TODO: for multiple areas, we will have multiple watchdogs; and multiple threads to manage (define *watchdog* (make-thread common:watchdog "Watchdog thread")) (if (not (args:get-arg "-server")) (thread-start! *watchdog*)) ;; if starting a server; wait till we get to running state before kicking off watchdog ;; bracket open-output-file with code to make leading directory if it does not exist and handle exceptions (define (open-logfile logpath) |
︙ | ︙ | |||
2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 | (if (not *didsomething*) (debug:print 0 *default-log-port* help)) ;;(BB> "thread-join! watchdog") ;; join the watchdog thread if it has been thread-start!ed (it may not have been started in the case of a server that never enters running state) ;; (symbols returned by thread-state: created ready running blocked suspended sleeping terminated dead) (if (thread? *watchdog*) (case (thread-state *watchdog*) ((ready running blocked sleeping terminated dead) (thread-join! *watchdog*)))) (set! *time-to-exit* #t) | > | 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 | (if (not *didsomething*) (debug:print 0 *default-log-port* help)) ;;(BB> "thread-join! watchdog") ;; join the watchdog thread if it has been thread-start!ed (it may not have been started in the case of a server that never enters running state) ;; (symbols returned by thread-state: created ready running blocked suspended sleeping terminated dead) ;; TODO: for multiple areas, we will have multiple watchdogs; and multiple threads to manage (if (thread? *watchdog*) (case (thread-state *watchdog*) ((ready running blocked sleeping terminated dead) (thread-join! *watchdog*)))) (set! *time-to-exit* #t) |
︙ | ︙ |
Modified rmt.scm from [6898f1a6b7] to [6da0373e5e].
︙ | ︙ | |||
53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 | (mutex-lock! *rmt-mutex*) ;; 1. check if server is started IFF cmd is a write OR if we are not on the homehost, store in runremote ;; 2. check the age of the connections. refresh the connection if it is older than timeout-20 seconds. ;; 3. do the query, if on homehost use local access ;; (let* ((start-time (current-seconds)) ;; snapshot time so all use cases get same value (runremote (or area-dat *runremote*))) (cond ;; give up if more than 15 attempts ((> attemptnum 15) (debug:print 0 *default-log-port* "ERROR: 15 tries to start/connect to server. Giving up.") (exit 1)) ;; reset the connection if it has been unused too long ((and runremote (remote-conndat runremote) (let ((expire-time (+ (- start-time (remote-server-timeout runremote))(random 30)))) ;; add 30 seconds of noise so that not all running tests expire at the same time causing a storm of server starts (< (http-transport:server-dat-get-last-access (remote-conndat runremote)) expire-time))) (debug:print-info 12 *default-log-port* "rmt:send-receive, case 8") (remote-conndat-set! runremote #f) | > > > > > > > > > > > > > > > > > > > | 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 | (mutex-lock! *rmt-mutex*) ;; 1. check if server is started IFF cmd is a write OR if we are not on the homehost, store in runremote ;; 2. check the age of the connections. refresh the connection if it is older than timeout-20 seconds. ;; 3. do the query, if on homehost use local access ;; (let* ((start-time (current-seconds)) ;; snapshot time so all use cases get same value (areapath *toppath*);; TODO - resolve from dbstruct to be compatible with multiple areas (readonly-mode (file-write-access? (conc *toppath* "/megatest.db") )) ;; TODO: use dbstruct or runremote to figure this out in future (runremote (or area-dat *runremote*))) (cond ;; give up if more than 15 attempts ((> attemptnum 15) (debug:print 0 *default-log-port* "ERROR: 15 tries to start/connect to server. Giving up.") (exit 1)) ;; readonly mode, read request- handle it - case 20 ((and readonly-mode (member cmd api:read-only-queries)) (mutex-unlock! *rmt-mutex*) (debug:print-info 12 *default-log-port* "rmt:send-receive, case 20") (rmt:open-qry-close-locally cmd 0 params) ) ;; readonly mode, write request. Do nothing, return #f (readonly-mode (mutex-unlock! *rmt-mutex*) (debug:print-info 12 *default-log-port* "rmt:send-receive, case 21") (debug:print 0 *default-log-port* "WARNING: write transaction requested on a readonly area. cmd="cmd" params="params) #f ) ;; reset the connection if it has been unused too long ((and runremote (remote-conndat runremote) (let ((expire-time (+ (- start-time (remote-server-timeout runremote))(random 30)))) ;; add 30 seconds of noise so that not all running tests expire at the same time causing a storm of server starts (< (http-transport:server-dat-get-last-access (remote-conndat runremote)) expire-time))) (debug:print-info 12 *default-log-port* "rmt:send-receive, case 8") (remote-conndat-set! runremote #f) |
︙ | ︙ |