06/06: deduplication: Place link files under /gnu/store/.links.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 3dbf331942f11ee888ccbf849cacdd3a0ab971cd
Author: Ludovic Courtès <address@hidden>
Date:   Tue Jul 3 00:26:59 2018 +0200

    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 +++++++++++++++++++---------
 tests/store-deduplication.scm |  4 ++++
 2 files changed, 23 insertions(+), 9 deletions(-)

diff --git a/guix/store/deduplication.scm b/guix/store/deduplication.scm
index b1cd887..b97719d 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
diff --git a/tests/store-deduplication.scm b/tests/store-deduplication.scm
index 2361723..4ca2ec0 100644
--- a/tests/store-deduplication.scm
+++ b/tests/store-deduplication.scm
@@ -47,6 +47,10 @@
                      (lambda (port)
                        (put-bytevector port data))))
                  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
          (lambda (port)
            (put-bytevector port (string->utf8 "This is unique."))))