ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 05:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

deduplicate: Create the '.links' directory lazily.

Browse source 
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.
This commit is contained in:
Ludovic Courtès 2020-12-11 15:48:02 +01:00
parent 9e6fe0e08f
commit 7530e491b5
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 51 additions and 47 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

96
guix/store/deduplication.scm
View file

@ -159,52 +159,56 @@ (define* (deduplicate path hash #:key (store (%store-directory)))
(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

2
tests/store-deduplication.scm
View file

@ -95,7 +95,7 @@ (define-module (test-store-deduplication)
(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))))))