Maxim Cournoyer <maxim.cournoyer@gmail.com> writes:

> Fixes <https://issues.guix.gnu.org/43893>.
>
> This changes the 'update-guix-package' tool so that it:
>
> 1. Always uses a clean checkout to compute the hash of the updated 'guix'
> package.
> 2. Ensures the commit used in the updated 'guix' package definition has already
> been pushed upstream.
>
> * build-aux/update-guix-package.scm (%savannah-guix-git-repo-push-url): New
> variable.
> (with-input-pipe-to-string): New syntax.
> (find-origin-remote, git-add-worktree): New procedures.
> (commit-already-pushed?): New predicate.
> (main): Check the commit used has already been pushed upstream and compute the
> hash from a clean checkout.
> * doc/contributing.texi (Updating the Guix Package): Document it.

[...]
  
>  (define %top-srcdir
>    (string-append (current-source-directory) "/.."))
> @@ -101,44 +109,69 @@ COMMIT."
>        (exp
>         (error "'guix' package definition is not as expected" exp)))))
>  
> -
> -(define (main . args)
> -  (match args
> -    ((commit version)
> -     (with-store store
> -       (let* ((source   (add-to-store store
> -                                      "guix-checkout" ;dummy name
> -                                      #t "sha256" %top-srcdir
> -                                      #:select? version-controlled?))
> -              (hash     (query-path-hash store source))
> -              (location (package-definition-location))
> -              (old-hash (content-hash-value
> -                          (origin-hash (package-source guix)))))
> -         (edit-expression location
> -                          (update-definition commit hash
> -                                             #:old-hash old-hash
> -                                             #:version version))
> +(define (git-add-worktree directory commit-ish)
> +  "Create a new git worktree at DIRECTORY, detached on commit COMMIT-ISH."
> +  (invoke "git" "worktree" "add" "--detach" directory commit-ish))

Is it feasible to use Guile-Git here (given appropriate bindings)?

> +(define %savannah-guix-git-repo-push-url
> +  "git.savannah.gnu.org/srv/git/guix.git")
>  
> -         ;; Re-add SOURCE to the store, but this time under the real name used
> -         ;; in the 'origin'.  This allows us to build the package without
> -         ;; having to make a real checkout; thus, it also works when working
> -         ;; on a private branch.
> -         (reload-module
> -          (resolve-module '(gnu packages package-management)))
> +(define-syntax-rule (with-input-pipe-to-string prog arg ...)
> +  (let* ((input-pipe (open-pipe* OPEN_READ prog arg ...))
> +	 (output (get-string-all input-pipe))
> +	 (exit-val (status:exit-val (close-pipe input-pipe))))
> +    (unless (zero? exit-val)
> +      (error (format #f "Command ~s exited with non-zero exit status: ~s"
> +                     (string-join (list prog arg ...)) exit-val)))
> +    (string-trim-both output)))
>  
> -         (let* ((source (add-to-store store
> -                                      (origin-file-name (package-source guix))
> -                                      #t "sha256" source))
> -                (root   (store-path-package-name source)))
> +(define (find-origin-remote)
> +  "Find the name of the git remote with the Savannah Guix git repo URL."
> +  (and-let* ((remotes (string-split (with-input-pipe-to-string
> +                                     "git" "remote" "-v")
> +                                    #\newline))
> +             (origin-entry (find (cut string-contains <>
> +                                      (string-append
> +                                       %savannah-guix-git-repo-push-url
> +                                       " (push)"))
> +                                 remotes)))
> +    (first (string-split origin-entry #\tab))))
>  
> -           ;; Add an indirect GC root for SOURCE in the current directory.
> -           (false-if-exception (delete-file root))
> -           (symlink source root)
> -           (add-indirect-root store
> -                              (string-append (getcwd) "/" root))
> +(define (commit-already-pushed? remote commit)
> +  "True if COMMIT is found in the REMOTE repository."
> +  (not (string-null? (with-input-pipe-to-string
> +                      "git" "branch" "-r" "--contains" commit
> +                      (string-append remote "/master")))))

...because parsing git CLI output is error-prone and "ugly" (IMO).  But
not a strong opinion.

> -           (format #t "source code for commit ~a: ~a (GC root: ~a)~%"
> -                   commit source root)))))
> +
> +(define (main . args)
> +  (match args
> +    ((commit version)
> +     (with-directory-excursion %top-srcdir
> +       (or (getenv "GUIX_ALLOW_ME_TO_USE_PRIVATE_COMMIT")
> +           (commit-already-pushed? (find-origin-remote) commit)
> +           (leave (G_ "Commit ~a is not pushed upstream.  Aborting.~%") commit))
> +       (dynamic-wind
> +         (lambda ()
> +           #t)
> +         (lambda ()
> +           (call-with-temporary-directory
> +            (lambda (tmp-directory)
> +              (let* ((dummy (git-add-worktree tmp-directory commit))
> +                     (hash (nix-base32-string->bytevector
> +                            (string-trim-both
> +                             (with-output-to-string
> +		               (lambda ()
> +		                 (guix-hash "-rx" tmp-directory))))))
> +                     (location (package-definition-location))
> +                     (old-hash (content-hash-value
> +                                (origin-hash (package-source guix)))))
> +                (edit-expression location
> +                                 (update-definition commit hash
> +                                                    #:old-hash old-hash
> +                                                    #:version version))))))
> +         (lambda ()
> +           (invoke "git" "worktree" "prune")))))

This is not great, because users (well, developers who run this script)
may have worktrees that are temporarily inaccessible (e.g. on a USB
drive or whatever).  Better to just leave the stale reference instead of
potentially destroying users worktrees.

Perhaps the script could 'git clone --maxdepth=1' instead of creating a
worktree?