bug#22883: [PATCH 4/9] channels: 'latest-channel-instance' authenticates Git checkouts.

["Ludovic Courtès" <ludo@gnu.org>]

Fixes <https://bugs.gnu.org/22883>.

* guix/channels.scm (<channel>)[introduction]: New field.
(<channel-introduction>): New record type.
(%guix-channel-introduction): New variable.
(%default-channels): Use it.
(<channel-metadata>)[keyring-reference]: New field.
(%default-keyring-reference): New variable.
(read-channel-metadata, read-channel-metadata-from-source): Initialize
the 'keyring-reference' field.
(commit-short-id, verify-introductory-commit)
(authenticate-channel): New procedures.
(latest-channel-instance): Call 'authenticate-channel' when CHANNEL has
an introduction.
* tests/channels.scm (gpg+git-available?, commit-id-string): New
procedures.
("authenticate-channel, wrong first commit signer"):
("authenticate-channel, .guix-authorizations"): New tests.
* doc/guix.texi (Invoking guix pull): Mention authentication.
---
 .dir-locals.el     |   1 +
 doc/guix.texi      |   6 +-
 guix/channels.scm  | 182 +++++++++++++++++++++++++++++++++++++++++++--
 tests/channels.scm | 122 ++++++++++++++++++++++++++++++
 4 files changed, 304 insertions(+), 7 deletions(-)

diff --git a/.dir-locals.el b/.dir-locals.el
index dc8bc0e437..7ac1eb7509 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -95,6 +95,7 @@
    (eval . (put 'eventually 'scheme-indent-function 1))
 
    (eval . (put 'call-with-progress-reporter 'scheme-indent-function 1))
+   (eval . (put 'with-repository 'scheme-indent-function 2))
    (eval . (put 'with-temporary-git-repository 'scheme-indent-function 2))
    (eval . (put 'with-environment-variables 'scheme-indent-function 1))
    (eval . (put 'with-fresh-gnupg-setup 'scheme-indent-function 1))
diff --git a/doc/guix.texi b/doc/guix.texi
index 056bf011f6..6fcb47970b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -3719,13 +3719,17 @@ this option is primarily useful when the daemon was running with
 @cindex updating Guix
 @cindex @command{guix pull}
 @cindex pull
+@cindex security, @command{guix pull}
+@cindex authenticity, of code obtained with @command{guix pull}
 Packages are installed or upgraded to the latest version available in
 the distribution currently available on your local machine.  To update
 that distribution, along with the Guix tools, you must run @command{guix
 pull}: the command downloads the latest Guix source code and package
 descriptions, and deploys it.  Source code is downloaded from a
 @uref{https://git-scm.com, Git} repository, by default the official
-GNU@tie{}Guix repository, though this can be customized.
+GNU@tie{}Guix repository, though this can be customized.  @command{guix
+pull} ensures that the code it downloads is @emph{authentic} by
+verifying that commits are signed by Guix developers.
 
 Specifically, @command{guix pull} downloads code from the @dfn{channels}
 (@pxref{Channels}) specified by one of the followings, in this order:
diff --git a/guix/channels.scm b/guix/channels.scm
index 84c47fc0d0..c2ea0e26ff 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -21,6 +21,11 @@
 (define-module (guix channels)
   #:use-module (git)
   #:use-module (guix git)
+  #:use-module (guix git-authenticate)
+  #:use-module ((guix openpgp)
+                #:select (openpgp-public-key-fingerprint
+                          openpgp-format-fingerprint))
+  #:use-module (guix base16)
   #:use-module (guix records)
   #:use-module (guix gexp)
   #:use-module (guix modules)
@@ -28,6 +33,7 @@
   #:use-module (guix monads)
   #:use-module (guix profiles)
   #:use-module (guix packages)
+  #:use-module (guix progress)
   #:use-module (guix derivations)
   #:use-module (guix combinators)
   #:use-module (guix diagnostics)
@@ -48,17 +54,23 @@
   #:autoload   (guix self) (whole-package make-config.scm)
   #:autoload   (guix inferior) (gexp->derivation-in-inferior) ;FIXME: circular dep
   #:autoload   (guix quirks) (%quirks %patches applicable-patch? apply-patch)
+  #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (ice-9 vlist)
   #:use-module ((ice-9 rdelim) #:select (read-string))
+  #:use-module ((rnrs bytevectors) #:select (bytevector=?))
   #:export (channel
             channel?
             channel-name
             channel-url
             channel-branch
             channel-commit
+            channel-introduction
             channel-location
 
+            channel-introduction?
+            ;; <channel-introduction> accessors purposefully omitted for now.
+
             %default-channels
             guix-channel?
 
@@ -67,6 +79,7 @@
             channel-instance-commit
             channel-instance-checkout
 
+            authenticate-channel
             latest-channel-instances
             checkout->channel-instance
             latest-channel-derivation
