ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 21:38: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 (define links-directory
(string-append store "/.links")) (string-append store "/.links"))
(mkdir-p links-directory) (let loop ((path path)
(let loop ((path path) (type (stat:type (lstat path)))
(type (stat:type (lstat path))) (hash hash))
(hash hash)) (if (eq? 'directory type)
(if (eq? 'directory type) ;; Can't hardlink directories, so hardlink their atoms.
;; Can't hardlink directories, so hardlink their atoms. (for-each (match-lambda
(for-each (match-lambda ((file . properties)
((file . properties) (unless (member file '("." ".."))
(unless (member file '("." "..")) (let* ((file (string-append path "/" file))
(let* ((file (string-append path "/" file)) (type (match (assoc-ref properties 'type)
(type (match (assoc-ref properties 'type) ((or 'unknown #f)
((or 'unknown #f) (stat:type (lstat file)))
(stat:type (lstat file))) (type type))))
(type type)))) (loop file type
(loop file type (and (not (eq? 'directory type))
(and (not (eq? 'directory type)) (nar-sha256 file)))))))
(nar-sha256 file))))))) (scandir* path))
(scandir* path)) (let ((link-file (string-append links-directory "/"
(let ((link-file (string-append links-directory "/" (bytevector->nix-base32-string hash))))
(bytevector->nix-base32-string hash)))) (if (file-exists? link-file)
(if (file-exists? link-file) (replace-with-link link-file path
(replace-with-link link-file path #:swap-directory links-directory
#:swap-directory links-directory #:store store)
#:store store) (catch 'system-error
(catch 'system-error (lambda ()
(lambda () (link path link-file))
(link path link-file)) (lambda args
(lambda args (let ((errno (system-error-errno args)))
(let ((errno (system-error-errno args))) (cond ((= errno EEXIST)
(cond ((= errno EEXIST) ;; Someone else put an entry for PATH in
;; Someone else put an entry for PATH in ;; LINKS-DIRECTORY before we could. Let's use it.
;; LINKS-DIRECTORY before we could. Let's use it. (replace-with-link path link-file
(replace-with-link path link-file #:swap-directory
#:swap-directory links-directory
links-directory #:store store))
#:store store)) ((= errno ENOENT)
((= errno ENOSPC) ;; This most likely means that LINKS-DIRECTORY does
;; There's not enough room in the directory index for ;; not exist. Attempt to create it and try again.
;; more entries in .links, but that's fine: we can (mkdir-p links-directory)
;; just stop. (loop path type hash))
#f) ((= errno ENOSPC)
((= errno EMLINK) ;; There's not enough room in the directory index for
;; PATH has reached the maximum number of links, but ;; more entries in .links, but that's fine: we can
;; that's OK: we just can't deduplicate it more. ;; just stop.
#f) #f)
(else (apply throw args))))))))))) ((= 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) (define (tee input len output)
"Return a port that reads up to LEN bytes from INPUT and writes them to "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 () (lambda ()
(set! link (lambda (old new) (set! link (lambda (old new)
(set! links (+ links 1)) (set! links (+ links 1))
(if (<= links 3) (if (<= links 4)
(true-link old new) (true-link old new)
(throw 'system-error "link" "~A" '("Whaaat?!") (throw 'system-error "link" "~A" '("Whaaat?!")
(list ENOSPC)))))) (list ENOSPC))))))