summaryrefslogtreecommitdiff
path: root/guix/store
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 /guix/store
parentaf2f8ae5f14d272d341148764d256792d8ef06aa (diff)
downloadgnu-guix-3dbf331942f11ee888ccbf849cacdd3a0ab971cd.tar
gnu-guix-3dbf331942f11ee888ccbf849cacdd3a0ab971cd.tar.gz
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.
Diffstat (limited to 'guix/store')
-rw-r--r--guix/store/deduplication.scm28
1 files changed, 19 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