diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/channels.scm | 84 | ||||
| -rw-r--r-- | tests/git-authenticate.scm | 2 | ||||
| -rw-r--r-- | tests/guix-git-authenticate.sh | 56 | ||||
| -rw-r--r-- | tests/guix-pack-relocatable.sh | 5 | ||||
| -rw-r--r-- | tests/lint.scm | 22 | ||||
| -rw-r--r-- | tests/pack.scm | 66 | ||||
| -rw-r--r-- | tests/packages.scm | 40 | ||||
| -rw-r--r-- | tests/store.scm | 4 | ||||
| -rw-r--r-- | tests/syscalls.scm | 6 |
9 files changed, 268 insertions, 17 deletions
diff --git a/tests/channels.scm b/tests/channels.scm index 3a2c1d429b..cde3b668fb 100644 --- a/tests/channels.scm +++ b/tests/channels.scm @@ -402,6 +402,27 @@ (channel-news-for-commit channel commit5 commit1)) '(#f "tag-for-first-news-entry"))))))) +(unless (which (git-command)) (test-skip 1)) +(test-assert "latest-channel-instances, missing introduction for 'guix'" + (with-temporary-git-repository directory + '((add "a.txt" "A") + (commit "first commit") + (add "b.scm" "#t") + (commit "second commit")) + (with-repository directory repository + (let* ((commit1 (find-commit repository "first")) + (commit2 (find-commit repository "second")) + (channel (channel (url (string-append "file://" directory)) + (name 'guix)))) + + (guard (c ((message-condition? c) + (->bool (string-contains (condition-message c) + "introduction")))) + (with-store store + ;; Attempt a downgrade from NEW to OLD. + (latest-channel-instances store (list channel)) + #f)))))) + (unless (gpg+git-available?) (test-skip 1)) (test-equal "authenticate-channel, wrong first commit signer" #t @@ -430,12 +451,11 @@ (with-repository directory repository (let* ((commit1 (find-commit repository "first")) (commit2 (find-commit repository "second")) - (intro ((@@ (guix channels) make-channel-introduction) + (intro (make-channel-introduction (commit-id-string commit1) (openpgp-public-key-fingerprint (read-openpgp-packet - %ed25519bis-public-key-file)) ;different key - #f)) ;no signature + %ed25519bis-public-key-file)))) ;different key (channel (channel (name 'example) (url (string-append "file://" directory)) (introduction intro)))) @@ -448,7 +468,8 @@ 'failed)))))) (unless (gpg+git-available?) (test-skip 1)) -(test-assert "authenticate-channel, .guix-authorizations" +(test-equal "authenticate-channel, .guix-authorizations" + #t (with-fresh-gnupg-setup (list %ed25519-public-key-file %ed25519-secret-key-file %ed25519bis-public-key-file @@ -486,12 +507,11 @@ (let* ((commit1 (find-commit repository "first")) (commit2 (find-commit repository "second")) (commit3 (find-commit repository "third")) - (intro ((@@ (guix channels) make-channel-introduction) + (intro (make-channel-introduction (commit-id-string commit1) (openpgp-public-key-fingerprint (read-openpgp-packet - %ed25519-public-key-file)) - #f)) ;no signature + %ed25519-public-key-file)))) (channel (channel (name 'example) (url (string-append "file://" directory)) (introduction intro)))) @@ -516,4 +536,54 @@ #:keyring-reference-prefix "") 'failed))))))) +(unless (gpg+git-available?) (test-skip 1)) +(test-equal "latest-channel-instances, authenticate dependency" + #t + ;; Make sure that a channel dependency that has an introduction is + ;; authenticated. This test checks that an authentication error is raised + ;; as it should when authenticating the dependency. + (with-fresh-gnupg-setup (list %ed25519-public-key-file + %ed25519-secret-key-file) + (with-temporary-git-repository dependency-directory + `((add ".guix-channel" + ,(object->string + '(channel (version 0) + (keyring-reference "master")))) + (add ".guix-authorizations" + ,(object->string + `(authorizations (version 0) ()))) + (add "signer.key" ,(call-with-input-file %ed25519-public-key-file + get-string-all)) + (commit "zeroth commit" + (signer ,(key-fingerprint %ed25519-public-key-file))) + (add "foo.txt" "evil") + (commit "unsigned commit")) + (with-repository dependency-directory dependency + (let* ((commit0 (find-commit dependency "zeroth")) + (commit1 (find-commit dependency "unsigned")) + (intro `(channel-introduction + (version 0) + (commit ,(commit-id-string commit0)) + (signer ,(openpgp-format-fingerprint + (openpgp-public-key-fingerprint + (read-openpgp-packet + %ed25519-public-key-file))))))) + (with-temporary-git-repository directory + `((add ".guix-channel" + ,(object->string + `(channel (version 0) + (dependencies + (channel + (name test-channel) + (url ,dependency-directory) + (introduction ,intro)))))) + (commit "single commit")) + (let ((channel (channel (name 'test) (url directory)))) + (guard (c ((unsigned-commit-error? c) + (oid=? (git-authentication-error-commit c) + (commit-id commit1)))) + (with-store store + (latest-channel-instances store (list channel)) + 'failed))))))))) + (test-end "channels") diff --git a/tests/git-authenticate.scm b/tests/git-authenticate.scm index 865481f7c5..d87eacc659 100644 --- a/tests/git-authenticate.scm +++ b/tests/git-authenticate.scm @@ -56,7 +56,7 @@ #:keyring-reference "master") 'failed))))) -(unless (which (gpg+git-available?)) (test-skip 1)) +(unless (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-git-authenticate.sh b/tests/guix-git-authenticate.sh new file mode 100644 index 0000000000..1c76e240b5 --- /dev/null +++ b/tests/guix-git-authenticate.sh @@ -0,0 +1,56 @@ +# GNU Guix --- Functional package management for GNU +# Copyright © 2020 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/>. + +# +# Test the 'guix git authenticate' command-line utility. +# + +# Skip if we're not in a Git checkout. +[ -d "$abs_top_srcdir/.git" ] || exit 77 + +# Skip if there's no 'keyring' branch. +guile -c '(use-modules (git)) + (member "refs/heads/keyring" (branch-list (repository-open ".")))' || \ + exit 77 + +# Keep in sync with '%default-channels' in (guix channels)! +intro_commit="9edb3f66fd807b096b48283debdcddccfea34bad" +intro_signer="BBB0 2DDF 2CEA F6A8 0D1D E643 A2A0 6DF2 A33A 54FA" + +cache_key="test-$$" + +guix git authenticate "$intro_commit" "$intro_signer" \ + --cache-key="$cache_key" --stats \ + --end=9549f0283a78fe36f2d4ff2a04ef8ad6b0c02604 + +rm "$XDG_CACHE_HOME/guix/authentication/$cache_key" + +# Commit and signer of the 'v1.0.0' tag. +v1_0_0_commit="6298c3ffd9654d3231a6f25390b056483e8f407c" +v1_0_0_signer="3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5" # civodul +v1_0_1_commit="d68de958b60426798ed62797ff7c96c327a672ac" + +# This should fail because these commits lack '.guix-authorizations'. +if guix git authenticate "$v1_0_0_commit" "$v1_0_0_signer" \ + --cache-key="$cache_key" --end="$v1_0_1_commit"; +then false; else true; fi + +# This should work thanks to '--historical-authorizations'. +guix git authenticate "$v1_0_0_commit" "$v1_0_0_signer" \ + --cache-key="$cache_key" --end="$v1_0_1_commit" --stats \ + --historical-authorizations="$abs_top_srcdir/etc/historical-authorizations" diff --git a/tests/guix-pack-relocatable.sh b/tests/guix-pack-relocatable.sh index 358cac5b26..52d7212594 100644 --- a/tests/guix-pack-relocatable.sh +++ b/tests/guix-pack-relocatable.sh @@ -111,3 +111,8 @@ esac tarball="`guix pack -R -S /share=share groff:doc`" (cd "$test_directory"; tar xvf "$tarball") test -d "$test_directory/share/doc/groff/html" + +# Ensure '-R' applies to propagated inputs. Failing to do that, it would fail +# with a profile collision error in this case because 'python-scipy' +# propagates 'python-numpy'. See <https://bugs.gnu.org/42510>. +guix pack -RR python-numpy python-scipy --no-grafts -n diff --git a/tests/lint.scm b/tests/lint.scm index ac174f9f23..2f5e5623c1 100644 --- a/tests/lint.scm +++ b/tests/lint.scm @@ -611,7 +611,7 @@ (origin (method git-fetch) (uri (git-reference - (url "https://github.com/archive/example.git") + (url "https://github.com/archive/example") (commit "0"))) (sha256 %null-sha256)))))) (check-source-unstable-tarball pkg))) @@ -698,6 +698,26 @@ (lint-warning-message second-warning))))))))) (test-skip (if (http-server-can-listen?) 0 1)) +(test-equal "source, git-reference: 301 -> 200" + "permanent redirect from http://localhost:10000/foo/bar to http://localhost:9999/foo/bar" + (with-http-server `((200 ,%long-string)) + (let* ((initial-url (%local-url)) + (redirect (build-response #:code 301 + #:headers + `((location + . ,(string->uri initial-url)))))) + (parameterize ((%http-server-port (+ 1 (%http-server-port)))) + (with-http-server `((,redirect "")) + (let ((pkg (dummy-package + "x" + (source (origin + (method git-fetch) + (uri (git-reference (url (%local-url)) + (commit "v1.0.0"))) + (sha256 %null-sha256)))))) + (single-lint-warning-message (check-source pkg)))))))) + +(test-skip (if (http-server-can-listen?) 0 1)) (test-equal "source: 301 -> 404" "URI http://localhost:10000/foo/bar not reachable: 404 (\"Such is life\")" (with-http-server '((404 "booh!")) diff --git a/tests/pack.scm b/tests/pack.scm index 0c1406e687..e8455b4f37 100644 --- a/tests/pack.scm +++ b/tests/pack.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> ;;; ;;; This file is part of GNU Guix. @@ -27,8 +27,13 @@ #:use-module (guix grafts) #:use-module (guix tests) #:use-module (guix gexp) + #:use-module (guix modules) + #:use-module (gnu packages) + #:use-module ((gnu packages base) #:select (glibc-utf8-locales)) #:use-module (gnu packages bootstrap) #:use-module ((gnu packages compression) #:select (squashfs-tools)) + #:use-module ((gnu packages guile) #:select (guile-sqlite3)) + #:use-module ((gnu packages gnupg) #:select (guile-gcrypt)) #:use-module (srfi srfi-64)) (define %store @@ -57,10 +62,10 @@ (unless (network-reachable?) (test-skip 1)) (test-assertm "self-contained-tarball" %store (mlet* %store-monad - ((profile (profile-derivation (packages->manifest - (list %bootstrap-guile)) - #:hooks '() - #:locales? #f)) + ((profile -> (profile + (content (packages->manifest (list %bootstrap-guile))) + (hooks '()) + (locales? #f))) (tarball (self-contained-tarball "pack" profile #:symlinks '(("/bin/Guile" -> "bin/guile")) @@ -137,6 +142,57 @@ (built-derivations (list check)))) (unless store (test-skip 1)) + (test-assertm "self-contained-tarball + localstatedir, UTF-8 file names" store + (mlet* %store-monad + ((guile (set-guile-for-build (default-guile))) + (tree (interned-file-tree + `("directory-with-utf8-file-names" directory + ("α" regular (data "alpha")) + ("λ" regular (data "lambda"))))) + (tarball (self-contained-tarball "tar-pack" tree + #:localstatedir? #t)) + (check (gexp->derivation + "check-tarball" + (with-extensions (list guile-sqlite3 guile-gcrypt) + (with-imported-modules (source-module-closure + '((guix store database))) + #~(begin + (use-modules (guix store database) + (rnrs io ports) + (srfi srfi-1)) + + (define (valid-file? basename data) + (define file + (string-append "./" #$tree "/" basename)) + + (string=? (call-with-input-file (pk 'file file) + get-string-all) + data)) + + (setenv "PATH" + (string-append #$%tar-bootstrap "/bin")) + (system* "tar" "xvf" #$tarball) + + (sql-schema + #$(local-file (search-path %load-path + "guix/store/schema.sql"))) + (with-database "var/guix/db/db.sqlite" db + ;; Make sure non-ASCII file names are properly + ;; handled. + (setenv "GUIX_LOCPATH" + #+(file-append glibc-utf8-locales + "/lib/locale")) + (setlocale LC_ALL "en_US.utf8") + + (mkdir #$output) + (exit + (and (every valid-file? + '("α" "λ") + '("alpha" "lambda")) + (integer? (path-id db #$tree))))))))))) + (built-derivations (list check)))) + + (unless store (test-skip 1)) (test-assertm "docker-image + localstatedir" store (mlet* %store-monad ((guile (set-guile-for-build (default-guile))) diff --git a/tests/packages.scm b/tests/packages.scm index c7b6f669b5..6aa36170d2 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -524,6 +524,32 @@ (build-derivations %store (list drv)) (call-with-input-file output get-string-all))) +(test-equal "package-source-derivation, origin, sha3-512" + "hello, sha3" + (let* ((bash (search-bootstrap-binary "bash" (%current-system))) + (builder (add-text-to-store %store "my-fixed-builder.sh" + "echo -n hello, sha3 > $out" '())) + (method (lambda* (url hash-algo hash #:optional name + #:rest rest) + (and (eq? hash-algo 'sha3-512) + (raw-derivation name bash (list builder) + #:sources (list builder) + #:hash hash + #:hash-algo hash-algo)))) + (source (origin + (method method) + (uri "unused://") + (file-name "origin-sha3") + (hash (content-hash + (gcrypt:bytevector-hash (string->utf8 "hello, sha3") + (gcrypt:lookup-hash-algorithm + 'sha3-512)) + sha3-512)))) + (drv (package-source-derivation %store source)) + (output (derivation->output-path drv))) + (build-derivations %store (list drv)) + (call-with-input-file output get-string-all))) + (unless (network-reachable?) (test-skip 1)) (test-equal "package-source-derivation, snippet" "OK" @@ -1084,6 +1110,20 @@ (("dep" package) (eq? package dep))))) +(test-assert "package->bag, sensitivity to %current-system" + (let* ((dep (dummy-package "dep" + (propagated-inputs (if (string=? (%current-system) + "i586-gnu") + `(("libxml2" ,libxml2)) + '())))) + (pkg (dummy-package "foo" + (native-inputs `(("dep" ,dep))))) + (bag (package->bag pkg (%current-system) "i586-gnu"))) + (equal? (parameterize ((%current-system "x86_64-linux")) + (bag-transitive-inputs bag)) + (parameterize ((%current-system "i586-gnu")) + (bag-transitive-inputs bag))))) + (test-assert "package->bag, sensitivity to %current-target-system" (let* ((dep (dummy-package "dep" (propagated-inputs (if (%current-target-system) diff --git a/tests/store.scm b/tests/store.scm index 06f7939657..ee3e01f33b 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -116,7 +116,7 @@ (list (stat:uid s) (stat:perms s)))) (test-equal "add-to-store" - '("sha1" "sha256" "sha512") + '("sha1" "sha256" "sha512" "sha3-256" "sha3-512" "blake2s-256") (let* ((file (search-path %load-path "guix.scm")) (content (call-with-input-file file get-bytevector-all))) (map (lambda (hash-algo) @@ -125,7 +125,7 @@ (bytevector=? (call-with-input-file file get-bytevector-all) content) hash-algo))) - '("sha1" "sha256" "sha512")))) + '("sha1" "sha256" "sha512" "sha3-256" "sha3-512" "blake2s-256")))) (test-equal "add-data-to-store" #vu8(1 2 3 4 5) diff --git a/tests/syscalls.scm b/tests/syscalls.scm index 6acaa0b131..09aa228e8e 100644 --- a/tests/syscalls.scm +++ b/tests/syscalls.scm @@ -382,7 +382,11 @@ (member "lo" names)))) (test-assert "network-interface-names" - (match (network-interface-names) + (match (remove (lambda (interface) + ;; Ignore interface aliases since they don't show up in + ;; (all-network-interface-names). + (string-contains interface ":")) + (network-interface-names)) (((? string? names) ..1) (lset<= string=? names (all-network-interface-names))))) |