diff options
| -rw-r--r-- | guix/store/deduplication.scm | 28 | ||||
| -rw-r--r-- | tests/store-deduplication.scm | 4 |
2 files changed, 23 insertions, 9 deletions
diff --git a/guix/store/deduplication.scm b/guix/store/deduplication.scm index b1cd8873ae..b97719d4bf 100644 --- a/guix/store/deduplication.scm +++ b/guix/store/deduplication.scm @@ -94,11 +94,21 @@ LINK-PREFIX." ;; things link to this" (EMLINK), "this link already exists" (EEXIST), and ;; "can't fit more stuff in this directory" (ENOSPC). -(define (replace-with-link target to-replace) - "Atomically replace the file TO-REPLACE with a link to TARGET. Note: TARGET -and TO-REPLACE must be on the same file system." - (let ((temp-link (get-temp-link target (dirname to-replace)))) - (rename-file temp-link to-replace))) +(define* (replace-with-link target to-replace + #:key (swap-directory (dirname target))) + "Atomically replace the file TO-REPLACE with a link to TARGET. Use +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)) + (catch 'system-error + (lambda () + (rename-file temp-link to-replace)) + (lambda args + (delete-file temp-link) + (unless (= EMLINK (system-error-errno args)) + (apply throw args)))))) (define-syntax-rule (false-if-system-error (errors ...) exp ...) "Given ERRORS, a list of system error codes to ignore, evaluates EXP... and @@ -131,8 +141,8 @@ under STORE." #:store store)))) (scandir path)) (if (file-exists? link-file) - (false-if-system-error (EMLINK) - (replace-with-link link-file path)) + (replace-with-link link-file path + #:swap-directory links-directory) (catch 'system-error (lambda () (link path link-file)) @@ -141,8 +151,8 @@ under STORE." (cond ((= errno EEXIST) ;; Someone else put an entry for PATH in ;; LINKS-DIRECTORY before we could. Let's use it. - (false-if-system-error (EMLINK) - (replace-with-link path link-file))) + (replace-with-link path link-file + #:swap-directory links-directory)) ((= errno ENOSPC) ;; There's not enough room in the directory index for ;; more entries in .links, but that's fine: we can diff --git a/tests/store-deduplication.scm b/tests/store-deduplication.scm index 2361723199..4ca2ec0f61 100644 --- a/tests/store-deduplication.scm +++ b/tests/store-deduplication.scm @@ -47,6 +47,10 @@ (lambda (port) (put-bytevector port data)))) identical) + ;; Make the parent of IDENTICAL read-only. This should not prevent + ;; deduplication for inserting its hard link. + (chmod (dirname (second identical)) #o544) + (call-with-output-file unique (lambda (port) (put-bytevector port (string->utf8 "This is unique.")))) |