diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/cpan.scm | 2 | ||||
| -rw-r--r-- | tests/file-systems.scm | 26 | ||||
| -rw-r--r-- | tests/guix-system.sh | 6 | ||||
| -rw-r--r-- | tests/substitute.scm | 193 | ||||
| -rw-r--r-- | tests/uuid.scm | 56 |
5 files changed, 240 insertions, 43 deletions
diff --git a/tests/cpan.scm b/tests/cpan.scm index de865b22be..8900716cb0 100644 --- a/tests/cpan.scm +++ b/tests/cpan.scm @@ -100,7 +100,7 @@ ('home-page "http://search.cpan.org/dist/Foo-Bar") ('synopsis "Fizzle Fuzz") ('description 'fill-in-yourself!) - ('license (package-license perl))) + ('license 'perl-license)) (string=? (bytevector->nix-base32-string (call-with-input-string test-source port-sha256)) hash)) diff --git a/tests/file-systems.scm b/tests/file-systems.scm index 12f4f09c57..4c28d0ebc5 100644 --- a/tests/file-systems.scm +++ b/tests/file-systems.scm @@ -22,38 +22,12 @@ #:use-module (gnu system file-systems) #:use-module (srfi srfi-1) #:use-module (srfi srfi-64) - #:use-module (rnrs bytevectors) #:use-module (ice-9 match)) ;; Test the (gnu system file-systems) module. (test-begin "file-systems") -(test-equal "uuid->string" - "c5307e6b-d1ba-499d-89c5-cb0b143577c4" - (uuid->string - #vu8(197 48 126 107 209 186 73 157 137 197 203 11 20 53 119 196))) - -(test-equal "string->uuid" - '(16 "4dab5feb-d176-45de-b287-9b0a6e4c01cb") - (let ((uuid (string->uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb"))) - (list (bytevector-length uuid) (uuid->string uuid)))) - -(test-assert "uuid" - (let ((str "4dab5feb-d176-45de-b287-9b0a6e4c01cb")) - (bytevector=? (uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb") - (string->uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb")))) - -(test-assert "uuid, syntax error" - (catch 'syntax-error - (lambda () - (eval '(uuid "foobar") (current-module)) - #f) - (lambda (key proc message location form . args) - (and (eq? proc 'uuid) - (string-contains message "invalid UUID") - (equal? form '(uuid "foobar")))))) - (test-assert "file-system-needed-for-boot?" (let-syntax ((dummy-fs (syntax-rules () ((_ directory) diff --git a/tests/guix-system.sh b/tests/guix-system.sh index de6db0928c..d575795ea0 100644 --- a/tests/guix-system.sh +++ b/tests/guix-system.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> +# Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> # # This file is part of GNU Guix. # @@ -215,3 +215,7 @@ EOF # In both cases 'my-torrc' should be properly resolved. guix system build "$tmpdir/config.scm" -n (cd "$tmpdir"; guix system build "config.scm" -n) + +# Searching. +guix system search tor | grep "^name: tor" +guix system search anonym network | grep "^name: tor" diff --git a/tests/substitute.scm b/tests/substitute.scm index 69b272f2bb..0ad6247954 100644 --- a/tests/substitute.scm +++ b/tests/substitute.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org> -;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015, 2017 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -28,7 +28,9 @@ #:use-module (guix base32) #:use-module ((guix store) #:select (%store-prefix)) #:use-module ((guix ui) #:select (guix-warning-port)) - #:use-module ((guix build utils) #:select (delete-file-recursively)) + #:use-module ((guix build utils) + #:select (mkdir-p delete-file-recursively)) + #:use-module (guix tests http) #:use-module (rnrs bytevectors) #:use-module (rnrs io ports) #:use-module (web uri) @@ -112,6 +114,15 @@ version identifier.." +(define %main-substitute-directory + ;; The place where 'call-with-narinfo' stores its data by default. + (uri-path (string->uri (getenv "GUIX_BINARY_SUBSTITUTE_URL")))) + +(define %alternate-substitute-directory + ;; Another place. + (string-append (dirname %main-substitute-directory) + "/substituter-alt-data")) + (define %narinfo ;; Skeleton of the narinfo used below. (string-append "StorePath: " (%store-prefix) @@ -125,14 +136,14 @@ References: bar baz Deriver: " (%store-prefix) "/foo.drv System: mips64el-linux\n")) -(define (call-with-narinfo narinfo thunk) - "Call THUNK in a context where $GUIX_BINARY_SUBSTITUTE_URL is populated with +(define* (call-with-narinfo narinfo thunk + #:optional + (narinfo-directory %main-substitute-directory)) + "Call THUNK in a context where the directory at URL is populated with a file for NARINFO." - (let ((narinfo-directory (and=> (string->uri (getenv - "GUIX_BINARY_SUBSTITUTE_URL")) - uri-path)) - (cache-directory (string-append (getenv "XDG_CACHE_HOME") - "/guix/substitute/"))) + (mkdir-p narinfo-directory) + (let ((cache-directory (string-append (getenv "XDG_CACHE_HOME") + "/guix/substitute/"))) (dynamic-wind (lambda () (when (file-exists? cache-directory) @@ -161,14 +172,17 @@ a file for NARINFO." #f)) thunk (lambda () - (delete-file-recursively cache-directory))))) + (when (file-exists? cache-directory) + (delete-file-recursively cache-directory)))))) (define-syntax-rule (with-narinfo narinfo body ...) (call-with-narinfo narinfo (lambda () body ...))) +(define-syntax-rule (with-narinfo* narinfo directory body ...) + (call-with-narinfo narinfo (lambda () body ...) directory)) + ;; Transmit these options to 'guix substitute'. -(set! (@@ (guix scripts substitute) %cache-urls) - (list (getenv "GUIX_BINARY_SUBSTITUTE_URL"))) +(substitute-urls (list (getenv "GUIX_BINARY_SUBSTITUTE_URL"))) (test-equal "query narinfo without signature" "" ; not substitutable @@ -228,7 +242,7 @@ a file for NARINFO." (guix-substitute "--query")))))))) (test-quit "substitute, no signature" - "lacks a signature" + "no valid substitute" (with-narinfo %narinfo (guix-substitute "--substitute" (string-append (%store-prefix) @@ -236,7 +250,7 @@ a file for NARINFO." "foo"))) (test-quit "substitute, invalid hash" - "hash" + "no valid substitute" ;; The hash in the signature differs from the hash of %NARINFO. (with-narinfo (string-append %narinfo "Signature: " (signature-field "different body") @@ -247,7 +261,7 @@ a file for NARINFO." "foo"))) (test-quit "substitute, unauthorized key" - "unauthorized" + "no valid substitute" (with-narinfo (string-append %narinfo "Signature: " (signature-field %narinfo @@ -273,9 +287,158 @@ a file for NARINFO." (lambda () (false-if-exception (delete-file "substitute-retrieved")))))) +(test-equal "substitute, unauthorized narinfo comes first" + "Substitutable data." + (with-narinfo* + (string-append %narinfo "Signature: " + (signature-field + %narinfo + #:public-key %wrong-public-key)) + %alternate-substitute-directory + + (with-narinfo* (string-append %narinfo "Signature: " + (signature-field %narinfo)) + %main-substitute-directory + + (dynamic-wind + (const #t) + (lambda () + ;; Remove this file so that the substitute can only be retrieved + ;; from %ALTERNATE-SUBSTITUTE-DIRECTORY. + (delete-file (string-append %main-substitute-directory + "/example.nar")) + + (parameterize ((substitute-urls + (map (cut string-append "file://" <>) + (list %alternate-substitute-directory + %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-equal "substitute, unsigned narinfo comes first" + "Substitutable data." + (with-narinfo* %narinfo ;not signed! + %alternate-substitute-directory + + (with-narinfo* (string-append %narinfo "Signature: " + (signature-field %narinfo)) + %main-substitute-directory + + (dynamic-wind + (const #t) + (lambda () + ;; Remove this file so that the substitute can only be retrieved + ;; from %ALTERNATE-SUBSTITUTE-DIRECTORY. + (delete-file (string-append %main-substitute-directory + "/example.nar")) + + (parameterize ((substitute-urls + (map (cut string-append "file://" <>) + (list %alternate-substitute-directory + %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-equal "substitute, first narinfo is unsigned and has wrong hash" + "Substitutable data." + (with-narinfo* (regexp-substitute #f + (string-match "NarHash: [[:graph:]]+" + %narinfo) + 'pre + "NarHash: sha256:" + (bytevector->nix-base32-string + (make-bytevector 32)) + 'post) + %alternate-substitute-directory + + (with-narinfo* (string-append %narinfo "Signature: " + (signature-field %narinfo)) + %main-substitute-directory + + (dynamic-wind + (const #t) + (lambda () + ;; This time remove the file so that the substitute can only be + ;; retrieved from %MAIN-SUBSTITUTE-DIRECTORY. + (delete-file (string-append %alternate-substitute-directory + "/example.nar")) + + (parameterize ((substitute-urls + (map (cut string-append "file://" <>) + (list %alternate-substitute-directory + %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-equal "substitute, first narinfo is unsigned and has wrong refs" + "Substitutable data." + (with-narinfo* (regexp-substitute #f + (string-match "References: ([^\n]+)\n" + %narinfo) + 'pre "References: " 1 + " wrong set of references\n" + 'post) + %alternate-substitute-directory + + (with-narinfo* (string-append %narinfo "Signature: " + (signature-field %narinfo)) + %main-substitute-directory + + (dynamic-wind + (const #t) + (lambda () + ;; This time remove the file so that the substitute can only be + ;; retrieved from %MAIN-SUBSTITUTE-DIRECTORY. + (delete-file (string-append %alternate-substitute-directory + "/example.nar")) + + (parameterize ((substitute-urls + (map (cut string-append "file://" <>) + (list %alternate-substitute-directory + %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-quit "substitute, two invalid narinfos" + "no valid substitute" + (with-narinfo* %narinfo ;not signed + %alternate-substitute-directory + + (with-narinfo* (string-append %narinfo "Signature: " ;unauthorized + (signature-field + %narinfo + #:public-key %wrong-public-key)) + %main-substitute-directory + + (guix-substitute "--substitute" + (string-append (%store-prefix) + "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") + "substitute-retrieved")))) + (test-end "substitute") ;;; Local Variables: ;;; eval: (put 'with-narinfo 'scheme-indent-function 1) +;;; eval: (put 'with-narinfo* 'scheme-indent-function 2) ;;; eval: (put 'test-quit 'scheme-indent-function 2) ;;; End: diff --git a/tests/uuid.scm b/tests/uuid.scm new file mode 100644 index 0000000000..c2f15de996 --- /dev/null +++ b/tests/uuid.scm @@ -0,0 +1,56 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015, 2017 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-uuid) + #:use-module (gnu system uuid) + #:use-module (srfi srfi-64) + #:use-module (rnrs bytevectors)) + +(test-begin "uuid") + +(test-equal "uuid->string" + "c5307e6b-d1ba-499d-89c5-cb0b143577c4" + (uuid->string + #vu8(197 48 126 107 209 186 73 157 137 197 203 11 20 53 119 196))) + +(test-equal "string->uuid" + '(16 "4dab5feb-d176-45de-b287-9b0a6e4c01cb") + (let ((uuid (string->uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb"))) + (list (bytevector-length uuid) (uuid->string uuid)))) + +(test-assert "uuid" + (let ((str "4dab5feb-d176-45de-b287-9b0a6e4c01cb")) + (bytevector=? (uuid-bytevector + (uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb")) + (string->uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb")))) + +(test-assert "uuid, syntax error" + (catch 'syntax-error + (lambda () + (eval '(uuid "foobar") (current-module)) + #f) + (lambda (key proc message location form . args) + (and (eq? proc 'uuid) + (string-contains message "invalid UUID") + (equal? form '(uuid "foobar" 'dce)))))) + +(test-equal "uuid, ISO-9660, format preserved" + "1970-01-01-17-14-42-99" + (uuid->string (uuid "1970-01-01-17-14-42-99" 'iso9660))) + +(test-end) |