diff options
Diffstat (limited to 'tests/store.scm')
| -rw-r--r-- | tests/store.scm | 235 |
1 files changed, 79 insertions, 156 deletions
diff --git a/tests/store.scm b/tests/store.scm index 5494e1a348..07ebff2ea2 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -310,46 +310,27 @@ (test-assert "substitute query" (with-store s - (let* ((d (package-derivation s %bootstrap-guile (%current-system))) - (o (derivation->output-path d)) - (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL") - (compose uri-path string->uri)))) + (let* ((d (package-derivation s %bootstrap-guile (%current-system))) + (o (derivation->output-path d))) ;; Create fake substituter data, to be read by `substitute-binary'. - (call-with-output-file (string-append dir "/nix-cache-info") - (lambda (p) - (format p "StoreDir: ~a\nWantMassQuery: 0\n" - (%store-prefix)))) - (call-with-output-file (string-append dir "/" (store-path-hash-part o) - ".narinfo") - (lambda (p) - (format p "StorePath: ~a -URL: ~a -Compression: none -NarSize: 1234 -References: -System: ~a -Deriver: ~a~%" - o ; StorePath - (string-append dir "/example.nar") ; URL - (%current-system) ; System - (basename - (derivation-file-name d))))) ; Deriver - - ;; Remove entry from the local cache. - (false-if-exception - (delete-file (string-append (getenv "XDG_CACHE_HOME") - "/guix/substitute-binary/" - (store-path-hash-part o)))) - - ;; Make sure `substitute-binary' correctly communicates the above data. - (set-build-options s #:use-substitutes? #t) - (and (has-substitutes? s o) - (equal? (list o) (substitutable-paths s (list o))) - (match (pk 'spi (substitutable-path-info s (list o))) - (((? substitutable? s)) - (and (string=? (substitutable-deriver s) (derivation-file-name d)) - (null? (substitutable-references s)) - (equal? (substitutable-nar-size s) 1234)))))))) + (with-derivation-narinfo d + ;; Remove entry from the local cache. + (false-if-exception + (delete-file (string-append (getenv "XDG_CACHE_HOME") + "/guix/substitute-binary/" + (store-path-hash-part o)))) + + ;; Make sure `substitute-binary' correctly communicates the above + ;; data. + (set-build-options s #:use-substitutes? #t) + (and (has-substitutes? s o) + (equal? (list o) (substitutable-paths s (list o))) + (match (pk 'spi (substitutable-path-info s (list o))) + (((? substitutable? s)) + (and (string=? (substitutable-deriver s) + (derivation-file-name d)) + (null? (substitutable-references s)) + (equal? (substitutable-nar-size s) 1234))))))))) (test-assert "substitute" (with-store s @@ -365,42 +346,24 @@ Deriver: ~a~%" (o (derivation->output-path d)) (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL") (compose uri-path string->uri)))) - ;; Create fake substituter data, to be read by `substitute-binary'. - (call-with-output-file (string-append dir "/nix-cache-info") - (lambda (p) - (format p "StoreDir: ~a\nWantMassQuery: 0\n" - (%store-prefix)))) - (call-with-output-file (string-append dir "/example.out") - (lambda (p) - (display c p))) - (call-with-output-file (string-append dir "/example.nar") - (lambda (p) - (write-file (string-append dir "/example.out") p))) - (call-with-output-file (string-append dir "/" (store-path-hash-part o) - ".narinfo") - (lambda (p) - (format p "StorePath: ~a -URL: ~a -Compression: none -NarSize: 1234 -NarHash: sha256:~a -References: -System: ~a -Deriver: ~a~%" - o ; StorePath - "example.nar" ; relative URL - (call-with-input-file (string-append dir "/example.nar") - (compose bytevector->nix-base32-string sha256 - get-bytevector-all)) - (%current-system) ; System - (basename - (derivation-file-name d))))) ; Deriver - - ;; Make sure we use `substitute-binary'. - (set-build-options s #:use-substitutes? #t) - (and (has-substitutes? s o) - (build-derivations s (list d)) - (equal? c (call-with-input-file o get-string-all)))))) + (call-with-output-file (string-append dir "/example.out") + (lambda (p) + (display c p))) + (call-with-output-file (string-append dir "/example.nar") + (lambda (p) + (write-file (string-append dir "/example.out") p))) + + (let ((h (call-with-input-file (string-append dir "/example.nar") + port-sha256))) + ;; Create fake substituter data, to be read by `substitute-binary'. + (with-derivation-narinfo d + (sha256 => h) + + ;; Make sure we use `substitute-binary'. + (set-build-options s #:use-substitutes? #t) + (and (has-substitutes? s o) + (build-derivations s (list d)) + (equal? c (call-with-input-file o get-string-all)))))))) (test-assert "substitute, corrupt output hash" ;; Tweak the substituter into installing a substitute whose hash doesn't @@ -417,52 +380,33 @@ Deriver: ~a~%" (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL") (compose uri-path string->uri)))) ;; Create fake substituter data, to be read by `substitute-binary'. - (call-with-output-file (string-append dir "/nix-cache-info") - (lambda (p) - (format p "StoreDir: ~a\nWantMassQuery: 0\n" - (%store-prefix)))) - (call-with-output-file (string-append dir "/example.out") - (lambda (p) - (display "The contents here do not match C." p))) - (call-with-output-file (string-append dir "/example.nar") - (lambda (p) - (write-file (string-append dir "/example.out") p))) - (call-with-output-file (string-append dir "/" (store-path-hash-part o) - ".narinfo") - (lambda (p) - (format p "StorePath: ~a -URL: ~a -Compression: none -NarSize: 1234 -NarHash: sha256:~a -References: -System: ~a -Deriver: ~a~%" - o ; StorePath - "example.nar" ; relative URL - (bytevector->nix-base32-string - (sha256 (string->utf8 c))) - (%current-system) ; System - (basename - (derivation-file-name d))))) ; Deriver - - ;; Make sure we use `substitute-binary'. - (set-build-options s - #:use-substitutes? #t - #:fallback? #f) - (and (has-substitutes? s o) - (guard (c ((nix-protocol-error? c) - ;; XXX: the daemon writes "hash mismatch in downloaded - ;; path", but the actual error returned to the client - ;; doesn't mention that. - (pk 'corrupt c) - (not (zero? (nix-protocol-error-status c))))) - (build-derivations s (list d)) - #f))))) + (with-derivation-narinfo d + (sha256 => (sha256 (string->utf8 c))) + + (call-with-output-file (string-append dir "/example.out") + (lambda (p) + (display "The contents here do not match C." p))) + (call-with-output-file (string-append dir "/example.nar") + (lambda (p) + (write-file (string-append dir "/example.out") p))) + + ;; Make sure we use `substitute-binary'. + (set-build-options s + #:use-substitutes? #t + #:fallback? #f) + (and (has-substitutes? s o) + (guard (c ((nix-protocol-error? c) + ;; XXX: the daemon writes "hash mismatch in downloaded + ;; path", but the actual error returned to the client + ;; doesn't mention that. + (pk 'corrupt c) + (not (zero? (nix-protocol-error-status c))))) + (build-derivations s (list d)) + #f)))))) (test-assert "substitute --fallback" (with-store s - (let* ((t (random-text)) ; contents of the output + (let* ((t (random-text)) ; contents of the output (d (build-expression->derivation s "substitute-me-not" `(call-with-output-file %output @@ -470,45 +414,24 @@ Deriver: ~a~%" (display ,t p))) #:guile-for-build (package-derivation s %bootstrap-guile (%current-system)))) - (o (derivation->output-path d)) - (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL") - (compose uri-path string->uri)))) + (o (derivation->output-path d))) ;; Create fake substituter data, to be read by `substitute-binary'. - (call-with-output-file (string-append dir "/nix-cache-info") - (lambda (p) - (format p "StoreDir: ~a\nWantMassQuery: 0\n" - (%store-prefix)))) - (call-with-output-file (string-append dir "/" (store-path-hash-part o) - ".narinfo") - (lambda (p) - (format p "StorePath: ~a -URL: ~a -Compression: none -NarSize: 1234 -NarHash: sha256:0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73 -References: -System: ~a -Deriver: ~a~%" - o ; StorePath - "does-not-exist.nar" ; relative URL - (%current-system) ; System - (basename - (derivation-file-name d))))) ; Deriver - - ;; Make sure we use `substitute-binary'. - (set-build-options s #:use-substitutes? #t) - (and (has-substitutes? s o) - (guard (c ((nix-protocol-error? c) - ;; The substituter failed as expected. Now make sure that - ;; #:fallback? #t works correctly. - (set-build-options s - #:use-substitutes? #t - #:fallback? #t) - (and (build-derivations s (list d)) - (equal? t (call-with-input-file o get-string-all))))) - ;; Should fail. - (build-derivations s (list d)) - #f))))) + (with-derivation-narinfo d + ;; Make sure we use `substitute-binary'. + (set-build-options s #:use-substitutes? #t) + (and (has-substitutes? s o) + (guard (c ((nix-protocol-error? c) + ;; The substituter failed as expected. Now make + ;; sure that #:fallback? #t works correctly. + (set-build-options s + #:use-substitutes? #t + #:fallback? #t) + (and (build-derivations s (list d)) + (equal? t (call-with-input-file o + get-string-all))))) + ;; Should fail. + (build-derivations s (list d)) + #f)))))) (test-assert "export/import several paths" (let* ((texts (unfold (cut >= <> 10) |