mirror of
https://codeberg.org/guix/guix.git
synced 2026-01-25 03:55:08 -06:00
Merge branch 'version-1.5.0'
Change-Id: I5a36bbdb772c88f71fbe612cf6c445c34088e35c
This commit is contained in:
Rutherther
commit
addca6dba4
14 changed files with 829 additions and 170 deletions
74
Makefile.am
74
Makefile.am
|
|
@ -1142,12 +1142,18 @@ system_flags = $(foreach system,$(1),-s $(system))
|
|||
# 5. Build the installation and VM images. The images will run 'guix'
|
||||
# corresponding to 'vX.Y.Z' + 1 commit, and they will install 'vX.Y.Z'.
|
||||
#
|
||||
# This 'release' target takes care of everything and copies the resulting
|
||||
# files to $(releasedir).
|
||||
# This is split into two targets, because a commit is made that has to be
|
||||
# pushed to Guix.
|
||||
# First, 'prepare-release' should be run, doing steps 1 and 2.
|
||||
# Then, the resulting commit should be pushed so that it's available
|
||||
# to be downloaded for the system images.
|
||||
# Afterwards, the 'release' target takes care of the rest. This 'release'
|
||||
# target takes care of everything and copies the resulting files to
|
||||
# $(releasedir).
|
||||
#
|
||||
# XXX: Depend on 'dist' rather than 'distcheck' to work around the Gettext
|
||||
# issue described at <https://savannah.gnu.org/bugs/index.php?51027>.
|
||||
release: dist-with-updated-version all
|
||||
prepare-release: dist-with-updated-version all
|
||||
@if ! git diff-index --quiet HEAD; then \
|
||||
echo "There are uncommitted changes; stopping." >&2 ; \
|
||||
exit 1 ; \
|
||||
|
|
@ -1165,48 +1171,26 @@ release: dist-with-updated-version all
|
|||
$(top_builddir)/pre-inst-env guix build guix \
|
||||
$(call system_flags,$(SUPPORTED_SYSTEMS)) \
|
||||
-v1 --no-grafts --fallback
|
||||
# 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
|
||||
|
||||
@echo
|
||||
@echo "First step done! Source tarball is ready in $(releasedir)"
|
||||
@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
|
||||
# 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
|
||||
|
|
|
|||
|
|
@ -47841,7 +47841,9 @@ machine. The @code{grub-bootloader} bootloader is always used
|
|||
independently of what is declared in the @code{operating-system} file
|
||||
passed as argument. This is to make it easier to work with QEMU, which
|
||||
uses the SeaBIOS BIOS by default, expecting a bootloader to be installed
|
||||
in the Master Boot Record (MBR).
|
||||
in the Master Boot Record (MBR). In case the virtual machine is
|
||||
going to be AArch64, you might want to take a look at @code{qcow2-gpt}
|
||||
image type that installs bootloader only in EFI.
|
||||
|
||||
@cindex docker-image, creating docker images
|
||||
When using the @code{docker} image type, a Docker image is produced.
|
||||
|
|
@ -54765,7 +54767,18 @@ Build an image based on the @code{efi32-disk-image} image.
|
|||
|
||||
@defvar qcow2-image-type
|
||||
Build an image based on the @code{mbr-disk-image} image but with the
|
||||
@code{compressed-qcow2} image format.
|
||||
@code{compressed-qcow2} image format. The resulting image will have
|
||||
an MBR embedded bootloader as well as an EFI bootloader. This image
|
||||
is not suitable for architectures that do not support `grub-pc`,
|
||||
such as AArch64. See @code{qcow2-gpt-image-type} for an alternative.
|
||||
@end defvar
|
||||
|
||||
@defvar qcow2-gpt-image-type
|
||||
Build an image based on the @code{efi-disk-image} image but with the
|
||||
@code{compressed-qcow2} image format. The resulting image will have
|
||||
only EFI bootloader, unlike @code{qcow2-image-type}. This image
|
||||
is suitable for architectures that do not support `grub-pc`, such
|
||||
as AArch64.
|
||||
@end defvar
|
||||
|
||||
@defvar iso-image-type
|
||||
|
|
|
|||
|
|
@ -71,18 +71,21 @@ TARGET."
|
|||
"connman" "network-manager" "wpa-supplicant" "isc-dhcp" "cups"
|
||||
"linux-libre" "grub-hybrid")))
|
||||
|
||||
(define %system-gui-packages
|
||||
(define (%system-gui-packages target)
|
||||
;; Key packages proposed by the Guix System installer.
|
||||
(append (map specification->package
|
||||
'(;; build system `python' does not support cross builds
|
||||
;"gnome" "xfce" "mate" "openbox"
|
||||
;"gnome" "xfce" "mate" "openbox"
|
||||
"awesome"
|
||||
"i3-wm" "i3status" "dmenu" "st"
|
||||
"ratpoison" "xterm"
|
||||
;; build system `emacs' does not support cross builds
|
||||
;"emacs-exwm" "emacs-desktop-environment"
|
||||
;"emacs-exwm" "emacs-desktop-environment"
|
||||
"emacs"))
|
||||
%default-xorg-modules))
|
||||
;; NOTE: %default-xorg-modules depends on system.
|
||||
(parameterize
|
||||
((%current-target-system target))
|
||||
%default-xorg-modules)))
|
||||
|
||||
(define %packages-to-cross-build
|
||||
;; Packages that must be cross-buildable from x86_64-linux.
|
||||
|
|
@ -151,7 +154,8 @@ TARGET."
|
|||
;; With a graphical environment:
|
||||
(if (or (target-x86-32? target)
|
||||
(target-aarch64? target))
|
||||
%system-gui-packages
|
||||
;; %system-gui-packages depends on the system.
|
||||
(%system-gui-packages target)
|
||||
'()))))
|
||||
(fold delete (map platform-system->target (systems))
|
||||
'(;; Disable cross-compilation to self:
|
||||
|
|
|
|||
412
etc/teams/release/artifacts-manifest.scm
Normal file
412
etc/teams/release/artifacts-manifest.scm
Normal file
|
|
@ -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
|
||||
26
etc/teams/release/artifacts.scm
Normal file
26
etc/teams/release/artifacts.scm
Normal file
|
|
@ -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)
|
||||
|
|
@ -428,7 +428,11 @@ GRUB configuration and OS-DRV as the stuff in it."
|
|||
"-not" "-wholename" "/System/*"
|
||||
"-not" "-name" "unicode.pf2"
|
||||
"-not" "-name" "bzImage"
|
||||
"-not" "-name" "*.gz" ; initrd & all man pages
|
||||
"-not" "-name" "zImage"
|
||||
"-not" "-name" "Image"
|
||||
"-not" "-name" "vmlinuz"
|
||||
"-not" "-name" "*.gz" ; initrd
|
||||
"-not" "-name" "*.zst" ; all man pages
|
||||
"-not" "-name" "*.png" ; includes grub-image.png
|
||||
"-exec" "set_filter" "--zisofs"
|
||||
"--")
|
||||
|
|
|
|||
|
|
@ -367,14 +367,13 @@ purposes."
|
|||
'unknown)
|
||||
((channels ...)
|
||||
(map (lambda (channel)
|
||||
(let* ((uri (string->uri (channel-url channel)))
|
||||
(url (if (or (not uri) (eq? 'file (uri-scheme uri)))
|
||||
"local checkout"
|
||||
(channel-url channel))))
|
||||
`(channel ,(channel-name channel) ,url ,(channel-commit channel))))
|
||||
;; NOTE: URL is not logged to synchronize the derivations
|
||||
;; coming out of pre-inst-env, time-machine and Cuirass
|
||||
;; for generating release artifacts.
|
||||
`(channel ,(channel-name channel) ,(channel-commit channel)))
|
||||
channels))))
|
||||
|
||||
(define* (installer-program #:key dry-run?)
|
||||
(define* (installer-program #:key dry-run? (guix-for-installer (current-guix)))
|
||||
"Return a file-like object that runs the given INSTALLER."
|
||||
(define init-gettext
|
||||
;; Initialize gettext support, so that installer messages can be
|
||||
|
|
@ -423,7 +422,7 @@ purposes."
|
|||
guile-gnutls
|
||||
guile-zlib ;for (gnu build linux-modules)
|
||||
guile-zstd ;for (gnu build linux-modules)
|
||||
(current-guix))
|
||||
guix-for-installer)
|
||||
(with-imported-modules `(,@(source-module-closure
|
||||
`(,@modules
|
||||
(gnu services herd)
|
||||
|
|
|
|||
|
|
@ -197,9 +197,9 @@
|
|||
;; Latest version of Guix, which may or may not correspond to a release.
|
||||
;; Note: the 'update-guix-package.scm' script expects this definition to
|
||||
;; start precisely like this.
|
||||
(let ((version "1.4.0")
|
||||
(commit "21ce6b392ace4c4d22543abc41bd7c22596cd6d2")
|
||||
(revision 47))
|
||||
(let ((version "1.5.0rc1")
|
||||
(commit "2d4ed08662714ea46cfe0b41ca195d1ef845fd1b")
|
||||
(revision 0))
|
||||
(package
|
||||
(name "guix")
|
||||
|
||||
|
|
@ -215,7 +215,7 @@
|
|||
(commit commit)))
|
||||
(sha256
|
||||
(base32
|
||||
"0q4f5aiqld1smjmq0k0y96wrrvn7pizsx8xzqk6m7f9f2qm7pdhc"))
|
||||
"0z1ixlkzsaj978nh57179871xkzbf8zsf10xkcfs2647iznkx7az"))
|
||||
(file-name (string-append "guix-" version "-checkout"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
|
|
@ -234,10 +234,9 @@
|
|||
(string-append "--with-bash-completion-dir="
|
||||
(assoc-ref %outputs "out")
|
||||
"/etc/bash_completion.d")
|
||||
;; TODO: Uncomment after guix is updated.
|
||||
;; (string-append "--with-apparmor-profile-dir="
|
||||
;; (assoc-ref %outputs "out")
|
||||
;; "/etc/apparmor.d")
|
||||
(string-append "--with-apparmor-profile-dir="
|
||||
(assoc-ref %outputs "out")
|
||||
"/etc/apparmor.d")
|
||||
|
||||
;; Set 'DOT_USER_PROGRAM' to the empty string so
|
||||
;; we don't keep a reference to Graphviz, whose
|
||||
|
|
|
|||
|
|
@ -64,6 +64,7 @@
|
|||
#:use-module ((guix modules) #:select (source-module-closure))
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix derivations)
|
||||
#:use-module (guix platform)
|
||||
#:use-module (guix records)
|
||||
#:use-module (guix deprecation)
|
||||
#:use-module (guix utils)
|
||||
|
|
@ -148,25 +149,36 @@
|
|||
;;;
|
||||
;;; Code:
|
||||
|
||||
(define %default-xorg-modules
|
||||
;; Default list of modules loaded by the server. When multiple drivers
|
||||
;; match, the first one in the list is loaded.
|
||||
(list xf86-video-vesa
|
||||
xf86-video-fbdev
|
||||
xf86-video-amdgpu
|
||||
xf86-video-ati
|
||||
xf86-video-cirrus
|
||||
xf86-video-intel
|
||||
xf86-video-mach64
|
||||
xf86-video-nouveau
|
||||
xf86-video-nv
|
||||
xf86-video-sis
|
||||
(define* (default-xorg-modules
|
||||
#:optional
|
||||
(system (or (and=>
|
||||
(%current-target-system)
|
||||
platform-target->system)
|
||||
(%current-system))))
|
||||
"Default list of modules loaded by the server. When multiple drivers match,
|
||||
the first one in the list is loaded."
|
||||
;; Return only supported packages, because some aren't supported
|
||||
;; on all architectures.
|
||||
(filter (cut supported-package? <> system)
|
||||
(list xf86-video-vesa
|
||||
xf86-video-fbdev
|
||||
xf86-video-amdgpu
|
||||
xf86-video-ati
|
||||
xf86-video-cirrus
|
||||
xf86-video-intel
|
||||
xf86-video-mach64
|
||||
xf86-video-nouveau
|
||||
xf86-video-nv
|
||||
xf86-video-sis
|
||||
|
||||
;; Libinput is the new thing and is recommended over evdev/synaptics:
|
||||
;; <http://who-t.blogspot.fr/2015/01/xf86-input-libinput-compatibility-with.html>.
|
||||
xf86-input-libinput
|
||||
xf86-input-evdev
|
||||
xf86-input-mouse))
|
||||
;; Libinput is the new thing and is recommended over evdev/synaptics:
|
||||
;; <http://who-t.blogspot.fr/2015/01/xf86-input-libinput-compatibility-with.html>.
|
||||
xf86-input-libinput
|
||||
xf86-input-evdev
|
||||
xf86-input-mouse)))
|
||||
|
||||
(define-syntax %default-xorg-modules
|
||||
(identifier-syntax (default-xorg-modules)))
|
||||
|
||||
(define %default-xorg-fonts
|
||||
;; Default list of fonts available to the X server.
|
||||
|
|
|
|||
145
gnu/system/examples/vm-image-efi.tmpl
Normal file
145
gnu/system/examples/vm-image-efi.tmpl
Normal file
|
|
@ -0,0 +1,145 @@
|
|||
;; -*- mode: scheme; -*-
|
||||
;; This is an operating system configuration for a VM image.
|
||||
;; Modify it as you see fit and instantiate the changes by running:
|
||||
;;
|
||||
;; guix system reconfigure /etc/config.scm
|
||||
;;
|
||||
|
||||
(use-modules (gnu)
|
||||
(guix)
|
||||
(srfi srfi-1)
|
||||
(ice-9 match)
|
||||
(guix channels)
|
||||
(gnu system image))
|
||||
(use-service-modules desktop mcron networking spice ssh xorg sddm)
|
||||
(use-package-modules bootloaders fonts
|
||||
package-management xdisorg xorg)
|
||||
|
||||
(define vm-image-motd (plain-file "motd" "
|
||||
\x1b[1;37mThis is the GNU system. Welcome!\x1b[0m
|
||||
|
||||
This instance of Guix is a template for virtualized environments.
|
||||
You can reconfigure the whole system by adjusting /etc/config.scm
|
||||
and running:
|
||||
|
||||
guix system reconfigure /etc/config.scm
|
||||
|
||||
Run '\x1b[1;37minfo guix\x1b[0m' to browse documentation.
|
||||
|
||||
\x1b[1;33mConsider setting a password for the 'root' and 'guest' \
|
||||
accounts.\x1b[0m
|
||||
"))
|
||||
|
||||
(operating-system
|
||||
(host-name "gnu")
|
||||
(timezone "Etc/UTC")
|
||||
(locale "en_US.utf8")
|
||||
(keyboard-layout (keyboard-layout "us" "altgr-intl"))
|
||||
|
||||
;; Label for the GRUB boot menu.
|
||||
(label (string-append "GNU Guix "
|
||||
(or (getenv "GUIX_DISPLAYED_VERSION")
|
||||
(package-version guix))))
|
||||
|
||||
(firmware '())
|
||||
|
||||
;; On AArch64, support SCSI CDROMs and HDs.
|
||||
(initrd-modules (cons* "sd_mod" "sr_mod"
|
||||
%base-initrd-modules))
|
||||
|
||||
(bootloader
|
||||
(bootloader-configuration
|
||||
(bootloader grub-efi-bootloader)
|
||||
(targets '("/boot/efi"))
|
||||
(terminal-outputs '(console))))
|
||||
(file-systems (cons* (file-system
|
||||
(mount-point "/")
|
||||
(device (file-system-label root-label))
|
||||
(type "ext4"))
|
||||
(file-system
|
||||
(mount-point "/boot/efi")
|
||||
(device (file-system-label "GNU-ESP"))
|
||||
(type "vfat"))
|
||||
%base-file-systems))
|
||||
|
||||
(users (cons (user-account
|
||||
(name "guest")
|
||||
(comment "GNU Guix Live")
|
||||
(password "") ;no password
|
||||
(group "users")
|
||||
(supplementary-groups '("wheel" "netdev"
|
||||
"audio" "video")))
|
||||
%base-user-accounts))
|
||||
|
||||
;; Our /etc/sudoers file. Since 'guest' initially has an empty password,
|
||||
;; allow for password-less sudo.
|
||||
(sudoers-file (plain-file "sudoers" "\
|
||||
root ALL=(ALL) ALL
|
||||
%wheel ALL=NOPASSWD: ALL\n"))
|
||||
|
||||
(pam-services
|
||||
;; Explicitly allow for empty passwords.
|
||||
(base-pam-services #:allow-empty-passwords? #t))
|
||||
|
||||
(packages
|
||||
(append (list font-bitstream-vera
|
||||
;; Auto-started script providing SPICE dynamic resizing for
|
||||
;; Xfce (see:
|
||||
;; https://gitlab.xfce.org/xfce/xfce4-settings/-/issues/142).
|
||||
x-resize)
|
||||
%base-packages))
|
||||
|
||||
(services
|
||||
(append (list (service xfce-desktop-service-type)
|
||||
|
||||
;; Choose SLiM, which is lighter than the default GDM.
|
||||
(service slim-service-type
|
||||
(slim-configuration
|
||||
(auto-login? #t)
|
||||
(default-user "guest")
|
||||
(xorg-configuration
|
||||
(xorg-configuration
|
||||
;; The QXL virtual GPU driver is added to provide
|
||||
;; a better SPICE experience.
|
||||
(modules (cons xf86-video-qxl
|
||||
%default-xorg-modules))
|
||||
(keyboard-layout keyboard-layout)))))
|
||||
|
||||
;; Uncomment the line below to add an SSH server.
|
||||
;;(service openssh-service-type)
|
||||
|
||||
;; Add support for the SPICE protocol, which enables dynamic
|
||||
;; resizing of the guest screen resolution, clipboard
|
||||
;; integration with the host, etc.
|
||||
(service spice-vdagent-service-type)
|
||||
|
||||
;; Use the DHCP client service rather than NetworkManager.
|
||||
(service dhcpcd-service-type))
|
||||
|
||||
;; Remove some services that don't make sense in a VM.
|
||||
(remove (lambda (service)
|
||||
(let ((type (service-kind service)))
|
||||
(or (memq type
|
||||
(list gdm-service-type
|
||||
sddm-service-type
|
||||
wpa-supplicant-service-type
|
||||
cups-pk-helper-service-type
|
||||
network-manager-service-type
|
||||
modem-manager-service-type))
|
||||
(eq? 'network-manager-applet
|
||||
(service-type-name type)))))
|
||||
(modify-services %desktop-services
|
||||
(login-service-type config =>
|
||||
(login-configuration
|
||||
(inherit config)
|
||||
(motd vm-image-motd)))
|
||||
|
||||
;; Install and run the current Guix rather than an older
|
||||
;; snapshot.
|
||||
(guix-service-type config =>
|
||||
(guix-configuration
|
||||
(inherit config)
|
||||
(guix (current-guix))))))))
|
||||
|
||||
;; Allow resolution of '.local' host names with mDNS.
|
||||
(name-service-switch %mdns-host-lookup-nss))
|
||||
|
|
@ -10,6 +10,7 @@
|
|||
(srfi srfi-1)
|
||||
(ice-9 match)
|
||||
(guix channels)
|
||||
(gnu packages package-management)
|
||||
(gnu system image))
|
||||
(use-service-modules desktop mcron networking spice ssh xorg sddm)
|
||||
(use-package-modules bootloaders fonts
|
||||
|
|
@ -30,15 +31,6 @@ Run '\x1b[1;37minfo guix\x1b[0m' to browse documentation.
|
|||
accounts.\x1b[0m
|
||||
"))
|
||||
|
||||
(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)))))
|
||||
|
||||
(operating-system
|
||||
(host-name "gnu")
|
||||
(timezone "Etc/UTC")
|
||||
|
|
@ -141,14 +133,7 @@ root ALL=(ALL) ALL
|
|||
(guix-service-type config =>
|
||||
(guix-configuration
|
||||
(inherit config)
|
||||
(guix
|
||||
(let ((guix (current-guix)))
|
||||
(package
|
||||
(inherit guix)
|
||||
;; Do not leak the local checkout URL.
|
||||
(source (channel
|
||||
(inherit %default-guix-channel)
|
||||
(commit (guix-package-commit guix)))))))))))))
|
||||
(guix (current-guix))))))))
|
||||
|
||||
;; Allow resolution of '.local' host names with mDNS.
|
||||
(name-service-switch %mdns-host-lookup-nss))
|
||||
|
|
|
|||
|
|
@ -98,6 +98,7 @@
|
|||
efi-raw-image-type
|
||||
efi32-raw-image-type
|
||||
qcow2-image-type
|
||||
qcow2-gpt-image-type
|
||||
iso-image-type
|
||||
uncompressed-iso-image-type
|
||||
docker-image-type
|
||||
|
|
@ -265,6 +266,16 @@ set to the given OS."
|
|||
(format 'compressed-qcow2))
|
||||
<>))))
|
||||
|
||||
(define qcow2-gpt-image-type
|
||||
(image-type
|
||||
(name 'qcow2-gpt)
|
||||
(constructor (cut image-with-os
|
||||
(image
|
||||
(inherit efi-disk-image)
|
||||
(name 'image.qcow2)
|
||||
(format 'compressed-qcow2))
|
||||
<>))))
|
||||
|
||||
(define iso-image-type
|
||||
(image-type
|
||||
(name 'iso9660)
|
||||
|
|
@ -352,16 +363,27 @@ set to the given OS."
|
|||
(guix build utils))
|
||||
gexp* ...))))
|
||||
|
||||
(define (partition-has-flag? partition flag)
|
||||
"Return true if PARTITION's flags include FLAG."
|
||||
(member flag (partition-flags partition)))
|
||||
|
||||
(define (find-partition-with-flag image flag)
|
||||
"Return partition of the given IMAGE that has FLAG, or #f if not found."
|
||||
(srfi-1:find (cut partition-has-flag? <> flag)
|
||||
(image-partitions image)))
|
||||
|
||||
(define (root-partition? partition)
|
||||
"Return true if PARTITION is the root partition, false otherwise."
|
||||
(member 'boot (partition-flags partition)))
|
||||
(partition-has-flag? partition 'boot))
|
||||
|
||||
(define (find-root-partition image)
|
||||
"Return the root partition of the given IMAGE."
|
||||
(or (srfi-1:find root-partition? (image-partitions image))
|
||||
(or (find-partition-with-flag image 'boot)
|
||||
(raise (formatted-message
|
||||
(G_ "image lacks a partition with the 'boot' flag")))))
|
||||
|
||||
(define (find-esp-partition image)
|
||||
(find-partition-with-flag image 'esp))
|
||||
|
||||
(define (root-partition-index image)
|
||||
"Return the index of the root partition of the given IMAGE."
|
||||
(1+ (srfi-1:list-index root-partition? (image-partitions image))))
|
||||
|
|
@ -652,6 +674,10 @@ used in the image. "
|
|||
(uuid-bytevector (partition-uuid partition)))))
|
||||
|
||||
(let* ((os (image-operating-system image))
|
||||
(image-name (image-name image))
|
||||
(name (if image-name
|
||||
(symbol->string image-name)
|
||||
name))
|
||||
(bootloader (bootloader-package bootloader))
|
||||
(compression? (image-compression? image))
|
||||
(substitutable? (image-substitutable? image))
|
||||
|
|
@ -969,6 +995,19 @@ it can be used for bootloading."
|
|||
|
||||
(let* ((root-file-system-type (image->root-file-system image))
|
||||
(base-os (image-operating-system image))
|
||||
(esp-partition (find-esp-partition image))
|
||||
;; In case the user has added /boot/efi file-system,
|
||||
;; try to respect it and add a file-system pointing
|
||||
;; to the correct esp.
|
||||
(wants-boot-efi? (and
|
||||
(srfi-1:any
|
||||
(lambda (fs)
|
||||
(let ((mount-point (file-system-mount-point fs)))
|
||||
(string=? mount-point "/boot/efi")))
|
||||
(operating-system-file-systems base-os))
|
||||
esp-partition))
|
||||
;; Replace root file system with one with proper UUID that the
|
||||
;; target image will have. Similarly for /boot/efi.
|
||||
(file-systems-to-keep
|
||||
(srfi-1:remove
|
||||
(lambda (fs)
|
||||
|
|
@ -985,24 +1024,32 @@ it can be used for bootloading."
|
|||
file-systems
|
||||
#:volatile-root? volatile-root?
|
||||
rest)))
|
||||
(bootloader (if (eq? format 'iso9660)
|
||||
;; Only replace with grub-mkrescue-bootloader if grub-pc
|
||||
;; is supported. AArch64 doesn't support it. In such
|
||||
;; cases, respect bootloader of the system. Still,
|
||||
;; for now make-iso9660-image installs only GRUB.
|
||||
(bootloader (if (and (eq? format 'iso9660)
|
||||
(supported-package? grub-hybrid))
|
||||
(bootloader-configuration
|
||||
(inherit
|
||||
(operating-system-bootloader base-os))
|
||||
(bootloader grub-mkrescue-bootloader))
|
||||
(operating-system-bootloader base-os)))
|
||||
(file-systems (cons (file-system
|
||||
(mount-point "/")
|
||||
(device "/dev/placeholder")
|
||||
(type root-file-system-type))
|
||||
file-systems-to-keep))))
|
||||
(inherit
|
||||
(operating-system-bootloader base-os))
|
||||
(bootloader grub-mkrescue-bootloader))
|
||||
(operating-system-bootloader base-os)))))
|
||||
(uuid (root-uuid os)))
|
||||
(operating-system
|
||||
(inherit os)
|
||||
(file-systems (cons (file-system
|
||||
(mount-point "/")
|
||||
(device uuid)
|
||||
(type root-file-system-type))
|
||||
(operating-system
|
||||
(inherit os)
|
||||
(file-systems (append
|
||||
(list (file-system
|
||||
(mount-point "/")
|
||||
(device uuid)
|
||||
(type root-file-system-type)))
|
||||
(if wants-boot-efi?
|
||||
(list (file-system
|
||||
(mount-point "/boot/efi")
|
||||
(type "vfat")
|
||||
(device (file-system-label
|
||||
(partition-label esp-partition)))))
|
||||
'())
|
||||
file-systems-to-keep)))))
|
||||
|
||||
(define* (system-image image)
|
||||
|
|
|
|||
|
|
@ -28,6 +28,7 @@
|
|||
#:use-module (gnu)
|
||||
#:use-module (gnu system)
|
||||
#:use-module (gnu system privilege)
|
||||
#:use-module (gnu bootloader)
|
||||
#:use-module (gnu bootloader u-boot)
|
||||
#:use-module (guix gexp)
|
||||
#:use-module (guix store)
|
||||
|
|
@ -64,6 +65,7 @@
|
|||
#:use-module (gnu packages xorg)
|
||||
#:use-module (ice-9 match)
|
||||
#:export (installation-os
|
||||
make-installation-os
|
||||
a20-olinuxino-lime-installation-os
|
||||
a20-olinuxino-lime2-emmc-installation-os
|
||||
a20-olinuxino-micro-installation-os
|
||||
|
|
@ -334,10 +336,13 @@ templates under @file{/etc/configuration}.")))
|
|||
"Load the @code{uvesafb} kernel module with the right options.")
|
||||
(default-value #t)))
|
||||
|
||||
(define* (%installation-services #:key (system (or (and=>
|
||||
(%current-target-system)
|
||||
platform-target->system)
|
||||
(%current-system))))
|
||||
(define* (%installation-services
|
||||
#:key
|
||||
(system (or (and=>
|
||||
(%current-target-system)
|
||||
platform-target->system)
|
||||
(%current-system)))
|
||||
(guix-for-system (current-guix)))
|
||||
;; List of services of the installation system.
|
||||
(let ((motd (plain-file "motd" "
|
||||
\x1b[1;37mWelcome to the installation of GNU Guix!\x1b[0m
|
||||
|
|
@ -355,15 +360,6 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m
|
|||
(define bare-bones-os
|
||||
(load "examples/bare-bones.tmpl"))
|
||||
|
||||
(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)))))
|
||||
|
||||
(append
|
||||
;; Generic services
|
||||
(list (service virtual-terminal-service-type)
|
||||
|
|
@ -371,7 +367,8 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m
|
|||
(service kmscon-service-type
|
||||
(kmscon-configuration
|
||||
(virtual-terminal "tty1")
|
||||
(login-program (installer-program))))
|
||||
(login-program (installer-program
|
||||
#:guix-for-installer guix-for-system))))
|
||||
|
||||
(service login-service-type
|
||||
(login-configuration
|
||||
|
|
@ -408,13 +405,7 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m
|
|||
|
||||
;; Install and run the current Guix rather than an older
|
||||
;; snapshot.
|
||||
(guix (let ((guix (current-guix)))
|
||||
(package
|
||||
(inherit guix)
|
||||
;; Do not leak the local checkout URL.
|
||||
(source (channel
|
||||
(inherit %default-guix-channel)
|
||||
(commit (guix-package-commit guix)))))))))
|
||||
(guix guix-for-system)))
|
||||
|
||||
;; Start udev so that useful device nodes are available.
|
||||
;; Use device-mapper rules for cryptsetup & co; enable the CRDA for
|
||||
|
|
@ -525,19 +516,52 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m
|
|||
jfsutils
|
||||
xfsprogs))
|
||||
|
||||
(define installation-os
|
||||
(define* (%installation-initrd-modules
|
||||
#:key
|
||||
(system (or (and=>
|
||||
(%current-target-system)
|
||||
platform-target->system)
|
||||
(%current-system))))
|
||||
;; AArch64 currently lacks a lot of modules necessary
|
||||
;; for booting from USB sticks, hard disks or
|
||||
;; CDROMs. Those are built-in in x86_64 kernel.
|
||||
`(,@(if (target-aarch64? system)
|
||||
'("sr_mod" "sd_mod"
|
||||
"usb_common" "usbcore"
|
||||
;; USB 3.0
|
||||
"xhci_pci" "xhci_hcd"
|
||||
;; embedded USB 3.0
|
||||
"xhci_plat_hcd"
|
||||
;; USB 2.0
|
||||
"ehci_pci" "ehci_hcd")
|
||||
'())
|
||||
,@%base-initrd-modules))
|
||||
|
||||
(define* (make-installation-os #:key
|
||||
;; Version displayed in the GRUB entry name.
|
||||
(grub-displayed-version
|
||||
(package-version guix))
|
||||
;; Whether to use efi-only installation.
|
||||
;; When #f, use hybrid grub that sets up
|
||||
;; both legacy boot and efi.
|
||||
(efi-only? #f))
|
||||
;; The operating system used on installation images for USB sticks etc.
|
||||
(operating-system
|
||||
(host-name "gnu")
|
||||
(timezone "Europe/Paris")
|
||||
(locale "en_US.utf8")
|
||||
(name-service-switch %mdns-host-lookup-nss)
|
||||
(bootloader (bootloader-configuration
|
||||
(bootloader grub-bootloader)
|
||||
(targets '("/dev/sda"))))
|
||||
(label (string-append "GNU Guix installation "
|
||||
(or (getenv "GUIX_DISPLAYED_VERSION")
|
||||
(package-version guix))))
|
||||
|
||||
(initrd-modules (%installation-initrd-modules))
|
||||
|
||||
(bootloader (if efi-only?
|
||||
(bootloader-configuration
|
||||
(bootloader grub-efi-bootloader)
|
||||
(targets '("/boot/efi")))
|
||||
(bootloader-configuration
|
||||
(bootloader grub-bootloader)
|
||||
(targets '("/dev/sda")))))
|
||||
(label (string-append "GNU Guix installation " grub-displayed-version))
|
||||
|
||||
;; XXX: The AMD Radeon driver is reportedly broken, which makes kmscon
|
||||
;; non-functional:
|
||||
|
|
@ -550,19 +574,19 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m
|
|||
;; the appropriate one.
|
||||
(append %base-live-file-systems
|
||||
|
||||
;; XXX: This should be %BASE-FILE-SYSTEMS but we don't need
|
||||
;; elogind's cgroup file systems.
|
||||
(list %pseudo-terminal-file-system
|
||||
%shared-memory-file-system
|
||||
%efivars-file-system
|
||||
%immutable-store)))
|
||||
;; XXX: This should be %BASE-FILE-SYSTEMS but we don't need
|
||||
;; elogind's cgroup file systems.
|
||||
(list %pseudo-terminal-file-system
|
||||
%shared-memory-file-system
|
||||
%efivars-file-system
|
||||
%immutable-store)))
|
||||
|
||||
(users (list (user-account
|
||||
(name "guest")
|
||||
(group "users")
|
||||
(supplementary-groups '("wheel")) ; allow use of sudo
|
||||
(password "")
|
||||
(comment "Guest of GNU"))))
|
||||
(name "guest")
|
||||
(group "users")
|
||||
(supplementary-groups '("wheel")) ; allow use of sudo
|
||||
(password "")
|
||||
(comment "Guest of GNU"))))
|
||||
|
||||
(issue %issue)
|
||||
(services (%installation-services))
|
||||
|
|
@ -570,20 +594,25 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m
|
|||
;; We don't need setuid programs, except for 'passwd', which can be handy
|
||||
;; if one is to allow remote SSH login to the machine being installed.
|
||||
(privileged-programs (list (privileged-program
|
||||
(program (file-append shadow "/bin/passwd"))
|
||||
(setuid? #t))))
|
||||
(program (file-append shadow "/bin/passwd"))
|
||||
(setuid? #t))))
|
||||
|
||||
(pam-services
|
||||
;; Explicitly allow for empty passwords.
|
||||
(base-pam-services #:allow-empty-passwords? #t))
|
||||
|
||||
(packages (append
|
||||
(list glibc ; for 'tzselect' & co.
|
||||
fontconfig
|
||||
font-dejavu font-gnu-unifont
|
||||
grub) ; mostly so xrefs to its manual work
|
||||
%installer-disk-utilities
|
||||
%base-packages))))
|
||||
(list glibc ; for 'tzselect' & co.
|
||||
fontconfig
|
||||
font-dejavu font-gnu-unifont
|
||||
|
||||
;; Mostly so xrefs to its manual work.
|
||||
(bootloader-package
|
||||
(bootloader-configuration-bootloader bootloader)))
|
||||
%installer-disk-utilities
|
||||
%base-packages))))
|
||||
|
||||
(define installation-os (make-installation-os))
|
||||
|
||||
(define* (os-with-u-boot os board #:key (bootloader-target "/dev/mmcblk0")
|
||||
(triplet "arm-linux-gnueabihf"))
|
||||
|
|
|
|||
|
|
@ -366,7 +366,7 @@ FILE-SYSTEMS."
|
|||
(define virtio-modules
|
||||
;; Modules for Linux para-virtualized devices, for use in QEMU guests.
|
||||
'("virtio_pci" "virtio_balloon" "virtio_blk" "virtio_net"
|
||||
"virtio_console" "virtio-rng"))
|
||||
"virtio_console" "virtio-rng" "virtio_mmio" "virtio_scsi"))
|
||||
|
||||
`("ahci" ;for SATA controllers
|
||||
"usb-storage" "uas" ;for the installation image etc.
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue