diff --git a/.dir-locals.el b/.dir-locals.el index 92979fc5ed..155255a770 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 6784ee0b92..af52c03370 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,