diff options
| -rw-r--r-- | guix/store/deduplication.scm | 13 | ||||
| -rw-r--r-- | tests/store-deduplication.scm | 9 |
2 files changed, 12 insertions, 10 deletions
diff --git a/guix/store/deduplication.scm b/guix/store/deduplication.scm index 4b4ac01f64..d3139eb904 100644 --- a/guix/store/deduplication.scm +++ b/guix/store/deduplication.scm @@ -85,7 +85,7 @@ LINK-PREFIX." (lambda () (link target tempname) tempname) - (lambda (args) + (lambda args (if (= (system-error-errno args) EEXIST) (try (tempname-in link-prefix)) (throw 'system-error args)))))) @@ -120,12 +120,15 @@ under STORE." (link-file (string-append links-directory "/" (bytevector->base16-string hash)))) (mkdir-p links-directory) - (if (file-is-directory? path) + (if (eq? 'directory (stat:type (lstat path))) ;; Can't hardlink directories, so hardlink their atoms. (for-each (lambda (file) - (unless (member file '("." "..")) - (deduplicate file (nar-sha256 file) - #:store store))) + (unless (or (member file '("." "..")) + (and (string=? path store) + (string=? file ".links"))) + (let ((file (string-append path "/" file))) + (deduplicate file (nar-sha256 file) + #:store store)))) (scandir path)) (if (file-exists? link-file) (false-if-system-error (EMLINK) diff --git a/tests/store-deduplication.scm b/tests/store-deduplication.scm index 04817a193a..2361723199 100644 --- a/tests/store-deduplication.scm +++ b/tests/store-deduplication.scm @@ -37,10 +37,12 @@ (lambda (store) (let ((data (string->utf8 "Hello, world!")) (identical (map (lambda (n) - (string-append store "/" (number->string n))) + (string-append store "/" (number->string n) + "/a/b/c")) (iota 5))) (unique (string-append store "/unique"))) (for-each (lambda (file) + (mkdir-p (dirname file)) (call-with-output-file file (lambda (port) (put-bytevector port data)))) @@ -49,10 +51,7 @@ (lambda (port) (put-bytevector port (string->utf8 "This is unique.")))) - (for-each (lambda (file) - (deduplicate file (sha256 data) #:store store)) - identical) - (deduplicate unique (nar-sha256 unique) #:store store) + (deduplicate store (nar-sha256 store) #:store store) ;; (system (string-append "ls -lRia " store)) (cons* (apply = (map (compose stat:ino stat) identical)) |