02/07: deduplication: Use 'dynamic-wind' when changing permissions of the parent.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit d52e16d3b68b4f5e748b4d6014d4a9c207266ade
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Thu Jun 25 10:10:09 2020 +0200

    deduplication: Use 'dynamic-wind' when changing permissions of the parent.
    
    Suggested by Caleb Ristvedt <caleb.ristvedt@cune.org>.
    
    * guix/store/deduplication.scm (call-with-writable-file): New procedure.
    (with-writable-file): New macro.
    (replace-with-link): Use it.
---
 .dir-locals.el               |  1 +
 guix/store/deduplication.scm | 24 ++++++++++++++++--------
 2 files changed, 17 insertions(+), 8 deletions(-)

diff --git a/.dir-locals.el b/.dir-locals.el
index 92979fc..155255a 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -37,6 +37,7 @@
    (eval . (put 'with-file-lock 'scheme-indent-function 1))
    (eval . (put 'with-file-lock/no-wait 'scheme-indent-function 1))
    (eval . (put 'with-profile-lock 'scheme-indent-function 1))
+   (eval . (put 'with-writable-file 'scheme-indent-function 1))
 
    (eval . (put 'package 'scheme-indent-function 0))
    (eval . (put 'origin 'scheme-indent-function 0))
diff --git a/guix/store/deduplication.scm b/guix/store/deduplication.scm
index 6784ee0..af52c03 100644
--- a/guix/store/deduplication.scm
+++ b/guix/store/deduplication.scm
@@ -94,6 +94,20 @@ LINK-PREFIX."
             (try (tempname-in link-prefix))
             (apply throw args))))))
 
+(define (call-with-writable-file file thunk)
+  (let ((stat (lstat file)))
+    (dynamic-wind
+      (lambda ()
+        (make-file-writable file))
+      thunk
+      (lambda ()
+        (set-file-time file stat)
+        (chmod file (stat:mode stat))))))
+
+(define-syntax-rule (with-writable-file file exp ...)
+  "Make FILE writable for the dynamic extent of EXP..."
+  (call-with-writable-file file (lambda () exp ...)))
+
 ;; There are 3 main kinds of errors we can get from hardlinking: "Too many
 ;; things link to this" (EMLINK), "this link already exists" (EEXIST), and
 ;; "can't fit more stuff in this directory" (ENOSPC).
@@ -120,20 +134,14 @@ Note: TARGET, TO-REPLACE, and SWAP-DIRECTORY must be on 
the same file system."
   ;; 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)
+    (with-writable-file (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))))
-
-      ;; Restore PARENT's mtime and permissions.
-      (set-file-time parent stat)
-      (chmod parent (stat:mode stat)))))
+            (apply throw args)))))))
 
 (define* (deduplicate path hash #:key (store %store-directory))
   "Check if a store item with sha256 hash HASH already exists.  If so,