aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-12-11 15:48:02 +0100
committerLudovic Courtès <ludo@gnu.org>2020-12-15 17:32:12 +0100
commit7530e491b517497b7b8166b5ccecdc3d4cdb468d (patch)
treef228a2bcadb518ba8e948652ec41f41aafed1c51
parent9e6fe0e08fda67ab298ca33ef00ffbf078ce4dd9 (diff)
downloadguix-7530e491b517497b7b8166b5ccecdc3d4cdb468d.tar.gz
guix-7530e491b517497b7b8166b5ccecdc3d4cdb468d.zip
deduplicate: Create the '.links' directory lazily.
This avoids repeated (mkdir-p "/gnu/store/.links") calls when deduplicating lots of files. * guix/store/deduplication.scm (deduplicate): Remove initial call to 'mkdir-p'. Add ENOENT case in 'link' exception handler. Reindent. * tests/store-deduplication.scm ("deduplicate, ENOSPC"): Check for (<= links 4) to account for the initial 'link' call.
-rw-r--r--guix/store/deduplication.scm96
-rw-r--r--tests/store-deduplication.scm2
2 files changed, 51 insertions, 47 deletions
diff --git a/guix/store/deduplication.scm b/guix/store/deduplication.scm
index 8564f12107..a72a43bf79 100644
--- a/guix/store/deduplication.scm
+++ b/guix/store/deduplication.scm
@@ -159,52 +159,56 @@ under STORE."
(define links-directory
(string-append store "/.links"))
- (mkdir-p links-directory)
- (let loop ((path path)
- (type (stat:type (lstat path)))
- (hash hash))
- (if (eq? 'directory type)
- ;; Can't hardlink directories, so hardlink their atoms.
- (for-each (match-lambda
- ((file . properties)
- (unless (member file '("." ".."))
- (let* ((file (string-append path "/" file))
- (type (match (assoc-ref properties 'type)
- ((or 'unknown #f)
- (stat:type (lstat file)))
- (type type))))
- (loop file type
- (and (not (eq? 'directory type))
- (nar-sha256 file)))))))
- (scandir* path))
- (let ((link-file (string-append links-directory "/"
- (bytevector->nix-base32-string hash))))
- (if (file-exists? link-file)
- (replace-with-link link-file path
- #:swap-directory links-directory
- #:store store)
- (catch 'system-error
- (lambda ()
- (link path link-file))
- (lambda args
- (let ((errno (system-error-errno args)))
- (cond ((= errno EEXIST)
- ;; Someone else put an entry for PATH in
- ;; LINKS-DIRECTORY before we could. Let's use it.
- (replace-with-link path link-file
- #:swap-directory
- links-directory
- #:store store))
- ((= errno ENOSPC)
- ;; There's not enough room in the directory index for
- ;; more entries in .links, but that's fine: we can
- ;; just stop.
- #f)
- ((= errno EMLINK)
- ;; PATH has reached the maximum number of links, but
- ;; that's OK: we just can't deduplicate it more.
- #f)
- (else (apply throw args)))))))))))
+ (let loop ((path path)
+ (type (stat:type (lstat path)))
+ (hash hash))
+ (if (eq? 'directory type)
+ ;; Can't hardlink directories, so hardlink their atoms.
+ (for-each (match-lambda
+ ((file . properties)
+ (unless (member file '("." ".."))
+ (let* ((file (string-append path "/" file))
+ (type (match (assoc-ref properties 'type)
+ ((or 'unknown #f)
+ (stat:type (lstat file)))
+ (type type))))
+ (loop file type
+ (and (not (eq? 'directory type))
+ (nar-sha256 file)))))))
+ (scandir* path))
+ (let ((link-file (string-append links-directory "/"
+ (bytevector->nix-base32-string hash))))
+ (if (file-exists? link-file)
+ (replace-with-link link-file path
+ #:swap-directory links-directory
+ #:store store)
+ (catch 'system-error
+ (lambda ()
+ (link path link-file))
+ (lambda args
+ (let ((errno (system-error-errno args)))
+ (cond ((= errno EEXIST)
+ ;; Someone else put an entry for PATH in
+ ;; LINKS-DIRECTORY before we could. Let's use it.
+ (replace-with-link path link-file
+ #:swap-directory
+ links-directory
+ #:store store))
+ ((= errno ENOENT)
+ ;; This most likely means that LINKS-DIRECTORY does
+ ;; not exist. Attempt to create it and try again.
+ (mkdir-p links-directory)
+ (loop path type hash))
+ ((= errno ENOSPC)
+ ;; There's not enough room in the directory index for
+ ;; more entries in .links, but that's fine: we can
+ ;; just stop.
+ #f)
+ ((= errno EMLINK)
+ ;; PATH has reached the maximum number of links, but
+ ;; that's OK: we just can't deduplicate it more.
+ #f)
+ (else (apply throw args)))))))))))
(define (tee input len output)
"Return a port that reads up to LEN bytes from INPUT and writes them to
diff --git a/tests/store-deduplication.scm b/tests/store-deduplication.scm
index 7b01acae24..b1c2d93bbd 100644
--- a/tests/store-deduplication.scm
+++ b/tests/store-deduplication.scm
@@ -95,7 +95,7 @@
(lambda ()
(set! link (lambda (old new)
(set! links (+ links 1))
- (if (<= links 3)
+ (if (<= links 4)
(true-link old new)
(throw 'system-error "link" "~A" '("Whaaat?!")
(list ENOSPC))))))