@@ 1177,49 1177,20 @@ prepare-release: dist-with-updated-version all
@echo "Now push the resulting commit and run `make release`."
@echo
+# Make sure you've ran prepare-release prior to running release and pushed
+# the commit to Guix. It might be pushed to any branch, such as version-X.Y.Z.
release: all
-# Generate the binary release tarballs.
- rm -f $(BINARY_TARBALLS)
- $(MAKE) $(BINARY_TARBALLS)
- for system in $(SUPPORTED_SYSTEMS) ; do \
- mv "guix-binary.$$system.tar.xz" \
- "$(releasedir)/guix-binary-$(PACKAGE_VERSION).$$system.tar.xz" ; \
- done
-# Build 'current-guix' to speed things up for the next step.
- $(top_builddir)/pre-inst-env guix build \
- -e '((@ (gnu packages package-management) current-guix))' \
- $(call system_flags,$(GUIX_SYSTEM_INSTALLER_SYSTEMS)) \
- -v1 --no-grafts --fallback
-# Generate the ISO installation images.
- for system in $(GUIX_SYSTEM_INSTALLER_SYSTEMS) ; do \
- GUIX_DISPLAYED_VERSION="`git describe --match=v* | sed -'es/^v//'`" ; \
- image=`$(top_builddir)/pre-inst-env \
- guix system image -t iso9660 \
- --label="GUIX_$${system}_$(VERSION)" \
- --system=$$system --fallback \
- gnu/system/install.scm` ; \
- if [ ! -f "$$image" ] ; then \
- echo "failed to produce Guix installation image for $$system" >&2 ; \
- exit 1 ; \
- fi ; \
- cp "$$image" "$(releasedir)/$(GUIX_SYSTEM_IMAGE_BASE).$$system.iso.tmp" ; \
- mv "$(releasedir)/$(GUIX_SYSTEM_IMAGE_BASE).$$system.iso.tmp" \
- "$(releasedir)/$(GUIX_SYSTEM_IMAGE_BASE).$$system.iso" ; \
- done
-# Generate the VM images.
- for system in $(GUIX_SYSTEM_VM_SYSTEMS) ; do \
- GUIX_DISPLAYED_VERSION="`git describe --match=v* | sed -'es/^v//'`" ; \
- image=`$(top_builddir)/pre-inst-env \
- guix system image -t qcow2 $(GUIX_SYSTEM_VM_IMAGE_FLAGS) \
- --save-provenance \
- --system=$$system --fallback \
- gnu/system/examples/vm-image.tmpl` ; \
- if [ ! -f "$$image" ] ; then \
- echo "failed to produce Guix VM image for $$system" >&2 ; \
- exit 1 ; \
- fi ; \
- cp "$$image" "$(releasedir)/$(GUIX_SYSTEM_VM_IMAGE_BASE).$$system.qcow2"; \
- done
+# Build the artifacts for current commit.
+# Use time-machine for provenance.
+ $(MKDIR_P) "$(releasedir)"
+ @echo "Building guix inferior for current commit."
+ COMMIT="$$(git rev-parse HEAD)" && \
+ GUIX="$$(guix time-machine --commit=$$COMMIT)/bin/guix" && \
+ echo "Building artifacts for current commit: $$COMMIT." && \
+ ARTIFACTS="$$($$GUIX build --no-grafts \
+ -f ./etc/teams/release/artifacts.scm)" && \
+ echo "Artifacts built! Copying to $(releasedir)" && \
+ cp -f "$$ARTIFACTS"/* "$(releasedir)"
@echo
@echo "Congratulations! All the release files are now in $(releasedir)."
@echo
@@ 0,0 1,412 @@
+;;; GNU Guix --- Functional package management for GNU
+;;;
+;;; 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/>.
+
+;;; This manifest returns build artfacts for all supported systems. This can be
+;;; controlled by SUPPORTED_SYSTEMS environment variable. For the list of
+;;; artifacts produced, see artifacts-for-system and the `<thing>-for-system?`
+;;; procedures. NOTE: the --system argument does not change the system for which
+;;; the resulting package is built. They return different definitions of the
+;;; images. To change the system, pass different SUPPORTED_SYSTEMS.
+
+(use-modules (gnu compression)
+ (gnu image)
+ (gnu packages graphviz)
+ (gnu packages imagemagick)
+ (gnu packages package-management)
+ (gnu packages perl)
+ (gnu services)
+ (gnu system image)
+ (gnu system install)
+ (gnu system)
+ (guix build-system gnu)
+ (guix build-system trivial)
+ (guix channels)
+ (guix gexp)
+ (guix git)
+ (guix grafts)
+ (guix memoization)
+ (guix monads)
+ (guix packages)
+ (guix profiles)
+ (guix records)
+ (guix scripts pack)
+ (guix store)
+ (guix ui)
+ (guix utils)
+ (ice-9 format)
+ (ice-9 match)
+ (srfi srfi-9)
+ (srfi srfi-26)
+ (srfi srfi-35))
+
+;; For easier testing, use (snapshot) guix package from (gnu packages
+;; package-management). Otherwise, the package is updated to current commit and
+;; might not be substitutable, leading to longer build times.
+(define %use-snapshot-package?
+ (string=? (or (getenv "GUIX_USE_SNAPSHOT_PACKAGE") "no") "yes"))
+
+(define (%guix-version)
+ ;; NOTE: while package-version guix is not correct in general,
+ ;; it is correct for the release itself. At that time, the
+ ;; guix package is updated to vX.Y.Z and it's the version
+ ;; we want to use.
+ (package-version guix))
+
+(define (%vm-image-path)
+ (search-path %load-path "gnu/system/examples/vm-image.tmpl"))
+
+(define (%vm-image-efi-path)
+ (search-path %load-path "gnu/system/examples/vm-image-efi.tmpl"))
+
+;; monadic record and gexp-compiler
+;; taken from Inria
+;; https://gitlab.inria.fr/numpex-pc5/wp3/guix-images/-/blob/17bf4585abc2d637faa5d339436e778b7c9fb1ce/modules/guix-hpc/packs.scm
+
+;; XXX: The <monadic> hack below will hopefully become unnecessary once the
+;; (guix scripts pack) interface switches to declarative style--i.e.,
+;; file-like objects.
+
+(define-record-type <monadic>
+ (monadic->declarative mvalue)
+ monadic?
+ (mvalue monadic-value))
+
+(define-gexp-compiler (monadic-compiler (monadic <monadic>) system target)
+ (monadic-value monadic))
+
+;; The tarball should be the same for every system.
+;; Still, we need to decide what system to build it
+;; for, so use the one that CI has most resources for.
+(define (source-tarball-for-system? system)
+ (member system
+ '("x86_64-linux")))
+
+(define (iso-for-system? system)
+ (member system
+ '("x86_64-linux" "i686-linux" "aarch64-linux")))
+
+(define (qcow2-for-system? system)
+ (member system
+ '("x86_64-linux" "aarch64-linux")))
+
+(define* (qcow2-gpt-for-system? system)
+ (string=? system "aarch64-linux"))
+
+(define (copy-/etc/config.scm config)
+ "Copy the configuration.scm of the operating system to /etc/config.scm, for
+user's convenience. The file has to be writable, not a link to the store, so
+etc-service-type can't be used here. CONFIG is a pair of strings, (FROM . TO).
+The config will be copied from FROM to TO."
+ (match config
+ ((from . to)
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils))
+ (when (not (file-exists? #$to))
+ (copy-file #$from #$to)
+ (make-file-writable #$to)))))
+ (_ (raise
+ (formatted-message-string
+ (G_ "unexpected config parameter, should be pair of strings: ~a"
+ config))))))
+
+(define copy-/etc/config.scm-service-type
+ (service-type (name 'copy-/etc/config.scm)
+ (description
+ "Copy the system configuration file to /etc/config.scm.")
+ (extensions (list (service-extension activation-service-type
+ copy-/etc/config.scm)))
+ (default-value (cons "/run/current-system/configuration.scm"
+ "/etc/config.scm"))))
+
+(define (operating-system-with-/etc/config.scm os)
+ "Copy the system configuration file to writable /etc/config.scm on first boot."
+ (operating-system
+ (inherit os)
+ (services (cons (service copy-/etc/config.scm-service-type)
+ (operating-system-user-services os)))))
+
+(define (simple-provenance-entry config-file)
+ "Return system entries describing the operating system config, provided
+through CONFIG-FILE."
+ (mbegin %store-monad
+ (return `(("configuration.scm"
+ ,(local-file (assume-valid-file-name config-file)
+ "configuration.scm"))))))
+
+;; This is mostly taken from provenance-service-type from (gnu services),
+;; but it provides only configuration.scm, not channels.scm. This is
+;; to get the same derivations for both Cuirass and local builds.
+;; In the future, provenance-service-type could be adapted to support
+;; this use case as well.
+(define simple-provenance-service-type
+ (service-type (name 'provenance)
+ (extensions
+ (list (service-extension system-service-type
+ simple-provenance-entry)))
+ (default-value #f) ;the OS config file
+ (description
+ "Store configuration.scm of the system in the system
+itself.")))
+
+(define* (operating-system-with-simple-provenance
+ os
+ #:optional
+ (config-file
+ (operating-system-configuration-file
+ os)))
+ "Return a variant of OS that stores its CONFIG-FILE. This is similar to
+`operating-system-with-provenance`, but it does copy only the
+configuration.scm."
+ (operating-system
+ (inherit os)
+ (services (cons (service simple-provenance-service-type config-file)
+ (operating-system-user-services os)))))
+
+(define (guix-package-commit guix)
+ ;; Extract the commit of the GUIX package.
+ (match (package-source guix)
+ ((? channel? source)
+ (channel-commit source))
+ (_
+ (apply (lambda* (#:key commit #:allow-other-keys) commit)
+ (package-arguments guix)))))
+
+;; NOTE: Normally, we would use (current-guix), along with url
+;; overriden to the upstream repository to not leak our local checkout.
+;; But currently, the (current-guix) derivation has to be computed through
+;; QEMU for systems other than your host system. This takes a lot of time,
+;; it takes at least half an hour to get the derivations.
+(define (guix-package/with-commit guix commit)
+ "Use the guix from (gnu packages package-management),
+but override its commit to the specified version. Make sure
+to also override the channel commit to have the correct
+provenance."
+ (let ((scm-version (car (string-split (package-version guix) #\-))))
+ (package
+ (inherit guix)
+ (version (string-append scm-version "." (string-take commit 7)))
+ (source (git-checkout
+ (url (channel-url %default-guix-channel))
+ (commit commit)))
+ (arguments
+ (substitute-keyword-arguments (package-arguments guix)
+ ((#:configure-flags flags '())
+ #~(cons*
+ (string-append "--with-channel-commit=" #$commit)
+ (filter (lambda (flag)
+ (not (string-prefix? "--with-channel-commit=" flag)))
+ #$flags))))))))
+
+(define guix-for-images
+ (mlambda (system)
+ (cond
+ ;; For testing purposes, use the guix package directly.
+ (%use-snapshot-package? guix)
+ ;; Normally, update the guix package to current commit.
+ (else
+ (guix-package/with-commit guix (guix-package-commit (current-guix)))))))
+
+(define %binary-tarball-compression "xz")
+
+;; Like guix pack -C xz -s --localstatedir --profile-name=current-guix guix
+(define* (binary-tarball-for-system system #:key (extra-packages '()))
+ (let* ((base-name (string-append "guix-binary-" (%guix-version) "." system))
+ (manifest (packages->manifest (cons* guix extra-packages)))
+ (profile (profile (content manifest)))
+ (inputs `(("profile" ,profile)))
+ (compression %binary-tarball-compression))
+ (manifest-entry
+ (name (string-append base-name ".tar." compression))
+ (version (%guix-version))
+ (item (monadic->declarative
+ (self-contained-tarball
+ base-name profile
+ #:profile-name "current-guix"
+ #:compressor (lookup-compressor compression)
+ #:localstatedir? #t))))))
+
+;; Like guix system image -t iso9660 \
+;; --label="GUIX_$${system}_$(VERSION)" gnu/system/install.scm
+(define* (iso-for-system system)
+ (let* ((name (string-append
+ "guix-system-install-" (%guix-version) "." system ".iso"))
+ (base-os (make-installation-os
+ #:grub-displayed-version (%guix-version)
+ #:efi-only? (string=? system "aarch64-linux")))
+ (base-image (os->image base-os #:type iso-image-type))
+ (label (string-append "GUIX_" system "_"
+ (if (> (string-length (%guix-version)) 7)
+ (string-take (%guix-version) 7)
+ (%guix-version)))))
+ (manifest-entry
+ (name name)
+ (version (%guix-version))
+ (item (system-image
+ (image-with-label
+ (image
+ (inherit base-image)
+ (name (string->symbol name)))
+ label))))))
+
+;; Like guix system image -t qcow2 gnu/system/examples/vm-image.tmpl
+(define* (qcow2-for-system system)
+ (let* ((name (string-append
+ "guix-system-vm-image-" (%guix-version) "." system ".qcow2"))
+ (base-os-path
+ (if (qcow2-gpt-for-system? system)
+ (%vm-image-efi-path)
+ (%vm-image-path)))
+ (target-image-type
+ (if (qcow2-gpt-for-system? system)
+ qcow2-gpt-image-type
+ qcow2-image-type))
+ (base-os
+ (operating-system-with-/etc/config.scm
+ (operating-system-with-simple-provenance
+ (load base-os-path) base-os-path)))
+ (base-image (os->image base-os #:type target-image-type)))
+ (manifest-entry
+ (name name)
+ (version (%guix-version))
+ (item (system-image
+ (image
+ (inherit base-image)
+ (volatile-root? #f)
+ (name (string->symbol name))))))))
+
+(define* (guix-source-tarball)
+ (let ((guix (package
+ (inherit guix)
+ (native-inputs
+ (modify-inputs (package-native-inputs guix)
+ ;; graphviz-minimal -> graphviz
+ (replace "graphviz" graphviz)
+ (append imagemagick)
+ (append perl))))))
+ (manifest-entry
+ (name (string-append "guix-" (%guix-version) ".tar.gz"))
+ (version (package-version guix))
+ (item (dist-package
+ guix
+ ;; Guix is built from git source, not from tarball.
+ ;; So it's fine to use its source directly.
+ (package-source guix))))))
+
+(define* (manifest-entry-with-parameters system entry
+ #:key
+ (guix-for-images-proc guix-for-images))
+ (manifest-entry
+ (inherit entry)
+ (item
+ (with-parameters
+ ((%current-system system)
+ (%current-target-system #f)
+ (current-guix-package (guix-for-images-proc system)))
+ (manifest-entry-item entry)))))
+
+(define* (manifest-with-parameters system manifest
+ #:key
+ (guix-for-images-proc guix-for-images))
+ "Returns entries in the manifest accompanied with %current-system,
+%current-target-sytem and current-guix-package parameters."
+ (make-manifest
+ (map (cut manifest-entry-with-parameters system <>
+ #:guix-for-images-proc guix-for-images-proc)
+ (manifest-entries manifest))))
+
+(define (artifacts-for-system/nonparameterized system)
+ "Get all artifacts for given system. This will always include the
+guix-binary tarball and optionally iso and/or qcow2 images."
+ (manifest
+ (append
+ (list
+ (binary-tarball-for-system system))
+ ;; TODO: After source tarball generation is ready, uncomment.
+ ;; (if (source-tarball-for-system? system)
+ ;; (list (guix-source-tarball))
+ ;; '())
+ (if (iso-for-system? system)
+ (list (iso-for-system system))
+ '())
+ (if (qcow2-for-system? system)
+ (list (qcow2-for-system system))
+ '()))))
+
+(define* (artifacts-for-system system
+ #:key
+ (guix-for-images-proc guix-for-images))
+ "Collects all artifacts for a system. Gives them the proper %current-system
+and %current-target-system parameters, so the --system passed on CLI is
+irrelevant."
+ ;; NOTE: parameterizing current system, because the tarball seems to somehow
+ ;; depend on it early on. I haven't investigated it, but seems like a bug. Could
+ ;; it be the gexp->derivation + monadic->declarative, not passing down the
+ ;; system? Symptom: guix build --system=x86_64 -m artifacts-manifest.scm and
+ ;; guix build --system=i686-linux -m artifacts-manifest.scm gives out different
+ ;; results without the parameterization.
+ (parameterize
+ ((%current-system system)
+ (%current-target-system #f)
+ (current-guix-package (guix-for-images-proc system)))
+ (manifest-with-parameters
+ system
+ (artifacts-for-system/nonparameterized system)
+ #:guix-for-images-proc guix-for-images-proc)))
+
+(define (manifest->union manifest)
+ "Makes a union that will be a folder with all the entries symlinked. This
+is different from a profile as it expects the entries are just simple files
+and symlinks them by their manifest-entry-name."
+ (let ((entries (manifest-entries manifest)))
+ (computed-file
+ "artifacts-union"
+ (with-imported-modules '((guix build union)
+ (guix build utils))
+ #~(begin
+ (use-modules (guix build utils))
+
+ (mkdir-p #$output)
+
+ (for-each
+ (lambda* (entry)
+ (symlink (cdr entry)
+ (string-append #$output "/" (car entry))))
+ (list #$@(map (lambda (entry)
+ #~(cons
+ #$(manifest-entry-name entry)
+ #$(manifest-entry-item entry)))
+ entries))))))))
+
+(define %supported-systems
+ (or (and
+ (getenv "SUPPORTED_SYSTEMS")
+ (string-split (getenv "SUPPORTED_SYSTEMS") #\ ))
+ '("x86_64-linux" "i686-linux"
+ "armhf-linux" "aarch64-linux"
+ "powerpc64le-linux" "riscv64-linux")))
+
+(define supported-systems-union-manifest
+ (concatenate-manifests
+ (map artifacts-for-system
+ %supported-systems)))
+
+(when %use-snapshot-package?
+ (warning (G_ "building images using the 'guix' package (snapshot)~%")))
+(info (G_ "producing artifacts for the following systems: ~a~%")
+ %supported-systems)
+supported-systems-union-manifest
@@ 0,0 1,26 @@
+;;; GNU Guix --- Functional package management for GNU
+;;;
+;;; 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/>.
+
+;;; Produce a single directory with all the artifacts inside of it, with proper
+;;; names. They can then be easily copied to releasedir in Makefile. The files are
+;;; symlinked to save space, but they should be copied out of the store as regular
+;;; files.
+
+(load "artifacts-manifest.scm")
+
+(manifest->union
+ supported-systems-union-manifest)