From adb158b7396cbdcda347fa298978408e531a03fd Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 14 Dec 2018 11:10:25 +0100
Subject: deduplication: Gracefully handle ENOSPC raised by 'link' calls.

Reported by Andreas Enge <andreas@enge.fr>
in <https://bugs.gnu.org/33676>.

* guix/store/deduplication.scm (replace-with-link): Catch ENOSPC around
'get-temp-link'.  Do nothing when 'get-temp-link' throws ENOSPC.  Move
code to restore PARENT's permissions outside of 'catch'.
* tests/store-deduplication.scm ("deduplicate, ENOSPC"): New test.
---
 guix/store/deduplication.scm  | 40 ++++++++++++++++++++++++++-------------
 tests/store-deduplication.scm | 44 ++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 70 insertions(+), 14 deletions(-)

diff --git a/guix/store/deduplication.scm b/guix/store/deduplication.scm
index 21b0c81f3d..a777940f86 100644
--- a/guix/store/deduplication.scm
+++ b/guix/store/deduplication.scm
@@ -99,24 +99,38 @@ LINK-PREFIX."
 (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.
+SWAP-DIRECTORY as the directory to store temporary hard links.  Upon ENOSPC
+and EMLINK, TO-REPLACE is left unchanged.
 
 Note: TARGET, TO-REPLACE, and SWAP-DIRECTORY must be on the same file system."
-  (let* ((temp-link (get-temp-link target swap-directory))
-         (parent    (dirname to-replace))
-         (stat      (stat parent)))
-    (make-file-writable parent)
+  (define temp-link
     (catch 'system-error
       (lambda ()
-        (rename-file temp-link to-replace)
-
-        ;; Restore PARENT's mtime and permissions.
-        (set-file-time parent stat)
-        (chmod parent (stat:mode stat)))
+        (get-temp-link target swap-directory))
       (lambda args
-        (delete-file temp-link)
-        (unless (= EMLINK (system-error-errno args))
-          (apply throw args))))))
+        ;; We get ENOSPC when we can't fit an additional entry in
+        ;; SWAP-DIRECTORY.
+        (if (= ENOSPC (system-error-errno args))
+            #f
+            (apply throw args)))))
+
+  ;; If we couldn't create TEMP-LINK, that's OK: just don't do the
+  ;; replacement, which means TO-REPLACE won't be deduplicated.
+  (when temp-link
+    (let* ((parent (dirname to-replace))
+           (stat   (stat parent)))
+      (make-file-writable parent)
+      (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))))
+
+      ;; Restore PARENT's mtime and permissions.
+      (set-file-time parent stat)
+      (chmod parent (stat:mode stat)))))
 
 (define* (deduplicate path hash #:key (store %store-directory))
   "Check if a store item with sha256 hash HASH already exists.  If so,
diff --git a/tests/store-deduplication.scm b/tests/store-deduplication.scm
index e438aa84c6..e2870a363d 100644
--- a/tests/store-deduplication.scm
+++ b/tests/store-deduplication.scm
@@ -48,7 +48,7 @@
                        (put-bytevector port data))))
                  identical)
        ;; Make the parent of IDENTICAL read-only.  This should not prevent
-       ;; deduplication for inserting its hard link.
+       ;; deduplication from inserting its hard link.
        (chmod (dirname (second identical)) #o544)
 
        (call-with-output-file unique
@@ -64,4 +64,46 @@
               (stat:nlink (stat unique))
               (map (compose stat:nlink stat) identical))))))
 
+(test-equal "deduplicate, ENOSPC"
+  (cons* #f                                       ;inode comparison
+         (append (make-list 3 4)
+                 (make-list 7 1)))                ;'nlink' values
+
+  ;; In this scenario the first 3 files are properly deduplicated and then we
+  ;; simulate a full '.links' directory where link(2) gets ENOSPC, thereby
+  ;; preventing deduplication of the subsequent files.
+  (call-with-temporary-directory
+   (lambda (store)
+     (let ((true-link link)
+           (links     0)
+           (data1     (string->utf8 "Hello, world!"))
+           (data2     (string->utf8 "Hi, world!"))
+           (identical (map (lambda (n)
+                             (string-append store "/" (number->string n)
+                                            "/a/b/c"))
+                           (iota 10)))
+           (populate  (lambda (data)
+                        (lambda (file)
+                          (mkdir-p (dirname file))
+                          (call-with-output-file file
+                            (lambda (port)
+                              (put-bytevector port data)))))))
+       (for-each (populate data1) (take identical 5))
+       (for-each (populate data2) (drop identical 5))
+       (dynamic-wind
+         (lambda ()
+           (set! link (lambda (old new)
+                        (set! links (+ links 1))
+                        (if (<= links 3)
+                            (true-link old new)
+                            (throw 'system-error "link" "~A" '("Whaaat?!")
+                                   (list ENOSPC))))))
+         (lambda ()
+           (deduplicate store (nar-sha256 store) #:store store))
+         (lambda ()
+           (set! link true-link)))
+
+       (cons (apply = (map (compose stat:ino stat) identical))
+             (map (compose stat:nlink stat) identical))))))
+
 (test-end "store-deduplication")
-- 
cgit v1.2.3