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
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
|
;; (mutex-lock! bup-mutex)
(run-n-wait bup-exe params: bup-restore-params print-cmd: #f)
;; (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))))
;; 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)
(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))
(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))))))
|
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
|
|
|
>
>
>
>
>
>
>
>
|
|
|
|
>
|
|
|
|
|
|
>
|
|
<
<
|
|
|
|
|
|
>
|
|
|
|
<
<
<
<
|
>
>
|
<
>
|
>
>
>
>
>
|
>
>
>
>
>
>
|
|
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
417
418
419
420
421
422
423
424
425
426
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
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
|
;; (mutex-lock! bup-mutex)
(run-n-wait bup-exe params: bup-restore-params print-cmd: #f)
;; (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-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 (common:get-youngest-test tests))
(destpath (args:get-arg "-dest")))
(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)))))))))))
|