aboutsummaryrefslogtreecommitdiff
path: root/manifest.scm
blob: 2bc225ead764e52753c31b7fe1ff20dc1c4aa778 (about) (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2022, 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

;; GNU Guix development manifest.  To create development environment, run
;;
;;     guix shell
;;
;; or something like
;;
;;     guix shell --pure git git:send-email openssh

(use-modules (guix profiles)
             (gnu packages gnupg)
             (gnu packages perl)
             (gnu packages package-management))

(concatenate-manifests
 (list (package->development-manifest guix)

       ;; Extra packages used by make dist.
       (packages->manifest (list perl))

       ;; Extra packages used by unit tests.
       (packages->manifest (list gnupg))))
(assq-ref location 'line)) (column 0) (offset (linear-offset str line column))) (string-append (format #f "(let ((version \"~a\") (commit \"~a\") (revision ~a))\n" (or version old-version) commit (if (and version (not (string=? version old-version))) 0 (+ 1 old-revision))) (string-drop (update-hash str) offset)))) (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-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)))) (apply main (cdr (command-line)))