@@ -104,15 +117,44 @@
   (url       channel-url)
   (branch    channel-branch (default "master"))
   (commit    channel-commit (default #f))
+  (introduction channel-introduction (default #f))
   (location  channel-location
              (default (current-source-location)) (innate)))
 
+;; Channel introductions.  A "channel introduction" provides a commit/signer
+;; pair that specifies the first commit of the authentication process as well
+;; as its signer's fingerprint.  The pair must be signed by the signer of that
+;; commit so that only them may emit this introduction.  Introductions are
+;; used to bootstrap trust in a channel.
+(define-record-type <channel-introduction>
+  (make-channel-introduction first-signed-commit first-commit-signer
+                             signature)
+  channel-introduction?
+  (first-signed-commit  channel-introduction-first-signed-commit) ;hex string
+  (first-commit-signer  channel-introduction-first-commit-signer) ;bytevector
+  (signature            channel-introduction-signature))          ;string
+
+(define %guix-channel-introduction
+  ;; Introduction of the official 'guix channel.  The chosen commit is the
+  ;; first one that introduces '.guix-authorizations' on the 'core-updates'
+  ;; branch that was eventually merged in 'master'.  Any branch starting
+  ;; before that commit cannot be merged or it will be rejected by 'guix pull'
+  ;; & co.
+  (make-channel-introduction
+   "87a40d7203a813921b3ef0805c2b46c0026d6c31"
+   (base16-string->bytevector
+    (string-downcase
+     (string-filter char-set:hex-digit            ;mbakke
+                    "BBB0 2DDF 2CEA F6A8 0D1D  E643 A2A0 6DF2 A33A 54FA")))
+   #f))                   ;TODO: Add an intro signature so it can be exported.
+
 (define %default-channels
   ;; Default list of channels.
   (list (channel
          (name 'guix)
          (branch "master")
-         (url "https://git.savannah.gnu.org/git/guix.git"))))
+         (url "https://git.savannah.gnu.org/git/guix.git")
+         (introduction %guix-channel-introduction))))
 
 (define (guix-channel? channel)
   "Return true if CHANNEL is the 'guix' channel."
@@ -126,11 +168,16 @@
   (checkout  channel-instance-checkout))
 
 (define-record-type <channel-metadata>
-  (channel-metadata directory dependencies news-file)
+  (channel-metadata directory dependencies news-file keyring-reference)
   channel-metadata?
   (directory     channel-metadata-directory)      ;string with leading slash
   (dependencies  channel-metadata-dependencies)   ;list of <channel>
-  (news-file     channel-metadata-news-file))     ;string | #f
+  (news-file     channel-metadata-news-file)      ;string | #f
+  (keyring-reference channel-metadata-keyring-reference)) ;string
+
+(define %default-keyring-reference
+  ;; Default value of the 'keyring-reference' field.
+  "keyring")
 
 (define (channel-reference channel)
   "Return the \"reference\" for CHANNEL, an sexp suitable for
@@ -147,7 +194,10 @@ if valid metadata could not be read from PORT."
     (('channel ('version 0) properties ...)
      (let ((directory    (and=> (assoc-ref properties 'directory) first))
            (dependencies (or (assoc-ref properties 'dependencies) '()))
-           (news-file    (and=> (assoc-ref properties 'news-file) first)))
+           (news-file    (and=> (assoc-ref properties 'news-file) first))
+           (keyring-reference
+            (or (and=> (assoc-ref properties 'keyring-reference) first)
+                %default-keyring-reference)))
        (channel-metadata
         (cond ((not directory) "/")               ;directory
               ((string-prefix? "/" directory) directory)
@@ -164,7 +214,8 @@ if valid metadata could not be read from PORT."
                     (url url)
                     (commit (get 'commit))))))
              dependencies)
-        news-file)))                              ;news-file
+        news-file
+        keyring-reference)))
     ((and ('channel ('version version) _ ...) sexp)
      (raise (condition
              (&message (message "unsupported '.guix-channel' version"))
@@ -188,7 +239,7 @@ doesn't exist."
         read-channel-metadata))
     (lambda args
       (if (= ENOENT (system-error-errno args))
-          (channel-metadata "/" '() #f)
+          (channel-metadata "/" '() #f %default-keyring-reference)
           (apply throw args)))))
 
 (define (channel-instance-metadata instance)
@@ -212,6 +263,117 @@ result is unspecified."
          (apply-patch patch checkout))
        (loop rest)))))
 
+(define commit-short-id
+  (compose (cut string-take <> 7) oid->string commit-id))
+
+(define (verify-introductory-commit repository introduction keyring)
+  "Raise an exception if the first commit described in INTRODUCTION doesn't
+have the expected signer."
+  (define commit-id
+    (channel-introduction-first-signed-commit introduction))
+
+  (define actual-signer
+    (openpgp-public-key-fingerprint
+     (commit-signing-key repository (string->oid commit-id)
+                         keyring)))
+
+  (define expected-signer
+    (channel-introduction-first-commit-signer introduction))
+
+  (unless (bytevector=? expected-signer actual-signer)
+    (raise (condition
+            (&message
+             (message (format #f (G_ "initial commit ~a is signed by '~a' \
+instead of '~a'")
+                              commit-id
+                              (openpgp-format-fingerprint actual-signer)
+                              (openpgp-format-fingerprint expected-signer))))))))
+
+(define* (authenticate-channel channel checkout commit
+                               #:key (keyring-reference-prefix "origin/"))
+  "Authenticate the given COMMIT of CHANNEL, available at CHECKOUT, a
+directory containing a CHANNEL checkout.  Raise an error if authentication
+fails."
+  ;; XXX: Too bad we need to re-open CHECKOUT.
+  (with-repository checkout repository
+    (define start-commit
+      (commit-lookup repository
+                     (string->oid
+                      (channel-introduction-first-signed-commit
+                       (channel-introduction channel)))))
+
+    (define end-commit
+      (commit-lookup repository (string->oid commit)))
+
+    (define cache-key
+      (string-append "channels/" (symbol->string (channel-name channel))))
+
+    (define keyring-reference
+      (channel-metadata-keyring-reference
+       (read-channel-metadata-from-source checkout)))
+
+    (define keyring
+      (load-keyring-from-reference repository
+                                   (string-append keyring-reference-prefix
+                                                  keyring-reference)))
+
+    (define authenticated-commits
+      ;; Previously-authenticated commits that don't need to be checked again.
+      (filter-map (lambda (id)
+                    (false-if-exception
+                     (commit-lookup repository (string->oid id))))
+                  (previously-authenticated-commits cache-key)))
+
+    (define commits
+      ;; Commits to authenticate, excluding the closure of
+      ;; AUTHENTICATED-COMMITS.
+      (commit-difference end-commit start-commit
+                         authenticated-commits))
+
+    (define reporter
+      (progress-reporter/bar (length commits)))
+
+    ;; When COMMITS is empty, it's either because AUTHENTICATED-COMMITS
+    ;; contains END-COMMIT or because END-COMMIT is not a descendant of
+    ;; START-COMMIT.  Check that.
+    (if (null? commits)
+        (match (commit-relation start-commit end-commit)
+          ((or 'self 'ancestor 'descendant) #t)   ;nothing to do!
+          ('unrelated
+           (raise
+            (condition
+             (&message
+              (message
+               (format #f (G_ "'~a' is not related to introductory \
+commit of channel '~a'~%")
+                       (oid->string (commit-id end-commit))
+                       (channel-name channel))))))))
+        (begin
+          (format (current-error-port)
+                  (G_ "Authenticating channel '~a', \
+commits ~a to ~a (~h new commits)...~%")
+                  (channel-name channel)
+                  (commit-short-id start-commit)
+                  (commit-short-id end-commit)
+                  (length commits))
+
+          ;; If it's our first time, verify CHANNEL's introductory commit.
+          (when (null? authenticated-commits)
+            (verify-introductory-commit repository
+                                        (channel-introduction channel)
+                                        keyring))
+
+          (call-with-progress-reporter reporter
+            (lambda (report)
+              (authenticate-commits repository commits
+                                    #:keyring keyring
+                                    #:report-progress report)))
+
+          (unless (null? commits)
+            (cache-authenticated-commit cache-key
+                                        (oid->string
+                                         (commit-id end-commit))))))))
+
 (define* (latest-channel-instance store channel
                                   #:key (patches %patches)
                                   starting-commit)
@@ -225,6 +387,14 @@ relation to STARTING-COMMIT when provided."
                 (update-cached-checkout (channel-url channel)
                                         #:ref (channel-reference channel)
                                         #:starting-commit starting-commit)))
+    (if (channel-introduction channel)
+        (authenticate-channel channel checkout commit)
+        ;; TODO: Warn for all the channels once the authentication interface
+        ;; is public.
+        (when (guix-channel? channel)
+          (warning (G_ "the code of channel '~a' cannot be authenticated~%")
+                   (channel-name channel))))
+
     (when (guix-channel? channel)
       ;; Apply the relevant subset of PATCHES directly in CHECKOUT.  This is
       ;; safe to do because 'switch-to-ref' eventually does a hard reset.
diff --git a/tests/channels.scm b/tests/channels.scm
index 3b141428c8..2c857083e9 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))
+
+\f
 (test-begin "channels")
 
 (define* (make-instance #:key
@@ -389,4 +402,113 @@
                          (channel-news-for-commit channel commit5 commit1))
                     '(#f "tag-for-first-news-entry")))))))
 
+(unless (gpg+git-available?) (test-skip 1))
+(test-assert "authenticate-channel, wrong first commit signer"
+  (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))))
+      (with-repository directory repository
+        (let* ((commit1 (find-commit repository "first"))
+               (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? c)
+                     (->bool (string-contains (condition-message c)
+                                              "initial commit"))))
+            (authenticate-channel channel directory
+                                  (commit-id-string commit1)
+                                  #: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")
-- 
2.26.2