mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-25 22:08:16 -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
|
;; things link to this" (EMLINK), "this link already exists" (EEXIST), and
|
||||||
;; "can't fit more stuff in this directory" (ENOSPC).
|
;; "can't fit more stuff in this directory" (ENOSPC).
|
||||||
|
|
||||||
(define (replace-with-link target to-replace)
|
(define* (replace-with-link target to-replace
|
||||||
"Atomically replace the file TO-REPLACE with a link to TARGET. Note: TARGET
|
#:key (swap-directory (dirname target)))
|
||||||
and TO-REPLACE must be on the same file system."
|
"Atomically replace the file TO-REPLACE with a link to TARGET. Use
|
||||||
(let ((temp-link (get-temp-link target (dirname to-replace))))
|
SWAP-DIRECTORY as the directory to store temporary hard links.
|
||||||
(rename-file temp-link to-replace)))
|
|
||||||
|
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 ...)
|
(define-syntax-rule (false-if-system-error (errors ...) exp ...)
|
||||||
"Given ERRORS, a list of system error codes to ignore, evaluates EXP... and
|
"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))))
|
#:store store))))
|
||||||
(scandir path))
|
(scandir path))
|
||||||
(if (file-exists? link-file)
|
(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
|
(catch 'system-error
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(link path link-file))
|
(link path link-file))
|
||||||
|
@ -141,8 +151,8 @@ (define* (deduplicate path hash #:key (store %store-directory))
|
||||||
(cond ((= errno EEXIST)
|
(cond ((= errno EEXIST)
|
||||||
;; Someone else put an entry for PATH in
|
;; Someone else put an entry for PATH in
|
||||||
;; LINKS-DIRECTORY before we could. Let's use it.
|
;; 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)
|
((= errno ENOSPC)
|
||||||
;; There's not enough room in the directory index for
|
;; There's not enough room in the directory index for
|
||||||
;; more entries in .links, but that's fine: we can
|
;; more entries in .links, but that's fine: we can
|
||||||
|
|
|
@ -47,6 +47,10 @@ (define-module (test-store-deduplication)
|
||||||
(lambda (port)
|
(lambda (port)
|
||||||
(put-bytevector port data))))
|
(put-bytevector port data))))
|
||||||
identical)
|
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
|
(call-with-output-file unique
|
||||||
(lambda (port)
|
(lambda (port)
|
||||||
(put-bytevector port (string->utf8 "This is unique."))))
|
(put-bytevector port (string->utf8 "This is unique."))))
|
||||||
|
|
Loading…
Reference in a new issue