projects/guix·blob master · refs

237 lines · 10.3 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2018, 2020-2022, 2024 Ludovic Courtès <[email protected]>
3;;;
4;;; This file is part of GNU Guix.
5;;;
6;;; GNU Guix is free software; you can redistribute it and/or modify it
7;;; under the terms of the GNU General Public License as published by
8;;; the Free Software Foundation; either version 3 of the License, or (at
9;;; your option) any later version.
10;;;
11;;; GNU Guix is distributed in the hope that it will be useful, but
12;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14;;; GNU General Public License for more details.
15;;;
16;;; You should have received a copy of the GNU General Public License
17;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
18
19(define-module (test-store-deduplication)
20 #:use-module (guix tests)
21 #:use-module (guix store deduplication)
22 #:use-module (gcrypt hash)
23 #:use-module ((guix utils) #:select (call-with-temporary-directory))
24 #:use-module (guix build utils)
25 #:use-module (rnrs bytevectors)
26 #:use-module (ice-9 binary-ports)
27 #:use-module (ice-9 match)
28 #:use-module (srfi srfi-1)
29 #:use-module (srfi srfi-26)
30 #:use-module (srfi srfi-64))
31
32(define (cartesian-product . lst)
33 "Return the Cartesian product of all the given lists."
34 (match lst
35 ((head)
36 (map list head))
37 ((head . rest)
38 (let ((others (apply cartesian-product rest)))
39 (append-map (lambda (init)
40 (map (lambda (lst)
41 (cons init lst))
42 others))
43 head)))
44 (()
45 '())))
46
47
48(test-begin "store-deduplication")
49
50(test-equal "deduplicate, below %deduplication-minimum-size"
51 (list #t (make-list 5 1))
52
53 (call-with-temporary-directory
54 (lambda (store)
55 ;; Note: DATA must be longer than %DEDUPLICATION-MINIMUM-SIZE.
56 (let ((data "Hello, world!")
57 (identical (map (lambda (n)
58 (string-append store "/" (number->string n)
59 "/a/b/c"))
60 (iota 5))))
61 (for-each (lambda (file)
62 (mkdir-p (dirname file))
63 (call-with-output-file file
64 (lambda (port)
65 (put-bytevector port (string->utf8 data)))))
66 identical)
67
68 (deduplicate store (nar-sha256 store) #:store store)
69
70 ;; (system (string-append "ls -lRia " store))
71 (list (= (length (delete-duplicates
72 (map (compose stat:ino stat) identical)))
73 (length identical))
74 (map (compose stat:nlink stat) identical))))))
75
76(test-equal "deduplicate"
77 (cons* #t #f ;inode comparisons
78 2 (make-list 5 6)) ;'nlink' values
79
80 (call-with-temporary-directory
81 (lambda (store)
82 ;; Note: DATA must be longer than %DEDUPLICATION-MINIMUM-SIZE.
83 (let ((data (string-concatenate (make-list 1000 "Hello, world!")))
84 (identical (map (lambda (n)
85 (string-append store "/" (number->string n)
86 "/a/b/c"))
87 (iota 5)))
88 (unique (string-append store "/unique")))
89 (for-each (lambda (file)
90 (mkdir-p (dirname file))
91 (call-with-output-file file
92 (lambda (port)
93 (put-bytevector port (string->utf8 data)))))
94 identical)
95 ;; Make the parent of IDENTICAL read-only. This should not prevent
96 ;; deduplication from inserting its hard link.
97 (chmod (dirname (second identical)) #o544)
98
99 (call-with-output-file unique
100 (lambda (port)
101 (put-bytevector port (string->utf8 (string-reverse data)))))
102
103 (deduplicate store (nar-sha256 store) #:store store)
104
105 ;; (system (string-append "ls -lRia " store))
106 (cons* (apply = (map (compose stat:ino stat) identical))
107 (= (stat:ino (stat unique))
108 (stat:ino (stat (car identical))))
109 (stat:nlink (stat unique))
110 (map (compose stat:nlink stat) identical))))))
111
112(test-equal "deduplicate, ENOSPC"
113 (cons* #f ;inode comparison
114 (append (make-list 3 4)
115 (make-list 7 1))) ;'nlink' values
116
117 ;; In this scenario the first 3 files are properly deduplicated and then we
118 ;; simulate a full '.links' directory where link(2) gets ENOSPC, thereby
119 ;; preventing deduplication of the subsequent files.
120 (call-with-temporary-directory
121 (lambda (store)
122 (let ((true-link link)
123 (links 0)
124 (data1 (string->utf8
125 (string-concatenate (make-list 1000 "Hello, world!"))))
126 (data2 (string->utf8
127 (string-concatenate (make-list 1000 "Hi, world!"))))
128 (identical (map (lambda (n)
129 (string-append store "/" (number->string n)
130 "/a/b/c"))
131 (iota 10)))
132 (populate (lambda (data)
133 (lambda (file)
134 (mkdir-p (dirname file))
135 (call-with-output-file file
136 (lambda (port)
137 (put-bytevector port data)))))))
138 (for-each (populate data1) (take identical 5))
139 (for-each (populate data2) (drop identical 5))
140 (dynamic-wind
141 (lambda ()
142 (set! link (lambda (old new)
143 (set! links (+ links 1))
144 (if (<= links 4)
145 (true-link old new)
146 (throw 'system-error "link" "~A" '("Whaaat?!")
147 (list ENOSPC))))))
148 (lambda ()
149 (deduplicate store (nar-sha256 store) #:store store))
150 (lambda ()
151 (set! link true-link)))
152
153 (cons (apply = (map (compose stat:ino stat) identical))
154 (map (compose stat:nlink stat) identical))))))
155
156(test-assert "copy-file/deduplicate, below %deduplication-minimum-size"
157 (call-with-temporary-directory
158 (lambda (store)
159 (let ((source (string-append store "/input")))
160 (call-with-output-file source
161 (lambda (port)
162 (display "Hello!\n" port)))
163 (copy-file/deduplicate source
164 (string-append store "/a")
165 #:store store)
166 (and (not (directory-exists? (string-append store "/.links")))
167 (file=? source (string-append store "/a"))
168 (not (= (stat:ino (stat (string-append store "/a")))
169 (stat:ino (stat source)))))))))
170
171(test-assert "copy-file/deduplicate"
172 (call-with-temporary-directory
173 (lambda (store)
174 (let ((source (search-path %load-path "gnu/packages/emacs-xyz.scm")))
175 (for-each (lambda (target)
176 (copy-file/deduplicate source
177 (string-append store target)
178 #:store store))
179 '("/a" "/b" "/c"))
180 (and (directory-exists? (string-append store "/.links"))
181 (file=? source (string-append store "/a"))
182 (apply = (map (compose stat:ino stat
183 (cut string-append store <>))
184 '("/a" "/b" "/c"))))))))
185
186(for-each (match-lambda
187 ((initial-gap middle-gap final-gap)
188 (test-assert
189 (format #f "copy-file/deduplicate, sparse files (holes: ~a/~a/~a)"
190 initial-gap middle-gap final-gap)
191 (call-with-temporary-directory
192 (lambda (store)
193 (let* ((source (string-append store "/source"))
194 (store-st (stat store))
195 (store-bksz (stat:blksize store-st))
196 ;; the test checks that space is actually saved
197 ;; by the holes, but this isn't the case if
198 ;; the size of each allocated block is large enough to swamp the savings.
199 ;;
200 ;; So, on large-block systems (e.g. Asahi tmpfs) we need
201 ;; to scale the gaps so this is true again.
202 (scale (max 1 (/ store-bksz 4096)))
203 (initial-gap (* initial-gap scale))
204 (middle-gap (* middle-gap scale))
205 (final-gap (* final-gap scale)))
206 (call-with-output-file source
207 (lambda (port)
208 (seek port initial-gap SEEK_CUR)
209 (display "hi!" port)
210 (seek port middle-gap SEEK_CUR)
211 (display "bye." port)
212 (when (> final-gap 0)
213 (seek port (- final-gap 1) SEEK_CUR)
214 (put-u8 port 0))))
215
216 (for-each (lambda (target)
217 (copy-file/deduplicate source
218 (string-append store target)
219 #:store store))
220 '("/a" "/b" "/c"))
221 (system* "du" "-h" source)
222 (system* "du" "-h" "--apparent-size" source)
223 (system* "du" "-h" (string-append store "/a"))
224 (system* "du" "-h" "--apparent-size" (string-append store "/a"))
225 (and (directory-exists? (string-append store "/.links"))
226 (file=? source (string-append store "/a"))
227 (apply = (map (compose stat:ino stat
228 (cut string-append store <>))
229 '("/a" "/b" "/c")))
230 (let ((st (pk 'S (stat (string-append store "/a")))))
231 (<= (* 512 (stat:blocks st))
232 (stat:size st))))))))))
233 (cartesian-product '(0 3333 8192)
234 '(8192 9999 16384 22222)
235 '(0 8192)))
236
237(test-end "store-deduplication")