1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
4 ;;; This file is part of GNU Guix.
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.
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.
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/>.
19 (define-module (test-store)
20 #:use-module (guix tests)
21 #:use-module (guix store)
22 #:use-module (guix utils)
23 #:use-module (guix monads)
24 #:use-module (guix hash)
25 #:use-module (guix base32)
26 #:use-module (guix packages)
27 #:use-module (guix derivations)
28 #:use-module (guix serialization)
29 #:use-module (guix build utils)
30 #:use-module (guix gexp)
31 #:use-module (gnu packages)
32 #:use-module (gnu packages bootstrap)
33 #:use-module (ice-9 match)
34 #:use-module (rnrs bytevectors)
35 #:use-module (rnrs io ports)
36 #:use-module (web uri)
37 #:use-module (srfi srfi-1)
38 #:use-module (srfi srfi-11)
39 #:use-module (srfi srfi-26)
40 #:use-module (srfi srfi-34)
41 #:use-module (srfi srfi-64))
43 ;; Test the (guix store) module.
46 (open-connection-for-tests))
51 (test-equal "connection handshake error"
53 (let ((port (%make-void-port "rw")))
54 (guard (c ((nix-connection-error? c)
55 (and (eq? port (nix-connection-error-file c))
56 (nix-connection-error-code c))))
57 (open-connection #f #:port port)
60 (test-equal "store-path-hash-part"
61 "283gqy39v3g9dxjy26rynl0zls82fmcg"
63 (string-append (%store-prefix)
64 "/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7")))
66 (test-equal "store-path-hash-part #f"
69 (string-append (%store-prefix)
70 "/foo/bar/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7")))
72 (test-equal "store-path-package-name"
74 (store-path-package-name
75 (string-append (%store-prefix)
76 "/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7")))
78 (test-equal "store-path-package-name #f"
80 (store-path-package-name
81 "/foo/bar/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7"))
83 (test-assert "direct-store-path?"
84 (and (direct-store-path?
85 (string-append (%store-prefix)
86 "/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7"))
87 (not (direct-store-path?
90 "/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7/bin/guile")))
91 (not (direct-store-path? (%store-prefix)))))
93 (test-skip (if %store 0 13))
95 (test-equal "add-data-to-store"
97 (call-with-input-file (add-data-to-store %store "data" #vu8(1 2 3 4 5))
100 (test-assert "valid-path? live"
101 (let ((p (add-text-to-store %store "hello" "hello, world")))
102 (valid-path? %store p)))
104 (test-assert "valid-path? false"
105 (not (valid-path? %store
106 (string-append (%store-prefix) "/"
107 (make-string 32 #\e) "-foobar"))))
109 (test-assert "valid-path? error"
111 (guard (c ((nix-protocol-error? c) #t))
112 (valid-path? s "foo")
115 (test-assert "valid-path? recovery"
116 ;; Prior to Nix commit 51800e0 (18 Mar. 2014), the daemon would immediately
117 ;; close the connection after receiving a 'valid-path?' RPC with a non-store
119 ;; <http://article.gmane.org/gmane.linux.distributions.nixos/12411> for
122 (let-syntax ((true-if-error (syntax-rules ()
124 (guard (c ((nix-protocol-error? c) #t))
126 (and (true-if-error (valid-path? s "foo"))
127 (true-if-error (valid-path? s "bar"))
128 (true-if-error (valid-path? s "baz"))
129 (true-if-error (valid-path? s "chbouib"))
130 (valid-path? s (add-text-to-store s "valid" "yeah"))))))
132 (test-assert "hash-part->path"
133 (let ((p (add-text-to-store %store "hello" "hello, world")))
134 (equal? (hash-part->path %store (store-path-hash-part p))
137 (test-assert "dead-paths"
138 (let ((p (add-text-to-store %store "random-text" (random-text))))
139 (->bool (member p (dead-paths %store)))))
141 ;; FIXME: Find a test for `live-paths'.
143 ;; (test-assert "temporary root is in live-paths"
144 ;; (let* ((p1 (add-text-to-store %store "random-text"
145 ;; (random-text) '()))
146 ;; (b (add-text-to-store %store "link-builder"
147 ;; (format #f "echo ~a > $out" p1)
149 ;; (d1 (derivation %store "link"
150 ;; "/bin/sh" `("-e" ,b)
151 ;; #:inputs `((,b) (,p1))))
152 ;; (p2 (derivation->output-path d1)))
153 ;; (and (add-temp-root %store p2)
154 ;; (build-derivations %store (list d1))
155 ;; (valid-path? %store p1)
156 ;; (member (pk p2) (live-paths %store)))))
158 (test-assert "permanent root"
159 (let* ((p (with-store store
160 (let ((p (add-text-to-store store "random-text"
162 (add-permanent-root p)
163 (add-permanent-root p) ; should not throw
165 (and (member p (live-paths %store))
167 (remove-permanent-root p)
168 (->bool (member p (dead-paths %store)))))))
170 (test-assert "dead path can be explicitly collected"
171 (let ((p (add-text-to-store %store "random-text"
173 (let-values (((paths freed) (delete-paths %store (list p))))
174 (and (equal? paths (list p))
176 (not (file-exists? p))))))
178 (test-assert "add-text-to-store vs. delete-paths"
179 ;; Before, 'add-text-to-store' would return PATH2 without noticing that it
180 ;; is no longer valid.
182 (let* ((text (random-text))
183 (path (add-text-to-store store "delete-me" text))
184 (deleted (delete-paths store (list path)))
185 (path2 (add-text-to-store store "delete-me" text)))
186 (and (string=? path path2)
187 (equal? deleted (list path))
188 (valid-path? store path)
189 (file-exists? path)))))
191 (test-assert "add-to-store vs. delete-paths"
194 (let* ((file (search-path %load-path "guix.scm"))
195 (path (add-to-store store "delete-me" #t "sha256" file))
196 (deleted (delete-paths store (list path)))
197 (path2 (add-to-store store "delete-me" #t "sha256" file)))
198 (and (string=? path path2)
199 (equal? deleted (list path))
200 (valid-path? store path)
201 (file-exists? path)))))
203 (test-assert "references"
204 (let* ((t1 (add-text-to-store %store "random1"
206 (t2 (add-text-to-store %store "random2"
207 (random-text) (list t1))))
208 (and (equal? (list t1) (references %store t2))
209 (equal? (list t2) (referrers %store t1))
210 (null? (references %store t1))
211 (null? (referrers %store t2)))))
213 (test-assert "references/substitutes missing reference info"
215 (set-build-options s #:use-substitutes? #f)
216 (guard (c ((nix-protocol-error? c) #t))
217 (let* ((b (add-to-store s "bash" #t "sha256"
218 (search-bootstrap-binary "bash"
220 (d (derivation s "the-thing" b '("--help")
222 (references/substitutes s (list (derivation->output-path d) b))
225 (test-assert "references/substitutes with substitute info"
227 (set-build-options s #:use-substitutes? #t)
228 (let* ((t1 (add-text-to-store s "random1" (random-text)))
229 (t2 (add-text-to-store s "random2" (random-text)
231 (t3 (add-text-to-store s "build" "echo -n $t2 > $out"))
232 (b (add-to-store s "bash" #t "sha256"
233 (search-bootstrap-binary "bash"
235 (d (derivation s "the-thing" b `("-e" ,t3)
236 #:inputs `((,b) (,t3) (,t2))
237 #:env-vars `(("t2" . ,t2))))
238 (o (derivation->output-path d)))
239 (with-derivation-narinfo d
240 (sha256 => (sha256 (string->utf8 t2)))
241 (references => (list t2))
243 (equal? (references/substitutes s (list o t3 t2 t1))
249 (test-equal "substitutable-path-info when substitutes are turned off"
252 (set-build-options s #:use-substitutes? #f)
253 (let* ((b (add-to-store s "bash" #t "sha256"
254 (search-bootstrap-binary "bash"
256 (d (derivation s "the-thing" b '("--version")
258 (o (derivation->output-path d)))
259 (with-derivation-narinfo d
260 (substitutable-path-info s (list o))))))
262 (test-equal "substitutable-paths when substitutes are turned off"
265 (set-build-options s #:use-substitutes? #f)
266 (let* ((b (add-to-store s "bash" #t "sha256"
267 (search-bootstrap-binary "bash"
269 (d (derivation s "the-thing" b '("--version")
271 (o (derivation->output-path d)))
272 (with-derivation-narinfo d
273 (substitutable-paths s (list o))))))
275 (test-assert "requisites"
276 (let* ((t1 (add-text-to-store %store "random1"
278 (t2 (add-text-to-store %store "random2"
279 (random-text) (list t1)))
280 (t3 (add-text-to-store %store "random3"
281 (random-text) (list t2)))
282 (t4 (add-text-to-store %store "random4"
283 (random-text) (list t1 t3))))
285 (and (= (length x) (length y))
288 (and (same? (requisites %store (list t1)) (list t1))
289 (same? (requisites %store (list t2)) (list t1 t2))
290 (same? (requisites %store (list t3)) (list t1 t2 t3))
291 (same? (requisites %store (list t4)) (list t1 t2 t3 t4))
292 (same? (requisites %store (list t1 t2 t3 t4))
293 (list t1 t2 t3 t4)))))
295 (test-assert "derivers"
296 (let* ((b (add-text-to-store %store "build" "echo $foo > $out" '()))
297 (s (add-to-store %store "bash" #t "sha256"
298 (search-bootstrap-binary "bash"
300 (d (derivation %store "the-thing"
302 #:env-vars `(("foo" . ,(random-text)))
303 #:inputs `((,b) (,s))))
304 (o (derivation->output-path d)))
305 (and (build-derivations %store (list d))
306 (equal? (query-derivation-outputs %store (derivation-file-name d))
308 (equal? (valid-derivers %store o)
309 (list (derivation-file-name d))))))
311 (test-assert "topologically-sorted, one item"
312 (let* ((a (add-text-to-store %store "a" "a"))
313 (b (add-text-to-store %store "b" "b" (list a)))
314 (c (add-text-to-store %store "c" "c" (list b)))
315 (d (add-text-to-store %store "d" "d" (list c)))
316 (s (topologically-sorted %store (list d))))
317 (equal? s (list a b c d))))
319 (test-assert "topologically-sorted, several items"
320 (let* ((a (add-text-to-store %store "a" "a"))
321 (b (add-text-to-store %store "b" "b" (list a)))
322 (c (add-text-to-store %store "c" "c" (list b)))
323 (d (add-text-to-store %store "d" "d" (list c)))
324 (s1 (topologically-sorted %store (list d a c b)))
325 (s2 (topologically-sorted %store (list b d c a b d))))
326 (equal? s1 s2 (list a b c d))))
328 (test-assert "topologically-sorted, more difficult"
329 (let* ((a (add-text-to-store %store "a" "a"))
330 (b (add-text-to-store %store "b" "b" (list a)))
331 (c (add-text-to-store %store "c" "c" (list b)))
332 (d (add-text-to-store %store "d" "d" (list c)))
333 (w (add-text-to-store %store "w" "w"))
334 (x (add-text-to-store %store "x" "x" (list w)))
335 (y (add-text-to-store %store "y" "y" (list x d)))
336 (s1 (topologically-sorted %store (list y)))
337 (s2 (topologically-sorted %store (list c y)))
338 (s3 (topologically-sorted %store (cons y (references %store y)))))
339 ;; The order in which 'references' returns the references of Y is
340 ;; unspecified, so accommodate.
341 (let* ((x-then-d? (equal? (references %store y) (list x d))))
345 (list a b c d w x y)))
349 (list a b c d w x y)))
350 (lset= string=? s1 s3)))))
352 (test-assert "current-build-output-port, UTF-8"
353 ;; Are UTF-8 strings in the build log properly interpreted?
355 (with-fluids ((%default-port-encoding "UTF-8")) ;for the string port
356 (call-with-output-string
358 (parameterize ((current-build-output-port port))
359 (let* ((s "Here’s a Greek letter: λ.")
360 (d (build-expression->derivation
361 %store "foo" `(display ,s)
363 (package-derivation s %bootstrap-guile (%current-system)))))
364 (guard (c ((nix-protocol-error? c) #t))
365 (build-derivations %store (list d))))))))
366 "Here’s a Greek letter: λ."))
368 (test-assert "current-build-output-port, UTF-8 + garbage"
369 ;; What about a mixture of UTF-8 + garbage?
371 (with-fluids ((%default-port-encoding "UTF-8")) ;for the string port
372 (call-with-output-string
374 (parameterize ((current-build-output-port port))
375 (let ((d (build-expression->derivation
378 (use-modules (rnrs io ports))
379 (display "garbage: ")
380 (put-bytevector (current-output-port) #vu8(128))
381 (display "lambda: λ\n"))
383 (package-derivation %store %bootstrap-guile))))
384 (guard (c ((nix-protocol-error? c) #t))
385 (build-derivations %store (list d))))))))
386 "garbage: ?lambda: λ"))
388 (test-assert "log-file, derivation"
389 (let* ((b (add-text-to-store %store "build" "echo $foo > $out" '()))
390 (s (add-to-store %store "bash" #t "sha256"
391 (search-bootstrap-binary "bash"
393 (d (derivation %store "the-thing"
395 #:env-vars `(("foo" . ,(random-text)))
396 #:inputs `((,b) (,s)))))
397 (and (build-derivations %store (list d))
398 (file-exists? (pk (log-file %store (derivation-file-name d)))))))
400 (test-assert "log-file, output file name"
401 (let* ((b (add-text-to-store %store "build" "echo $foo > $out" '()))
402 (s (add-to-store %store "bash" #t "sha256"
403 (search-bootstrap-binary "bash"
405 (d (derivation %store "the-thing"
407 #:env-vars `(("foo" . ,(random-text)))
408 #:inputs `((,b) (,s))))
409 (o (derivation->output-path d)))
410 (and (build-derivations %store (list d))
411 (file-exists? (pk (log-file %store o)))
412 (string=? (log-file %store (derivation-file-name d))
413 (log-file %store o)))))
415 (test-assert "no substitutes"
417 (let* ((d1 (package-derivation s %bootstrap-guile (%current-system)))
418 (d2 (package-derivation s %bootstrap-glibc (%current-system)))
419 (o (map derivation->output-path (list d1 d2))))
420 (set-build-options s #:use-substitutes? #f)
421 (and (not (has-substitutes? s (derivation-file-name d1)))
422 (not (has-substitutes? s (derivation-file-name d2)))
423 (null? (substitutable-paths s o))
424 (null? (substitutable-path-info s o))))))
426 (test-assert "build-things with output path"
428 (let* ((c (random-text)) ;contents of the output
429 (d (build-expression->derivation
431 `(call-with-output-file %output
435 (package-derivation s %bootstrap-guile (%current-system))))
436 (o (derivation->output-path d)))
437 (set-build-options s #:use-substitutes? #f)
439 ;; Pass 'build-things' the output file name, O. However, since there
440 ;; are no substitutes for O, it will just do nothing.
441 (build-things s (list o))
442 (not (valid-path? s o)))))
444 (test-skip (if (getenv "GUIX_BINARY_SUBSTITUTE_URL") 0 1))
446 (test-assert "substitute query"
448 (let* ((d (package-derivation s %bootstrap-guile (%current-system)))
449 (o (derivation->output-path d)))
450 ;; Create fake substituter data, to be read by 'guix substitute'.
451 (with-derivation-narinfo d
452 ;; Remove entry from the local cache.
454 (delete-file-recursively (string-append (getenv "XDG_CACHE_HOME")
455 "/guix/substitute")))
457 ;; Make sure 'guix substitute' correctly communicates the above
459 (set-build-options s #:use-substitutes? #t
460 #:substitute-urls (%test-substitute-urls))
461 (and (has-substitutes? s o)
462 (equal? (list o) (substitutable-paths s (list o)))
463 (match (pk 'spi (substitutable-path-info s (list o)))
464 (((? substitutable? s))
465 (and (string=? (substitutable-deriver s)
466 (derivation-file-name d))
467 (null? (substitutable-references s))
468 (equal? (substitutable-nar-size s) 1234)))))))))
470 (test-assert "substitute query, alternating URLs"
471 (let* ((d (with-store s
472 (package-derivation s %bootstrap-guile (%current-system))))
473 (o (derivation->output-path d)))
474 (with-derivation-narinfo d
475 ;; Remove entry from the local cache.
477 (delete-file-recursively (string-append (getenv "XDG_CACHE_HOME")
478 "/guix/substitute")))
480 ;; Note: We reconnect to the daemon to force a new instance of 'guix
481 ;; substitute' to be used; otherwise the #:substitute-urls of
482 ;; 'set-build-options' would have no effect.
484 (and (with-store s ;the right substitute URL
485 (set-build-options s #:use-substitutes? #t
486 #:substitute-urls (%test-substitute-urls))
487 (has-substitutes? s o))
488 (with-store s ;the wrong one
489 (set-build-options s #:use-substitutes? #t
490 #:substitute-urls (list
491 "http://does-not-exist"))
492 (not (has-substitutes? s o)))
493 (with-store s ;the right one again
494 (set-build-options s #:use-substitutes? #t
495 #:substitute-urls (%test-substitute-urls))
496 (has-substitutes? s o))
497 (with-store s ;empty list of URLs
498 (set-build-options s #:use-substitutes? #t
499 #:substitute-urls '())
500 (not (has-substitutes? s o)))))))
502 (test-assert "substitute"
504 (let* ((c (random-text)) ; contents of the output
505 (d (build-expression->derivation
507 `(call-with-output-file %output
509 (exit 1) ; would actually fail
512 (package-derivation s %bootstrap-guile (%current-system))))
513 (o (derivation->output-path d)))
514 (with-derivation-substitute d c
515 (set-build-options s #:use-substitutes? #t
516 #:substitute-urls (%test-substitute-urls))
517 (and (has-substitutes? s o)
518 (build-derivations s (list d))
519 (equal? c (call-with-input-file o get-string-all)))))))
521 (test-assert "substitute + build-things with output path"
523 (let* ((c (random-text)) ;contents of the output
524 (d (build-expression->derivation
526 `(call-with-output-file %output
528 (exit 1) ;would actually fail
531 (package-derivation s %bootstrap-guile (%current-system))))
532 (o (derivation->output-path d)))
533 (with-derivation-substitute d c
534 (set-build-options s #:use-substitutes? #t
535 #:substitute-urls (%test-substitute-urls))
536 (and (has-substitutes? s o)
537 (build-things s (list o)) ;give the output path
539 (equal? c (call-with-input-file o get-string-all)))))))
541 (test-assert "substitute, corrupt output hash"
542 ;; Tweak the substituter into installing a substitute whose hash doesn't
543 ;; match the one announced in the narinfo. The daemon must notice this and
546 (let* ((c "hello, world") ; contents of the output
547 (d (build-expression->derivation
548 s "corrupt-substitute"
551 (package-derivation s %bootstrap-guile (%current-system))))
552 (o (derivation->output-path d)))
553 (with-derivation-substitute d c
554 (sha256 => (make-bytevector 32 0)) ;select a hash that doesn't match C
556 ;; Make sure we use 'guix substitute'.
558 #:use-substitutes? #t
560 #:substitute-urls (%test-substitute-urls))
561 (and (has-substitutes? s o)
562 (guard (c ((nix-protocol-error? c)
563 ;; XXX: the daemon writes "hash mismatch in downloaded
564 ;; path", but the actual error returned to the client
565 ;; doesn't mention that.
567 (not (zero? (nix-protocol-error-status c)))))
568 (build-derivations s (list d))
571 (test-assert "substitute --fallback"
573 (let* ((t (random-text)) ; contents of the output
574 (d (build-expression->derivation
575 s "substitute-me-not"
576 `(call-with-output-file %output
580 (package-derivation s %bootstrap-guile (%current-system))))
581 (o (derivation->output-path d)))
582 ;; Create fake substituter data, to be read by 'guix substitute'.
583 (with-derivation-narinfo d
584 ;; Make sure we use 'guix substitute'.
585 (set-build-options s #:use-substitutes? #t
586 #:substitute-urls (%test-substitute-urls))
587 (and (has-substitutes? s o)
588 (guard (c ((nix-protocol-error? c)
589 ;; The substituter failed as expected. Now make
590 ;; sure that #:fallback? #t works correctly.
592 #:use-substitutes? #t
594 (%test-substitute-urls)
596 (and (build-derivations s (list d))
597 (equal? t (call-with-input-file o
600 (build-derivations s (list d))
603 (test-assert "export/import several paths"
604 (let* ((texts (unfold (cut >= <> 10)
605 (lambda _ (random-text))
608 (files (map (cut add-text-to-store %store "text" <>) texts))
609 (dump (call-with-bytevector-output-port
610 (cut export-paths %store files <>))))
611 (delete-paths %store files)
612 (and (every (negate file-exists?) files)
613 (let* ((source (open-bytevector-input-port dump))
614 (imported (import-paths %store source)))
615 (and (equal? imported files)
616 (every file-exists? files)
619 (call-with-input-file file
623 (test-assert "export/import paths, ensure topological order"
624 (let* ((file0 (add-text-to-store %store "baz" (random-text)))
625 (file1 (add-text-to-store %store "foo" (random-text)
627 (file2 (add-text-to-store %store "bar" (random-text)
629 (files (list file1 file2))
630 (dump1 (call-with-bytevector-output-port
631 (cute export-paths %store (list file1 file2) <>)))
632 (dump2 (call-with-bytevector-output-port
633 (cute export-paths %store (list file2 file1) <>))))
634 (delete-paths %store files)
635 (and (every (negate file-exists?) files)
636 (bytevector=? dump1 dump2)
637 (let* ((source (open-bytevector-input-port dump1))
638 (imported (import-paths %store source)))
639 ;; DUMP1 should contain exactly FILE1 and FILE2, not FILE0.
640 (and (equal? imported (list file1 file2))
641 (every file-exists? files)
642 (equal? (list file0) (references %store file1))
643 (equal? (list file1) (references %store file2)))))))
645 (test-assert "export/import incomplete"
646 (let* ((file0 (add-text-to-store %store "baz" (random-text)))
647 (file1 (add-text-to-store %store "foo" (random-text)
649 (file2 (add-text-to-store %store "bar" (random-text)
651 (dump (call-with-bytevector-output-port
652 (cute export-paths %store (list file2) <>))))
653 (delete-paths %store (list file0 file1 file2))
654 (guard (c ((nix-protocol-error? c)
655 (and (not (zero? (nix-protocol-error-status c)))
656 (string-contains (nix-protocol-error-message c)
658 ;; Here we get an exception because DUMP does not include FILE0 and
659 ;; FILE1, which are dependencies of FILE2.
660 (import-paths %store (open-bytevector-input-port dump)))))
662 (test-assert "export/import recursive"
663 (let* ((file0 (add-text-to-store %store "baz" (random-text)))
664 (file1 (add-text-to-store %store "foo" (random-text)
666 (file2 (add-text-to-store %store "bar" (random-text)
668 (dump (call-with-bytevector-output-port
669 (cute export-paths %store (list file2) <>
671 (delete-paths %store (list file0 file1 file2))
672 (let ((imported (import-paths %store (open-bytevector-input-port dump))))
673 (and (equal? imported (list file0 file1 file2))
674 (every file-exists? (list file0 file1 file2))
675 (equal? (list file0) (references %store file1))
676 (equal? (list file1) (references %store file2))))))
678 (test-assert "write-file & export-path yield the same result"
679 ;; Here we compare 'write-file' and the daemon's own implementation.
680 ;; 'write-file' is the reference because we know it sorts file
681 ;; deterministically. Conversely, the daemon uses 'readdir' and the entries
682 ;; currently happen to be sorted as a side-effect of some unrelated
683 ;; operation (search for 'unhacked' in archive.cc.) Make sure we detect any
685 (run-with-store %store
686 (mlet* %store-monad ((drv1 (package->derivation %bootstrap-guile))
687 (out1 -> (derivation->output-path drv1))
688 (data -> (unfold (cut >= <> 26)
690 (random-bytevector 128))
694 (use-modules (rnrs io ports) (srfi srfi-1))
700 (+ i (char->integer #\a)))))
702 (define (touch file data)
703 (call-with-output-file file
705 (put-bytevector port data))))
710 ;; The files must be different so they have
711 ;; different inode numbers, and the inode
712 ;; order must differ from the lexicographic
715 (append (drop letters 10)
719 (drv2 (gexp->derivation "bunch" build))
720 (out2 -> (derivation->output-path drv2))
721 (item-info -> (store-lift query-path-info)))
723 (built-derivations (list drv1 drv2))
725 (lambda (item result)
727 (let-values (((port get) (open-sha256-port)))
728 (write-file item port)
732 ;; 'query-path-info' returns a hash produced by using the
733 ;; daemon's C++ 'dump' function, which is the implementation
735 (>>= (item-info item)
739 (bytevector=? (path-info-hash info) ref-hash))))))
742 #:guile-for-build (%guile-for-build)))
744 (test-assert "import corrupt path"
745 (let* ((text (random-text))
746 (file (add-text-to-store %store "text" text))
747 (dump (call-with-bytevector-output-port
748 (cut export-paths %store (list file) <>))))
749 (delete-paths %store (list file))
751 ;; Flip a bit in the stream's payload.
752 (let* ((index (quotient (bytevector-length dump) 4))
753 (byte (bytevector-u8-ref dump index)))
754 (bytevector-u8-set! dump index (logxor #xff byte)))
756 (and (not (file-exists? file))
757 (guard (c ((nix-protocol-error? c)
759 (and (not (zero? (nix-protocol-error-status c)))
760 (string-contains (nix-protocol-error-message c)
762 (let* ((source (open-bytevector-input-port dump))
763 (imported (import-paths %store source)))
764 (pk 'corrupt-imported imported)
767 (test-assert "register-path"
768 (let ((file (string-append (%store-prefix) "/" (make-string 32 #\f)
770 (when (valid-path? %store file)
771 (delete-paths %store (list file)))
772 (false-if-exception (delete-file file))
774 (let ((ref (add-text-to-store %store "ref-of-fake" (random-text)))
775 (drv (string-append file ".drv")))
776 (call-with-output-file file
777 (cut display "This is a fake store item.\n" <>))
779 #:references (list ref)
782 (and (valid-path? %store file)
783 (equal? (references %store file) (list ref))
784 (null? (valid-derivers %store file))
785 (null? (referrers %store file))))))
787 (test-assert "verify-store"
788 (let* ((text (random-text))
789 (file1 (add-text-to-store %store "foo" text))
790 (file2 (add-text-to-store %store "bar" (random-text)
792 (and (pk 'verify1 (verify-store %store)) ;hopefully OK ;
795 (not (pk 'verify2 (verify-store %store)))) ;bad! ;
797 ;; Using 'add-text-to-store' here wouldn't work: It would succeed ;
798 ;; without actually creating the file. ;
799 (call-with-output-file file1
801 (display text port)))
802 (pk 'verify3 (verify-store %store)))))) ;OK again
804 (test-assert "verify-store + check-contents"
805 ;; XXX: This test is I/O intensive.
807 (let* ((text (random-text))
808 (drv (build-expression->derivation
810 `(let ((out (assoc-ref %outputs "out")))
811 (call-with-output-file out
813 (display ,text port)))
816 (package-derivation s %bootstrap-guile (%current-system))))
817 (file (derivation->output-path drv)))
818 (with-derivation-substitute drv text
819 (and (build-derivations s (list drv))
820 (verify-store s #:check-contents? #t) ;should be OK
823 (call-with-output-file file
825 (display "corrupt!" port)))
828 ;; Make sure the corruption is detected. We don't test repairing
829 ;; because only "trusted" users are allowed to do it, but we
830 ;; don't expose that notion of trusted users that nix-daemon
831 ;; supports because it seems dubious and redundant with what the
832 ;; OS provides (in Nix "trusted" users have additional
833 ;; privileges, such as overriding the set of substitute URLs, but
834 ;; we instead want to allow anyone to modify them, provided
835 ;; substitutes are signed by a root-approved key.)
836 (not (verify-store s #:check-contents? #t))
838 ;; Delete the corrupt item to leave the store in a clean state.
839 (delete-paths s (list file)))))))
841 (test-assert "build-things, check mode"
843 (call-with-temporary-output-file
844 (lambda (entropy entropy-port)
845 (write (random-text) entropy-port)
846 (force-output entropy-port)
847 (let* ((drv (build-expression->derivation
848 store "non-deterministic"
850 (use-modules (rnrs io ports))
851 (let ((out (assoc-ref %outputs "out")))
852 (call-with-output-file out
854 ;; Rely on the fact that tests do not use the
855 ;; chroot, and thus ENTROPY is readable.
856 (display (call-with-input-file ,entropy
861 (package-derivation store %bootstrap-guile (%current-system))))
862 (file (derivation->output-path drv)))
863 (and (build-things store (list (derivation-file-name drv)))
865 (write (random-text) entropy-port)
866 (force-output entropy-port)
867 (guard (c ((nix-protocol-error? c)
868 (pk 'determinism-exception c)
869 (and (not (zero? (nix-protocol-error-status c)))
870 (string-contains (nix-protocol-error-message c)
872 ;; This one will produce a different result. Since we're in
873 ;; 'check' mode, this must fail.
874 (build-things store (list (derivation-file-name drv))
878 (test-assert "build multiple times"
880 ;; Ask to build twice.
881 (set-build-options store #:rounds 2 #:use-substitutes? #f)
883 (call-with-temporary-output-file
884 (lambda (entropy entropy-port)
885 (write (random-text) entropy-port)
886 (force-output entropy-port)
887 (let* ((drv (build-expression->derivation
888 store "non-deterministic"
890 (use-modules (rnrs io ports))
891 (let ((out (assoc-ref %outputs "out")))
892 (call-with-output-file out
894 ;; Rely on the fact that tests do not use the
895 ;; chroot, and thus ENTROPY is accessible.
896 (display (call-with-input-file ,entropy
899 (call-with-output-file ,entropy
901 (write 'foobar port)))))
904 (package-derivation store %bootstrap-guile (%current-system))))
905 (file (derivation->output-path drv)))
906 (guard (c ((nix-protocol-error? c)
907 (pk 'multiple-build c)
908 (and (not (zero? (nix-protocol-error-status c)))
909 (string-contains (nix-protocol-error-message c)
911 ;; This one will produce a different result on the second run.
912 (current-build-output-port (current-error-port))
913 (build-things store (list (derivation-file-name drv)))
916 (test-equal "store-lower"
918 (let* ((add (store-lower text-file))
919 (file (add %store "foo" "Lowered.")))
920 (call-with-input-file file get-string-all)))
922 (test-equal "current-system"
924 (parameterize ((%current-system "frob"))
925 (run-with-store %store
927 (set-current-system "bar")
931 (test-assert "query-path-info"
932 (let* ((ref (add-text-to-store %store "ref" "foo"))
933 (item (add-text-to-store %store "item" "bar" (list ref)))
934 (info (query-path-info %store item)))
935 (and (equal? (path-info-references info) (list ref))
936 (equal? (path-info-hash info)
939 (call-with-output-string (cut write-file item <>))))))))
941 (test-assert "path-info-deriver"
942 (let* ((b (add-text-to-store %store "build" "echo $foo > $out" '()))
943 (s (add-to-store %store "bash" #t "sha256"
944 (search-bootstrap-binary "bash"
946 (d (derivation %store "the-thing"
948 #:env-vars `(("foo" . ,(random-text)))
949 #:inputs `((,b) (,s))))
950 (o (derivation->output-path d)))
951 (and (build-derivations %store (list d))
952 (not (path-info-deriver (query-path-info %store b)))
953 (string=? (derivation-file-name d)
954 (path-info-deriver (query-path-info %store o))))))
956 (test-equal "build-cores"
959 (let* ((build (add-text-to-store store "build.sh"
960 "echo $NIX_BUILD_CORES > $out"))
961 (bash (add-to-store store "bash" #t "sha256"
962 (search-bootstrap-binary "bash"
964 (drv1 (derivation store "the-thing" bash
966 #:inputs `((,bash) (,build))
967 #:env-vars `(("x" . ,(random-text)))))
968 (drv2 (derivation store "the-thing" bash
970 #:inputs `((,bash) (,build))
971 #:env-vars `(("x" . ,(random-text))))))
972 (and (build-derivations store (list drv1))
974 (set-build-options store #:build-cores 42)
975 (build-derivations store (list drv2)))
976 (list (call-with-input-file (derivation->output-path drv1)
978 (call-with-input-file (derivation->output-path drv2)