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

deduplicate: Fix a couple of thinkos.

Browse source 
* guix/store/deduplication.scm (get-temp-link): Turn 'args' in the 'catch'
handler into a rest argument.
(deduplicate): Use 'lstat' instead of 'file-is-directory?' to properly
handle symlinks.  When iterating over the result of 'scandir', exclude
the ".links" sub-directory.
* tests/store-deduplication.scm ("deduplicate"): Create sub-directories
and call 'deduplicate' directly on STORE.
This commit is contained in:
Ludovic Courtès 2018-06-06 16:36:01 +02:00
parent 866ee8c66a
commit 0d0438ed8c
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 12 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
guix/store/deduplication.scm
View file

@ -85,7 +85,7 @@ (define* (get-temp-link target #:optional (link-prefix (dirname target)))
(lambda () (lambda ()
(link target tempname) (link target tempname)
tempname) tempname)
(lambda (args) (lambda args
(if (= (system-error-errno args) EEXIST) (if (= (system-error-errno args) EEXIST)
(try (tempname-in link-prefix)) (try (tempname-in link-prefix))
(throw 'system-error args)))))) (throw 'system-error args))))))
@ -120,12 +120,15 @@ (define* (deduplicate path hash #:key (store %store-directory))
(link-file (string-append links-directory "/" (link-file (string-append links-directory "/"
(bytevector->base16-string hash)))) (bytevector->base16-string hash))))
(mkdir-p links-directory) (mkdir-p links-directory)
(if (file-is-directory? path) (if (eq? 'directory (stat:type (lstat path)))
;; Can't hardlink directories, so hardlink their atoms. ;; Can't hardlink directories, so hardlink their atoms.
(for-each (lambda (file) (for-each (lambda (file)
(unless (member file '("." "..")) (unless (or (member file '("." ".."))
(deduplicate file (nar-sha256 file) (and (string=? path store)
#:store store))) (string=? file ".links")))
(let ((file (string-append path "/" file)))
(deduplicate file (nar-sha256 file)
#:store store))))
(scandir path)) (scandir path))
(if (file-exists? link-file) (if (file-exists? link-file)
(false-if-system-error (EMLINK) (false-if-system-error (EMLINK)

9
tests/store-deduplication.scm
View file

@ -37,10 +37,12 @@ (define-module (test-store-deduplication)
(lambda (store) (lambda (store)
(let ((data (string->utf8 "Hello, world!")) (let ((data (string->utf8 "Hello, world!"))
(identical (map (lambda (n) (identical (map (lambda (n)
(string-append store "/" (number->string n))) (string-append store "/" (number->string n)
"/a/b/c"))
(iota 5))) (iota 5)))
(unique (string-append store "/unique"))) (unique (string-append store "/unique")))
(for-each (lambda (file) (for-each (lambda (file)
(mkdir-p (dirname file))
(call-with-output-file file (call-with-output-file file
(lambda (port) (lambda (port)
(put-bytevector port data)))) (put-bytevector port data))))
@ -49,10 +51,7 @@ (define-module (test-store-deduplication)
(lambda (port) (lambda (port)
(put-bytevector port (string->utf8 "This is unique.")))) (put-bytevector port (string->utf8 "This is unique."))))
(for-each (lambda (file) (deduplicate store (nar-sha256 store) #:store store)
(deduplicate file (sha256 data) #:store store))
identical)
(deduplicate unique (nar-sha256 unique) #:store store)
;; (system (string-append "ls -lRia " store)) ;; (system (string-append "ls -lRia " store))
(cons* (apply = (map (compose stat:ino stat) identical)) (cons* (apply = (map (compose stat:ino stat) identical))