maint: update-guix-package: Prevent accidentally breaking guix pull.

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, with-temporary-git-worktree): New syntaxes.
(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.
* .dir-locals.el (scheme-mode): Fix indentation of with-temporary-git-worktree.

3 files changed, 112 insertions, 30 deletions

diff --git a/.dir-locals.el b/.dir-locals.el
index 7f310d2612..19f15b3e1a 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -103,6 +103,7 @@
    (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-temporary-git-worktree '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/build-aux/update-guix-package.scm b/build-aux/update-guix-package.scm
index f695e91cfd..9b03b06c7c 100644
--- a/build-aux/update-guix-package.scm
+++ b/build-aux/update-guix-package.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,13 +25,20 @@
 ;;; Code:
 
 (use-modules (guix)
+             (guix ui)
              (guix git-download)
              (guix upstream)
              (guix utils)
              (guix base32)
              (guix build utils)
+             (guix scripts hash)
              (gnu packages package-management)
-             (ice-9 match))
+             (ice-9 match)
+             (ice-9 popen)
+             (ice-9 textual-ports)
+             (srfi srfi-1)
+             (srfi srfi-2)
+             (srfi srfi-26))
 
 (define %top-srcdir
   (string-append (current-source-directory) "/.."))
@@ -101,44 +109,74 @@ COMMIT."
       (exp
        (error "'guix' package definition is not as expected" exp)))))
 
+(define (git-add-worktree directory commit)
+  "Create a new git worktree at DIRECTORY, detached on commit COMMIT."
+  (invoke "git" "worktree" "add" "--detach" directory commit))
+
+(define-syntax-rule (with-temporary-git-worktree commit body ...)
+  "Execute BODY in the context of a temporary git worktree created from COMMIT."
+  (call-with-temporary-directory
+   (lambda (tmp-directory)
+     (dynamic-wind
+       (lambda ()
+         #t)
+       (lambda ()
+         (git-add-worktree tmp-directory commit)
+         (with-directory-excursion tmp-directory body ...))
+       (lambda ()
+         (invoke "git" "worktree" "remove" "--force" tmp-directory))))))
+
+(define %savannah-guix-git-repo-push-url
+  "git.savannah.gnu.org/srv/git/guix.git")
+
+(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)))
+
+(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))))
+
+(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")))))
+
 
 (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))
+     (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))
+       (let* ((hash (with-temporary-git-worktree commit
+                        (nix-base32-string->bytevector
+                         (string-trim-both
+                          (with-output-to-string
+		            (lambda ()
+		              (guix-hash "-rx" ".")))))))
               (location (package-definition-location))
               (old-hash (content-hash-value
-                          (origin-hash (package-source guix)))))
+                         (origin-hash (package-source guix)))))
          (edit-expression location
                           (update-definition commit hash
                                              #:old-hash old-hash
-                                             #:version version))
-
-         ;; 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)))
-
-         (let* ((source (add-to-store store
-                                      (origin-file-name (package-source guix))
-                                      #t "sha256" source))
-                (root   (store-path-package-name source)))
-
-           ;; 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))
-
-           (format #t "source code for commit ~a: ~a (GC root: ~a)~%"
-                   commit source root)))))
+                                             #:version version)))))
     ((commit)
      ;; Automatically deduce the version and revision numbers.
      (main commit #f))))
diff --git a/doc/contributing.texi b/doc/contributing.texi
index af3601442e..11a932a9bf 100644
--- a/doc/contributing.texi
+++ b/doc/contributing.texi
@@ -28,6 +28,7 @@ choice.
 * Submitting Patches::          Share your work.
 * Tracking Bugs and Patches::   Using Debbugs.
 * Commit Access::               Pushing to the official repository.
+* Updating the Guix Package::   Updating the Guix package definition.
 @end menu
 
 @node Building from Git
@@ -1323,3 +1324,45 @@ only push their own awesome changes, but also offer some of their time
 @emph{reviewing} and pushing other people's changes.  As a committer,
 you're welcome to use your expertise and commit rights to help other
 contributors, too!
+
+@node Updating the Guix Package
+@section Updating the Guix Package
+
+@cindex update-guix-package, updating the guix package
+It is sometimes desirable to update the @code{guix} package itself (the
+package defined in @code{(gnu packages package-management)}), for
+example to make new daemon features available for use by the
+@code{guix-service-type} service type.  In order to simplify this task,
+the following command can be used:
+
+@example
+make update-guix-package
+@end example
+
+The @code{update-guix-package} make target will use the last known
+@emph{commit} corresponding to @code{HEAD} in your Guix checkout,
+compute the hash of the Guix sources corresponding to that commit and
+update the @code{commit}, @code{revision} and hash of the @code{guix}
+package definition.
+
+To validate that the updated @code{guix} package hashes are correct and
+that it can be built successfully, the following command can be run from
+the directory of your Guix checkout:
+
+@example
+./pre-inst-env guix build guix
+@end example
+
+To guard against accidentally updating the @code{guix} package to a
+commit that others can't refer to, a check is made that the commit used
+has already been pushed to the Savannah-hosted Guix git repository.
+
+This check can be disabled, @emph{at your own peril}, by setting the
+@code{GUIX_ALLOW_ME_TO_USE_PRIVATE_COMMIT} environment variable.
+
+To build the resulting 'guix' package when using a private commit, the
+following command can be used:
+
+@example
+./pre-inst-env guix build guix --with-git-url=guix=$PWD
+@end example