nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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:
Ludovic Courtès 2018-07-03 00:26:59 +02:00
parent af2f8ae5f1
commit 3dbf331942
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 23 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
guix/store/deduplication.scm
View File

@ -94,11 +94,21 @@ LINK-PREFIX."
;; 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 @@ under STORE."
#: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 @@ under STORE."
(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

4
tests/store-deduplication.scm
View File

@ -47,6 +47,10 @@
(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."))))