;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org>
-;;; Copyright © 2014, 2015, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
(define-module (test-substitute)
#:use-module (guix scripts substitute)
#:use-module (guix base64)
- #:use-module (guix hash)
+ #:use-module (gcrypt hash)
#:use-module (guix serialization)
- #:use-module (guix pk-crypto)
+ #:use-module (gcrypt pk-crypto)
#:use-module (guix pki)
#:use-module (guix config)
#:use-module (guix base32)
#:use-module ((guix store) #:select (%store-prefix))
#:use-module ((guix ui) #:select (guix-warning-port))
+ #:use-module ((guix utils) #:select (call-with-compressed-output-port))
#:use-module ((guix build utils)
- #:select (mkdir-p delete-file-recursively))
+ #:select (mkdir-p delete-file-recursively dump-port))
#:use-module (guix tests http)
#:use-module (rnrs bytevectors)
#:use-module (rnrs io ports)
(cute write-file
(string-append narinfo-directory "/example.out") <>))
- (set! (@@ (guix scripts substitute)
- %allow-unauthenticated-substitutes?)
- #f))
+ (%allow-unauthenticated-substitutes? #f))
thunk
(lambda ()
(when (file-exists? cache-directory)
(lambda ()
(guix-substitute "--query"))))))))
+(test-equal "query narinfo with signature over nothing"
+ ;; The signature is computed over the empty string, not over the important
+ ;; parts, so the narinfo must be ignored.
+ ""
+
+ (with-narinfo (string-append "Signature: " (signature-field "") "\n"
+ %narinfo "\n")
+ (string-trim-both
+ (with-output-to-string
+ (lambda ()
+ (with-input-from-string (string-append "have " (%store-prefix)
+ "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+ (lambda ()
+ (guix-substitute "--query"))))))))
+
+(test-equal "query narinfo with signature over irrelevant bits"
+ ;; The signature is valid but it does not cover the
+ ;; StorePath/NarHash/References tuple and is thus irrelevant; the narinfo
+ ;; must be ignored.
+ ""
+
+ (let ((prefix (string-append "StorePath: " (%store-prefix)
+ "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo
+URL: example.nar
+Compression: none\n")))
+ (with-narinfo (string-append prefix
+ "Signature: " (signature-field prefix) "
+NarHash: sha256:aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+NarSize: 42
+References: bar baz
+Deriver: " (%store-prefix) "/foo.drv
+System: mips64el-linux\n")
+ (string-trim-both
+ (with-output-to-string
+ (lambda ()
+ (with-input-from-string (string-append "have " (%store-prefix)
+ "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+ (lambda ()
+ (guix-substitute "--query")))))))))
+
(test-equal "query narinfo signed with authorized key"
(string-append (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
"/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
"substitute-retrieved"))))
+(test-equal "substitute, narinfo with several URLs"
+ "Substitutable data."
+ (let ((narinfo (string-append "StorePath: " (%store-prefix)
+ "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo
+URL: example.nar.gz
+Compression: gzip
+URL: example.nar.lz
+Compression: lzip
+URL: example.nar
+Compression: none
+NarHash: sha256:" (bytevector->nix-base32-string
+ (sha256 (string->utf8 "Substitutable data."))) "
+NarSize: 42
+References: bar baz
+Deriver: " (%store-prefix) "/foo.drv
+System: mips64el-linux\n")))
+ (with-narinfo (string-append narinfo "Signature: "
+ (signature-field narinfo))
+ (dynamic-wind
+ (const #t)
+ (lambda ()
+ (define (compress input output compression)
+ (call-with-output-file output
+ (lambda (port)
+ (call-with-compressed-output-port compression port
+ (lambda (port)
+ (call-with-input-file input
+ (lambda (input)
+ (dump-port input port))))))))
+
+ (let ((nar (string-append %main-substitute-directory
+ "/example.nar")))
+ (compress nar (string-append nar ".gz") 'gzip)
+ (compress nar (string-append nar ".lz") 'lzip))
+
+ (parameterize ((substitute-urls
+ (list (string-append "file://"
+ %main-substitute-directory))))
+ (guix-substitute "--substitute"
+ (string-append (%store-prefix)
+ "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+ "substitute-retrieved"))
+ (call-with-input-file "substitute-retrieved" get-string-all))
+ (lambda ()
+ (false-if-exception (delete-file "substitute-retrieved")))))))
+
(test-end "substitute")
;;; Local Variables: