From 3dbf331942f11ee888ccbf849cacdd3a0ab971cd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 3 Jul 2018 00:26:59 +0200 Subject: 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. --- guix/store/deduplication.scm | 28 +++++++++++++++++++--------- 1 file changed, 19 insertions(+), 9 deletions(-) (limited to 'guix/store') 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 -- cgit v1.2.3