summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2018-07-03 00:26:59 +0200
committerLudovic Courtès <ludo@gnu.org>2018-07-03 00:39:11 +0200
commit3dbf331942f11ee888ccbf849cacdd3a0ab971cd (patch)
treee14b075fe4e103288d7536123bcc4c83f1bf1f3a
parentaf2f8ae5f14d272d341148764d256792d8ef06aa (diff)
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.
-rw-r--r--guix/store/deduplication.scm28
-rw-r--r--tests/store-deduplication.scm4
2 files changed, 23 insertions, 9 deletions
diff --git a/guix/store/deduplication.scm b/guix/store/deduplication.scm
index b1cd8873aea..b97719d4bf6 100644
--- a/guix/store/deduplication.scm
+++ b/guix/store/deduplication.scm
@@ -94,11 +94,21 @@ LINK-PREFIX."
94;; things link to this" (EMLINK), "this link already exists" (EEXIST), and 94;; things link to this" (EMLINK), "this link already exists" (EEXIST), and
95;; "can't fit more stuff in this directory" (ENOSPC). 95;; "can't fit more stuff in this directory" (ENOSPC).
96 96
97(define (replace-with-link target to-replace) 97(define* (replace-with-link target to-replace
98 "Atomically replace the file TO-REPLACE with a link to TARGET. Note: TARGET 98 #:key (swap-directory (dirname target)))
99and TO-REPLACE must be on the same file system." 99 "Atomically replace the file TO-REPLACE with a link to TARGET. Use
100 (let ((temp-link (get-temp-link target (dirname to-replace)))) 100SWAP-DIRECTORY as the directory to store temporary hard links.
101 (rename-file temp-link to-replace))) 101
102Note: TARGET, TO-REPLACE, and SWAP-DIRECTORY must be on the same file system."
103 (let ((temp-link (get-temp-link target swap-directory)))
104 (make-file-writable (dirname to-replace))
105 (catch 'system-error
106 (lambda ()
107 (rename-file temp-link to-replace))
108 (lambda args
109 (delete-file temp-link)
110 (unless (= EMLINK (system-error-errno args))
111 (apply throw args))))))
102 112
103(define-syntax-rule (false-if-system-error (errors ...) exp ...) 113(define-syntax-rule (false-if-system-error (errors ...) exp ...)
104 "Given ERRORS, a list of system error codes to ignore, evaluates EXP... and 114 "Given ERRORS, a list of system error codes to ignore, evaluates EXP... and
@@ -131,8 +141,8 @@ under STORE."
131 #:store store)))) 141 #:store store))))
132 (scandir path)) 142 (scandir path))
133 (if (file-exists? link-file) 143 (if (file-exists? link-file)
134 (false-if-system-error (EMLINK) 144 (replace-with-link link-file path
135 (replace-with-link link-file path)) 145 #:swap-directory links-directory)
136 (catch 'system-error 146 (catch 'system-error
137 (lambda () 147 (lambda ()
138 (link path link-file)) 148 (link path link-file))
@@ -141,8 +151,8 @@ under STORE."
141 (cond ((= errno EEXIST) 151 (cond ((= errno EEXIST)
142 ;; Someone else put an entry for PATH in 152 ;; Someone else put an entry for PATH in
143 ;; LINKS-DIRECTORY before we could. Let's use it. 153 ;; LINKS-DIRECTORY before we could. Let's use it.
144 (false-if-system-error (EMLINK) 154 (replace-with-link path link-file
145 (replace-with-link path link-file))) 155 #:swap-directory links-directory))
146 ((= errno ENOSPC) 156 ((= errno ENOSPC)
147 ;; There's not enough room in the directory index for 157 ;; There's not enough room in the directory index for
148 ;; more entries in .links, but that's fine: we can 158 ;; more entries in .links, but that's fine: we can
diff --git a/tests/store-deduplication.scm b/tests/store-deduplication.scm
index 23617231994..4ca2ec0f61e 100644
--- a/tests/store-deduplication.scm
+++ b/tests/store-deduplication.scm
@@ -47,6 +47,10 @@
47 (lambda (port) 47 (lambda (port)
48 (put-bytevector port data)))) 48 (put-bytevector port data))))
49 identical) 49 identical)
50 ;; Make the parent of IDENTICAL read-only. This should not prevent
51 ;; deduplication for inserting its hard link.
52 (chmod (dirname (second identical)) #o544)
53
50 (call-with-output-file unique 54 (call-with-output-file unique
51 (lambda (port) 55 (lambda (port)
52 (put-bytevector port (string->utf8 "This is unique.")))) 56 (put-bytevector port (string->utf8 "This is unique."))))