Overview
Context
Changes
Modified dbmod.scm
from [550b97413e]
to [bf0b6456e0].
︙ | | |
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
|
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
|
+
-
+
+
+
+
-
+
|
(dbr:dbstruct-dbfile-set! dbstruct dbfullname)
(dbr:dbstruct-dbtmpname-set! dbstruct tmpdb)
(dbr:dbstruct-dbfname-set! dbstruct dbfname)
(dbr:dbstruct-sync-proc-set! dbstruct
(lambda (last-update)
(if *sync-in-progress*
(debug:print 3 *default-log-port* "WARNING: overlapping calls to sync to disk")
(let* ((syncer-logfile (conc areapath"/logs/"dbfname"-syncer.log"))
(let* ((sync-cmd (conc "megatest -db2db -from "tmpdb" -to "dbfullname"&"))
(sync-cmd (conc "NBFAKE_LOG="syncer-logfile" nbfake megatest -db2db -from "tmpdb" -to "dbfullname" -period 5 -timeout 10 &"))
(synclock-file (conc dbfullname".lock"))
(syncer-running-file (conc dbfullname"-sync-running"))
(synclock-mod-time (if (file-exists? synclock-file)
(handle-exceptions
exn
#f
(file-modification-time synclock-file))
#f))
(thethread (lambda ()
(thread-start!
(make-thread
(lambda ()
(set! *sync-in-progress* #t)
(debug:print-info "Running "sync-cmd)
(if (file-exists? syncer-running-file)
(debug:print-info 0 *default-log-port* "Syncer still running, skipping syncer start.")
(system sync-cmd)
(system sync-cmd))
(set! *sync-in-progress* #f)))))))
(if (< (file-modification-time tmpdb)
(file-modification-time dbfullname))
(debug:print 0 *default-log-port* "Skipping sync, "tmpdb" older than "dbfullname)
(if synclock-mod-time
(if (< (- (current-seconds) synclock-mod-time) 20) ;; something wrong with sync, remove file
(begin
|
︙ | | |
Modified megatest.scm
from [885b3caa0f]
to [ed67bbef31].
︙ | | |
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
|
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
|
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
;; use with -from and -to
;;
(if (args:get-arg "-db2db")
(let* ((duh (launch:setup))
(src-db (args:get-arg "-from"))
(dest-db (args:get-arg "-to"))
(sync-period (args:get-arg "-period")) ;; NOT IMPLEMENTED YET
(sync-timeout (args:get-arg "-timeout")) ;; NOT IMPLEMENTED YET
(sync-period (args:get-arg-number "-period"))
(sync-timeout (args:get-arg-number "-timeout"))
;; (sync-period (if sync-period-in (string->number sync-period-in) #f))
;; (sync-timeout (if sync-timeout-in (string->number sync-timeout-in) #f))
(lockfile (conc dest-db".sync-lock"))
(keys (db:get-keys #f))
)
(if (and src-db dest-db)
(if (file-exists? src-db)
(if (file-exists? lockfile)
(debug:print 0 *default-log-port* "Lock "lockfile" exists, skipping sync...")
(dbfile:with-simple-file-lock
lockfile
(lambda ()
;;(with-output-to-file lockfile
;; (lambda ()
(thesync (lambda (last-update)
;; (print (current-process-id))))
(debug:print-info 0 *default-log-port* "Attempting to sync data from "src-db" to "dest-db"...")
(if #f ;; (not (file-exists? dest-db))
(begin
(dbfile:with-simple-file-lock
(conc dest-db ".lock") ;; is the db being opened right now?
(lambda ()
(debug:print 0 *default-log-port* "Using copy to create "dest-db" from "src-db)
(file-copy src-db dest-db))))
(let ((res (dbmod:db-to-db-sync src-db dest-db 0 (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."))))
;; (delete-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)))
(debug:print-info 0 *default-log-port* "Attempting to sync data from "src-db" to "dest-db"...")
(if (not (file-exists? dest-db))
(begin
(dbfile:with-simple-file-lock
(conc dest-db ".lock") ;; is the db being opened right now?
(lambda ()
(debug:print 0 *default-log-port* "Using copy to create "dest-db" from "src-db)
(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)))))
(if (and src-db dest-db)
(if (file-exists? src-db)
(if (file-exists? lockfile)
(debug:print 0 *default-log-port* "Lock "lockfile" exists, skipping sync...")
(dbfile:with-simple-file-lock
(conc dest-db"-sync-running")
(lambda ()
(let loop ((last-changed (current-seconds))
(last-update 0))
(let* ((changes (dbfile:with-simple-file-lock
lockfile
(lambda ()
(thesync last-update))))
(now-time (current-seconds)))
(if (and sync-period sync-timeout) ;;
(if (> 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* "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)
(set! *didsomething* #t)))
(if (args:get-arg "-list-run-time")
|
︙ | | |
Modified tcp-transportmod.scm
from [02829c3b33]
to [6c61845b3c].
︙ | | |
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
|
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
|
-
+
-
+
|
;; (dbfname (tt-conn-port conn)) ;; 192.168.0.127:4242-726924:4.db
(pid (tt-conn-pid conn))
(servinf (tt-conn-servinf-file conn)))
;;(servinf (tt-servinf-file ttdat))) ;; (conc areapath"/.servinfo/"host":"port"-"pid":"dbfname))) ;; TODO, use (server:get-servinfo-dir areapath)
(hash-table-set! (tt-conns ttdat) dbfname #f)
(if (and servinf (file-exists? servinf))
(begin
(if (< attemptnum 3)
(if (< attemptnum 10)
(begin
(thread-sleep! 0.25)
(thread-sleep! 0.5)
(tt:handler ttdat cmd run-id params (+ attemptnum 1) area-dat areapath readonly-mode dbfname testsuite mtexe))
(begin
(debug:print 0 *default-log-port* "INFO: no response from server "host":"port" for "dbfname)
(if (and (file-exists? servinf)
(> (- (current-seconds)(file-modification-time servinf)) 60))
(begin
(debug:print 0 *default-log-port* "INFO: "servinf" file seems old and no ping response, removing it.")
|
︙ | | |