Megatest

Diff
Login

Differences From Artifact [3fa116b68d]:

To Artifact [767b31815a]:


427
428
429
430
431
432
433
434
435
436


437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
	 (write-access (file-write-access? dbpath)))
    (debug:print-info 13 *default-log-port* "db:open-megatest-db "dbpath)
    (if (and dbexists (not write-access))
	(set! *db-write-access* #f))
    ;; (cons db dbpath)))
    (make-dbr:dbdat dbfile: dbpath dbh: db read-only: (not write-access))))

;; sync run to disk if touched
;;
(define (db:sync-touched dbstruct run-id #!key (force-sync #f))


  (let* ((subdb   (dbfile:get-subdb dbstruct run-id))
	 (tmpsubdb   (dbfile:get-subdb dbstruct run-id))
         (tmpdbfile (dbr:subdb-tmpdbfile tmpsubdb))
	 (mtdb    (dbr:subdb-mtdbdat subdb))
         (tmpdb (dbfile:open-sqlite3-db tmpdbfile #f))

	 ;; (refndb  (dbr:subdb-refndb subdb))
	 (start-t (current-seconds)))
    (debug:print-info 4 *default-log-port* "Syncing for run-id: " run-id)
    (mutex-lock! *db-multi-sync-mutex*)
    (let ((update_info (cons "last_update" (if force-sync 0 *db-last-sync*) )))
      (mutex-unlock! *db-multi-sync-mutex*)
      (db:sync-tables (db:sync-all-tables-list dbstruct) update_info tmpdb mtdb))
    (mutex-lock! *db-multi-sync-mutex*)
    (set! *db-last-sync* start-t)
    (set! *db-last-access* start-t)







|


>
>
|
|
|


<
<

<







427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443


444

445
446
447
448
449
450
451
	 (write-access (file-write-access? dbpath)))
    (debug:print-info 13 *default-log-port* "db:open-megatest-db "dbpath)
    (if (and dbexists (not write-access))
	(set! *db-write-access* #f))
    ;; (cons db dbpath)))
    (make-dbr:dbdat dbfile: dbpath dbh: db read-only: (not write-access))))

;; sync run from tmp disk to nfs disk if touched
;;
(define (db:sync-touched dbstruct run-id #!key (force-sync #f))
  (debug:print-info 0 *default-log-port* "db:sync-touched Syncing: " (conc (if run-id run-id "main") ".db"))

  (let* (
	 (subdb   (or (dbfile:get-subdb dbstruct run-id) (dbfile:init-subdb dbstruct run-id db:initialize-main-db)))
         (tmpdbfile (dbr:subdb-tmpdbfile subdb))
	 (mtdb    (dbr:subdb-mtdbdat subdb))
         (tmpdb (dbfile:open-sqlite3-db tmpdbfile #f))


	 (start-t (current-seconds)))

    (mutex-lock! *db-multi-sync-mutex*)
    (let ((update_info (cons "last_update" (if force-sync 0 *db-last-sync*) )))
      (mutex-unlock! *db-multi-sync-mutex*)
      (db:sync-tables (db:sync-all-tables-list dbstruct) update_info tmpdb mtdb))
    (mutex-lock! *db-multi-sync-mutex*)
    (set! *db-last-sync* start-t)
    (set! *db-last-access* start-t)
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
690
(define (db:sync-tables tbls last-update fromdb todb . slave-dbs)
  (handle-exceptions
   exn
   (begin
     (debug:print 0 *default-log-port* "EXCEPTION: database probably overloaded or unreadable in db:sync-tables.")
     (print-call-chain (current-error-port))
     (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
     (debug:print 5 *default-log-port* "exn=" (condition->list exn))
     (debug:print 0 *default-log-port* " status:  " ((condition-property-accessor 'sqlite3 'status) exn))
     (debug:print 0 *default-log-port* " src db:  " (dbr:dbdat-dbfile fromdb))
     (for-each (lambda (dbdat)
		 (let ((dbpath (dbr:dbdat-dbfile dbdat)))
		   (debug:print 0 *default-log-port* " dbpath:  " dbpath)
		   (if (not (db:repair-db dbdat))
		       (begin
			 (debug:print-error 0 *default-log-port* "Failed to rebuild " dbpath ", exiting now.")
			 (exit)))))
	       (cons todb slave-dbs))
     
     0)

   ;; this is the work to be done")
   (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? (dbr:dbdat-dbh fromdb)))
     (debug:print-error 0 *default-log-port* "db:sync-tables called with fromdb not a database " fromdb)
   -3)
    ((not (sqlite3:database? (dbr:dbdat-dbh todb)))
     (debug:print-error 0 *default-log-port* "db:sync-tables called with todb not a database " todb)
   -4)







|















|

|







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
(define (db:sync-tables tbls last-update fromdb todb . slave-dbs)
  (handle-exceptions
   exn
   (begin
     (debug:print 0 *default-log-port* "EXCEPTION: database probably overloaded or unreadable in db:sync-tables.")
     (print-call-chain (current-error-port))
     (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
     (debug:print 0 *default-log-port* "exn=" (condition->list exn))
     (debug:print 0 *default-log-port* " status:  " ((condition-property-accessor 'sqlite3 'status) exn))
     (debug:print 0 *default-log-port* " src db:  " (dbr:dbdat-dbfile fromdb))
     (for-each (lambda (dbdat)
		 (let ((dbpath (dbr:dbdat-dbfile dbdat)))
		   (debug:print 0 *default-log-port* " dbpath:  " dbpath)
		   (if (not (db:repair-db dbdat))
		       (begin
			 (debug:print-error 0 *default-log-port* "Failed to rebuild " dbpath ", exiting now.")
			 (exit)))))
	       (cons todb slave-dbs))
     
     0)

   ;; this is the work to be done")
   (cond
    ((not fromdb) (debug:print 0 *default-log-port* "WARNING: db:sync-tables called with fromdb missing")
     -1)
    ((not todb)   (debug:print 0 *default-log-port* "WARNING: db:sync-tables called with todb missing")
     -2)
    ((not (sqlite3:database? (dbr:dbdat-dbh fromdb)))
     (debug:print-error 0 *default-log-port* "db:sync-tables called with fromdb not a database " fromdb)
   -3)
    ((not (sqlite3:database? (dbr:dbdat-dbh todb)))
     (debug:print-error 0 *default-log-port* "db:sync-tables called with todb not a database " todb)
   -4)
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
	    ;; set up the field->num table
	    (for-each
	     (lambda (field)
	       (hash-table-set! field->num field count)
	       (set! count (+ count 1)))
	     fields)

            (debug:print 3 *default-log-port* "fromdat: " fromdat)

	    ;; read the source table
            ;; store a list of all rows in the table in fromdat, up to batch-len.
            ;; Then add fromdat to the fromdats list, clear fromdat and repeat.
	    (sqlite3:for-each-row
	     (lambda (a . b)
	       (set! fromdat (cons (apply vector a b) fromdat))
	       (if (> (length fromdat) batch-len)







<
<







762
763
764
765
766
767
768


769
770
771
772
773
774
775
	    ;; set up the field->num table
	    (for-each
	     (lambda (field)
	       (hash-table-set! field->num field count)
	       (set! count (+ count 1)))
	     fields)



	    ;; read the source table
            ;; store a list of all rows in the table in fromdat, up to batch-len.
            ;; Then add fromdat to the fromdats list, clear fromdat and repeat.
	    (sqlite3:for-each-row
	     (lambda (a . b)
	       (set! fromdat (cons (apply vector a b) fromdat))
	       (if (> (length fromdat) batch-len)
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
                 (set! totrecords (+ totrecords 1)))

	    ;; tack on remaining records in fromdat
	    (if (not (null? fromdat))
		(set! fromdats (cons fromdat fromdats)))

	    (if (common:low-noise-print 120 "sync-records")
		(debug:print 4 *default-log-port* "found " totrecords " records to sync"))

	    (sqlite3:for-each-row
	     (lambda (a . b)
	       (hash-table-set! todat a (apply vector a b)))
	     (dbr:dbdat-dbh todb)
	     full-sel)








|







787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
                 (set! totrecords (+ totrecords 1)))

	    ;; tack on remaining records in fromdat
	    (if (not (null? fromdat))
		(set! fromdats (cons fromdat fromdats)))

	    (if (common:low-noise-print 120 "sync-records")
		(debug:print 0 *default-log-port* "found " totrecords " records to sync"))

	    (sqlite3:for-each-row
	     (lambda (a . b)
	       (hash-table-set! todat a (apply vector a b)))
	     (dbr:dbdat-dbh todb)
	     full-sel)

850
851
852
853
854
855
856

857

858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
                                )
                            )
                            ))
			fromdat-lst))))
		  fromdats)



	         (debug:print 3 *default-log-port* "changed rows: " changed-rows)



		 (sqlite3:finalize! stmth)
                 (if (member "last_update" field-names)
                    (db:create-trigger db tablename))))
	     (append (list todb) slave-dbs)
           )
          )
        )
	tbls)
       (let* ((runtime      (- (current-milliseconds) start-time))
	      (should-print (or (debug:debug-mode 12)
				(common:low-noise-print 120 "db sync" (> runtime 500))))) ;; low and high sync times treated as separate.
	 (if should-print (debug:print 3 *default-log-port* "INFO: db sync, total run time " runtime " ms"))
	 (for-each 
	  (lambda (dat)
	    (let ((tblname (car dat))
		  (count   (cdr dat)))
	      (set! tot-count (+ tot-count count))
	      (if (> count 0)
		  (if should-print (debug:print 0 *default-log-port* (format #f "    ~10a ~5a" tblname count))))))







>
|
>













|







847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
                                )
                            )
                            ))
			fromdat-lst))))
		  fromdats)


                 (if (> changed-rows 0)
	           (debug:print 0 *default-log-port* "table " tablename " changed rows: " changed-rows)
                 )


		 (sqlite3:finalize! stmth)
                 (if (member "last_update" field-names)
                    (db:create-trigger db tablename))))
	     (append (list todb) slave-dbs)
           )
          )
        )
	tbls)
       (let* ((runtime      (- (current-milliseconds) start-time))
	      (should-print (or (debug:debug-mode 12)
				(common:low-noise-print 120 "db sync" (> runtime 500))))) ;; low and high sync times treated as separate.
	 (if should-print (debug:print 0 *default-log-port* "INFO: db sync, total run time " runtime " ms"))
	 (for-each 
	  (lambda (dat)
	    (let ((tblname (car dat))
		  (count   (cdr dat)))
	      (set! tot-count (+ tot-count count))
	      (if (> count 0)
		  (if should-print (debug:print 0 *default-log-port* (format #f "    ~10a ~5a" tblname count))))))
1053
1054
1055
1056
1057
1058
1059
1060
1061

1062
1063
1064


1065
1066
1067
1068

1069
1070
1071
1072
1073
1074


























































1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091

1092
1093
1094
1095
1096
1097
1098
;; 	  ))))




;; Get a lock from the no-sync-db for the from-db, then delta sync the from-db to the to-db, otherwise return #f

(define (db:lock-and-delta-sync no-sync-db from-db-file to-db-file)
  (assert (not *db-sync-in-progress*) "FATAL: db:lock-and-sync called while a sync is in progress.")

  (let* ((lockdat  (db:no-sync-get-lock no-sync-db from-db))
	 (gotlock  (car lockdat))
	 (locktime (cdr lockdat)))


    (if gotlock
	(begin
          (debug:print 0 *default-log-port* "db:lock-and-sync copying db")
	  ;; (file-copy from-db to-db #t)

	  (db:no-sync-del! no-sync-db from-db)
	  #t)
        (begin
          (debug:print 0 *default-log-port* "could not get lock for " from-db " from no-sync-db")
	  #f
        ))))































































;; 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)

  (db:open-db dbstruct #f)

  (let* ((data-synced 0) ;; count of changed records
    (tmp-area       (common:get-db-tmp-area))
    (dbfiles        (glob (conc tmp-area"/.db/*.db")))
    (sync-durations (make-hash-table))
    )







|

>
|


>
>


|
<
>
|


|


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

















>







1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069

1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
;; 	  ))))




;; Get a lock from the no-sync-db for the from-db, then delta sync the from-db to the to-db, otherwise return #f

(define (db:lock-and-delta-sync no-sync-db dbstruct from-db-file runid)
  (assert (not *db-sync-in-progress*) "FATAL: db:lock-and-sync called while a sync is in progress.")
  (debug:print-info 3 *default-log-port* "db:lock-and-delta-sync")
  (let* ((lockdat  (db:no-sync-get-lock no-sync-db from-db-file))
	 (gotlock  (car lockdat))
	 (locktime (cdr lockdat)))

    (debug:print-info 3 *default-log-port* "db:lock-and-delta-sync: go lock?")
    (if gotlock
	(begin
          (debug:print 0 *default-log-port* "db:lock-and-delta-sync copying db")

          (db:sync-touched dbstruct runid)
	  (db:no-sync-del! no-sync-db from-db-file)
	  #t)
        (begin
          (debug:print 0 *default-log-port* "could not get lock for " from-db-file " from no-sync-db")
	  #f
        ))))




(define (db:all-db-sync dbstruct)
  (db:open-db dbstruct #f)
  (let* ((data-synced 0) ;; count of changed records
    (tmp-area       (common:get-db-tmp-area))
    (dbfiles        (glob (conc tmp-area"/.db/*.db")))
    (sync-durations (make-hash-table))
    (no-sync-db        (db:open-no-sync-db))
    )
    (for-each
     (lambda (file)
       (debug:print-info 3 *default-log-port* "file: " file)
       (let* ((fname (conc (pathname-file file) ".db"))
	      (fulln (conc *toppath*"/.db/"fname))
	      (time1 (if (file-exists? file)
			 (file-modification-time file)
			 (begin
			   (debug:print-info 0 *default-log-port* "Sync - I do not see file "file)
			   1)))
	      (time2 (if (file-exists? fulln)
			 (file-modification-time fulln)
			 (begin
			   (debug:print-info 0 *default-log-port* "Sync - I do not see file "fulln)
			   0)))
	      (changed (> time1 time2))
	      (do-cp (cond
		      ((not (file-exists? fulln)) ;; shouldn't happen, but this might recover
		       (debug:print-info 0 *default-log-port* "File "fulln" not found! Copying "fname" to "fulln)
		       #t)
		      (changed ;; (and changed
		       ;; (> (- (current-seconds) time1) 3)) ;; if file is changed and three seconds have passed.
		       #t)
		      ((and changed *time-to-exit*) ;; last sync
		       #t)
		      (else
		       #f))))
	 (if do-cp
	     (let* ((start-time (current-milliseconds))
              (fname (pathname-file file))
              (runid (if (string= fname "main") #f (string->number fname)))
              )
	       (debug:print-info 3 *default-log-port* "db:all-db-sync: fname: " fname", delta: " (- time1 time2) " seconds")

	       (db:lock-and-delta-sync no-sync-db dbstruct fname runid)
	       (hash-table-set! sync-durations (conc fname".db") (- (current-milliseconds) start-time)))
	     (debug:print-info 3 *default-log-port* "skipping sync. " file " is up to date")
         )
       )
     )
     dbfiles
    )
  )
   #t
)






;; 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)

  (db:open-db dbstruct #f)

  (let* ((data-synced 0) ;; count of changed records
    (tmp-area       (common:get-db-tmp-area))
    (dbfiles        (glob (conc tmp-area"/.db/*.db")))
    (sync-durations (make-hash-table))
    )
5102
5103
5104
5105
5106
5107
5108
5109
5110
5111
5112
5113
5114
5115
5116
5117
5118
5119
5120
5121
5122
5123

5124
5125
5126


5127



5128
5129
5130
5131
5132
5133
5134
                  (exit 1)))
                ;;(debug:print 1 *default-log-port* "INFO: ["(common:human-time)"] Syncer started (method="syncer")")
                )))
	    (debug:print-info 13 *default-log-port* "watchdog done."))
	  (debug:print-info 13 *default-log-port* "no need for watchdog on non-homehost"))))


(define (db:do-sync)
  (let* ((syncer (or (configf:lookup *configdat* "server" "sync-method") "delta-sync"))
    (dbstruct (db:setup #t)))

    (debug:print 0 *default-log-port* "db:do-sync: sync-method: " syncer)
    (cond
      ((equal? syncer "brute-force-sync")
       (db:run-lock-and-sync *no-sync-db*))
      ((equal? syncer "delta-sync")
       (debug:print 0 *default-log-port* "db:do-sync: db:multi-db-sync" )
       (let* (
	   (tmpdbpth (dbr:dbstruct-tmppath 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 "db:do-sync: Synced " res " records to megatest.db")
             )
	     (print "db:do-sync: Skipping sync, there is a sync in progress.")
           )







|






|







>
|
|
|
>
>
|
>
>
>







5163
5164
5165
5166
5167
5168
5169
5170
5171
5172
5173
5174
5175
5176
5177
5178
5179
5180
5181
5182
5183
5184
5185
5186
5187
5188
5189
5190
5191
5192
5193
5194
5195
5196
5197
5198
5199
5200
5201
                  (exit 1)))
                ;;(debug:print 1 *default-log-port* "INFO: ["(common:human-time)"] Syncer started (method="syncer")")
                )))
	    (debug:print-info 13 *default-log-port* "watchdog done."))
	  (debug:print-info 13 *default-log-port* "no need for watchdog on non-homehost"))))


(define (db:do-sync no-sync-db)
  (let* ((syncer (or (configf:lookup *configdat* "server" "sync-method") "delta-sync"))
    (dbstruct (db:setup #t)))

    (debug:print 0 *default-log-port* "db:do-sync: sync-method: " syncer)
    (cond
      ((equal? syncer "brute-force-sync")
       (db:run-lock-and-sync no-sync-db))
      ((equal? syncer "delta-sync")
       (debug:print 0 *default-log-port* "db:do-sync: db:multi-db-sync" )
       (let* (
	   (tmpdbpth (dbr:dbstruct-tmppath dbstruct))
	   (lockfile (conc tmpdbpth ".lock"))
	   (locked   (common:simple-file-lock lockfile)) 
	   (res      (if locked
                         ;; sync all dbs for this area
                



			 (db:all-db-sync dbstruct) 
                         #f
                     )
            )
           )
           (if res
	     (begin
	       (common:simple-file-release-lock lockfile)
	       (print "db:do-sync: Synced " res " records to megatest.db")
             )
	     (print "db:do-sync: Skipping sync, there is a sync in progress.")
           )