Overview
Comment: | Archive get now works well |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.65-broken |
Files: | files | file ages | folders |
SHA1: |
0645166f9cdc9cbb2e922e7a3b0094fb |
User & Date: | mrwellan on 2020-04-27 17:46:53 |
Other Links: | branch diff | manifest | tags |
Context
2020-04-27
| ||
18:23 | Fixed -dest to lock to correct location check-in: 0364beb9c9 user: mrwellan tags: v1.65-broken | |
17:46 | Archive get now works well check-in: 0645166f9c user: mrwellan tags: v1.65-broken | |
2020-04-21
| ||
04:13 | Get data from archive partially working check-in: 5de2fd17b5 user: mrwellan tags: v1.65-broken | |
Changes
Modified archive.scm from [bb0fd0a689] to [a68821a111].
︙ | ︙ | |||
385 386 387 388 389 390 391 392 393 | ;; (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 ;; | > > > > > > > > > > > > > | > | | | > > > > > > > > | | | | > | | | | | | > | | < < | | | | | | > | | | | < < < < | > > | < > | > > > > > | > > > > > > | | 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))))))))))) |
Modified runs.scm from [f48ffb3bcd] to [3d52148a1f].
︙ | ︙ | |||
2103 2104 2105 2106 2107 2108 2109 | (header (vector-ref rundat 0)) (runs (vector-ref rundat 1)) (states (if state (string-split state ",") '())) (statuses (if status (string-split status ",") '())) (state-status (if (string? new-state-status) (string-split new-state-status ",") '(#f #f))) (rp-mutex (make-mutex)) (bup-mutex (make-mutex)) | | > | 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 | (header (vector-ref rundat 0)) (runs (vector-ref rundat 1)) (states (if state (string-split state ",") '())) (statuses (if status (string-split status ",") '())) (state-status (if (string? new-state-status) (string-split new-state-status ",") '(#f #f))) (rp-mutex (make-mutex)) (bup-mutex (make-mutex)) (keep-records (args:get-arg "-keep-records")) ;; used in conjunction with -remove-runs to keep the records, TODO: consolidate this with "mode". (test-records '())) ;; for tasks that we wish to operate on all tests in one fell swoop (let* ((write-access-actions '(remove-runs set-state-status archive run-wait kill-runs)) (dbfile (conc *toppath* "/megatest.db")) (readonly-mode (not (file-write-access? dbfile)))) (when (and readonly-mode (member action write-access-actions)) (debug:print-error 0 *default-log-port* "megatest.db is readonly. Cannot proceed with action ["action"] in which write-access isrequired .") |
︙ | ︙ | |||
2137 2138 2139 2140 2141 2142 2143 | (let* ((run-id (db:get-value-by-header run header "id")) (run-state (db:get-value-by-header run header "state")) (run-name (db:get-value-by-header run header "runname")) (tests (if (not (equal? run-state "locked")) (proc-get-tests run-id) '())) (lasttpath "/does/not/exist/I/hope") | | | 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 | (let* ((run-id (db:get-value-by-header run header "id")) (run-state (db:get-value-by-header run header "state")) (run-name (db:get-value-by-header run header "runname")) (tests (if (not (equal? run-state "locked")) (proc-get-tests run-id) '())) (lasttpath "/does/not/exist/I/hope") (lastrealpath "/does/not/exist/I/hope") (worker-thread #f)) (debug:print-info 4 *default-log-port* "runs:operate-on run=" run ", header=" header) (if (not (null? tests)) (begin (case action ((kill-runs) (tasks:kill-runner target run-name "%") |
︙ | ︙ | |||
2164 2165 2166 2167 2168 2169 2170 | ((print-run) (debug:print 1 *default-log-port* "Printing info for run " runkey ", run=" run ", tests=" tests ", header=" header) action) ((run-wait) (debug:print 1 *default-log-port* "Waiting for run " runkey ", run=" runnamepatt " to complete")) ((archive) (debug:print 1 *default-log-port* "Archiving/restoring (" (args:get-arg "-archive") ") data for run: " runkey " " (db:get-value-by-header run header "runname")) | > | | | < | | | | | | | | | | | > > > | 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 | ((print-run) (debug:print 1 *default-log-port* "Printing info for run " runkey ", run=" run ", tests=" tests ", header=" header) action) ((run-wait) (debug:print 1 *default-log-port* "Waiting for run " runkey ", run=" runnamepatt " to complete")) ((archive) (debug:print 1 *default-log-port* "Archiving/restoring (" (args:get-arg "-archive") ") data for run: " runkey " " (db:get-value-by-header run header "runname")) (let ((op (string->symbol (args:get-arg "-archive")))) (set! worker-thread (make-thread (lambda () (case op ((save save-remove keep-html) (archive:run-bup op run-id run-name tests rp-mutex bup-mutex)) ((restore) (archive:bup-restore op run-id run-name tests rp-mutex bup-mutex)) ((get) ;;; NOTE: This is a special case. We wish to operate on ALL tests in one go (set! test-records (append tests test-records))) (else (debug:print-error 0 *default-log-port* "unrecognised sub command " op " for -archive. Run \"megatest\" to see help") (exit)))) "archive-bup-thread")) (thread-start! worker-thread) (if (eq? op 'get) (thread-join! worker-thread)) ;; we need the test-records set to not overlap )) (else (debug:print-info 0 *default-log-port* "action not recognised " action))) ;; actions that operate on one test at a time can be handled below ;; (let ((sorted-tests (filter vector? |
︙ | ︙ | |||
2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 | (debug:print-info 0 *default-log-port* "Estimating disk space usage for " test-fulln ": " (common:get-disk-space-used ddir))))))) (if (not (null? tal)) (loop (car tal)(cdr tal)))) ))) ) (if worker-thread (thread-join! worker-thread))) (common:join-backgrounded-threads)))) ;; remove the run if zero tests remain (if (eq? action 'remove-runs) (let* ((run-id (db:get-value-by-header run header "id")) ;; NB// masks run-id from above? (remtests (mt:get-tests-for-run run-id #f '("DELETED") '("n/a") not-in: #t))) (if (null? remtests) ;; no more tests remaining ;; Remove the last dir from the path. ;; And same for the link-resolved path | > | 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 | (debug:print-info 0 *default-log-port* "Estimating disk space usage for " test-fulln ": " (common:get-disk-space-used ddir))))))) (if (not (null? tal)) (loop (car tal)(cdr tal)))) ))) ) (if worker-thread (thread-join! worker-thread))) (common:join-backgrounded-threads)))) ;; remove the run if zero tests remain (if (eq? action 'remove-runs) (let* ((run-id (db:get-value-by-header run header "id")) ;; NB// masks run-id from above? (remtests (mt:get-tests-for-run run-id #f '("DELETED") '("n/a") not-in: #t))) (if (null? remtests) ;; no more tests remaining ;; Remove the last dir from the path. ;; And same for the link-resolved path |
︙ | ︙ | |||
2424 2425 2426 2427 2428 2429 2430 | (debug:print 1 *default-log-port* "Recursively removing real dir " realpath) (runs:recursive-delete-with-error-msg realpath) ))))) )) runs) | | > > | | | | 2429 2430 2431 2432 2433 2434 2435 2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 | (debug:print 1 *default-log-port* "Recursively removing real dir " realpath) (runs:recursive-delete-with-error-msg realpath) ))))) )) runs) ;; special case - archive get (if (equal? (args:get-arg "-archive") "get") (archive:bup-get-data "get" #f #f test-records rp-mutex bup-mutex)) ) #t ) (define (runs:remove-test-directory test mode) ;; remove-data-only) (let* ((run-dir (db:test-get-rundir test)) ;; run dir is from the link tree (real-dir (if (common:file-exists? run-dir) ;; (resolve-pathname run-dir) (common:nice-path run-dir) #f)) |
︙ | ︙ |