Index: archive.scm ================================================================== --- archive.scm +++ archive.scm @@ -226,33 +226,42 @@ (prev-test-physical-path (if (file-exists? test-path) (read-symbolic-link test-path #t) #f)) (new-test-physical-path (conc best-disk "/" test-partial-path)) (archive-block-id (db:test-get-archived test-dat)) (archive-block-info (rmt:test-get-archive-block-info archive-block-id)) - (archive-path (vector-ref archive-block-info 2)) ;; look in db.scm for test-get-archive-block-info for the vector record info + (archive-path (if (vector? archive-block-info) + (vector-ref archive-block-info 2) ;; look in db.scm for test-get-archive-block-info for the vector record info + #f)) ;; no archive found? (archive-internal-path (conc (common:get-testsuite-name) "-" run-id "/latest/" test-partial-path))) ;; some sanity checks (if (and prev-test-physical-path (file-exists? prev-test-physical-path)) ;; what to do? abort or clean up or link it in? (debug:print 0 "ERROR: the old directory " prev-test-physical-path ", still exists! This should not be.")) - ;; CREATE WORK AREA - ;; test-src-path == #f ==> don't copy in data from tests directory - ;; itemdat == string ==> use directly - (create-work-area run-id run-name keyvals test-id #f best-disk test-name item-path) ;; #!key (remtries 2)) - - ;; 1. Get the block id from the test info - ;; 2. Get the block data given the block id - ;; 3. Construct the paths etc. for the following command: - ;; - ;; bup -d /tmp/matt/adisk1/2015_q1/fullrun_e1a40/ restore -C /tmp/seeme fullrun-30/latest/ubuntu/nfs/none/w02.1.20.54_b/ - - ;; DO BUP RESTORE - (let* ((new-test-dat (rmt:get-test-info-by-id run-id test-id)) - (new-test-path (db:test-get-rundir new-test-dat)) - ;; new-test-path won't work - must use best-disk instead? Nope, new-test-path but tack on /.. - (bup-restore-params (list "-d" archive-path "restore" "-C" (conc new-test-path "/..") archive-internal-path))) - (debug:print-info 0 "Restoring archived data to " new-test-physical-path "; params: " bup-restore-params) - (run-n-wait bup-exe params: bup-restore-params print-cmd: #f)))) - tests))) + (if archive-path ;; no point in proceeding if there is no actual archive + (begin + ;; CREATE WORK AREA + ;; test-src-path == #f ==> don't copy in data from tests directory + ;; itemdat == string ==> use directly + (create-work-area run-id run-name keyvals test-id #f best-disk test-name item-path) ;; #!key (remtries 2)) + + ;; 1. Get the block id from the test info + ;; 2. Get the block data given the block id + ;; 3. Construct the paths etc. for the following command: + ;; + ;; bup -d /tmp/matt/adisk1/2015_q1/fullrun_e1a40/ restore -C /tmp/seeme fullrun-30/latest/ubuntu/nfs/none/w02.1.20.54_b/ + + ;; DO BUP RESTORE + (let* ((new-test-dat (rmt:get-test-info-by-id run-id test-id)) + (new-test-path (if (vector? new-test-dat ) + (db:test-get-rundir new-test-dat) + (begin + (debug:print 0 "ERROR: unable to get data for run-id=" run-id ", test-id=" test-id) + (exit 1)))) + ;; new-test-path won't work - must use best-disk instead? Nope, new-test-path but tack on /.. + (bup-restore-params (list "-d" archive-path "restore" "-C" (conc new-test-path "/..") archive-internal-path))) + (debug:print-info 0 "Restoring archived data to " new-test-physical-path " from archive in " archive-path " ... " archive-internal-path) + (run-n-wait bup-exe params: bup-restore-params print-cmd: #f))) + (debug:print 0 "ERROR: No archive path in the record for run-id=" run-id " test-id=" test-id)))) + (filter vector? tests)))) Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -1471,11 +1471,11 @@ (debug:print 1 "Printing info for run " runkey ", run=" run ", tests=" tests ", header=" header) action) ((run-wait) (debug:print 1 "Waiting for run " runkey ", run=" runnamepatt " to complete")) ((archive) - (debug:print 1 "Archiving data for run: " runkey " " (db:get-value-by-header run header "runname")) + (debug:print 1 "Archiving/restoring (" (args:get-arg "-archive") ") data for run: " runkey " " (db:get-value-by-header run header "runname")) (set! worker-thread (make-thread (lambda () (case (string->symbol (args:get-arg "-archive")) ((save save-remove keep-html)(archive:run-bup (args:get-arg "-archive") run-id run-name tests)) ((restore)(archive:bup-restore (args:get-arg "-archive") run-id run-name tests)) (else (debug:print 0 "ERROR: unrecognised sub command to -archive. Run \"megatest\" to see help")))) @@ -1484,17 +1484,19 @@ (else (debug:print-info 0 "action not recognised " action))) ;; actions that operate on one test at a time can be handled below ;; - (let ((sorted-tests (sort tests (lambda (a b)(let ((dira ;; (rmt:sdb-qry 'getstr - (db:test-get-rundir a)) ;; ) ;; (filedb:get-path *fdb* (db:test-get-rundir a))) - (dirb ;; (rmt:sdb-qry 'getstr - (db:test-get-rundir b))) ;; ) ;; ((filedb:get-path *fdb* (db:test-get-rundir b)))) - (if (and (string? dira)(string? dirb)) - (> (string-length dira)(string-length dirb)) - #f))))) + (let ((sorted-tests (filter + vector? + (sort tests (lambda (a b)(let ((dira ;; (rmt:sdb-qry 'getstr + (db:test-get-rundir a)) ;; ) ;; (filedb:get-path *fdb* (db:test-get-rundir a))) + (dirb ;; (rmt:sdb-qry 'getstr + (db:test-get-rundir b))) ;; ) ;; ((filedb:get-path *fdb* (db:test-get-rundir b)))) + (if (and (string? dira)(string? dirb)) + (> (string-length dira)(string-length dirb)) + #f)))))) (toplevel-retries (make-hash-table)) ;; try three times to loop through and remove top level tests (test-retry-time (make-hash-table)) (allow-run-time 10)) ;; seconds to allow for killing tests before just brutally killing 'em (let loop ((test (car sorted-tests)) (tal (cdr sorted-tests)))