Merge branch 'master' into core-updates

Conflicts:
	gnu/packages/ruby.scm

8 files changed, 280 insertions, 20 deletions

diff --git a/tests/channels.scm b/tests/channels.scm
index 5f13a48ec1..cde3b668fb 100644
--- a/tests/channels.scm
+++ b/tests/channels.scm
@@ -402,8 +402,30 @@
                          (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-assert "authenticate-channel, wrong first commit signer"
+(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
@@ -422,28 +444,32 @@
           (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"))
-               (intro   ((@@ (guix channels) make-channel-introduction)
+               (commit2 (find-commit repository "second"))
+               (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))))
-          (guard (c ((message? c)
+          (guard (c ((message-condition? c)
                      (->bool (string-contains (condition-message c)
                                               "initial commit"))))
             (authenticate-channel channel directory
-                                  (commit-id-string commit1)
+                                  (commit-id-string commit2)
                                   #:keyring-reference-prefix "")
             '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
@@ -481,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))))
@@ -511,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/lint.scm b/tests/lint.scm
index 9d3c349fc5..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!"))
@@ -737,6 +757,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))
@@ -748,6 +769,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 "'")
@@ -770,6 +792,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
@@ -893,6 +917,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)
@@ -904,6 +929,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
@@ -917,6 +943,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)
@@ -936,6 +963,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
@@ -951,6 +979,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.
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)))))