diff options
Diffstat (limited to 'guix/store/deduplication.scm')
| -rw-r--r-- | guix/store/deduplication.scm | 28 |
1 files changed, 19 insertions, 9 deletions
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 |