mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
deduplication: Place link files under /gnu/store/.links.
Previously they'd always be placed next to TO-REPLACE, which would lead to EPERM in some cases. * guix/store/deduplication.scm (replace-with-link): Add #:swap-directory parameter and honor it. Add call to 'make-file-writable'. Catch 'system-error' around 'rename-file'. (deduplicate): Pass #:swap-directory and remove uses of 'false-if-system-error'. * tests/store-deduplication.scm ("deduplicate"): Add 'chmod' call.
This commit is contained in:
parent
af2f8ae5f1
commit
3dbf331942
2 changed files with 23 additions and 9 deletions
|
@ -94,11 +94,21 @@ (define* (get-temp-link target #:optional (link-prefix (dirname target)))
|
|||
;; 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 @@ (define* (deduplicate path hash #:key (store %store-directory))
|
|||
#: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 @@ (define* (deduplicate path hash #:key (store %store-directory))
|
|||
(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
|
||||
|
|
|
@ -47,6 +47,10 @@ (define-module (test-store-deduplication)
|
|||
(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."))))
|
||||
|
|
Loading…
Reference in a new issue