Overview
Comment: | Fixed the first run archive disk not found issue |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.65-broken |
Files: | files | file ages | folders |
SHA1: |
64aa9347d5e5af8d43fdcfbf64891596 |
User & Date: | mrwellan on 2020-05-05 12:55:16 |
Other Links: | branch diff | manifest | tags |
Context
2020-05-05
| ||
18:07 | Updated makefile and initial attempt at mk_wrapper for chicken check-in: 071ebc34ba user: jmoon18 tags: v1.65-broken | |
12:55 | Fixed the first run archive disk not found issue check-in: 64aa9347d5 user: mrwellan tags: v1.65-broken | |
12:38 | fixed-save check-in: 50237f6e1f user: mrwellan tags: v1.65-broken | |
Changes
Modified archive.scm from [e3fbfd8139] to [212cc6c596].
︙ | ︙ | |||
88 89 90 91 92 93 94 | (hash-table-ref blockid-cache key) (let* ((pscript (configf:lookup *configdat* "archive" "pathscript")) (pscript-cmd (conc pscript " " testsuite-name " " target " " run-name " " test-name)) (apath (if pscript (handle-exceptions exn (begin | | | 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 | (hash-table-ref blockid-cache key) (let* ((pscript (configf:lookup *configdat* "archive" "pathscript")) (pscript-cmd (conc pscript " " testsuite-name " " target " " run-name " " test-name)) (apath (if pscript (handle-exceptions exn (begin (debug:print 0 *default-log-port* "ERROR: script \"" pscript-cmd "\" failed to run properly.") (exit 1)) (with-input-from-pipe pscript-cmd read-line)) #f)) ;; this is the user-calculated archive path (adisks (archive:get-archive-disks)) (best-disk (common:get-disk-with-most-free-space adisks dneeded))) |
︙ | ︙ | |||
115 116 117 118 119 120 121 | (block-id (rmt:archive-register-block-name bdisk-id archive-path))) ;; (allocation-id (rmt:archive-allocate-testsuite/area-to-block block-id testsuite-name area-key))) (if block-id ;; (and block-id allocation-id) (let ((res (cons block-id archive-path))) (hash-table-set! blockid-cache key res) res) (begin | | | | 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 | (block-id (rmt:archive-register-block-name bdisk-id archive-path))) ;; (allocation-id (rmt:archive-allocate-testsuite/area-to-block block-id testsuite-name area-key))) (if block-id ;; (and block-id allocation-id) (let ((res (cons block-id archive-path))) (hash-table-set! blockid-cache key res) res) (begin (debug:print 0 *default-log-port* "WARNING: no disk found for " target ", " run-name ", " test-name ", archive-path=" archive-path) #f))) (begin (debug:print 0 *default-log-port* "WARNING: no disk found for " target ", " run-name ", " test-name ", block-id=" block-id) #f)))))) ;; no best disk found ;; archive - run bup ;; ;; 1. create the bup dir if not exists ;; 2. start the du of each directory ;; 3. gen index |
︙ | ︙ |
Modified db.scm from [4b75655ccf] to [2247f17f91].
︙ | ︙ | |||
1462 1463 1464 1465 1466 1467 1468 | (sqlite3:for-each-row (lambda (id) (set! res id)) db "SELECT id FROM archive_blocks WHERE archive_disk_id=? AND disk_path=?;" bdisk-id archive-path) (if res ;; record exists, update du if applicable and return res | < | | < | | 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 | (sqlite3:for-each-row (lambda (id) (set! res id)) db "SELECT id FROM archive_blocks WHERE archive_disk_id=? AND disk_path=?;" bdisk-id archive-path) (if res ;; record exists, update du if applicable and return res (if du (sqlite3:execute db "UPDATE archive_blocks SET last_du=?,last_du_time=(strftime('%s','now')) WHERE archive_disk_id=? AND disk_path=?;" bdisk-id archive-path du)) (begin (sqlite3:execute db "INSERT OR REPLACE INTO archive_blocks (archive_disk_id,disk_path,last_du) VALUES (?,?,?);" bdisk-id archive-path (or du 0)) (set! res (db:archive-register-block-name dbstruct bdisk-id archive-path du: du)))) (stack-push! (dbr:dbstruct-dbstack dbstruct) dbdat) res)) ;; The "archived" field in tests is overloaded; 0 = not archived, > 0 archived in block with given id ;; (define (db:test-set-archive-block-id dbstruct run-id test-id archive-block-id) |
︙ | ︙ |