diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/channels.scm | 131 | ||||
| -rw-r--r-- | tests/git-authenticate.scm | 27 | ||||
| -rw-r--r-- | tests/guix-environment-container.sh | 2 | ||||
| -rw-r--r-- | tests/guix-repl.sh | 84 | ||||
| -rw-r--r-- | tests/lint.scm | 39 |
5 files changed, 254 insertions, 29 deletions
diff --git a/tests/channels.scm b/tests/channels.scm index 3b141428c8..3a2c1d429b 100644 --- a/tests/channels.scm +++ b/tests/channels.scm @@ -31,15 +31,28 @@ #:use-module ((guix build utils) #:select (which)) #:use-module (git) #:use-module (guix git) + #:use-module (guix git-authenticate) + #:use-module (guix openpgp) #:use-module (guix tests git) + #:use-module (guix tests gnupg) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:use-module (srfi srfi-64) + #:use-module (rnrs bytevectors) + #:use-module (rnrs io ports) #:use-module (ice-9 control) #:use-module (ice-9 match)) +(define (gpg+git-available?) + (and (which (git-command)) + (which (gpg-command)) (which (gpgconf-command)))) + +(define commit-id-string + (compose oid->string commit-id)) + + (test-begin "channels") (define* (make-instance #:key @@ -199,12 +212,12 @@ (commit (oid->string (commit-id commit2))))) (old (channel (inherit spec) (commit (oid->string (commit-id commit1)))))) - (define (validate-pull channel current instance relation) + (define (validate-pull channel current commit relation) (return (and (eq? channel old) (string=? (oid->string (commit-id commit2)) current) (string=? (oid->string (commit-id commit1)) - (channel-instance-commit instance)) + commit) relation))) (with-store store @@ -389,4 +402,118 @@ (channel-news-for-commit channel commit5 commit1)) '(#f "tag-for-first-news-entry"))))))) +(unless (gpg+git-available?) (test-skip 1)) +(test-equal "authenticate-channel, wrong first commit signer" + #t + (with-fresh-gnupg-setup (list %ed25519-public-key-file + %ed25519-secret-key-file + %ed25519bis-public-key-file + %ed25519bis-secret-key-file) + (with-temporary-git-repository directory + `((add ".guix-channel" + ,(object->string + '(channel (version 0) + (keyring-reference "master")))) + (add ".guix-authorizations" + ,(object->string + `(authorizations (version 0) + ((,(key-fingerprint + %ed25519-public-key-file) + (name "Charlie")))))) + (add "signer.key" ,(call-with-input-file %ed25519-public-key-file + get-string-all)) + (commit "first commit" + (signer ,(key-fingerprint %ed25519-public-key-file))) + (add "random" ,(random-text)) + (commit "second commit" + (signer ,(key-fingerprint %ed25519-public-key-file)))) + (with-repository directory repository + (let* ((commit1 (find-commit repository "first")) + (commit2 (find-commit repository "second")) + (intro ((@@ (guix channels) make-channel-introduction) + (commit-id-string commit1) + (openpgp-public-key-fingerprint + (read-openpgp-packet + %ed25519bis-public-key-file)) ;different key + #f)) ;no signature + (channel (channel (name 'example) + (url (string-append "file://" directory)) + (introduction intro)))) + (guard (c ((message-condition? c) + (->bool (string-contains (condition-message c) + "initial commit")))) + (authenticate-channel channel directory + (commit-id-string commit2) + #:keyring-reference-prefix "") + 'failed)))))) + +(unless (gpg+git-available?) (test-skip 1)) +(test-assert "authenticate-channel, .guix-authorizations" + (with-fresh-gnupg-setup (list %ed25519-public-key-file + %ed25519-secret-key-file + %ed25519bis-public-key-file + %ed25519bis-secret-key-file) + (with-temporary-git-repository directory + `((add ".guix-channel" + ,(object->string + '(channel (version 0) + (keyring-reference "channel-keyring")))) + (add ".guix-authorizations" + ,(object->string + `(authorizations (version 0) + ((,(key-fingerprint + %ed25519-public-key-file) + (name "Charlie")))))) + (commit "zeroth commit") + (add "a.txt" "A") + (commit "first commit" + (signer ,(key-fingerprint %ed25519-public-key-file))) + (add "b.txt" "B") + (commit "second commit" + (signer ,(key-fingerprint %ed25519-public-key-file))) + (add "c.txt" "C") + (commit "third commit" + (signer ,(key-fingerprint %ed25519bis-public-key-file))) + (branch "channel-keyring") + (checkout "channel-keyring") + (add "signer.key" ,(call-with-input-file %ed25519-public-key-file + get-string-all)) + (add "other.key" ,(call-with-input-file %ed25519bis-public-key-file + get-string-all)) + (commit "keyring commit") + (checkout "master")) + (with-repository directory repository + (let* ((commit1 (find-commit repository "first")) + (commit2 (find-commit repository "second")) + (commit3 (find-commit repository "third")) + (intro ((@@ (guix channels) make-channel-introduction) + (commit-id-string commit1) + (openpgp-public-key-fingerprint + (read-openpgp-packet + %ed25519-public-key-file)) + #f)) ;no signature + (channel (channel (name 'example) + (url (string-append "file://" directory)) + (introduction intro)))) + ;; COMMIT1 and COMMIT2 are fine. + (and (authenticate-channel channel directory + (commit-id-string commit2) + #:keyring-reference-prefix "") + + ;; COMMIT3 is signed by an unauthorized key according to its + ;; parent's '.guix-authorizations' file. + (guard (c ((unauthorized-commit-error? c) + (and (oid=? (git-authentication-error-commit c) + (commit-id commit3)) + (bytevector=? + (openpgp-public-key-fingerprint + (unauthorized-commit-error-signing-key c)) + (openpgp-public-key-fingerprint + (read-openpgp-packet + %ed25519bis-public-key-file)))))) + (authenticate-channel channel directory + (commit-id-string commit3) + #:keyring-reference-prefix "") + 'failed))))))) + (test-end "channels") diff --git a/tests/git-authenticate.scm b/tests/git-authenticate.scm index 97990acaea..865481f7c5 100644 --- a/tests/git-authenticate.scm +++ b/tests/git-authenticate.scm @@ -32,31 +32,6 @@ ;; Test the (guix git-authenticate) tools. -(define %ed25519-public-key-file - (search-path %load-path "tests/ed25519.key")) -(define %ed25519-secret-key-file - (search-path %load-path "tests/ed25519.sec")) -(define %ed25519bis-public-key-file - (search-path %load-path "tests/ed25519bis.key")) -(define %ed25519bis-secret-key-file - (search-path %load-path "tests/ed25519bis.sec")) - -(define (read-openpgp-packet file) - (get-openpgp-packet - (open-bytevector-input-port - (call-with-input-file file read-radix-64)))) - -(define key-fingerprint - (compose openpgp-format-fingerprint - openpgp-public-key-fingerprint - read-openpgp-packet)) - -(define (key-id file) - (define id - (openpgp-public-key-id (read-openpgp-packet))) - - (string-pad (number->string id 16) 16 #\0)) - (define (gpg+git-available?) (and (which (git-command)) (which (gpg-command)) (which (gpgconf-command)))) @@ -81,7 +56,7 @@ #:keyring-reference "master") 'failed))))) -(unless (which (git-command)) (test-skip 1)) +(unless (which (gpg+git-available?)) (test-skip 1)) (test-assert "signed commits, SHA1 signature" (with-fresh-gnupg-setup (list %ed25519-public-key-file %ed25519-secret-key-file) diff --git a/tests/guix-environment-container.sh b/tests/guix-environment-container.sh index d313f2e734..45264d4978 100644 --- a/tests/guix-environment-container.sh +++ b/tests/guix-environment-container.sh @@ -24,7 +24,7 @@ set -e guix environment --version -if ! guile -c '((@@ (guix scripts environment) assert-container-features))' +if ! guile -c '((@ (guix scripts environment) assert-container-features))' then # User containers are not supported; skip this test. exit 77 diff --git a/tests/guix-repl.sh b/tests/guix-repl.sh new file mode 100644 index 0000000000..e1c2b8241f --- /dev/null +++ b/tests/guix-repl.sh @@ -0,0 +1,84 @@ +# GNU Guix --- Functional package management for GNU +# Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com> +# Copyright © 2020 Konrad Hinsen <konrad.hinsen@fastmail.net> +# +# 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/>. + +# +# Test the `guix repl' command-line utility. +# + +guix repl --version + +test_directory="`mktemp -d`" +export test_directory +trap 'chmod -Rf +w "$test_directory"; rm -rf "$test_directory"' EXIT + +tmpfile="$test_directory/foo.scm" +rm -f "$tmpfile" +trap 'rm -f "$tmpfile"' EXIT + +module_dir="t-guix-repl-$$" +mkdir "$module_dir" +trap 'rm -rf "$module_dir"' EXIT + + +cat > "$tmpfile"<<EOF +(use-modules (guix packages) + (gnu packages base)) + +(format #t "~a\n" (package-name coreutils)) +EOF + +test "`guix repl "$tmpfile"`" = "coreutils" + + +cat > "$module_dir/foo.scm"<<EOF +(define-module (foo) + #:use-module (guix packages) + #:use-module (gnu packages base)) + +(define-public dummy + (package (inherit hello) + (name "dummy") + (version "42") + (synopsis "dummy package") + (description "dummy package. Only used for testing purposes."))) +EOF + +cat > "$tmpfile"<<EOF +(use-modules (guix packages) + (foo)) + +(format #t "~a\n" (package-version dummy)) +EOF + +test "`guix repl "$tmpfile" -L "$module_dir"`" = "42" + +cat > "$tmpfile"<<EOF +(format #t "~a\n" (cdr (command-line))) +EOF + +test "`guix repl -- "$tmpfile" -a b --input=foo.txt`" = "(-a b --input=foo.txt)" + +cat > "$tmpfile"<<EOF +#!$(type -P env) -S guix repl -- +!# +(format #t "~a\n" (cdr (command-line))) +EOF +chmod 755 $tmpfile + +test "`"$tmpfile" -a b --input=foo.txt`" = "(-a b --input=foo.txt)" diff --git a/tests/lint.scm b/tests/lint.scm index 4ce45b4a70..ac174f9f23 100644 --- a/tests/lint.scm +++ b/tests/lint.scm @@ -353,6 +353,36 @@ (((and (? lint-warning?) first-warning) others ...) (lint-warning-message first-warning)))) +(test-equal "profile-collisions: no warnings" + '() + (check-profile-collisions (dummy-package "x"))) + +(test-equal "profile-collisions: propagated inputs collide" + "propagated inputs p0@1 and p0@2 collide" + (let* ((p0 (dummy-package "p0" (version "1"))) + (p0* (dummy-package "p0" (version "2"))) + (p1 (dummy-package "p1" (propagated-inputs `(("p0" ,p0))))) + (p2 (dummy-package "p2" (propagated-inputs `(("p1" ,p1))))) + (p3 (dummy-package "p3" (propagated-inputs `(("p0" ,p0*))))) + (p4 (dummy-package "p4" (propagated-inputs + `(("p2" ,p2) ("p3", p3)))))) + (single-lint-warning-message + (check-profile-collisions p4)))) + +(test-assert "profile-collisions: propagated inputs collide, store items" + (string-match-or-error + "propagated inputs /[[:graph:]]+-p0-1 and /[[:graph:]]+-p0-1 collide" + (let* ((p0 (dummy-package "p0" (version "1"))) + (p0* (dummy-package "p0" (version "1") + (inputs `(("x" ,(dummy-package "x")))))) + (p1 (dummy-package "p1" (propagated-inputs `(("p0" ,p0))))) + (p2 (dummy-package "p2" (propagated-inputs `(("p1" ,p1))))) + (p3 (dummy-package "p3" (propagated-inputs `(("p0" ,p0*))))) + (p4 (dummy-package "p4" (propagated-inputs + `(("p2" ,p2) ("p3", p3)))))) + (single-lint-warning-message + (check-profile-collisions p4))))) + (test-equal "license: invalid license" "invalid license field" (single-lint-warning-message @@ -707,6 +737,7 @@ (single-lint-warning-message (check-mirror-url (dummy-package "x" (source source)))))) +(test-skip (if (http-server-can-listen?) 0 1)) (test-equal "github-url" '() (with-http-server `((200 ,%long-string)) @@ -718,6 +749,7 @@ (sha256 %null-sha256))))))) (let ((github-url "https://github.com/foo/bar/bar-1.0.tar.gz")) + (test-skip (if (http-server-can-listen?) 0 1)) (test-equal "github-url: one suggestion" (string-append "URL should be '" github-url "'") @@ -740,6 +772,8 @@ (method url-fetch) (uri (%local-url)) (sha256 %null-sha256)))))))))))) + + (test-skip (if (http-server-can-listen?) 0 1)) (test-equal "github-url: already the correct github url" '() (check-github-url @@ -863,6 +897,7 @@ '() (check-formatting (dummy-package "x"))) +(test-skip (if (http-server-can-listen?) 0 1)) (test-assert "archival: missing content" (let* ((origin (origin (method url-fetch) @@ -874,6 +909,7 @@ (source origin))))))) (warning-contains? "not archived" warnings))) +(test-skip (if (http-server-can-listen?) 0 1)) (test-equal "archival: content available" '() (let* ((origin (origin @@ -887,6 +923,7 @@ (parameterize ((%swh-base-url (%local-url))) (check-archival (dummy-package "x" (source origin))))))) +(test-skip (if (http-server-can-listen?) 0 1)) (test-assert "archival: missing revision" (let* ((origin (origin (method git-fetch) @@ -906,6 +943,7 @@ (check-archival (dummy-package "x" (source origin))))))) (warning-contains? "scheduled" warnings))) +(test-skip (if (http-server-can-listen?) 0 1)) (test-equal "archival: revision available" '() (let* ((origin (origin @@ -921,6 +959,7 @@ (parameterize ((%swh-base-url (%local-url))) (check-archival (dummy-package "x" (source origin))))))) +(test-skip (if (http-server-can-listen?) 0 1)) (test-assert "archival: rate limit reached" ;; We should get a single warning stating that the rate limit was reached, ;; and nothing more, in particular no other HTTP requests. |