@@ -387,50 +387,82 @@ ;; (mutex-unlock! bup-mutex) (mt:test-set-state-status-by-id run-id test-id "COMPLETED" #f #f))) (debug:print-error 0 *default-log-port* "No archive path in the record for run-id=" run-id " test-id=" test-id)))) (filter vector? tests)))) +(define (common:get-youngest-test tests) + (if (null? tests) + #f + (let ((res #f)) + (for-each + (lambda (test-dat) + (let ((event-time (db:test-get-event_time test-dat))) + (if (or (not res) + (> event-time (db:test-get-event_time res))) + (set! res test-dat)))) + tests) + res))) + ;; from an archive get a specific path - works ONLY with bup for now ;; -(define (archive:bup-get-data archive-command run-id run-name tests rp-mutex bup-mutex) +(define (archive:bup-get-data archive-command run-id-in run-name-in tests rp-mutex bup-mutex) (if (null? tests) (debug:print-info 0 *default-log-port* "get-data called with no matching tests to operate on.") + (let* ((bup-exe (or (configf:lookup *configdat* "archive" "bup") "bup")) (linktree (common:get-linktree)) ;; (configf:lookup *configdat* "setup" "linktree"))) - (test-dat (car tests)) + ;; (test-dat (common:get-youngest-test tests)) (destpath (args:get-arg "-dest"))) - - ;; When restoring test-dat will initially contain an old and invalid path to the test - (let* ((item-path (db:test-get-item-path test-dat)) - (test-name (db:test-get-testname test-dat)) - (test-id (db:test-get-id test-dat)) - (run-id (db:test-get-run_id test-dat)) - (keyvals (rmt:get-key-val-pairs run-id)) - (target (string-intersperse (map cadr keyvals) "/")) - - (toplevel/children (and (db:test-get-is-toplevel test-dat) - (> (rmt:test-toplevel-num-items run-id test-name) 0))) - (test-partial-path (conc target "/" run-name "/" (db:test-make-full-name test-name item-path))) - ;; note the trailing slash to get the dir inspite of it being a link - (test-path (conc linktree "/" test-partial-path)) - (mutex-lock! rp-mutex) - (mutex-unlock! rp-mutex) - (archive-block-id (db:test-get-archived test-dat)) - (archive-block-info (rmt:test-get-archive-block-info archive-block-id)) - (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))) - - (if (and archive-path ;; no point in proceeding if there is no actual archive - (not toplevel/children)) - (begin - ;; 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-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" (or destpath "data") " " archive-internal-path))) - (debug:print-info 0 *default-log-port* "Restoring archived data to " (or destpath "data") " from archive in " archive-path " ... " archive-internal-path) - ;; (mutex-lock! bup-mutex) - (run-n-wait bup-exe params: bup-restore-params print-cmd: #f))) - (debug:print-error 0 *default-log-port* "No archive path in the record for run-id=" run-id " test-id=" test-id)))))) - + (cond + ((null? tests) + (debug:print-error 0 *default-log-port* + "No test matching provided target, runname pattern and test pattern found.")) + ((file-exists? destpath) + (debug:print-error 0 *default-log-port* + "Destination path alread exists! Please remove it before running get.")) + (else + (let loop ((rem-tests tests)) + (let* ((test-dat (common:get-youngest-test rem-tests)) + (item-path (db:test-get-item-path test-dat)) + (test-name (db:test-get-testname test-dat)) + (test-id (db:test-get-id test-dat)) + (run-id (db:test-get-run_id test-dat)) + (run-name (rmt:get-run-name-from-id run-id)) + (keyvals (rmt:get-key-val-pairs run-id)) + (target (string-intersperse (map cadr keyvals) "/")) + + (toplevel/children (and (db:test-get-is-toplevel test-dat) + (> (rmt:test-toplevel-num-items run-id test-name) 0))) + (test-partial-path (conc target "/" run-name "/" + (db:test-make-full-name test-name item-path))) + ;; note the trailing slash to get the dir inspite of it being a link + (test-path (conc linktree "/" 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 (if (vector? archive-block-info) + (vector-ref archive-block-info 2) + #f)) + (archive-internal-path (conc (common:get-testsuite-name) "-" run-id + "/latest/" test-partial-path))) + + (if (and archive-path ;; no point in proceeding if there is no actual archive + (not toplevel/children)) + (begin + (let* ((bup-restore-params (list "-d" archive-path "restore" "-C" (or destpath "data") + " " ;; What is the empty string for? + archive-internal-path))) + (debug:print-info 0 *default-log-port* "Restoring archived data to " (or destpath "data") + " from archive in " archive-path " ... " archive-internal-path) + (run-n-wait bup-exe params: bup-restore-params print-cmd: #t))) + (let ((new-rem-tests (filter (lambda (tdat) + (or (not (eq? (db:test-get-id tdat) test-id)) + (not (eq? (db:test-get-run_id tdat) run-id)))) + rem-tests) )) + (debug:print-info 0 *default-log-port* + "No archive path in the record for run-id=" run-id + " test-id=" test-id ", skipping.") + (if (null? new-rem-tests) + (begin + (debug:print-info 0 *default-log-port* "No archives found for " target "/" run-name "...") + #f) + (loop new-rem-tests))))))))))) +