Subject: [bug#75981] [PATCH (WIP) v1.5 2/4] Add 'guix fork authenticate'.

From: Maxim Cournoyer <[email-masked]>
Date: Mon, 03 Feb 2025 00:23:41 +0900

Hi,

45mg <[email-masked]> writes:

> * guix/scripts/fork/authenticate.scm: New file.
> * Makefile.am (MODULES): Add the new file.
> * guix/scripts/fork.scm
> (show-help): Mention new command.
> (%sub-commands): Add new command.

OK.

[...]

> diff --git a/guix/scripts/fork/authenticate.scm b/guix/scripts/fork/authenticate.scm

[...]

> +(define-module (guix scripts fork authenticate)
> +  #:use-module (git)
> +  #:use-module (guix git)
> +  #:use-module (guix git-authenticate)
> +  #:use-module (guix base16)
> +  #:use-module (guix ui)
> +  #:use-module (guix progress)
> +  #:use-module (guix scripts)
> +  #:use-module (guix build utils)
> +  #:use-module (guix channels)
> +  #:use-module (ice-9 exceptions)
> +  #:use-module (ice-9 match)
> +  #:use-module (ice-9 receive)
> +  #:use-module (ice-9 popen)
> +  #:use-module (ice-9 format)
> +  #:use-module (ice-9 pretty-print)
> +  #:use-module (ice-9 string-fun)
> +  #:use-module (ice-9 textual-ports)

Please sort lexicographically.

[...]

> +(define %default-options
> +  (let ((introduction (channel-introduction %default-guix-channel)))
> +    `((upstream-commit
> +       . ,(string->oid (channel-introduction-first-signed-commit introduction)))

nitpick: a bit wide (83 chars)

> +      (upstream-signer
> +       . ,(openpgp-fingerprint
> +           (string-upcase
> +            (bytevector->base16-string
> +             (channel-introduction-first-commit-signer introduction)))))
> +      (upstream-keyring
> +       . "keyring"))))
> +
> +(define %usage
> +  (format #f (G_ "Usage: guix fork authenticate UPSTREAM COMMIT SIGNER [OPTIONS...]
> +Authenticate a fork of Guix, using COMMIT/SIGNER as the fork introduction.
> +
> +First, authenticate new commits from UPSTREAM, using Guix's default
> +introduction. Then authenticate the remaining commits using the fork
> +introduction.
> +
> +  -r, --repository=DIRECTORY
> +                         Authenticate the Git repository in DIRECTORY
> +
> +      --upstream-commit=COMMIT
> +      --upstream-signer=SIGNER
> +                         Use COMMIT/SIGNER as the introduction for upstream
> +                         Guix, overriding the default values
> +                         ~a
> +                        /~a
> +                         (Guix's default introduction).
> +
> +  -k, --keyring=REFERENCE
> +                         load keyring for fork commits from REFERENCE, a Git
> +                         branch (default \"keyring\")
> +      --upstream-keyring=REFERENCE
> +                         load keyring for upstream commits from REFERENCE, a
> +                         Git branch (default \"keyring\")
> +      --end=COMMIT       authenticate fork commits up to COMMIT
> +      --cache-key=KEY    cache authenticated commits under KEY
> +      --historical-authorizations=FILE
> +                         read historical authorizations from FILE
> +      --stats            Display commit signing statistics upon completion
> +
> +  -h, --help             display this help and exit
> +  -V, --version          display version information and exit
> +")
> +          (assoc-ref %default-options 'upstream-commit)
> +          (assoc-ref %default-options 'upstream-signer)))
> +
> +(define (show-help)
> +  (display %usage)
> +  (newline)
> +  (show-bug-report-information))
> +
> +(define (missing-arguments)
> +  (leave (G_ "wrong number of arguments; \
> +required UPSTREAM, COMMIT and SIGNER~%")))
> +
> +
> +;;;
> +;;; Helper prodecures.
> +;;;
> +
> +(define (fork-config-value repository key)
> +  "Return the config value associated with KEY in the
> +'guix.fork-authentication' namespace in REPOSITORY, or #f if no such config
> +was found."
> +  (let* ((config (repository-config repository))
> +         (branch (repository-current-branch repository)))
> +    (catch 'git-error
> +      (lambda ()
> +        (config-entry-value
> +         (config-get-entry config
> +                           (string-append "guix.fork-authentication."
> +                                          key))))
> +      (const #f))))
> +
> +(define (fork-configured-introduction repository)
> +  "Return three values: the upstream branch name, introductory commit, and
> +signer fingerprint (strings) for this fork, as configured in REPOSITORY.
> +Error out if any were missing."

s/were/are/

> +  (let* ((upstream-branch (fork-config-value repository "upstream-branch"))
> +         (commit (fork-config-value repository "introduction-commit"))
> +         (signer (fork-config-value repository "introduction-signer")))
> +    (unless (and upstream-branch commit signer)
> +      (leave (G_ "fork information in .git/config is incomplete;
> +missing at least one of
> +introduction-commit, introduction-signer, upstream-branch
> +under [guix \"fork-authentication\"]")))
> +    (values upstream-branch commit signer)))
> +
> +(define (fork-configured-keyring-reference repository)
> +  "Return the keyring reference configured in REPOSITORY or #f if missing."
> +  (fork-config-value repository "keyring"))
> +
> +(define (fork-configured? repository)
> +  "Return true if REPOSITORY already contains fork introduction info in its
> +'config' file."
> +  (and (fork-config-value repository "upstream-branch")
> +       (fork-config-value repository "introduction-commit")
> +       (fork-config-value repository "introduction-signer")))
> +
> +(define* (record-fork-configuration
> +          repository
> +          #:key commit signer upstream-branch keyring-reference)

nitpick: I'd leave the first arg on the same line, and put the keywords
on separate lines below.

> +  "Record COMMIT, SIGNER, UPSTREAM-BRANCH and KEYRING-REFERENCE in the
> +'config' file of REPOSITORY."

Should it say, .git/config file, for extra clarity?

> +  (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.fork-authentication.introduction-commit"
> +                           commit)
> +        (set-config-string config "guix.fork-authentication.introduction-signer"
> +                           signer)
> +        (set-config-string config "guix.fork-authentication.upstream-branch"
> +                           upstream-branch)
> +        (set-config-string config "guix.fork-authentication.keyring"
> +                           keyring-reference)
> +        (info (G_ "introduction, upstream branch and keyring recorded \
> +in repository configuration file~%")))
> +      (warning (G_ "could not record introduction and keyring configuration\
> + (Guile-Git too old?)~%"))))

That should be an error, not a warning, no?  Unless you think it's not
critical to what this tool is trying to achieve.

> +
> +(define (guix-fork-authenticate . args)
> +  (define options
> +    (parse-command-line args %options (list %default-options)
> +                        #:build-options? #f))
> +
> +  (define (command-line-arguments lst)
> +    (reverse (filter-map (match-lambda
> +                           (('argument . arg) arg)
> +                           (_ #f))
> +                         lst)))
> +
> +  (define (make-reporter start-commit end-commit commits)
> +    (format (current-error-port)
> +            (G_ "Authenticating commits ~a to ~a (~h new \
> +commits)...~%")
> +            (commit-short-id start-commit)
> +            (commit-short-id end-commit)
> +            (length commits))
> +    (if (isatty? (current-error-port))
> +        (progress-reporter/bar (length commits))
> +        progress-reporter/silent))
> +
> +  (with-error-handling
> +    (with-git-error-handling
> +     ;; TODO: BUG: it doesn't recognize '~' in paths
> +     ;; How to do 'realpath' in Guile?

It doesn't exist yet, as far as I know.  We have readlink* which
recursively expands links (guix utils).

> +     (let* ((repository (repository-open (or (assoc-ref options 'directory)
> +                                             (repository-discover "."))))
> +            (upstream commit signer (match (command-line-arguments options)

Perhaps break the line here to reduce horizontal indent.

> +                                      ((upstream commit signer)
> +                                       (values
> +                                        (branch-lookup repository upstream)
> +                                        (string->oid commit)
> +                                        (openpgp-fingerprint* signer)))
> +                                      (()
> +                                       (receive (upstream commit signer)
> +                                           (fork-configured-introduction repository)
> +                                         (values
> +                                          (branch-lookup repository upstream)
> +                                          (string->oid commit)
> +                                          (openpgp-fingerprint* signer))))
> +                                      (_
> +                                       (missing-arguments))))

Hm, I've looked at argument-handler again, and I guess it could be used,
though I'm not sure it'd simplify things by much.  Give it a try, if you want!

> +            (upstream-commit (assoc-ref options 'upstream-commit))
> +            (upstream-signer (assoc-ref options 'upstream-signer))
> +            (history (match (assoc-ref options 'historical-authorizations)
> +                       (#f '())
> +                       (file (call-with-input-file file
> +                               read-authorizations))))
> +            (keyring (or (assoc-ref options 'keyring-reference)
> +                         (fork-configured-keyring-reference repository)
> +                         "keyring"))
> +            (upstream-keyring (assoc-ref options 'upstream-keyring))
> +            (end (match (assoc-ref options 'end-commit)
> +                   (#f  (reference-target
> +                         (repository-head repository)))
> +                   (oid oid)))
> +            (upstream-end (match (assoc-ref options 'upstream-end-commit)
> +                            (#f
> +                             (reference-target upstream))
> +                            (oid oid)))
> +            (cache-key (or (assoc-ref options 'cache-key)
> +                           (repository-cache-key repository)))
> +            (show-stats? (assoc-ref options 'show-stats?)))
> +
> +       (define upstream-authentication-args
> +         (filter identity
> +                 (list
> +                  (oid->string upstream-commit)
> +                  (bytevector->base16-string upstream-signer)
> +                  (string-append "--repository="
> +                                 (repository-directory repository))
> +                  (string-append "--end="
> +                                 (oid->string upstream-end))
> +                  (and upstream-keyring
> +                       (string-append "--keyring="
> +                                      upstream-keyring))
> +                  (and show-stats? "--stats"))))
> +
> +       (info (G_ "calling `guix git authenticate` for branch ~a...~%")
> +             (branch-name upstream))
> +
> +       (apply run-guix-command 'git "authenticate"
> +              upstream-authentication-args)
> +
> +       (define fork-stats
> +         (authenticate-repository
> +          repository commit signer
> +          #:end end
> +          #:keyring-reference keyring
> +          #:historical-authorizations history
> +          #:cache-key cache-key
> +          #:make-reporter make-reporter))
> +
> +       (unless (fork-configured? repository)
> +         (record-fork-configuration repository
> +                               #:commit (oid->string commit)
> +                               #:signer (bytevector->base16-string signer)
> +                               #:upstream-branch (branch-name upstream)
> +                               #:keyring-reference keyring))
> +
> +       (when (and show-stats? (not (null? fork-stats)))
> +         (show-authentication-stats fork-stats))
> +
> +       (info (G_ "successfully authenticated commit ~a~%")
> +             (oid->string end))))))

The rest LGTM, from a cursory review.

-- 
Thanks,
Maxim