08/08: channels: Dependencies listed in '.guix-channel' can have an introduction.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit d774c7b1218a3cc20079b19812da119f9ed26b54
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Wed Jul 1 23:32:25 2020 +0200

    channels: Dependencies listed in '.guix-channel' can have an introduction.
    
    Suggested by Ricardo Wurmus and Simon Tournier.
    
    * guix/channels.scm (sexp->channel-introduction): New procedure.
    (read-channel-metadata): Use it.
    (profile-channels)[sexp->channel-introduction]: Remove.
    * tests/channels.scm ("latest-channel-instances, authenticate dependency"):
    New test.
    * doc/guix.texi (Channels)[Declaring Channel Dependencies]: Augment example.
---
 doc/guix.texi      | 10 +++++++++-
 guix/channels.scm  | 20 +++++++++++---------
 tests/channels.scm | 50 ++++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 70 insertions(+), 10 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index c3dd977..7823367 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -4160,7 +4160,15 @@ The meta-data file should contain a simple S-expression 
like this:
  (dependencies
   (channel
    (name some-collection)
-   (url "https://example.org/first-collection.git";))
+   (url "https://example.org/first-collection.git";)
+
+   ;; The 'introduction' bit below is optional: you would
+   ;; provide it for dependencies that can be authenticated.
+   (introduction
+    (channel-introduction
+      (version 0)
+      (commit "a8883b58dc82e167c96506cf05095f37c2c2c6cd")
+      (signer "CABB A931 C0FF EEC6 900D  0CFB 090B 1199 3D9A EBB5"))))
   (channel
    (name some-other-collection)
    (url "https://example.org/second-collection.git";)
diff --git a/guix/channels.scm b/guix/channels.scm
index 32ada7b..500c956 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -223,6 +223,14 @@ introduction, add it."
     (#f      `(branch . ,(channel-branch channel)))
     (commit  `(commit . ,(channel-commit channel)))))
 
+(define sexp->channel-introduction
+  (match-lambda
+    (('channel-introduction ('version 0)
+                            ('commit commit) ('signer signer)
+                            _ ...)
+     (make-channel-introduction commit (openpgp-fingerprint signer)))
+    (x #f)))
+
 (define (read-channel-metadata port)
   "Read from PORT channel metadata in the format expected for the
 '.guix-channel' file.  Return a <channel-metadata> record, or raise an error
@@ -250,7 +258,9 @@ if valid metadata could not be read from PORT."
                     (name name)
                     (branch branch)
                     (url url)
-                    (commit (get 'commit))))))
+                    (commit (get 'commit))
+                    (introduction (and=> (get 'introduction)
+                                         sexp->channel-introduction))))))
              dependencies)
         news-file
         keyring-reference
@@ -948,14 +958,6 @@ to 'latest-channel-instances'."
 (define (profile-channels profile)
   "Return the list of channels corresponding to entries in PROFILE.  If
 PROFILE is not a profile created by 'guix pull', return the empty list."
-  (define sexp->channel-introduction
-    (match-lambda
-      (('channel-introduction ('version 0)
-                              ('commit commit) ('signer signer)
-                              _ ...)
-       (make-channel-introduction commit (openpgp-fingerprint signer)))
-      (x #f)))
-
   (filter-map (lambda (entry)
                 (match (assq 'source (manifest-entry-properties entry))
                   (('source ('repository ('version 0)
diff --git a/tests/channels.scm b/tests/channels.scm
index 7e593b8..cde3b66 100644
--- a/tests/channels.scm
+++ b/tests/channels.scm
@@ -536,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")