diff options
Diffstat (limited to 'build-aux/update-guix-package.scm')
| -rw-r--r-- | build-aux/update-guix-package.scm | 145 |
1 files changed, 107 insertions, 38 deletions
diff --git a/build-aux/update-guix-package.scm b/build-aux/update-guix-package.scm index f695e91cfd..9fe6c201cc 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,20 +25,25 @@ ;;; 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 regex) + (ice-9 textual-ports) + (srfi srfi-1) + (srfi srfi-2) + (srfi srfi-26)) (define %top-srcdir (string-append (current-source-directory) "/..")) -(define version-controlled? - (git-predicate %top-srcdir)) - (define (package-definition-location) "Return the source properties of the definition of the 'guix' package." (call-with-input-file (location-file (package-location guix)) @@ -101,44 +107,107 @@ 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 (call-with-temporary-git-worktree commit proc) + "Execute PROC in the context of a temporary git worktree created from +COMMIT. PROC receives the temporary directory file name as an argument." + (call-with-temporary-directory + (lambda (tmp-directory) + (dynamic-wind + (lambda () + #t) + (lambda () + (git-add-worktree tmp-directory commit) + (proc tmp-directory)) + (lambda () + (invoke "git" "worktree" "remove" "--force" tmp-directory)))))) + +(define %savannah-guix-git-repo-push-url-regexp + "git.(savannah|sv).gnu.org:?/srv/git/guix.git \\(push\\)") + +(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-match + %savannah-guix-git-repo-push-url-regexp + <>) + 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 (keep-source-in-store store source) + "Add SOURCE to the store under the name that the 'guix' package expects." + + ;; 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 + #:select? (git-predicate 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)) + + (info (G_ "source code kept in ~a (GC root: ~a)~%") + source root))) + (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)) - - ;; 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))))) + (with-directory-excursion %top-srcdir + (or (getenv "GUIX_ALLOW_ME_TO_USE_PRIVATE_COMMIT") + (let ((remote (find-origin-remote))) + (unless remote + (leave (G_ "Failed to find the origin git remote.~%"))) + (commit-already-pushed? remote commit)) + (leave (G_ "Commit ~a is not pushed upstream. Aborting.~%") commit)) + (call-with-temporary-git-worktree commit + (lambda (tmp-directory) + (let* ((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)) + ;; When GUIX_ALLOW_ME_TO_USE_PRIVATE_COMMIT is set, the sources are + ;; added to the store. This is used as part of 'make release'. + (when (getenv "GUIX_ALLOW_ME_TO_USE_PRIVATE_COMMIT") + (with-store store + (keep-source-in-store store tmp-directory)))))))) ((commit) ;; Automatically deduce the version and revision numbers. (main commit #f)))) |