382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
|
(exit 1))))
(debug:print-info 2 *default-log-port* "Archiving data with bup")
(let-values (((pid-val exit-status exit-code) (run-n-wait bup-exe params: bup-save-params print-cmd: print-prefix)))
(if (not (eq? exit-code 0))
(begin
(debug:print-error 0 *default-log-port* "There was an error archiving data with bup. Archive failed.")
(exit 1))
(debug:print-info 2 *default-log-port* "To restore megatest.db run megatest -archive replicacte-db -source archive-dir -time-stamp <ts>. Current timestamp: " (seconds->std-time-str (current-seconds)))))))
(else
(debug:print-info 0 *default-log-port* "No support for databse archiving with " archiver)))
(debug:print-error 0 *default-log-port* "There was an error rsyncing tmp database")))))
(define (archive:restore-db archive-path ts)
(let* ((bup-exe (or (configf:lookup *configdat* "archive" "bup") "bup"))
(archive-internal-path (conc (common:get-testsuite-name) "-megatest-db/" ts "/megatest.db" ))
(bup-restore-params (list "-d" archive-path "restore" "-C" *toppath* archive-internal-path)))
(debug:print-info 0 *default-log-port* "Restoring archived data to " *toppath* " from archive in " archive-path " ... " archive-internal-path)
(run-n-wait bup-exe params: bup-restore-params print-cmd: #f))
(db:multi-db-sync
(db:setup #f)
'killservers
;'dejunk
;'adj-testids
'old2new
)
(debug:print-info 1 *default-log-port* "dropping trigerrs to update linktree")
(rmt:drop-all-triggers)
|
|
|
|
>
|
<
|
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
|
(exit 1))))
(debug:print-info 2 *default-log-port* "Archiving data with bup")
(let-values (((pid-val exit-status exit-code) (run-n-wait bup-exe params: bup-save-params print-cmd: print-prefix)))
(if (not (eq? exit-code 0))
(begin
(debug:print-error 0 *default-log-port* "There was an error archiving data with bup. Archive failed.")
(exit 1))
(debug:print-info 0 *default-log-port* "To restore megatest.db run megatest -archive replicacte-db -source archive-dir -time-stamp <ts>. Current timestamp: " (seconds->std-time-str (current-seconds)))))))
(else
(debug:print-info 0 *default-log-port* "No support for databse archiving with " archiver)))
(debug:print-error 0 *default-log-port* "There was an error rsyncing tmp database")))))
(define (archive:restore-db archive-path ts)
(let* ((bup-exe (or (configf:lookup *configdat* "archive" "bup") "bup"))
(archive-internal-path (conc (common:get-testsuite-name) "-megatest-db/" ts "/megatest.db" ))
(bup-restore-params (list "-d" archive-path "restore" "-C" *toppath* archive-internal-path)))
(debug:print-info 2 *default-log-port* "Restoring archived data to " *toppath* " from archive in " archive-path " ... " archive-internal-path)
(run-n-wait bup-exe params: bup-restore-params print-cmd: "Running:"))
(sleep 2)
(db:multi-db-sync
(db:setup #f)
'killservers
;'dejunk
;'adj-testids
'old2new
)
(debug:print-info 1 *default-log-port* "dropping triggers to update linktree")
(rmt:drop-all-triggers)
(let* ((linktree (common:get-linktree)) ;; (configf:lookup *configdat* "setup" "linktree")))
(src-archive-linktree (rmt:get-var "src-archive-linktree")))
(if (not (equal? src-archive-linktree linktree))
(rmt:update-tesdata-on-repilcate-db src-archive-linktree linktree))
(debug:print-info 1 *default-log-port* "creating triggers after updating linktree")
(rmt:create-all-triggers)
))
|