deduplication: Restore directory mtime and permissions after deduplication.
Fixes <https://bugs.gnu.org/33361>. * guix/store/deduplication.scm (replace-with-link): Call 'set-file-time' and 'chmod' after 'rename-file'. * tests/nar.scm ("restore-file-set with directories (signed, valid)"): New test.
This commit is contained in:
parent
8390869811
commit
f5a2724ae4
|
@ -102,11 +102,17 @@ LINK-PREFIX."
|
|||
SWAP-DIRECTORY as the directory to store temporary hard links.
|
||||
|
||||
Note: TARGET, TO-REPLACE, and SWAP-DIRECTORY must be on the same file system."
|
||||
(let ((temp-link (get-temp-link target swap-directory)))
|
||||
(make-file-writable (dirname to-replace))
|
||||
(let* ((temp-link (get-temp-link target swap-directory))
|
||||
(parent (dirname to-replace))
|
||||
(stat (stat parent)))
|
||||
(make-file-writable parent)
|
||||
(catch 'system-error
|
||||
(lambda ()
|
||||
(rename-file temp-link to-replace))
|
||||
(rename-file temp-link to-replace)
|
||||
|
||||
;; Restore PARENT's mtime and permissions.
|
||||
(set-file-time parent stat)
|
||||
(chmod parent (stat:mode stat)))
|
||||
(lambda args
|
||||
(delete-file temp-link)
|
||||
(unless (= EMLINK (system-error-errno args))
|
||||
|
|
|
@ -359,6 +359,41 @@
|
|||
files))
|
||||
(every canonical-file? files)))))))
|
||||
|
||||
(test-assert "restore-file-set with directories (signed, valid)"
|
||||
;; <https://bugs.gnu.org/33361> describes a bug whereby directories
|
||||
;; containing files subject to deduplication were not canonicalized--i.e.,
|
||||
;; their mtime and permissions were not reset. Ensure that this bug is
|
||||
;; gone.
|
||||
(with-store store
|
||||
(let* ((text1 (random-text))
|
||||
(text2 (random-text))
|
||||
(tree `("tree" directory
|
||||
("a" regular (data ,text1))
|
||||
("b" directory
|
||||
("c" regular (data ,text2))
|
||||
("d" regular (data ,text1))))) ;duplicate
|
||||
(file (add-file-tree-to-store store tree))
|
||||
(dump (call-with-bytevector-output-port
|
||||
(cute export-paths store (list file) <>))))
|
||||
(delete-paths store (list file))
|
||||
(and (not (file-exists? file))
|
||||
(let* ((source (open-bytevector-input-port dump))
|
||||
(imported (restore-file-set source)))
|
||||
(and (equal? imported (list file))
|
||||
(file-exists? file)
|
||||
(valid-path? store file)
|
||||
(string=? text1
|
||||
(call-with-input-file (string-append file "/a")
|
||||
get-string-all))
|
||||
(string=? text2
|
||||
(call-with-input-file
|
||||
(string-append file "/b/c")
|
||||
get-string-all))
|
||||
(= (stat:ino (stat (string-append file "/a"))) ;deduplication
|
||||
(stat:ino (stat (string-append file "/b/d"))))
|
||||
(every canonical-file?
|
||||
(find-files file #:directories? #t))))))))
|
||||
|
||||
(test-assert "restore-file-set (missing signature)"
|
||||
(let/ec return
|
||||
(with-store store
|
||||
|
|
Loading…
Reference in New Issue