1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
| | ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2020-2022 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (test-store-deduplication)
#:use-module (guix tests)
#:use-module (guix store deduplication)
#:use-module (gcrypt hash)
#:use-module ((guix utils) #:select (call-with-temporary-directory))
#:use-module (guix build utils)
#:use-module (rnrs bytevectors)
#:use-module (ice-9 binary-ports)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-64))
(test-begin "store-deduplication")
(test-equal "deduplicate, below %deduplication-minimum-size"
(list #t (make-list 5 1))
(call-with-temporary-directory
(lambda (store)
;; Note: DATA must be longer than %DEDUPLICATION-MINIMUM-SIZE.
(let ((data "Hello, world!")
(identical (map (lambda (n)
(string-append store "/" (number->string n)
"/a/b/c"))
(iota 5))))
(for-each (lambda (file)
(mkdir-p (dirname file))
(call-with-output-file file
(lambda (port)
(put-bytevector port (string->utf8 data)))))
identical)
(deduplicate store (nar-sha256 store) #:store store)
;; (system (string-append "ls -lRia " store))
(list (= (length (delete-duplicates
(map (compose stat:ino stat) identical)))
(length identical))
(map (compose stat:nlink stat) identical))))))
(test-equal "deduplicate"
(cons* #t #f ;inode comparisons
2 (make-list 5 6)) ;'nlink' values
(call-with-temporary-directory
(lambda (store)
;; Note: DATA must be longer than %DEDUPLICATION-MINIMUM-SIZE.
(let ((data (string-concatenate (make-list 1000 "Hello, world!")))
(identical (map (lambda (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 (string->utf8 data)))))
identical)
;; Make the parent of IDENTICAL read-only. This should not prevent
;; deduplication from inserting its hard link.
(chmod (dirname (second identical)) #o544)
(call-with-output-file unique
(lambda (port)
(put-bytevector port (string->utf8 (string-reverse data)))))
(deduplicate store (nar-sha256 store) #:store store)
;; (system (string-append "ls -lRia " store))
(cons* (apply = (map (compose stat:ino stat) identical))
(= (stat:ino (stat unique))
(stat:ino (stat (car identical))))
(stat:nlink (stat unique))
(map (compose stat:nlink stat) identical))))))
(test-equal "deduplicate, ENOSPC"
(cons* #f ;inode comparison
(append (make-list 3 4)
(make-list 7 1))) ;'nlink' values
;; In this scenario the first 3 files are properly deduplicated and then we
;; simulate a full '.links' directory where link(2) gets ENOSPC, thereby
;; preventing deduplication of the subsequent files.
(call-with-temporary-directory
(lambda (store)
(let ((true-link link)
(links 0)
(data1 (string->utf8
(string-concatenate (make-list 1000 "Hello, world!"))))
(data2 (string->utf8
(string-concatenate (make-list 1000 "Hi, world!"))))
(identical (map (lambda (n)
(string-append store "/" (number->string n)
"/a/b/c"))
(iota 10)))
(populate (lambda (data)
(lambda (file)
(mkdir-p (dirname file))
(call-with-output-file file
(lambda (port)
(put-bytevector port data)))))))
(for-each (populate data1) (take identical 5))
(for-each (populate data2) (drop identical 5))
(dynamic-wind
(lambda ()
(set! link (lambda (old new)
(set! links (+ links 1))
(if (<= links 4)
(true-link old new)
(throw 'system-error "link" "~A" '("Whaaat?!")
(list ENOSPC))))))
(lambda ()
(deduplicate store (nar-sha256 store) #:store store))
(lambda ()
(set! link true-link)))
(cons (apply = (map (compose stat:ino stat) identical))
(map (compose stat:nlink stat) identical))))))
(test-assert "copy-file/deduplicate, below %deduplication-minimum-size"
(call-with-temporary-directory
(lambda (store)
(let ((source (string-append store "/input")))
(call-with-output-file source
(lambda (port)
(display "Hello!\n" port)))
(copy-file/deduplicate source
(string-append store "/a")
#:store store)
(and (not (directory-exists? (string-append store "/.links")))
(file=? source (string-append store "/a"))
(not (= (stat:ino (stat (string-append store "/a")))
(stat:ino (stat source)))))))))
(test-assert "copy-file/deduplicate"
(call-with-temporary-directory
(lambda (store)
(let ((source (search-path %load-path "gnu/packages/emacs-xyz.scm")))
(for-each (lambda (target)
(copy-file/deduplicate source
(string-append store target)
#:store store))
'("/a" "/b" "/c"))
(and (directory-exists? (string-append store "/.links"))
(file=? source (string-append store "/a"))
(apply = (map (compose stat:ino stat
(cut string-append store <>))
'("/a" "/b" "/c"))))))))
(test-end "store-deduplication")
|