aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--.dir-locals.el2
-rw-r--r--guix/tests.scm35
-rw-r--r--tests/derivations.scm4
-rw-r--r--tests/store.scm235
4 files changed, 105 insertions, 171 deletions
diff --git a/.dir-locals.el b/.dir-locals.el
index b82d0494e4..91d57b9eb2 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -42,6 +42,8 @@
(eval . (put 'emacs-batch-edit-file 'scheme-indent-function 1))
(eval . (put 'emacs-substitute-sexps 'scheme-indent-function 1))
(eval . (put 'emacs-substitute-variables 'scheme-indent-function 1))
+ (eval . (put 'with-derivation-narinfo 'scheme-indent-function 1))
+
(eval . (put 'syntax-parameterize 'scheme-indent-function 1))
(eval . (put 'with-monad 'scheme-indent-function 1))
diff --git a/guix/tests.scm b/guix/tests.scm
index 36341cb4cc..ed2ad45a03 100644
--- a/guix/tests.scm
+++ b/guix/tests.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -20,6 +20,7 @@
#:use-module (guix store)
#:use-module (guix derivations)
#:use-module (guix packages)
+ #:use-module (guix base32)
#:use-module (gnu packages bootstrap)
#:use-module (srfi srfi-34)
#:use-module (rnrs bytevectors)
@@ -86,25 +87,31 @@ given by REPLACEMENT."
;;; Narinfo files, as used by the substituter.
;;;
-(define* (derivation-narinfo drv #:optional (nar "example.nar"))
+(define* (derivation-narinfo drv #:key (nar "example.nar")
+ (sha256 (make-bytevector 32 0)))
"Return the contents of the narinfo corresponding to DRV; NAR should be the
-file name of the archive containing the substitute for DRV."
+file name of the archive containing the substitute for DRV, and SHA256 is the
+expected hash."
(format #f "StorePath: ~a
URL: ~a
Compression: none
NarSize: 1234
+NarHash: sha256:~a
References:
System: ~a
Deriver: ~a~%"
(derivation->output-path drv) ; StorePath
nar ; URL
+ (bytevector->nix-base32-string sha256) ; NarHash
(derivation-system drv) ; System
(basename
(derivation-file-name drv)))) ; Deriver
-(define (call-with-derivation-narinfo drv thunk)
+(define* (call-with-derivation-narinfo drv thunk
+ #:key (sha256 (make-bytevector 32 0)))
"Call THUNK in a context where fake substituter data, as read by 'guix
-substitute-binary', has been installed for DRV."
+substitute-binary', has been installed for DRV. SHA256 is the hash of the
+expected output of DRV."
(let* ((output (derivation->output-path drv))
(dir (uri-path
(string->uri (getenv "GUIX_BINARY_SUBSTITUTE_URL"))))
@@ -119,18 +126,24 @@ substitute-binary', has been installed for DRV."
(%store-prefix))))
(call-with-output-file narinfo
(lambda (p)
- (display (derivation-narinfo drv) p))))
+ (display (derivation-narinfo drv #:sha256 sha256) p))))
thunk
(lambda ()
(delete-file narinfo)
(delete-file info)))))
-(define-syntax-rule (with-derivation-narinfo drv body ...)
- "Evaluate BODY in a context where DRV looks substitutable from the
+(define-syntax with-derivation-narinfo
+ (syntax-rules (sha256 =>)
+ "Evaluate BODY in a context where DRV looks substitutable from the
substituter's viewpoint."
- (call-with-derivation-narinfo drv
- (lambda ()
- body ...)))
+ ((_ drv (sha256 => hash) body ...)
+ (call-with-derivation-narinfo drv
+ (lambda () body ...)
+ #:sha256 hash))
+ ((_ drv body ...)
+ (call-with-derivation-narinfo drv
+ (lambda ()
+ body ...)))))
(define-syntax-rule (dummy-package name* extra-fields ...)
"Return a \"dummy\" package called NAME*, with all its compulsory fields
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 8e592ab6a1..80aabad3a8 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -916,7 +916,3 @@
(exit (= (test-runner-fail-count (test-runner-current)) 0))
-
-;; Local Variables:
-;; eval: (put 'with-derivation-narinfo 'scheme-indent-function 1)
-;; End:
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)