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

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

Hi,

My first thought was similar to Liliana's reply in the other
issue thread: putting lots of energy into making it convenient to fork
Guix instead of contributing to the review process (described as slow
and erratic, which appears to be the motivation here), appears
counter-productive.

So I'm not even sure this should be incorporated in Guix, especially if
it does touch the sensitive guix authentication mechanism.

I'll still offer a review, given the code looks rather good, and perhaps
being a committer I'm missing part of the picture on why such a
mechanism improves on the status quo of using extensions or channels, or
local unauthenticated forks (for personal use, that was enough for me
when one of my changes didn't make it for a year).  It was rather
inconvenient, but that was a good motivator to keep nudging it into Guix
proper.

And I disagree with your assessment that it takes years to become a Guix
committer.  I think 6 months to a year would be a reasonable time frame
for a dedicated individual.  It's also not the only way to be useful to
the project.  Reviewing the work of others help a lot too (those appear
at https://qa.guix.gnu.org/patches).

Below are some comments on the code.

45mg <[email-masked]> writes:

> * guix/scripts/fork.scm, guix/scripts/fork/create.scm: New files.
> * Makefile.am (MODULES): Add the new files.
> * guix/build/utils.scm (invoke/stdout): New procedure.

Touching (guix build utils) is a world rebuild (the module is included
in every build system, including the gnu-build-system).  Perhaps start
its life in (guix utils) with a TODO to move it to (guix build utils)
later along another world-rebuilding change.

Later: I see you changed that in this v1.5 revision: in this case just
update the change log message.

> * guix/utils.scm (chain-cut): New procedure.

Could use 's/New procedure./Likewise./' to avoid repetition.

> * guix/scripts/git/authenticate.scm
> (commit-short-id): Remove procedure, and use its existing duplicate in
> guix/channels.scm.
> (openpgp-fingerprint*, current-branch, show-stats): Move procedures to
> the files below.

You can use the ellipsis trick: (openpgp-fingerprint*): "Move to..."
* guix/channels.scm (openpgp-fingerprint*): ... here.

and likewise for the other procedures.

There's a missing entry for adjusting the renamed current-branch
procedure inside the config-value proc.

[...]

> diff --git a/guix/channels.scm b/guix/channels.scm
> index 4700f7a45d..6ca8e64881 100644
> --- a/guix/channels.scm
> +++ b/guix/channels.scm
> @@ -47,6 +47,7 @@ (define-module (guix channels)
>    #:use-module (guix packages)
>    #:use-module (guix progress)
>    #:use-module (guix derivations)
> +  #:autoload   (rnrs bytevectors) (bytevector-length)
>    #:use-module (guix diagnostics)
>    #:use-module (guix sets)
>    #:use-module (guix store)
> @@ -81,6 +82,7 @@ (define-module (guix channels)
>  
>              openpgp-fingerprint->bytevector
>              openpgp-fingerprint
> +            openpgp-fingerprint*
>  
>              %default-guix-channel
>              %default-channels
> @@ -171,6 +173,17 @@ (define-syntax openpgp-fingerprint
>        ((_ str)
>         #'(openpgp-fingerprint->bytevector str)))))
>  
> +(define (openpgp-fingerprint* str)
> +  "Like openpgp-fingerprint, but with error handling from (guix diagnostics)."
> +    (unless (string-every (char-set-union char-set:hex-digit
> +                                          char-set:whitespace)
> +                          str)
> +      (leave (G_ "~a: invalid OpenPGP fingerprint~%") str))
> +    (let ((fingerprint (openpgp-fingerprint str)))
> +      (unless (= 20 (bytevector-length fingerprint))
> +        (leave (G_ "~a: wrong length for OpenPGP fingerprint~%") str))
> +      fingerprint))
> +

I'm not convinced having a program-exiting procedure in the public API
makes sense (and these are annoying at the REPL!)  Returning a proper
exception would be better.

[...]

> --- /dev/null
> +++ b/guix/scripts/fork.scm

[...]

> +(define-module (guix scripts fork)
> +  #:use-module (ice-9 match)
> +  #:use-module (guix ui)
> +  #:use-module (guix scripts)

Please list modules in lexicographic order.

[...]

> diff --git a/guix/scripts/fork/create.scm b/guix/scripts/fork/create.scm
> new file mode 100644
> index 0000000000..a9de204f23
> --- /dev/null
> +++ b/guix/scripts/fork/create.scm

[...]

> +
> +;;;
> +;;; Helper prodecures.
> +;;;
> +
> +(define (fingerprint->key-file-name fingerprint)
> +  (let* ((listing (invoke/stdout "gpg" "--list-key" "--with-colons" fingerprint))
> +         (uid (chain-cut listing
> +                           (string-split <> #\newline)
> +                           (filter (cut string-prefix? "uid:" <>) <>)
> +                           first

If there are no key for FINGERPRINT, `first' will fail with a cryptic
error here.  It should ideally throw a useful exception.

[...]

> +
> +;;;
> +;;; Entry point.
> +;;;
> +
> +(define (guix-fork-create . args)
> +  (define options
> +    (parse-command-line args %options (list %default-options)
> +                        #:build-options? #f))

I think you could provide a proc to set the default value of the
DIRECTORY positional argument via #:argument-handler...

> +
> +  (define (command-line-arguments lst)
> +    (reverse (filter-map (match-lambda
> +                           (('argument . arg) arg)
> +                           (_ #f))
> +                         lst)))
> +
> +  (with-error-handling
> +    (let* ((signing-key directory (match (command-line-arguments options)
> +                                    ((signing-key directory)
> +                                     (values signing-key directory))
> +                                    ((signing-key)
> +                                     (values signing-key "guix"))
> +                                    (_ (missing-arguments))))

Avoiding the command-line-arguments proc as well as the match above.

> +           (upstream (assoc-ref options 'upstream))
> +           (channel-url (assoc-ref options 'channel-url))
> +           (use-existing? (assoc-ref options 'use-existing?))
> +           (git-parameters (assoc-ref options 'git-parameters))
> +           (git-c-options  ;'("-c" "param1" "-c" "param2" ...)
> +            (let loop ((opts '()) (params git-parameters))
> +              (if (or (not params) (null-list? params))
> +                  opts
> +                  (loop (append
> +                         opts (list "-c" (first params)))

You have enough horizontal space to (append opts ...) on a single line I
think.

> +                        (drop params 1)))))
> +
> +           (key-file-name (fingerprint->key-file-name signing-key))
> +           (introduction-name (car (string-split key-file-name #\-)))
> +
> +           (upstream-branch-name "master"))
> +
> +      (define (invoke-git . args)
> +        (apply invoke `("git" ,@git-c-options "-C" ,directory ,@args)))

We prefer to use guile-git throughout Guix, as it has a proper Scheme
interface.  Have you tried using it instead of shelling out to git?
Perhaps it was missing some features you needed?

> +      (unless use-existing?
> +        (info (G_ "Cloning from upstream ~a...~%") upstream)
> +        (invoke "git" "clone" upstream directory))

Why not using the above defined invoke-git here?

> +
> +      (info (G_ "Authenticating upstream commits...~%"))
> +
> +      (when channel-url
> +        (info (G_ "Renaming existing 'origin' remote to 'upstream'...~%"))
> +        (invoke-git "remote" "rename" "origin" "upstream")
> +        (info (G_ "Using provided channel URL for new 'origin' remote...~%"))
> +        (invoke-git "remote" "add" "origin" channel-url))
> +
> +      (set! upstream-branch-name
> +            (chain-cut
> +             (invoke/stdout "git"

Break the line to place "git" below invoke/stdout, to avoid busting our
80 columns max convention a bit below.

> +                            "-C" directory
> +                            "symbolic-ref"
> +                            (string-append "refs/remotes/"
> +                                           (if channel-url "upstream" "origin")
> +                                           "/HEAD"))
> +             string-trim-right
> +             (string-split <> #\/)
> +             last))
> +
> +      (info (G_ "Adding key to keyring branch...~%"))
> +      (invoke-git "switch" "keyring")
> +      (invoke "gpg"
> +              "--armor" "--export"
> +              "-o" (string-append directory "/" key-file-name)
> +              signing-key)
> +      (invoke-git "add" "--" key-file-name)
> +      (invoke-git "commit" "-m" "Add key for fork introduction.")
> +
> +      (info (G_ "Setting up fork branch...~%"))
> +      (invoke-git "switch" "--create" "fork" "master")
> +      (when channel-url
> +        (update-channel-url (string-append directory "/.guix-channel")
> +                            channel-url))
> +      (rewrite-authorizations (string-append directory "/.guix-authorizations")
> +                              introduction-name signing-key)
> +      (invoke-git "add" "--"
> +                  (string-append directory "/.guix-authorizations")
> +                  (string-append directory "/.guix-channel"))
> +      (invoke-git "commit"
> +                  (string-append "--gpg-sign=" signing-key)
> +                  "-m"
> +                  (string-append
> +                   "Initial fork commit.\n\n"
> +                   ".guix-authorizations: Allow only " introduction-name "'s key."
> +                   (if channel-url
> +                       "\n.guix-channels: Update channel URL."
> +                       "")))
> +      (info (G_ "Successfully created Guix fork in ~a.

Phew!

> +You should run the following command next:
> +guix fork authenticate ~a ~a ~a~%")
> +            directory
> +            upstream-branch-name
> +            (string-trim-right (invoke/stdout "git" "-C" directory "rev-parse" "HEAD"))
> +            signing-key))))
> diff --git a/guix/scripts/git/authenticate.scm b/guix/scripts/git/authenticate.scm
> index e3ecb67c89..154aae9b14 100644
> --- a/guix/scripts/git/authenticate.scm
> +++ b/guix/scripts/git/authenticate.scm
> @@ -23,8 +23,8 @@ (define-module (guix scripts git authenticate)
>    #:use-module (guix git-authenticate)
>    #:autoload   (guix openpgp) (openpgp-format-fingerprint
>                                 openpgp-public-key-fingerprint)
> -  #:use-module ((guix channels) #:select (openpgp-fingerprint))
> -  #:use-module ((guix git) #:select (with-git-error-handling))
> +  #:use-module ((guix channels) #:select (openpgp-fingerprint*))
> +  #:use-module ((guix git) #:select (with-git-error-handling commit-short-id repository-current-branch))

Please watch the 80 columns limit :-).

>    #:use-module (guix progress)
>    #:use-module (guix base64)
>    #:autoload   (rnrs bytevectors) (bytevector-length)
> @@ -76,15 +76,6 @@ (define %options
>  (define %default-options
>    '())
>  
> -(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
> @@ -94,7 +85,7 @@ (define (config-value repository key)
>                    ((_ exp)
>                     (catch 'git-error (lambda () exp) (const #f))))))
>      (let* ((config (repository-config repository))
> -           (branch (current-branch repository)))
> +           (branch (repository-current-branch repository)))
>        ;; First try the BRANCH-specific value, then the generic one.`
>        (or (and branch
>                 (false-if-git-error
> @@ -194,21 +185,6 @@ (define (install-hooks repository)
>        (warning (G_ "cannot determine where to install hooks\
>   (Guile-Git too old?)~%"))))
>  
> -(define (show-stats stats)
> -  "Display STATS, an alist containing commit signing stats as returned by
> -'authenticate-repository'."
> -  (format #t (G_ "Signing statistics:~%"))
> -  (for-each (match-lambda
> -              ((signer . count)
> -               (format #t "  ~a ~10d~%"
> -                       (openpgp-format-fingerprint
> -                        (openpgp-public-key-fingerprint signer))
> -                       count)))
> -            (sort stats
> -                  (match-lambda*
> -                    (((_ . count1) (_ . count2))
> -                     (> count1 count2))))))
> -
>  (define (show-help)
>    (display (G_ "Usage: guix git authenticate COMMIT SIGNER [OPTIONS...]
>  Authenticate the given Git checkout using COMMIT/SIGNER as its introduction.\n"))
> @@ -251,19 +227,6 @@ (define (guix-git-authenticate . args)
>                             (_ #f))
>                           lst)))
>  
> -  (define commit-short-id
> -    (compose (cut string-take <> 7) oid->string commit-id))
> -
> -  (define (openpgp-fingerprint* str)
> -    (unless (string-every (char-set-union char-set:hex-digit
> -                                          char-set:whitespace)
> -                          str)
> -      (leave (G_ "~a: invalid OpenPGP fingerprint~%") str))
> -    (let ((fingerprint (openpgp-fingerprint str)))
> -      (unless (= 20 (bytevector-length fingerprint))
> -        (leave (G_ "~a: wrong length for OpenPGP fingerprint~%") str))
> -      fingerprint))
> -

If that's only ever used here, I'd leave it here, as as I said earlier,
it's not a great API (and having confusing asterisk suffixes variants in
the public API should be limited to cases that truly matter, in my
opinion).

[...]

>  
> @@ -1193,6 +1200,60 @@ (define-syntax current-source-directory
>            ;; raising an error would upset Geiser users
>            #f))))))
>  
> +
> +;;;
> +;;; Higher-order functions.
> +;;;
> +
> +(define-syntax chain-cut
> +  (lambda (x)
> +    "Apply each successive form to the result of evaluating the previous one.
> +Before applying, expand each form (op ...) to (cut op ...).
> +
> +Examples:
> +
> +    (chain-cut '(1 2 3) cdr car)
> + => (car (cdr '(1 2 3)))
> +
> +    (chain-cut 2 (- 3 <>) 1+)
> + => (1+ ((cut - 3 <>) 2))
> + => (1+ (- 3 2))
> +"
> +    (syntax-case x ()
> +      ((chain-cut init op) (identifier? #'op)
> +       #'(op init))
> +      ((chain-cut init (op ...))
> +       #'((cut op ...) init))
> +      ((chain-cut init op op* ...) (identifier? #'op)
> +       #'(chain-cut (op init) op* ...))
> +      ((chain-cut init (op ...) op* ...)
> +       #'(chain-cut ((cut op ...) init) op* ...)))))

I'm not 100% convince on the above, as it seems it leads to bunching a
whole lot of procedures together and not paying attention to potential
exceptions/errors returned.  But maybe that's OK if the whole form is
wrapped in an error handler.

That's it!  This adding a whole new command line, and to get everyone
aware, I think going through the new GCD (Guix Common Document/RFC)
process is warranted before it is to be accepted/included in
Guix.

-- 
Thanks,
Maxim