aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/channels.scm84
-rw-r--r--tests/git-authenticate.scm2
-rw-r--r--tests/guix-git-authenticate.sh56
-rw-r--r--tests/guix-pack-relocatable.sh5
-rw-r--r--tests/lint.scm22
-rw-r--r--tests/pack.scm66
-rw-r--r--tests/packages.scm40
-rw-r--r--tests/store.scm4
-rw-r--r--tests/syscalls.scm6
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)))))
generated by cgit v1.2.3 (git 2.45.0) at 2024-12-29 09:44:07 +0000