git authenticate: Record introduction and keyring in ‘.git/config’.

* guix/scripts/git/authenticate.scm (%default-options): Remove
‘keyring-reference’.
(config-value, configured-introduction, configured-keyring-reference)
(configured?, record-configuration, current-branch): New procedures.
(guix-git-authenticate)[missing-arguments]: New procedure.
Use ‘configured-introduction’ when zero arguments are given.
Use ‘configured-keyring-reference’ when ‘-k’ is not passed.  Add call to
‘record-configuration’.
* doc/guix.texi (Invoking guix git authenticate): Document it.

Change-Id: I66e111a83f50407b52da71662629947f83a78bbc

doc/guix.texi

@@ -7314,6 +7314,8 @@ for Fortran development.  For other languages, please use
 @section Invoking @command{guix git authenticate}
 
 @cindex @command{guix git authenticate}
+@cindex authentication, of Git checkouts
+@cindex Git checkout authentication
 
 The @command{guix git authenticate} command authenticates a Git checkout
 following the same rule as for channels (@pxref{channel-authentication,
@@ -7333,13 +7335,35 @@ The general syntax is:
 guix git authenticate @var{commit} @var{signer} [@var{options}@dots{}]
 @end example
 
+@cindex introduction, for Git authentication
 By default, this command authenticates the Git checkout in the current
 directory; it outputs nothing and exits with exit code zero on success
 and non-zero on failure.  @var{commit} above denotes the first commit
 where authentication takes place, and @var{signer} is the OpenPGP
 fingerprint of public key used to sign @var{commit}.  Together, they
-form a ``channel introduction'' (@pxref{channel-authentication, channel
+form a @dfn{channel introduction} (@pxref{channel-authentication, channel
-introduction}).  The options below allow you to fine-tune the process.
+introduction}).  On your first successful run, the introduction is
+recorded in the @file{.git/config} file of your checkout, allowing you
+to omit them from subsequent invocations:
+
+@example
+guix git authenticate [@var{options}@dots{}]
+@end example
+
+Should you have branches that require different introductions, you can
+specify them directly in @file{.git/config}.  For example, if the branch
+called @code{personal-fork} has a different introduction than other
+branches, you can extend @file{.git/config} along these lines:
+
+@smallexample
+[guix "authentication-personal-fork"]
+	introduction-commit = cabba936fd807b096b48283debdcddccfea3900d
+	introduction-signer = C0FF EECA BBA9 E6A8 0D1D  E643 A2A0 6DF2 A33A 54FA
+	keyring = keyring
+@end smallexample
+
+The command-line options described below allow you to fine-tune the
+process.
 
 @table @code
 @item --repository=@var{directory}

guix/scripts/git/authenticate.scm

@@ -31,6 +31,7 @@ (define-module (guix scripts git authenticate)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-37)
+  #:use-module (srfi srfi-71)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:export (guix-git-authenticate))
@@ -73,8 +74,79 @@ (define %options
                   (alist-cons 'show-stats? #t result)))))
 
 (define %default-options
-  '((directory . ".")
+  '((directory . ".")))
-    (keyring-reference . "keyring")))
+
+(define (current-branch repository)
+  "Return the name of the checked out branch of REPOSITORY or #f if it could
+not be determined."
+  (and (not (repository-head-detached? repository))
+       (let* ((head (repository-head repository))
+              (name (reference-name head)))
+         (and (string-prefix? "refs/heads/" name)
+              (string-drop name (string-length "refs/heads/"))))))
+
+(define (config-value repository key)
+  "Return the config value associated with KEY in the 'guix.authentication' or
+'guix.authentication-BRANCH' name space in REPOSITORY, or #f if no such config
+was found."
+  (let-syntax ((false-if-git-error
+                (syntax-rules ()
+                  ((_ exp)
+                   (catch 'git-error (lambda () exp) (const #f))))))
+    (let* ((config (repository-config repository))
+           (branch (current-branch repository)))
+      ;; First try the BRANCH-specific value, then the generic one.`
+      (or (and branch
+               (false-if-git-error
+                (config-entry-value
+                 (config-get-entry config
+                                   (string-append "guix.authentication-"
+                                                  branch "." key)))))
+          (false-if-git-error
+           (config-entry-value
+            (config-get-entry config
+                              (string-append "guix.authentication."
+                                             key))))))))
+
+(define (configured-introduction repository)
+  "Return two values: the commit and signer fingerprint (strings) as
+configured in REPOSITORY.  Error out if one or both were missing."
+  (let* ((commit (config-value repository "introduction-commit"))
+         (signer (config-value repository "introduction-signer")))
+    (unless (and commit signer)
+      (leave (G_ "unknown introductory commit and signer~%")))
+    (values commit signer)))
+
+(define (configured-keyring-reference repository)
+  "Return the keyring reference configured in REPOSITORY or #f if missing."
+  (config-value repository "keyring"))
+
+(define (configured? repository)
+  "Return true if REPOSITORY already container introduction info in its
+'config' file."
+  (and (config-value repository "introduction-commit")
+       (config-value repository "introduction-signer")))
+
+(define* (record-configuration repository
+                               #:key commit signer keyring-reference)
+  "Record COMMIT, SIGNER, and KEYRING-REFERENCE in the 'config' file of
+REPOSITORY."
+  (define config
+    (repository-config repository))
+
+  ;; Guile-Git < 0.7.0 lacks 'set-config-string'.
+  (if (module-defined? (resolve-interface '(git)) 'set-config-string)
+      (begin
+        (set-config-string config "guix.authentication.introduction-commit"
+                           commit)
+        (set-config-string config "guix.authentication.introduction-signer"
+                           signer)
+        (set-config-string config "guix.authentication.keyring"
+                           keyring-reference)
+        (info (G_ "introduction and keyring recorded \
+in repository configuration file~%")))
+      (warning (G_ "could not record introduction and keyring configuration\
+ (Guile-Git too old?)~%"))))
 
 (define (show-stats stats)
   "Display STATS, an alist containing commit signing stats as returned by
@@ -158,35 +230,48 @@ (define (make-reporter start-commit end-commit commits)
         (progress-reporter/bar (length commits))
         progress-reporter/silent))
 
+  (define (missing-arguments)
+    (leave (G_ "wrong number of arguments; \
+expected COMMIT and SIGNER~%")))
+
   (with-error-handling
     (with-git-error-handling
-     (match (command-line-arguments options)
+     (let* ((directory   (assoc-ref options 'directory))
-       ((commit signer)
+            (show-stats? (assoc-ref options 'show-stats?))
-        (let* ((directory   (assoc-ref options 'directory))
+            (repository  (repository-open directory))
-               (show-stats? (assoc-ref options 'show-stats?))
+            (commit signer (match (command-line-arguments options)
-               (keyring     (assoc-ref options 'keyring-reference))
+                             ((commit signer)
-               (repository  (repository-open directory))
+                              (values commit signer))
-               (end         (match (assoc-ref options 'end-commit)
+                             (()
-                              (#f  (reference-target
+                              (configured-introduction repository))
-                                    (repository-head repository)))
+                             (_
-                              (oid oid)))
+                              (missing-arguments))))
-               (history     (match (assoc-ref options 'historical-authorizations)
+            (keyring     (or (assoc-ref options 'keyring-reference)
-                              (#f '())
+                             (configured-keyring-reference repository)
-                              (file (call-with-input-file file
+                             "keyring"))
-                                      read-authorizations))))
+            (end         (match (assoc-ref options 'end-commit)
-               (cache-key   (or (assoc-ref options 'cache-key)
+                           (#f  (reference-target
-                                (repository-cache-key repository))))
+                                 (repository-head repository)))
-          (define stats
+                           (oid oid)))
-            (authenticate-repository repository (string->oid commit)
+            (history     (match (assoc-ref options 'historical-authorizations)
-                                     (openpgp-fingerprint* signer)
+                           (#f '())
-                                     #:end end
+                           (file (call-with-input-file file
-                                     #:keyring-reference keyring
+                                   read-authorizations))))
-                                     #:historical-authorizations history
+            (cache-key   (or (assoc-ref options 'cache-key)
-                                     #:cache-key cache-key
+                             (repository-cache-key repository))))
-                                     #:make-reporter make-reporter))
+       (define stats
+         (authenticate-repository repository (string->oid commit)
+                                  (openpgp-fingerprint* signer)
+                                  #:end end
+                                  #:keyring-reference keyring
+                                  #:historical-authorizations history
+                                  #:cache-key cache-key
+                                  #:make-reporter make-reporter))
 
-          (when (and show-stats? (not (null? stats)))
+       (unless (configured? repository)
-            (show-stats stats))))
+         (record-configuration repository
-       (_
+                               #:commit commit #:signer signer
-        (leave (G_ "wrong number of arguments; \
+                               #:keyring-reference keyring))
-expected COMMIT and SIGNER~%")))))))
+
+       (when (and show-stats? (not (null? stats)))
+         (show-stats stats))))))

tests/guix-git-authenticate.sh

@@ -1,5 +1,5 @@
 # GNU Guix --- Functional package management for GNU
-# Copyright © 2020, 2022 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2020, 2022, 2024 Ludovic Courtès <ludo@gnu.org>
 #
 # This file is part of GNU Guix.
 #
@@ -46,6 +46,13 @@ guix git authenticate "$intro_commit" "$intro_signer"	\
      --cache-key="$cache_key" --stats			\
      --end="$v1_2_0_commit"
 
+# Check a commit that came soon after v1.2.0.  No need to repeat $intro_commit
+# and $intro_signer because it should have been recorded in '.git/config'.
+after_v1_2_0="be4d9527b55b6829e33a6e0727496af25927a786"
+guix git authenticate				\
+     --cache-key="$cache_key" --stats		\
+     --end="$v1_2_0_commit"
+
 rm "$XDG_CACHE_HOME/guix/authentication/$cache_key"
 
 # Commit and signer of the 'v1.0.0' tag.