Merge remote-tracking branch 'origin/master' into staging

With resolved conflicts in:
	gnu/packages/bittorrent.scm
	gnu/packages/databases.scm
	gnu/packages/geo.scm
	gnu/packages/gnupg.scm
	gnu/packages/gstreamer.scm
	gnu/packages/gtk.scm
	gnu/packages/linux.scm
	gnu/packages/python-xyz.scm
	gnu/packages/xorg.scm
	guix/build/qt-utils.scm

.dir-locals.el

@@ -75,6 +75,7 @@
    (eval . (put 'origin 'scheme-indent-function 0))
    (eval . (put 'build-system 'scheme-indent-function 0))
    (eval . (put 'bag 'scheme-indent-function 0))
+   (eval . (put 'gexp->derivation 'scheme-indent-function 1))
    (eval . (put 'graft 'scheme-indent-function 0))
    (eval . (put 'operating-system 'scheme-indent-function 0))
    (eval . (put 'file-system 'scheme-indent-function 0))
@@ -140,6 +141,8 @@
 
    (eval . (put 'with-paginated-output-port 'scheme-indent-function 1))
 
+   (eval . (put 'with-shepherd-action 'scheme-indent-function 3))
+
    ;; This notably allows '(' in Paredit to not insert a space when the
    ;; preceding symbol is one of these.
    (eval . (modify-syntax-entry ?~ "'"))

.gitignore

@@ -1,6 +1,7 @@
 *.eps
 *.go
 *.log
+*.mo
 *.pdf
 *.png
 *.tar.xz
@@ -73,9 +74,10 @@
 /etc/guix-daemon.service
 /etc/guix-publish.conf
 /etc/guix-publish.service
+/etc/guix-gc.service
 /etc/init.d/guix-daemon
 /etc/openrc/guix-daemon
-/guix-daemon
+/guix-*
 /guix/config.scm
 /libformat.a
 /libstore.a
@@ -93,6 +95,7 @@
 /nix/config.h
 /nix/config.h.in
 /po/doc/*.mo
+/po/doc/*.pot
 /po/guix/*.gmo
 /po/guix/*.insert-header
 /po/guix/*.mo
@@ -128,6 +131,7 @@
 /po/packages/remove-potcdate.sin
 /po/packages/stamp-po
 /pre-inst-env
+/release-*
 /scripts/guix
 /test-env
 /test-tmp
@@ -145,8 +149,9 @@ stamp-h[0-9]
 tmp
 /doc/os-config-lightweight-desktop.texi
 /nix/scripts/download
+/.tarball-version
 /.version
-/doc/stamp-[0-9]
+/doc/stamp-*
 /gnu/packages/bootstrap
 /gnu/packages/aux-files/guile-guile-launcher.o
 /guile

.guix-authorizations

@@ -23,7 +23,7 @@
    "39B3 3C8D 9448 0D2D DCC2  A498 8B44 A0CD C7B9 56F2"
    (name "bandali"))
   (;; primary: "34FF 38BC D151 25A6 E340  A0B5 3453 2F9F AFCA 8B8E"
-   "A0C5 E352 2EF8 EF5C 64CD  B7F0 FD73 CAC7 19D3 2566"
+   "A3A4 B419 0074 087C A7DE  5698 BC45 CA67 E2F8 D007"
    (name "bavier"))
   ("45CC 63B8 5258 C9D5 5F34  B239 D37D 0EA7 CECC 3912"
    (name "biscuolo"))
@@ -73,21 +73,17 @@
    (name "jlicht"))
   ("8141 6036 E81A 5CF7 8F80  1071 ECFC 8398 8B4E 4B9F"
    (name "jonsger"))
-  ("83B6 703A DCCA 3B69 4BCE  2DA6 E6A5 EE3C 1946 7A0D"
-   (name "kkebreau"))
   ("017D 74E2 7F58 5696 3801  781D F663 943E 08D8 092A"
    (name "lbraun"))
   ("CA4F 8CF4 37D7 478F DA05  5FD4 4213 7701 1A37 8446"
    (name "lbraun (professional)"))
   ("ACC2 3BA0 59F7 CCF4 08F0  43AD 442A 84B8 C70E 2F87"
-   (name "leoprikler"))
+   (name "lilyp"))
   ("45E5 75FA 53EA 8BD6 1BCE  0B4E 3ADC 75F0 13D6 78F9"
    (name "leungbk"))
   (;; primary: "4F71 6F9A 8FA2 C80E F1B5  E1BA 5E35 F231 DE1A C5E0"
    "B051 5948 F1E7 D3C1 B980  38A0 2646 FA30 BACA 7F08"
    (name "lfam"))
-  ("148B CB8B D80B FB16 B1DE  0E91 45A8 B1E8 6BCD 10A6"
-   (name "lle_bout"))
   ("8887 84C4 1459 ACCB 83E7  E84C 634C 6E89 79FA BEC2"
    (name "m1gu3l"))
   ("CBF5 9755 CBE7 E7EF EF18  3FB1 DD40 9A15 D822 469D"

.mailmap

@@ -15,6 +15,7 @@ Ben Woodcroft <donttrustben@gmail.com>
 Ben Woodcroft <donttrustben@gmail.com> <b.woodcroft@uq.edu.au>
 Ben Woodcroft <donttrustben@gmail.com> <donttrustben near gmail.com>
 Brett Gilio <brettg@gnu.org> <brettg@posteo.net>
+Christine Lemmer-Webber <cwebber@dustycloud.org>
 Claes Wallin (韋嘉誠) <claes.wallin@greatsinodevelopment.com>
 Cyprien Nicolas <cyprien@nicolas.tf> <c.nicolas+gitorious@gmail.com>
 Daniel Pimentel <d4n1@d4n1.org> <d4n1@member.fsf.org>
@@ -24,8 +25,8 @@ David Thompson <davet@gnu.org> <dthompson2@worcester.edu>
 David Thompson <davet@gnu.org> <dthompson@member.fsf.org>
 David Thompson <davet@gnu.org> <dthompson@vistahigherlearning.com>
 Deck Pickard <deck.r.pickard@gmail.com> <nebu@kipple>
-Eric Bavier <bavier@member.fsf.org> <ericbavier@gmail.com>
+Eric Bavier <bavier@posteo.net> <ericbavier@gmail.com>
-Eric Bavier <bavier@member.fsf.org> <bavier@posteo.net>
+Eric Bavier <bavier@posteo.net> <bavier@member.fsf.org>
 Eric Dvorsak <eric@dvorsak.fr> <yenda1@gmail.com>
 George Clemmer <myglc2@gmail.com>
 ison <ison@airmail.cc> <ison111@protonmail.com>
@@ -38,16 +39,21 @@ Joshua Grant <tadni@riseup.net> <gzg@riseup.net>
 Joshua Grant <tadni@riseup.net> <jgrant@parenthetical.io>
 Joshua Grant <tadni@riseup.net> <tadnimi@gmail.com>
 Joshua Grant <tadni@riseup.net> <youlysses@riseup.net>
-Kei Kebreau <kei@openmailbox.org> <kkebreau@posteo.net>
+Kei Kebreau <kkebreau@posteo.net>
 Leo Famulari <leo@famulari.name> <lfamular@gmail.com>
+Liliana Prikler <liliana.prikler@gmail.com> Leo Prikler <leo.prikler@student.tugraz.at>
 Ludovic Courtès <ludo@gnu.org> <ludovic.courtes@inria.fr>
 Marek Benc <dusxmt@gmx.com> <merkur32@gmail.com>
-Marius Bakke <mbakke@fastmail.com> <m.bakke@warwick.ac.uk>
+Marius Bakke <marius@gnu.org> <mbakke@fastmail.com>
+Marius Bakke <marius@gnu.org> <m.bakke@warwick.ac.uk>
+Marius Bakke <marius@gnu.org> <marius.bakke@usit.uio.no>
+Marius Bakke <marius@gnu.org> <mbakke@berlin.guixsd.org>
 Mathieu Lirzin <mthl@gnu.org> <mthl@openmailbox.org>
 Mathieu Lirzin <mthl@gnu.org> <mathieu.lirzin@openmailbox.org>
 Mathieu Othacehe <m.othacehe@gmail.com>
 Mathieu Othacehe <mathieu.othacehe@parrot.com>
 Mathieu Othacehe <othacehe@gnu.org>
+Matthew James Kraai <kraai@ftbfs.org>
 Nikita Karetnikov <nikita@karetnikov.org> <nikita.karetnikov@gmail.com>
 nikita <nikita@n0.is>
 nikita <nikita@n0.is> ng0 <ng0@n0.is>

Makefile.am

@@ -15,6 +15,7 @@
 # Copyright © 2018 Alex Vong <alexvong1995@gmail.com>
 # Copyright © 2019 Efraim Flashner <efraim@flashner.co.il>
 # Copyright © 2021 Chris Marusich <cmmarusich@gmail.com>
+# Copyright © 2021 Andrew Tropin <andrew@trop.in>
 #
 # This file is part of GNU Guix.
 #
@@ -141,6 +142,7 @@ MODULES =					\
   guix/build-system/go.scm			\
   guix/build-system/meson.scm			\
   guix/build-system/minify.scm			\
+  guix/build-system/minetest.scm		\
   guix/build-system/asdf.scm			\
   guix/build-system/copy.scm			\
   guix/build-system/glib-or-gtk.scm		\
@@ -203,6 +205,7 @@ MODULES =					\
   guix/build/gnu-dist.scm			\
   guix/build/guile-build-system.scm		\
   guix/build/maven-build-system.scm		\
+  guix/build/minetest-build-system.scm		\
   guix/build/node-build-system.scm		\
   guix/build/perl-build-system.scm		\
   guix/build/python-build-system.scm		\
@@ -220,6 +223,7 @@ MODULES =					\
   guix/build/linux-module-build-system.scm	\
   guix/build/store-copy.scm			\
   guix/build/json.scm				\
+  guix/build/pack.scm				\
   guix/build/utils.scm				\
   guix/build/union.scm				\
   guix/build/profiles.scm			\
@@ -248,8 +252,10 @@ MODULES =					\
   guix/import/cpan.scm				\
   guix/import/cran.scm				\
   guix/import/crate.scm				\
+  guix/import/egg.scm   			\
   guix/import/elpa.scm   			\
   guix/import/gem.scm				\
+  guix/import/git.scm                           \
   guix/import/github.scm   			\
   guix/import/gnome.scm				\
   guix/import/gnu.scm				\
@@ -258,10 +264,10 @@ MODULES =					\
   guix/import/json.scm				\
   guix/import/kde.scm				\
   guix/import/launchpad.scm   			\
+  guix/import/minetest.scm   			\
   guix/import/opam.scm				\
   guix/import/print.scm				\
   guix/import/pypi.scm				\
-  guix/import/snix.scm				\
   guix/import/stackage.scm			\
   guix/import/texlive.scm   			\
   guix/import/utils.scm				\
@@ -290,17 +296,20 @@ MODULES =					\
   guix/scripts/system.scm			\
   guix/scripts/system/search.scm		\
   guix/scripts/system/reconfigure.scm		\
+  guix/scripts/home.scm			\
+  guix/scripts/home/import.scm			\
   guix/scripts/lint.scm				\
   guix/scripts/challenge.scm			\
   guix/scripts/import/crate.scm			\
   guix/scripts/import/cran.scm			\
+  guix/scripts/import/egg.scm   		\
   guix/scripts/import/elpa.scm  		\
   guix/scripts/import/gem.scm			\
   guix/scripts/import/gnu.scm			\
   guix/scripts/import/go.scm			\
   guix/scripts/import/hackage.scm		\
   guix/scripts/import/json.scm  		\
-  guix/scripts/import/nix.scm			\
+  guix/scripts/import/minetest.scm  		\
   guix/scripts/import/opam.scm			\
   guix/scripts/import/pypi.scm			\
   guix/scripts/import/stackage.scm		\
@@ -365,10 +374,10 @@ AUX_FILES =						\
   gnu/packages/aux-files/chromium/master-preferences.json		\
   gnu/packages/aux-files/emacs/guix-emacs.el		\
   gnu/packages/aux-files/guix.vim			\
-  gnu/packages/aux-files/linux-libre/5.11-arm.conf	\
+  gnu/packages/aux-files/linux-libre/5.14-arm.conf	\
-  gnu/packages/aux-files/linux-libre/5.11-arm64.conf	\
+  gnu/packages/aux-files/linux-libre/5.14-arm64.conf	\
-  gnu/packages/aux-files/linux-libre/5.11-i686.conf	\
+  gnu/packages/aux-files/linux-libre/5.14-i686.conf	\
-  gnu/packages/aux-files/linux-libre/5.11-x86_64.conf	\
+  gnu/packages/aux-files/linux-libre/5.14-x86_64.conf	\
   gnu/packages/aux-files/linux-libre/5.10-arm.conf	\
   gnu/packages/aux-files/linux-libre/5.10-arm64.conf	\
   gnu/packages/aux-files/linux-libre/5.10-i686.conf	\
@@ -451,6 +460,7 @@ SCM_TESTS =					\
   tests/debug-link.scm				\
   tests/derivations.scm			\
   tests/discovery.scm				\
+  tests/egg.scm				\
   tests/elpa.scm				\
   tests/file-systems.scm			\
   tests/gem.scm				\
@@ -459,14 +469,15 @@ SCM_TESTS =					\
   tests/git-authenticate.scm			\
   tests/glob.scm				\
   tests/gnu-maintenance.scm			\
-  tests/go.scm					\
   tests/grafts.scm				\
   tests/graph.scm				\
   tests/gremlin.scm				\
   tests/hackage.scm				\
+  tests/import-git.scm				\
   tests/import-utils.scm			\
   tests/inferior.scm				\
   tests/lint.scm				\
+  tests/minetest.scm				\
   tests/modules.scm				\
   tests/monads.scm				\
   tests/nar.scm				\
@@ -486,10 +497,11 @@ SCM_TESTS =					\
   tests/search-paths.scm			\
   tests/services.scm				\
   tests/services/file-sharing.scm		\
+  tests/services/configuration.scm		\
   tests/services/linux.scm			\
+  tests/services/telephony.scm			\
   tests/sets.scm				\
   tests/size.scm				\
-  tests/snix.scm				\
   tests/status.scm				\
   tests/store-database.scm			\
   tests/store-deduplication.scm		\
@@ -508,6 +520,12 @@ SCM_TESTS =					\
   tests/uuid.scm				\
   tests/workers.scm
 
+if HAVE_GUILE_LIB
+SCM_TESTS += tests/go.scm
+else
+EXTRA_DIST += tests/go.scm
+endif
+
 if BUILD_DAEMON_OFFLOAD
 SCM_TESTS  += tests/offload.scm
 else
@@ -582,7 +600,8 @@ check-system: $(GOBJECTS)
 dist_pkgdata_DATA =				\
   etc/substitutes/berlin.guix.gnu.org.pub	\
   etc/substitutes/ci.guix.gnu.org.pub		\
-  etc/substitutes/ci.guix.info.pub
+  etc/substitutes/ci.guix.info.pub		\
+  etc/substitutes/bordeaux.guix.gnu.org.pub
 
 # Bash completion file.
 dist_bashcompletion_DATA = etc/completion/bash/guix	\
@@ -606,9 +625,11 @@ EXTRA_DIST +=						\
   .guix-authorizations					\
   .guix-channel						\
   scripts/guix.in					\
+  etc/disarchive-manifest.scm				\
   etc/guix-install.sh					\
   etc/news.scm						\
   etc/release-manifest.scm				\
+  etc/source-manifest.scm				\
   etc/system-tests.scm					\
   etc/historical-authorizations				\
   build-aux/build-self.scm				\
@@ -658,15 +679,53 @@ CLEANFILES =					\
 # the whole thing.  Likewise, set 'XDG_CACHE_HOME' to avoid loading possibly
 # stale files from ~/.cache/guile/ccache.
 %.go: make-go ; @:
-make-go: $(MODULES) guix/config.scm $(dist_noinst_DATA)
+make-go: make-core-go make-packages-go make-system-go make-cli-go
-	$(AM_V_at)echo "Compiling Scheme modules..." ;			\
+
-	unset GUILE_LOAD_COMPILED_PATH ;				\
+# Define a rule to build a subset of the .go files.
-	XDG_CACHE_HOME=/nowhere						\
+define guile-compilation-rule
-	host=$(host) srcdir="$(top_srcdir)"				\
+
-	$(top_builddir)/pre-inst-env					\
+$(1): $(2)
-	$(GUILE) -L "$(top_builddir)" -L "$(top_srcdir)"		\
+	$(AM_V_at)echo "Compiling Scheme modules..." ;		\
-	  --no-auto-compile 						\
+	unset GUILE_LOAD_COMPILED_PATH ;			\
-	  -s "$(top_srcdir)"/build-aux/compile-all.scm $^
+	XDG_CACHE_HOME=/nowhere					\
+	host=$(host) srcdir="$(top_srcdir)"			\
+	$(top_builddir)/pre-inst-env				\
+	$(GUILE) -L "$(top_builddir)" -L "$(top_srcdir)"	\
+	  --no-auto-compile					\
+	  -s "$(top_srcdir)"/build-aux/compile-all.scm		\
+	  --total $(words $(MODULES))				\
+	  --completed $(3)					\
+	  $$(filter %.scm,$$^)
+
+.PHONY: $(1)
+
+endef
+
+# Split compilation in several steps, each of which building a subset of
+# $(MODULES).  The main goal is to reduce peak memory consumption, as reported
+# in <https://issues.guix.gnu.org/48963>.  Each 'eval' call below creates a
+# 'make-*-go' phony target that builds the corresponding subset.
+
+MODULES_CORE     = guix.scm $(filter-out guix/scripts/%,$(filter guix/%,$(MODULES)))
+MODULES_PACKAGES = $(filter gnu/packages/%,$(MODULES))
+MODULES_SYSTEM   = gnu.scm $(filter-out gnu/packages/%,$(filter gnu/%,$(MODULES)))
+MODULES_CLI      = $(filter guix/scripts/%,$(MODULES))
+
+$(eval $(call guile-compilation-rule,make-core-go,	\
+  $(MODULES_CORE) guix/config.scm $(dist_noinst_DATA),	\
+  0))
+
+$(eval $(call guile-compilation-rule,make-packages-go,	\
+  $(MODULES_PACKAGES) make-core-go,			\
+  $(words $(MODULES_CORE))))
+
+$(eval $(call guile-compilation-rule,make-system-go,	\
+  $(MODULES_SYSTEM) make-packages-go make-core-go,	\
+  $(words $(MODULES_CORE) $(MODULES_PACKAGES))))
+
+$(eval $(call guile-compilation-rule,make-cli-go,			\
+  $(MODULES_CLI) make-system-go make-packages-go make-core-go,		\
+  $(words $(MODULES_CORE) $(MODULES_PACKAGES) $(MODULES_SYSTEM))))
 
 SUFFIXES = .go
 
@@ -733,22 +792,22 @@ AM_DISTCHECK_CONFIGURE_FLAGS =			\
   --enable-daemon				\
   ac_cv_guix_test_root="$(GUIX_TEST_ROOT)"
 
-# Name of the 'guix' package shipped in the binary tarball.
-GUIX_FOR_BINARY_TARBALL = guix
-
 # The self-contained tarball.
 guix-binary.%.tar.xz:
 	$(AM_V_GEN)GUIX_PACKAGE_PATH=					\
 	tarball=`$(top_builddir)/pre-inst-env guix pack -C xz		\
 	  --fallback							\
 	  -s "$*" --localstatedir --profile-name=current-guix		\
-	  $(GUIX_FOR_BINARY_TARBALL)` ;					\
+	  guix` ;					\
 	cp "$$tarball" "$@.tmp" ; mv "$@.tmp" "$@"
 
 
+# The dependency on doc-pot-update is to generate the .pot files, which are
+# not checked in.
+dist: doc-pot-update
+
 dist-hook: gen-ChangeLog gen-AUTHORS gen-tarball-version
 dist-hook: assert-no-store-file-names
-dist-hook: doc-po-update
 
 distcheck-hook: assert-binaries-available assert-final-inputs-self-contained
 
@@ -829,21 +888,20 @@ system_flags = $(foreach system,$(1),-s $(system))
 
 # The release process works in several phases:
 #
-#   0. We assume the developer created a 'vX.Y' tag.
+#   0. We assume the developer created a 'vX.Y.Z' tag.
 #   1. Build the source tarball.
-#   2. Update the 'guix' package so that it corresponds to the 'vX.Y' tag.
+#   2. Update the 'guix' package so that it corresponds to the 'vX.Y.Z' tag.
 #   3. Build the binary tarballs for that 'guix' package.
 #   4. Update the 'guix' package again.
-#   5. Build the installation images.  The images will run 'guix'
+#   5. Build the installation and VM images.  The images will run 'guix'
-#      corresponding to 'vX.Y' + 1 commit, and they will install 'vX.Y'.
+#      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).
 #
 # 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
+release: dist-with-updated-version all
-	cd po; git checkout .
 	@if ! git diff-index --quiet HEAD; then			\
 	  echo "There are uncommitted changes; stopping." >&2 ;	\
 	  exit 1 ;						\
@@ -851,21 +909,24 @@ release: dist-with-updated-version
 	$(MKDIR_P) "$(releasedir)"
 	rm -f "$(releasedir)"/*
 	mv $(SOURCE_TARBALLS) "$(releasedir)"
+# Bump the Guix package version and build it.
 	GUIX_ALLOW_ME_TO_USE_PRIVATE_COMMIT=yes \
 	$(top_builddir)/pre-inst-env "$(GUILE)"	\
 		$(top_srcdir)/build-aux/update-guix-package.scm	\
 	   	"`git rev-parse HEAD`" "$(PACKAGE_VERSION)"
 	git add $(top_srcdir)/gnu/packages/package-management.scm
 	git commit -m "gnu: guix: Update to $(PACKAGE_VERSION)."
-	$(top_builddir)/pre-inst-env guix build $(GUIX_FOR_BINARY_TARBALL)	\
+	$(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
+# Bump the Guix package version and build it (again).
 	GUIX_ALLOW_ME_TO_USE_PRIVATE_COMMIT=yes \
 	$(top_builddir)/pre-inst-env "$(GUILE)"	\
 		$(top_srcdir)/build-aux/update-guix-package.scm	\
@@ -875,9 +936,10 @@ release: dist-with-updated-version
 	$(top_builddir)/pre-inst-env guix build guix			\
 	      $(call system_flags,$(GUIX_SYSTEM_SUPPORTED_SYSTEMS))	\
 	      -v1 --no-grafts --fallback
+# Generate the ISO installation images.
 	for system in $(GUIX_SYSTEM_SUPPORTED_SYSTEMS) ; do				\
 	  image=`$(top_builddir)/pre-inst-env						\
-	    guix system disk-image -t iso9660                                           \
+	    guix system image -t iso9660                                           	\
 	    --label="GUIX_$${system}_$(VERSION)"					\
             --system=$$system --fallback						\
 	    gnu/system/install.scm` ;							\
@@ -885,13 +947,14 @@ release: dist-with-updated-version
 	    echo "failed to produced Guix installation image for $$system" >&2 ;	\
 	    exit 1 ;									\
 	  fi ;										\
-	  xz < "$$image" > "$(releasedir)/$(GUIX_SYSTEM_IMAGE_BASE).$$system.iso.xz.tmp" ;	\
+	  cp "$$image" "$(releasedir)/$(GUIX_SYSTEM_IMAGE_BASE).$$system.iso.tmp" ;	\
-	  mv "$(releasedir)/$(GUIX_SYSTEM_IMAGE_BASE).$$system.iso.xz.tmp"		\
+	  mv "$(releasedir)/$(GUIX_SYSTEM_IMAGE_BASE).$$system.iso.tmp"			\
-	     "$(releasedir)/$(GUIX_SYSTEM_IMAGE_BASE).$$system.iso.xz" ;		\
+	     "$(releasedir)/$(GUIX_SYSTEM_IMAGE_BASE).$$system.iso" ;			\
 	done
+# Generate the VM images.
 	for system in $(GUIX_SYSTEM_VM_SYSTEMS) ; do					\
 	  image=`$(top_builddir)/pre-inst-env						\
-	    guix system vm-image $(GUIX_SYSTEM_VM_IMAGE_FLAGS)				\
+	    guix system image -t qcow2 $(GUIX_SYSTEM_VM_IMAGE_FLAGS)			\
 	    --save-provenance								\
 	    --system=$$system --fallback						\
 	    gnu/system/examples/vm-image.tmpl` ;					\
@@ -899,9 +962,7 @@ release: dist-with-updated-version
 	    echo "failed to produced Guix VM image for $$system" >&2 ;			\
 	    exit 1 ;									\
 	  fi ;										\
-	  xz < "$$image" > "$(releasedir)/$(GUIX_SYSTEM_VM_IMAGE_BASE).$$system.xz.tmp" ;	\
+	  cp "$$image" "$(releasedir)/$(GUIX_SYSTEM_VM_IMAGE_BASE).$$system.qcow2";	\
-	  mv "$(releasedir)/$(GUIX_SYSTEM_VM_IMAGE_BASE).$$system.xz.tmp"			\
-	     "$(releasedir)/$(GUIX_SYSTEM_VM_IMAGE_BASE).$$system.xz" ;			\
 	done
 	@echo
 	@echo "Congratulations!  All the release files are now in $(releasedir)."
@@ -969,76 +1030,32 @@ cuirass-jobs: $(GOBJECTS)
 
 # Downloading up-to-date PO files.
 
-# make-download-po-rule DOMAIN DIRECTORY [FILE-NAME-PREFIX]
+WEBLATE_REPO = https://framagit.org/tyreunom/guix-translations
-define make-download-po-rule
 
-download-po.$(1):
+# Shallow clone the Git repository behind Weblate and copy files from it if
-	if [ -f "$(top_srcdir)/$(2)/LINGUAS" ]; then				\
+# they contain at least one translation, and they are well-formed (Scheme
-	  LINGUAS="`grep -v '^[[:blank:]]*#' < $(top_srcdir)/$(2)/LINGUAS`" ;	\
+# format only), warn otherwise.  Copied files are converted to a canonical
-	else									\
+# form.
-	  LINGUAS="`(cd $(top_srcdir)/$(2);					\
+download-po:
-	    for i in *.po; do echo $$$$i; done) | cut -d . -f 2`" ;		\
+	dir=$$(mktemp -d); \
-	fi ;									\
+	git clone --depth 1 "$(WEBLATE_REPO)" "$$dir/translations"; \
-	for lang in $$$$LINGUAS; do						\
+	for domain in po/doc po/guix po/packages; do \
-	  if wget -nv -O "$(top_srcdir)/$(2)/$(3)$$$$lang.po.tmp"		\
+	    for po in "$$dir/translations/$$domain"/*.po; do \
-	     "https://translate.fedoraproject.org/api/translations/guix/$(1)/$$$$lang/file/" ; \
+	        translated=$$(LANG=en_US.UTF-8 msgfmt --statistics "$$po" 2>&1 | cut -f1 -d' '); \
-	  then									\
+	        target=$$(basename "$$po"); \
-	    msgfilter --no-wrap -i "$(top_srcdir)/$(2)/$(3)$$$$lang.po.tmp"	\
+	        target="$$domain/$$target"; \
-	      cat > "$(top_srcdir)/$(2)/$(3)$$$$lang.po.tmp2" ;			\
+	        if msgfmt -c "$$po" && [ "$$translated" != "0" ]; then \
-	    rm "$(top_srcdir)/$(2)/$(3)$$$$lang.po.tmp" ;			\
+	            msgfilter --no-wrap -i "$$po" cat > "$$po".tmp; \
-	    mv "$(top_srcdir)/$(2)/$(3)$$$$lang.po"{.tmp2,} ;			\
+	            mv "$$po".tmp "$$target"; \
-	  else									\
+	            echo "copied $$target."; \
-	    rm "$(top_srcdir)/$(2)/$(3)$$$$lang.po.tmp" ;			\
+	        else \
-	  fi ;									\
+	            echo "WARN: $$target ($$translated translated messages) was not added/updated."; \
-	done
+	        fi; \
-
+	    done; \
-.PHONY: download-po.$(1)
+	done; \
-
+	rm -rf "$$dir"
-endef
-
-# Checking po files for issues.  This is useful to run after downloading new
-# po files.
-
-# make-check-po-rule DOMAIN DIRECTORY [FILE-NAME-PREFIX]
-define make-check-po-rule
-
-check-po.$(1):
-	if [ -f "$(top_srcdir)/$(2)/LINGUAS" ]; then				\
-	  LINGUAS="`grep -v '^[[:blank:]]*#' < $(top_srcdir)/$(2)/LINGUAS`" ;	\
-	else									\
-	  LINGUAS="`(cd $(top_srcdir)/$(2);					\
-	    for i in *.po; do echo $$$$i; done) | cut -d . -f 2`" ;		\
-	fi ;									\
-	for lang in $$$$LINGUAS; do						\
-	  if [ -f "$(top_srcdir)/$(2)/$(3)$$$$lang.po" ];			\
-	  then									\
-	    if ! msgfmt -c "$(top_srcdir)/$(2)/$(3)$$$$lang.po" ;		\
-		then								\
-		  exit 1 ;							\
-	    fi ;								\
-	  fi ;									\
-	done
-
-.PHONY: check-po.$(1)
-
-endef
-
-$(eval $(call make-download-po-rule,documentation-cookbook,po/doc,guix-cookbook.))
-$(eval $(call make-download-po-rule,documentation-manual,po/doc,guix-manual.))
-$(eval $(call make-download-po-rule,guix,po/guix))
-$(eval $(call make-download-po-rule,packages,po/packages))
-
-$(eval $(call make-check-po-rule,documentation-cookbook,po/doc,guix-cookbook.))
-$(eval $(call make-check-po-rule,documentation-manual,po/doc,guix-manual.))
-$(eval $(call make-check-po-rule,guix,po/guix))
-$(eval $(call make-check-po-rule,packages,po/packages))
-
-download-po: $(foreach domain,guix packages documentation-manual documentation-cookbook,download-po.$(domain))
 .PHONY: download-po
 
-check-po: $(foreach domain,guix packages documentation-manual documentation-cookbook,check-po.$(domain))
-.PHONY: check-po
-
 ## -------------- ##
 ## Silent rules.  ##
 ## -------------- ##

NEWS

@@ -2,8 +2,9 @@
 #+TITLE: Guix NEWS – history of user-visible changes
 #+STARTUP: content hidestars
 
-Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 Copyright © 2016, 2017, 2018 Ricardo Wurmus <rekado@elephly.net>
+Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 
   Copying and distribution of this file, with or without modification,
   are permitted in any medium without royalty provided the copyright
@@ -11,6 +12,156 @@ Copyright © 2016, 2017, 2018 Ricardo Wurmus <rekado@elephly.net>
 
 Please send Guix bug reports to bug-guix@gnu.org.
 
+* Changes in 1.4.0 (since 1.3.0)
+** Package management
+*** New ‘deb’ format for the ‘guix pack’ command
+*** New ‘guix import minetest’ command, to import Minetest extensions
+*** ‘guix import elpa’ now supports the non-GNU ELPA repository
+*** New updater (see ‘guix refresh’): ‘generic-git’
+*** ‘--with-commit’ option now accepts strings returned by ‘git describe’
+** Distribution
+*** The installation script can now enable local substitute servers discovery
+*** More control over boot-time file system checks and repairs
+*** XFS file systems can be created by the installer and mounted by label/UUID
+** Programming interfaces
+*** (guix records) now supports “field sanitizers”
+** Noteworthy bug fixes
+*** Fall back to Software Heritage when cloning a channel
+    (<https://issues.guix.gnu.org/44187>)
+*** ‘--with-patch’ can be used on packages with non-origin sources
+    (<https://issues.guix.gnu.org/49697>)
+*** Fix pathological profile building performance in the presence of grafts
+    (<https://issues.guix.gnu.org/49439>)
+
+* Changes in 1.3.0 (since 1.2.0)
+** Package management
+*** POWER9 (powerpc64le-linux) is now supported as a technology preview
+*** New ‘--export-manifest’ and ‘--export-channels’ options of ‘guix package’
+*** New ‘--profile’ option for ‘guix environment’
+*** New ‘--discover’ option of ‘guix-daemon’, for local substitute discovery
+*** New ‘--advertise’ option of ‘guix publish’
+*** New ‘--with-patch’ and ‘--with-latest’ package transformation options
+*** ‘guix system image’ supersedes the ‘disk-image’ and ‘vm-image’ sub-commands
+*** ‘--verbosity=1’ no longer displays download URLs
+*** ‘guix publish -C’ now supports zstd compression via Guile-zstd
+*** ‘guix-daemon’ now supports zstd substitutes, which decompress faster
+*** New ‘guix import go’ command, to import Go packages
+*** ‘guix import opam’ now supports Coq packages and has a ‘--repo’ option
+*** ‘guix import crate’ now honors semantic versioning (“semver”)
+*** ‘guix import nix’ has been removed
+*** New updaters (see ‘guix refresh’): ‘sourceforge’ and ‘generic-html’
+*** Substitute installation has been optimized
+*** ‘guix’ commands suggest alternative sub-commands or options upon typos
+*** Offloading no longer requires ‘guile’ to be in $PATH on build machines
+*** ‘GUIX_EXTENSIONS_PATH’ is honored when looking for extensions such as GWL
+*** New ‘--format’ option for ‘guix processes’
+*** ‘guix upgrade’ can now be passed several regexps
+
+** Distribution
+
+*** The Guix System demonstration VM now supports the SPICE protocol
+*** The installation script can now run in a fully automated manner
+*** ‘qemu-binfmt-service-type’ now relies on statically-linked QEMU
+*** ‘sysctl-service-type’ enables Linux protected hardlinks/symlinks by default
+*** ‘%base-services’ now includes a default ‘sysctl-service-type’ instance
+*** Linux Logical Volumne Manager (LVM) now supported, via ‘lvm-device-mapping’
+*** ‘guix system init’ has been optimized
+*** ‘guix system’ warns when users/groups appear more than once
+*** ‘guix system image -t rock64-raw’ produces images for Rock64 devices
+*** ‘herd discover guix-daemon on’ turns on substitute server discovery
+*** Default initrd now supports bcachefs
+*** CUPS service includes ‘brlaser’ extension by default
+*** “lp” group is no longer included in ‘%base-groups’
+*** New ‘--graph-backend’ option for ‘guix system {extension,shepherd}-graph’
+*** New services
+
+agate, cuirass-remote-worker, ipfs, keepalived, laminar, radicale, syncthing,
+transmission-daemon, wireguard, xorg-server
+
+*** 2009 new packages
+
+*** 3100 package updates
+
+Noteworthy updates:
+emacs 27.2, gcc-toolchain 10.3.0, ghc 8.8.3, glibc 2.31, gnome 3.34.5,
+gnupg 2.2.27, go 1.14.15, guile 3.0.5, icecat 78.10.0-guix0-preview1,
+icedtea 3.7.0, inkscape 1.0.2, julia 1.5.3, libreoffice 6.4.7.2,
+linux-libre 5.11.15, ocaml 4.11.1, octave 6.2.0, openjdk 14.0,
+python 3.8.2, racket 8.0, rust 1.51.0, r 4.0.4, sbcl 2.1.3, xfce 4.16.0,
+xorg-server 1.20.10
+
+** Programming interfaces
+
+*** New ‘channel-with-substitutes-available’ procedure in (guix channels)
+*** New modules (guix substitutes), (guix narinfo), and (guix avahi)
+*** <image> records can be passed to ‘guix system image’
+*** New (guix ipfs) module to interact with an IPFS gateway
+
+** Noteworthy bug fixes
+
+*** Risk of local privilege escalation via guix-daemon fixed
+    (<https://issues.guix.gnu.org/47229>, CVE-2021-27851)
+*** Setuid programs on Guix System are no longer setgid root
+    (<https://issues.guix.gnu.org/46395>)
+*** Risk of local privilege escalation during reconfigure fixed
+    (<https://issues.guix.gnu.org/47584>)
+*** Grafting recognizes UTF-16 and UTF-32 store references
+    (<https://issues.guix.gnu.org/33848>)
+*** (guix git) honors HTTP/HTTPS proxy settings for Git submodules
+    (<https://issues.guix.gnu.org/44593>)
+*** Fix ‘guix substitute’ crash when interleaving lzip and gzip
+    (<https://issues.guix.gnu.org/46967>)
+*** Fix GnuTLS memory corruption when used from Guile
+    (<https://issues.guix.gnu.org/46330>)
+*** Update GnuTLS to 3.6.15, addressing a time-dependent test failure
+    (<https://issues.guix.gnu.org/44559>)
+*** Booted system is fully protected from garbage collection
+    (<https://issues.guix.gnu.org/46767>)
+*** Add MSDOS disk label support on UEFI systems
+    (<https://issues.guix.gnu.org/47889>)
+*** Installer’s kmscon no longer uses up 100% CPU
+    (<https://issues.guix.gnu.org/39341>)
+*** Git checkouts can be updated to the remote’s default HEAD
+    (<https://issues.guix.gnu.org/45187>)
+*** ‘guix pull’ correctly displays early builds and downloads
+    (<https://issues.guix.gnu.org/41930>)
+*** Fix OpenRC init scripts for ‘guix-daemon’
+    (<https://issues.guix.gnu.org/46871>)
+*** Activate system when switching generations
+    (<https://issues.guix.gnu.org/38884>)
+*** ‘guix environment -C’ preserves original mount flags
+    (<https://issues.guix.gnu.org/46292>)
+*** Remove duplicates in profile transactions
+    (<https://issues.guix.gnu.org/23874>)
+*** Fix sound problems with ALSA plugins on foreign distros
+    (<https://issues.guix.gnu.org/40832>)
+
+** Native language support
+
+*** Updated translations of the manual
+
+The manual is fully translated into French and German, 90% translated into
+Spanish, and has preliminary translations into Chinese, Brazilian Portuguese,
+and Russian.
+
+*** Update translations of the cookbook
+
+The cookbook is fully translated in French and German and has a preliminary
+translation into Korean.
+
+*** Updated translations of messages
+
+This version of Guix is fully translated in French, German, and Slovak; it has
+good translation into Brazilian Portuguese and Spanish, and preliminary
+translations in a dozen other languages.
+
+*** Translations now hosted on Fedora’s Weblate instance
+
+Translations are now handled at
+<https://translate.fedoraproject.org/projects/guix/guix/> (thanks, Fedora!).
+You can join to help improve translations in your native language of messages,
+documentation, package descriptions, and the web site.
+
 * Changes in 1.2.0 (since 1.1.0)
 
 ** Package management

README

@@ -62,7 +62,7 @@ Please email <help-guix@gnu.org> for questions and <bug-guix@gnu.org> for bug
 reports; email <gnu-system-discuss@gnu.org> for general issues regarding the
 GNU system.
 
-Join #guix on irc.freenode.net.
+Join #guix on irc.libera.chat.
 
 * Guix & Nix
 

ROADMAP

@@ -23,7 +23,7 @@ There will be a few 0.x releases by then to give the new features more
 exposure and testing.
 
 You're welcome to discuss this road map on guix-devel@gnu.org or #guix on
-Freenode!
+the Libera Chat IRC network!
 
 * Features scheduled for 1.0
 

THANKS

@@ -43,7 +43,7 @@ infrastructure help:
 	     Alen Skondro <askondro@gmail.com>
               Jan Synáček <jan.synacek@gmail.com>
 	 Matthias Wachs <wachs@net.in.tum.de>
-Christopher Allan Webber <cwebber@dustycloud.org>
+        Christine Lemmer-Webber <cwebber@dustycloud.org>
            Philip Woods <elzairthesorcerer@gmail.com>
 
 GNU Guix also includes non-software works.  Thanks to the following

bootstrap

@@ -5,8 +5,7 @@ set -e -x
 
 # Generate stubs for translations.
 langs=`find po/doc -type f -name 'guix-manual*.po' \
-        | sed -e 's,guix-manual\.,,' \
+        | sed -e 's,.*/guix-manual\.,,;s,\.po$,,'`
-        | xargs -n 1 -I{} basename {} .po`
 for lang in ${langs}; do
     if [ ! -e "doc/guix.${lang}.texi" ]; then
 	echo "@setfilename guix.${lang}.info" > "doc/guix.${lang}.texi"
@@ -16,8 +15,7 @@ for lang in ${langs}; do
     fi
 done
 langs=`find po/doc -type f -name 'guix-cookbook*.po' \
-        | sed -e 's,guix-cookbook\.,,' \
+        | sed -e 's,.*/guix-cookbook\.,,;s,\.po$,,'`
-        | xargs -n 1 -I{} basename {} .po`
 for lang in ${langs}; do
     if [ ! -e "doc/guix-cookbook.${lang}.texi" ]; then
 	echo "@setfilename guix-cookbook.${lang}.info" > "doc/guix-cookbook.${lang}.texi"

build-aux/build-self.scm

@@ -250,6 +250,7 @@ interface (FFI) of Guile.")
     (match-lambda
       (('guix 'config) #f)
       (('guix 'channels) #f)
+      (('guix 'build 'download) #f)             ;autoloaded by (guix download)
       (('guix _ ...)   #t)
       (('gnu _ ...)    #t)
       (_               #f)))

build-aux/compile-all.scm

@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
-;;; Copyright © 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -98,26 +98,36 @@ to 'make'."
     (exit 1)))
 
 (match (command-line)
-  ((_ . files)
+  ((_ "--total" (= string->number grand-total)
+      "--completed" (= string->number processed)
+      . files)
+   ;; GRAND-TOTAL is the total number of .scm files in the project; PROCESSED
+   ;; is the total number of .scm files already compiled in previous
+   ;; invocations of this script.
    (catch #t
      (lambda ()
-       (compile-files srcdir (getcwd)
+       (let* ((to-build  (filter file-needs-compilation? files))
-                      (filter file-needs-compilation? files)
+              (processed (+ processed
-                      #:workers (parallel-job-count*)
+                            (- (length files) (length to-build)))))
-                      #:host host
+         (compile-files srcdir (getcwd) to-build
-                      #:report-load (lambda (file total completed)
+                        #:workers (parallel-job-count*)
-                                      (when file
+                        #:host host
-                                        (format #t "[~3d%] LOAD     ~a~%"
+                        #:report-load (lambda (file total completed)
-                                                (% (+ 1 completed) (* 2 total))
+                                        (when file
-                                                file)
+                                          (format #t "[~3d%] LOAD     ~a~%"
-                                        (force-output)))
+                                                  (% (+ 1 completed
-                      #:report-compilation (lambda (file total completed)
+                                                          (* 2 processed))
-                                             (when file
+                                                     (* 2 grand-total))
-                                               (format #t "[~3d%] GUILEC   ~a~%"
+                                                  file)
-                                                       (% (+ total completed 1)
+                                          (force-output)))
-                                                          (* 2 total))
+                        #:report-compilation (lambda (file total completed)
-                                                       (scm->go file))
+                                               (when file
-                                               (force-output)))))
+                                                 (format #t "[~3d%] GUILEC   ~a~%"
+                                                         (% (+ total completed 1
+                                                                     (* 2 processed))
+                                                            (* 2 grand-total))
+                                                         (scm->go file))
+                                                 (force-output))))))
      (lambda _
        (primitive-exit 1))
      (lambda args
@@ -132,11 +142,8 @@ to 'make'."
                             (false-if-exception
                              (module-ref ui 'report-load-error)))))
          (if report
-             ;; In Guile <= 2.2.5, 'current-load-port' was not exported.
+             (report (or (and=> (current-load-port) port-filename) "?.scm")
-             (let ((load-port ((module-ref (resolve-module '(ice-9 ports))
+                     args frame)
-                                           'current-load-port))))
-               (report (or (and=> load-port port-filename) "?.scm")
-                       args frame))
              (begin
                (print-exception (current-error-port) frame
                                 (car args) (cdr args))

build-aux/test-env.in

@@ -1,7 +1,7 @@
 #!/bin/sh
 
 # GNU Guix --- Functional package management for GNU
-# Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2021 Ludovic Courtès <ludo@gnu.org>
 #
 # This file is part of GNU Guix.
 #
@@ -91,14 +91,11 @@ then
     # Place for the substituter's cache.
     XDG_CACHE_HOME="$GUIX_STATE_DIRECTORY/cache-$$"
 
-    # For the (guix import snix) tests.
-    NIXPKGS="@NIXPKGS@"
-
     export NIX_IGNORE_SYMLINK_STORE NIX_STORE_DIR		\
 	GUIX_LOG_DIRECTORY GUIX_STATE_DIRECTORY GUIX_DATABASE_DIRECTORY	\
 	GUIX_BINARY_SUBSTITUTE_URL				\
         GUIX_ALLOW_UNAUTHENTICATED_SUBSTITUTES			\
-        GUIX_CONFIGURATION_DIRECTORY XDG_CACHE_HOME NIXPKGS
+        GUIX_CONFIGURATION_DIRECTORY XDG_CACHE_HOME
 
     # Launch the daemon without chroot support because is may be
     # unavailable, for instance if we're not running as root.

build-aux/update-NEWS.scm

@@ -95,7 +95,7 @@ paragraph."
     (with-atomic-file-replacement news-file
       (lambda (input output)
         (rewrite-org-section input output
-                             (make-regexp "^(\\*+) (.*) new packages")
+                             (make-regexp "^(\\*+).*new packages")
                              (lambda (match port)
                                (let ((stars (match:substring match 1)))
                                  (format port
@@ -141,7 +141,7 @@ paragraph."
     (with-atomic-file-replacement news-file
       (lambda (input output)
         (rewrite-org-section input output
-                             (make-regexp "^(\\*+) (.*) package updates")
+                             (make-regexp "^(\\*+).*package updates")
                              (lambda (match port)
                                (let ((stars (match:substring match 1))
                                      (lst   (map (match-lambda
@@ -166,16 +166,22 @@ paragraph."
          (string-append data-directory "/packages-"
                         version ".txt"))
 
+       (define (package<? p1 p2)
+         (string<? (package-full-name p1) (package-full-name p2)))
+
        (let-values (((previous-version new-version)
                      (call-with-input-file news-file NEWS->versions)))
          (format (current-error-port) "Updating NEWS for ~a to ~a...~%"
                  previous-version new-version)
          (let* ((old (call-with-input-file (package-file previous-version)
                        read))
-                (new (fold-packages (lambda (p r)
+                (all-packages/sorted (sort (fold-packages (lambda (p r)
-                                      (alist-cons (package-name p) (package-version p)
+                                                            (cons p r))
-                                                  r))
+                                                          '())
-                                    '())))
+                                           package<?))
+                (new (map (lambda (p)
+                            (cons (package-name p) (package-version p)))
+                          all-packages/sorted)))
            (call-with-output-file (package-file new-version)
              (lambda (port)
                (pretty-print new port)))

config-daemon.ac

@@ -117,7 +117,7 @@ if test "x$guix_build_daemon" = "xyes"; then
 
   dnl Determine the appropriate default list of substitute URLs (GnuTLS
   dnl is required so we can default to 'https'.)
-  guix_substitute_urls="https://ci.guix.gnu.org"
+  guix_substitute_urls="https://ci.guix.gnu.org https://bordeaux.guix.gnu.org"
 
   AC_MSG_CHECKING([for default substitute URLs])
   AC_MSG_RESULT([$guix_substitute_urls])

configure.ac

@@ -21,7 +21,7 @@ dnl For the C++ code.  This must be used early.
 AC_USE_SYSTEM_EXTENSIONS
 
 AM_GNU_GETTEXT([external])
-AM_GNU_GETTEXT_VERSION([0.18.1])
+AM_GNU_GETTEXT_VERSION([0.19.1])
 
 GUIX_SYSTEM_TYPE
 GUIX_ASSERT_SUPPORTED_SYSTEM
@@ -96,16 +96,12 @@ m4_pattern_forbid([^GUIX_])
 
 dnl Search for 'guile' and 'guild'.  This macro defines
 dnl 'GUILE_EFFECTIVE_VERSION'.
-GUILE_PKG([3.0 2.2])
+GUILE_PKG([3.0])
 GUILE_PROGS
 if test "x$GUILD" = "x"; then
    AC_MSG_ERROR(['guild' binary not found; please check your Guile installation.])
 fi
 
-if test "x$GUILE_EFFECTIVE_VERSION" = "x2.2"; then
-  PKG_CHECK_MODULES([GUILE], [guile-2.2 >= 2.2.6])
-fi
-
 dnl Get CFLAGS and LDFLAGS for libguile.
 GUILE_FLAGS
 
@@ -150,6 +146,13 @@ if test "x$guix_cv_have_recent_guile_git" != "xyes"; then
   AC_MSG_ERROR([A recent Guile-Git could not be found; please install it.])
 fi
 
+dnl Check for the optional Guile-Lib.
+GUILE_MODULE_EXPORTS([have_guile_lib], [(htmlprag)], [%strict-tokenizer?])
+AM_CONDITIONAL([HAVE_GUILE_LIB], [test "x$have_guile_lib" = "xyes"])
+AM_COND_IF(HAVE_GUILE_LIB,,
+  [AC_MSG_WARN([The Guile-Lib requirement was not satisfied (>= 0.2.7);
+Some features such as the Go importer will not be usable.])])
+
 dnl Check for Guile-zlib.
 GUIX_CHECK_GUILE_ZLIB
 if test "x$guix_cv_have_recent_guile_zlib" != "xyes"; then
@@ -195,23 +198,6 @@ AC_SUBST([GZIP])
 AC_SUBST([BZIP2])
 AC_SUBST([XZ])
 
-AC_ARG_WITH([nixpkgs],
-  [AS_HELP_STRING([--with-nixpkgs=DIR],
-    [search for Nixpkgs in DIR (for testing purposes only)])],
-  [case "$withval" in
-    yes|no) AC_MSG_ERROR([Please use `--with-nixpkgs=DIR'.]);;
-    *)      NIXPKGS="$withval";;
-   esac],
-  [])
-
-AC_MSG_CHECKING([for Nixpkgs source tree])
-if test -f "$NIXPKGS/default.nix"; then
-   AC_MSG_RESULT([$NIXPKGS])
-   AC_SUBST([NIXPKGS])
-else
-   AC_MSG_RESULT([not found])
-fi
-
 LIBGCRYPT_LIBDIR="no"
 LIBGCRYPT_PREFIX="no"
 

doc/build.scm

@@ -51,7 +51,16 @@
   (@@ (guix self) file-append*))
 
 (define translated-texi-manuals
-  (@@ (guix self) translate-texi-manuals))
+  (let ((translated (@@ (guix self) translate-texi-manuals)))
+    (lambda (source)
+      (let ((result (translated source)))
+        ;; Build with 'guile-3.0-latest', which is linked against
+        ;; 'libgc/disable-munmap', to avoid the dreaded "mmap(PROT_NONE)
+        ;; failed" crash: <https://bugs.gnu.org/47428>.
+        (computed-file (computed-file-name result)
+                       (computed-file-gexp result)
+                       #:options (computed-file-options result)
+                       #:guile guile-3.0-latest)))))
 
 (define info-manual
   (@@ (guix self) info-manual))
@@ -63,9 +72,9 @@
       "guix"))
 
 (define %languages
-  ;; The cookbook is currently only translated into German.
+  ;; The cookbook is not translated in the same languages as the manual
   (if (string=? %manual "guix-cookbook")
-      '("de" "en")
+      '("de" "en" "fr")
       '("de" "en" "es" "fr" "ru" "zh_CN")))
 
 (define (texinfo-manual-images source)
@@ -948,7 +957,7 @@ from SOURCE."
                   (div
                    (ul
                     (li (a (@ (href "html_node"))
-                           "HTML, with one page per node"))
+                           "HTML, with a separate page per node"))
                     (li (a (@ (href
                                ,(string-append
                                  #$manual

doc/contributing.texi

@@ -3,7 +3,7 @@
 
 This project is a cooperative effort, and we need your help to make it
 grow!  Please get in touch with us on @email{guix-devel@@gnu.org} and
-@code{#guix} on the Freenode IRC network.  We welcome ideas, bug
+@code{#guix} on the Libera Chat IRC network.  We welcome ideas, bug
 reports, patches, and anything that may be helpful to the project.  We
 particularly welcome help on packaging (@pxref{Packaging Guidelines}).
 
@@ -26,9 +26,10 @@ choice.
 * Packaging Guidelines::        Growing the distribution.
 * Coding Style::                Hygiene of the contributor.
 * Submitting Patches::          Share your work.
-* Tracking Bugs and Patches::   Using Debbugs.
+* Tracking Bugs and Patches::   Keeping it all organized.
 * Commit Access::               Pushing to the official repository.
 * Updating the Guix Package::   Updating the Guix package definition.
+* Translating Guix::            Make Guix speak your native language.
 @end menu
 
 @node Building from Git
@@ -241,7 +242,7 @@ Manual}).  First, you need more than an editor, you need
 wonderful @url{https://nongnu.org/geiser/, Geiser}.  To set that up, run:
 
 @example
-guix package -i emacs guile emacs-geiser
+guix package -i emacs guile emacs-geiser emacs-geiser-guile
 @end example
 
 Geiser allows for interactive and incremental development from within
@@ -375,12 +376,12 @@ Once your package builds correctly, please send us a patch
 (@pxref{Submitting Patches}).  Well, if you need help, we will be happy to
 help you too.  Once the patch is committed in the Guix repository, the
 new package automatically gets built on the supported platforms by
-@url{@value{SUBSTITUTE-URL}, our continuous integration system}.
+@url{https://@value{SUBSTITUTE-SERVER-1}, our continuous integration system}.
 
 @cindex substituter
 Users can obtain the new package definition simply by running
 @command{guix pull} (@pxref{Invoking guix pull}).  When
-@code{@value{SUBSTITUTE-SERVER}} is done building the package, installing the
+@code{@value{SUBSTITUTE-SERVER-1}} is done building the package, installing the
 package automatically downloads binaries from there
 (@pxref{Substitutes}).  The only place where human intervention is
 needed is to review and apply the patch.
@@ -531,9 +532,11 @@ It is a good idea to strip commit identifiers in the @code{version}
 field to, say, 7 digits.  It avoids an aesthetic annoyance (assuming
 aesthetics have a role to play here) as well as problems related to OS
 limits such as the maximum shebang length (127 bytes for the Linux
-kernel).  It is best to use the full commit identifiers in
+kernel).  There are helper functions for doing this for packages using
-@code{origin}s, though, to avoid ambiguities.  A typical package
+@code{git-fetch} or @code{hg-fetch} (see below).  It is best to use the
-definition may look like this:
+full commit identifiers in @code{origin}s, though, to avoid ambiguities.
+A typical package definition may look like this:
+
 
 @lisp
 (define my-package
@@ -552,6 +555,20 @@ definition may look like this:
       )))
 @end lisp
 
+@deffn {Scheme Procedure} git-version @var{VERSION} @var{REVISION} @var{COMMIT}
+Return the version string for packages using @code{git-fetch}.
+
+@lisp
+(git-version "0.2.3" "0" "93818c936ee7e2f1ba1b315578bde363a7d43d05")
+@result{} "0.2.3-0.93818c9"
+@end lisp
+@end deffn
+
+@deffn {Scheme Procedure} hg-version @var{VERSION} @var{REVISION} @var{CHANGESET}
+Return the version string for packages using @code{hg-fetch}.  It works
+in the same way as @code{git-version}.
+@end deffn
+
 @node Synopses and Descriptions
 @subsection Synopses and Descriptions
 
@@ -994,6 +1011,12 @@ Before submitting a patch that adds or modifies a package definition,
 please run through this check list:
 
 @enumerate
+@cindex @code{git format-patch}
+@cindex @code{git-format-patch}
+@item
+We recommend to use the command @code{git format-patch --base} to
+include the commit where your patch applies.
+
 @item
 If the authors of the packaged software provide a cryptographic
 signature for the release tarball, make an effort to verify the
@@ -1017,20 +1040,21 @@ Make sure the package builds on your platform, using @code{guix build
 We recommend you also try building the package on other supported
 platforms.  As you may not have access to actual hardware platforms, we
 recommend using the @code{qemu-binfmt-service-type} to emulate them.  In
-order to enable it, add the following service to the list of services in
+order to enable it, add the @code{virtualization} service module and the
-your @code{operating-system} configuration:
+following service to the list of services in your @code{operating-system}
+configuration:
 
 @lisp
 (service qemu-binfmt-service-type
  (qemu-binfmt-configuration
-   (platforms (lookup-qemu-platforms "arm" "aarch64"))
+   (platforms (lookup-qemu-platforms "arm" "aarch64"))))
 @end lisp
 
 Then reconfigure your system.
 
 You can then build packages for different platforms by specifying the
 @code{--system} option.  For example, to build the "hello" package for
-the armhf, aarch64, or mips64 architectures, you would run the following
+the armhf or aarch64 architectures, you would run the following
 commands, respectively:
 @example
 guix build --system=armhf-linux --rounds=2 hello
@@ -1061,7 +1085,7 @@ and which optional dependencies should be used.  In particular, avoid adding
 the @code{texlive-tiny} package or @code{texlive-union} procedure instead.
 
 @item
-For important changes, check that dependent package (if applicable) are
+For important changes, check that dependent packages (if applicable) are
 not affected by the change; @code{guix refresh --list-dependent
 @var{package}} will help you do that (@pxref{Invoking guix refresh}).
 
@@ -1079,15 +1103,17 @@ rebuilding induced, commits go to different branches, along these lines:
 @code{staging} branch (non-disruptive changes).  This branch is intended
 to be merged in @code{master} every 6 weeks or so.  Topical changes
 (e.g., an update of the GNOME stack) can instead go to a specific branch
-(say, @code{gnome-updates}).
+(say, @code{gnome-updates}).  This branch is not expected to be
+buildable or usable until late in its development process.
 
 @item more than 1,800 dependent packages
 @code{core-updates} branch (may include major and potentially disruptive
 changes).  This branch is intended to be merged in @code{master} every
-6 months or so.
+6 months or so.  This branch is not expected to be buildable or usable
+until late in its development process.
 @end table
 
-All these branches are @uref{@value{SUBSTITUTE-URL},
+All these branches are @uref{https://@value{SUBSTITUTE-SERVER-1},
 tracked by our build farm} and merged into @code{master} once
 everything has been successfully built.  This allows us to fix issues
 before they hit users, and to reduce the window during which pre-built
@@ -1121,7 +1147,7 @@ as timestamps or randomly-generated output in the build result.
 
 Another option is to use @command{guix challenge} (@pxref{Invoking guix
 challenge}).  You may run it once the package has been committed and
-built by @code{@value{SUBSTITUTE-SERVER}} to check whether it obtains the same
+built by @code{@value{SUBSTITUTE-SERVER-1}} to check whether it obtains the same
 result as you did.  Better yet: Find another machine that can build it
 and run @command{guix publish}.  Since the remote build machine is
 likely different from yours, this can catch non-determinism issues
@@ -1177,6 +1203,11 @@ MIME attachments.  You are advised to pay attention if your email client
 changes anything like line breaks or indentation which could potentially
 break the patches.
 
+Expect some delay when you submit your very first patch to
+@email{guix-patches@@gnu.org}. You have to wait until you get an
+acknowledgement with the assigned tracking number. Future acknowledgements
+should not be delayed.
+
 When a bug is resolved, please close the thread by sending an email to
 @email{@var{NNN}-done@@debbugs.gnu.org}.
 
@@ -1198,6 +1229,18 @@ for more information.  You can install @command{git send-email} with
 @node Tracking Bugs and Patches
 @section Tracking Bugs and Patches
 
+This section describes how the Guix project tracks its bug reports and
+patch submissions.
+
+@menu
+* The Issue Tracker::           The official bug and patch tracker.
+* Debbugs User Interfaces::     Ways to interact with Debbugs.
+* Debbugs Usertags::            Tag reports with custom labels.
+@end menu
+
+@node The Issue Tracker
+@subsection The Issue Tracker
+
 @cindex bug reports, tracking
 @cindex patch submissions, tracking
 @cindex issue tracking
@@ -1209,6 +1252,9 @@ email to @email{bug-guix@@gnu.org}, while patch submissions are filed
 against the @code{guix-patches} package by sending email to
 @email{guix-patches@@gnu.org} (@pxref{Submitting Patches}).
 
+@node Debbugs User Interfaces
+@subsection Debbugs User Interfaces
+
 A web interface (actually @emph{two} web interfaces!) are available to
 browse issues:
 
@@ -1246,12 +1292,72 @@ For example, to list all open issues on @code{guix-patches}, hit:
 @xref{Top,,, debbugs-ug, Debbugs User Guide}, for more information on
 this nifty tool!
 
+@node Debbugs Usertags
+@subsection Debbugs Usertags
+
+@cindex usertags, for debbugs
+@cindex Debbugs usertags
+Debbugs provides a feature called @dfn{usertags} that allows any user to
+tag any bug with an arbitrary label.  Bugs can be searched by usertag,
+so this is a handy way to organize bugs@footnote{The list of usertags is
+public information, and anyone can modify any user's list of usertags,
+so keep that in mind if you choose to use this feature.}.
+
+For example, to view all the bug reports (or patches, in the case of
+@code{guix-patches}) tagged with the usertag @code{powerpc64le-linux}
+for the user @code{guix}, open a URL like the following in a web
+browser:
+@url{https://debbugs.gnu.org/cgi-bin/pkgreport.cgi?tag=powerpc64le-linux;users=guix}.
+
+For more information on how to use usertags, please refer to the
+documentation for Debbugs or the documentation for whatever tool you use
+to interact with Debbugs.
+
+In Guix, we are experimenting with usertags to keep track of
+architecture-specific issues.  To facilitate collaboration, all our
+usertags are associated with the single user @code{guix}.  The following
+usertags currently exist for that user:
+
+@table @code
+
+@item powerpc64le-linux
+The purpose of this usertag is to make it easy to find the issues that
+matter most for the @code{powerpc64le-linux} system type.  Please assign
+this usertag to bugs or patches that affect @code{powerpc64le-linux} but
+not other system types.  In addition, you may use it to identify issues
+that for some reason are particularly important for the
+@code{powerpc64le-linux} system type, even if the issue affects other
+system types, too.
+
+@item reproducibility
+For issues related to reproducibility.  For example, it would be
+appropriate to assign this usertag to a bug report for a package that
+fails to build reproducibly.
+
+@end table
+
+If you're a committer and you want to add a usertag, just start using it
+with the @code{guix} user.  If the usertag proves useful to you,
+consider updating this section of the manual so that others will know
+what your usertag means.
+
 @node Commit Access
 @section Commit Access
 
 @cindex commit access, for developers
-For frequent contributors, having write access to the repository is
+Everyone can contribute to Guix without having commit access
-convenient.  When you deem it necessary, consider applying for commit
+(@pxref{Submitting Patches}).  However, for frequent contributors,
+having write access to the repository can be convenient.  Commit access
+should not be thought of as a ``badge of honor'' but rather as a
+responsibility a contributor is willing to take to help the project.
+
+The following sections explain how to get commit access, how to be ready
+to push commits, and the policies and community expectations for commits
+pushed upstream.
+
+@subsection Applying for Commit Access
+
+When you deem it necessary, consider applying for commit
 access by following these steps:
 
 @enumerate
@@ -1323,6 +1429,29 @@ review and merging system, which, as a consequence, may lead us to have
 fewer people with commit access to the main repository.  Stay tuned!
 @end quotation
 
+All commits that are pushed to the central repository on Savannah must
+be signed with an OpenPGP key, and the public key should be uploaded to
+your user account on Savannah and to public key servers, such as
+@code{keys.openpgp.org}.  To configure Git to automatically sign
+commits, run:
+
+@example
+git config commit.gpgsign true
+
+# Substitute the fingerprint of your public PGP key.
+git config user.signingkey CABBA6EA1DC0FF33
+@end example
+
+You can prevent yourself from accidentally pushing unsigned commits to
+Savannah by using the pre-push Git hook located at
+@file{etc/git/pre-push}:
+
+@example
+cp etc/git/pre-push .git/hooks/pre-push
+@end example
+
+@subsection Commit Policy
+
 If you get commit access, please make sure to follow
 the policy below (discussions of the policy can take place on
 @email{guix-devel@@gnu.org}).
@@ -1341,25 +1470,6 @@ mailing list for commit notifications (@email{guix-commits@@gnu.org}),
 so people can notice.  Before pushing your changes, make sure to run
 @code{git pull --rebase}.
 
-All commits that are pushed to the central repository on Savannah must
-be signed with an OpenPGP key, and the public key should be uploaded to
-your user account on Savannah and to public key servers, such as
-@code{keys.openpgp.org}.  To configure Git to automatically sign
-commits, run:
-
-@example
-git config commit.gpgsign true
-git config user.signingkey CABBA6EA1DC0FF33
-@end example
-
-You can prevent yourself from accidentally pushing unsigned commits to
-Savannah by using the pre-push Git hook called located at
-@file{etc/git/pre-push}:
-
-@example
-cp etc/git/pre-push .git/hooks/pre-push
-@end example
-
 When pushing a commit on behalf of somebody else, please add a
 @code{Signed-off-by} line at the end of the commit log message---e.g.,
 with @command{git am --signoff}.  This improves tracking of who did
@@ -1381,12 +1491,76 @@ you're confident, it's OK to commit.
 That last part is subject to being adjusted, allowing individuals to commit
 directly on non-controversial changes on parts they’re familiar with.
 
+@subsection Addressing Issues
+
+Peer review (@pxref{Submitting Patches}) and tools such as
+@command{guix lint} (@pxref{Invoking guix lint}) and the test suite
+(@pxref{Running the Test Suite}) should catch issues before they are
+pushed.  Yet, commits that ``break'' functionality might occasionally
+go through.  When that happens, there are two priorities: mitigating
+the impact, and understanding what happened to reduce the chance of
+similar incidents in the future.  The responsibility for both these
+things primarily lies with those involved, but like everything this is
+a group effort.
+
+Some issues can directly affect all users---for instance because they
+make @command{guix pull} fail or break core functionality, because they
+break major packages (at build time or run time), or because they
+introduce known security vulnerabilities.
+
+@cindex reverting commits
+The people involved in authoring, reviewing, and pushing such
+commit(s) should be at the forefront to mitigate their impact in a
+timely fashion: by pushing a followup commit to fix it (if possible),
+or by reverting it to leave time to come up with a proper fix, and by
+communicating with other developers about the problem.
+
+If these persons are unavailable to address the issue in time, other
+committers are entitled to revert the commit(s), explaining in the
+commit log and on the mailing list what the problem was, with the goal
+of leaving time to the original committer, reviewer(s), and author(s)
+to propose a way forward.
+
+Once the problem has been dealt with, it is the responsibility of
+those involved to make sure the situation is understood.  If you are
+working to understand what happened, focus on gathering information
+and avoid assigning any blame.  Do ask those involved to describe what
+happened, do not ask them to explain the situation---this would
+implicitly blame them, which is unhelpful.  Accountability comes from
+a consensus about the problem, learning from it and improving
+processes so that it's less likely to reoccur.
+
+@subsection Commit Revocation
+
 In order to reduce the possibility of mistakes, committers will have
 their Savannah account removed from the Guix Savannah project and their
 key removed from @file{.guix-authorizations} after 12 months of
 inactivity; they can ask to regain commit access by emailing the
 maintainers, without going through the vouching process.
 
+Maintainers@footnote{See @uref{https://guix.gnu.org/en/about} for the
+current list of maintainers.  You can email them privately at
+@email{guix-maintainers@@gnu.org}.} may also revoke an individual's
+commit rights, as a last resort, if cooperation with the rest of the
+community has caused too much friction---even within the bounds of the
+project's code of conduct (@pxref{Contributing}).  They would only do so
+after public or private discussion with the individual and a clear
+notice.  Examples of behavior that hinders cooperation and could lead to
+such a decision include:
+
+@itemize
+@item repeated violation of the commit policy stated above;
+@item repeated failure to take peer criticism into account;
+@item breaching trust through a series of grave incidents.
+@end itemize
+
+When maintainers resort to such a decision, they notify developers on
+@email{guix-devel@@gnu.org}; inquiries may be sent to
+@email{guix-maintainers@@gnu.org}.  Depending on the situation, the
+individual may still be welcome to contribute.
+
+@subsection Helping Out
+
 One last thing: the project keeps moving forward because committers not
 only push their own awesome changes, but also offer some of their time
 @emph{reviewing} and pushing other people's changes.  As a committer,
@@ -1429,3 +1603,266 @@ This check can be disabled, @emph{at your own peril}, by setting the
 @code{GUIX_ALLOW_ME_TO_USE_PRIVATE_COMMIT} environment variable.  When
 this variable is set, the updated package source is also added to the
 store.  This is used as part of the release process of Guix.
+
+@cindex translation
+@cindex l10n
+@cindex i18n
+@cindex native language support
+@node Translating Guix
+@section Translating Guix
+
+Writing code and packages is not the only way to provide a meaningful
+contribution to Guix.  Translating to a language you speak is another
+example of a valuable contribution you can make.  This section is designed
+to describe the translation process.  It gives you advice on how you can
+get involved, what can be translated, what mistakes you should avoid and
+what we can do to help you!
+
+Guix is a big project that has multiple components that can be translated.
+We coordinate the translation effort on a
+@uref{https://translate.fedoraproject.org/projects/guix/,Weblate instance}
+hosted by our friends at Fedora.  You will need an account to submit
+translations.
+
+Some of the software packaged in Guix also contain translations.  We do not
+host a translation platform for them.  If you want to translate a package
+provided by Guix, you should contact their developers or find the information
+on their website.  As an example, you can find the homepage of the
+@code{hello} package by typing @code{guix show hello}.  On the ``homepage''
+line, you will see @url{https://www.gnu.org/software/hello/} as the homepage.
+
+Many GNU and non-GNU packages can be translated on the
+@uref{https://translationproject.org,Translation Project}.  Some projects
+with multiple components have their own platform.  For instance, GNOME has
+its own platform, @uref{https://l10n.gnome.org/,Damned Lies}.
+
+Guix has five components hosted on Weblate.
+
+@itemize
+@item @code{guix} contains all the strings from the Guix software (the
+      guided system installer, the package manager, etc), excluding packages.
+@item @code{packages} contains the synopsis (single-sentence description
+      of a package) and description (longer description) of packages in Guix.
+@item @code{website} contains the official Guix website, except for
+      blog posts and multimedia content.
+@item @code{documentation-manual} corresponds to this manual.
+@item @code{documentation-cookbook} is the component for the cookbook.
+@end itemize
+
+@subsubheading General Directions
+
+Once you get an account, you should be able to select a component from
+@uref{https://translate.fedoraproject.org/projects/guix/,the guix project},
+and select a language.  If your language does not appear in the list, go
+to the bottom and click on the ``Start new translation'' button.  Select
+the language you want to translate to from the list, to start your new
+translation.
+
+Like lots of other free software packages, Guix uses
+@uref{https://www.gnu.org/software/gettext,GNU Gettext} for its translations,
+with which translatable strings are extracted from the source code to so-called
+PO files.
+
+Even though PO files are text files, changes should not be made with a text
+editor but with PO editing software.  Weblate integrates PO editing
+functionality.  Alternatively, translators can use any of various
+free-software tools for filling in translations, of which
+@uref{https://poedit.net/,Poedit} is one example, and (after logging in)
+@uref{https://docs.weblate.org/en/latest/user/files.html,upload} the changed
+file.  There is also a special
+@uref{https://www.emacswiki.org/emacs/PoMode,PO editing mode} for users of GNU
+Emacs.  Over time translators find out what software they are happy with and
+what features they need.
+
+On Weblate, you will find various links to the editor, that will show various
+subsets (or all) of the strings.  Have a look around and at the
+@uref{https://docs.weblate.org/en/latest/,documentation} to familiarize
+yourself with the platform.
+
+@subsubheading Translation Components
+
+In this section, we provide more detailed guidance on the translation
+process, as well as details on what you should or should not do.  When in
+doubt, please contact us, we will be happy to help!
+
+@table @asis
+@item guix
+Guix is written in the Guile programming language, and some strings contain
+special formatting that is interpreted by Guile.  These special formatting
+should be highlighted by Weblate.  They start with @code{~} followed by one
+or more characters.
+
+When printing the string, Guile replaces the special formatting symbols with
+actual values.  For instance, the string @samp{ambiguous package specification
+`~a'} would be substituted to contain said package specification instead of
+@code{~a}.  To properly translate this string, you must keep the formatting
+code in your translation, although you can place it where it makes sense in
+your language.  For instance, the French translation says @samp{spécification
+du paquet « ~a » ambiguë} because the adjective needs to be placed in the
+end of the sentence.
+
+If there are multiple formatting symbols, make sure to respect the order.
+Guile does not know in which order you intended the string to be read, so it
+will substitute the symbols in the same order as the English sentence.
+
+As an example, you cannot translate @samp{package '~a' has been superseded by
+'~a'} by @samp{'~a' superseeds package '~a'}, because the meaning would be
+reversed.  If @var{foo} is superseded by @var{bar}, the translation would read
+@samp{'foo' superseeds package 'bar'}.  To work around this problem, it
+is possible to use more advanced formatting to select a given piece of data,
+instead of following the default English order.  @xref{Formatted Output,,,
+guile, GNU Guile Reference Manual}, for more information on formatting in Guile.
+
+@item packages
+
+Package descriptions occasionally contain Texinfo markup (@pxref{Synopses
+and Descriptions}).   Texinfo markup looks like @samp{@@code@{rm -rf@}},
+@samp{@@emph@{important@}}, etc.  When translating, please leave markup as is.
+
+The characters after ``@@'' form the name of the markup, and the text between
+``@{'' and ``@}'' is its content.  In general, you should not translate the
+content of markup like @code{@@code}, as it contains literal code that do not
+change with language.  You can translate the content of formatting markup such
+as @code{@@emph}, @code{@@i}, @code{@@itemize}, @code{@@item}.  However, do
+not translate the name of the markup, or it will not be recognized.  Do
+not translate the word after @code{@@end}, it is the name of the markup that
+is closed at this position (e.g.@: @code{@@itemize ... @@end itemize}).
+
+@item documentation-manual and documentation-cookbook
+
+The first step to ensure a successful translation of the manual is to find
+and translate the following strings @emph{first}:
+
+@itemize
+@item @code{version.texi}: Translate this string as @code{version-xx.texi},
+      where @code{xx} is your language code (the one shown in the URL on
+      weblate).
+@item @code{contributing.texi}: Translate this string as
+      @code{contributing.xx.texi}, where @code{xx} is the same language code.
+@item @code{Top}: Do not translate this string, it is important for Texinfo.
+      If you translate it, the document will be empty (missing a Top node).
+      Please look for it, and register @code{Top} as its translation.
+@end itemize
+
+Translating these strings first ensure we can include your translation in
+the guix repository without breaking the make process or the
+@command{guix pull} machinery.
+
+The manual and the cookbook both use Texinfo.  As for @code{packages}, please
+keep Texinfo markup as is.  There are more possible markup types in the manual
+than in the package descriptions.  In general, do not translate the content
+of @code{@@code}, @code{@@file}, @code{@@var}, @code{@@value}, etc.  You
+should translate the content of formatting markup such as @code{@@emph},
+@code{@@i}, etc.
+
+The manual contains sections that can be referred to by name by @code{@@ref},
+@code{@@xref} and @code{@@pxref}.  We have a mechanism in place so you do
+not have to translate their content.  If you keep the English title, we will
+automatically replace it with your translation of that title.  This ensures
+that Texinfo will always be able to find the node. If you decide to change
+the translation of the title, the references will automatically be updated
+and you will not have to update them all yourself.
+
+When translating references from the cookbook to the manual, you need to
+replace the name of the manual and the name of the section.  For instance,
+to translate @code{@@pxref@{Defining Packages,,, guix, GNU Guix Reference
+Manual@}}, you would replace @code{Defining Packages} with the title of that
+section in the translated manual @emph{only} if that title is translated.
+If the title is not translated in your language yet, do not translate it here,
+or the link will be broken.  Replace @code{guix} with @code{guix.xx} where
+@code{xx} is your language code.  @code{GNU Guix Reference Manual} is the
+text of the link.  You can translate it however you wish.
+
+@item website
+
+The website pages are written using SXML, an s-expression version of HTML,
+the basic language of the web.  We have a process to extract translatable
+strings from the source, and replace complex s-expressions with a more familiar
+XML markup, where each markup is numbered.  Translators can arbitrarily change
+the ordering, as in the following example.
+
+@example
+#. TRANSLATORS: Defining Packages is a section name
+#. in the English (en) manual.
+#: apps/base/templates/about.scm:64
+msgid "Packages are <1>defined<1.1>en</1.1><1.2>Defining-Packages.html</1.2></1> as native <2>Guile</2> modules."
+msgstr "Pakete werden als reine <2>Guile</2>-Module <1>definiert<1.1>de</1.1><1.2>Pakete-definieren.html</1.2></1>."
+@end example
+
+Note that you need to include the same markups.  You cannot skip any.
+@end table
+
+In case you make a mistake, the component might fail to build properly with your
+language, or even make guix pull fail.  To prevent that, we have a process
+in place to check the content of the files before pushing to our repository.
+We will not be able to update the translation for your language in Guix, so
+we will notify you (through weblate and/or by email) so you get a chance to
+fix the issue.
+
+@subsubheading Outside of Weblate
+
+Currently, some parts of Guix cannot be translated on Weblate, help wanted!
+
+@itemize
+@item @command{guix pull} news can be translated in @file{news.scm}, but is not
+      available from Weblate.  If you want to provide a translation, you
+      can prepare a patch as described above, or simply send us your
+      translation with the name of the news entry you translated and your
+      language. @xref{Writing Channel News}, for more information about
+      channel news.
+@item Guix blog posts cannot currently be translated.
+@item The installer script (for foreign distributions) is entirely in English.
+@item Some of the libraries Guix uses cannot be translated or are translated
+      outside of the Guix project.  Guile itself is not internationalized.
+@item Other manuals linked from this manual or the cookbook might not be
+      translated.
+@end itemize
+
+@subsubheading Translation Infrastructure
+
+Weblate is backed by a git repository from which it discovers new strings to
+translate and pushes new and updated translations.  Normally, it would be
+enough to give it commit access to our repositories.  However, we decided
+to use a separate repository for two reasons.  First, we would have to give
+Weblate commit access and authorize its signing key, but we do not trust it
+in the same way we trust guix developers, especially since we do not manage
+the instance ourselves.  Second, if translators mess something up, it can
+break the generation of the website and/or guix pull for all our users,
+independently of their language.
+
+For these reasons, we use a dedicated repository to host translations, and we
+synchronize it with our guix and artworks repositories after checking no issue
+was introduced in the translation.
+
+Developers can download the latest PO files from weblate in the Guix
+repository by running the @command{make download-po} command.  It will
+automatically download the latest files from weblate, reformat them to a
+canonical form, and check they do not contain issues.  The manual needs to be
+built again to check for additional issues that might crash Texinfo.
+
+Before pushing new translation files, developers should add them to the
+make machinery so the translations are actually available.  The process
+differs for the various components.
+
+@itemize
+@item New po files for the @code{guix} and @code{packages} components must
+      be registered by adding the new language to @file{po/guix/LINGUAS} or
+      @file{po/packages/LINGUAS}.
+@item New po files for the @code{documentation-manual} component must be
+      registered by adding the file name to @code{DOC_PO_FILES} in
+      @file{po/doc/local.mk}, the generated @file{%D%/guix.xx.texi} manual to
+      @code{info_TEXINFOS} in @file{doc/local.mk} and the generated
+      @file{%D%/guix.xx.texi} and @file{%D%/contributing.xx.texi} to
+      @code{TRANSLATED_INFO} also in @file{doc/local.mk}.
+@item New po files for the @code{documentation-cookbook} component must be
+      registered by adding the file name to @code{DOC_COOKBOOK_PO_FILES} in
+      @file{po/doc/local.mk}, the generated @file{%D%/guix-cookbook.xx.texi}
+      manual to @code{info_TEXINFOS} in @file{doc/local.mk} and the generated
+      @file{%D%/guix-cookbook.xx.texi} to @code{TRANSLATED_INFO} also
+      in @file{doc/local.mk}.
+@item New po files for the @code{website} component must be added to the
+      @code{guix-artwork} repository, in @file{website/po/}.
+      @file{website/po/LINGUAS} and @file{website/po/ietf-tags.scm} must
+      be updated accordingly (see @file{website/i18n-howto.txt} for more
+      information on the process).
+@end itemize

doc/guix-cookbook.texi

@@ -16,7 +16,8 @@ Copyright @copyright{} 2020 Matthew Brooks@*
 Copyright @copyright{} 2020 Marcin Karpezo@*
 Copyright @copyright{} 2020 Brice Waegeneire@*
 Copyright @copyright{} 2020 André Batista@*
-Copyright @copyright{} 2020 Christopher Lemmer Webber
+Copyright @copyright{} 2020 Christine Lemmer-Webber@*
+Copyright @copyright{} 2021 Joshua Branson@*
 
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -85,8 +86,8 @@ Packaging
 
 System Configuration
 
-* Customizing the Kernel::      Creating and using a custom Linux kernel
+* Auto-Login to a Specific TTY:: Automatically Login a User to a Specific TTY
-
+* Customizing the Kernel::       Creating and using a custom Linux kernel on Guix System.
 
 @end detailmenu
 @end menu
@@ -590,7 +591,7 @@ packages.
 Guix makes it possible to streamline the process by adding as many ``package
 declaration directories'' as you want.
 
-Create a directory, say @file{~./guix-packages} and add it to the @samp{GUIX_PACKAGE_PATH}
+Create a directory, say @file{~/guix-packages} and add it to the @samp{GUIX_PACKAGE_PATH}
 environment variable:
 
 @example
@@ -1353,6 +1354,7 @@ chapter is to demonstrate some advanced configuration concepts.
 reference.
 
 @menu
+* Auto-Login to a Specific TTY:: Automatically Login a User to a Specific TTY
 * Customizing the Kernel::       Creating and using a custom Linux kernel on Guix System.
 * Guix System Image API::        Customizing images to target specific platforms.
 * Connecting to Wireguard VPN::  Connecting to a Wireguard VPN.
@@ -1363,6 +1365,51 @@ reference.
 * Setting up NGINX with Lua:: Configuring NGINX web-server to load Lua modules.
 @end menu
 
+@node Auto-Login to a Specific TTY
+@section Auto-Login to a Specific TTY
+
+While the Guix manual explains auto-login one user to @emph{all} TTYs (
+@pxref{auto-login to TTY,,, guix, GNU Guix Reference Manual}), some
+might prefer a situation, in which one user is logged into one TTY with
+the other TTYs either configured to login different users or no one at
+all.  Note that one can auto-login one user to any TTY, but it is
+usually advisable to avoid @code{tty1}, which, by default, is used to
+log warnings and errors.
+
+Here is how one might set up auto login for one user to one tty:
+
+@lisp
+(define (auto-login-to-tty config tty user)
+  (if (string=? tty (mingetty-configuration-tty config))
+        (mingetty-configuration
+         (inherit config)
+         (auto-login user))
+        config))
+
+(define %my-services
+  (modify-services %base-services
+    ;; @dots{}
+    (mingetty-service-type config =>
+                           (auto-login-to-tty
+                            config "tty3" "alice"))))
+
+(operating-system
+  ;; @dots{}
+  (services %my-services))
+@end lisp
+
+One could also @code{compose} (@pxref{Higher-Order Functions,,, guile,
+The Guile Reference Manual}) @code{auto-login-to-tty} to login multiple
+users to multiple ttys.
+
+Finally, here is a note of caution.  Setting up auto login to a TTY,
+means that anyone can turn on your computer and run commands as your
+regular user.
+However, if you have an encrypted root partition, and thus already need
+to enter a passphrase when the system boots, auto-login might be a
+convenient option.
+
+
 @node Customizing the Kernel
 @section Customizing the Kernel
 
@@ -1671,7 +1718,7 @@ operating-system dedicated to the @b{Pine A64 LTS} board.
    (locale "en_US.utf8")
    (bootloader (bootloader-configuration
                 (bootloader u-boot-pine64-lts-bootloader)
-                (target "/dev/vda")))
+                (targets '("/dev/vda"))))
    (initrd-modules '())
    (kernel linux-libre-arm64-generic)
    (file-systems (cons (file-system
@@ -2003,10 +2050,12 @@ Copy into it the output of:
 cat ~/.ssh/<username>_rsa.pub
 @end example
 
-Power the Linode down. In the Linode's Disks/Configurations tab, resize
+Power the Linode down.
-the Debian disk to be smaller. 30 GB is recommended.
+
+In the Linode's Storage tab, resize the Debian disk to be smaller.
+30 GB free space is recommended.  Then click "Add a disk", and fill
+out the form with the following:
 
-In the Linode settings, "Add a disk", with the following:
 @itemize @bullet
 @item
 Label: "Guix"
@@ -2018,9 +2067,9 @@ Filesystem: ext4
 Set it to the remaining size
 @end itemize
 
-On the "configuration" field that comes with the default image, press
+In the Configurations tab, press "Edit" on the default Debian profile.
-"..." and select "Edit", then on that menu add to @file{/dev/sdc} the "Guix"
+Under "Block Device Assignment" click "Add a Device". It should be
-label.
+@file{/dev/sdc} and you can select the "Guix" disk. Save Changes.
 
 Now "Add a Configuration", with the following:
 @itemize @bullet
@@ -2046,8 +2095,8 @@ Root device: @file{/dev/sda}
 Turn off all the filesystem/boot helpers
 @end itemize
 
-Now power it back up, picking the Debian configuration.  Once it's
+Now power it back up, booting with the Debian configuration.  Once it's
-booted up, ssh in your server via @code{ssh
+running, ssh to your server via @code{ssh
 root@@@var{<your-server-IP-here>}}. (You can find your server IP address in
 your Linode Summary section.) Now you can run the "install guix from
 @pxref{Binary Installation,,, guix, GNU Guix}" steps:
@@ -2136,19 +2185,20 @@ Replace the following fields in the above configuration:
 @end lisp
 
 The last line in the above example lets you log into the server as root
-and set the initial root password.  After you have done this, you may
+and set the initial root password (see the note at the end of this
+recipe about root login).  After you have done this, you may
 delete that line from your configuration and reconfigure to prevent root
 login.
 
-Save your ssh public key (eg: @file{~/.ssh/id_rsa.pub}) as
+Copy your ssh public key (eg: @file{~/.ssh/id_rsa.pub}) as
-@file{@var{<your-username-here>}_rsa.pub} and your
+@file{@var{<your-username-here>}_rsa.pub} and put
 @file{guix-config.scm} in the same directory.  In a new terminal run
 these commands.
 
 @example
 sftp root@@<remote server ip address>
-put /home/<username>/ssh/id_rsa.pub .
+put /path/to/files/<username>_rsa.pub .
-put /path/to/linode/guix-config.scm .
+put /path/to/files/guix-config.scm .
 @end example
 
 In your first terminal, mount the guix drive:
@@ -2158,9 +2208,9 @@ mkdir /mnt/guix
 mount /dev/sdc /mnt/guix
 @end example
 
-Due to the way we set things up above, we do not install GRUB
+Due to the way we set up the bootloader section of the guix-config.scm,
-completely.  Instead we install only our grub configuration file.  So we
+only the grub configuration file will be installed.  So, we need to copy
-need to copy over some of the other GRUB stuff that is already there:
+over some of the other GRUB stuff already installed on the Debian system:
 
 @example
 mkdir -p /mnt/guix/boot/grub
@@ -2213,7 +2263,7 @@ still need to set your root and user password initially by clicking on
 the ``Launch Console'' option in your linode.  Choose the ``Glish''
 instead of ``Weblish''.  Now you should be able to ssh into the machine.
 
-Horray!  At this point you can shut down the server, delete the
+Hooray!  At this point you can shut down the server, delete the
 Debian disk, and resize the Guix to the rest of the size.
 Congratulations!
 

doc/he-config-bare-bones.scm

@@ -0,0 +1,24 @@
+(use-modules (gnu home)
+             (gnu home-services)
+             (gnu home-services shells)
+             (gnu services)
+             (gnu packages admin)
+             (guix gexp))
+
+
+(home-environment
+ (packages (list htop))
+ (services
+  (list
+   (service home-bash-service-type
+            (home-bash-configuration
+             (guix-defaults? #t)
+             (bash-profile '("\
+export HISTFILE=$XDG_CACHE_HOME/.bash_history"))))
+
+   (simple-service 'test-config
+                   home-files-service-type
+                   (list `("config/test.conf"
+                           ,(plain-file "tmp-file.txt"
+                                        "the content of ~/.config/test.conf")))))))
+

doc/htmlxref.cnf

@@ -397,15 +397,15 @@ guile-gtk	node	${GS}/guile-gtk/docs/guile-gtk/
 guile-rpc	mono	${GS}/guile-rpc/manual/guile-rpc.html
 guile-rpc	node	${GS}/guile-rpc/manual/html_node/
 
-guix.de		mono	${GS}/guix/manual/de/guix.html
+guix.de		mono	${GS}/guix/manual/de/guix.de.html
 guix.de		node	${GS}/guix/manual/de/html_node/
-guix.es		mono	${GS}/guix/manual/es/guix.html
+guix.es		mono	${GS}/guix/manual/es/guix.es.html
 guix.es		node	${GS}/guix/manual/es/html_node/
-guix.fr		mono	${GS}/guix/manual/fr/guix.html
+guix.fr		mono	${GS}/guix/manual/fr/guix.fr.html
 guix.fr		node	${GS}/guix/manual/fr/html_node/
-guix.ru		mono	${GS}/guix/manual/ru/guix.html
+guix.ru		mono	${GS}/guix/manual/ru/guix.ru.html
 guix.ru		node	${GS}/guix/manual/ru/html_node/
-guix.zh_CN	mono	${GS}/guix/manual/zh-cn/guix.html
+guix.zh_CN	mono	${GS}/guix/manual/zh-cn/guix.zh_CN.html
 guix.zh_CN	node	${GS}/guix/manual/zh-cn/html_node/
 guix		mono	${GS}/guix/manual/en/guix.html
 guix		node	${GS}/guix/manual/en/html_node/

doc/local.mk

@@ -4,7 +4,7 @@
 # Copyright © 2013 Andreas Enge <andreas@enge.fr>
 # Copyright © 2016 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
 # Copyright © 2016, 2018 Mathieu Lirzin <mthl@gnu.org>
-# Copyright © 2018 Julien Lepiller <julien@lepiller.eu>
+# Copyright © 2018, 2021 Julien Lepiller <julien@lepiller.eu>
 #
 # This file is part of GNU Guix.
 #
@@ -21,14 +21,35 @@
 # You should have received a copy of the GNU General Public License
 # along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
+# If adding a language, update the following variables, and info_TEXINFOS.
+MANUAL_LANGUAGES = de es fa fr it ko pt_BR ru sk zh_CN
+COOKBOOK_LANGUAGES = de fa fr ko ru sk zh_Hans
+
+# Arg1: A list of languages codes.
+# Arg2: The file name stem.
+lang_to_texinfo = $(foreach lang,$(1),%D%/$(2).$(lang).texi)
+
+# Automake does not understand GNU Make non-standard extensions,
+# unfortunately, so we cannot use the above patsubst-based function here.
 info_TEXINFOS = %D%/guix.texi			\
   %D%/guix.de.texi				\
   %D%/guix.es.texi				\
+  %D%/guix.fa.texi				\
   %D%/guix.fr.texi				\
+  %D%/guix.it.texi				\
+  %D%/guix.ko.texi				\
+  %D%/guix.pt_BR.texi				\
   %D%/guix.ru.texi				\
+  %D%/guix.sk.texi				\
   %D%/guix.zh_CN.texi				\
   %D%/guix-cookbook.texi			\
-  %D%/guix-cookbook.de.texi
+  %D%/guix-cookbook.de.texi			\
+  %D%/guix-cookbook.fa.texi			\
+  %D%/guix-cookbook.fr.texi			\
+  %D%/guix-cookbook.ko.texi			\
+  %D%/guix-cookbook.ru.texi			\
+  %D%/guix-cookbook.sk.texi			\
+  %D%/guix-cookbook.zh_Hans.texi
 
 %C%_guix_TEXINFOS = \
   %D%/contributing.texi \
@@ -61,18 +82,10 @@ OS_CONFIG_EXAMPLES_TEXI =			\
   %D%/os-config-desktop.texi			\
   %D%/os-config-lightweight-desktop.texi
 
-TRANSLATED_INFO =				\
+TRANSLATED_INFO = 						\
-  %D%/guix.de.texi				\
+  $(call lang_to_texinfo,$(MANUAL_LANGUAGES),guix)		\
-  %D%/guix.es.texi				\
+  $(call lang_to_texinfo,$(MANUAL_LANGUAGES),contributing)	\
-  %D%/guix.fr.texi				\
+  $(call lang_to_texinfo,$(COOKBOOK_LANGUAGES),guix-cookbook)
-  %D%/guix.ru.texi				\
-  %D%/guix.zh_CN.texi				\
-  %D%/contributing.de.texi			\
-  %D%/contributing.es.texi			\
-  %D%/contributing.fr.texi			\
-  %D%/contributing.ru.texi			\
-  %D%/contributing.zh_CN.texi			\
-  %D%/guix-cookbook.de.texi
 
 # Bundle this file so that makeinfo finds it in out-of-source-tree builds.
 BUILT_SOURCES        += $(OS_CONFIG_EXAMPLES_TEXI) $(TRANSLATED_INFO)
@@ -100,7 +113,7 @@ cat "$@.tmp" | egrep '@p?x?ref' -A1 | sed 'N;s|--\n||g;P;D' | sed 's|^| |g' | \
       line=$$(grep -n "^msgid \"$$e\"" "$<" | cut -f1 --delimiter=":") ;\
       ((line++)) ;\
       if [ "$$line" != "1" ]; then \
-	translation=$$(head -n "$$line" "$<" | tail -1 | grep msgstr | sed 's|msgstr "\(.*\)"|\1|') ;\
+	translation=$$(head -n "$$line" "$<" | tail -1 | grep msgstr | sed 's|msgstr "\([^"]*\)"|\1|') ;\
 	if [ "$$translation" != "" ]; then \
 	      sed "N;s@\(p\?x\?ref\){$$(echo $$e | sed 's| |[\\n ]|g')\(,\|}\)@\1{$$translation\2@g;P;D" -i "$@.tmp" ;\
 	fi ;\

etc/committer.scm.in

@@ -4,6 +4,8 @@
 
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2020, 2021 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -36,7 +38,43 @@
         (ice-9 popen)
         (ice-9 match)
         (ice-9 rdelim)
-        (ice-9 textual-ports))
+        (ice-9 regex)
+        (ice-9 textual-ports)
+        (guix gexp))
+
+(define* (break-string str #:optional (max-line-length 70))
+  "Break the string STR into lines that are no longer than MAX-LINE-LENGTH.
+Return a single string."
+  (define (restore-line words)
+    (string-join (reverse words) " "))
+  (if (<= (string-length str) max-line-length)
+      str
+      (let ((words+lengths (map (lambda (word)
+                                  (cons word (string-length word)))
+                                (string-tokenize str))))
+        (match (fold (match-lambda*
+                       (((word . length)
+                         (count current lines))
+                        (let ((new-count (+ count length 1)))
+                          (if (< new-count max-line-length)
+                              (list new-count
+                                    (cons word current)
+                                    lines)
+                              (list length
+                                    (list word)
+                                    (cons (restore-line current) lines))))))
+                     '(0 () ())
+                     words+lengths)
+          ((_ last-words lines)
+           (string-join (reverse (cons (restore-line last-words) lines))
+                        "\n"))))))
+
+(define* (break-string-with-newlines str #:optional (max-line-length 70))
+  "Break the lines of string STR into lines that are no longer than
+MAX-LINE-LENGTH. Return a single string."
+  (string-join (map (cut break-string <> max-line-length)
+                    (string-split str #\newline))
+               "\n"))
 
 (define (read-excursion port)
   "Read an expression from PORT and reset the port position before returning
@@ -204,18 +242,19 @@ corresponding to the top-level definition containing the staged changes."
                           (added (lset-difference equal? new-values old-values)))
                       (format port
                               "[~a]: ~a~%" field
-                              (match (list (map symbol->string removed)
+                              (break-string
-                                           (map symbol->string added))
+                               (match (list (map symbol->string removed)
-                                ((() added)
+                                            (map symbol->string added))
-                                 (format #f "Add ~a."
+                                 ((() added)
-                                         (listify added)))
+                                  (format #f "Add ~a."
-                                ((removed ())
+                                          (listify added)))
-                                 (format #f "Remove ~a."
+                                 ((removed ())
-                                         (listify removed)))
+                                  (format #f "Remove ~a."
-                                ((removed added)
+                                          (listify removed)))
-                                 (format #f "Remove ~a; add ~a."
+                                 ((removed added)
-                                         (listify removed)
+                                  (format #f "Remove ~a; add ~a."
-                                         (listify added)))))))))
+                                          (listify removed)
+                                          (listify added))))))))))
             '(inputs propagated-inputs native-inputs)))
 
 (define* (add-commit-message file-name variable-name #:optional (port (current-output-port)))
@@ -224,6 +263,41 @@ corresponding to the top-level definition containing the staged changes."
           "gnu: Add ~a.~%~%* ~a (~a): New variable.~%"
           variable-name file-name variable-name))
 
+(define* (custom-commit-message file-name variable-name message changelog
+                                #:optional (port (current-output-port)))
+  "Print custom commit message for a change to VARIABLE-NAME in FILE-NAME, using
+MESSAGE as the commit message and CHANGELOG as the body of the ChangeLog
+entry. If CHANGELOG is #f, the commit message is reused. If CHANGELOG already
+contains ': ', no colon is inserted between the location and body of the
+ChangeLog entry."
+  (define (trim msg)
+    (string-trim-right (string-trim-both msg) (char-set #\.)))
+
+  (define (changelog-has-location? changelog)
+    (->bool (string-match "^[[:graph:]]+:[[:blank:]]" changelog)))
+
+  (let* ((message (trim message))
+         (changelog (if changelog (trim changelog) message))
+         (message/f (format #f "gnu: ~a: ~a." variable-name message))
+         (changelog/f (if (changelog-has-location? changelog)
+                          (format #f "* ~a (~a)~a."
+                                  file-name variable-name changelog)
+                          (format #f "* ~a (~a): ~a."
+                                  file-name variable-name changelog))))
+    (format port
+            "~a~%~%~a~%"
+            (break-string-with-newlines message/f 72)
+            (break-string-with-newlines changelog/f 72))))
+
+(define (add-copyright-line line)
+  "Add the copyright line on LINE to the previous commit."
+  (let ((author (match:substring
+                 (string-match "^\\+;;; Copyright ©[^[:alpha:]]+(.*)$" line)
+                 1)))
+    (format
+     (current-output-port) "Amend and add copyright line for ~a~%" author)
+    (system* "git" "commit" "--amend" "--no-edit")))
+
 (define (group-hunks-by-sexp hunks)
   "Return a list of pairs associating all hunks with the S-expression they are
 modifying."
@@ -252,6 +326,15 @@ modifying."
 (define %delay 1000)
 
 (define (main . args)
+  (define* (change-commit-message* file-name old new #:rest rest)
+    (let ((changelog #f))
+      (match args
+        ((or (message changelog) (message))
+         (apply custom-commit-message
+                file-name (second old) message changelog rest))
+        (_
+         (apply change-commit-message file-name old new rest)))))
+
   (match (diff-info)
     (()
      (display "Nothing to be done.\n" (current-error-port)))
@@ -297,18 +380,25 @@ modifying."
                                     (error "Cannot apply")))
                                 (usleep %delay))
                               hunks)
-                    (change-commit-message (hunk-file-name (first hunks))
+                    (define copyright-line
-                                           old new
+                      (any (lambda (line) (and=> (string-prefix? "+;;; Copyright ©" line)
-                                           (current-output-port))
+                                              (const line)))
-                    (let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" "-")))
+                                (hunk-diff-lines (first hunks))))
-                      (change-commit-message (hunk-file-name (first hunks))
+                    (cond
-                                             old new
+                     (copyright-line
-                                             port)
+                      (add-copyright-line copyright-line))
+                     (else
+                      (let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" "-")))
+                        (change-commit-message* (hunk-file-name (first hunks))
+                                                old new)
+                      (change-commit-message* (hunk-file-name (first hunks))
+                                              old new
+                                              port)
                       (usleep %delay)
                       (unless (eqv? 0 (status:exit-val (close-pipe port)))
-                        (error "Cannot commit")))))
+                        (error "Cannot commit")))))))
                  ;; XXX: we recompute the hunks here because previous
                  ;; insertions lead to offsets.
                  (new+old+hunks (diff-info)))))))
 
-(main)
+(apply main (cdr (command-line)))

etc/completion/bash/guix

@@ -1,5 +1,6 @@
 # GNU Guix --- Functional package management for GNU
 # Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2021 Tobias Geerinck-Rice <me@tobias.gr>
 #
 # This file is part of GNU Guix.
 #
@@ -68,31 +69,29 @@ _guix_complete_installed_package ()
 
 _guix_complete_option ()
 {
-    local subcommand
+    local command="${COMP_WORDS[$1]}"
-    case "${COMP_WORDS[2]}" in
+    local subcommand="${COMP_WORDS[$(($1 + 1))]}"
-	-*)     subcommand="";;
+    if _guix_is_option "$subcommand"
-	[a-z]*) subcommand="${COMP_WORDS[2]}";;
+    then
-    esac
+	subcommand=""
-    local options="$(${COMP_WORDS[0]} ${COMP_WORDS[1]} $subcommand --help 2> /dev/null \
+    fi
+    local options="$(${COMP_WORDS[0]} $command $subcommand --help 2> /dev/null \
                             | grep '^  \+-' \
                             | sed -e's/^.*--\([a-zA-Z0-9_-]\+\)\(=\?\).*/--\1\2/g')"
     compopt -o nospace
-    COMPREPLY=($(compgen -W "$options" -- "${COMP_WORDS[${#COMP_WORDS[*]} - 1]}"))
+    COMPREPLY=($(compgen -W "$options" -- "$2"))
 }
 
-_guix_is_command ()
+_guix_is_option ()
 {
-    local word
+    case "$1" in
-    local result="false"
+	-*)
-    for word in ${COMP_WORDS[*]}
+	    true
-    do
+	    ;;
-	if [ "$word" = "$1" ]
+	*)
-	then
+	    false
-	    result=true
+	    ;;
-	    break
+    esac
-	fi
-    done
-    $result
 }
 
 _guix_is_removing ()
@@ -183,22 +182,43 @@ _guix_complete ()
     local word_count=${#COMP_WORDS[*]}
     local word_at_point="${COMP_WORDS[$COMP_CWORD]}"
 
-    if [ "$COMP_CWORD" -gt 1 ]
+    # Find the innermost command at point, e.g. "build" in the case of
-    then
+    # "guix time-machine OPTIONS -- build<Tab>" -- but "time-machine" if
-	case "$word_at_point" in
+    # point is moved before "build".
-	    -*)
+    local command_index=0
-		_guix_complete_option "$word_at_point"
+    local command
-		return
+    local word_index=0
-		;;
+    local word
-	esac
+    local expect_command="true"
-    fi
+    while [[ $((++word_index)) -le COMP_CWORD ]]
+    do
+	word="${COMP_WORDS[$word_index]}"
+	if $expect_command
+	then
+	    command_index=$word_index
+	    command="$word"
+	    expect_command="false"
+	    continue
+	fi
+	if [[ "$word" = "--" ]]
+	then
+	    case "$command" in
+		environment)
+		    break
+		    ;;
+		time-machine)
+		    expect_command="true"
+		    ;;
+	    esac
+	fi
+    done
 
     case $COMP_CWORD in
-	1)
+	$command_index)
 	    _guix_complete_command
 	    ;;
 	*)
-	    if _guix_is_command "package"
+	    if [[ "$command" = "package" ]]
 	    then
 		if _guix_is_dash_L || _guix_is_dash_m || _guix_is_dash_p || _guix_is_dash_f
 		then
@@ -209,7 +229,7 @@ _guix_complete ()
 		else
 		    _guix_complete_available_package "$word_at_point"
 		fi
-	    elif _guix_is_command "install"
+	    elif [[ "$command" = "install" ]]
 	    then
                 if _guix_is_dash_L || _guix_is_dash_m || _guix_is_dash_p
                 then
@@ -217,7 +237,7 @@ _guix_complete ()
 		else
 		    _guix_complete_available_package "$word_at_point"
 		fi
-	    elif _guix_is_command "remove"
+	    elif [[ "$command" = "remove" ]]
 	    then
                 if _guix_is_dash_L || _guix_is_dash_m || _guix_is_dash_p
                 then
@@ -225,7 +245,7 @@ _guix_complete ()
 		else
 		    _guix_complete_installed_package "$word_at_point"
 		fi
-	    elif _guix_is_command "upgrade"
+	    elif [[ "$command" = "upgrade" ]]
 	    then
                 if _guix_is_dash_L || _guix_is_dash_m || _guix_is_dash_p
                 then
@@ -233,7 +253,7 @@ _guix_complete ()
 		else
 		    _guix_complete_installed_package "$word_at_point"
 		fi
-            elif _guix_is_command "build"
+            elif [[ "$command" = "build" ]]
             then
                 if _guix_is_dash_L || _guix_is_dash_m || _guix_is_dash_f
                 then
@@ -241,51 +261,54 @@ _guix_complete ()
 		else
 		    _guix_complete_available_package "$word_at_point"
                 fi
-	    elif _guix_is_command "environment"
+	    elif [[ "$command" = "environment" ]]
 	    then
                 if _guix_is_dash_L || _guix_is_dash_m || _guix_is_dash_p || _guix_is_dash_l
                 then
                     _guix_complete_file
+		elif _guix_is_option "$word_at_point"
+		then
+		    _guix_complete_option "$command_index" "$word_at_point"
 		else
 		    _guix_complete_available_package "$word_at_point"
 		fi
-	    elif _guix_is_command "download"
+	    elif [[ "$command" = "download" ]]
 	    then
 		 _guix_complete_file
-	    elif _guix_is_command "system"
+	    elif [[ "$command" = "system" ]]
 	    then
 		case $COMP_CWORD in
 		    2) _guix_complete_subcommand;;
 		    *) _guix_complete_file;; # TODO: restrict to *.scm
 		esac
-            elif _guix_is_command "pull"
+            elif [[ "$command" = "pull" ]]
             then
                 if _guix_is_dash_C || _guix_is_dash_p
                 then
                     _guix_complete_file
                 fi
-            elif _guix_is_command "time-machine"
+            elif [[ "$command" = "time-machine" ]]
             then
                 if _guix_is_dash_C
                 then
                     _guix_complete_file
 		else
-		    _guix_complete_command
+		    _guix_complete_option "$command_index" "$word_at_point"
                 fi
-	    elif _guix_is_command "container"
+	    elif [[ "$command" = "container" ]]
 	    then
 		case $COMP_CWORD in
 		    2) _guix_complete_subcommand;;
 		    3) _guix_complete_pid "$word_at_point";;
 		    *) _guix_complete_file;;
 		esac
-	    elif _guix_is_command "import"
+	    elif [[ "$command" = "import" ]]
 	    then
 		_guix_complete_subcommand
-	    elif _guix_is_command "hash" || _guix_is_command "gc"
+	    elif [[ "$command" = "hash" || "$command" = "gc" ]]
 	    then
 		_guix_complete_file
-            elif _guix_is_command "weather"
+            elif [[ "$command" = "weather" ]]
             then
                 if _guix_is_dash_m
                 then
@@ -296,6 +319,12 @@ _guix_complete ()
 	    fi
 	    ;;
     esac
+
+    if [[ -z "$COMPREPLY" && COMP_CWORD -gt command_index ]] &&
+        _guix_is_option "$word_at_point"
+    then
+	_guix_complete_option "$command_index" "$word_at_point"
+    fi
 }
 
 complete -F _guix_complete guix

etc/completion/fish/guix.fish

@@ -322,8 +322,6 @@ complete -f -c guix -n '__fish_guix_needs_command' -a import -d 'Run IMPORTER wi
 ##### import gnu
 complete -f -c guix -n '__fish_guix_using_command import; and not __fish_seen_subcommand_from $remotecommands' -a gnu -d 'Return a package declaration template for PACKAGE, a GNU package.'
 complete -f -c guix -n '__fish_guix_using_command import; and __fish_seen_subcommand_from gnu' -a "--key-download=" -d 'handle missing OpenPGP keys according to POLICY: "always", "never", and "interactive", which is also used when "key-download" is not specified.'
-##### import nix
-complete -f -c guix -n '__fish_guix_using_command import; and not __fish_seen_subcommand_from $remotecommands' -a nix -d 'Import and convert the Nix expression ATTRIBUTE of NIXPKGS.'
 ##### import pypi
 complete -f -c guix -n '__fish_guix_using_command import; and not __fish_seen_subcommand_from $remotecommands' -a pypi -d 'Import and convert the PyPI package for PACKAGE-NAME.'
 ##### import cpan

etc/completion/zsh/_guix

@@ -2,6 +2,8 @@
 #
 # GNU Guix --- Functional package management for GNU
 # Copyright © 2016 Eric Le Bihan <eric.le.bihan.dev@free.fr>
+# Copyright © 2021 Noah Evans <noah@nevans.me>
+# Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
 #
 # This file is part of GNU Guix.
 #
@@ -68,21 +70,24 @@ _guix_list_installed_packages()
 (( $+functions[_guix_build] )) || _guix_build()
 {
     _arguments \
-        '--expression=[build the package matching EXPR]:EXPR' \
+        {-e,--expression=}'[build the package or derivation EXPR evaluates to]:EXPR' \
-        '--file=[build the package matching code evaluated from FILE]:FILE:_files' \
+        {-f,--file=}'[build the package or derivation that the code within FILE evaluates to]:FILE:_files' \
-        '--source[build the packages source derivations]' \
+        {-m,--manifest=}'[build the packages that the manifest given in FILE evaluates to]:FILE:_files' \
-        '--sources=[build source derivations]:TYPE:(all package transitive)' \
+        {-S,--source}'[build the packages source derivations]' \
-        '--system=[attempt to build for SYSTEM (e.g. "i686-linux")]:SYSTEM' \
+        '--sources=[build source derivations]:TYPE:(package all transitive)' \
+        {-s,--system=}'[attempt to build for SYSTEM (e.g. "i686-linux")]:SYSTEM' \
         '--target=[cross-build for TRIPLET (e.g. "armel-linux-gnu")]:TRIPLET' \
-        '--derivations[return the derivation paths of the given packages]' \
+        {-d,--derivations}'[return the derivation paths of the given packages]' \
         '--check[rebuild items to check for non-determinism issues]' \
-        '--root=[symlink result to FILE and register it as GC root]:FILE:_files' \
+        '--repair[repair the specified items]' \
-        '--quiet[do not show the build log]' \
+        {-r,--root=}'[make FILE a symlink to the result, and register it as a GC root]:FILE:_files' \
+        {-v,--verbosity=}'[use the given verbosity LEVEL]:LEVEL' \
+        {-q,--quiet}'[do not show the build log]' \
         '--log-file[return the log file names for the given derivations]' \
-        '--load-path=[prepend DIR to the package module search path]:DIR:_dirs' \
+        {-L,--load-path=}'[prepend DIR to the package module search path]:DIR:_files -\' \
-        '--keep-failed[keep build tree of failed builds]' \
+        {-K,--keep-failed}'[keep build tree of failed builds]' \
-        '--keep-going[keep going when some of the derivations fail]' \
+        {-k,--keep-going}'[keep going when some of the derivations fail]' \
-        '--dry-run[do not build the derivations]' \
+        {-n,--dry-run}'[do not build the derivations]' \
         '--fallback[fall back to building when the substituter fails]' \
         '--no-substitutes[build instead of resorting to pre-built substitutes]' \
         '--substitute-urls=[fetch substitute from URLS if they are authorized]:URLS:_urls' \
@@ -90,12 +95,12 @@ _guix_list_installed_packages()
         '--no-offload[do not attempt to offload builds]' \
         '--max-silent-time=[mark the build as failed after SECONDS of silence]:SECONDS' \
         '--timeout=[mark the build as failed after SECONDS of activity]:SECONDS' \
-        '--verbosity=[use the given verbosity LEVEL]:LEVEL' \
         '--rounds=[build N times in a row to detect non-determinism]:N' \
-        '--cores=[allow the use of up to N CPU cores for the build]:N' \
+        {-c,--cores=}'[allow the use of up to N CPU cores for the build]:N' \
-        '--max-jobs=[allow at most N build jobs]:N' \
+        {-M,--max-jobs=}'[allow at most N build jobs]:N' \
-        '--with-source=[use SOURCE when building the corresponding package]:SOURCE' \
+        '--debug=[produce debugging output at LEVEL]:LEVEL' \
-        '--with-input=[replace dependency PACKAGE by REPLACEMENT]:PACKAGE=REPLACEMENT' \
+        '--help-transform[list package transformation options not shown here]' \
+        {-V,--version}'[display version information and exit]' \
         '*:package:->packages'
 
     if [[ "$state" = packages ]]; then
@@ -107,7 +112,10 @@ _guix_list_installed_packages()
 (( $+functions[_guix_challenge] )) || _guix_challenge()
 {
     _arguments \
-        '--substitute-urls=[fetch substitute from URLS if they are authorized]:URL:_urls' \
+        '--substitute-urls=[compare build results with those at URLS]:URLS:_urls' \
+        '--diff=[show differences according to MODE]:MODE' \
+        {-v,--verbose}'[show details about successful comparisons]' \
+        {-V,--version}'[display version information and exit]' \
         '*:package:->packages'
 
     if [[ "$state" = packages ]]; then
@@ -126,7 +134,11 @@ _guix_list_installed_packages()
 (( $+functions[_guix_download] )) || _guix_download()
 {
     _arguments \
-        '--format=[write the hash in the given format]:FMT:(nix-base32 base16 base32 hex)' \
+        {-f,--format=}'[write the hash in the given format]:FMT:(nix-base32 base16 base32 hex)' \
+        {-H,--hash=}'[use the given hash ALGORITHM]:ALGORITHM' \
+        '--no-check-certificate[do not validate the certificate of HTTPS servers ]' \
+        {-o,--output=}'[download to FILE]:FILE:_files' \
+        {-V,--version}'[display version information and exit]' \
         '1:URL:_urls'
 }
 
@@ -139,21 +151,29 @@ _guix_list_installed_packages()
 (( $+functions[_guix_environment] )) || _guix_environment()
 {
     _arguments \
-        '--expression=[create environment for the package evaluated from EXPR]:EXPR' \
+        {-e,--expression=}'[create environment for the package that EXPR evaluates to]:EXPR' \
-        '--load=[create environment for the package evaluated from FILE]:FILE:_files' \
+        {-l,--load=}'[create environment for the package that the code within FILE evaluates to]:FILE:_files' \
-        '--ad-hoc[include all specified packages, not only their inputs]' \
+        {-m,--manifest=}'[create environment with the manifest from FILE]:FILE:_files' \
+        {-p,--profile=}'[create environment from profile at PATH]:PATH:_files -/' \
+        '--ad-hoc[include all specified packages in the environment instead of only their inputs]' \
         '--pure[unset existing environment variables]' \
+        {-E,--preserve=}'[preserve environment variables that match REGEXP]:REGEXP' \
         '--search-paths[display needed environment variable definitions]' \
-        '--system=[attempt to build for SYSTEM (e.g. "i686-linux")]:SYSTEM' \
+        {-s,--system=}'[attempt to build for SYSTEM (e.g. "i686-linux")]:SYSTEM' \
-        '--container[run command within an isolated container]' \
+        {-r,--root=}'[make FILE a symlink to the result, and register it as a GC root]:FILE:_files' \
-        '--network[allow containers to access the network]' \
+        {-C,--container}'[run command within an isolated container]' \
-        '--share=[share writable host file system according to SPEC]:SPEC' \
+        {-N,--network}'[allow containers to access the network]' \
-        '--expose=[expose read-only host file system according to SPEC]:SPEC' \
+        {-P,--link-profile}'[link environment profile to ~/.guix-profile within an isolated container]' \
+        {-u,--user=}'[instead of copying the name and home of the current user into an isolated container, use the name USER with home directory /home/USER]:USER:_users' \
+        '--no-cwd[do not share current working directory with an isolated container]' \
+        '--share=[for containers, share writable host file system according to SPEC]:SPEC' \
+        '--expose=[for containers, expose read-only host file system according to SPEC]:SPEC' \
+        {-v,--verbosity=}'[use the given verbosity LEVEL]:LEVEL' \
         '--bootstrap[use bootstrap binaries to build the environment]' \
-        '--load-path=[prepend DIR to the package module search path]:DIR:_dirs' \
+        {-L,--load-path=}'[prepend DIR to the package module search path]:DIR:_files -/' \
-        '--keep-failed[keep build tree of failed builds]' \
+        {-K,--keep-failed}'[keep build tree of failed builds]' \
-        '--keep-going[keep going when some of the derivations fail]' \
+        {-k,--keep-going}'[keep going when some of the derivations fail]' \
-        '--dry-run[do not build the derivations]' \
+        {-n,--dry-run}'[do not build the derivations]' \
         '--fallback[fall back to building when the substituter fails]' \
         '--no-substitutes[build instead of resorting to pre-built substitutes]' \
         '--substitute-urls=[fetch substitute from URLS if they are authorized]:URLS:_urls' \
@@ -161,10 +181,12 @@ _guix_list_installed_packages()
         '--no-offload[do not attempt to offload builds]' \
         '--max-silent-time=[mark the build as failed after SECONDS of silence]:SECONDS' \
         '--timeout=[mark the build as failed after SECONDS of activity]:SECONDS' \
-        '--verbosity=[use the given verbosity LEVEL]:LEVEL' \
         '--rounds=[build N times in a row to detect non-determinism]:N' \
-        '--cores=[allow the use of up to N CPU cores for the build]:N' \
+        {-c,--cores=}'[allow the use of up to N CPU cores for the build]:N' \
-        '--max-jobs=[allow at most N build jobs]:N' \
+        {-M,--max-jobs=}'[allow at most N build jobs]:N' \
+        '--debug=[produce debugging output at LEVEL]:LEVEL' \
+        '--help-transform[list package transformation options not shown here]' \
+        {-V,--version}'[display version information and exit]' \
         '*:package:->packages'
 
     if [[ "$state" = packages ]]; then
@@ -177,27 +199,39 @@ _guix_list_installed_packages()
 (( $+functions[_guix_gc] )) || _guix_gc()
 {
     _arguments \
-        '--collect-garbage=[collect at least MIN bytes of garbage]:MIN' \
+        {-C,--collect-garbage=}'[collect at least MIN bytes of garbage]:MIN' \
-        '--free-space=[attempt to reach FREE available space in the store]:FREE' \
+        {-F,--free-space=}'[attempt to reach FREE available space in the store]:FREE' \
-        '--delete[attempt to delete PATHS]' \
+        {-d,--delete-generations=}'[delete profile generations matching PATTERN]:PATTERN' \
+        {-D,--delete}'[attempt to delete PATHS]' \
+        '--list-roots[list the users GC roots]' \
+        '--list-busy[list store items used by running processes]' \
         '--optimize[optimize the store by deduplicating identical files]' \
         '--list-dead[list dead paths]' \
         '--list-live[list live paths]' \
         '--references[list the references of PATHS]' \
-        '--requisites[list the requisites of PATHS]' \
+        {-R,--requisites}'[list the requisites of PATHS]' \
         '--referrers[list the referrers of PATHS]' \
+        '--derivers[list the derivers of PATHS]' \
         '--verify=[verify the integrity of the store]:OPTS:(contents repair)' \
         '--list-failures[list cached build failures]' \
         '--clear-failures[remove PATHS from the set of cached failures]' \
-        '1:PATH:_dirs'
+        {-V,--version}'[display version information and exit]:V' \
+        '1:PATH:_files -/'
 }
 
 (( $+functions[_guix_graph] )) || _guix_graph()
 {
     _arguments \
-        '--type=[represent nodes of the given TYPE]:TYPE:->types' \
+        {-b,--backend=}'[produce a graph with the given backend TYPE]:TYPE:->types' \
+        '--list-backends[list the available graph backends]' \
+        {-t,--type=}'[represent nodes of the given TYPE]:TYPE:->types' \
         '--list-types[list the available graph types]' \
-        '--expression=[consider the package EXPR evaluates to]:EXPR' \
+        '--path[display the shortest path between the given nodes]' \
+        {-e,--expression=}'[consider the package EXPR evaluates to]:EXPR' \
+        {-s,--system=}'[consider the graph for SYSTEM (e.g. "i686-linux")]:SYSTEM' \
+        {-L,--load-path=}'[prepend DIR to the package module search path]:DIR:_files -/' \
+        '--help-transform[list package transformation options not shown here]' \
+        {-V,--version}'[display version information and exit]' \
         '1:PACKAGE:->packages'
 
     case "$state" in
@@ -216,14 +250,18 @@ _guix_list_installed_packages()
 (( $+functions[_guix_hash] )) || _guix_hash()
 {
     _arguments \
-        '--format=[write the hash in the given format]:FMT:(nix-base32 base16 base32 hex)' \
+        {-x,--exclude-vcs}'[exclude version control directories]' \
-        '--recursive[compute the hash on FILE recursively]'\
+        {-H,--hash=}'[use the given hash ALGORITHM]:ALGORITHM' \
+        {-f,--format=}'[write the hash in the given format]:FMT:(nix-base32 base16 base32 hex)' \
+        {-r,--recursive}'[compute the hash on FILE recursively]' \
+        {-V,--version}'[display version information and exit]' \
         '1:FILE:_files'
 }
 
 (( $+functions[_guix_import] )) || _guix_import()
 {
     _arguments \
+        {-V,--version}'[display version information and exit]' \
         '1:IMPORTER:->importer' \
         '*:args:'
 
@@ -236,8 +274,12 @@ _guix_list_installed_packages()
 (( $+functions[_guix_lint] )) || _guix_lint()
 {
     _arguments \
-        '--checkers=[only run the specified checkers]:CHECKERS:->checkers' \
+        {-c,--checkers=}'[only run the specified checkers]:CHECKERS:->checkers' \
-        '--list-checkers[display the list of available lint checkers]' \
+        {-x,--exclude=}'[exclude the specified checkers]:CHECKERSS:->checkers' \
+        {-n,--no-network}'[only run checkers that do not access the network]' \
+        {-L,--load-path=}'[prepend DIR to the package module search path]:DIR:_files -/' \
+        {-l,--list-checkers}'[display the list of available lint checkers]' \
+        {-V,--version}'[display version information and exit]' \
         '1:PACKAGE:->packages'
 
     case "$state" in
@@ -255,29 +297,32 @@ _guix_list_installed_packages()
 (( $+functions[_guix_package] )) || _guix_package()
 {
     _arguments \
-        '--install[install one or more packages]: :->install' \
+        {-i,--install}'[install one or more packages]: :->install' \
-        '--install-from-expression=[install the package EXP evaluates to]:EXP' \
+        {-e,--install-from-expression=}'[install the package EXP evaluates to]:EXP' \
-        '--install-from-file=[install the package evaluated from FILE]:FILE:_files' \
+        {-f,--install-from-file=}'[install the package evaluated from FILE]:FILE:_files' \
-        '--remove[remove one or more packages]: :->remove' \
+        {-r,--remove}'[remove one or more packages]: :->remove' \
-        '--upgrade=[upgrade all the installed packages matching REGEXP]:REGEXP' \
+        {-u,--upgrade=}'[upgrade all the installed packages matching REGEXP]:REGEXP' \
-        '--manifest=[create a new profile generation from FILE]:FILE:_files' \
+        {-m,--manifest=}'[create a new profile generation from FILE]:FILE:_files' \
         '--do-not-upgrade=[do not upgrade any packages matching REGEXP]:REGEXP' \
         '--roll-back[roll back to the previous generation]' \
         '--search-paths=[display needed environment variable definitions]:KINDS' \
-        '--list-generations=[list generations matching PATTERN]:PATTERN' \
+        {-l,--list-generations=}'[list generations matching PATTERN]:PATTERN' \
-        '--delete-generations=[delete generations matching PATTERN]:PATTERN' \
+        {-d,--delete-generations=}'[delete generations matching PATTERN]:PATTERN' \
-        '--switch-generation=[switch to a generation matching PATTERN]:PATTERN' \
+        {-S,--switch-generation=}'[switch to a generation matching PATTERN]:PATTERN' \
-        '--profile=[use PROFILE instead of the default profile]:PROFILE' \
+        '--export-manifest[print a manifest for the chosen profile]' \
+        '--export-channels[print channels for the chosen profile]' \
+        {-p,--profile}'[use PROFILE instead of the default profile]:PROFILE:_files -/' \
+        '--list-profiles[list the profiles]' \
+        '--allow-collisions[do not treat collisions in the profile as an error]' \
         '--bootstrap[use the bootstrap Guile to build the profile]' \
-        '--verbose[produce verbose output]' \
+        {-s,--search=}'[search in synopsis and description using REGEXP]:REGEXP' \
-        '--search=[search in synopsis and description using REGEXP]:REGEXP' \
+        {-I,--list-installed=}'[list installed packages matching REGEXP]:REGEXP' \
-        '--list-installed=[list installed packages matching REGEXP]:REGEXP' \
+        {-A,--list-available=}'[list available packages matching REGEXP]:REGEXP' \
-        '--list-available=[list available packages matching REGEXP]:REGEXP' \
         '--show=[show details about a package]: :->show' \
-        '--load-path=[prepend DIR to the package module search path]:DIR:_dirs' \
+        {-L,--load-path=}'[prepend DIR to the package module search path]:DIR:_files -/' \
-        '--keep-failed[keep build tree of failed builds]' \
+        {-K,--keep-failed}'[keep build tree of failed builds]' \
-        '--keep-going[keep going when some of the derivations fail]' \
+        {-k,--keep-going}'[keep going when some of the derivations fail]' \
-        '--dry-run[do not build the derivations]' \
+        {-n,--dry-run}'[do not build the derivations]' \
         '--fallback[fall back to building when the substituter fails]' \
         '--no-substitutes[build instead of resorting to pre-built substitutes]' \
         '--substitute-urls=[fetch substitute from URLS if they are authorized]:URLS:_urls' \
@@ -285,12 +330,13 @@ _guix_list_installed_packages()
         '--no-offload[do not attempt to offload builds]' \
         '--max-silent-time=[mark the build as failed after SECONDS of silence]:SECONDS' \
         '--timeout=[mark the build as failed after SECONDS of activity]:SECONDS' \
-        '--verbosity=[use the given verbosity LEVEL]:LEVEL' \
         '--rounds=[build N times in a row to detect non-determinism]:N' \
-        '--cores=[allow the use of up to N CPU cores for the build]:N' \
+        {-c,--cores=}'[allow the use of up to N CPU cores for the build]:N' \
-        '--max-jobs=[allow at most N build jobs]:N' \
+        {-M,--max-jobs=}'[allow at most N build jobs]:N' \
-        '--with-source=[use SOURCE when building the corresponding package]:SOURCE' \
+        '--debug=[produce debugging output at LEVEL]' \
-        '--with-input=[replace dependency PACKAGE by REPLACEMENT]:PACKAGE=REPLACEMENT'
+        '--help-transform[list package transformation options not shown here]' \
+        {-v,--verbosity=}'[use the given verbosity LEVEL]' \
+        {-V,--version}'[display version information and exit]'
 
     case "$state" in
         install|show)
@@ -304,37 +350,165 @@ _guix_list_installed_packages()
         esac
 }
 
+(( $+functions[_guix_install] )) || _guix_install()
+{
+    _arguments \
+        {-p,--profile=}'[use PROFILE instead of the users default profile]:PROFILE:_files -/' \
+        {-v,--verbosity=}'[use the given verbosity LEVEL]:LEVEL' \
+        {-L,--load-path=}'[prepend DIR to the package module search path]:DIR:_files -/' \
+        {-K,--keep-failed}'[keep build tree of failed builds]' \
+        {-k,--keep-going}'[keep going when some of the derivations fail]' \
+        {-n,--dry-run}'[do not build the derivations]' \
+        '--fallback[fall back to building when the substituter fails]' \
+        '--no-substitutes[build instead of resorting to pre-built substitutes]' \
+        '--substitute-urls=[fetch substitute from URLS if they are authorized]:URLS:_urls' \
+        '--no-grafts[do not graft packages]' \
+        '--no-offload[do not attempt to offload builds]' \
+        '--max-silent-time=[mark the build as failed after SECONDS of silence]:SECONDS' \
+        '--timeout=[mark the build as failed after SECONDS of activity]:SECONDS' \
+        '--rounds=[build N times in a row to detect non-determinism]:N' \
+        {-c,--cores=}'[allow the use of up to N CPU cores for the build]:N' \
+        {-M,--max-jobs=}'[allow at most N build jobs]:N' \
+        '--debug=[produce debugging output at LEVEL]:LEVEL' \
+        '--help-transform[list package transformation options not shown here]' \
+        {-V,--version}'[display version information and exit]' \
+        '*:package:->packages'
+
+    if [[ "$state" = packages ]]; then
+        _guix_list_available_packages
+        compadd -a -- _guix_available_packages
+    fi
+}
+
+(( $+functions[_guix_remove] )) || _guix_remove()
+{
+    _arguments \
+        {-p,--profile=}'[use PROFILE instead of the users default profile]:PROFILE:_files -/' \
+        {-v,--verbosity=}'[use the given verbosity LEVEL]:LEVEL' \
+        {-L,--load-path=}'[prepend DIR to the package module search path]:DIR:_files -/' \
+        {-K,--keep-failed}'[keep build tree of failed builds]' \
+        {-k,--keep-going}'[keep going when some of the derivations fail]' \
+        {-n,--dry-run}'[do not build the derivations]' \
+        '--fallback[fall back to building when the substituter fails]' \
+        '--no-substitutes[build instead of resorting to pre-built substitutes]' \
+        '--substitute-urls=[fetch substitute from URLS if they are authorized]:URLS:_urls' \
+        '--no-grafts[do not graft packages]' \
+        '--no-offload[do not attempt to offload builds]' \
+        '--max-silent-time=[mark the build as failed after SECONDS of silence]:SECONDS' \
+        '--timeout=[mark the build as failed after SECONDS of activity]:SECONDS' \
+        '--rounds=[build N times in a row to detect non-determinism]:N' \
+        {-c,--cores=}'[allow the use of up to N CPU cores for the build]:N' \
+        {-M,--max-jobs=}'[allow at most N build jobs]:N' \
+        '--debug=[produce debugging output at LEVEL]:LEVEL' \
+        {-V,--version}'[display version information and exit]' \
+        '*:package:->packages'
+
+    if [[ "$state" = packages ]]; then
+        _guix_list_installed_packages
+        compadd -a -- _guix_installed_packages
+    fi
+}
+
+(( $+functions[_guix_upgrade] )) || _guix_upgrade()
+{
+    _arguments \
+        {-p,--profile=}'[use PROFILE instead of the users default profile]:PROFILE:_files -/' \
+        {-v,--verbosity=}'[use the given verbosity LEVEL]:LEVEL' \
+        '--do-not-upgrade=[do not upgrade any packages matching REGEXP]:REGEXP' \
+        {-L,--load-path=}'[prepend DIR to the package module search path]:DIR:_files -/' \
+        {-K,--keep-failed}'[keep build tree of failed builds]' \
+        {-k,--keep-going}'[keep going when some of the derivations fail]' \
+        {-n,--dry-run}'[do not build the derivations]' \
+        '--fallback[fall back to building when the substituter fails]' \
+        '--no-substitutes[build instead of resorting to pre-built substitutes]' \
+        '--substitute-urls=[fetch substitute from URLS if they are authorized]:URLS:_urls' \
+        '--no-grafts[do not graft packages]' \
+        '--no-offload[do not attempt to offload builds]' \
+        '--max-silent-time=[mark the build as failed after SECONDS of silence]:SECONDS' \
+        '--timeout=[mark the build as failed after SECONDS of activity]:SECONDS' \
+        '--rounds=[build N times in a row to detect non-determinism]:N' \
+        {-c,--cores=}'[allow the use of up to N CPU cores for the build]:N' \
+        {-M,--max-jobs=}'[allow at most N build jobs]:N' \
+        '--debug=[produce debugging output at LEVEL]:LEVEL' \
+        '--help-transform[list package transformation options not shown here]' \
+        {-V,--version}'[display version information and exit]' \
+        '*:regexp'
+}
+
 (( $+functions[_guix_publish] )) || _guix_publish()
 {
     _arguments \
-        '--port=[listen on PORT]:PORT:' \
+        {-p,--port=}'[listen on PORT]:PORT' \
-        '--listen=[listen on the network interface for HOST]:HOST:_hosts' \
+        '--listen=[listen on the network interface for HOST]:HOST_hosts' \
-        '--user=[change privileges to USER as soon as possible]:USER:_users' \
+        {-u,--user=}'[change privileges to USER as soon as possible]:USER_users' \
-        '--compression=[compress archives at LEVEL]:LEVEL' \
+        {-a,--advertise}'[advertise on the local network]' \
+        {-C,--compression=}'[compress archives with METHOD at LEVEL]:METHOD' \
+        {-c,--cache=}'[cache published items to DIRECTORY]:DIRECTORY:_files -/' \
+        '--cache-bypass-threshold=[serve store items below SIZE even when not cached]:SIZE' \
+        '--workers=[use N workers to bake items]:N' \
         '--ttl=[announce narinfos can be cached for TTL seconds]:TTL' \
-        '--repl=[spawn REPL server on PORT]:PORT'
+        '--negative-ttl=[announce missing narinfos can be cached for TTL seconds]:TTL' \
+        '--nar-path=[use PATH as the prefix for nar URLs]:PATH' \
+        '--public-key=[use FILE as the public key for signatures]:FILE:_files' \
+        '--private-key=[use FILE as the private key for signatures]:FILE:_files' \
+        {-r,--repl=}'[spawn REPL server on PORT]:PORT' \
+        {-V,--version}'[display version information and exit]' \
 }
 
 (( $+functions[_guix_pull] )) || _guix_pull()
 {
     _arguments \
-        '--verbose[produce verbose output]' \
+        {-C,--channels=}'[deploy the channels defined in FILE]:FILE:_files' \
-        '--url=[download the Guix tarball from URL]:URL:_urls' \
+        '--url=[download from the Git repository at URL]:URL:_urls' \
-        '--bootstrap[use the bootstrap Guile to build the new Guix]'
+        '--commit=[download the specified COMMIT]:COMMIT' \
+        '--branch=[download the tip of the specified BRANCH]:BRANCH' \
+        '--allow-downgrades[allow downgrades to earlier channel revisions]' \
+        '--disable-authentication[disable channel authentication]' \
+        {-N,--news}'[display news compared to the previous generation]' \
+        {-l,--list-generations=}'[list generations matching PATTERN]:PATTERN' \
+        '--roll-back[roll back to the previous generation]' \
+        {-d,--delete-generations=}'[delete generations matching PATTERN]:PATTERN' \
+        {-S,--switch-generation=}'[switch to a generation matching PATTERN]:PATTERN' \
+        {-p,--profile=}'[use PROFILE instead of ~/.config/guix/current]:PROFILE:_files -/' \
+        {-v,--verbosity=}'[use the given verbosity LEVEL]:LEVEL' \
+        {-s,--system=}'[attempt to build for SYSTEM (e.g. "i686-linux")]:SYSTEM' \
+        '--bootstrap[use the bootstrap Guile to build the new Guix]' \
+        {-L,--load-path=}'[prepend DIR to the package module search path]:DIR:_files -/' \
+        {-K,--keep-failed}'[keep build tree of failed builds]' \
+        {-k,--keep-going}'[keep going when some of the derivations fail]' \
+        {-n,--dry-run}'[do not build the derivations]' \
+        '--fallback[fall back to building when the substituter fails]' \
+        '--no-substitutes[build instead of resorting to pre-built substitutes]' \
+        '--substitute-urls=[fetch substitute from URLS if they are authorized]:URLS:_urls' \
+        '--no-grafts[do not graft packages]' \
+        '--no-offload[do not attempt to offload builds]' \
+        '--max-silent-time=[mark the build as failed after SECONDS of silence]:SECONDS' \
+        '--timeout=[mark the build as failed after SECONDS of activity]:SECONDS' \
+        '--rounds=[build N times in a row to detect non-determinism]:N' \
+        {-c,--cores=}'[allow the use of up to N CPU cores for the build]:N' \
+        {-M,--max-jobs=}'[allow at most N build jobs]:N' \
+        '--debug=[produce debugging output at LEVEL]:LEVEL' \
+        {-V,--version}'[display version information and exit]'
 }
 
 (( $+functions[_guix_refresh] )) || _guix_refresh()
 {
     _arguments \
-        '--expression=[consider the package EXPR evaluates to]:EXPR' \
+        {-e,--expression=}'[consider the package EXPR evaluates to]:EXPR' \
-        '--update[update source files in place]' \
+        {-u,--update}'[update source files in place]' \
-        '--select=[select all the packages in SUBSET]:SUBSET:(core non-core)' \
+        {-s,--select=}'[select all the packages in SUBSET, one of]:SUBSET:(core non-core)' \
-        '--type=[restrict to updates from the specified updaters]:UPDATER:->updaters' \
+        {-m,--manifest=}'[select all the packages from the manifest in FILE]:FILE:_files' \
-        '--list-updaters[list available updaters and exit]' \
+        {-t,--type=}'[restrict to updates from the specified updaters]:UPDATER:-.updaters' \
-        '--list-dependent[list top-level dependent packages]' \
+        {-L,--list-updaters}'[list available updaters and exit]' \
-        '--key-server=[use HOST as the OpenPGP key server]:HOST:_hosts' \
+        {-l,--list-dependent}'[list top-level dependent packages that would need to be rebuilt as a result of upgrading PACKAGE...]' \
+        {-r,--recursive}'[check the PACKAGE and its inputs for upgrades]' \
+        '--list-transitive[list all the packages that PACKAGE depends on]' \
+        '--keyring=[use FILE as the keyring of upstream OpenPGP keys]:FILE:_files' \
+        '--key-server=[use HOST as the OpenPGP key server]:HOST_hosts' \
         '--gpg=[use COMMAND as the GnuPG 2.x command]:COMMAND' \
-        '--key-download=[policy to handle missing OpenPGP keys]:POLICY:(always interactive never)' \
+        '--key-download=[handle missing OpenPGP keys according to POLICY:]:POLICY:(always interactive never)' \
+        '--load-path=[prepend DIR to the package module search path]:DIR:_files -/' \
+        {-V,--version}'[display version information and exit]' \
         '*:package:->packages'
 
     case "$state" in
@@ -352,9 +526,12 @@ _guix_list_installed_packages()
 (( $+functions[_guix_size] )) || _guix_size()
 {
     _arguments \
-        '--substitute-urls=[fetch substitute from URLS if they are authorized]:URL:_urls' \
+        '--substitute-urls=[fetch substitute from URLS if they are authorized]:URLS:_urls' \
-        '-system=[consider packages for SYSTEM--e.g., "i686-linux"]:SYSTEM' \
+        {-s,--system=}'[consider packages for SYSTEM (e.g. "i686-linux")]:SYSTEM' \
-        '--map-file=[write to FILE a graphical map of disk usage]:FILE:_files' \
+        '--sort=[sort according to KEY]:KEY:(closure self)' \
+        {-m,--map-file=}'[write to FILE a graphical map of disk usage]:FILE:_files' \
+        {-L,--load-path=}'[prepend DIR to the package module search path]:DIR:_files -/' \
+        {-V,--version}'[display version information and exit]' \
         '*:package:->packages'
 
         if [[ "$state" = packages ]]; then
@@ -366,28 +543,42 @@ _guix_list_installed_packages()
 (( $+functions[_guix_system] )) || _guix_system()
 {
     _arguments \
-        '--load-path=[prepend DIR to the package module search path]:DIR:_dirs' \
+        {-L,--load-path=}'[prepend DIR to the package module search path]:DIR:_files -/' \
-        '--keep-failed[keep build tree of failed builds]' \
+        {-K,--keep-failed}'[keep build tree of failed builds]' \
-        '--keep-going[keep going when some of the derivations fail]' \
+        {-k,--keep-going}'[keep going when some of the derivations fail]' \
-        '--dry-run[do not build the derivations]' \
+        {-n,--dry-run}'[do not build the derivations]' \
         '--fallback[fall back to building when the substituter fails]' \
         '--no-substitutes[build instead of resorting to pre-built substitutes]' \
-        '--substitute-urls=[fetch substitute from URLS if they are authorized]:URL:_urls' \
+        '--substitute-urls=[fetch substitute from URLS if they are authorized]:URLS:_urls' \
         '--no-grafts[do not graft packages]' \
         '--no-offload[do not attempt to offload builds]' \
         '--max-silent-time=[mark the build as failed after SECONDS of silence]:SECONDS' \
         '--timeout=[mark the build as failed after SECONDS of activity]:SECONDS' \
-        '--verbosity=[use the given verbosity LEVEL]:LEVEL' \
         '--rounds=[build N times in a row to detect non-determinism]:N' \
-        '--cores=[allow the use of up to N CPU cores for the build]:N' \
+        {-c,--cores=}'[allow the use of up to N CPU cores for the build]:N' \
-        '--max-jobs=[allow at most N build jobs]:N' \
+        {-M,--max-jobs=}'[allow at most N build jobs]:N' \
-        '--derivation[return the derivation of the given system]' \
+        '--debug=[produce debugging output at LEVEL]:LEVEL' \
-        '--on-error=[apply STRATEGY when an error occurs while reading FILE]:STRATEGY' \
+        {-d,--derivation}'[return the derivation of the given system]' \
-        '--image-size=[for "image", produce an image of SIZE]:SIZE' \
+        {-e,--expression=}'[consider the operating-system EXPR evaluates to instead of reading FILE, when applicable]:EXPR' \
-        '--no-grub[for "init", do not install GRUB]' \
+        '--allow-downgrades[for reconfigure, allow downgrades to earlier channel revisions]' \
-        '--share=[for "vm", share host file system according to SPEC]:SPEC' \
+        '--on-error=[apply STRATEGY  when an error occurs while reading FILE]:STRATEGY:(nothing-special backtrace debug)' \
-        '--expose=[for "vm", expose host file system according to SPEC]:SPEC' \
+        '--list-image-types[list available image types]' \
-        '--full-boot[for "vm", make a full boot sequence]' \
+        {-t,--image-type=}'[for image, produce an image of TYPE]:TYPE' \
+        '--image-size=[for image, produce an image of SIZE]:SIZE' \
+        '--no-bootloader[for init, do not install a bootloader]' \
+        '--volatile[for image, make the root file system volatile]' \
+        '--label=[for image, label disk image with LABEL]:LABEL' \
+        '--save-provenance[save provenance information]' \
+        '--share=[for vm and container, share host file system with read/write access according to SPEC]:SPEC' \
+        '--expose=[for vm and container, expose host file system directory as read-only according to SPEC]:SPEC' \
+        {-N,--network}'[for container, allow containers to access the network]' \
+        {-r,--root=}'[for vm, image, container and build, make FILE a symlink to the result, and register it as a GC root]:FILE:_files' \
+        '--full-boot[for vm, make a full boot sequence]' \
+        '--skip-checks[skip file system and initrd module safety checks]' \
+        '--target=[cross-build for TRIPLET (e.g. "armel-linux-gnu")]:TRIPLET' \
+        {-v,--verbosity=}'[use the given verbosity LEVEL]:LEVEL' \
+        '--graph-backend=[use BACKEND for extension-graphs and shepherd-graph]:BACKEND' \
+        {-V,--version}'[display version information and exit]' \
         '1:action:->actions' \
         '*:file:_files'
 
@@ -405,20 +596,35 @@ _guix_list_installed_packages()
         "build:Build a given package"
         "challenge:Challenge the substitutes for a package"
         "container:Build and manipulate Linux containers"
+        "copy:Copy store items remotely over SSH"
+        "deploy:Deploy operating systems on a set of machines"
+        "describe:Describe the channel revisions currently used"
         "download:Download the file at given URL and add it to the store"
         "edit:Edit the definitions of a package"
         "environment:Build an environment with a package and its dependencies"
         "gc:Invoke the garbage collector"
+        "git:Operate on Git repositories"
         "graph:Emit a DOT representation of the dependencies of a package"
         "hash:Return the cryptographic hash of a file"
         "import:Run an importer"
+        "install:Install packages"
         "lint:Run a set of checkers on a package"
+        "offload:Set up and operate build offloading"
+        "pack:Create application bundles"
         "package:Install, remove, or upgrade packages"
+        "processes:List currently running sessions"
         "publish:Publish /gnu/store over HTTP."
         "pull:Download and deploy the latest version of Guix"
         "refresh:Update package definitions to match the latest version"
+        "remove:Remove packages"
+        "repl:Read-eval-print loop (REPL) for interactive programming"
+        "search:Search for packages"
+        "show:Show information about packages"
         "size:Report the size of a package and its dependencies"
         "system:Build the operating system"
+        "time-machine:Run commands from a different revision"
+        "upgrade:Upgrade packages"
+        "weather:Report on the availability of pre-built package binaries"
     )
 
     if (( CURRENT == 1 )); then

etc/disarchive-manifest.scm

@@ -0,0 +1,112 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Ludovic Courtès <ludo@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/>.
+
+;;; This file returns a manifest that builds a directory containing Disarchive
+;;; metadata for all the tarballs packages refer to.
+
+(use-modules (srfi srfi-1) (ice-9 match)
+             (guix packages) (guix gexp) (guix profiles)
+             (guix base16)
+             (gnu packages))
+
+(include "source-manifest.scm")
+
+(define (tarball-origin? origin)
+  (match (origin-actual-file-name origin)
+    (#f #f)
+    ((? string? file)
+     ;; As of version 0.2.1, Disarchive can only deal with raw tarballs and
+     ;; gzip-compressed tarballs.
+     (and (origin-hash origin)
+          (or (string-suffix? ".tar.gz" file)
+              (string-suffix? ".tgz" file)
+              (string-suffix? ".tar" file))))))
+
+(define (origin->disarchive origin)
+  "Return a directory containing Disarchive metadata for ORIGIN, a tarball, or
+an empty directory if ORIGIN could not be disassembled."
+  (define file-name
+    (let ((hash (origin-hash origin)))
+      (string-append (symbol->string (content-hash-algorithm hash))
+                     "/"
+                     (bytevector->base16-string
+                      (content-hash-value hash)))))
+
+  (define disarchive
+    (specification->package "disarchive"))
+
+  (define build
+    (with-imported-modules '((guix build utils))
+      #~(begin
+          (use-modules (guix build utils)
+                       (srfi srfi-34))
+
+          (define tarball
+            #+(upstream-origin origin))
+
+          (define file-name
+            (string-append #$output "/" #$file-name))
+
+          (define profile
+            #+(profile (content (packages->manifest (list disarchive)))))
+
+          (mkdir-p (dirname file-name))
+          (setenv "PATH" (string-append profile "/bin"))
+          (setenv "GUILE_LOAD_PATH"
+                  (string-append profile "/share/guile/site/"
+                                 (effective-version)))
+          (setenv "GUILE_LOAD_COMPILED_PATH"
+                  (string-append profile "/lib/guile/" (effective-version)
+                                 "/site-ccache"))
+
+          (guard (c ((invoke-error? c)
+                     ;; Sometimes Disarchive fails with "could not find Gzip
+                     ;; compressor".  When that happens, produce an empty
+                     ;; directory instead of failing.
+                     (report-invoke-error c)
+                     (delete-file file-name)))
+            (with-output-to-file file-name
+              (lambda ()
+                ;; Disarchive records the tarball name in its output.  Thus,
+                ;; strip the hash from TARBALL.
+                (let ((short-name (strip-store-file-name tarball)))
+                  (symlink tarball short-name)
+                  (invoke "disarchive" "disassemble" short-name))))))))
+
+  (computed-file (match (origin-actual-file-name origin)
+                   ((? string? str) (string-append str ".dis"))
+                   (#f "anonymous-tarball.dis"))
+                 build))
+
+(define (disarchive-collection origins)
+  "Return a directory containing all the Disarchive metadata for ORIGINS."
+  (directory-union "disarchive-collection"
+                   (filter-map (lambda (origin)
+                                 (and (tarball-origin? origin)
+                                      (origin->disarchive origin)))
+                               origins)
+                   #:copy? #t))
+
+
+;; The manifest containing Disarchive data.
+(let ((origins (all-origins)))
+  (manifest
+   (list (manifest-entry
+           (name "disarchive-collection")
+           (version (length origins))
+           (item (disarchive-collection origins))))))

etc/guix-daemon.cil.in

@@ -301,7 +301,7 @@
                 open read write)))
   (allow guix_daemon_t
          guix_daemon_conf_t
-         (lnk_file (create getattr rename unlink)))
+         (lnk_file (create getattr rename unlink read)))
   (allow guix_daemon_t net_conf_t
          (file (getattr open read)))
   (allow guix_daemon_t net_conf_t
@@ -328,6 +328,9 @@
   (allow guix_daemon_t
          cache_home_t
          (dir (search)))
+  (allow guix_daemon_t
+         cache_home_t
+         (lnk_file (getattr read)))
 
   ;; self upgrades
   (allow guix_daemon_t
@@ -340,7 +343,7 @@
   ;; Socket operations
   (allow guix_daemon_t
          guix_daemon_socket_t
-         (sock_file (unlink)))
+         (sock_file (unlink write)))
   (allow guix_daemon_t
          init_t
          (fd (use)))

etc/guix-daemon.conf.in

@@ -7,4 +7,4 @@ start on runlevel [2345]
 
 stop on runlevel [016]
 
-exec @localstatedir@/guix/profiles/per-user/root/current-guix/bin/guix-daemon --build-users-group=guixbuild
+exec @localstatedir@/guix/profiles/per-user/root/current-guix/bin/guix-daemon --build-users-group=guixbuild --discover=no

etc/guix-daemon.service.in

@@ -6,7 +6,8 @@
 Description=Build daemon for GNU Guix
 
 [Service]
-ExecStart=@localstatedir@/guix/profiles/per-user/root/current-guix/bin/guix-daemon --build-users-group=guixbuild
+ExecStart=@localstatedir@/guix/profiles/per-user/root/current-guix/bin/guix-daemon \
+    --build-users-group=guixbuild --discover=no
 Environment='GUIX_LOCPATH=@localstatedir@/guix/profiles/per-user/root/guix-profile/lib/locale' LC_ALL=en_US.utf8
 RemainAfterExit=yes
 StandardOutput=syslog

etc/guix-gc.service.in

@@ -0,0 +1,20 @@
+# This is a "service unit file" for the systemd init system to perform a
+# one-shot 'guix gc' operation.  It is meant to be triggered by a timer.
+# Drop it in /etc/systemd/system or similar together with 'guix-gc.timer'
+# to set it up.
+
+[Unit]
+Description=Discard unused Guix store items
+
+[Service]
+Type=oneshot
+# Customize the 'guix gc' arguments to fit your needs.
+ExecStart=@localstatedir@/guix/profiles/per-user/root/current-guix/bin/guix gc -d 1m -F 10G
+PrivateDevices=yes
+PrivateNetwork=yes
+PrivateUsers=no
+ProtectKernelTunables=yes
+ProtectKernelModules=yes
+ProtectControlGroups=yes
+MemoryDenyWriteExecute=yes
+SystemCallFilter=@default @file-system @basic-io @system-service

etc/guix-gc.timer

@@ -0,0 +1,15 @@
+# This is a "timer unit file" for the systemd init system to trigger
+# 'guix-gc.service' periodically.  Drop it in /etc/systemd/system or similar
+# together with 'guix-gc.service' to set it up.
+
+[Unit]
+Description=Discard unused Guix store items
+
+[Timer]
+OnCalendar=weekly
+AccuracySec=1h
+Persistent=true
+RandomizedDelaySec=6000
+
+[Install]
+WantedBy=timers.target

etc/guix-install.sh

@@ -9,6 +9,7 @@
 # Copyright © 2020 Daniel Brooks <db48x@db48x.net>
 # Copyright © 2021 Jakub Kądziołka <kuba@kadziolka.net>
 # Copyright © 2021 Chris Marusich <cmmarusich@gmail.com>
+# Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 #
 # This file is part of GNU Guix.
 #
@@ -64,12 +65,12 @@ INF="[ INFO ] "
 DEBUG=0
 GNU_URL="https://ftp.gnu.org/gnu/guix/"
 #GNU_URL="https://alpha.gnu.org/gnu/guix/"
-OPENPGP_SIGNING_KEY_ID="3CE464558A84FDC69DB40CFB090B11993D9AEBB5"
 
-# This script needs to know where root's home directory is.  However, we
+# The following associative array holds set of GPG keys used to sign the
-# cannot simply use the HOME environment variable, since there is no guarantee
+# releases, keyed by their corresponding Savannah user ID.
-# that it points to root's home directory.
+declare -A GPG_SIGNING_KEYS
-ROOT_HOME="$(echo ~root)"
+GPG_SIGNING_KEYS[15145]=3CE464558A84FDC69DB40CFB090B11993D9AEBB5  # ludo
+GPG_SIGNING_KEYS[127547]=27D586A4F8900854329FF09F1260E46482E63562 # maxim
 
 # ------------------------------------------------------------------------------
 #+UTILITIES
@@ -91,13 +92,25 @@ _debug()
     fi
 }
 
+# Return true if user answered yes, false otherwise.
+# $1: The prompt question.
+prompt_yes_no() {
+    while true; do
+        read -rp "$1 " yn
+        case $yn in
+            [Yy]*) return 0;;
+            [Nn]*) return 1;;
+            *) _msg "Please answer yes or no."
+        esac
+    done
+}
 
 chk_require()
 { # Check that every required command is available.
     declare -a warn
     local c
 
-    _debug "--- [ $FUNCNAME ] ---"
+    _debug "--- [ ${FUNCNAME[0]} ] ---"
 
     for c in "$@"; do
         command -v "$c" &>/dev/null || warn+=("$c")
@@ -112,29 +125,44 @@ chk_require()
 
 chk_gpg_keyring()
 { # Check whether the Guix release signing public key is present.
-    _debug "--- [ $FUNCNAME ] ---"
+    _debug "--- [ ${FUNCNAME[0]} ] ---"
+    local user_id
+    local gpg_key_id
+    local exit_flag
 
-    # Without --dry-run this command will create a ~/.gnupg owned by root on
+    for user_id in "${!GPG_SIGNING_KEYS[@]}"; do
-    # systems where gpg has never been used, causing errors and confusion.
+        gpg_key_id=${GPG_SIGNING_KEYS[$user_id]}
-    gpg --dry-run --list-keys ${OPENPGP_SIGNING_KEY_ID} >/dev/null 2>&1 || (
+        # Without --dry-run this command will create a ~/.gnupg owned by root on
-        _err "${ERR}Missing OpenPGP public key.  Fetch it with this command:"
+        # systems where gpg has never been used, causing errors and confusion.
-        echo "  wget 'https://sv.gnu.org/people/viewgpg.php?user_id=15145' -qO - | sudo -i gpg --import -"
+        if ! gpg --dry-run --list-keys "$gpg_key_id" >/dev/null 2>&1; then
+            if prompt_yes_no "${INF}The following OpenPGP public key is \
+required to verify the Guix binary signature: $gpg_key_id.
+Would you like me to fetch it for you? (yes/no)"; then
+                wget "https://sv.gnu.org/people/viewgpg.php?user_id=$user_id" \
+                     --no-verbose -O- | gpg --import -
+            else
+                _err "${ERR}Missing OpenPGP public key ($gpg_key_id).
+Fetch it with this command:
+
+  wget \"https://sv.gnu.org/people/viewgpg.php?user_id=$user_id\" -O - | \
+sudo -i gpg --import -"
+                exit_flag=yes
+            fi
+        fi
+    done
+    if [ "$exit_flag" = yes ]; then
         exit 1
-    )
+    fi
 }
 
 chk_term()
 { # Check for ANSI terminal for color printing.
-    local ansi_term
-
     if [ -t 2 ]; then
         if [ "${TERM+set}" = 'set' ]; then
             case "$TERM" in
                 xterm*|rxvt*|urxvt*|linux*|vt*|eterm*|screen*)
-                    ansi_term=true
                     ;;
                 *)
-                    ansi_term=false
                     ERR="[ FAIL ] "
                     PAS="[ PASS ] "
                     ;;
@@ -221,6 +249,16 @@ chk_sys_nscd()
     fi
 }
 
+# Configure substitute discovery according to user's preferences.
+# $1 is the installed service file to edit.
+configure_substitute_discovery() {
+    if grep -q -- '--discover=no' "$1" && \
+            prompt_yes_no "Would you like the Guix daemon to automatically \
+discover substitute servers on the local network? (yes/no)"; then
+        sed -i 's/--discover=no/--discover=yes/' "$1"
+    fi
+}
+
 # ------------------------------------------------------------------------------
 #+MAIN
 
@@ -231,10 +269,10 @@ guix_get_bin_list()
     local latest_ver
     local default_ver
 
-    _debug "--- [ $FUNCNAME ] ---"
+    _debug "--- [ ${FUNCNAME[0]} ] ---"
 
     # Filter only version and architecture
-    bin_ver_ls=("$(wget -qO- "$gnu_url" \
+    bin_ver_ls=("$(wget "$gnu_url" --no-verbose -O- \
         | sed -n -e 's/.*guix-binary-\([0-9.]*[a-z0-9]*\)\..*.tar.xz.*/\1/p' \
         | sort -Vu)")
 
@@ -260,25 +298,25 @@ guix_get_bin()
     local url="$1"
     local bin_ver="$2"
     local dl_path="$3"
+    local wget_args=()
 
-    _debug "--- [ $FUNCNAME ] ---"
+    _debug "--- [ ${FUNCNAME[0]} ] ---"
 
     _msg "${INF}Downloading Guix release archive"
 
-    wget --help | grep -q '\--show-progress' && \
+    wget --help | grep -q '\--show-progress' \
-        _PROGRESS_OPT="-q --show-progress" || _PROGRESS_OPT=""
+        && wget_args=("--no-verbose" "--show-progress")
-    wget $_PROGRESS_OPT -P "$dl_path" "${url}/${bin_ver}.tar.xz" "${url}/${bin_ver}.tar.xz.sig"
 
-    if [[ "$?" -eq 0 ]]; then
+    if wget "${wget_args[@]}" -P "$dl_path" \
-       _msg "${PAS}download completed."
+            "${url}/${bin_ver}.tar.xz" "${url}/${bin_ver}.tar.xz.sig"; then
+        _msg "${PAS}download completed."
     else
         _err "${ERR}could not download ${url}/${bin_ver}.tar.xz."
         exit 1
     fi
 
     pushd "${dl_path}" >/dev/null
-    gpg --verify "${bin_ver}.tar.xz.sig" >/dev/null 2>&1
+    if gpg --verify "${bin_ver}.tar.xz.sig" >/dev/null 2>&1; then
-    if [[ "$?" -eq 0 ]]; then
         _msg "${PAS}Signature is valid."
         popd >/dev/null
     else
@@ -292,53 +330,57 @@ sys_create_store()
     local pkg="$1"
     local tmp_path="$2"
 
-    _debug "--- [ $FUNCNAME ] ---"
+    _debug "--- [ ${FUNCNAME[0]} ] ---"
-
-    cd "$tmp_path"
-    tar --extract \
-        --file "$pkg" &&
-    _msg "${PAS}unpacked archive"
 
     if [[ -e "/var/guix" || -e "/gnu" ]]; then
         _err "${ERR}A previous Guix installation was found.  Refusing to overwrite."
         exit 1
-    else
-        _msg "${INF}Installing /var/guix and /gnu..."
-        mv "${tmp_path}/var/guix" /var/
-        mv "${tmp_path}/gnu" /
     fi
 
-    _msg "${INF}Linking the root user's profile"
+    cd "$tmp_path"
-    mkdir -p "${ROOT_HOME}/.config/guix"
+    tar --extract --file "$pkg" && _msg "${PAS}unpacked archive"
-    ln -sf /var/guix/profiles/per-user/root/current-guix \
-       "${ROOT_HOME}/.config/guix/current"
 
-    GUIX_PROFILE="${ROOT_HOME}/.config/guix/current"
+    _msg "${INF}Installing /var/guix and /gnu..."
+    mv "${tmp_path}/var/guix" /var/
+    mv "${tmp_path}/gnu" /
+
+    _msg "${INF}Linking the root user's profile"
+    mkdir -p "~root/.config/guix"
+    ln -sf /var/guix/profiles/per-user/root/current-guix \
+       "~root/.config/guix/current"
+
+    GUIX_PROFILE="~root/.config/guix/current"
+    # shellcheck disable=SC1090
     source "${GUIX_PROFILE}/etc/profile"
-    _msg "${PAS}activated root profile at ${ROOT_HOME}/.config/guix/current"
+    _msg "${PAS}activated root profile at ${GUIX_PROFILE}"
 }
 
 sys_create_build_user()
 { # Create the group and user accounts for build users.
 
-    _debug "--- [ $FUNCNAME ] ---"
+    _debug "--- [ ${FUNCNAME[0]} ] ---"
 
-    if [ $(getent group guixbuild) ]; then
+    if getent group guixbuild > /dev/null; then
         _msg "${INF}group guixbuild exists"
     else
         groupadd --system guixbuild
         _msg "${PAS}group <guixbuild> created"
     fi
 
+    if getent group kvm > /dev/null; then
+        _msg "${INF}group kvm exists and build users will be added to it"
+        local KVMGROUP=,kvm
+    fi
+
     for i in $(seq -w 1 10); do
         if id "guixbuilder${i}" &>/dev/null; then
             _msg "${INF}user is already in the system, reset"
-            usermod -g guixbuild -G guixbuild           \
+            usermod -g guixbuild -G guixbuild${KVMGROUP}     \
                     -d /var/empty -s "$(which nologin)" \
                     -c "Guix build user $i"             \
                     "guixbuilder${i}";
         else
-            useradd -g guixbuild -G guixbuild           \
+            useradd -g guixbuild -G guixbuild${KVMGROUP}     \
                     -d /var/empty -s "$(which nologin)" \
                     -c "Guix build user $i" --system    \
                     "guixbuilder${i}";
@@ -354,7 +396,7 @@ sys_enable_guix_daemon()
     local local_bin
     local var_guix
 
-    _debug "--- [ $FUNCNAME ] ---"
+    _debug "--- [ ${FUNCNAME[0]} ] ---"
 
     info_path="/usr/local/share/info"
     local_bin="/usr/local/bin"
@@ -363,8 +405,9 @@ sys_enable_guix_daemon()
     case "$INIT_SYS" in
         upstart)
             { initctl reload-configuration;
-              cp "${ROOT_HOME}/.config/guix/current/lib/upstart/system/guix-daemon.conf" \
+              cp "~root/.config/guix/current/lib/upstart/system/guix-daemon.conf" \
                  /etc/init/ &&
+                  configure_substitute_discovery /etc/init/guix-daemon.conf &&
                   start guix-daemon; } &&
                 _msg "${PAS}enabled Guix daemon via upstart"
             ;;
@@ -372,15 +415,15 @@ sys_enable_guix_daemon()
             { # systemd .mount units must be named after the target directory.
               # Here we assume a hard-coded name of /gnu/store.
               # XXX Work around <https://issues.guix.gnu.org/41356> until next release.
-              if [ -f "${ROOT_HOME}/.config/guix/current/lib/systemd/system/gnu-store.mount" ]; then
+              if [ -f "~root/.config/guix/current/lib/systemd/system/gnu-store.mount" ]; then
-                  cp "${ROOT_HOME}/.config/guix/current/lib/systemd/system/gnu-store.mount" \
+                  cp "~root/.config/guix/current/lib/systemd/system/gnu-store.mount" \
                      /etc/systemd/system/;
                   chmod 664 /etc/systemd/system/gnu-store.mount;
                   systemctl daemon-reload &&
                       systemctl enable gnu-store.mount;
               fi
 
-              cp "${ROOT_HOME}/.config/guix/current/lib/systemd/system/guix-daemon.service" \
+              cp "~root/.config/guix/current/lib/systemd/system/guix-daemon.service" \
                  /etc/systemd/system/;
               chmod 664 /etc/systemd/system/guix-daemon.service;
 
@@ -394,6 +437,9 @@ sys_enable_guix_daemon()
                        -e 's/^Environment=\(.*\)$/Environment=\1 LC_ALL=en_US.UTF-8';
               fi;
 
+              configure_substitute_discovery \
+                  /etc/systemd/system/guix-daemon.service
+
               systemctl daemon-reload &&
                   systemctl enable guix-daemon &&
                   systemctl start  guix-daemon; } &&
@@ -401,10 +447,12 @@ sys_enable_guix_daemon()
             ;;
         sysv-init)
             { mkdir -p /etc/init.d;
-              cp "${ROOT_HOME}/.config/guix/current/etc/init.d/guix-daemon" \
+              cp "~root/.config/guix/current/etc/init.d/guix-daemon" \
                  /etc/init.d/guix-daemon;
               chmod 775 /etc/init.d/guix-daemon;
 
+              configure_substitute_discovery /etc/init.d/guix-daemon
+
               update-rc.d guix-daemon defaults &&
                   update-rc.d guix-daemon enable &&
                   service guix-daemon start; } &&
@@ -412,17 +460,19 @@ sys_enable_guix_daemon()
             ;;
         openrc)
             { mkdir -p /etc/init.d;
-              cp "${ROOT_HOME}/.config/guix/current/etc/openrc/guix-daemon" \
+              cp "~root/.config/guix/current/etc/openrc/guix-daemon" \
                  /etc/init.d/guix-daemon;
               chmod 775 /etc/init.d/guix-daemon;
 
+              configure_substitute_discovery /etc/init.d/guix-daemon
+
               rc-update add guix-daemon default &&
                   rc-service guix-daemon start; } &&
                 _msg "${PAS}enabled Guix daemon via OpenRC"
             ;;
         NA|*)
             _msg "${ERR}unsupported init system; run the daemon manually:"
-            echo "  ${ROOT_HOME}/.config/guix/current/bin/guix-daemon --build-users-group=guixbuild"
+            echo "  ~root/.config/guix/current/bin/guix-daemon --build-users-group=guixbuild"
             ;;
     esac
 
@@ -439,21 +489,18 @@ sys_enable_guix_daemon()
 
 sys_authorize_build_farms()
 { # authorize the public key of the build farm
-    while true; do
+    if prompt_yes_no "Permit downloading pre-built package binaries from the \
-        read -p "Permit downloading pre-built package binaries from the project's build farm? (yes/no) " yn
+project's build farm? (yes/no)"; then
-        case $yn in
+        guix archive --authorize \
-            [Yy]*) guix archive --authorize < "${ROOT_HOME}/.config/guix/current/share/guix/ci.guix.gnu.org.pub" &&
+             < "~root/.config/guix/current/share/guix/ci.guix.gnu.org.pub" \
-                       _msg "${PAS}Authorized public key for ci.guix.gnu.org";
+            && _msg "${PAS}Authorized public key for ci.guix.gnu.org"
-                   break;;
+        else
-            [Nn]*) _msg "${INF}Skipped authorizing build farm public keys"
+            _msg "${INF}Skipped authorizing build farm public keys"
-                   break;;
+    fi
-            *) _msg "Please answer yes or no.";
-        esac
-    done
 }
 
 sys_create_init_profile()
-{ # Create /etc/profile.d/guix.sh for better desktop integration
+{ # Define for better desktop integration
   # This will not take effect until the next shell or desktop session!
     [ -d "/etc/profile.d" ] || mkdir /etc/profile.d # Just in case
     cat <<"EOF" > /etc/profile.d/guix.sh
@@ -470,7 +517,7 @@ export INFOPATH="$_GUIX_PROFILE/share/info:$INFOPATH"
 GUIX_PROFILE="$HOME/.guix-profile"
 [ -L $GUIX_PROFILE ] || return
 GUIX_LOCPATH="$GUIX_PROFILE/lib/locale"
-export GUIX_PROFILE GUIX_LOCPATH
+export GUIX_LOCPATH
 
 [ -f "$GUIX_PROFILE/etc/profile" ] && . "$GUIX_PROFILE/etc/profile"
 
@@ -527,7 +574,7 @@ This script installs GNU Guix on your system
 https://www.gnu.org/software/guix/
 EOF
     echo -n "Press return to continue..."
-    read -r  ANSWER
+    read -r
 }
 
 main()
@@ -549,10 +596,19 @@ main()
     umask 0022
     tmp_path="$(mktemp -t -d guix.XXX)"
 
-    guix_get_bin_list "${GNU_URL}"
+    if [ -z "${GUIX_BINARY_FILE_NAME}" ]; then
-    guix_get_bin "${GNU_URL}" "${BIN_VER}" "$tmp_path"
+        guix_get_bin_list "${GNU_URL}"
+        guix_get_bin "${GNU_URL}" "${BIN_VER}" "$tmp_path"
+        GUIX_BINARY_FILE_NAME=${BIN_VER}.tar.xz
+    else
+        if ! [[ $GUIX_BINARY_FILE_NAME =~ $ARCH_OS ]]; then
+            _err "$ARCH_OS not in ${GUIX_BINARY_FILE_NAME}; aborting"
+        fi
+        _msg "${INF}Using manually provided binary ${GUIX_BINARY_FILE_NAME}"
+        GUIX_BINARY_FILE_NAME=$(realpath "$GUIX_BINARY_FILE_NAME")
+    fi
 
-    sys_create_store "${BIN_VER}.tar.xz" "${tmp_path}"
+    sys_create_store "${GUIX_BINARY_FILE_NAME}" "${tmp_path}"
     sys_create_build_user
     sys_enable_guix_daemon
     sys_authorize_build_farms

etc/indent-code.el

@@ -99,6 +99,8 @@
                             nil t)
          (let ((indent-tabs-mode nil))
            (beginning-of-defun)
+           (mark-sexp)
+           (untabify (point) (mark))
            (indent-sexp)
            (save-buffer)
            (message "Done!"))
@@ -108,6 +110,7 @@
      ;; Indent all of FILE-NAME.
      (find-file file-name)
      (let ((indent-tabs-mode nil))
+       (untabify (point-min) (point-max))
        (indent-region (point-min) (point-max))
        (save-buffer)
        (message "Done!")))

etc/init.d/guix-daemon.in

@@ -36,7 +36,7 @@ start)
       -E LC_ALL=en_US.utf8 \
       -p "/var/run/guix-daemon.pid" \
       @localstatedir@/guix/profiles/per-user/root/current-guix/bin/guix-daemon \
-      --build-users-group=guixbuild
+      --build-users-group=guixbuild --discover=no
   fi
   ;;
 stop)

etc/news.scm

@@ -14,6 +14,8 @@
 ;; Copyright © 2021 Zhu Zihao <all_but_last@163.com>
 ;; Copyright © 2021 Chris Marusich <cmmarusich@gmail.com>
 ;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
 ;;
 ;; Copying and distribution of this file, with or without modification, are
 ;; permitted in any medium without royalty provided the copyright notice and
@@ -21,6 +23,199 @@
 
 (channel-news
  (version 0)
+(entry (commit "a2324d8b56eabf8117bca220a507cc791edffd2e")
+        (title
+         (en "Guix Home is a part of GNU Guix")
+         (de "Guix Home ist jetzt Teil von GNU Guix")
+         (ru "Guix Home теперь поставляется в составе GNU Guix"))
+        (body
+         (en "Guix Home splitted out from rde project and now is a part of
+Guix proper.  It is available as a @emph{technology preview} and thus subject
+to change.
+
+The new @command{guix home} command with its actions allows users to
+manage their packages and configurations (aka. dotfiles) in a declarative way,
+similar to how many people manage their system with @command{guix system}.
+
+Take a look at available actions and arguments:
+@example
+guix home --help
+@end example
+
+See @command{info \"(guix) Home Configuration\"} for more information.")
+         (de "Guix Home ist aus dem rde-Projekt ins offizielle Guix übernommen
+worden. Es ist als @emph{Technologievorschau} bereits verfügbar, aber die
+Schnittstelle kann sich in Zukunft noch ändern.
+
+Der neue Befehl @command{guix home} ermöglicht es, die Pakete und
+Konfigurationsdateien (Dotfiles) für ein Benutzerkonto im deklarativen Stil zu
+verwalten. Es ist analog dazu, wie man @command{guix system} benutzen kann, um
+sein System zu verwalten.
+
+Werfen Sie einen Blick auf die verfügbaren Aktionen und Argumente:
+@example
+guix home --help
+@end example
+
+Führen Sie für mehr Informationen @command{info \"(guix) Home Configuration\"}
+aus.")
+         (ru "Guix Home отделился от проекта rde и теперь является частью
+Guix.  Новая команда @command{guix home} даёт возможность пользователям
+управлять их пакетами и конфигурациями (дотфайлами) для них в декларативном
+стиле, аналогично тому, как многие люди управляют своими системами с помощью
+@command{guix system}.
+
+Чтобы получить список доступных действий и аргументов:
+@example
+guix home --help
+@end example
+
+Смотрите @command{info \"(guix) Home Configuration\"} для получения более
+детальных сведений.")))
+
+ (entry (commit "5b32ad4f6f555d305659cee825879df075b06331")
+        (title
+         (en "New @option{--max-depth} option for @command{guix graph}")
+         (de "Neue Option @option{--max-depth} für @command{guix graph}")
+         (fr "Nouvelle option @option{--max-depth} pour @command{guix graph}"))
+        (body
+         (en "The @command{guix graph} command has a new @option{--max-depth}
+(or @option{-M}) option, which allows you to restrict a graph to the given
+depth---very useful when visualizing large graphs.  For example, the command
+below displays, using the @code{xdot} package, the dependency graph of
+LibreOffice, including only nodes that are at most at distance 2 of
+LibreOffice itself:
+
+@example
+guix graph -M 2 libreoffice | xdot -
+@end example
+
+See @command{info \"(guix) Invoking guix graph\"} for more information.")
+         (de "Der Befehl @command{guix graph} verfügt über eine neue
+Befehlszeilenoption @option{--max-depth} (oder @option{-M}), mit der
+Sie einen Graphen auf die angegebene Tiefe einschränken. Das ist vor
+allem bei großen Graphen nützlich; zum Beispiel zeigt der folgende
+Befehl, unter Verwendung des Pakets @code{xdot}, den
+Abhängigkeitsgraphen von LibreOffice unter Ausschluss der Knoten, die
+eine Distanz größer als 2 von LibreOffice selbst haben:
+
+@example
+guix graph -M 2 libreoffice | xdot -
+@end example
+
+Führen Sie @code{info \"(guix.de) Aufruf von guix graph\"} aus, um mehr zu
+erfahren.")
+         (fr "La commande @command{guix graph} dispose d'une nouvelle option
+@option{--max-depth} (ou @option{-M}) pour restreindre la profondeur d'un
+graphe---très utile pour visualiser des gros graphes.  Par exemple, la
+commande ci-dessous affiche, en utilisant @code{xdot}, le graphe de dépendance
+de LibreOffice en n'incluant que les nœuds qui sont au plus à distance 2 de
+LibreOffice soi-même :
+
+@example
+guix graph -M 2 libreoffice | xdot -
+@end example
+
+Voir @command{info \"(guix.fr) Invoquer guix graph\"} pour plus
+d'informations.")))
+
+ (entry (commit "05f44c2d858a1e7b13c90362c35fa86bdc4d5a24")
+        (title
+         (en "Channel clones fall back to Software Heritage")
+         (de "Zum Klonen von Kanälen wird notfalls auf Software Heritage zurückgegriffen")
+         (fr "Les clones de canaux peuvent recourir à Software Heritage"))
+        (body
+         (en "When @command{guix time-machine} or @command{guix pull} fetches
+a channel pinned to a specific commit, it now automatically falls back to
+cloning it from the Software Heritage archive if the original URL is
+unreachable.  This contributes to long-term reproducibility.  See
+@command{info \"(guix) Replicating Guix\"}.
+
+Automatic fallback also works for other Git clones made on your behalf, such
+as when using @option{--with-commit} and related package transformation
+options.")
+         (de "Wenn bei @command{guix time-machine} oder @command{guix
+pull} ein bestimmter Commit eines Kanals bezogen werden soll, wird
+jetzt für den Fall, dass die ursprüngliche URL unerreichbar ist,
+automatisch vom Software-Heritage-Archiv geklont. Das trägt zur
+langfristigen Reproduzierbarkeit bei. Siehe @command{info \"(guix.de)
+Guix nachbilden\"}.
+
+Der automatische Rückgriff auf Software Heritage findet auch
+Verwendung bei anderen Arten von Git-Klon, die Guix durchführt, z.B.@:
+wenn Sie @option{--with-commit} und ähnliche Paketumwandlungsoptionen
+einsetzen.")
+         (fr "Quand la commande @command{guix time-machine} ou @command{guix
+pull} récupère un canal fixé à une révision spécifique, elle est maintenant
+capable de le cloner depuis l'archive Software Heritage si l'URL initiale
+n'est plus disponible.  Cela contribue à la reproductibilité à long terme.
+Voir @command{info \"(guix.fr) Répliquer Guix\"}.
+
+Ce recours à Software Heritage fonctionne aussi pour les autres clones Git que
+Guix peut faire, comme lorsqu'on utilise @option{--with-commit} et les options
+de transformation de paquet similaires.")))
+
+ (entry (commit "82daab42811a2e3c7684ebdf12af75ff0fa67b99")
+        (title
+         (en "New @samp{deb} format for the @command{guix pack} command")
+         (de "Neues Format @samp{deb} für den Befehl @command{guix pack}"))
+        (body
+         (en "Debian archives (with the .deb file extension) can now be
+produced via the @command{guix pack --format=deb} command, providing an
+alternative distribution path for software built with Guix.  Here is a simple
+example that generates a Debian archive for the @code{hello} package:
+
+@example
+guix pack --format=deb --symlink=/usr/bin/hello=bin/hello hello
+@end example
+
+See @command{info \"(guix) Invoking guix pack\"} for more information.")
+         (de "Debian-Archive (mit der Dateinamenserweiterung .deb) können
+jetzt auch mit dem Befehl @command{guix pack --format=deb} erzeugt werden, um
+mit Guix erstellte Software auf andere Art anzubieten.  Hier sehen Sie ein
+einfaches Beispiel, wie ein Debian-Archiv für das Paket @code{hello} angelegt
+wird:
+
+@example
+guix pack --format=deb --symlink=/usr/bin/hello=bin/hello hello
+@end example
+
+Siehe @command{info \"(guix.de) Aufruf von guix pack\"} für mehr
+Informationen.")))
+
+ (entry (commit "bdc298ecee15283451d3aa20a849dd7bb22c8538")
+        (title
+         (en "New @command{guix import egg} command")
+         (de "Neuer Befehl @command{guix import egg}")
+         (zh "新的 @command{guix import egg} 命令"))
+        (body
+         (en "The new @command{guix import egg} command allows packagers to
+generate a package definition or a template thereof given the name of a
+CHICKEN egg package, like so:
+
+@example
+guix import egg sourcehut
+@end example
+
+Run @command{info \"(guix) Invoking guix import\"} for more info.")
+         (de "Mit dem neuen Befehl @command{guix import egg} können
+Paketautoren eine Paketdefinition oder eine Vorlage dafür anhand des Namens
+eines „Egg“-Pakets für CHICKEN erzeugen, etwa so:
+
+@example
+guix import egg sourcehut
+@end example
+
+Führen Sie @command{info \"(guix.de) Aufruf von guix import\"} aus, um mehr
+Informationen zu bekommen.")
+         (zh "新的 @command{guix import egg} 命令能让贡献者从一个CHICKEN egg生
+成一个包装或包装样板。
+
+@example
+guix import egg sourcehut
+@end example
+
+想了解更多可以运行 @command{info \"(guix) Invoking guix import\"}。")))
 
  (entry (commit "2161820ebbbab62a5ce76c9101ebaec54dc61586")
         (title

etc/openrc/guix-daemon.in

@@ -20,7 +20,7 @@
 export GUIX_LOCPATH=@localstatedir@/guix/profiles/per-user/root/guix-profile/lib/locale
 export LC_ALL=en_US.utf8
 command="@localstatedir@/guix/profiles/per-user/root/current-guix/bin/guix-daemon"
-command_args="--build-users-group=guixbuild"
+command_args="--build-users-group=guixbuild --discover=no"
 command_background="yes"
 pidfile="/var/run/guix-daemon.pid"
 

etc/release-manifest.scm

@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -49,6 +49,14 @@ TARGET."
        '("bootstrap-tarballs" "gcc-toolchain" "nss-certs"
          "openssh" "emacs" "vim" "python" "guile" "guix")))
 
+(define %base-packages/armhf
+  ;; XXX: Relax requirements for armhf-linux for lack of enough build power.
+  (map (lambda (package)
+         (if (string=? (package-name package) "emacs")
+             (specification->package "emacs-no-x")
+             package))
+       %base-packages))
+
 (define %base-packages/hurd
   ;; XXX: For now we are less demanding of "i586-gnu".
   (map specification->package
@@ -100,9 +108,18 @@ TARGET."
   (manifest
    (append-map (lambda (system)
                  (map (cut package->manifest-entry* <> system)
-                      (if (string=? system "i586-gnu")
+                      (cond ((string=? system "i586-gnu")
-                          %base-packages/hurd
+                             %base-packages/hurd)
-                          %base-packages)))
+                            ((string=? system "armhf-linux")
+                             ;; FIXME: Drop special case when ci.guix.gnu.org
+                             ;; has more ARMv7 build power.
+                             %base-packages/armhf)
+                            ((string=? system "powerpc64le-linux")
+                             ;; FIXME: Drop 'bootstrap-tarballs' until
+                             ;; <https://bugs.gnu.org/48055> is fixed.
+                             (drop %base-packages 1))
+                            (else
+                             %base-packages))))
                %cuirass-supported-systems)))
 
 (define %system-manifest

etc/snippets/scheme-mode/guix-origin

@@ -19,7 +19,9 @@
                  (t "(string-append \\"https://\\" version \\".tar.gz\\")"))}$0)
  ${1:$(cond ((equal yas-text "git-fetch")
              "(file-name (git-file-name name version))")
-            ((member yas-text '("svn-fetch" "hg-fetch" "cvs-fetch" "bzr-fetch"))
+            ((equal yas-text "hg-fetch")
+             "(file-name (hg-file-name name version))")
+            ((member yas-text '("svn-fetch" "cvs-fetch" "bzr-fetch"))
              "(file-name (string-append name \\"-\\" version \\"-checkout\\"))")
             (t ""))}
  (sha256

etc/source-manifest.scm

@@ -0,0 +1,66 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Ludovic Courtès <ludo@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/>.
+
+;;; This file returns a manifest containing origins of all the packages.  The
+;;; main purpose is to allow continuous integration services to keep upstream
+;;; source code around.  It can also be passed to 'guix weather -m'.
+
+(use-modules (srfi srfi-1) (srfi srfi-26)
+             (ice-9 match) (ice-9 vlist)
+             (guix packages) (guix profiles)
+             (gnu packages))
+
+(define (all-packages)
+  "Return the list of all the packages, public or private, omitting only
+superseded packages."
+  (fold-packages (lambda (package lst)
+                   (match (package-replacement package)
+                     (#f (cons package lst))
+                     (replacement
+                      (append (list replacement package) lst))))
+                 '()
+                 #:select? (negate package-superseded)))
+
+(define (upstream-origin source)
+  "Return SOURCE without any patches or snippet."
+  (origin (inherit source)
+          (snippet #f) (patches '())))
+
+(define (all-origins)
+  "Return the list of origins referred to by all the packages."
+  (let loop ((packages (all-packages))
+             (origins  '())
+             (visited   vlist-null))
+    (match packages
+      ((head . tail)
+       (let ((new (remove (cut vhash-assq <> visited)
+                          (package-direct-sources head))))
+         (loop tail (append new origins)
+               (fold (cut vhash-consq <> #t <>)
+                     visited new))))
+      (()
+       origins))))
+
+;; Return a manifest containing all the origins.
+(manifest (map (lambda (origin)
+                 (manifest-entry
+                   (name (or (origin-actual-file-name origin)
+                             "origin"))
+                   (version "0")
+                   (item (upstream-origin origin))))
+               (all-origins)))

etc/substitutes/bordeaux.guix.gnu.org.pub

@@ -0,0 +1,6 @@
+(public-key
+ (ecc
+  (curve Ed25519)
+  (q #7D602902D3A2DBB83F8A0FB98602A754C5493B0B778C8D1DD4E0F41DE14DE34F#)
+  )
+ )

gnu/bootloader.scm

@@ -2,7 +2,7 @@
 ;;; Copyright © 2017 David Craven <david@craven.ch>
 ;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
-;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -25,7 +25,10 @@
   #:use-module (guix gexp)
   #:use-module (guix profiles)
   #:use-module (guix records)
-  #:use-module (guix ui)
+  #:use-module (guix deprecation)
+  #:use-module ((guix ui) #:select (warn-about-load-error))
+  #:use-module (guix diagnostics)
+  #:use-module (guix i18n)
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
   #:export (menu-entry
@@ -55,7 +58,8 @@
             bootloader-configuration
             bootloader-configuration?
             bootloader-configuration-bootloader
-            bootloader-configuration-target
+            bootloader-configuration-target ;deprecated
+            bootloader-configuration-targets
             bootloader-configuration-menu-entries
             bootloader-configuration-default-entry
             bootloader-configuration-timeout
@@ -179,12 +183,17 @@ record."
 ;; The <bootloader-configuration> record contains bootloader independant
 ;; configuration used to fill bootloader configuration file.
 
+(define-syntax-rule (warn-target-field-deprecation value)
+  (%warn-target-field-deprecation value (current-source-location)))
+
 (define-record-type* <bootloader-configuration>
   bootloader-configuration make-bootloader-configuration
   bootloader-configuration?
   (bootloader         bootloader-configuration-bootloader) ;<bootloader>
-  (target             bootloader-configuration-target      ;string
+  (targets            %bootloader-configuration-targets    ;list of strings
                       (default #f))
+  (target             %bootloader-configuration-target ;deprecated
+                      (default #f) (sanitize warn-target-field-deprecation))
   (menu-entries       bootloader-configuration-menu-entries ;list of <menu-entry>
                       (default '()))
   (default-entry      bootloader-configuration-default-entry ;integer
@@ -204,6 +213,26 @@ record."
   (serial-speed       bootloader-configuration-serial-speed ;integer | #f
                       (default #f)))
 
+(define (%warn-target-field-deprecation value location)
+  (when value
+    (warning (source-properties->location location)
+             (G_ "the 'target' field is deprecated, please use 'targets' \
+instead~%")))
+  value)
+
+(define-deprecated (bootloader-configuration-target config)
+  bootloader-configuration-targets
+  (%bootloader-configuration-target config))
+
+(define (bootloader-configuration-targets config)
+  (or (%bootloader-configuration-targets config)
+      ;; TODO: Remove after the deprecated 'target' field is removed.
+      (list (%bootloader-configuration-target config))
+      ;; XXX: At least the GRUB installer (see (gnu bootloader grub)) has this
+      ;; peculiar behavior of installing fonts and GRUB modules when DEVICE is #f,
+      ;; hence the default value of '(#f) rather than '().
+      (list #f)))
+
 
 ;;;
 ;;; Bootloaders.

gnu/bootloader/grub.scm

@@ -647,11 +647,12 @@ below the directory TARGET for the system whose root is mounted at MOUNT-POINT.
 MOUNT-POINT is the last argument in 'guix system init /etc/config.scm mnt/point'
 or '/' for other 'guix system' commands.
 
-TARGET is the target argument given to the bootloader-configuration in
+Where TARGET comes from the targets argument given to the
+bootloader-configuration in:
 
 (operating-system
  (bootloader (bootloader-configuration
-              (target \"/boot\")
+              (targets '(\"/boot\"))
               …))
  …)
 

gnu/bootloader/u-boot.scm

@@ -73,9 +73,12 @@
 
 (define install-allwinner64-u-boot
   #~(lambda (bootloader root-index image)
-      (let ((spl (string-append bootloader "/libexec/u-boot-sunxi-with-spl.fit.itb")))
+      (let ((spl (string-append bootloader "/libexec/u-boot-sunxi-with-spl.bin"))
+            (u-boot (string-append bootloader "/libexec/u-boot-sunxi-with-spl.fit.itb")))
         (write-file-on-device spl (stat:size (stat spl))
-                              image (* 8 1024)))))
+                              image (* 8 1024))
+        (write-file-on-device u-boot (stat:size (stat u-boot))
+                              image (* 40 1024)))))
 
 (define install-imx-u-boot
   #~(lambda (bootloader root-index image)

gnu/build/activation.scm

@@ -6,6 +6,8 @@
 ;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
 ;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2020 Christine Lemmer-Webber <cwebber@dustycloud.org>
+;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,6 +26,7 @@
 
 (define-module (gnu build activation)
   #:use-module (gnu system accounts)
+  #:use-module (gnu system setuid)
   #:use-module (gnu build accounts)
   #:use-module (gnu build linux-boot)
   #:use-module (guix build utils)
@@ -279,14 +282,17 @@ they already exist."
   "/run/setuid-programs")
 
 (define (activate-setuid-programs programs)
-  "Turn PROGRAMS, a list of file names, into setuid programs stored under
+  "Turn PROGRAMS, a list of file setuid-programs record, into setuid programs
-%SETUID-DIRECTORY."
+stored under %SETUID-DIRECTORY."
-  (define (make-setuid-program prog)
+  (define (make-setuid-program program setuid? setgid? uid gid)
     (let ((target (string-append %setuid-directory
-                                 "/" (basename prog))))
+                                 "/" (basename program)))
-      (copy-file prog target)
+          (mode (+ #o0555                   ; base permissions
-      (chown target 0 0)
+                   (if setuid? #o4000 0)    ; setuid bit
-      (chmod target #o4555)))
+                   (if setgid? #o2000 0)))) ; setgid bit
+      (copy-file program target)
+      (chown target uid gid)
+      (chmod target mode)))
 
   (format #t "setting up setuid programs in '~a'...~%"
           %setuid-directory)
@@ -302,15 +308,27 @@ they already exist."
   (for-each (lambda (program)
               (catch 'system-error
                 (lambda ()
-                  (make-setuid-program program))
+                  (let* ((program-name (setuid-program-program program))
+                         (setuid?      (setuid-program-setuid? program))
+                         (setgid?      (setuid-program-setgid? program))
+                         (user         (setuid-program-user program))
+                         (group        (setuid-program-group program))
+                         (uid (match user
+                                ((? string?) (passwd:uid (getpwnam user)))
+                                ((? integer?) user)))
+                         (gid (match group
+                                ((? string?) (group:gid (getgrnam group)))
+                                ((? integer?) group))))
+                    (make-setuid-program program-name setuid? setgid? uid gid)))
                 (lambda args
                   ;; If we fail to create a setuid program, better keep going
                   ;; so that we don't leave %SETUID-DIRECTORY empty or
                   ;; half-populated.  This can happen if PROGRAMS contains
                   ;; incorrect file names: <https://bugs.gnu.org/38800>.
                   (format (current-error-port)
-                          "warning: failed to make '~a' setuid-root: ~a~%"
+                          "warning: failed to make ~s setuid/setgid: ~a~%"
-                          program (strerror (system-error-errno args))))))
+                          (setuid-program-program program)
+                          (strerror (system-error-errno args))))))
             programs))
 
 (define (activate-special-files special-files)

gnu/build/file-systems.scm

@@ -3,7 +3,7 @@
 ;;; Copyright © 2016, 2017 David Craven <david@craven.ch>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
-;;; Copyright © 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2019–2021 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2019 David C. Trudgian <dave@trudgian.net>
 ;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
@@ -166,14 +166,23 @@ if DEVICE does not contain an ext2 file system."
   (sub-bytevector sblock 104 16))
 
 (define (ext2-superblock-volume-name sblock)
-  "Return the volume name of SBLOCK as a string of at most 16 characters, or
+  "Return the volume name of ext2 superblock SBLOCK as a string of at most 16
-#f if SBLOCK has no volume name."
+characters, or #f if SBLOCK has no volume name."
   (null-terminated-latin1->string (sub-bytevector sblock 120 16)))
 
-(define (check-ext2-file-system device)
+(define (check-ext2-file-system device force? repair)
-  "Return the health of an ext2 file system on DEVICE."
+  "Return the health of an unmounted ext2 file system on DEVICE.  If FORCE? is
+true, check the file system even if it's marked as clean.  If REPAIR is false,
+do not write to the file system to fix errors.  If it's #t, fix all
+errors.  Otherwise, fix only those considered safe to repair automatically."
   (match (status:exit-val
-          (system* "e2fsck" "-v" "-p" "-C" "0" device))
+          (apply system* `("e2fsck" "-v" "-C" "0"
+                           ,@(if force? '("-f") '())
+                           ,@(match repair
+                               (#f '("-n"))
+                               (#t '("-y"))
+                               (_  '("-p")))
+                           ,device)))
     (0 'pass)
     (1 'errors-corrected)
     (2 'reboot-required)
@@ -239,15 +248,15 @@ if DEVICE does not contain an linux-swap file system."
 (define (read-bcachefs-superblock device)
   "Return the raw contents of DEVICE's bcachefs superblock as a bytevector, or #f
 if DEVICE does not contain a bcachefs file system."
-  ;; We completely ignore the back-up superblock & any checksum errors.
+  ;; Field offsets & lengths, in bytes.  There are more (and the superblock is
-  ;; Superblock field names, with offset & length respectively, in bytes:
+  ;; extensible) but we need only some basic information here:
   ;;  0 16 bch_csum
   ;; 16  8 version
   ;; 24 16 magic
-  ;; 40 16 uuid ← ‘internal UUID’, you probably don't want this
+  ;; 40 16 uuid               ← ‘internal’: you probably don't want this one
-  ;; 56 16 user_uuid ← ‘external UUID’, the one by which to mount
+  ;; 56 16 user_uuid          ← ‘external’: user-visible one by which to mount
   ;; 72 32 label
-  ;; … there are more & the superblock is extensible, but we don't care yet.
+  ;; Assume a sane file system: ignore the back-up superblock & checksums.
   (read-superblock device 4096 104 bcachefs-superblock?))
 
 (define (bcachefs-superblock-external-uuid sblock)
@@ -256,19 +265,28 @@ bytevector."
   (sub-bytevector sblock 56 16))
 
 (define (bcachefs-superblock-volume-name sblock)
-  "Return the volume name of SBLOCK as a string of at most 32 characters, or
+  "Return the volume name of bcachefs superblock SBLOCK as a string of at most
-#f if SBLOCK has no volume name."
+32 characters, or #f if SBLOCK has no volume name."
   (null-terminated-latin1->string (sub-bytevector sblock 72 32)))
 
-(define (check-bcachefs-file-system device)
+(define (check-bcachefs-file-system device force? repair)
-  "Return the health of a bcachefs file system on DEVICE."
+  "Return the health of an unmounted bcachefs file system on DEVICE.  If FORCE?
+is true, check the file system even if it's marked as clean.  If REPAIR is
+false, do not write to the file system to fix errors.  If it's #t, fix all
+errors. Otherwise, fix only those considered safe to repair automatically."
   (let ((ignored-bits (logior 2))       ; DEVICE was mounted read-only
         (status
+         ;; A number, or #f on abnormal termination (e.g., assertion failure).
          (status:exit-val
-          (apply system* "bcachefs" "fsck" "-p" "-v"
+          (apply system* `("bcachefs" "fsck" "-v"
-                 ;; Make each multi-device member a separate argument.
+                           ,@(if force? '("-f") '())
-                 (string-split device #\:)))))
+                           ,@(match repair
-    (match (logand (lognot ignored-bits) status)
+                               (#f '("-n"))
+                               (#t '("-y"))
+                               (_  '("-p")))
+                           ;; Make each multi-device member a separate argument.
+                           ,@(string-split device #\:))))))
+    (match (and=> status (cut logand <> (lognot ignored-bits)))
       (0 'pass)
       (1 'errors-corrected)
       (_ 'fatal-error))))
@@ -299,16 +317,33 @@ if DEVICE does not contain a btrfs file system."
   (sub-bytevector sblock 32 16))
 
 (define (btrfs-superblock-volume-name sblock)
-  "Return the volume name of SBLOCK as a string of at most 256 characters, or
+  "Return the volume name of btrfs superblock SBLOCK as a string of at most 256
-#f if SBLOCK has no volume name."
+characters, or #f if SBLOCK has no volume name."
   (null-terminated-latin1->string (sub-bytevector sblock 299 256)))
 
-(define (check-btrfs-file-system device)
+(define (check-btrfs-file-system device force? repair)
-  "Return the health of a btrfs file system on DEVICE."
+  "Return the health of an unmounted btrfs file system on DEVICE.  If FORCE? is
-  (match (status:exit-val
+false, return 'PASS unconditionally as btrfs claims no need for off-line checks.
-          (system* "btrfs" "device" "scan"))
+When FORCE? is true, do perform a real check.  This is not recommended!  See
-    (0 'pass)
+@uref{https://bugzilla.redhat.com/show_bug.cgi?id=625967#c8}.  If REPAIR is
-    (_ 'fatal-error)))
+false, do not write to DEVICE.  If it's #t, fix any errors found.  Otherwise,
+fix only those considered safe to repair automatically."
+  (if force?
+      (match (status:exit-val
+              (apply system* `("btrfs" "check" "--progress"
+                               ;; Btrfs's ‘--force’ is not relevant to us here.
+                               ,@(match repair
+                                   ;; Upstream considers ALL repairs dangerous
+                                   ;; and will warn the user at run time.
+                                   (#t '("--repair"))
+                                   (_  '("--readonly" ; a no-op for clarity
+                                         ;; A 466G file system with 180G used is
+                                         ;; enough to kill btrfs with 6G of RAM.
+                                         "--mode" "lowmem")))
+                               ,device)))
+        (0 'pass)
+        (_ 'fatal-error))
+      'pass))
 
 
 ;;;
@@ -332,15 +367,22 @@ if DEVICE does not contain a btrfs file system."
   (sub-bytevector sblock 67 4))
 
 (define (fat32-superblock-volume-name sblock)
-  "Return the volume name of SBLOCK as a string of at most 11 characters, or
+  "Return the volume name of fat superblock SBLOCK as a string of at most 11
-#f if SBLOCK has no volume name.  The volume name is a latin1 string.
+characters, or #f if SBLOCK has no volume name.  The volume name is a latin1
-Trailing spaces are trimmed."
+string.  Trailing spaces are trimmed."
   (string-trim-right (latin1->string (sub-bytevector sblock 71 11) (lambda (c) #f)) #\space))
 
-(define (check-fat-file-system device)
+(define (check-fat-file-system device force? repair)
-  "Return the health of a fat file system on DEVICE."
+  "Return the health of an unmounted FAT file system on DEVICE.  FORCE? is
+ignored: a full file system scan is always performed.  If REPAIR is false, do
+not write to the file system to fix errors. Otherwise, automatically fix them
+using the least destructive approach."
   (match (status:exit-val
-          (system* "fsck.vfat" "-v" "-a" device))
+          (apply system* `("fsck.vfat" "-v"
+                           ,@(match repair
+                               (#f '("-n"))
+                               (_  '("-a"))) ; no 'safe/#t distinction
+                           ,device)))
     (0 'pass)
     (1 'errors-corrected)
     (_ 'fatal-error)))
@@ -365,9 +407,9 @@ Trailing spaces are trimmed."
   (sub-bytevector sblock 39 4))
 
 (define (fat16-superblock-volume-name sblock)
-  "Return the volume name of SBLOCK as a string of at most 11 characters, or
+  "Return the volume name of fat superblock SBLOCK as a string of at most 11
-#f if SBLOCK has no volume name.  The volume name is a latin1 string.
+characters, or #f if SBLOCK has no volume name.  The volume name is a latin1
-Trailing spaces are trimmed."
+string.  Trailing spaces are trimmed."
   (string-trim-right (latin1->string (sub-bytevector sblock 43 11)
                                      (lambda (c) #f))
                      #\space))
@@ -426,8 +468,8 @@ SBLOCK as a bytevector.  If that's not set, returns the creation time."
     (sub-bytevector time 0 16))) ; strips GMT offset.
 
 (define (iso9660-superblock-volume-name sblock)
-  "Return the volume name of SBLOCK as a string.  The volume name is an ASCII
+  "Return the volume name of iso9660 superblock SBLOCK as a string.  The volume
-string.  Trailing spaces are trimmed."
+name is an ASCII string.  Trailing spaces are trimmed."
   ;; Note: Valid characters are of the set "[0-9][A-Z]_" (ECMA-119 Appendix A)
   (string-trim-right (latin1->string (sub-bytevector sblock 40 32)
                                      (lambda (c) #f)) #\space))
@@ -458,14 +500,32 @@ if DEVICE does not contain a JFS file system."
   (sub-bytevector sblock 136 16))
 
 (define (jfs-superblock-volume-name sblock)
-  "Return the volume name of SBLOCK as a string of at most 16 characters, or
+  "Return the volume name of JFS superblock SBLOCK as a string of at most 16
-#f if SBLOCK has no volume name."
+characters, or #f if SBLOCK has no volume name."
   (null-terminated-latin1->string (sub-bytevector sblock 152 16)))
 
-(define (check-jfs-file-system device)
+(define (check-jfs-file-system device force? repair)
-  "Return the health of a JFS file system on DEVICE."
+  "Return the health of an unmounted JFS file system on DEVICE.  If FORCE? is
+true, check the file system even if it's marked as clean.  If REPAIR is false,
+do not write to the file system to fix errors, and replay the transaction log
+only if FORCE?  is true. Otherwise, replay the transaction log before checking
+and automatically fix found errors."
   (match (status:exit-val
-          (system* "jfs_fsck" "-p" "-v" device))
+          (apply system*
+                 `("jfs_fsck" "-v"
+                   ;; The ‘LEVEL’ logic is convoluted.  To quote fsck/xchkdsk.c
+                   ;; (‘-p’, ‘-a’, and ‘-r’ are aliases in every way):
+                   ;; “If -f was chosen, have it override [-p] by [forcing] a
+                   ;;  check regardless of the outcome after the log is
+                   ;;  replayed”.
+                   ;; “If -n is specified by itself, don't replay the journal.
+                   ;;  If -n is specified with [-p], replay the journal but
+                   ;;  don't make any other changes”.
+                   ,@(if force? '("-f") '())
+                   ,@(match repair
+                       (#f '("-n"))
+                       (_  '("-p"))) ; no 'safe/#t distinction
+                   ,device)))
     (0 'pass)
     (1 'errors-corrected)
     (2 'reboot-required)
@@ -510,18 +570,28 @@ if DEVICE does not contain an F2FS file system."
                   16))
 
 (define (f2fs-superblock-volume-name sblock)
-  "Return the volume name of SBLOCK as a string of at most 512 characters, or
+  "Return the volume name of F2FS superblock SBLOCK as a string of at most 512
-#f if SBLOCK has no volume name."
+characters, or #f if SBLOCK has no volume name."
   (null-terminated-utf16->string
    (sub-bytevector sblock (- (+ #x470 12) #x400) 512)
    %f2fs-endianness))
 
-(define (check-f2fs-file-system device)
+(define (check-f2fs-file-system device force? repair)
-  "Return the health of a F2FS file system on DEVICE."
+  "Return the health of an unmuounted F2FS file system on DEVICE.  If FORCE? is
+true, check the file system even if it's marked as clean.  If either FORCE? or
+REPAIR are true, automatically fix found errors."
+  ;; There's no ‘-n’ equivalent (‘--dry-run’ does not disable writes).
+  ;; ’-y’ is an alias of ‘-f’.  The man page is bad: read main.c.
+  (when (and force? (not repair))
+    (format (current-error-port)
+            "warning: forced check of F2FS ~a implies repairing any errors~%"
+            device))
   (match (status:exit-val
-          (system* "fsck.f2fs" "-p" device))
+          (apply system* `("fsck.f2fs"
-    ;; 0 and -1 are the only two possibilities
+                           ,@(if force? '("-f") '())
-    ;; (according to the manpage)
+                           ,@(if repair '("-p") '("--dry-run"))
+                           ,device)))
+    ;; 0 and -1 are the only two possibilities according to the man page.
     (0 'pass)
     (_ 'fatal-error)))
 
@@ -599,13 +669,81 @@ if DEVICE does not contain a NTFS file system."
 ;; in the BOOT SECTOR like the UUID, but in the MASTER FILE TABLE, which seems
 ;; way harder to access.
 
-(define (check-ntfs-file-system device)
+(define (check-ntfs-file-system device force? repair)
-  "Return the health of a NTFS file system on DEVICE."
+  "Return the health of an unmounted NTFS file system on DEVICE.  FORCE? is
+ignored: a full check is always performed.  Repair is not possible: if REPAIR is
+true and the volume has been repaired by an external tool, clear the volume
+dirty flag to indicate that it's now safe to mount."
   (match (status:exit-val
-          (system* "ntfsfix" device))
+          (apply system* `("ntfsfix"
+                           ,@(if repair '("--clear-dirty") '("--no-action"))
+                           ,device)))
     (0 'pass)
     (_ 'fatal-error)))
 
+
+
+;;;
+;;; XFS file systems.
+;;;
+
+;; <https://git.kernel.org/pub/scm/fs/xfs/xfs-documentation.git/tree/design/XFS_Filesystem_Structure/allocation_groups.asciidoc>
+
+(define-syntax %xfs-endianness
+  ;; Endianness of XFS file systems.
+  (identifier-syntax (endianness big)))
+
+(define (xfs-superblock? sblock)
+  "Return #t when SBLOCK is an XFS superblock."
+  (bytevector=? (sub-bytevector sblock 0 4)
+                (string->utf8 "XFSB")))
+
+(define (read-xfs-superblock device)
+  "Return the raw contents of DEVICE's XFS superblock as a bytevector, or #f
+if DEVICE does not contain an XFS file system."
+  (read-superblock device 0 120 xfs-superblock?))
+
+(define (xfs-superblock-uuid sblock)
+  "Return the UUID of XFS superblock SBLOCK as a 16-byte bytevector."
+  (sub-bytevector sblock 32 16))
+
+(define (xfs-superblock-volume-name sblock)
+  "Return the volume name of XFS superblock SBLOCK as a string of at most 12
+characters, or #f if SBLOCK has no volume name."
+  (null-terminated-latin1->string (sub-bytevector sblock 108 12)))
+
+(define (check-xfs-file-system device force? repair)
+  "Return the health of an unmounted XFS file system on DEVICE.  If FORCE? is
+false, return 'PASS unconditionally as XFS claims no need for off-line checks.
+When FORCE? is true, do perform a thorough check.  If REPAIR is false, do not
+write to DEVICE.  If it's #t, replay the log, check, and fix any errors found.
+Otherwise, only replay the log, and check without attempting further repairs."
+  (define (xfs_repair)
+    (status:exit-val
+     (apply system* `("xfs_repair" "-Pv"
+                      ,@(match repair
+                          (#t '("-e"))
+                          (_  '("-n"))) ; will miss some errors
+                      ,device))))
+  (if force?
+      ;; xfs_repair fails with exit status 2 if the log is dirty, which is
+      ;; likely in situations where you're running xfs_repair.  Only the kernel
+      ;; can replay the log by {,un}mounting it cleanly.
+      (match (let ((status (xfs_repair)))
+               (if (and repair (eq? 2 status))
+                   (let ((target "/replay-XFS-log"))
+                     ;; The kernel helpfully prints a ‘Mounting…’ notice for us.
+                     (mkdir target)
+                     (mount device target "xfs")
+                     (umount target)
+                     (rmdir target)
+                     (xfs_repair))
+                   status))
+        (0 'pass)
+        (4 'errors-corrected)
+        (_ 'fatal-error))
+      'pass))
+
 
 ;;;
 ;;; Partition lookup.
@@ -644,16 +782,13 @@ if DEVICE does not contain a NTFS file system."
                      (loop parts))))))))))
 
 (define (ENOENT-safe proc)
-  "Wrap the one-argument PROC such that ENOENT errors are caught and lead to a
+  "Wrap the one-argument PROC such that ENOENT, EIO, and ENOMEDIUM errors are
-warning and #f as the result."
+caught and lead to a warning and #f as the result."
   (lambda (device)
     (catch 'system-error
       (lambda ()
         (proc device))
       (lambda args
-        ;; When running on the hand-made /dev,
-        ;; 'disk-partitions' could return partitions for which
-        ;; we have no /dev node.  Handle that gracefully.
         (let ((errno (system-error-errno args)))
           (cond ((= ENOENT errno)
                  (format (current-error-port)
@@ -671,11 +806,10 @@ warning and #f as the result."
 (define (partition-field-reader read field)
   "Return a procedure that takes a device and returns the value of a FIELD in
 the partition superblock or #f."
-  (let ((read (ENOENT-safe read)))
+  (lambda (device)
-    (lambda (device)
+    (let ((sblock (read device)))
-      (let ((sblock (read device)))
+      (and sblock
-        (and sblock
+           (field sblock)))))
-             (field sblock))))))
 
 (define (read-partition-field device partition-field-readers)
   "Returns the value of a FIELD in the partition superblock of DEVICE or #f. It
@@ -703,7 +837,9 @@ partition field reader that returned a value."
         (partition-field-reader read-jfs-superblock
                                 jfs-superblock-volume-name)
         (partition-field-reader read-f2fs-superblock
-                                f2fs-superblock-volume-name)))
+                                f2fs-superblock-volume-name)
+        (partition-field-reader read-xfs-superblock
+                                xfs-superblock-volume-name)))
 
 (define %partition-uuid-readers
   (list (partition-field-reader read-iso9660-superblock
@@ -725,7 +861,9 @@ partition field reader that returned a value."
         (partition-field-reader read-f2fs-superblock
                                 f2fs-superblock-uuid)
         (partition-field-reader read-ntfs-superblock
-                                ntfs-superblock-uuid)))
+                                ntfs-superblock-uuid)
+        (partition-field-reader read-xfs-superblock
+                                xfs-superblock-uuid)))
 
 (define read-partition-label
   (cut read-partition-field <> %partition-label-readers))
@@ -742,11 +880,14 @@ partition field reader that returned a value."
 (define (partition-predicate reader =)
   "Return a predicate that returns true if the FIELD of partition header that
 was READ is = to the given value."
-  (lambda (expected)
+  ;; When running on the hand-made /dev, 'disk-partitions' could return
-    (lambda (device)
+  ;; partitions for which we have no /dev node.  Handle that gracefully.
-      (let ((actual (reader device)))
+  (let ((reader (ENOENT-safe reader)))
-        (and actual
+    (lambda (expected)
-             (= actual expected))))))
+      (lambda (device)
+        (let ((actual (reader device)))
+          (and actual
+               (= actual expected)))))))
 
 (define partition-label-predicate
   (partition-predicate read-partition-label string=?))
@@ -816,8 +957,13 @@ containing ':/')."
               (uuid-bytevector spec)
               uuid->string))))
 
-(define (check-file-system device type)
+(define (check-file-system device type force? repair)
-  "Run a file system check of TYPE on DEVICE."
+  "Check an unmounted TYPE file system on DEVICE.  Do nothing but warn if it is
+mounted.  If FORCE? is true, check even when considered unnecessary.  If REPAIR
+is false, try not to write to DEVICE at all.  If it's #t, try to fix all errors
+found.  Otherwise, fix only those considered safe to repair automatically.  Not
+all TYPEs support all values or combinations of FORCE? and REPAIR.  Don't throw
+an exception in such cases but perform the nearest sane action."
   (define check-procedure
     (cond
      ((string-prefix? "ext" type) check-ext2-file-system)
@@ -828,36 +974,44 @@ containing ':/')."
      ((string-prefix? "f2fs" type) check-f2fs-file-system)
      ((string-prefix? "ntfs" type) check-ntfs-file-system)
      ((string-prefix? "nfs" type) (const 'pass))
+     ((string-prefix? "xfs" type) check-xfs-file-system)
      (else #f)))
 
   (if check-procedure
-      (match (check-procedure device)
+      (let ((mount (find (lambda (mount)
-        ('pass
+                           (string=? device (mount-source mount)))
-         #t)
+                         (mounts))))
-        ('errors-corrected
+        (if mount
-         (format (current-error-port)
+            (format (current-error-port)
-                 "File system check corrected errors on ~a; continuing~%"
+                    "Refusing to check ~a file system already mounted at ~a~%"
-                 device))
+                    device (mount-point mount))
-        ('reboot-required
+            (match (check-procedure device force? repair)
-         (format (current-error-port)
+              ('pass
-                 "File system check corrected errors on ~a; rebooting~%"
+               #t)
-                 device)
+              ('errors-corrected
-         (sleep 3)
+               (format (current-error-port)
-         (reboot))
+                       "File system check corrected errors on ~a; continuing~%"
-        ('fatal-error
+                       device))
-         (format (current-error-port) "File system check on ~a failed~%"
+              ('reboot-required
-                 device)
+               (format (current-error-port)
+                       "File system check corrected errors on ~a; rebooting~%"
+                       device)
+               (sleep 3)
+               (reboot))
+              ('fatal-error
+               (format (current-error-port) "File system check on ~a failed~%"
+                       device)
 
-         ;; Spawn a REPL only if someone would be able to interact with it.
+               ;; Spawn a REPL only if someone might interact with it.
-         (when (isatty? (current-input-port))
+               (when (isatty? (current-input-port))
-           (format (current-error-port) "Spawning Bourne-like REPL.~%")
+                 (format (current-error-port) "Spawning Bourne-like REPL.~%")
 
-           ;; 'current-output-port' is typically connected to /dev/klog (in
+                 ;; 'current-output-port' is typically connected to /dev/klog
-           ;; PID 1), but here we want to make sure we talk directly to the
+                 ;; (in PID 1), but here we want to make sure we talk directly
-           ;; user.
+                 ;; to the user.
-           (with-output-to-file "/dev/console"
+                 (with-output-to-file "/dev/console"
-             (lambda ()
+                   (lambda ()
-               (start-repl %bournish-language))))))
+                     (start-repl %bournish-language))))))))
       (format (current-error-port)
               "No file system check procedure for ~a; skipping~%"
               device)))
@@ -886,7 +1040,11 @@ corresponds to the symbols listed in FLAGS."
       (()
        0))))
 
-(define* (mount-file-system fs #:key (root "/root"))
+(define* (mount-file-system fs #:key (root "/root")
+                            (check? (file-system-check? fs))
+                            (skip-check-if-clean?
+                             (file-system-skip-check-if-clean? fs))
+                            (repair (file-system-repair fs)))
   "Mount the file system described by FS, a <file-system> object, under ROOT."
 
   (define (mount-nfs source mount-point type flags options)
@@ -924,8 +1082,8 @@ corresponds to the symbols listed in FLAGS."
                                (file-system-mount-flags (statfs source)))
                               0)))
          (options (file-system-options fs)))
-    (when (file-system-check? fs)
+    (when check?
-      (check-file-system source type))
+      (check-file-system source type (not skip-check-if-clean?) repair))
 
     (catch 'system-error
       (lambda ()

gnu/build/image.scm

@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
+;;; Copyright © 2016 Christine Lemmer-Webber <cwebber@dustycloud.org>
 ;;; Copyright © 2016, 2017 Leo Famulari <leo@famulari.name>
 ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
 ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
@@ -61,7 +61,7 @@
    (inexact->exact (ceiling (/ size 1024)))))
 
 (define (estimate-partition-size root)
-  "Given the ROOT directory, evalute and return its size.  As this doesn't
+  "Given the ROOT directory, evaluate and return its size.  As this doesn't
 take the partition metadata size into account, take a 25% margin."
   (* 1.25 (file-size root)))
 

gnu/build/jami-service.scm

@@ -0,0 +1,587 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;;
+;;; 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/>.
+
+;;; Commentary:
+;;;
+;;; This module contains helpers used as part of the jami-service-type
+;;; definition.
+;;;
+;;; Code:
+
+(define-module (gnu build jami-service)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 peg)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 regex)
+  #:use-module (rnrs io ports)
+  #:autoload (shepherd service) (fork+exec-command)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:export (account-fingerprint?
+            account-details->recutil
+            get-accounts
+            get-usernames
+            set-account-details
+            add-account
+            account->username
+            username->account
+            username->contacts
+            enable-account
+            disable-account
+
+            add-contact
+            remove-contact
+
+            set-all-moderators
+            set-moderator
+            username->all-moderators?
+            username->moderators
+
+            dbus-available-services
+            dbus-service-available?
+
+            %send-dbus-binary
+            %send-dbus-bus
+            %send-dbus-user
+            %send-dbus-group
+            %send-dbus-debug
+            send-dbus
+
+            with-retries))
+
+;;;
+;;; Utilities.
+;;;
+
+(define-syntax-rule (with-retries n delay body ...)
+  "Retry the code in BODY up to N times until it doesn't raise an exception
+nor return #f, else raise an error.  A delay of DELAY seconds is inserted
+before each retry."
+  (let loop ((attempts 0))
+    (catch #t
+      (lambda ()
+        (let ((result (begin body ...)))
+          (if (not result)
+              (error "failed attempt" attempts)
+              result)))
+      (lambda args
+        (if (< attempts n)
+            (begin
+              (sleep delay)             ;else wait and retry
+              (loop (+ 1 attempts)))
+            (error "maximum number of retry attempts reached"
+                   body ... args))))))
+
+(define (alist->list alist)
+  "Flatten ALIST into a list."
+  (append-map (match-lambda
+                (() '())
+                ((key . value)
+                 (list key value)))
+              alist))
+
+(define account-fingerprint-rx (make-regexp "[0-9A-Fa-f]{40}"))
+
+(define (account-fingerprint? val)
+  "A Jami account fingerprint is 40 characters long and only contains
+hexadecimal characters."
+  (and (string? val)
+       (regexp-exec account-fingerprint-rx val)))
+
+
+;;;
+;;; D-Bus reply parser.
+;;;
+
+(define (parse-dbus-reply reply)
+  "Return the parse tree of REPLY, a string returned by the 'dbus-send'
+command."
+  ;; Refer to 'man 1 dbus-send' for the grammar reference.  Note that the
+  ;; format of the replies doesn't match the format of the input, which is the
+  ;; one documented, but it gives an idea.  For an even better reference, see
+  ;; the `print_iter' procedure of the 'dbus-print-message.c' file from the
+  ;; 'dbus' package sources.
+  (define-peg-string-patterns
+    "contents <- header (item / container (item / container*)?)
+     item <-- WS type WS value NL
+     container <- array / dict / variant
+     array <-- array-start (item / container)* array-end
+     dict <-- array-start dict-entry* array-end
+     dict-entry <-- dict-entry-start item item dict-entry-end
+     variant <-- variant-start item
+     type <-- 'string' / 'int16' / 'uint16' / 'int32' / 'uint32' / 'int64' /
+              'uint64' / 'double' / 'byte' / 'boolean' / 'objpath'
+     value <-- (!NL .)* NL
+     header < (!NL .)* NL
+     variant-start < WS 'variant'
+     array-start < WS 'array [' NL
+     array-end < WS ']' NL
+     dict-entry-start < WS 'dict entry(' NL
+     dict-entry-end < WS ')' NL
+     DQ < '\"'
+     WS < ' '*
+     NL < '\n'*")
+
+  (peg:tree (match-pattern contents reply)))
+
+(define (strip-quotes text)
+  "Strip the leading and trailing double quotes (\") characters from TEXT."
+  (let* ((text* (if (string-prefix? "\"" text)
+                    (string-drop text 1)
+                    text))
+         (text** (if (string-suffix? "\"" text*)
+                     (string-drop-right text* 1)
+                     text*)))
+    text**))
+
+(define (deserialize-item item)
+  "Return the value described by the ITEM parse tree as a Guile object."
+  ;; Strings are printed wrapped in double quotes (see the print_iter
+  ;; procedure in dbus-print-message.c).
+  (match item
+    (('item ('type "string") ('value value))
+     (strip-quotes value))
+    (('item ('type "boolean") ('value value))
+     (if (string=? "true" value)
+         #t
+         #f))
+    (('item _ ('value value))
+     value)))
+
+(define (serialize-boolean bool)
+  "Return the serialized format expected by dbus-send for BOOL."
+  (format #f "boolean:~:[false~;true~]" bool))
+
+(define (dict->alist dict-parse-tree)
+  "Translate a dict parse tree to an alist."
+  (define (tuples->alist tuples)
+    (map (lambda (x) (apply cons x)) tuples))
+
+  (match dict-parse-tree
+    ('dict
+     '())
+    (('dict ('dict-entry keys values) ...)
+     (let ((keys* (map deserialize-item keys))
+           (values* (map deserialize-item values)))
+       (tuples->alist (zip keys* values*))))))
+
+(define (array->list array-parse-tree)
+  "Translate an array parse tree to a list."
+  (match array-parse-tree
+    ('array
+     '())
+    (('array items ...)
+     (map deserialize-item items))))
+
+
+;;;
+;;; Low-level, D-Bus-related procedures.
+;;;
+
+;;; The following parameters are used in the jami-service-type service
+;;; definition to conveniently customize the behavior of the send-dbus helper,
+;;; even when called indirectly.
+(define %send-dbus-binary (make-parameter "dbus-send"))
+(define %send-dbus-bus (make-parameter #f))
+(define %send-dbus-user (make-parameter #f))
+(define %send-dbus-group (make-parameter #f))
+(define %send-dbus-debug (make-parameter #f))
+
+(define* (send-dbus #:key service path interface method
+                    bus
+                    dbus-send
+                    user group
+                    timeout
+                    arguments)
+  "Return the response of DBUS-SEND, else raise an error.  Unless explicitly
+provided, DBUS-SEND takes the value of the %SEND-DBUS-BINARY parameter.  BUS
+can be used to specify the bus address, such as 'unix:path=/var/run/jami/bus'.
+Alternatively, the %SEND-DBUS-BUS parameter can be used.  ARGUMENTS can be
+used to pass input values to a D-Bus method call.  TIMEOUT is the amount of
+time to wait for a reply in milliseconds before giving up with an error.  USER
+and GROUP allow choosing under which user/group the DBUS-SEND command is
+executed.  Alternatively, the %SEND-DBUS-USER and %SEND-DBUS-GROUP parameters
+can be used instead."
+  (let* ((command `(,(if dbus-send
+                         dbus-send
+                         (%send-dbus-binary))
+                    ,@(if (or bus (%send-dbus-bus))
+                          (list (string-append "--bus="
+                                               (or bus (%send-dbus-bus))))
+                          '())
+                    "--print-reply"
+                    ,@(if timeout
+                          (list (format #f "--reply-timeout=~d" timeout))
+                          '())
+                    ,(string-append "--dest=" service) ;e.g., cx.ring.Ring
+                    ,path            ;e.g., /cx/ring/Ring/ConfigurationManager
+                    ,(string-append interface "." method)
+                    ,@(or arguments '())))
+         (temp-port (mkstemp! (string-copy "/tmp/dbus-send-output-XXXXXXX")))
+         (temp-file (port-filename temp-port)))
+    (dynamic-wind
+      (lambda ()
+        (let* ((uid (or (and=> (or user (%send-dbus-user))
+                               (compose passwd:uid getpwnam)) -1))
+               (gid (or (and=> (or group (%send-dbus-group))
+                               (compose group:gid getgrnam)) -1)))
+          (chown temp-port uid gid)))
+      (lambda ()
+        (let ((pid (fork+exec-command command
+                                      #:user (or user (%send-dbus-user))
+                                      #:group (or group (%send-dbus-group))
+                                      #:log-file temp-file)))
+          (match (waitpid pid)
+            ((_ . status)
+             (let ((exit-status (status:exit-val status))
+                   (output (call-with-port temp-port get-string-all)))
+               (if (= 0 exit-status)
+                   output
+                   (error "the send-dbus command exited with: "
+                          command exit-status output)))))))
+      (lambda ()
+        (false-if-exception (delete-file temp-file))))))
+
+(define (parse-account-ids reply)
+  "Return the Jami account IDs from REPLY, which is assumed to be the output
+of the Jami D-Bus `getAccountList' method."
+  (array->list (parse-dbus-reply reply)))
+
+(define (parse-account-details reply)
+  "Parse REPLY, which is assumed to be the output of the Jami D-Bus
+`getAccountDetails' method, and return its content as an alist."
+  (dict->alist (parse-dbus-reply reply)))
+
+(define (parse-contacts reply)
+  "Parse REPLY, which is assumed to be the output of the Jamid D-Bus
+`getContacts' method, and return its content as an alist."
+  (match (parse-dbus-reply reply)
+    ('array
+     '())
+    (('array dicts ...)
+     (map dict->alist dicts))))
+
+
+;;;
+;;; Higher-level, D-Bus-related procedures.
+;;;
+
+(define (validate-fingerprint fingerprint)
+  "Validate that fingerprint is 40 characters long."
+  (unless (account-fingerprint? fingerprint)
+    (error "Account fingerprint is not valid:" fingerprint)))
+
+(define (dbus-available-services)
+  "Return the list of available (acquired) D-Bus services."
+  (let ((reply (parse-dbus-reply
+                (send-dbus #:service "org.freedesktop.DBus"
+                           #:path "/org/freedesktop/DBus"
+                           #:interface "org.freedesktop.DBus"
+                           #:method "ListNames"))))
+    ;; Remove entries such as ":1.7".
+    (remove (cut string-prefix? ":" <>)
+            (array->list reply))))
+
+(define (dbus-service-available? service)
+  "Predicate to check for the D-Bus SERVICE availability."
+  (member service (dbus-available-services)))
+
+(define* (send-dbus/configuration-manager #:key method arguments timeout)
+  "Query the Jami D-Bus ConfigurationManager service."
+  (send-dbus #:service "cx.ring.Ring"
+             #:path "/cx/ring/Ring/ConfigurationManager"
+             #:interface "cx.ring.Ring.ConfigurationManager"
+             #:method method
+             #:arguments arguments
+             #:timeout timeout))
+
+;;; The following methods are for internal use; they make use of the account
+;;; ID, an implementation detail of Jami the user should not need to be
+;;; concerned with.
+(define (get-account-ids)
+  "Return the available Jami account identifiers (IDs).  Account IDs are an
+implementation detail used to identify the accounts in Jami."
+  (parse-account-ids
+   (send-dbus/configuration-manager #:method "getAccountList")))
+
+(define (id->account-details id)
+  "Retrieve the account data associated with the given account ID."
+  (parse-account-details
+   (send-dbus/configuration-manager
+    #:method "getAccountDetails"
+    #:arguments (list (string-append "string:" id)))))
+
+(define (id->volatile-account-details id)
+  "Retrieve the account data associated with the given account ID."
+  (parse-account-details
+   (send-dbus/configuration-manager
+    #:method "getVolatileAccountDetails"
+    #:arguments (list (string-append "string:" id)))))
+
+(define (id->account id)
+  "Retrieve the complete account data associated with the given account ID."
+  (append (id->volatile-account-details id)
+          (id->account-details id)))
+
+(define %username-to-id-cache #f)
+
+(define (invalidate-username-to-id-cache!)
+  (set! %username-to-id-cache #f))
+
+(define (username->id username)
+  "Return the first account ID corresponding to USERNAME."
+  (unless (assoc-ref %username-to-id-cache username)
+    (set! %username-to-id-cache
+          (append-map
+           (lambda (id)
+             (let* ((account (id->account id))
+                    (username (assoc-ref account "Account.username"))
+                    (registered-name (assoc-ref account
+                                                "Account.registeredName")))
+               `(,@(if username
+                       (list (cons username id))
+                       '())
+                 ,@(if registered-name
+                       (list (cons registered-name id))
+                       '()))))
+           (get-account-ids))))
+  (or (assoc-ref %username-to-id-cache username)
+      (let ((message (format #f "Could not retrieve a local account ID\
+ for ~:[username~;fingerprint~]" (account-fingerprint? username))))
+        (error message username))))
+
+(define (account->username account)
+  "Return USERNAME, the registered username associated with ACCOUNT, else its
+public key fingerprint."
+  (or (assoc-ref account "Account.registeredName")
+      (assoc-ref account "Account.username")))
+
+(define (id->username id)
+  "Return USERNAME, the registered username associated with ID, else its
+public key fingerprint, else #f."
+  (account->username (id->account id)))
+
+(define (get-accounts)
+  "Return the list of all accounts, as a list of alists."
+  (map id->account (get-account-ids)))
+
+(define (get-usernames)
+  "Return the list of the usernames associated with the present accounts."
+  (map account->username (get-accounts)))
+
+(define (username->account username)
+  "Return the first account associated with USERNAME, else #f.
+USERNAME can be either the account 40 characters public key fingerprint or a
+registered username."
+  (find (lambda (account)
+          (member username
+                  (list (assoc-ref account "Account.username")
+                        (assoc-ref account "Account.registeredName"))))
+        (get-accounts)))
+
+(define (add-account archive)
+  "Import the Jami account ARCHIVE and return its account ID.  The archive
+should *not* be encrypted with a password.  Return the username associated
+with the account."
+  (invalidate-username-to-id-cache!)
+  (let ((reply (send-dbus/configuration-manager
+                #:method "addAccount"
+                #:arguments (list (string-append
+                                   "dict:string:string:Account.archivePath,"
+                                   archive
+                                   ",Account.type,RING")))))
+    ;; The account information takes some time to be populated.
+    (let ((id (deserialize-item (parse-dbus-reply reply))))
+      (with-retries 20 1
+        (let ((username (id->username id)))
+          (if (string-null? username)
+              #f
+              username))))))
+
+(define (remove-account username)
+  "Delete the Jami account associated with USERNAME, the account 40 characters
+fingerprint or a registered username."
+  (let ((id (username->id username)))
+    (send-dbus/configuration-manager
+     #:method "removeAccount"
+     #:arguments (list (string-append "string:" id))))
+  (invalidate-username-to-id-cache!))
+
+(define* (username->contacts username)
+  "Return the contacts associated with the account of USERNAME as two values;
+the first one being the regular contacts and the second one the banned
+contacts.  USERNAME can be either the account 40 characters public key
+fingerprint or a registered username.  The contacts returned are represented
+using their 40 characters fingerprint."
+  (let* ((id (username->id username))
+         (reply (send-dbus/configuration-manager
+                 #:method "getContacts"
+                 #:arguments (list (string-append "string:" id))))
+         (all-contacts (parse-contacts reply))
+         (banned? (lambda (contact)
+                    (and=> (assoc-ref contact "banned")
+                           (cut string=? "true" <>))))
+         (banned (filter banned? all-contacts))
+         (not-banned (filter (negate banned?) all-contacts))
+         (fingerprint (cut assoc-ref <> "id")))
+    (values (map fingerprint not-banned)
+            (map fingerprint banned))))
+
+(define* (remove-contact contact username #:key ban?)
+  "Remove CONTACT, the 40 characters public key fingerprint of a contact, from
+the account associated with USERNAME (either a fingerprint or a registered
+username).  When BAN? is true, also mark the contact as banned."
+  (validate-fingerprint contact)
+  (let ((id (username->id username)))
+    (send-dbus/configuration-manager
+     #:method "removeContact"
+     #:arguments (list (string-append "string:" id)
+                       (string-append "string:" contact)
+                       (serialize-boolean ban?)))))
+
+(define (add-contact contact username)
+  "Add CONTACT, the 40 characters public key fingerprint of a contact, to the
+account of USERNAME (either a fingerprint or a registered username)."
+  (validate-fingerprint contact)
+  (let ((id (username->id username)))
+    (send-dbus/configuration-manager
+     #:method "addContact"
+     #:arguments (list (string-append "string:" id)
+                       (string-append "string:" contact)))))
+
+(define* (set-account-details details username #:key timeout)
+  "Set DETAILS, an alist containing the key value pairs to set for the account
+of USERNAME, a registered username or account fingerprint.  The value of the
+parameters not provided are unchanged.  TIMEOUT is a value in milliseconds to
+pass to the `send-dbus/configuration-manager' procedure."
+  (let* ((id (username->id username))
+         (current-details (id->account-details id))
+         (updated-details (map (match-lambda
+                                 ((key . value)
+                                  (or (and=> (assoc-ref details key)
+                                             (cut cons key <>))
+                                      (cons key value))))
+                               current-details))
+         ;; dbus-send does not permit sending null strings (it throws a
+         ;; "malformed dictionary" error).  Luckily they seem to have the
+         ;; semantic of "default account value" in Jami; so simply drop them.
+         (updated-details* (remove (match-lambda
+                                     ((_ . value)
+                                      (string-null? value)))
+                                   updated-details)))
+    (send-dbus/configuration-manager
+     #:timeout timeout
+     #:method "setAccountDetails"
+     #:arguments
+     (list (string-append "string:" id)
+           (string-append "dict:string:string:"
+                          (string-join (alist->list updated-details*)
+                                       ","))))))
+
+(define (set-all-moderators enabled? username)
+  "Set the 'AllModerators' property to enabled? for the account of USERNAME, a
+registered username or account fingerprint."
+  (let ((id (username->id username)))
+    (send-dbus/configuration-manager
+     #:method "setAllModerators"
+     #:arguments
+     (list (string-append "string:" id)
+           (serialize-boolean enabled?)))))
+
+(define (username->all-moderators? username)
+  "Return the 'AllModerators' property for the account of USERNAME, a
+registered username or account fingerprint."
+  (let* ((id (username->id username))
+         (reply (send-dbus/configuration-manager
+                 #:method "isAllModerators"
+                 #:arguments
+                 (list (string-append "string:" id)))))
+    (deserialize-item (parse-dbus-reply reply))))
+
+(define (username->moderators username)
+  "Return the moderators for the account of USERNAME, a registered username or
+account fingerprint."
+  (let* ((id (username->id username))
+         (reply (send-dbus/configuration-manager
+                 #:method "getDefaultModerators"
+                 #:arguments
+                 (list (string-append "string:" id)))))
+    (array->list (parse-dbus-reply reply))))
+
+(define (set-moderator contact enabled? username)
+  "Set the moderator flag to ENABLED? for CONTACT, the 40 characters public
+key fingerprint of a contact for the account of USERNAME, a registered
+username or account fingerprint."
+  (validate-fingerprint contact)
+  (let* ((id (username->id username)))
+    (send-dbus/configuration-manager #:method "setDefaultModerator"
+                                     #:arguments
+                                     (list (string-append "string:" id)
+                                           (string-append "string:" contact)
+                                           (serialize-boolean enabled?)))))
+
+(define (disable-account username)
+  "Disable the account known by USERNAME, a registered username or account
+fingerprint."
+  (set-account-details '(("Account.enable" . "false")) username
+                       ;; Waiting for the reply on this command takes a very
+                       ;; long time that trips the default D-Bus timeout value
+                       ;; (25 s), for some reason.
+                        #:timeout 60000))
+
+(define (enable-account username)
+  "Enable the account known by USERNAME, a registered username or account
+fingerprint."
+  (set-account-details '(("Account.enable" . "true")) username))
+
+
+;;;
+;;; Presentation procedures.
+;;;
+
+(define (.->_ text)
+  "Map each period character to underscore characters."
+  (string-map (match-lambda
+                (#\. #\_)
+                (c c))
+              text))
+
+(define (account-details->recutil account-details)
+  "Serialize the account-details alist into a recutil string.  Period
+characters in the keys are normalized to underscore to meet Recutils' format
+requirements."
+  (define (pair->recutil-property pair)
+    (match pair
+      ((key . value)
+       (string-append (.->_ key) ": " value))))
+
+  (define sorted-account-details
+    ;; Have the account username, display name and alias appear first, for
+    ;; convenience.
+    (let ((first-items '("Account.username"
+                         "Account.displayName"
+                         "Account.alias")))
+      (append (map (cut assoc <> account-details) first-items)
+              (fold alist-delete account-details first-items))))
+
+  (string-join (map pair->recutil-property sorted-account-details) "\n"))
+
+;; Local Variables:
+;; eval: (put 'with-retries 'scheme-indent-function 2)
+;; End:

gnu/build/linux-boot.scm

@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2016, 2017, 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2016, 2017, 2019–2021 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
 ;;;
@@ -25,6 +25,7 @@
   #:autoload   (system repl repl) (start-repl)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim)
@@ -44,7 +45,6 @@
             make-static-device-nodes
             configure-qemu-networking
 
-            device-number
             boot-system))
 
 ;;; Commentary:
@@ -134,14 +134,9 @@ succeeds.  Return nothing otherwise.  The kernel logs any details to dmesg."
            ;; is found on the command line; our canonicalize-device-spec gives
            ;; up after 20 seconds.  We could emulate the former by looping…
            (device (canonicalize-device-spec spec))
-           (rdev (stat:rdev (stat device)))
+           (rdev (stat:rdev (stat device))))
-           ;; For backwards compatibility, device numbering is a baroque affair.
+      (let-values (((major minor) (device-number->major+minor rdev)))
-           ;; This is the full 64-bit scheme used by glibc's <sys/sysmacros.h>.
+        (format #f "~a:~a" major minor))))
-           (major (logior (ash (logand #x00000000000fff00 rdev) -8)
-                          (ash (logand #xfffff00000000000 rdev) -32)))
-           (minor (logior      (logand #x00000000000000ff rdev)
-                          (ash (logand #x00000ffffff00000 rdev) -12))))
-      (format #f "~a:~a" major minor)))
 
   ;; Write the resume DEVICE to this magic file, using the MAJOR:MINOR device
   ;; numbers if possible.  The kernel will immediately try to resume from it.
@@ -390,17 +385,8 @@ networking values.)  Return #t if INTERFACE is up, #f otherwise."
     (set-network-interface-address sock interface address)
     (set-network-interface-flags sock interface (logior flags IFF_UP))
 
-    ;; Hello!  We used to create /etc/resolv.conf here, with "nameserver
-    ;; 10.0.2.3\n".  However, with Linux-libre 3.16, we're getting ENOSPC.
-    ;; And since it's actually unnecessary, it's gone.
-
     (logand (network-interface-flags sock interface) IFF_UP)))
 
-(define (device-number major minor)
-  "Return the device number for the device with MAJOR and MINOR, for use as
-the last argument of `mknod'."
-  (+ (* major 256) minor))
-
 (define (pidof program)
   "Return the PID of the first presumed instance of PROGRAM."
   (let ((program (basename program)))
@@ -411,11 +397,18 @@ the last argument of `mknod'."
           (filter-map string->number (scandir "/proc")))))
 
 (define* (mount-root-file-system root type
-                                 #:key volatile-root? (flags 0) options)
+                                 #:key volatile-root? (flags 0) options
+                                 check? skip-check-if-clean? repair)
   "Mount the root file system of type TYPE at device ROOT. If VOLATILE-ROOT? is
 true, mount ROOT read-only and make it an overlay with a writable tmpfs using
 the kernel built-in overlayfs. FLAGS and OPTIONS indicates the options to use
-to mount ROOT, and behave the same as for the `mount' procedure."
+to mount ROOT, and behave the same as for the `mount' procedure.
+
+If CHECK? is true, first run ROOT's fsck tool (if any) non-interactively.
+If SKIP-CHECK-IF-CLEAN? is true, ask fsck to return immediately if ROOT is
+marked as clean.  If REPAIR is true, fsck may write to ROOT to perform repairs.
+If REPAIR is also 'PREEN, ask fsck to perform only those repairs that it
+considers safe."
 
   (if volatile-root?
       (begin
@@ -436,7 +429,8 @@ to mount ROOT, and behave the same as for the `mount' procedure."
         (mount "none" "/root" "overlay" 0
                "lowerdir=/real-root,upperdir=/rw-root/upper,workdir=/rw-root/work"))
       (begin
-        (check-file-system root type)
+        (when check?
+          (check-file-system root type (not skip-check-if-clean?) repair))
         (mount root "/root" type flags options)))
 
   ;; Make sure /root/etc/mtab is a symlink to /proc/self/mounts.
@@ -537,21 +531,36 @@ upon error."
       (mount-essential-file-systems)
       (let* ((args    (linux-command-line))
              (to-load (find-long-option "--load" args))
-             (root-fs (find root-mount-point? mounts))
+             ;; If present, ‘--root’ on the kernel command line takes precedence
-             (root-fs-type (or (and=> root-fs file-system-type)
+             ;; over the ‘device’ field of the root <file-system> record.
-                               "ext4"))
+             (root-device (and=> (find-long-option "--root" args)
-             (root-fs-device (and=> root-fs file-system-device))
+                                 device-string->file-system-device))
-             (root-fs-flags (mount-flags->bit-mask
+             (root-fs (or (find root-mount-point? mounts)
-                             (or (and=> root-fs file-system-flags)
+                          ;; Fall back to fictitious defaults.
-                                 '())))
+                          (file-system (device (or root-device "/dev/root"))
-             (root-options (if root-fs
+                                       (mount-point "/")
-                               (file-system-options root-fs)
+                                       (type "ext4"))))
-                               #f))
+             (fsck.mode (find-long-option "fsck.mode" args)))
-             ;; --root takes precedence over the 'device' field of the root
+
-             ;; <file-system> record.
+        (define (check? fs)
-             (root-device (or (and=> (find-long-option "--root" args)
+          (match fsck.mode
-                                     device-string->file-system-device)
+            ("skip"  #f)
-                              root-fs-device)))
+            ("force" #t)
+            (_ (file-system-check? fs)))) ; assume "auto"
+
+        (define (skip-check-if-clean? fs)
+          (match fsck.mode
+            ("force" #f)
+            (_ (file-system-skip-check-if-clean? fs))))
+
+        (define (repair fs)
+          (let ((arg (find-long-option "fsck.repair" args)))
+            (if arg
+                (match arg
+                  ("no"  #f)
+                  ("yes" #t)
+                  (_ 'preen))
+                (file-system-repair fs))))
 
         (when (member "--repl" args)
           (start-repl))
@@ -582,6 +591,16 @@ upon error."
           (unless (configure-qemu-networking)
             (display "network interface is DOWN\n")))
 
+        ;; A big ugly hammer, to be used only for debugging and in desperate
+        ;; situations where no proper device synchonisation is possible.
+        (let ((root-delay (and=> (find-long-option "rootdelay" args)
+                                 string->number)))
+          (when root-delay
+            (format #t
+                    "Pausing for rootdelay=~a seconds before mounting the root file system...\n"
+                    root-delay)
+            (sleep root-delay)))
+
         ;; Prepare the real root file system under /root.
         (unless (file-exists? "/root")
           (mkdir "/root"))
@@ -597,14 +616,24 @@ upon error."
 
         (if root-device
             (mount-root-file-system (canonicalize-device-spec root-device)
-                                    root-fs-type
+                                    (file-system-type root-fs)
                                     #:volatile-root? volatile-root?
-                                    #:flags root-fs-flags
+                                    #:flags (mount-flags->bit-mask
-                                    #:options root-options)
+                                             (file-system-flags root-fs))
+                                    #:options (file-system-options root-fs)
+                                    #:check? (check? root-fs)
+                                    #:skip-check-if-clean?
+                                    (skip-check-if-clean? root-fs)
+                                    #:repair (repair root-fs))
             (mount "none" "/root" "tmpfs"))
 
-        ;; Mount the specified file systems.
+        ;; Mount the specified non-root file systems.
-        (for-each mount-file-system
+        (for-each (lambda (fs)
+                    (mount-file-system fs
+                                       #:check? (check? fs)
+                                       #:skip-check-if-clean?
+                                       (skip-check-if-clean? fs)
+                                       #:repair (repair fs)))
                   (remove root-mount-point? mounts))
 
         (setenv "EXT2FS_NO_MTAB_OK" #f)

gnu/build/shepherd.scm

@@ -24,6 +24,12 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
+  ;; XXX: Lazy-bind the Shepherd to avoid a compile-time dependency.
+  #:autoload (shepherd service) (fork+exec-command
+                                 read-pid-file
+                                 exec-command
+                                 %precious-signals)
+  #:autoload (shepherd system) (unblock-signals)
   #:export (make-forkexec-constructor/container
             fork+exec-command/container))
 
@@ -92,14 +98,6 @@
                            (file-exists? (file-system-mapping-source mapping)))
                          mappings)))))
 
-;; XXX: Lazy-bind the Shepherd to avoid a compile-time dependency.
-(module-autoload! (current-module)
-                  '(shepherd service)
-                  '(fork+exec-command read-pid-file exec-command
-                    %precious-signals))
-(module-autoload! (current-module)
-                  '(shepherd system) '(unblock-signals))
-
 (define* (read-pid-file/container pid pid-file #:key (max-delay 5))
   "Read PID-FILE in the container namespaces of PID, which exists in a
 separate mount and PID name space.  Return the \"outer\" PID. "

gnu/build/vm.scm

@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
+;;; Copyright © 2016 Christine Lemmer-Webber <cwebber@dustycloud.org>
 ;;; Copyright © 2016, 2017 Leo Famulari <leo@famulari.name>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>

gnu/ci.scm

@@ -66,9 +66,15 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
-  #:export (%core-packages
+  #:export (derivation->job
+            image->job
+
+            %bootstrap-packages
+            %core-packages
             %cross-targets
             channel-source->package
+
+            arguments->systems
             cuirass-jobs))
 
 ;;; Commentary:
@@ -143,6 +149,14 @@ SYSTEM."
         %guile-bootstrap-tarball
         %bootstrap-tarballs))
 
+(define %bootstrap-packages
+  ;; Return the list of bootstrap packages from the commencement module.
+  (filter package?
+          (module-map
+           (lambda (sym var)
+             (variable-ref var))
+           (resolve-module '(gnu packages commencement)))))
+
 (define (packages-to-cross-build target)
   "Return the list of packages to cross-build for TARGET."
   ;; Don't cross-build the bootstrap tarballs for MinGW.
@@ -235,43 +249,48 @@ SYSTEM."
 (define (hours hours)
   (* 3600 hours))
 
+(define* (image->job store image
+                     #:key name system)
+  "Return the job for IMAGE on SYSTEM.  If NAME is passed, use it as job name,
+otherwise use the IMAGE name."
+  (let* ((image-name (or name
+                         (symbol->string (image-name image))))
+         (name (string-append image-name "." system))
+         (drv (run-with-store store
+                (mbegin %store-monad
+                  (set-guile-for-build (default-guile))
+                  (lower-object (system-image image))))))
+    (parameterize ((%graft? #f))
+      (derivation->job name drv))))
+
 (define (image-jobs store system)
   "Return a list of jobs that build images for SYSTEM."
-  (define (->job name drv)
-    (let ((name (string-append name "." system)))
-      (parameterize ((%graft? #f))
-        (derivation->job name drv))))
-
-  (define (build-image image)
-    (run-with-store store
-      (mbegin %store-monad
-        (set-guile-for-build (default-guile))
-        (lower-object (system-image image)))))
-
   (define MiB
     (expt 2 20))
 
   (if (member system %guix-system-supported-systems)
-      `(,(->job "usb-image"
+      `(,(image->job store
-                (build-image
+                     (image
-                 (image
+                      (inherit efi-disk-image)
-                  (inherit efi-disk-image)
+                      (operating-system installation-os))
-                  (operating-system installation-os))))
+                     #:name "usb-image"
-        ,(->job "iso9660-image"
+                     #:system system)
-                (build-image
+        ,(image->job
-                 (image
+          store
-                  (inherit (image-with-label
+          (image
-                            iso9660-image
+           (inherit (image-with-label
-                            (string-append "GUIX_" system "_"
+                     iso9660-image
-                                           (if (> (string-length %guix-version) 7)
+                     (string-append "GUIX_" system "_"
-                                               (substring %guix-version 0 7)
+                                    (if (> (string-length %guix-version) 7)
-                                               %guix-version))))
+                                        (substring %guix-version 0 7)
-                  (operating-system installation-os))))
+                                        %guix-version))))
+           (operating-system installation-os))
+          #:name "iso9660-image"
+          #:system system)
         ;; Only cross-compile Guix System images from x86_64-linux for now.
         ,@(if (string=? system "x86_64-linux")
-              (map (lambda (image)
+              (map (cut image->job store <>
-                     (->job (symbol->string (image-name image))
+                        #:system system)
-                            (build-image image)))
                    %guix-system-images)
               '()))
       '()))
@@ -357,6 +376,7 @@ SYSTEM."
               (>>= (profile-derivation (packages->manifest (list guix)))
                    (lambda (profile)
                      (self-contained-tarball "guix-binary" profile
+                                             #:profile-name "current-guix"
                                              #:localstatedir? #t
                                              #:compressor
                                              (lookup-compressor "xz")))))
@@ -437,6 +457,13 @@ valid."
                              load-manifest)
                     manifests))))
 
+(define (arguments->systems arguments)
+  "Return the systems list from ARGUMENTS."
+  (match (assoc-ref arguments 'systems)
+    (#f              %cuirass-supported-systems)
+    ((lst ...)       lst)
+    ((? string? str) (call-with-input-string str read))))
+
 
 ;;;
 ;;; Cuirass entry point.
@@ -448,10 +475,7 @@ valid."
     (assoc-ref arguments 'subset))
 
   (define systems
-    (match (assoc-ref arguments 'systems)
+    (arguments->systems arguments))
-      (#f              %cuirass-supported-systems)
-      ((lst ...)       lst)
-      ((? string? str) (call-with-input-string str read))))
 
   (define channels
     (let ((channels (assq-ref arguments 'channels)))
@@ -493,7 +517,7 @@ valid."
            (map (lambda (package)
                   (package-job store (job-name package)
                                package system))
-                %core-packages)
+                (append %bootstrap-packages %core-packages))
            (cross-jobs store system)))
          ('guix
           ;; Build Guix modules only.
@@ -516,6 +540,15 @@ valid."
          ('tarball
           ;; Build Guix tarball only.
           (tarball-jobs store system))
+         (('custom . modules)
+          ;; Build custom modules jobs only.
+          (append-map
+           (lambda (module)
+             (let ((proc (module-ref
+                          (resolve-interface module)
+                          'cuirass-jobs)))
+               (proc store arguments)))
+           modules))
          (('channels . channels)
           ;; Build only the packages from CHANNELS.
           (let ((all (all-packages)))

gnu/home-services.scm

@@ -0,0 +1,524 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;;
+;;; 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/>.
+
+(define-module (gnu home-services)
+  #:use-module (gnu services)
+  #:use-module (guix channels)
+  #:use-module (guix monads)
+  #:use-module (guix store)
+  #:use-module (guix gexp)
+  #:use-module (guix profiles)
+  #:use-module (guix sets)
+  #:use-module (guix ui)
+  #:use-module (guix discovery)
+  #:use-module (guix diagnostics)
+
+  #:use-module (srfi srfi-1)
+  #:use-module (ice-9 match)
+
+  #:export (home-service-type
+            home-profile-service-type
+            home-environment-variables-service-type
+            home-files-service-type
+            home-run-on-first-login-service-type
+            home-activation-service-type
+            home-run-on-change-service-type
+            home-provenance-service-type
+
+            fold-home-service-types)
+
+  #:re-export (service
+               service-type
+               service-extension))
+
+;;; Comment:
+;;;
+;;; This module is similar to (gnu system services) module, but
+;;; provides Home Services, which are supposed to be used for building
+;;; home-environment.
+;;;
+;;; Home Services use the same extension as System Services.  Consult
+;;; (gnu system services) module or manual for more information.
+;;;
+;;; home-service-type is a root of home services DAG.
+;;;
+;;; home-profile-service-type is almost the same as profile-service-type, at least
+;;; for now.
+;;;
+;;; home-environment-variables-service-type generates a @file{setup-environment}
+;;; shell script, which is expected to be sourced by login shell or other program,
+;;; which starts early and spawns all other processes.  Home services for shells
+;;; automatically add code for sourcing this file, if person do not use those home
+;;; services they have to source this script manually in their's shell *profile
+;;; file (details described in the manual).
+;;;
+;;; home-files-service-type is similar to etc-service-type, but doesn't extend
+;;; home-activation, because deploy mechanism for config files is pluggable and
+;;; can be different for different home environments: The default one is called
+;;; symlink-manager (will be introudced in a separate patch series), which creates
+;;; links for various dotfiles (like $XDG_CONFIG_HOME/$APP/...) to store, but is
+;;; possible to implement alternative approaches like read-only home from Julien's
+;;; guix-home-manager.
+;;;
+;;; home-run-on-first-login-service-type provides an @file{on-first-login} guile
+;;; script, which runs provided gexps once, when user makes first login.  It can
+;;; be used to start user's Shepherd and maybe some other process.  It relies on
+;;; assumption that /run/user/$UID will be created on login by some login
+;;; manager (elogind for example).
+;;;
+;;; home-activation-service-type provides an @file{activate} guile script, which
+;;; do three main things:
+;;;
+;;; - Sets environment variables to the values declared in
+;;; @file{setup-environment} shell script.  It's necessary, because user can set
+;;; for example XDG_CONFIG_HOME and it should be respected by activation gexp of
+;;; symlink-manager.
+;;;
+;;; - Sets GUIX_NEW_HOME and possibly GUIX_OLD_HOME vars to paths in the store.
+;;; Later those variables can be used by activation gexps, for example by
+;;; symlink-manager or run-on-change services.
+;;;
+;;; - Run all activation gexps provided by other home services.
+;;;
+;;; home-run-on-change-service-type allows to trigger actions during
+;;; activation if file or directory specified by pattern is changed.
+;;;
+;;; Code:
+
+
+(define (home-derivation entries mextensions)
+  "Return as a monadic value the derivation of the 'home'
+directory containing the given entries."
+  (mlet %store-monad ((extensions (mapm/accumulate-builds identity
+                                                          mextensions)))
+    (lower-object
+     (file-union "home" (append entries (concatenate extensions))))))
+
+(define home-service-type
+  ;; This is the ultimate service type, the root of the home service
+  ;; DAG.  The service of this type is extended by monadic name/item
+  ;; pairs.  These items end up in the "home-environment directory" as
+  ;; returned by 'home-environment-derivation'.
+  (service-type (name 'home)
+                (extensions '())
+                (compose identity)
+                (extend home-derivation)
+                (default-value '())
+                (description
+                 "Build the home environment top-level directory,
+which in turn refers to everything the home environment needs: its
+packages, configuration files, activation script, and so on.")))
+
+(define (packages->profile-entry packages)
+  "Return a system entry for the profile containing PACKAGES."
+  ;; XXX: 'mlet' is needed here for one reason: to get the proper
+  ;; '%current-target' and '%current-target-system' bindings when
+  ;; 'packages->manifest' is called, and thus when the 'package-inputs'
+  ;; etc. procedures are called on PACKAGES.  That way, conditionals in those
+  ;; inputs see the "correct" value of these two parameters.  See
+  ;; <https://issues.guix.gnu.org/44952>.
+  (mlet %store-monad ((_ (current-target-system)))
+    (return `(("profile" ,(profile
+                           (content (packages->manifest
+                                     (map identity
+                                     ;;(options->transformation transformations)
+                                     (delete-duplicates packages eq?))))))))))
+
+;; MAYBE: Add a list of transformations for packages.  It's better to
+;; place it in home-profile-service-type to affect all profile
+;; packages and prevent conflicts, when other packages relies on
+;; non-transformed version of package.
+(define home-profile-service-type
+  (service-type (name 'home-profile)
+                (extensions
+                 (list (service-extension home-service-type
+                                          packages->profile-entry)))
+                (compose concatenate)
+                (extend append)
+                (description
+                 "This is the @dfn{home profile} and can be found in
+@file{~/.guix-home/profile}.  It contains packages and
+configuration files that the user has declared in their
+@code{home-environment} record.")))
+
+(define (environment-variables->setup-environment-script vars)
+  "Return a file that can be sourced by a POSIX compliant shell which
+initializes the environment.  The file will source the home
+environment profile, set some default environment variables, and set
+environment variables provided in @code{vars}.  @code{vars} is a list
+of pairs (@code{(key . value)}), @code{key} is a string and
+@code{value} is a string or gexp.
+
+If value is @code{#f} variable will be omitted.
+If value is @code{#t} variable will be just exported.
+For any other, value variable will be set to the @code{value} and
+exported."
+  (define (warn-about-duplicate-defenitions)
+    (fold
+     (lambda (x acc)
+       (when (equal? (car x) (car acc))
+         (warning
+          (G_ "duplicate definition for `~a' environment variable ~%") (car x)))
+       x)
+     (cons "" "")
+     (sort vars (lambda (a b)
+                  (string<? (car a) (car b))))))
+
+  (warn-about-duplicate-defenitions)
+  (with-monad
+   %store-monad
+   (return
+    `(("setup-environment"
+       ;; TODO: It's necessary to source ~/.guix-profile too
+       ;; on foreign distros
+       ,(apply mixed-text-file "setup-environment"
+               "\
+HOME_ENVIRONMENT=$HOME/.guix-home
+GUIX_PROFILE=\"$HOME_ENVIRONMENT/profile\"
+PROFILE_FILE=\"$HOME_ENVIRONMENT/profile/etc/profile\"
+[ -f $PROFILE_FILE ] && . $PROFILE_FILE
+
+case $XDG_DATA_DIRS in
+  *$HOME_ENVIRONMENT/profile/share*) ;;
+  *) export XDG_DATA_DIRS=$HOME_ENVIRONMENT/profile/share:$XDG_DATA_DIRS ;;
+esac
+case $MANPATH in
+  *$HOME_ENVIRONMENT/profile/share/man*) ;;
+  *) export MANPATH=$HOME_ENVIRONMENT/profile/share/man:$MANPATH
+esac
+case $INFOPATH in
+  *$HOME_ENVIRONMENT/profile/share/info*) ;;
+  *) export INFOPATH=$HOME_ENVIRONMENT/profile/share/info:$INFOPATH ;;
+esac
+case $XDG_CONFIG_DIRS in
+  *$HOME_ENVIRONMENT/profile/etc/xdg*) ;;
+  *) export XDG_CONFIG_DIRS=$HOME_ENVIRONMENT/profile/etc/xdg:$XDG_CONFIG_DIRS ;;
+esac
+case $XCURSOR_PATH in
+  *$HOME_ENVIRONMENT/profile/share/icons*) ;;
+  *) export XCURSOR_PATH=$HOME_ENVIRONMENT/profile/share/icons:$XCURSOR_PATH ;;
+esac
+
+"
+
+               (append-map
+                (match-lambda
+                  ((key . #f)
+                   '())
+                  ((key . #t)
+                   (list "export " key "\n"))
+                  ((key . value)
+                   (list "export " key "=" value "\n")))
+                vars)))))))
+
+(define home-environment-variables-service-type
+  (service-type (name 'home-environment-variables)
+                (extensions
+                 (list (service-extension
+                        home-service-type
+                        environment-variables->setup-environment-script)))
+                (compose concatenate)
+                (extend append)
+                (default-value '())
+                (description "Set the environment variables.")))
+
+(define (files->files-directory files)
+  "Return a @code{files} directory that contains FILES."
+  (define (assert-no-duplicates files)
+    (let loop ((files files)
+               (seen (set)))
+      (match files
+        (() #t)
+        (((file _) rest ...)
+         (when (set-contains? seen file)
+           (raise (formatted-message (G_ "duplicate '~a' entry for files/")
+                                     file)))
+         (loop rest (set-insert file seen))))))
+
+  ;; Detect duplicates early instead of letting them through, eventually
+  ;; leading to a build failure of "files.drv".
+  (assert-no-duplicates files)
+
+  (file-union "files" files))
+
+(define (files-entry files)
+  "Return an entry for the @file{~/.guix-home/files}
+directory containing FILES."
+  (with-monad %store-monad
+    (return `(("files" ,(files->files-directory files))))))
+
+(define home-files-service-type
+  (service-type (name 'home-files)
+                (extensions
+                 (list (service-extension home-service-type
+                                          files-entry)))
+                (compose concatenate)
+                (extend append)
+                (default-value '())
+                (description "Configuration files for programs that
+will be put in @file{~/.guix-home/files}.")))
+
+(define (compute-on-first-login-script _ gexps)
+  (gexp->script
+   "on-first-login"
+   #~(let* ((xdg-runtime-dir (or (getenv "XDG_RUNTIME_DIR")
+                                 (format #f "/run/user/~a" (getuid))))
+            (flag-file-path (string-append
+                             xdg-runtime-dir "/on-first-login-executed"))
+            (touch (lambda (file-name)
+                     (call-with-output-file file-name (const #t)))))
+       ;; XDG_RUNTIME_DIR dissapears on logout, that means such trick
+       ;; allows to launch on-first-login script on first login only
+       ;; after complete logout/reboot.
+       (when (not (file-exists? flag-file-path))
+         (begin #$@gexps (touch flag-file-path))))))
+
+(define (on-first-login-script-entry m-on-first-login)
+  "Return, as a monadic value, an entry for the on-first-login script
+in the home environment directory."
+  (mlet %store-monad ((on-first-login m-on-first-login))
+        (return `(("on-first-login" ,on-first-login)))))
+
+(define home-run-on-first-login-service-type
+  (service-type (name 'home-run-on-first-login)
+                (extensions
+                 (list (service-extension
+                        home-service-type
+                        on-first-login-script-entry)))
+                (compose identity)
+                (extend compute-on-first-login-script)
+                (default-value #f)
+                (description "Run gexps on first user login.  Can be
+extended with one gexp.")))
+
+
+(define (compute-activation-script init-gexp gexps)
+  (gexp->script
+   "activate"
+   #~(let* ((he-init-file (lambda (he) (string-append he "/setup-environment")))
+            (he-path (string-append (getenv "HOME") "/.guix-home"))
+            (new-home-env (getenv "GUIX_NEW_HOME"))
+            (new-home (or new-home-env
+                          ;; Path of the activation file if called interactively
+                          (dirname (car (command-line)))))
+            (old-home-env (getenv "GUIX_OLD_HOME"))
+            (old-home (or old-home-env
+                          (if (file-exists? (he-init-file he-path))
+                              (readlink he-path)
+                              #f))))
+       (if (file-exists? (he-init-file new-home))
+           (let* ((port   ((@ (ice-9 popen) open-input-pipe)
+                           (format #f "source ~a && env -0"
+                                   (he-init-file new-home))))
+                  (result ((@ (ice-9 rdelim) read-delimited) "" port))
+                  (vars (map (lambda (x)
+                               (let ((si (string-index x #\=)))
+                                 (cons (string-take x si)
+                                       (string-drop x (1+ si)))))
+                             ((@ (srfi srfi-1) remove)
+                              string-null?
+                              (string-split result #\nul)))))
+             (close-port port)
+             (map (lambda (x) (setenv (car x) (cdr x))) vars)
+
+             (setenv "GUIX_NEW_HOME" new-home)
+             (setenv "GUIX_OLD_HOME" old-home)
+
+             #$@gexps
+
+             ;; Do not unset env variable if it was set outside.
+             (unless new-home-env (setenv "GUIX_NEW_HOME" #f))
+             (unless old-home-env (setenv "GUIX_OLD_HOME" #f)))
+           (format #t "\
+Activation script was either called or loaded by file from this direcotry:
+~a
+It doesn't seem that home environment is somewhere around.
+Make sure that you call ./activate by symlink from -home store item.\n"
+                   new-home)))))
+
+(define (activation-script-entry m-activation)
+  "Return, as a monadic value, an entry for the activation script
+in the home environment directory."
+  (mlet %store-monad ((activation m-activation))
+    (return `(("activate" ,activation)))))
+
+(define home-activation-service-type
+  (service-type (name 'home-activation)
+                (extensions
+                 (list (service-extension
+                        home-service-type
+                        activation-script-entry)))
+                (compose identity)
+                (extend compute-activation-script)
+                (default-value #f)
+                (description "Run gexps to activate the current
+generation of home environment and update the state of the home
+directory.  @command{activate} script automatically called during
+reconfiguration or generation switching.  This service can be extended
+with one gexp, but many times, and all gexps must be idempotent.")))
+
+
+;;;
+;;; On-change.
+;;;
+
+(define (compute-on-change-gexp eval-gexps? pattern-gexp-tuples)
+  #~(begin
+      (define (equal-regulars? file1 file2)
+        "Check if FILE1 and FILE2 are bit for bit identical."
+        (let* ((cmp-binary #$(file-append
+                              (@ (gnu packages base) diffutils) "/bin/cmp"))
+               (stats1     (lstat file1))
+               (stats2     (lstat file2)))
+          (cond
+           ((= (stat:ino stats1) (stat:ino stats2))         #t)
+           ((not (= (stat:size stats1) (stat:size stats2))) #f)
+
+           (else (= (system* cmp-binary file1 file2) 0)))))
+
+      (define (equal-symlinks? symlink1 symlink2)
+        "Check if SYMLINK1 and SYMLINK2 are pointing to the same target."
+        (string=? (readlink symlink1) (readlink symlink2)))
+
+      (define (equal-directories? dir1 dir2)
+        "Check if DIR1 and DIR2 have the same content."
+        (define (ordinary-file file)
+          (not (or (string=? file ".")
+                   (string=? file ".."))))
+        (let* ((files1 (scandir dir1 ordinary-file))
+               (files2 (scandir dir2 ordinary-file)))
+          (if (equal? files1 files2)
+              (map (lambda (file)
+                     (equal-files?
+                      (string-append dir1 "/" file)
+                      (string-append dir2 "/" file)))
+                   files1)
+              #f)))
+
+      (define (equal-files? file1 file2)
+        "Compares files, symlinks or directories of the same type."
+        (case (file-type file1)
+          ((directory) (equal-directories? file1 file2))
+          ((symlink) (equal-symlinks? file1 file2))
+          ((regular) (equal-regulars? file1 file2))
+          (else
+           (display "The file type is unsupported by on-change service.\n")
+           #f)))
+
+      (define (file-type file)
+        (stat:type (lstat file)))
+
+      (define (something-changed? file1 file2)
+        (cond
+         ((and (not (file-exists? file1))
+               (not (file-exists? file2))) #f)
+         ((or  (not (file-exists? file1))
+               (not (file-exists? file2))) #t)
+
+         ((not (eq? (file-type file1) (file-type file2))) #t)
+
+         (else
+          (not (equal-files? file1 file2)))))
+
+      (define expressions-to-eval
+        (map
+         (lambda (x)
+           (let* ((file1 (string-append
+                          (or (getenv "GUIX_OLD_HOME")
+                              "/gnu/store/non-existing-generation")
+                          "/" (car x)))
+                  (file2 (string-append (getenv "GUIX_NEW_HOME") "/" (car x)))
+                  (_ (format #t "Comparing ~a and\n~10t~a..." file1 file2))
+                  (any-changes? (something-changed? file1 file2))
+                  (_ (format #t " done (~a)\n"
+                             (if any-changes? "changed" "same"))))
+             (if any-changes? (cadr x) "")))
+         '#$pattern-gexp-tuples))
+
+      (if #$eval-gexps?
+          (begin
+            (display "Evaling on-change gexps.\n\n")
+            (for-each primitive-eval expressions-to-eval)
+            (display "On-change gexps evaluation finished.\n\n"))
+          (display "\
+On-change gexps won't be evaluated, disabled by service
+configuration.\n"))))
+
+(define home-run-on-change-service-type
+  (service-type (name 'home-run-on-change)
+                (extensions
+                 (list (service-extension
+                        home-activation-service-type
+                        identity)))
+                (compose concatenate)
+                (extend compute-on-change-gexp)
+                (default-value #t)
+                (description "\
+G-expressions to run if the specified files have changed since the
+last generation.  The extension should be a list of lists where the
+first element is the pattern for file or directory that expected to be
+changed, and the second element is the G-expression to be evaluated.")))
+
+
+;;;
+;;; Provenance tracking.
+;;;
+
+(define home-provenance-service-type
+  (service-type
+   (name 'home-provenance)
+   (extensions
+    (list (service-extension
+           home-service-type
+           (service-extension-compute
+            (first (service-type-extensions provenance-service-type))))))
+   (default-value #f)                ;the HE config file
+   (description "\
+Store provenance information about the home environment in the home
+environment itself: the channels used when building the home
+environment, and its configuration file, when available.")))
+
+(define sexp->home-provenance sexp->system-provenance)
+(define home-provenance system-provenance)
+
+
+;;;
+;;; Searching
+;;;
+
+(define (parent-directory directory)
+  "Get the parent directory of DIRECTORY"
+  (string-join (drop-right (string-split directory #\/) 1) "/"))
+
+(define %guix-home-root-directory
+  ;; Absolute file name of the module hierarchy.
+  (parent-directory (dirname (search-path %load-path "gnu/home-services.scm"))))
+
+(define %service-type-path
+  ;; Search path for service types.
+  (make-parameter `((,%guix-home-root-directory . "gnu/home-services"))))
+
+(define (all-home-service-modules)
+  "Return the default set of home-service modules."
+  (cons (resolve-interface '(gnu home-services))
+        (all-modules (%service-type-path)
+                     #:warn warn-about-load-error)))
+
+(define* (fold-home-service-types proc seed)
+  (fold-service-types proc seed (all-home-service-modules)))

gnu/home-services/configuration.scm

@@ -0,0 +1,109 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;;
+;;; 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/>.
+
+(define-module (gnu home-services configuration)
+  #:use-module (gnu services configuration)
+  #:use-module (guix gexp)
+  #:use-module (srfi srfi-1)
+  #:use-module (ice-9 curried-definitions)
+  #:use-module (ice-9 match)
+  #:use-module (guix i18n)
+  #:use-module (guix diagnostics)
+
+  #:export (filter-configuration-fields
+
+            interpose
+            list-of
+
+            list-of-strings?
+            alist?
+            string-or-gexp?
+	    serialize-string-or-gexp
+	    text-config?
+            serialize-text-config
+            generic-serialize-alist-entry
+            generic-serialize-alist))
+
+(define* (filter-configuration-fields configuration-fields fields
+				      #:optional negate?)
+  "Retrieve the fields listed in FIELDS from CONFIGURATION-FIELDS.
+If NEGATE? is @code{#t}, retrieve all fields except FIELDS."
+  (filter (lambda (field)
+            (let ((member? (member (configuration-field-name field) fields)))
+              (if (not negate?) member? (not member?))))
+          configuration-fields))
+
+
+(define* (interpose ls  #:optional (delimiter "\n") (grammar 'infix))
+  "Same as @code{string-join}, but without join and string, returns an
+DELIMITER interposed LS.  Support 'infix and 'suffix GRAMMAR values."
+  (when (not (member grammar '(infix suffix)))
+    (raise
+     (formatted-message
+      (G_ "The GRAMMAR value must be 'infix or 'suffix, but ~a provided.")
+      grammar)))
+  (fold-right (lambda (e acc)
+		(cons e
+		      (if (and (null? acc) (eq? grammar 'infix))
+			  acc
+			  (cons delimiter acc))))
+	      '() ls))
+
+(define (list-of pred?)
+  "Return a procedure that takes a list and check if all the elements of
+the list result in @code{#t} when applying PRED? on them."
+    (lambda (x)
+      (if (list? x)
+          (every pred? x)
+          #f)))
+
+
+(define list-of-strings?
+  (list-of string?))
+
+(define alist? list?)
+
+(define (string-or-gexp? sg) (or (string? sg) (gexp? sg)))
+(define (serialize-string-or-gexp field-name val) "")
+
+(define (text-config? config)
+  (and (list? config) (every string-or-gexp? config)))
+(define (serialize-text-config field-name val)
+  #~(string-append #$@(interpose val "\n" 'suffix)))
+
+(define ((generic-serialize-alist-entry serialize-field) entry)
+  "Apply the SERIALIZE-FIELD procedure on the field and value of ENTRY."
+  (match entry
+    ((field . val) (serialize-field field val))))
+
+(define (generic-serialize-alist combine serialize-field fields)
+  "Generate a configuration from an association list FIELDS.
+
+SERIALIZE-FIELD is a procedure that takes two arguments, it will be
+applied on the fields and values of FIELDS using the
+@code{generic-serialize-alist-entry} procedure.
+
+COMBINE is a procedure that takes one or more arguments and combines
+all the alist entries into one value, @code{string-append} or
+@code{append} are usually good candidates for this.
+
+See the @code{serialize-alist} procedure in `@code{(gnu home-services
+version-control}' for an example usage.)}"
+  (apply combine
+         (map (generic-serialize-alist-entry serialize-field) fields)))

gnu/home-services/fontutils.scm

@@ -0,0 +1,65 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;;
+;;; 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/>.
+
+(define-module (gnu home-services fontutils)
+  #:use-module (gnu home-services)
+  #:use-module (gnu packages fontutils)
+  #:use-module (guix gexp)
+
+  #:export (home-fontconfig-service-type))
+
+;;; Commentary:
+;;;
+;;; Services related to fonts.  home-fontconfig service provides
+;;; fontconfig configuration, which allows fc-* utilities to find
+;;; fonts in Guix Home's profile and regenerates font cache on
+;;; activation.
+;;;
+;;; Code:
+
+(define (add-fontconfig-config-file he-symlink-path)
+  `(("config/fontconfig/fonts.conf"
+     ,(mixed-text-file
+       "fonts.conf"
+       "<?xml version='1.0'?>
+<!DOCTYPE fontconfig SYSTEM 'fonts.dtd'>
+<fontconfig>
+  <dir>~/.guix-home/profile/share/fonts</dir>
+</fontconfig>"))))
+
+(define (regenerate-font-cache-gexp _)
+  `(("profile/share/fonts"
+     ,#~(system* #$(file-append fontconfig "/bin/fc-cache") "-fv"))))
+
+(define home-fontconfig-service-type
+  (service-type (name 'home-fontconfig)
+                (extensions
+                 (list (service-extension
+                        home-files-service-type
+                        add-fontconfig-config-file)
+                       (service-extension
+                        home-run-on-change-service-type
+                        regenerate-font-cache-gexp)
+                       (service-extension
+                        home-profile-service-type
+                        (const (list fontconfig)))))
+                (default-value #f)
+                (description
+                 "Provides configuration file for fontconfig and make
+fc-* utilities aware of font packages installed in Guix Home's profile.")))

gnu/home-services/mcron.scm

@@ -0,0 +1,115 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;;
+;;; 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/>.
+
+(define-module (gnu home-services mcron)
+  #:use-module (gnu packages guile-xyz)
+  #:use-module (gnu home-services)
+  #:use-module (gnu home-services shepherd)
+  #:use-module (gnu services shepherd)
+  #:use-module (guix records)
+  #:use-module (guix gexp)
+  #:use-module (srfi srfi-1)
+  #:use-module (ice-9 match)
+
+  #:export (home-mcron-configuration
+            home-mcron-service-type))
+
+;;; Commentary:
+;;
+;; Service for the GNU mcron cron job manager.
+;;
+;; Example configuration, the first job runs mbsync once every ten
+;; minutes, the second one writes "Mcron service" to ~/mcron-file once
+;; every minute.
+;;
+;; (service home-mcron-service-type
+;;            (home-mcron-configuration
+;;             (jobs (list #~(job '(next-minute
+;;                                  (range 0 60 10))
+;;                                (lambda ()
+;;                                  (system* "mbsync" "--all")))
+;;                         #~(job next-minute-from
+;;                                (lambda ()
+;;                                  (call-with-output-file (string-append (getenv "HOME")
+;;                                                                        "/mcron-file")
+;;                                    (lambda (port)
+;;                                      (display "Mcron service" port)))))))))
+;;
+;;; Code:
+
+(define-record-type* <home-mcron-configuration> home-mcron-configuration
+  make-home-mcron-configuration
+  home-mcron-configuration?
+  (package home-mcron-configuration-package ; package
+           (default mcron))
+  (jobs home-mcron-configuration-jobs   ; list of jobs
+        (default '())))
+
+(define job-files (@@ (gnu services mcron) job-files))
+(define shepherd-schedule-action
+  (@@ (gnu services mcron) shepherd-schedule-action))
+
+(define home-mcron-shepherd-services
+  (match-lambda
+    (($ <home-mcron-configuration> mcron '()) ; no jobs to run
+     '())
+    (($ <home-mcron-configuration> mcron jobs)
+     (let ((files (job-files mcron jobs)))
+       (list (shepherd-service
+              (documentation "User cron jobs.")
+              (provision '(mcron))
+              (modules `((srfi srfi-1)
+                         (srfi srfi-26)
+                         (ice-9 popen)            ; for the 'schedule' action
+                         (ice-9 rdelim)
+                         (ice-9 match)
+                         ,@%default-modules))
+              (start #~(make-forkexec-constructor
+                        (list #$(file-append mcron "/bin/mcron") #$@files)
+                        #:log-file (string-append
+                                    (or (getenv "XDG_LOG_HOME")
+                                        (format #f "~a/.local/var/log"
+                                                (getenv "HOME")))
+                                    "/mcron.log")))
+              (stop #~(make-kill-destructor))
+              (actions
+               (list (shepherd-schedule-action mcron files)))))))))
+
+(define home-mcron-profile (compose list home-mcron-configuration-package))
+
+(define (home-mcron-extend config jobs)
+  (home-mcron-configuration
+   (inherit config)
+   (jobs (append (home-mcron-configuration-jobs config)
+                 jobs))))
+
+(define home-mcron-service-type
+  (service-type (name 'home-mcron)
+                (extensions
+                 (list (service-extension
+                        home-shepherd-service-type
+                        home-mcron-shepherd-services)
+                       (service-extension
+                        home-profile-service-type
+                        home-mcron-profile)))
+                (compose concatenate)
+                (extend home-mcron-extend)
+                (default-value (home-mcron-configuration))
+                (description
+                 "Install and configure the GNU mcron cron job manager.")))

gnu/home-services/shells.scm

@@ -0,0 +1,634 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;;
+;;; 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/>.
+
+(define-module (gnu home-services shells)
+  #:use-module (gnu services configuration)
+  #:use-module (gnu home-services configuration)
+  #:use-module (gnu home-services utils)
+  #:use-module (gnu home-services)
+  #:use-module (gnu packages shells)
+  #:use-module (gnu packages bash)
+  #:use-module (guix gexp)
+  #:use-module (guix packages)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 match)
+
+  #:export (home-shell-profile-service-type
+            home-shell-profile-configuration
+
+            home-bash-service-type
+            home-bash-configuration
+            home-bash-extension
+
+            home-zsh-service-type
+            home-zsh-configuration
+            home-zsh-extension
+
+            home-fish-service-type
+            home-fish-configuration
+            home-fish-extension))
+
+;;; Commentary:
+;;;
+;;; This module contains shell related services like Zsh.
+;;;
+;;; Code:
+
+
+;;;
+;;; Shell profile.
+;;;
+
+(define path? string?)
+(define (serialize-path field-name val) val)
+
+(define-configuration home-shell-profile-configuration
+  (profile
+   (text-config '())
+   "\
+@code{home-shell-profile} is instantiated automatically by
+@code{home-environment}, DO NOT create this service manually, it can
+only be extended.
+
+@code{profile} is a list of strings or gexps, which will go to
+@file{~/.profile}.  By default @file{~/.profile} contains the
+initialization code, which have to be evaluated by login shell to make
+home-environment's profile avaliable to the user, but other commands
+can be added to the file if it is really necessary.
+
+In most cases shell's configuration files are preferred places for
+user's customizations.  Extend home-shell-profile service only if you
+really know what you do."))
+
+(define (add-shell-profile-file config)
+  `(("profile"
+     ,(mixed-text-file
+       "shell-profile"
+       "\
+HOME_ENVIRONMENT=$HOME/.guix-home
+. $HOME_ENVIRONMENT/setup-environment
+$HOME_ENVIRONMENT/on-first-login\n"
+       (serialize-configuration
+        config
+        (filter-configuration-fields
+         home-shell-profile-configuration-fields '(profile)))))))
+
+(define (add-profile-extensions config extensions)
+  (home-shell-profile-configuration
+   (inherit config)
+   (profile
+    (append (home-shell-profile-configuration-profile config)
+            extensions))))
+
+(define home-shell-profile-service-type
+  (service-type (name 'home-shell-profile)
+                (extensions
+                 (list (service-extension
+                        home-files-service-type
+                        add-shell-profile-file)))
+                (compose concatenate)
+                (extend add-profile-extensions)
+                (default-value (home-shell-profile-configuration))
+                (description "Create @file{~/.profile}, which is used
+for environment initialization of POSIX compliant login shells.  This
+service type can be extended with a list of strings or gexps.")))
+
+(define (serialize-boolean field-name val) "")
+(define (serialize-posix-env-vars field-name val)
+  #~(string-append
+     #$@(map
+         (match-lambda
+           ((key . #f)
+            "")
+           ((key . #t)
+            #~(string-append "export " #$key "\n"))
+           ((key . value)
+            #~(string-append "export " #$key "=" #$value "\n")))
+         val)))
+
+
+;;;
+;;; Zsh.
+;;;
+
+(define-configuration home-zsh-configuration
+  (package
+    (package zsh)
+    "The Zsh package to use.")
+  (xdg-flavor?
+   (boolean #t)
+   "Place all the configs to @file{$XDG_CONFIG_HOME/zsh}.  Makes
+@file{~/.zshenv} to set @env{ZDOTDIR} to @file{$XDG_CONFIG_HOME/zsh}.
+Shell startup process will continue with
+@file{$XDG_CONFIG_HOME/zsh/.zshenv}.")
+  (environment-variables
+   (alist '())
+   "Association list of environment variables to set for the Zsh session."
+   serialize-posix-env-vars)
+  (zshenv
+   (text-config '())
+   "List of strings or gexps, which will be added to @file{.zshenv}.
+Used for setting user's shell environment variables.  Must not contain
+commands assuming the presence of tty or producing output.  Will be
+read always.  Will be read before any other file in @env{ZDOTDIR}.")
+  (zprofile
+   (text-config '())
+   "List of strings or gexps, which will be added to @file{.zprofile}.
+Used for executing user's commands at start of login shell (In most
+cases the shell started on tty just after login).  Will be read before
+@file{.zlogin}.")
+  (zshrc
+   (text-config '())
+   "List of strings or gexps, which will be added to @file{.zshrc}.
+Used for executing user's commands at start of interactive shell (The
+shell for interactive usage started by typing @code{zsh} or by
+terminal app or any other program).")
+  (zlogin
+   (text-config '())
+   "List of strings or gexps, which will be added to @file{.zlogin}.
+Used for executing user's commands at the end of starting process of
+login shell.")
+  (zlogout
+   (text-config '())
+   "List of strings or gexps, which will be added to @file{.zlogout}.
+Used for executing user's commands at the exit of login shell.  It
+won't be read in some cases (if the shell terminates by exec'ing
+another process for example)."))
+
+(define (add-zsh-configuration config)
+  (let* ((xdg-flavor? (home-zsh-configuration-xdg-flavor? config)))
+
+    (define prefix-file
+      (cut string-append
+        (if xdg-flavor?
+            "config/zsh/."
+            "") <>))
+
+    (define (filter-fields field)
+      (filter-configuration-fields home-zsh-configuration-fields
+                                   (list field)))
+
+    (define (serialize-field field)
+      (serialize-configuration
+       config
+       (filter-fields field)))
+
+    (define (file-if-not-empty field)
+      (let ((file-name (symbol->string field))
+            (field-obj (car (filter-fields field))))
+        (if (not (null? ((configuration-field-getter field-obj) config)))
+            `(,(prefix-file file-name)
+              ,(mixed-text-file
+                file-name
+                (serialize-field field)))
+            '())))
+
+    (filter
+     (compose not null?)
+     `(,(if xdg-flavor?
+            `("zshenv"
+              ,(mixed-text-file
+                "auxiliary-zshenv"
+                (if xdg-flavor?
+                    "source ${XDG_CONFIG_HOME:-$HOME/.config}/zsh/.zshenv\n"
+                    "")))
+            '())
+       (,(prefix-file "zshenv")
+        ,(mixed-text-file
+          "zshenv"
+          (if xdg-flavor?
+              "export ZDOTDIR=${XDG_CONFIG_HOME:-$HOME/.config}/zsh\n"
+              "")
+          (serialize-field 'zshenv)
+          (serialize-field 'environment-variables)))
+       (,(prefix-file "zprofile")
+        ,(mixed-text-file
+          "zprofile"
+          "\
+# Setups system and user profiles and related variables
+source /etc/profile
+# Setups home environment profile
+source ~/.profile
+
+# It's only necessary if zsh is a login shell, otherwise profiles will
+# be already sourced by bash
+"
+          (serialize-field 'zprofile)))
+
+       ,@(list (file-if-not-empty 'zshrc)
+               (file-if-not-empty 'zlogin)
+               (file-if-not-empty 'zlogout))))))
+
+(define (add-zsh-packages config)
+  (list (home-zsh-configuration-package config)))
+
+(define-configuration/no-serialization home-zsh-extension
+  (environment-variables
+   (alist '())
+   "Association list of environment variables to set.")
+  (zshrc
+   (text-config '())
+   "List of strings or gexps.")
+  (zshenv
+   (text-config '())
+   "List of strings or gexps.")
+  (zprofile
+   (text-config '())
+   "List of strings or gexps.")
+  (zlogin
+   (text-config '())
+   "List of strings or gexps.")
+  (zlogout
+   (text-config '())
+   "List of strings or gexps."))
+
+(define (home-zsh-extensions original-config extension-configs)
+  (home-zsh-configuration
+   (inherit original-config)
+   (environment-variables
+    (append (home-zsh-configuration-environment-variables original-config)
+            (append-map
+             home-zsh-extension-environment-variables extension-configs)))
+   (zshrc
+    (append (home-zsh-configuration-zshrc original-config)
+            (append-map
+             home-zsh-extension-zshrc extension-configs)))
+   (zshenv
+    (append (home-zsh-configuration-zshenv original-config)
+            (append-map
+             home-zsh-extension-zshenv extension-configs)))
+   (zprofile
+    (append (home-zsh-configuration-zprofile original-config)
+            (append-map
+             home-zsh-extension-zprofile extension-configs)))
+   (zlogin
+    (append (home-zsh-configuration-zlogin original-config)
+            (append-map
+             home-zsh-extension-zlogin extension-configs)))
+   (zlogout
+    (append (home-zsh-configuration-zlogout original-config)
+            (append-map
+             home-zsh-extension-zlogout extension-configs)))))
+
+(define home-zsh-service-type
+  (service-type (name 'home-zsh)
+                (extensions
+                 (list (service-extension
+                        home-files-service-type
+                        add-zsh-configuration)
+                       (service-extension
+                        home-profile-service-type
+                        add-zsh-packages)))
+                (compose identity)
+                (extend home-zsh-extensions)
+                (default-value (home-zsh-configuration))
+                (description "Install and configure Zsh.")))
+
+
+;;;
+;;; Bash.
+;;;
+
+(define-configuration home-bash-configuration
+  (package
+   (package bash)
+   "The Bash package to use.")
+  (guix-defaults?
+   (boolean #t)
+   "Add sane defaults like reading @file{/etc/bashrc}, coloring output
+for @code{ls} provided by guix to @file{.bashrc}.")
+  (environment-variables
+   (alist '())
+   "Association list of environment variables to set for the Bash session."
+   serialize-posix-env-vars)
+  (bash-profile
+   (text-config '())
+   "List of strings or gexps, which will be added to @file{.bash_profile}.
+Used for executing user's commands at start of login shell (In most
+cases the shell started on tty just after login).  @file{.bash_login}
+won't be ever read, because @file{.bash_profile} always present.")
+  (bashrc
+   (text-config '())
+   "List of strings or gexps, which will be added to @file{.bashrc}.
+Used for executing user's commands at start of interactive shell (The
+shell for interactive usage started by typing @code{bash} or by
+terminal app or any other program).")
+  (bash-logout
+   (text-config '())
+   "List of strings or gexps, which will be added to @file{.bash_logout}.
+Used for executing user's commands at the exit of login shell.  It
+won't be read in some cases (if the shell terminates by exec'ing
+another process for example)."))
+
+;; TODO: Use value from (gnu system shadow)
+(define guix-bashrc
+  "\
+# Bash initialization for interactive non-login shells and
+# for remote shells (info \"(bash) Bash Startup Files\").
+
+# Export 'SHELL' to child processes.  Programs such as 'screen'
+# honor it and otherwise use /bin/sh.
+export SHELL
+
+if [[ $- != *i* ]]
+then
+    # We are being invoked from a non-interactive shell.  If this
+    # is an SSH session (as in \"ssh host command\"), source
+    # /etc/profile so we get PATH and other essential variables.
+    [[ -n \"$SSH_CLIENT\" ]] && source /etc/profile
+
+    # Don't do anything else.
+    return
+fi
+
+# Source the system-wide file.
+source /etc/bashrc
+
+# Adjust the prompt depending on whether we're in 'guix environment'.
+if [ -n \"$GUIX_ENVIRONMENT\" ]
+then
+    PS1='\\u@\\h \\w [env]\\$ '
+else
+    PS1='\\u@\\h \\w\\$ '
+fi
+alias ls='ls -p --color=auto'
+alias ll='ls -l'
+alias grep='grep --color=auto'\n")
+
+(define (add-bash-configuration config)
+  (define (filter-fields field)
+    (filter-configuration-fields home-bash-configuration-fields
+                                 (list field)))
+
+  (define (serialize-field field)
+    (serialize-configuration
+     config
+     (filter-fields field)))
+
+  (define* (file-if-not-empty field #:optional (extra-content #f))
+    (let ((file-name (symbol->string field))
+          (field-obj (car (filter-fields field))))
+      (if (or extra-content
+              (not (null? ((configuration-field-getter field-obj) config))))
+          `(,(object->snake-case-string file-name)
+            ,(mixed-text-file
+              (object->snake-case-string file-name)
+              (if extra-content extra-content "")
+              (serialize-field field)))
+          '())))
+
+  (filter
+   (compose not null?)
+   `(("bash_profile"
+      ,(mixed-text-file
+        "bash_profile"
+        "\
+# Setups system and user profiles and related variables
+# /etc/profile will be sourced by bash automatically
+# Setups home environment profile
+if [ -f ~/.profile ]; then source ~/.profile; fi
+
+# Honor per-interactive-shell startup file
+if [ -f ~/.bashrc ]; then source ~/.bashrc; fi
+"
+        (serialize-field 'bash-profile)
+        (serialize-field 'environment-variables)))
+
+     ,@(list (file-if-not-empty
+              'bashrc
+              (if (home-bash-configuration-guix-defaults? config)
+                  guix-bashrc
+                  #f))
+             (file-if-not-empty 'bash-logout)))))
+
+(define (add-bash-packages config)
+  (list (home-bash-configuration-package config)))
+
+(define-configuration/no-serialization home-bash-extension
+  (environment-variables
+   (alist '())
+   "Association list of environment variables to set.")
+  (bash-profile
+   (text-config '())
+   "List of strings or gexps.")
+  (bashrc
+   (text-config '())
+   "List of strings or gexps.")
+  (bash-logout
+   (text-config '())
+   "List of strings or gexps."))
+
+(define (home-bash-extensions original-config extension-configs)
+  (home-bash-configuration
+   (inherit original-config)
+   (environment-variables
+    (append (home-bash-configuration-environment-variables original-config)
+            (append-map
+             home-bash-extension-environment-variables extension-configs)))
+   (bash-profile
+    (append (home-bash-configuration-bash-profile original-config)
+            (append-map
+             home-bash-extension-bash-profile extension-configs)))
+   (bashrc
+    (append (home-bash-configuration-bashrc original-config)
+            (append-map
+             home-bash-extension-bashrc extension-configs)))
+   (bash-logout
+    (append (home-bash-configuration-bash-logout original-config)
+            (append-map
+             home-bash-extension-bash-logout extension-configs)))))
+
+(define home-bash-service-type
+  (service-type (name 'home-bash)
+                (extensions
+                 (list (service-extension
+                        home-files-service-type
+                        add-bash-configuration)
+                       (service-extension
+                        home-profile-service-type
+                        add-bash-packages)))
+                (compose identity)
+                (extend home-bash-extensions)
+                (default-value (home-bash-configuration))
+                (description "Install and configure GNU Bash.")))
+
+
+;;;
+;;; Fish.
+;;;
+
+(define (serialize-fish-aliases field-name val)
+  #~(string-append
+     #$@(map (match-lambda
+               ((key . value)
+                #~(string-append "alias " #$key " \"" #$value "\"\n"))
+               (_ ""))
+             val)))
+
+(define (serialize-fish-abbreviations field-name val)
+  #~(string-append
+     #$@(map (match-lambda
+               ((key . value)
+                #~(string-append "abbr --add " #$key " " #$value "\n"))
+               (_ ""))
+             val)))
+
+(define (serialize-fish-env-vars field-name val)
+  #~(string-append
+     #$@(map (match-lambda
+               ((key . #f)
+                "")
+               ((key . #t)
+                #~(string-append "set " #$key "\n"))
+               ((key . value)
+                #~(string-append "set " #$key " "  #$value "\n")))
+             val)))
+
+(define-configuration home-fish-configuration
+  (package
+    (package fish)
+    "The Fish package to use.")
+  (config
+   (text-config '())
+   "List of strings or gexps, which will be added to
+@file{$XDG_CONFIG_HOME/fish/config.fish}.")
+  (environment-variables
+   (alist '())
+   "Association list of environment variables to set in Fish."
+   serialize-fish-env-vars)
+  (aliases
+   (alist '())
+   "Association list of aliases for Fish, both the key and the value
+should be a string.  An alias is just a simple function that wraps a
+command, If you want something more akin to @dfn{aliases} in POSIX
+shells, see the @code{abbreviations} field."
+   serialize-fish-aliases)
+  (abbreviations
+   (alist '())
+   "Association list of abbreviations for Fish.  These are words that,
+when typed in the shell, will automatically expand to the full text."
+   serialize-fish-abbreviations))
+
+(define (fish-files-service config)
+  `(("config/fish/config.fish"
+     ,(mixed-text-file
+       "fish-config.fish"
+       #~(string-append "\
+# if we haven't sourced the login config, do it
+status --is-login; and not set -q __fish_login_config_sourced
+and begin
+
+  set --prepend fish_function_path "
+                        #$fish-foreign-env
+                        "/share/fish/functions
+  fenv source $HOME/.profile
+  set -e fish_function_path[1]
+
+  set -g __fish_login_config_sourced 1
+
+end\n\n")
+       (serialize-configuration
+        config
+        home-fish-configuration-fields)))))
+
+(define (fish-profile-service config)
+  (list (home-fish-configuration-package config)))
+
+(define-configuration/no-serialization home-fish-extension
+  (config
+   (text-config '())
+   "List of strings or gexps for extending the Fish initialization file.")
+  (environment-variables
+   (alist '())
+   "Association list of environment variables to set.")
+  (aliases
+   (alist '())
+   "Association list of Fish aliases.")
+  (abbreviations
+   (alist '())
+   "Association list of Fish abbreviations."))
+
+(define (home-fish-extensions original-config extension-configs)
+  (home-fish-configuration
+   (inherit original-config)
+   (config
+    (append (home-fish-configuration-config original-config)
+            (append-map
+             home-fish-extension-config extension-configs)))
+   (environment-variables
+    (append (home-fish-configuration-environment-variables original-config)
+            (append-map
+             home-fish-extension-environment-variables extension-configs)))
+   (aliases
+    (append (home-fish-configuration-aliases original-config)
+            (append-map
+             home-fish-extension-aliases extension-configs)))
+   (abbreviations
+    (append (home-fish-configuration-abbreviations original-config)
+            (append-map
+             home-fish-extension-abbreviations extension-configs)))))
+
+;; TODO: Support for generating completion files
+;; TODO: Support for installing plugins
+(define home-fish-service-type
+  (service-type (name 'home-fish)
+                (extensions
+                 (list (service-extension
+                        home-files-service-type
+                        fish-files-service)
+                       (service-extension
+                        home-profile-service-type
+                        fish-profile-service)))
+                (compose identity)
+                (extend home-fish-extensions)
+                (default-value (home-fish-configuration))
+                (description "\
+Install and configure Fish, the friendly interactive shell.")))
+
+
+(define (generate-home-shell-profile-documentation)
+  (generate-documentation
+   `((home-shell-profile-configuration
+      ,home-shell-profile-configuration-fields))
+   'home-shell-profile-configuration))
+
+(define (generate-home-bash-documentation)
+  (generate-documentation
+   `((home-bash-configuration
+      ,home-bash-configuration-fields))
+   'home-bash-configuration))
+
+(define (generate-home-zsh-documentation)
+  (generate-documentation
+   `((home-zsh-configuration
+      ,home-zsh-configuration-fields))
+   'home-zsh-configuration))
+
+(define (generate-home-fish-documentation)
+  (string-append
+   (generate-documentation
+    `((home-fish-configuration
+       ,home-fish-configuration-fields))
+    'home-fish-configuration)
+   "\n\n"
+   (generate-documentation
+    `((home-fish-extension
+       ,home-fish-extension-fields))
+    'home-fish-extension)))

gnu/home-services/shepherd.scm

@@ -0,0 +1,134 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;;
+;;; 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/>.
+
+(define-module (gnu home-services shepherd)
+  #:use-module (gnu home-services)
+  #:use-module (gnu packages admin)
+  #:use-module (gnu services shepherd)
+  #:use-module (guix sets)
+  #:use-module (guix gexp)
+  #:use-module (guix records)
+
+  #:use-module (srfi srfi-1)
+
+  #:export (home-shepherd-service-type
+            home-shepherd-configuration)
+  #:re-export (shepherd-service
+               shepherd-action))
+
+(define-record-type* <home-shepherd-configuration>
+  home-shepherd-configuration make-home-shepherd-configuration
+  home-shepherd-configuration?
+  (shepherd home-shepherd-configuration-shepherd
+            (default shepherd)) ; package
+  (auto-start? home-shepherd-configuration-auto-start?
+               (default #t))
+  (services home-shepherd-configuration-services
+            (default '())))
+
+(define (home-shepherd-configuration-file services shepherd)
+  "Return the shepherd configuration file for SERVICES.  SHEPHERD is used
+as shepherd package."
+  (assert-valid-graph services)
+
+  (let ((files (map shepherd-service-file services))
+        ;; TODO: Add compilation of services, it can improve start
+        ;; time.
+        ;; (scm->go (cute scm->go <> shepherd))
+        )
+    (define config
+      #~(begin
+          (use-modules (srfi srfi-34)
+                       (system repl error-handling))
+          (apply
+           register-services
+           (map
+            (lambda (file) (load file))
+            '#$files))
+          (action 'root 'daemonize)
+          (format #t "Starting services...~%")
+          (for-each
+           (lambda (service) (start service))
+           '#$(append-map shepherd-service-provision
+                          (filter shepherd-service-auto-start?
+                                  services)))
+          (newline)))
+
+    (scheme-file "shepherd.conf" config)))
+
+(define (launch-shepherd-gexp config)
+  (let* ((shepherd (home-shepherd-configuration-shepherd config))
+         (services (home-shepherd-configuration-services config)))
+    (if (home-shepherd-configuration-auto-start? config)
+        (with-imported-modules '((guix build utils))
+          #~(let ((log-dir (or (getenv "XDG_LOG_HOME")
+                               (format #f "~a/.local/var/log" (getenv "HOME")))))
+              ((@ (guix build utils) mkdir-p) log-dir)
+              (system*
+               #$(file-append shepherd "/bin/shepherd")
+               "--logfile"
+               (string-append
+                log-dir
+                "/shepherd.log")
+               "--config"
+               #$(home-shepherd-configuration-file services shepherd))))
+        #~"")))
+
+(define (reload-configuration-gexp config)
+  (let* ((shepherd (home-shepherd-configuration-shepherd config))
+         (services (home-shepherd-configuration-services config)))
+    #~(system*
+       #$(file-append shepherd "/bin/herd")
+       "load" "root"
+       #$(home-shepherd-configuration-file services shepherd))))
+
+(define (ensure-shepherd-gexp config)
+  #~(if (file-exists?
+         (string-append
+          (or (getenv "XDG_RUNTIME_DIR")
+              (format #f "/run/user/~a" (getuid)))
+          "/shepherd/socket"))
+        #$(reload-configuration-gexp config)
+        #$(launch-shepherd-gexp config)))
+
+(define-public home-shepherd-service-type
+  (service-type (name 'home-shepherd)
+                (extensions
+                 (list (service-extension
+                        home-run-on-first-login-service-type
+                        launch-shepherd-gexp)
+                       (service-extension
+                        home-activation-service-type
+                        ensure-shepherd-gexp)
+                       (service-extension
+                        home-profile-service-type
+                        (lambda (config)
+                          `(,(home-shepherd-configuration-shepherd config))))))
+                (compose concatenate)
+                (extend
+                 (lambda (config extra-services)
+                   (home-shepherd-configuration
+                    (inherit config)
+                    (services
+                     (append (home-shepherd-configuration-services config)
+                             extra-services)))))
+                (default-value (home-shepherd-configuration))
+                (description "Configure and install userland Shepherd.")))
+
+

gnu/home-services/symlink-manager.scm

@@ -0,0 +1,247 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;;
+;;; 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/>.
+
+(define-module (gnu home-services symlink-manager)
+  #:use-module (gnu home-services)
+  #:use-module (guix gexp)
+
+  #:export (home-symlink-manager-service-type))
+
+;;; Comment:
+;;;
+;;; symlink-manager cares about configuration files: it backs up files
+;;; created by user, removes symlinks and directories created by a
+;;; previous generation, and creates new directories and symlinks to
+;;; configuration files according to the content of files/ directory
+;;; (created by home-files-service) of the current home environment
+;;; generation.
+;;;
+;;; Code:
+
+(define (update-symlinks-script)
+  (program-file
+   "update-symlinks"
+   #~(begin
+       (use-modules (ice-9 ftw)
+                    (ice-9 curried-definitions)
+                    (ice-9 match)
+                    (srfi srfi-1))
+       (define ((simplify-file-tree parent) file)
+         "Convert the result produced by `file-system-tree' to less
+verbose and more suitable for further processing format.
+
+Extract dir/file info from stat and compose a relative path to the
+root of the file tree.
+
+Sample output:
+
+((dir . \".\")
+ ((dir . \"config\")
+  ((dir . \"config/fontconfig\")
+   (file . \"config/fontconfig/fonts.conf\"))
+  ((dir . \"config/isync\")
+   (file . \"config/isync/mbsyncrc\"))))
+"
+         (match file
+           ((name stat) `(file . ,(string-append parent name)))
+           ((name stat children ...)
+            (cons `(dir . ,(string-append parent name))
+                  (map (simplify-file-tree
+                        (if (equal? name ".")
+                            ""
+                            (string-append parent name "/")))
+                       children)))))
+
+       (define ((file-tree-traverse preordering) node)
+         "Traverses the file tree in different orders, depending on PREORDERING.
+
+if PREORDERING is @code{#t} resulting list will contain directories
+before files located in those directories, otherwise directory will
+appear only after all nested items already listed."
+         (let ((prepend (lambda (a b) (append b a))))
+           (match node
+             (('file . path) (list node))
+             ((('dir . path) . rest)
+              ((if preordering append prepend)
+               (list (cons 'dir path))
+               (append-map (file-tree-traverse preordering) rest))))))
+
+       (use-modules (guix build utils))
+
+       (let* ((config-home    (or (getenv "XDG_CONFIG_HOME")
+                                  (string-append (getenv "HOME") "/.config")))
+
+              (he-path (string-append (getenv "HOME") "/.guix-home"))
+              (new-he-path (string-append he-path ".new"))
+              (new-home (getenv "GUIX_NEW_HOME"))
+              (old-home (getenv "GUIX_OLD_HOME"))
+
+              (new-files-path (string-append new-home "/files"))
+              ;; Trailing dot is required, because files itself is symlink and
+              ;; to make file-system-tree works it should be a directory.
+              (new-files-dir-path (string-append new-files-path "/."))
+
+              (home-path (getenv "HOME"))
+              (backup-dir (string-append home-path "/"
+                                         (number->string (current-time))
+                                         "-guix-home-legacy-configs-backup"))
+
+              (old-tree (if old-home
+                          ((simplify-file-tree "")
+                           (file-system-tree
+                            (string-append old-home "/files/.")))
+                          #f))
+              (new-tree ((simplify-file-tree "")
+                         (file-system-tree new-files-dir-path)))
+
+              (get-source-path
+               (lambda (path)
+                 (readlink (string-append new-files-path "/" path))))
+
+              (get-target-path
+               (lambda (path)
+                 (string-append home-path "/." path)))
+
+              (get-backup-path
+               (lambda (path)
+                 (string-append backup-dir "/." path)))
+
+              (directory?
+               (lambda (path)
+                 (equal? (stat:type (stat path)) 'directory)))
+
+              (empty-directory?
+               (lambda (dir)
+                 (equal? (scandir dir) '("." ".."))))
+
+              (symlink-to-store?
+               (lambda (path)
+                 (and
+                  (equal? (stat:type (lstat path)) 'symlink)
+                  (store-file-name? (readlink path)))))
+
+              (backup-file
+               (lambda (path)
+                 (mkdir-p backup-dir)
+                 (format #t "Backing up ~a..." (get-target-path path))
+                 (mkdir-p (dirname (get-backup-path path)))
+                 (rename-file (get-target-path path) (get-backup-path path))
+                 (display " done\n")))
+
+              (cleanup-symlinks
+               (lambda ()
+                 (let ((to-delete ((file-tree-traverse #f) old-tree)))
+                   (display
+                    "Cleaning up symlinks from previous home-environment.\n\n")
+                   (map
+                    (match-lambda
+                      (('dir . ".")
+                       (display "Cleanup finished.\n\n"))
+
+                      (('dir . path)
+                       (if (and
+                            (file-exists? (get-target-path path))
+                            (directory? (get-target-path path))
+                            (empty-directory? (get-target-path path)))
+                           (begin
+                             (format #t "Removing ~a..."
+                                     (get-target-path path))
+                             (rmdir (get-target-path path))
+                             (display " done\n"))
+                           (format
+                            #t "Skipping ~a (not an empty directory)... done\n"
+                            (get-target-path path))))
+
+                      (('file . path)
+                       (when (file-exists? (get-target-path path))
+                         ;; DO NOT remove the file if it is no longer
+                         ;; a symlink to the store, it will be backed
+                         ;; up later during create-symlinks phase.
+                         (if (symlink-to-store? (get-target-path path))
+                             (begin
+                               (format #t "Removing ~a..." (get-target-path path))
+                               (delete-file (get-target-path path))
+                               (display " done\n"))
+                             (format
+                              #t
+                              "Skipping ~a (not a symlink to store)... done\n"
+                              (get-target-path path))))))
+                    to-delete))))
+
+              (create-symlinks
+               (lambda ()
+                 (let ((to-create ((file-tree-traverse #t) new-tree)))
+                   (map
+                    (match-lambda
+                      (('dir . ".")
+                       (display
+                        "New symlinks to home-environment will be created soon.\n")
+                       (format
+                        #t "All conflicting files will go to ~a.\n\n" backup-dir))
+
+                      (('dir . path)
+                       (let ((target-path (get-target-path path)))
+                         (when (and (file-exists? target-path)
+                                    (not (directory? target-path)))
+                           (backup-file path))
+
+                         (if (file-exists? target-path)
+                             (format
+                              #t "Skipping   ~a (directory already exists)... done\n"
+                              target-path)
+                             (begin
+                               (format #t "Creating   ~a..." target-path)
+                               (mkdir target-path)
+                               (display " done\n")))))
+
+                      (('file . path)
+                       (when (file-exists? (get-target-path path))
+                         (backup-file path))
+                       (format #t "Symlinking ~a -> ~a..."
+                               (get-target-path path) (get-source-path path))
+                       (symlink (get-source-path path) (get-target-path path))
+                       (display " done\n")))
+                    to-create)))))
+
+         (when old-tree
+           (cleanup-symlinks))
+
+         (create-symlinks)
+
+         (symlink new-home new-he-path)
+         (rename-file new-he-path he-path)
+
+         (display " done\nFinished updating symlinks.\n\n")))))
+
+
+(define (update-symlinks-gexp _)
+  #~(primitive-load #$(update-symlinks-script)))
+
+(define home-symlink-manager-service-type
+  (service-type (name 'home-symlink-manager)
+                (extensions
+                 (list
+                  (service-extension
+                   home-activation-service-type
+                   update-symlinks-gexp)))
+                (default-value #f)
+                (description "Provide an @code{update-symlinks}
+script, which creates symlinks to configuration files and directories
+on every activation.  If an existing file would be overwritten by a
+symlink, backs up that file first.")))

gnu/home-services/utils.scm

@@ -0,0 +1,105 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
+;;;
+;;; 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/>.
+
+(define-module (gnu home-services utils)
+  #:use-module (ice-9 string-fun)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+
+  #:export (maybe-object->string
+            object->snake-case-string
+            object->camel-case-string
+            list->human-readable-list))
+
+(define (maybe-object->string object)
+  "Like @code{object->string} but don't do anyting if OBJECT already is
+a string."
+  (if (string? object)
+      object
+      (object->string object)))
+
+;; Snake case: <https://en.wikipedia.org/wiki/Snake_case>
+(define* (object->snake-case-string object #:optional (style 'lower))
+  "Convert the object OBJECT to the equivalent string in ``snake
+case''.  STYLE can be three `@code{lower}', `@code{upper}', or
+`@code{capitalize}', defaults to `@code{lower}'.
+
+@example
+(object->snake-case-string 'variable-name 'upper)
+@result{} \"VARIABLE_NAME\" @end example"
+  (if (not (member style '(lower upper capitalize)))
+      (error 'invalid-style (format #f "~a is not a valid style" style))
+      (let ((stringified (maybe-object->string object)))
+        (string-replace-substring
+         (cond
+          ((equal? style 'lower) stringified)
+          ((equal? style 'upper) (string-upcase stringified))
+          (else (string-capitalize stringified)))
+         "-" "_"))))
+
+(define* (object->camel-case-string object #:optional (style 'lower))
+  "Convert the object OBJECT to the equivalent string in ``camel case''.
+STYLE can be three `@code{lower}', `@code{upper}', defaults to
+`@code{lower}'.
+
+@example
+(object->camel-case-string 'variable-name 'upper)
+@result{} \"VariableName\"
+@end example"
+  (if (not (member style '(lower upper)))
+      (error 'invalid-style (format #f "~a is not a valid style" style))
+      (let ((stringified (maybe-object->string object)))
+        (cond
+         ((eq? style 'upper)
+          (string-concatenate
+           (map string-capitalize
+                (string-split stringified (cut eqv? <> #\-)))))
+         ((eq? style 'lower)
+          (let ((splitted-string (string-split stringified (cut eqv? <> #\-))))
+            (string-concatenate
+             (cons (first splitted-string)
+                   (map string-capitalize
+                        (cdr splitted-string))))))))))
+
+(define* (list->human-readable-list lst
+                                    #:key
+                                    (cumulative? #f)
+                                    (proc identity))
+  "Turn a list LST into a sequence of terms readable by humans.
+If CUMULATIVE? is @code{#t}, use ``and'', otherwise use ``or'' before
+the last term.
+
+PROC is a procedure to apply to each of the elements of a list before
+turning them into a single human readable string.
+
+@example
+(list->human-readable-list '(1 4 9) #:cumulative? #t #:proc sqrt)
+@result{} \"1, 2, and 3\"
+@end example
+
+yields:"
+  (let* ((word (if cumulative? "and " "or "))
+         (init (append (drop-right lst 1))))
+    (format #f "~a" (string-append
+                     (string-join
+                      (map (compose maybe-object->string proc) init)
+                      ", " 'suffix)
+                     word
+                     (maybe-object->string (proc (last lst)))))))
+

gnu/home-services/xdg.scm

@@ -0,0 +1,478 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;;
+;;; 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/>.
+
+(define-module (gnu home-services xdg)
+  #:use-module (gnu services configuration)
+  #:use-module (gnu home-services configuration)
+  #:use-module (gnu home-services)
+  #:use-module (gnu packages freedesktop)
+  #:use-module (gnu home-services utils)
+  #:use-module (guix gexp)
+  #:use-module (guix records)
+  #:use-module (guix i18n)
+  #:use-module (guix diagnostics)
+
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (rnrs enums)
+
+  #:export (home-xdg-base-directories-service-type
+            home-xdg-base-directories-configuration
+            home-xdg-base-directories-configuration?
+
+            home-xdg-user-directories-service-type
+            home-xdg-user-directories-configuration
+            home-xdg-user-directories-configuration?
+
+            xdg-desktop-action
+            xdg-desktop-entry
+            home-xdg-mime-applications-service-type
+            home-xdg-mime-applications-configuration))
+
+;;; Commentary:
+;;
+;; This module contains services related to XDG directories and
+;; applications.
+;;
+;; - XDG base directories
+;; - XDG user directories
+;; - XDG MIME applications
+;;
+;;; Code:
+
+
+;;;
+;;; XDG base directories.
+;;;
+
+(define (serialize-path field-name val) "")
+(define path? string?)
+
+(define-configuration home-xdg-base-directories-configuration
+  (cache-home
+   (path "$HOME/.cache")
+   "Base directory for programs to store user-specific non-essential
+(cached) data.  Files in this directory can be deleted anytime without
+loss of important data.")
+  (config-home
+   (path "$HOME/.config")
+   "Base directory for programs to store configuration files.
+Some programs store here log or state files, but it's not desired,
+this directory should contain static configurations.")
+  (data-home
+   (path "$HOME/.local/share")
+   "Base directory for programs to store architecture independent
+read-only shared data, analogus to @file{/usr/share}, but for user.")
+  (runtime-dir
+   (path "${XDG_RUNTIME_DIR:-/run/user/$UID}")
+   "Base directory for programs to store user-specific runtime files,
+like sockets.")
+  (log-home
+   (path "$HOME/.local/var/log")
+   "Base directory for programs to store log files, analogus to
+@file{/var/log}, but for user.  It is not a part of XDG Base Directory
+Specification, but helps to make implementation of home services more
+consistent.")
+  (state-home
+   (path "$HOME/.local/var/lib")
+   "Base directory for programs to store state files, like databases,
+analogus to @file{/var/lib}, but for user.  It is not a part of XDG
+Base Directory Specification, but helps to make implementation of home
+services more consistent."))
+
+(define (home-xdg-base-directories-environment-variables-service config)
+  (map
+   (lambda (field)
+     (cons (format
+            #f "XDG_~a"
+            (object->snake-case-string (configuration-field-name field) 'upper))
+           ((configuration-field-getter field) config)))
+   home-xdg-base-directories-configuration-fields))
+
+(define (ensure-xdg-base-dirs-on-activation config)
+  #~(map (lambda (xdg-base-dir-variable)
+           ((@@ (guix build utils) mkdir-p)
+            (getenv
+             xdg-base-dir-variable)))
+         '#$(map (lambda (field)
+                   (format
+                    #f "XDG_~a"
+                    (object->snake-case-string
+                     (configuration-field-name field) 'upper)))
+                 home-xdg-base-directories-configuration-fields)))
+
+(define (last-extension-or-cfg config extensions)
+  "Picks configuration value from last provided extension.  If there
+are no extensions use configuration instead."
+  (or (and (not (null? extensions)) (last extensions)) config))
+
+(define home-xdg-base-directories-service-type
+  (service-type (name 'home-xdg-base-directories)
+                (extensions
+                 (list (service-extension
+                        home-environment-variables-service-type
+                        home-xdg-base-directories-environment-variables-service)
+                       (service-extension
+                        home-activation-service-type
+                        ensure-xdg-base-dirs-on-activation)))
+                (default-value (home-xdg-base-directories-configuration))
+                (compose identity)
+                (extend last-extension-or-cfg)
+                (description "Configure XDG base directories.  This
+service introduces two additional variables @env{XDG_STATE_HOME},
+@env{XDG_LOG_HOME}.  They are not a part of XDG specification, at
+least yet, but are convinient to have, it improves the consistency
+between different home services.  The services of this service-type is
+instantiated by default, to provide non-default value, extend the
+service-type (using @code{simple-service} for example).")))
+
+(define (generate-home-xdg-base-directories-documentation)
+  (generate-documentation
+   `((home-xdg-base-directories-configuration
+      ,home-xdg-base-directories-configuration-fields))
+   'home-xdg-base-directories-configuration))
+
+
+;;;
+;;; XDG user directories.
+;;;
+
+(define (serialize-string field-name val)
+  ;; The path has to be quoted
+  (format #f "XDG_~a_DIR=\"~a\"\n"
+          (object->snake-case-string field-name 'upper) val))
+
+(define-configuration home-xdg-user-directories-configuration
+  (desktop
+   (string "$HOME/Desktop")
+   "Default ``desktop'' directory, this is what you see on your
+desktop when using a desktop environment,
+e.g. GNOME (@pxref{XWindow,,,guix.info}).")
+  (documents
+   (string "$HOME/Documents")
+   "Default directory to put documents like PDFs.")
+  (download
+   (string "$HOME/Downloads")
+   "Default directory downloaded files, this is where your Web-broser
+will put downloaded files in.")
+  (music
+   (string "$HOME/Music")
+   "Default directory for audio files.")
+  (pictures
+   (string "$HOME/Pictures")
+   "Default directory for pictures and images.")
+  (publicshare
+   (string "$HOME/Public")
+   "Default directory for shared files, which can be accessed by other
+users on local machine or via network.")
+  (templates
+   (string "$HOME/Templates")
+   "Default directory for templates.  They can be used by graphical
+file manager or other apps for creating new files with some
+pre-populated content.")
+  (videos
+   (string "$HOME/Videos")
+   "Default directory for videos."))
+
+(define (home-xdg-user-directories-files-service config)
+  `(("config/user-dirs.conf"
+     ,(mixed-text-file
+       "user-dirs.conf"
+       "enabled=False\n"))
+    ("config/user-dirs.dirs"
+     ,(mixed-text-file
+       "user-dirs.dirs"
+      (serialize-configuration
+       config
+       home-xdg-user-directories-configuration-fields)))))
+
+(define (home-xdg-user-directories-activation-service config)
+  (let ((dirs (map (lambda (field)
+                     ((configuration-field-getter field) config))
+                   home-xdg-user-directories-configuration-fields)))
+    #~(let ((ensure-dir
+             (lambda (path)
+               (mkdir-p
+                ((@@ (ice-9 string-fun) string-replace-substring)
+                 path "$HOME" (getenv "HOME"))))))
+        (display "Creating XDG user directories...")
+        (map ensure-dir '#$dirs)
+        (display " done\n"))))
+
+(define home-xdg-user-directories-service-type
+  (service-type (name 'home-xdg-user-directories)
+                (extensions
+                 (list (service-extension
+                        home-files-service-type
+                        home-xdg-user-directories-files-service)
+                       (service-extension
+                        home-activation-service-type
+                        home-xdg-user-directories-activation-service)))
+                (default-value (home-xdg-user-directories-configuration))
+                (description "Configure XDG user directories.  To
+disable a directory, point it to the $HOME.")))
+
+(define (generate-home-xdg-user-directories-documentation)
+  (generate-documentation
+   `((home-xdg-user-directories-configuration
+     ,home-xdg-user-directories-configuration-fields))
+   'home-xdg-user-directories-configuration))
+
+
+;;;
+;;; XDG MIME applications.
+;;;
+
+;; Example config
+;;
+;;  (home-xdg-mime-applications-configuration
+;;   (added '((x-scheme-handler/magnet . torrent.desktop)))
+;;   (default '((inode/directory . file.desktop)))
+;;   (removed '((inode/directory . thunar.desktop)))
+;;   (desktop-entries
+;;    (list (xdg-desktop-entry
+;;           (file "file")
+;;           (name "File manager")
+;;           (type 'application)
+;;           (config
+;;            '((exec . "emacsclient -c -a emacs %u"))))
+;;          (xdg-desktop-entry
+;;           (file "text")
+;;           (name "Text editor")
+;;           (type 'application)
+;;           (config
+;;            '((exec . "emacsclient -c -a emacs %u")))
+;;           (actions
+;;            (list (xdg-desktop-action
+;;                   (action 'create)
+;;                   (name "Create an action")
+;;                   (config
+;;                    '((exec . "echo hi"))))))))))
+
+;; See
+;; <https://specifications.freedesktop.org/shared-mime-info-spec/shared-mime-info-spec-latest.html>
+;; <https://specifications.freedesktop.org/mime-apps-spec/mime-apps-spec-latest.html>
+
+(define (serialize-alist field-name val)
+  (define (serialize-mimelist-entry key val)
+    (let ((val (cond
+                ((list? val)
+                 (string-join (map maybe-object->string val) ";"))
+                ((or (string? val) (symbol? val))
+                 val)
+                (else (raise (formatted-message
+                              (G_ "\
+The value of an XDG MIME entry must be a list, string or symbol, was given ~a")
+                              val))))))
+      (format #f "~a=~a\n" key val)))
+
+  (define (merge-duplicates alist acc)
+    "Merge values that have the same key.
+
+@example
+(merge-duplicates '((key1 . value1)
+                    (key2 . value2)
+                    (key1 . value3)
+                    (key1 . value4)) '())
+
+@result{} ((key1 . (value4 value3 value1)) (key2 . value2))
+@end example"
+    (cond
+     ((null? alist) acc)
+     (else (let* ((head (first alist))
+                  (tail (cdr alist))
+                  (key (first head))
+                  (value (cdr head))
+                  (duplicate? (assoc key acc))
+                  (ensure-list (lambda (x)
+                                 (if (list? x) x (list x)))))
+             (if duplicate?
+                 ;; XXX: This will change the order of things,
+                 ;; though, it shouldn't be a problem for XDG MIME.
+                 (merge-duplicates
+                  tail
+                  (alist-cons key
+                              (cons value (ensure-list (cdr duplicate?)))
+                              (alist-delete key acc)))
+                 (merge-duplicates tail (cons head acc)))))))
+
+  (string-append (if (equal? field-name 'default)
+                     "\n[Default Applications]\n"
+                     (format #f "\n[~a Associations]\n"
+                             (string-capitalize (symbol->string field-name))))
+                 (generic-serialize-alist string-append
+                                          serialize-mimelist-entry
+                                          (merge-duplicates val '()))))
+
+(define xdg-desktop-types (make-enumeration
+                           '(application
+                             link
+                             directory)))
+
+(define (xdg-desktop-type? type)
+  (unless (enum-set-member? type xdg-desktop-types)
+    (raise (formatted-message
+            (G_ "XDG desktop type must be of of ~a, was given: ~a")
+            (list->human-readable-list (enum-set->list xdg-desktop-types))
+            type))))
+
+;; TODO: Add proper docs for this
+;; XXX: 'define-configuration' require that fields have a default
+;; value.
+(define-record-type* <xdg-desktop-action>
+  xdg-desktop-action make-xdg-desktop-action
+  xdg-desktop-action?
+  (action xdg-desktop-action-action)  ; symbol
+  (name   xdg-desktop-action-name)    ; string
+  (config xdg-desktop-action-config   ; alist
+          (default '())))
+
+(define-record-type* <xdg-desktop-entry>
+  xdg-desktop-entry make-xdg-desktop-entry
+  xdg-desktop-entry?
+  ;; ".desktop" will automatically be added
+  (file    xdg-desktop-entry-file)    ; string
+  (name    xdg-desktop-entry-name)    ; string
+  (type    xdg-desktop-entry-type)    ; xdg-desktop-type
+  (config  xdg-desktop-entry-config   ; alist
+           (default '()))
+  (actions xdg-desktop-entry-actions  ; list of <xdg-desktop-action>
+           (default '())))
+
+(define desktop-entries? (list-of xdg-desktop-entry?))
+(define (serialize-desktop-entries field-name val) "")
+
+(define (serialize-xdg-desktop-entry entry)
+  "Return a tuple of the file name for ENTRY and the serialized
+configuration."
+  (define (format-config key val)
+    (let ((val (cond
+                ((list? val)
+                 (string-join (map maybe-object->string val) ";"))
+                ((boolean? val)
+                 (if val "true" "false"))
+                (else val)))
+          (key (string-capitalize (maybe-object->string key))))
+      (list (if (string-suffix? key "?")
+                (string-drop-right key (- (string-length key) 1))
+                key)
+            "=" val "\n")))
+
+  (define (serialize-alist config)
+    (generic-serialize-alist identity format-config config))
+
+  (define (serialize-xdg-desktop-action action)
+    (match action
+      (($ <xdg-desktop-action> action name config)
+       `(,(format #f "[Desktop Action ~a]\n"
+                  (string-capitalize (maybe-object->string action)))
+         ,(format #f "Name=~a\n" name)
+         ,@(serialize-alist config)))))
+
+  (match entry
+    (($ <xdg-desktop-entry> file name type config actions)
+     (list (if (string-suffix? file ".desktop")
+               file
+               (string-append file ".desktop"))
+           `("[Desktop Entry]\n"
+             ,(format #f "Name=~a\n" name)
+             ,(format #f "Type=~a\n"
+                      (string-capitalize (symbol->string type)))
+             ,@(serialize-alist config)
+             ,@(append-map serialize-xdg-desktop-action actions))))))
+
+(define-configuration home-xdg-mime-applications-configuration
+  (added
+   (alist '())
+   "An association list of MIME types and desktop entries which indicate
+that the application should used to open the specified MIME type.  The
+value has to be string, symbol, or list of strings or symbols, this
+applies to the `@code{default}', and `@code{removed}' fields as well.")
+  (default
+    (alist '())
+    "An association list of MIME types and desktop entries which indicate
+that the application should be the default for opening the specified
+MIME type.")
+  (removed
+   (alist '())
+   "An association list of MIME types and desktop entries which indicate
+that the application cannot open the specified MIME type.")
+  (desktop-entries
+   (desktop-entries '())
+   "A list of XDG desktop entries to create.  See
+@code{xdg-desktop-entry}."))
+
+(define (home-xdg-mime-applications-files-service config)
+  (define (add-xdg-desktop-entry-file entry)
+    (let ((file (first entry))
+          (config (second entry)))
+      (list (format #f "local/share/applications/~a" file)
+          (apply mixed-text-file
+                 (format #f "xdg-desktop-~a-entry" file)
+                 config))))
+
+  (append
+   `(("config/mimeapps.list"
+      ,(mixed-text-file
+        "xdg-mime-appplications"
+        (serialize-configuration
+         config
+         home-xdg-mime-applications-configuration-fields))))
+   (map (compose add-xdg-desktop-entry-file serialize-xdg-desktop-entry)
+        (home-xdg-mime-applications-configuration-desktop-entries config))))
+
+(define (home-xdg-mime-applications-extension old-config extension-configs)
+  (define (extract-fields config)
+    ;; return '(added default removed desktop-entries)
+    (list (home-xdg-mime-applications-configuration-added config)
+          (home-xdg-mime-applications-configuration-default config)
+          (home-xdg-mime-applications-configuration-removed config)
+          (home-xdg-mime-applications-configuration-desktop-entries config)))
+
+  (define (append-configs elem acc)
+    (list (append (first elem) (first acc))
+          (append (second elem) (second acc))
+          (append (third elem) (third acc))
+          (append (fourth elem) (fourth acc))))
+
+  ;; TODO: Implement procedure to check for duplicates without
+  ;; sacrificing performance.
+  ;;
+  ;; Combine all the alists from 'added', 'default' and 'removed'
+  ;; into one big alist.
+  (let ((folded-configs (fold append-configs
+                              (extract-fields old-config)
+                              (map extract-fields extension-configs))))
+    (home-xdg-mime-applications-configuration
+     (added (first folded-configs))
+     (default (second folded-configs))
+     (removed (third folded-configs))
+     (desktop-entries (fourth folded-configs)))))
+
+(define home-xdg-mime-applications-service-type
+  (service-type (name 'home-xdg-mime-applications)
+                (extensions
+                 (list (service-extension
+                        home-files-service-type
+                        home-xdg-mime-applications-files-service)))
+                (compose identity)
+                (extend home-xdg-mime-applications-extension)
+                (default-value (home-xdg-mime-applications-configuration))
+                (description
+                 "Configure XDG MIME applications, and XDG desktop entries.")))

gnu/home.scm

@@ -0,0 +1,106 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
+;;;
+;;; 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/>.
+
+(define-module (gnu home)
+  #:use-module (gnu home-services)
+  #:use-module (gnu home-services symlink-manager)
+  #:use-module (gnu home-services shells)
+  #:use-module (gnu home-services xdg)
+  #:use-module (gnu home-services fontutils)
+  #:use-module (gnu services)
+  #:use-module (guix records)
+  #:use-module (guix diagnostics)
+
+  #:export (home-environment
+            home-environment?
+            this-home-environment
+
+            home-environment-derivation
+            home-environment-user-services
+            home-environment-essential-services
+            home-environment-services
+            home-environment-location
+
+            home-environment-with-provenance))
+
+;;; Comment:
+;;;
+;;; This module provides a <home-environment> record for managing
+;;; per-user packages and configuration files in the similar way as
+;;; <operating-system> do for system packages and configuration files.
+;;;
+;;; Code:
+
+(define-record-type* <home-environment> home-environment
+  make-home-environment
+  home-environment?
+  this-home-environment
+
+  (packages           home-environment-packages            ; list of (PACKAGE OUTPUT...)
+                      (default '()))
+
+  (essential-services home-environment-essential-services  ; list of services
+                      (thunked)
+                      (default (home-environment-default-essential-services
+                                this-home-environment)))
+
+  (services           home-environment-user-services
+                      (default '()))
+
+  (location           home-environment-location            ; <location>
+                      (default (and=> (current-source-location)
+                                      source-properties->location))
+                      (innate)))
+
+(define (home-environment-default-essential-services he)
+  "Return the list of essential services for home environment."
+  (list
+   (service home-run-on-first-login-service-type)
+   (service home-activation-service-type)
+   (service home-environment-variables-service-type)
+
+   (service home-symlink-manager-service-type)
+
+   (service home-fontconfig-service-type)
+   (service home-xdg-base-directories-service-type)
+   (service home-shell-profile-service-type)
+
+   (service home-service-type)
+   (service home-profile-service-type (home-environment-packages he))))
+
+(define* (home-environment-services he)
+  "Return all the services of home environment."
+  (instantiate-missing-services
+   (append (home-environment-user-services he)
+           (home-environment-essential-services he))))
+
+(define* (home-environment-derivation he)
+  "Return a derivation that builds OS."
+  (let* ((services         (home-environment-services he))
+         (home (fold-services services
+                              #:target-type home-service-type)))
+    (service-value home)))
+
+(define* (home-environment-with-provenance he config-file)
+  "Return a variant of HE that stores its own provenance information,
+including CONFIG-FILE, if available.  This is achieved by adding an instance
+of HOME-PROVENANCE-SERVICE-TYPE to its services."
+  (home-environment
+    (inherit he)
+    (services (cons (service home-provenance-service-type config-file)
+                    (home-environment-user-services he)))))

gnu/installer.scm

@@ -330,6 +330,7 @@ selected keymap."
                        btrfs-progs
                        jfsutils ;jfs_mkfs
                        ntfs-3g ;mkfs.ntfs
+                       xfsprogs ;mkfs.xfs
                        kbd ;chvt
                        guix ;guix system init call
                        util-linux ;mkwap

gnu/installer/newt/partition.scm

@@ -95,14 +95,17 @@ DEVICES list."
 
 (define (run-label-page button-text button-callback)
   "Run a page asking the user to select a partition table label."
-  (run-listbox-selection-page
+  ;; Force the GPT label if UEFI is supported.
-   #:info-text (G_ "Select a new partition table type. \
+  (if (efi-installation?)
+      "gpt"
+      (run-listbox-selection-page
+       #:info-text (G_ "Select a new partition table type. \
 Be careful, all data on the disk will be lost.")
-   #:title (G_ "Partition table")
+       #:title (G_ "Partition table")
-   #:listbox-items '("msdos" "gpt")
+       #:listbox-items '("msdos" "gpt")
-   #:listbox-item->text identity
+       #:listbox-item->text identity
-   #:button-text button-text
+       #:button-text button-text
-   #:button-callback-procedure button-callback))
+       #:button-callback-procedure button-callback)))
 
 (define (run-type-page partition)
   "Run a page asking the user to select a partition type."
@@ -128,7 +131,7 @@ Be careful, all data on the disk will be lost.")
   (run-listbox-selection-page
    #:info-text (G_ "Please select the file-system type for this partition.")
    #:title (G_ "File-system type")
-   #:listbox-items '(ext4 btrfs fat16 fat32 jfs ntfs swap)
+   #:listbox-items '(ext4 btrfs fat16 fat32 jfs ntfs xfs swap)
    #:listbox-item->text user-fs-type-name
    #:sort-listbox-items? #f
    #:button-text (G_ "Exit")
@@ -640,8 +643,10 @@ edit it."
              default-result))))
        ((partition? item)
         (if (freespace-partition? item)
-            (run-error-page (G_ "You cannot delete a free space area.")
+            (begin
-                            (G_ "Delete partition"))
+              (run-error-page (G_ "You cannot delete a free space area.")
+                              (G_ "Delete partition"))
+              default-result)
             (let* ((disk (partition-disk item))
                    (number-str (partition-print-number item))
                    (info-text
@@ -706,6 +711,13 @@ by pressing the Exit button.~%~%")))
                        (run-error-page
                         (G_ "No root mount point found.")
                         (G_ "Missing mount point"))
+                       #f)
+                      ((cannot-read-uuid? c)
+                       (run-error-page
+                        (format #f (G_ "Cannot read the ~a partition UUID.\
+ You may need to format it.")
+                                (cannot-read-uuid-partition c))
+                        (G_ "Wrong partition format"))
                        #f))
                  (check-user-partitions user-partitions))))
           (if user-partitions-ok?
@@ -786,6 +798,7 @@ by pressing the Exit button.~%~%")))
     (format-user-partitions user-partitions-with-pass)
     (syslog "formatted ~a user partitions~%"
             (length user-partitions-with-pass))
+    (syslog "user-partitions: ~a~%" user-partitions)
 
     (destroy-form-and-pop form)
     user-partitions))

gnu/installer/newt/services.scm

@@ -68,6 +68,28 @@ system.")
         (condition
          (&installer-step-abort)))))))
 
+(define (run-other-services-cbt-page)
+  "Run a page allowing the user to select other services."
+  (let ((items (filter (lambda (service)
+                         (not (member (system-service-type service)
+                                      '(desktop
+                                        network-management
+                                        networking))))
+                       %system-services)))
+    (run-checkbox-tree-page
+     #:info-text (G_ "You can now select other services to run on your \
+system.")
+     #:title (G_ "Other services")
+     #:items items
+     #:selection (map system-service-recommended? items)
+     #:item->text (compose G_ system-service-name)
+     #:checkbox-tree-height 9
+     #:exit-button-callback-procedure
+     (lambda ()
+       (raise
+        (condition
+         (&installer-step-abort)))))))
+
 (define (run-network-management-page)
   "Run a page to select among several network management methods."
   (let ((title (G_ "Network management")))
@@ -100,4 +122,5 @@ client may be enough for a server.")
             (run-networking-cbt-page)
             (if (null? desktop)
                 (list (run-network-management-page))
-                '()))))
+                '())
+            (run-other-services-cbt-page))))

gnu/installer/parted.scm

@@ -24,8 +24,13 @@
   #:use-module (gnu installer newt page)
   #:use-module (gnu system uuid)
   #:use-module ((gnu build file-systems)
-                #:select (read-partition-uuid
+                #:select (canonicalize-device-spec
+                          find-partition-by-label
+                          read-partition-uuid
                           read-luks-partition-uuid))
+  #:use-module ((gnu build linux-boot)
+                #:select (linux-command-line
+                          find-long-option))
   #:use-module ((gnu build linux-modules)
                 #:select (missing-modules))
   #:use-module ((gnu system linux-initrd)
@@ -70,6 +75,7 @@
             small-freespace-partition?
             esp-partition?
             boot-partition?
+            efi-installation?
             default-esp-mount-point
 
             with-delay-device-in-use?
@@ -106,6 +112,9 @@
 
             &no-root-mount-point
             no-root-mount-point?
+            &cannot-read-uuid
+            cannot-read-uuid?
+            cannot-read-uuid-partition
 
             check-user-partitions
             set-user-partitions-file-name
@@ -193,12 +202,8 @@ inferior to MAX-SIZE, #f otherwise."
 (define (esp-partition? partition)
   "Return #t if partition has the ESP flag, return #f otherwise."
   (let* ((disk (partition-disk partition))
-         (disk-type (disk-disk-type disk))
+         (disk-type (disk-disk-type disk)))
-         (has-extended? (disk-type-check-feature
-                         disk-type
-                         DISK-TYPE-FEATURE-EXTENDED)))
     (and (data-partition? partition)
-         (not has-extended?)
          (partition-is-flag-available? partition PARTITION-FLAG-ESP)
          (partition-get-flag partition PARTITION-FLAG-ESP))))
 
@@ -226,6 +231,7 @@ inferior to MAX-SIZE, #f otherwise."
     ((fat32) "fat32")
     ((jfs)   "jfs")
     ((ntfs)  "ntfs")
+    ((xfs)   "xfs")
     ((swap)  "linux-swap")))
 
 (define (user-fs-type->mount-type fs-type)
@@ -233,10 +239,11 @@ inferior to MAX-SIZE, #f otherwise."
   (case fs-type
     ((ext4)  "ext4")
     ((btrfs) "btrfs")
-    ((fat16) "fat")
+    ((fat16) "vfat")
     ((fat32) "vfat")
     ((jfs)   "jfs")
-    ((ntfs)  "ntfs")))
+    ((ntfs)  "ntfs")
+    ((xfs)   "xfs")))
 
 (define (partition-filesystem-user-type partition)
   "Return the filesystem type of PARTITION, to be stored in the FS-TYPE field
@@ -251,6 +258,7 @@ of <user-partition> record."
             ((string=? name "fat32") 'fat32)
             ((string=? name "jfs") 'jfs)
             ((string=? name "ntfs") 'ntfs)
+            ((string=? name "xfs") 'xfs)
             ((or (string=? name "swsusp")
                  (string=? name "linux-swap(v0)")
                  (string=? name "linux-swap(v1)"))
@@ -337,16 +345,35 @@ fail. See rereadpt function in wipefs.c of util-linux for an explanation."
   (with-null-output-ports
    (invoke "dmsetup" "remove_all")))
 
+(define (installation-device)
+  "Return the installation device path."
+  (let* ((cmdline (linux-command-line))
+         (root (find-long-option "--root" cmdline)))
+    (and root
+         (canonicalize-device-spec (uuid root)))))
+
 (define (non-install-devices)
-  "Return all the available devices, except the busy one, allegedly the
+  "Return all the available devices, except the install device."
-install device. DEVICE-IS-BUSY? is a parted call, checking if the device is
+  (define (read-only? device)
-mounted."
+    (dynamic-wind
-  ;; FIXME: The install image uses an overlayfs so the install device does not
+    (lambda ()
-  ;; appear as mounted and won't be considered as busy.
+      (device-open device))
-  (remove (lambda (device)
+    (lambda ()
-            (let ((file-name (device-path device)))
+      (device-read-only? device))
-              (device-is-busy? device)))
+    (lambda ()
-          (devices)))
+      (device-close device))))
+
+  ;; If parted reports that a device is read-only it is probably the
+  ;; installation device. However, as this detection does not always work,
+  ;; compare the device path to the installation device path read from the
+  ;; command line.
+  (let ((install-device (installation-device)))
+    (remove (lambda (device)
+              (let ((file-name (device-path device)))
+                (or (read-only? device)
+                    (and install-device
+                         (string=? file-name install-device)))))
+            (devices))))
 
 
 ;;
@@ -871,7 +898,7 @@ partition."
                 (format #f "Unable to create partition ~a~%" name)))))))))
 
 (define (force-user-partitions-formatting user-partitions)
-  "Set the NEED-FORMATING? fields to #t on all <user-partition> records of
+  "Set the NEED-FORMATTING? fields to #t on all <user-partition> records of
 USER-PARTITIONS list and return the updated list."
   (map (lambda (p)
          (user-partition
@@ -918,30 +945,26 @@ exists."
          ;; disk space. Otherwise, set the swap size to 5% of the disk space.
          (swap-size (min default-swap-size five-percent-disk)))
 
-    (if has-extended?
+    ;; Remove everything but esp if it exists.
-        ;; msdos - remove everything.
+    (for-each
-        (disk-remove-all-partitions disk)
+     (lambda (partition)
-        ;; gpt - remove everything but esp if it exists.
+       (and (data-partition? partition)
-        (for-each
+            (disk-remove-partition* disk partition)))
-         (lambda (partition)
+     non-boot-partitions)
-           (and (data-partition? partition)
-                (disk-remove-partition* disk partition)))
-         non-boot-partitions))
 
     (let* ((start-partition
-            (and (not has-extended?)
+            (if (efi-installation?)
-                 (if (efi-installation?)
+                (and (not esp-partition)
-                     (and (not esp-partition)
-                          (user-partition
-                           (fs-type 'fat32)
-                           (esp? #t)
-                           (size new-esp-size)
-                           (mount-point (default-esp-mount-point))))
                      (user-partition
-                      (fs-type 'ext4)
+                      (fs-type 'fat32)
-                      (bootable? #t)
+                      (esp? #t)
-                      (bios-grub? #t)
+                      (size new-esp-size)
-                      (size bios-grub-size)))))
+                      (mount-point (default-esp-mount-point))))
+                (user-partition
+                 (fs-type 'ext4)
+                 (bootable? #t)
+                 (bios-grub? #t)
+                 (size bios-grub-size))))
            (new-partitions
             (cond
              ((or (eq? scheme 'entire-root)
@@ -1013,15 +1036,48 @@ exists."
 (define-condition-type &no-root-mount-point &condition
   no-root-mount-point?)
 
+;; Cannot not read the partition UUID.
+(define-condition-type &cannot-read-uuid &condition
+  cannot-read-uuid?
+  (partition cannot-read-uuid-partition))
+
 (define (check-user-partitions user-partitions)
-  "Return #t if the USER-PARTITIONS lists contains one <user-partition> record
+  "Check the following statements:
-with a mount-point set to '/', raise &no-root-mount-point condition
+
-otherwise."
+The USER-PARTITIONS list contains one <user-partition> record with a
-  (let ((mount-points
+mount-point set to '/'.  Raise &no-root-mount-point condition otherwise.
-         (map user-partition-mount-point user-partitions)))
+
-    (or (member "/" mount-points)
+All the USER-PARTITIONS with a mount point and that will not be formatted have
-        (raise
+a valid UUID.  Raise a &cannot-read-uuid condition specifying the faulty
-         (condition (&no-root-mount-point))))))
+partition otherwise.
+
+Return #t if all the statements are valid."
+  (define (check-root)
+    (let ((mount-points
+           (map user-partition-mount-point user-partitions)))
+      (or (member "/" mount-points)
+          (raise
+           (condition (&no-root-mount-point))))))
+
+  (define (check-uuid)
+    (let ((mount-partitions
+           (filter user-partition-mount-point user-partitions)))
+      (every
+       (lambda (user-partition)
+         (let ((file-name (user-partition-file-name user-partition))
+               (need-formatting?
+                (user-partition-need-formatting? user-partition)))
+           (or need-formatting?
+               (read-partition-uuid file-name)
+               (raise
+                (condition
+                 (&cannot-read-uuid
+                  (partition file-name)))))))
+       mount-partitions)))
+
+  (and (check-root)
+       (check-uuid)
+       #t))
 
 (define (set-user-partitions-file-name user-partitions)
   "Set the partition file-name of <user-partition> records in USER-PARTITIONS
@@ -1072,6 +1128,11 @@ bit bucket."
   (with-null-output-ports
    (invoke "mkfs.ntfs" "-F" "-f" partition)))
 
+(define (create-xfs-file-system partition)
+  "Create an XFS file-system for PARTITION file-name."
+  (with-null-output-ports
+   (invoke "mkfs.xfs" "-f" partition)))
+
 (define (create-swap-partition partition)
   "Set up swap area on PARTITION file-name."
   (with-null-output-ports
@@ -1116,7 +1177,7 @@ USER-PARTITION if it is encrypted, or the plain file-name otherwise."
 
 (define (format-user-partitions user-partitions)
   "Format the <user-partition> records in USER-PARTITIONS list with
-NEED-FORMATING? field set to #t."
+NEED-FORMATTING? field set to #t."
   (for-each
    (lambda (user-partition)
      (let* ((need-formatting?
@@ -1153,6 +1214,10 @@ NEED-FORMATING? field set to #t."
           (and need-formatting?
                (not (eq? type 'extended))
                (create-ntfs-file-system file-name)))
+         ((xfs)
+          (and need-formatting?
+               (not (eq? type 'extended))
+               (create-xfs-file-system file-name)))
          ((swap)
           (create-swap-partition file-name))
          (else
@@ -1303,9 +1368,9 @@ from (gnu system mapped-devices) and return it."
     `((bootloader-configuration
        ,@(if (efi-installation?)
              `((bootloader grub-efi-bootloader)
-               (target ,(default-esp-mount-point)))
+               (targets (list ,(default-esp-mount-point))))
              `((bootloader grub-bootloader)
-               (target ,root-partition-disk)))
+               (targets (list ,root-partition-disk))))
 
        ;; XXX: Assume we defined the 'keyboard-layout' field of
        ;; <operating-system> right above.

gnu/installer/services.scm

@@ -2,6 +2,7 @@
 ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2021 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -29,7 +30,6 @@
             system-service-packages
 
             desktop-system-service?
-            networking-system-service?
 
             %system-services
             system-services->configuration))
@@ -38,7 +38,7 @@
   system-service make-system-service
   system-service?
   (name            system-service-name)           ;string
-  (type            system-service-type)           ;'desktop | 'networking
+  (type            system-service-type)           ;'desktop|'networking|…
   (recommended?    system-service-recommended?    ;Boolean
                    (default #f))
   (snippet         system-service-snippet         ;list of sexps
@@ -46,7 +46,6 @@
   (packages        system-service-packages        ;list of sexps
                    (default '())))
 
-;; This is the list of desktop environments supported as services.
 (define %system-services
   (let-syntax ((desktop-environment (syntax-rules ()
                                       ((_ fields ...)
@@ -56,6 +55,7 @@
                (G_ (syntax-rules ()               ;for xgettext
                      ((_ str) str))))
     (list
+     ;; This is the list of desktop environments supported as services.
      (desktop-environment
       (name "GNOME")
       (snippet '((service gnome-desktop-service-type))))
@@ -118,16 +118,18 @@
      (system-service
       (name (G_ "DHCP client (dynamic IP address assignment)"))
       (type 'network-management)
-      (snippet '((service dhcp-client-service-type)))))))
+      (snippet '((service dhcp-client-service-type))))
+
+     ;; Dealing with documents.
+     (system-service
+      (name (G_ "CUPS printing system (no Web interface by default)"))
+      (type 'document)
+      (snippet '((service cups-service-type)))))))
 
 (define (desktop-system-service? service)
   "Return true if SERVICE is a desktop environment service."
   (eq? 'desktop (system-service-type service)))
 
-(define (networking-system-service? service)
-  "Return true if SERVICE is a desktop environment service."
-  (eq? 'networking (system-service-type service)))
-
 (define (system-services->configuration services)
   "Return the configuration field for SERVICES."
   (let* ((snippets (append-map system-service-snippet services))

gnu/installer/steps.scm

@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018, 2019 Mathieu Othacehe <m.othacehe@gmail.com>
-;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -20,6 +20,7 @@
 (define-module (gnu installer steps)
   #:use-module (guix records)
   #:use-module (guix build utils)
+  #:use-module (guix i18n)
   #:use-module (gnu installer utils)
   #:use-module (ice-9 match)
   #:use-module (ice-9 pretty-print)
@@ -234,7 +235,7 @@ found in RESULTS."
                   '())))
           steps))
         (modules '((use-modules (gnu))
-                   (use-service-modules desktop networking ssh xorg))))
+                   (use-service-modules cups desktop networking ssh xorg))))
     `(,@modules
       ()
       (operating-system ,@configuration))))
@@ -245,8 +246,13 @@ found in RESULTS."
   (mkdir-p (dirname filename))
   (call-with-output-file filename
     (lambda (port)
-      (format port ";; This is an operating system configuration generated~%")
+      ;; TRANSLATORS: This is a comment within a Scheme file.  Each line must
-      (format port ";; by the graphical installer.~%")
+      ;; start with ";; " (two semicolons and a space).  Please keep line
+      ;; length below 60 characters.
+      (display (G_ "\
+;; This is an operating system configuration generated
+;; by the graphical installer.\n")
+               port)
       (newline port)
       (for-each (lambda (part)
                   (if (null? part)

gnu/installer/tests.scm

@@ -37,7 +37,8 @@
             enter-host-name+passwords
             choose-services
             choose-partitioning
-            conclude-installation
+            start-installation
+            complete-installation
 
             edit-configuration-file))
 
@@ -219,8 +220,9 @@ ROOT-PASSWORD, and USERS."
                                  (string-contains service "NSS"))))
                           (choose-network-management-tool?
                            (lambda (service)
-                             (string-contains service "DHCP"))))
+                             (string-contains service "DHCP")))
-  "Converse over PORT to choose networking services."
+                          (choose-other-service? (const #f)))
+  "Converse over PORT to choose services."
   (define desktop-environments '())
 
   (converse port
@@ -239,7 +241,11 @@ ROOT-PASSWORD, and USERS."
                      (multiple-choices? #f)
                      (items ,services))
      (null? desktop-environments)
-     (find choose-network-management-tool? services))))
+     (find choose-network-management-tool? services))
+
+    ((checkbox-list (title "Other services") (text _)
+                    (items ,services))
+     (filter choose-other-service? services))))
 
 (define (edit-configuration-file file)
   "Edit FILE, an operating system configuration file generated by the
@@ -281,14 +287,19 @@ instrumented for further testing."
 (define* (choose-partitioning port
                               #:key
                               (encrypted? #t)
+                              (uefi-support? #f)
                               (passphrase "thepassphrase")
                               (edit-configuration-file
                                edit-configuration-file))
   "Converse over PORT to choose the partitioning method.  When ENCRYPTED? is
 true, choose full-disk encryption with PASSPHRASE as the LUKS passphrase.
+
+When UEFI-SUPPORT? is true, assume that we are running the installation tests
+on an UEFI capable machine.
+
 This conversation stops when the user partitions have been formatted, right
 before the installer generates the configuration file and shows it in a dialog
-box."
+box. "
   (converse port
     ((list-selection (title "Partitioning method")
                      (multiple-choices? #f)
@@ -306,11 +317,15 @@ box."
            disks))
 
     ;; The "Partition table" dialog pops up only if there's not already a
-    ;; partition table.
+    ;; partition table and if the system does not support UEFI.
     ((list-selection (title "Partition table")
                      (multiple-choices? #f)
                      (items _))
+     ;; When UEFI is supported, the partition is forced to GPT by the
+     ;; installer.
+     (not uefi-support?)
      "gpt")
+
     ((list-selection (title "Partition scheme")
                      (multiple-choices? #f)
                      (items (,one-partition _ ...)))
@@ -338,10 +353,10 @@ box."
      ;; UUIDs before it generates the configuration file.
      (values))))
 
-(define (conclude-installation port)
+(define (start-installation port)
-  "Conclude the installation by checking over PORT that we get the generated
+  "Start the installation by checking over PORT that we get the generated
 configuration file, accepting it and starting the installation, and then
-receiving the final messages once the 'guix system init' process has
+receiving the pause message once the 'guix system init' process has
 completed."
   ;; Assume the previous message received was 'starting-final-step'; here we
   ;; send the reply to that message, which lets the installer continue.
@@ -355,8 +370,19 @@ completed."
                   (file ,configuration-file))
      (edit-configuration-file configuration-file))
     ((pause)                                      ;"Press Enter to continue."
-     #t)
+     (values))))
-    ((installation-complete)                      ;congratulations!
+
+(define (complete-installation port)
+  "Complete the installation by replying to the installer pause message and
+waiting for the installation-complete message."
+  ;; Assume the previous message received was 'pause'; here we send the reply
+  ;; to that message, which lets the installer continue.
+  (write #t port)
+  (newline port)
+  (force-output port)
+
+  (converse port
+    ((installation-complete)
      (values))))
 
 ;;; Local Variables:

gnu/local.mk

@@ -1,5 +1,5 @@
 # GNU Guix --- Functional package management for GNU
-# Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021, 2021 Ludovic Courtès <ludo@gnu.org>
 # Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Andreas Enge <andreas@enge.fr>
 # Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
 # Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Mark H Weaver <mhw@netris.org>
@@ -19,7 +19,7 @@
 # Copyright © 2018 Amirouche Boubekki <amirouche@hypermove.net>
 # Copyright © 2018, 2019, 2020, 2021 Oleg Pykhalov <go.wigust@gmail.com>
 # Copyright © 2018 Stefan Stefanović <stefanx2ovic@gmail.com>
-# Copyright © 2018, 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+# Copyright © 2018, 2020, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 # Copyright © 2019, 2020 Guillaume Le Vaillant <glv@posteo.net>
 # Copyright © 2019, 2020 John Soo <jsoo1@asu.edu>
 # Copyright © 2019 Jonathan Brielmaier <jonathan.brielmaier@web.de>
@@ -41,6 +41,10 @@
 # Copyright © 2020 Vinicius Monego <monego@posteo.net>
 # Copyright © 2021 Björn Höfling <bjoern.hoefling@bjoernhoefling.de>
 # Copyright © 2021 Philip McGrath <philip@philipmcgrath.com>
+# Copyright © 2021 Arun Isaac <arunisaac@systemreboot.net>
+# Copyright © 2021 Sharlatan Hellseher <sharlatanus@gmail.com>
+# Copyright © 2021 Dmitry Polyakov <polyakov@liltechdude.xyz>
+# Copyright © 2021 Andrew Tropin <andrew@trop.in>
 #
 # This file is part of GNU Guix.
 #
@@ -69,6 +73,16 @@ GNU_SYSTEM_MODULES =				\
   %D%/bootloader/u-boot.scm                     \
   %D%/bootloader/depthcharge.scm                \
   %D%/ci.scm					\
+  %D%/home.scm					\
+  %D%/home-services.scm			\
+  %D%/home-services/symlink-manager.scm	\
+  %D%/home-services/fontutils.scm		\
+  %D%/home-services/configuration.scm		\
+  %D%/home-services/shells.scm			\
+  %D%/home-services/shepherd.scm		\
+  %D%/home-services/mcron.scm			\
+  %D%/home-services/utils.scm			\
+  %D%/home-services/xdg.scm			\
   %D%/image.scm					\
   %D%/packages.scm				\
   %D%/packages/abduco.scm			\
@@ -184,7 +198,6 @@ GNU_SYSTEM_MODULES =				\
   %D%/packages/docbook.scm			\
   %D%/packages/docker.scm			\
   %D%/packages/documentation.scm		\
-  %D%/packages/drones.scm			\
   %D%/packages/dunst.scm			\
   %D%/packages/dvtm.scm				\
   %D%/packages/easyrpg.scm			\
@@ -296,6 +309,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/packages/installers.scm			\
   %D%/packages/ipfs.scm			\
   %D%/packages/irc.scm  			\
+  %D%/packages/irods.scm  			\
   %D%/packages/iso-codes.scm			\
   %D%/packages/jami.scm				\
   %D%/packages/java.scm				\
@@ -307,6 +321,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/packages/jrnl.scm				\
   %D%/packages/jose.scm				\
   %D%/packages/julia.scm			\
+  %D%/packages/julia-jll.scm			\
   %D%/packages/julia-xyz.scm			\
   %D%/packages/jupyter.scm			\
   %D%/packages/kawa.scm				\
@@ -348,6 +363,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/packages/linux.scm			\
   %D%/packages/lirc.scm				\
   %D%/packages/lisp.scm				\
+  %D%/packages/lisp-check.scm			\
   %D%/packages/lisp-xyz.scm			\
   %D%/packages/llvm.scm				\
   %D%/packages/lout.scm				\
@@ -378,6 +394,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/packages/mercury.scm			\
   %D%/packages/mes.scm				\
   %D%/packages/messaging.scm			\
+  %D%/packages/minetest.scm			\
   %D%/packages/mingw.scm			\
   %D%/packages/microcom.scm			\
   %D%/packages/moe.scm				\
@@ -420,6 +437,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/packages/openldap.scm			\
   %D%/packages/openpgp.scm			\
   %D%/packages/openstack.scm			\
+  %D%/packages/orange.scm			\
   %D%/packages/orpheus.scm			\
   %D%/packages/ots.scm				\
   %D%/packages/package-management.scm		\
@@ -427,6 +445,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/packages/parallel.scm			\
   %D%/packages/pascal.scm			\
   %D%/packages/password-utils.scm		\
+  %D%/packages/patool.scm			\
   %D%/packages/patchutils.scm			\
   %D%/packages/pciutils.scm			\
   %D%/packages/pcre.scm				\
@@ -444,6 +463,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/packages/php.scm				\
   %D%/packages/piet.scm			\
   %D%/packages/pkg-config.scm			\
+  %D%/packages/plan9.scm			\
   %D%/packages/plotutils.scm			\
   %D%/packages/poedit.scm				\
   %D%/packages/polkit.scm			\
@@ -471,6 +491,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/packages/toys.scm				\
   %D%/packages/tryton.scm			\
   %D%/packages/qt.scm				\
+  %D%/packages/racket.scm			\
   %D%/packages/radio.scm			\
   %D%/packages/ragel.scm			\
   %D%/packages/rails.scm			\
@@ -484,7 +505,9 @@ GNU_SYSTEM_MODULES =				\
   %D%/packages/rednotebook.scm			\
   %D%/packages/regex.scm				\
   %D%/packages/robotics.scm			\
+  %D%/packages/rocm.scm				\
   %D%/packages/rpc.scm				\
+  %D%/packages/rpm.scm				\
   %D%/packages/rrdtool.scm			\
   %D%/packages/rsync.scm			\
   %D%/packages/ruby.scm				\
@@ -550,6 +573,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/packages/tmux.scm				\
   %D%/packages/tor.scm				\
   %D%/packages/tv.scm				\
+  %D%/packages/uglifyjs.scm			\
   %D%/packages/uml.scm				\
   %D%/packages/unicode.scm			\
   %D%/packages/unrtf.scm			\
@@ -597,6 +621,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/services/base.scm				\
   %D%/services/certbot.scm			\
   %D%/services/cgit.scm			\
+  %D%/services/ci.scm				\
   %D%/services/configuration.scm		\
   %D%/services/cuirass.scm			\
   %D%/services/cups.scm				\
@@ -656,6 +681,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/system/mapped-devices.scm			\
   %D%/system/nss.scm				\
   %D%/system/pam.scm				\
+  %D%/system/setuid.scm				\
   %D%/system/shadow.scm				\
   %D%/system/uuid.scm				\
   %D%/system/vm.scm				\
@@ -674,6 +700,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/build/chromium-extension.scm		\
   %D%/build/cross-toolchain.scm			\
   %D%/build/image.scm				\
+  %D%/build/jami-service.scm			\
   %D%/build/file-systems.scm			\
   %D%/build/hurd-boot.scm			\
   %D%/build/install.scm				\
@@ -688,6 +715,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/tests.scm					\
   %D%/tests/audio.scm				\
   %D%/tests/base.scm				\
+  %D%/tests/ci.scm				\
   %D%/tests/cups.scm				\
   %D%/tests/databases.scm			\
   %D%/tests/desktop.scm				\
@@ -710,6 +738,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/tests/security-token.scm			\
   %D%/tests/singularity.scm			\
   %D%/tests/ssh.scm				\
+  %D%/tests/telephony.scm		        \
   %D%/tests/version-control.scm			\
   %D%/tests/virtualization.scm			\
   %D%/tests/web.scm
@@ -775,7 +804,8 @@ dist_installer_DATA =				\
 MODULES_NOT_COMPILED +=				\
   %D%/build/locale.scm				\
   %D%/build/shepherd.scm			\
-  %D%/build/svg.scm
+  %D%/build/svg.scm				\
+  %D%/tests/data/jami-dummy-account.dat
 
 patchdir = $(guilemoduledir)/%D%/packages/patches
 dist_patch_DATA =						\
@@ -790,6 +820,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/abseil-cpp-fix-gtest.patch		\
   %D%/packages/patches/abseil-cpp-fix-strerror_test.patch	\
   %D%/packages/patches/adb-add-libraries.patch			\
+  %D%/packages/patches/adb-libssl_11-compatibility.patch	\
   %D%/packages/patches/aegis-constness-error.patch         	\
   %D%/packages/patches/aegis-perl-tempdir1.patch           	\
   %D%/packages/patches/aegis-perl-tempdir2.patch           	\
@@ -803,15 +834,16 @@ dist_patch_DATA =						\
   %D%/packages/patches/akonadi-not-relocatable.patch		\
   %D%/packages/patches/akonadi-timestamps.patch		\
   %D%/packages/patches/allegro-mesa-18.2.5-and-later.patch	\
-  %D%/packages/patches/amule-crypto-6.patch			\
   %D%/packages/patches/anki-mpv-args.patch			\
   %D%/packages/patches/antiword-CVE-2014-8123.patch			\
   %D%/packages/patches/antlr3-3_1-fix-java8-compilation.patch	\
   %D%/packages/patches/antlr3-3_3-fix-java8-compilation.patch	\
   %D%/packages/patches/apr-skip-getservbyname-test.patch	\
+  %D%/packages/patches/ark-skip-xar-test.patch			\
   %D%/packages/patches/aspell-default-dict-dir.patch		\
   %D%/packages/patches/ath9k-htc-firmware-binutils.patch	\
   %D%/packages/patches/ath9k-htc-firmware-gcc.patch		\
+  %D%/packages/patches/ath9k-htc-firmware-gcc-compat.patch	\
   %D%/packages/patches/ath9k-htc-firmware-objcopy.patch		\
   %D%/packages/patches/audacity-build-with-system-portaudio.patch \
   %D%/packages/patches/audacity-add-include.patch 		\
@@ -829,6 +861,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/audiofile-hurd.patch 			\
   %D%/packages/patches/audiofile-function-signature.patch	\
   %D%/packages/patches/automake-skip-amhello-tests.patch	\
+  %D%/packages/patches/autotrace-glib-compat.patch		\
   %D%/packages/patches/avahi-localstatedir.patch		\
   %D%/packages/patches/avidemux-install-to-lib.patch		\
   %D%/packages/patches/awesome-reproducible-png.patch		\
@@ -845,7 +878,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/bazaar-CVE-2017-14176.patch		\
   %D%/packages/patches/bc-fix-cross-compilation.patch		\
   %D%/packages/patches/bear-disable-preinstall-tests.patch	\
-  %D%/packages/patches/bsdiff-CVE-2014-9862.patch		\
+  %D%/packages/patches/brightnessctl-elogind-support.patch	\
   %D%/packages/patches/bsd-games-2.17-64bit.patch		\
   %D%/packages/patches/bsd-games-add-configure-config.patch	\
   %D%/packages/patches/bsd-games-add-wrapper.patch		\
@@ -858,7 +891,6 @@ dist_patch_DATA =						\
   %D%/packages/patches/bsd-games-prevent-name-collisions.patch	\
   %D%/packages/patches/bsd-games-stdio.h.patch			\
   %D%/packages/patches/beancount-disable-googleapis-fonts.patch	\
-  %D%/packages/patches/beets-werkzeug-compat.patch		\
   %D%/packages/patches/behave-skip-a-couple-of-tests.patch	\
   %D%/packages/patches/beignet-correct-file-names.patch		\
   %D%/packages/patches/biber-fix-encoding-write.patch		\
@@ -875,7 +907,6 @@ dist_patch_DATA =						\
   %D%/packages/patches/blender-2.79-python-3.7-fix.patch	\
   %D%/packages/patches/blender-2.79-python-3.8-fix.patch	\
   %D%/packages/patches/bpftrace-disable-bfd-disasm.patch	\
-  %D%/packages/patches/busybox-CVE-2021-28831.patch		\
   %D%/packages/patches/byobu-writable-status.patch		\
   %D%/packages/patches/cairo-CVE-2018-19876.patch		\
   %D%/packages/patches/cairo-CVE-2020-35492.patch		\
@@ -884,6 +915,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/calibre-remove-test-unrar.patch		\
   %D%/packages/patches/casync-renameat2-declaration.patch	\
   %D%/packages/patches/catdoc-CVE-2017-11110.patch		\
+  %D%/packages/patches/ccache-fix-basedir-test.patch		\
   %D%/packages/patches/circos-remove-findbin.patch		\
   %D%/packages/patches/cdparanoia-fpic.patch			\
   %D%/packages/patches/cdrtools-3.01-mkisofs-isoinfo.patch 	\
@@ -916,12 +948,15 @@ dist_patch_DATA =						\
   %D%/packages/patches/combinatorial-blas-io-fix.patch		\
   %D%/packages/patches/coreutils-ls.patch			\
   %D%/packages/patches/cpufrequtils-fix-aclocal.patch		\
+  %D%/packages/patches/cpuinfo-system-libraries.patch		\
   %D%/packages/patches/crawl-upgrade-saves.patch		\
   %D%/packages/patches/crda-optional-gcrypt.patch		\
   %D%/packages/patches/clucene-contribs-lib.patch               \
   %D%/packages/patches/cube-nocheck.patch			\
+  %D%/packages/patches/cups-CVE-2020-10001.patch		\
   %D%/packages/patches/curl-use-ssl-cert-env.patch		\
   %D%/packages/patches/curl-7.76-use-ssl-cert-env.patch	\
+  %D%/packages/patches/curl-7.77-tls-priority-string.patch	\
   %D%/packages/patches/cursynth-wave-rand.patch			\
   %D%/packages/patches/cvs-CVE-2017-12836.patch		\
   %D%/packages/patches/cyrus-sasl-ac-try-run-fix.patch		\
@@ -942,6 +977,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/desmume-gcc7-fixes.patch			\
   %D%/packages/patches/dfu-programmer-fix-libusb.patch		\
   %D%/packages/patches/diffutils-gets-undeclared.patch		\
+  %D%/packages/patches/disarchive-cross-compilation.patch	\
   %D%/packages/patches/dkimproxy-add-ipv6-support.patch		\
   %D%/packages/patches/docbook-xsl-nonrecursive-string-subst.patch	\
   %D%/packages/patches/doc++-include-directives.patch		\
@@ -958,6 +994,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/ecl-16-ignore-stderr-write-error.patch	\
   %D%/packages/patches/ecl-16-libffi.patch			\
   %D%/packages/patches/efibootmgr-remove-extra-decl.patch	\
+  %D%/packages/patches/efivar-gcc-compat.patch			\
   %D%/packages/patches/eigen-remove-openmp-error-counting.patch	\
   %D%/packages/patches/eigen-stabilise-sparseqr-test.patch	\
   %D%/packages/patches/einstein-build.patch			\
@@ -974,12 +1011,13 @@ dist_patch_DATA =						\
   %D%/packages/patches/emacs-hyperbole-toggle-messaging.patch	\
   %D%/packages/patches/emacs-libgit-use-system-libgit2.patch    \
   %D%/packages/patches/emacs-source-date-epoch.patch		\
-  %D%/packages/patches/emacs-telega-patch-server-functions.patch	\
+  %D%/packages/patches/emacs-telega-path-placeholder.patch	\
   %D%/packages/patches/emacs-telega-test-env.patch		\
   %D%/packages/patches/emacs-wordnut-require-adaptive-wrap.patch	\
   %D%/packages/patches/enjarify-setup-py.patch			\
   %D%/packages/patches/enlightenment-fix-setuid-path.patch	\
   %D%/packages/patches/erlang-man-path.patch			\
+  %D%/packages/patches/esmtp-add-lesmtp.patch		\
   %D%/packages/patches/eudev-rules-directory.patch		\
   %D%/packages/patches/evilwm-lost-focus-bug.patch		\
   %D%/packages/patches/evolution-CVE-2020-11879.patch		\
@@ -1010,12 +1048,13 @@ dist_patch_DATA =						\
   %D%/packages/patches/foomatic-filters-CVE-2015-8327.patch	\
   %D%/packages/patches/foomatic-filters-CVE-2015-8560.patch	\
   %D%/packages/patches/fontconfig-hurd-path-max.patch		\
+  %D%/packages/patches/fp16-system-libraries.patch		\
   %D%/packages/patches/fpc-reproducibility.patch		\
   %D%/packages/patches/fplll-std-fenv.patch     		\
   %D%/packages/patches/freedink-engine-fix-sdl-hints.patch	\
-  %D%/packages/patches/freebayes-devendor-deps.patch		\
   %D%/packages/patches/freeimage-unbundle.patch		\
   %D%/packages/patches/fuse-overlapping-headers.patch				\
+  %D%/packages/patches/fxdiv-system-libraries.patch		\
   %D%/packages/patches/gajim-honour-GAJIM_PLUGIN_PATH.patch	\
   %D%/packages/patches/ganeti-deterministic-manual.patch	\
   %D%/packages/patches/ganeti-disable-version-symlinks.patch	\
@@ -1060,6 +1099,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/gcc-7-cross-environment-variables.patch	\
   %D%/packages/patches/gcc-7-cross-toolexeclibdir.patch		\
   %D%/packages/patches/gcc-8-cross-environment-variables.patch	\
+  %D%/packages/patches/gcc-8-sort-libtool-find-output.patch	\
   %D%/packages/patches/gcc-8-strmov-store-file-names.patch	\
   %D%/packages/patches/gcc-9-asan-fix-limits-include.patch	\
   %D%/packages/patches/gcc-9-strmov-store-file-names.patch	\
@@ -1085,7 +1125,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/ghostscript-no-header-id.patch		\
   %D%/packages/patches/ghostscript-no-header-uuid.patch		\
   %D%/packages/patches/ghostscript-no-header-creationdate.patch \
-  %D%/packages/patches/gimp-make-gegl-introspect-optional.patch	\
+  %D%/packages/patches/giara-fix-login.patch                      \
   %D%/packages/patches/glib-appinfo-watch.patch			\
   %D%/packages/patches/glib-tests-timer.patch			\
   %D%/packages/patches/glib-CVE-2021-27218.patch		\
@@ -1156,21 +1196,29 @@ dist_patch_DATA =						\
   %D%/packages/patches/gobject-introspection-absolute-shlib-path.patch \
   %D%/packages/patches/gobject-introspection-cc.patch		\
   %D%/packages/patches/gobject-introspection-girepository.patch	\
+  %D%/packages/patches/go-fix-script-tests.patch			\
+  %D%/packages/patches/go-github-com-urfave-cli-fix-tests.patch \
+  %D%/packages/patches/go-github-com-urfave-cli-v2-fix-tests.patch \
   %D%/packages/patches/go-skip-gc-test.patch			\
   %D%/packages/patches/gpm-glibc-2.26.patch			\
   %D%/packages/patches/gpodder-disable-updater.patch		\
   %D%/packages/patches/gpsbabel-fix-i686-test.patch		\
   %D%/packages/patches/grantlee-merge-theme-dirs.patch		\
+  %D%/packages/patches/graphviz-CVE-2020-18032.patch		\
   %D%/packages/patches/grep-timing-sensitive-test.patch		\
   %D%/packages/patches/grocsvs-dont-use-admiral.patch		\
   %D%/packages/patches/gromacs-tinyxml2.patch			\
   %D%/packages/patches/groovy-add-exceptionutilsgenerator.patch	\
-  %D%/packages/patches/grub-cross-system-i686.patch		\
   %D%/packages/patches/grub-efi-fat-serial-number.patch		\
   %D%/packages/patches/grub-setup-root.patch			\
-  %D%/packages/patches/grub-verifiers-Blocklist-fallout-cleanup.patch \
   %D%/packages/patches/gspell-dash-test.patch			\
+  %D%/packages/patches/gst-libav-64channels-stack-corruption.patch	\
+  %D%/packages/patches/gst-plugins-bad-fix-overflow.patch	\
+  %D%/packages/patches/gst-plugins-base-fix-id3v2-invalid-read.patch	\
   %D%/packages/patches/gst-plugins-good-fix-test.patch		\
+  %D%/packages/patches/gst-plugins-good-CVE-2021-3497.patch	\
+  %D%/packages/patches/gst-plugins-good-CVE-2021-3498.patch	\
+  %D%/packages/patches/gst-plugins-ugly-fix-out-of-bound-reads.patch	\
   %D%/packages/patches/guile-1.8-cpp-4.5.patch			\
   %D%/packages/patches/guile-2.2-skip-oom-test.patch            \
   %D%/packages/patches/guile-2.2-skip-so-test.patch             \
@@ -1207,11 +1255,11 @@ dist_patch_DATA =						\
   %D%/packages/patches/hdf-eos5-remove-gctp.patch		\
   %D%/packages/patches/hdf-eos5-fix-szip.patch			\
   %D%/packages/patches/hdf-eos5-fortrantests.patch		\
+  %D%/packages/patches/hexchat-add-libera-chat.patch		\
   %D%/packages/patches/http-parser-CVE-2020-8287.patch		\
   %D%/packages/patches/hubbub-sort-entities.patch		\
   %D%/packages/patches/hurd-cross.patch				\
   %D%/packages/patches/hurd-xattr.patch				\
-  %D%/packages/patches/hplip-remove-imageprocessor.patch	\
   %D%/packages/patches/hydra-disable-darcs-test.patch		\
   %D%/packages/patches/icecat-makeicecat.patch			\
   %D%/packages/patches/icecat-avoid-bundled-libraries.patch	\
@@ -1231,11 +1279,14 @@ dist_patch_DATA =						\
   %D%/packages/patches/imagemagick-WriteTHUMBNAILImage-fix.patch	\
   %D%/packages/patches/inetutils-hurd.patch			\
   %D%/packages/patches/inkscape-poppler-0.76.patch		\
+  %D%/packages/patches/instead-use-games-path.patch		\
+  %D%/packages/patches/inkscape-1.1-fix-build-witch-gcc7.5.patch	\
   %D%/packages/patches/intel-xed-fix-nondeterminism.patch	\
   %D%/packages/patches/intltool-perl-compatibility.patch	\
   %D%/packages/patches/iputils-libcap-compat.patch		\
   %D%/packages/patches/ipxe-reproducible-geniso.patch	        \
   %D%/packages/patches/irrlicht-use-system-libs.patch		\
+  %D%/packages/patches/isc-dhcp-gcc-compat.patch		\
   %D%/packages/patches/isl-0.11.1-aarch64-support.patch	\
   %D%/packages/patches/json-c-0.13-CVE-2020-12762.patch	\
   %D%/packages/patches/json-c-0.12-CVE-2020-12762.patch	\
@@ -1259,15 +1310,17 @@ dist_patch_DATA =						\
   %D%/packages/patches/java-xerces-build_dont_unzip.patch	\
   %D%/packages/patches/java-xerces-xjavac_taskdef.patch	\
   %D%/packages/patches/jfsutils-add-sysmacros.patch		\
+  %D%/packages/patches/jfsutils-gcc-compat.patch		\
   %D%/packages/patches/jfsutils-include-systypes.patch		\
   %D%/packages/patches/jsoncpp-fix-inverted-case.patch		\
   %D%/packages/patches/julia-SOURCE_DATE_EPOCH-mtime.patch	\
+  %D%/packages/patches/julia-tracker-16-compat.patch		\
   %D%/packages/patches/kdbusaddons-kinit-file-name.patch	\
+  %D%/packages/patches/libblockdev-glib-compat.patch		\
   %D%/packages/patches/libffi-3.3-powerpc-fixes.patch		\
   %D%/packages/patches/libffi-float128-powerpc64le.patch	\
   %D%/packages/patches/libvirt-add-install-prefix.patch	\
   %D%/packages/patches/libziparchive-add-includes.patch		\
-  %D%/packages/patches/lksctp-tools-1.0.18-fix-header-file-name.patch \
   %D%/packages/patches/localed-xorg-keyboard.patch		\
   %D%/packages/patches/kdiagram-Fix-missing-link-libraries.patch \
   %D%/packages/patches/kiki-level-selection-crash.patch		\
@@ -1314,6 +1367,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/libbonobo-activation-test-race.patch	\
   %D%/packages/patches/libcaca-CVE-2021-3410-pt1.patch		\
   %D%/packages/patches/libcaca-CVE-2021-3410-pt2.patch		\
+  %D%/packages/patches/libcacard-unknown-variable.patch		\
   %D%/packages/patches/libcanberra-sound-theme-freedesktop.patch \
   %D%/packages/patches/libcanberra-wayland-crash.patch \
   %D%/packages/patches/libcroco-CVE-2020-12825.patch		\
@@ -1323,6 +1377,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/libgit2-mtime-0.patch			\
   %D%/packages/patches/libgnome-encoding.patch			\
   %D%/packages/patches/libgnomeui-utf8.patch			\
+  %D%/packages/patches/libgrss-CVE-2016-2001.patch		\
   %D%/packages/patches/libjxr-fix-function-signature.patch	\
   %D%/packages/patches/libjxr-fix-typos.patch			\
   %D%/packages/patches/libofa-ftbfs-1.diff		\
@@ -1357,6 +1412,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/libutils-remove-damaging-includes.patch	\
   %D%/packages/patches/libvdpau-va-gl-unbundle.patch		\
   %D%/packages/patches/libvpx-CVE-2016-2818.patch		\
+  %D%/packages/patches/libxml2-xpath0-Add-option-xpath0.patch	\
   %D%/packages/patches/libxslt-generated-ids.patch		\
   %D%/packages/patches/libxt-guix-search-paths.patch		\
   %D%/packages/patches/lierolibre-check-unaligned-access.patch	\
@@ -1365,9 +1421,9 @@ dist_patch_DATA =						\
   %D%/packages/patches/lierolibre-remove-arch-warning.patch	\
   %D%/packages/patches/lierolibre-try-building-other-arch.patch	\
   %D%/packages/patches/linbox-fix-pkgconfig.patch		\
-  %D%/packages/patches/linkchecker-tests-require-network.patch	\
   %D%/packages/patches/linphone-desktop-without-sdk.patch           \
   %D%/packages/patches/linux-libre-support-for-Pinebook-Pro.patch \
+  %D%/packages/patches/linux-libre-arm64-generic-pinebook-lcd.patch \
   %D%/packages/patches/linux-pam-no-setfsuid.patch		\
   %D%/packages/patches/lirc-localstatedir.patch			\
   %D%/packages/patches/lirc-reproducible-build.patch		\
@@ -1376,6 +1432,9 @@ dist_patch_DATA =						\
   %D%/packages/patches/llvm-9-fix-bitcast-miscompilation.patch	\
   %D%/packages/patches/llvm-9-fix-lpad-miscompilation.patch	\
   %D%/packages/patches/llvm-9-fix-scev-miscompilation.patch	\
+  %D%/packages/patches/llvm-roc-3.0.0-add_libraries.patch \
+  %D%/packages/patches/llvm-roc-4.0.0-remove-isystem-usr-include.patch \
+  %D%/packages/patches/llvm-roc-4.2.0-add_Object.patch \
   %D%/packages/patches/lm-sensors-hwmon-attrs.patch		\
   %D%/packages/patches/lrcalc-includes.patch    		\
   %D%/packages/patches/lsh-fix-x11-forwarding.patch		\
@@ -1388,8 +1447,9 @@ dist_patch_DATA =						\
   %D%/packages/patches/luajit-no_ldconfig.patch			\
   %D%/packages/patches/luit-posix.patch				\
   %D%/packages/patches/lvm2-static-link.patch			\
-  %D%/packages/patches/mailutils-fix-uninitialized-variable.patch	\
+  %D%/packages/patches/mailutils-variable-lookup.patch		\
   %D%/packages/patches/make-impure-dirs.patch			\
+  %D%/packages/patches/marble-qt-add-qt-headers.patch		\
   %D%/packages/patches/mariadb-CVE-2021-27928.patch		\
   %D%/packages/patches/mars-install.patch			\
   %D%/packages/patches/mars-sfml-2.3.patch			\
@@ -1402,15 +1462,16 @@ dist_patch_DATA =						\
   %D%/packages/patches/mcrypt-CVE-2012-4527.patch			\
   %D%/packages/patches/libmemcached-build-with-gcc7.patch	\
   %D%/packages/patches/libmhash-hmac-fix-uaf.patch		\
+  %D%/packages/patches/mercurial-hg-extension-path.patch       \
   %D%/packages/patches/mesa-skip-tests.patch			\
   %D%/packages/patches/mescc-tools-boot.patch			\
   %D%/packages/patches/meson-for-build-rpath.patch		\
   %D%/packages/patches/metabat-fix-compilation.patch		\
   %D%/packages/patches/mhash-keygen-test-segfault.patch		\
+  %D%/packages/patches/minetest-add-MINETEST_MOD_PATH.patch	\
   %D%/packages/patches/mingw-w64-6.0.0-gcc.patch		\
   %D%/packages/patches/mingw-w64-dlltool-temp-prefix.patch	\
   %D%/packages/patches/mingw-w64-reproducible-gendef.patch	\
-  %D%/packages/patches/minimap2-aarch64-support.patch		\
   %D%/packages/patches/minisat-friend-declaration.patch		\
   %D%/packages/patches/minisat-install.patch			\
   %D%/packages/patches/mit-krb5-hurd.patch			\
@@ -1420,6 +1481,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/module-init-tools-moduledir.patch	\
   %D%/packages/patches/monero-use-system-miniupnpc.patch			\
   %D%/packages/patches/mono-mdoc-timestamping.patch		\
+  %D%/packages/patches/mosaicatcher-unbundle-htslib.patch	\
   %D%/packages/patches/mozjs17-aarch64-support.patch		\
   %D%/packages/patches/mozjs24-aarch64-support.patch		\
   %D%/packages/patches/mozjs38-pkg-config-version.patch		\
@@ -1447,14 +1509,18 @@ dist_patch_DATA =						\
   %D%/packages/patches/netsurf-system-utf8proc.patch		\
   %D%/packages/patches/netsurf-y2038-tests.patch		\
   %D%/packages/patches/netsurf-longer-test-timeout.patch	\
+  %D%/packages/patches/nettle-3.5-check-_pkcs1_sec_decrypt-msg-len.patch \
+  %D%/packages/patches/nettle-3.5-CVE-2021-3580-pt1.patch	\
+  %D%/packages/patches/nettle-3.5-CVE-2021-3580-pt2.patch	\
   %D%/packages/patches/nfs4-acl-tools-0.3.7-fixpaths.patch	\
   %D%/packages/patches/ngircd-handle-zombies.patch		\
   %D%/packages/patches/network-manager-plugin-path.patch	\
   %D%/packages/patches/nginx-socket-cloexec.patch		\
+  %D%/packages/patches/nnpack-system-libraries.patch		\
   %D%/packages/patches/nsis-env-passthru.patch			\
+  %D%/packages/patches/nsis-source-date-epoch.patch		\
   %D%/packages/patches/nss-increase-test-timeout.patch		\
   %D%/packages/patches/nss-3.56-pkgconfig.patch			\
-  %D%/packages/patches/ntfs-3g-CVE-2019-9755.patch		\
   %D%/packages/patches/nvi-assume-preserve-path.patch		\
   %D%/packages/patches/nvi-dbpagesize-binpower.patch		\
   %D%/packages/patches/nvi-db4.patch				\
@@ -1469,7 +1535,13 @@ dist_patch_DATA =						\
   %D%/packages/patches/ocaml-dose3-Fix-for-ocaml-4.06.patch	\
   %D%/packages/patches/ocaml-dose3-dont-make-printconf.patch	\
   %D%/packages/patches/ocaml-dose3-Install-mli-cmx-etc.patch	\
+  %D%/packages/patches/ocaml-ppx-variants-ppxlib-api-change.patch	\
   %D%/packages/patches/omake-fix-non-determinism.patch	\
+  %D%/packages/patches/oneko-remove-nonfree-characters.patch	\
+  %D%/packages/patches/onnx-optimizer-system-library.patch	\
+  %D%/packages/patches/onnx-use-system-googletest.patch	\
+  %D%/packages/patches/onnx-shared-libraries.patch	\
+  %D%/packages/patches/onnx-skip-model-downloads.patch		\
   %D%/packages/patches/openbabel-fix-crash-on-nwchem-output.patch	\
   %D%/packages/patches/opencascade-oce-glibc-2.26.patch		\
   %D%/packages/patches/opencv-fix-build-of-grfmt_jpeg2000.cpp.patch	\
@@ -1498,7 +1570,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/pciutils-hurd-fix.patch			\
   %D%/packages/patches/plasma-framework-fix-KF5PlasmaMacros.cmake.patch \
   %D%/packages/patches/ppsspp-disable-upgrade-and-gold.patch		\
-  %D%/packages/patches/samba-fix-fcntl-hint-detection.patch		\
+  %D%/packages/patches/pthreadpool-system-libraries.patch	\
   %D%/packages/patches/sdcc-disable-non-free-code.patch		\
   %D%/packages/patches/sdl-pango-api_additions.patch		\
   %D%/packages/patches/sdl-pango-blit_overflow.patch		\
@@ -1509,12 +1581,12 @@ dist_patch_DATA =						\
   %D%/packages/patches/smalltalk-multiplication-overflow.patch	\
   %D%/packages/patches/sqlite-hurd.patch			\
   %D%/packages/patches/sunxi-tools-remove-sys-io.patch	\
-  %D%/packages/patches/patchutils-test-perms.patch		\
   %D%/packages/patches/patch-hurd-path-max.patch		\
   %D%/packages/patches/perl-autosplit-default-time.patch	\
   %D%/packages/patches/perl-cross.patch				\
   %D%/packages/patches/perl-deterministic-ordering.patch	\
   %D%/packages/patches/perl-finance-quote-unuse-mozilla-ca.patch \
+  %D%/packages/patches/perl-image-exiftool-CVE-2021-22204.patch	\
   %D%/packages/patches/perl-io-socket-ssl-openssl-1.0.2f-fix.patch \
   %D%/packages/patches/perl-net-amazon-s3-moose-warning.patch	\
   %D%/packages/patches/perl-net-dns-resolver-programmable-fix.patch	\
@@ -1527,10 +1599,6 @@ dist_patch_DATA =						\
   %D%/packages/patches/picard-fix-id3-rename-test.patch		\
   %D%/packages/patches/picprog-non-intel-support.patch		\
   %D%/packages/patches/pidgin-add-search-path.patch		\
-  %D%/packages/patches/pinball-const-fix.patch			\
-  %D%/packages/patches/pinball-cstddef.patch			\
-  %D%/packages/patches/pinball-missing-separators.patch		\
-  %D%/packages/patches/pinball-src-deps.patch			\
   %D%/packages/patches/pinball-system-ltdl.patch		\
   %D%/packages/patches/pingus-boost-headers.patch		\
   %D%/packages/patches/pingus-sdl-libs-config.patch		\
@@ -1542,13 +1610,13 @@ dist_patch_DATA =						\
   %D%/packages/patches/plib-CVE-2011-4620.patch		\
   %D%/packages/patches/plib-CVE-2012-4552.patch		\
   %D%/packages/patches/plotutils-spline-test.patch		\
+  %D%/packages/patches/polkit-CVE-2021-3560.patch		\
   %D%/packages/patches/portaudio-audacity-compat.patch		\
   %D%/packages/patches/portmidi-modular-build.patch		\
   %D%/packages/patches/postgresql-disable-resolve_symlinks.patch	\
   %D%/packages/patches/procmail-ambiguous-getline-debian.patch  \
   %D%/packages/patches/procmail-CVE-2014-3618.patch		\
   %D%/packages/patches/procmail-CVE-2017-16844.patch		\
-  %D%/packages/patches/proot-test-fhs.patch			\
   %D%/packages/patches/psm-arch.patch				\
   %D%/packages/patches/psm-disable-memory-stats.patch		\
   %D%/packages/patches/psm-ldflags.patch			\
@@ -1582,6 +1650,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/python-cross-compile.patch		\
   %D%/packages/patches/python2-larch-coverage-4.0a6-compatibility.patch \
   %D%/packages/patches/python-configobj-setuptools.patch	\
+  %D%/packages/patches/python-execnet-read-only-fix.patch	\
   %D%/packages/patches/python-flask-restful-werkzeug-compat.patch	\
   %D%/packages/patches/python-keras-integration-test.patch	\
   %D%/packages/patches/python-pep8-stdlib-tokenize-compat.patch \
@@ -1589,27 +1658,32 @@ dist_patch_DATA =						\
   %D%/packages/patches/python-flint-includes.patch		\
   %D%/packages/patches/python-libxml2-utf8.patch		\
   %D%/packages/patches/python-matplotlib-run-under-wayland-gtk3.patch	\
-  %D%/packages/patches/python-mediafile-wavpack.patch		\
   %D%/packages/patches/python-memcached-syntax-warnings.patch	\
   %D%/packages/patches/python-mox3-python3.6-compat.patch	\
   %D%/packages/patches/python-testtools.patch			\
-  %D%/packages/patches/python-onnx-use-system-googletest.patch	\
   %D%/packages/patches/python-packaging-test-arch.patch		\
   %D%/packages/patches/python2-parameterized-docstring-test.patch	\
   %D%/packages/patches/python-paste-remove-timing-test.patch	\
   %D%/packages/patches/python-pycrypto-CVE-2013-7459.patch	\
   %D%/packages/patches/python-pycrypto-time-clock.patch		\
+  %D%/packages/patches/python-pyan3-fix-absolute-path-bug.patch \
+  %D%/packages/patches/python-pyan3-fix-positional-arguments.patch \
   %D%/packages/patches/python-pydot-regression-test.patch	\
   %D%/packages/patches/python2-pygobject-2-deprecation.patch	\
   %D%/packages/patches/python-pygpgme-fix-pinentry-tests.patch	\
+  %D%/packages/patches/python-pytest-asyncio-python-3.8.patch	\
+  %D%/packages/patches/python-pytorch-runpath.patch		\
+  %D%/packages/patches/python-pytorch-system-libraries.patch	\
   %D%/packages/patches/python-robotframework-source-date-epoch.patch \
+  %D%/packages/patches/python-seaborn-kde-test.patch		\
   %D%/packages/patches/python2-subprocess32-disable-input-test.patch	\
   %D%/packages/patches/python-unittest2-python3-compat.patch	\
   %D%/packages/patches/python-unittest2-remove-argparse.patch	\
   %D%/packages/patches/python-waitress-fix-tests.patch		\
-  %D%/packages/patches/pypy3-7.3.1-fix-tests.patch		\
   %D%/packages/patches/qemu-build-info-manual.patch		\
   %D%/packages/patches/qemu-CVE-2021-20203.patch		\
+  %D%/packages/patches/qemu-meson-compat.patch			\
+  %D%/packages/patches/qemu-sphinx-compat.patch			\
   %D%/packages/patches/qemu-glibc-2.27.patch 			\
   %D%/packages/patches/qemu-glibc-2.30.patch 			\
   %D%/packages/patches/qpdfview-qt515-compat.patch		\
@@ -1640,13 +1714,19 @@ dist_patch_DATA =						\
   %D%/packages/patches/ripperx-missing-file.patch		\
   %D%/packages/patches/rpcbind-CVE-2017-8779.patch		\
   %D%/packages/patches/rtags-separate-rct.patch			\
-  %D%/packages/patches/racket-sh-via-rktio.patch		\
+  %D%/packages/patches/racket-minimal-backport-1629887.patch    \
-  %D%/packages/patches/racket-store-checksum-override.patch	\
+  %D%/packages/patches/racket-minimal-sh-via-rktio.patch	\
   %D%/packages/patches/remake-impure-dirs.patch			\
+  %D%/packages/patches/restic-0.9.6-fix-tests-for-go1.15.patch	\
   %D%/packages/patches/retroarch-LIBRETRO_DIRECTORY.patch	\
   %D%/packages/patches/rnp-add-version.cmake.patch		\
   %D%/packages/patches/rnp-disable-ruby-rnp-tests.patch		\
   %D%/packages/patches/rnp-unbundle-googletest.patch		\
+  %D%/packages/patches/rocm-comgr-3.1.0-dependencies.patch \
+  %D%/packages/patches/rocm-opencl-runtime-3.10.0-includes.patch \
+  %D%/packages/patches/rocm-opencl-runtime-4.3-noclinfo.patch \
+  %D%/packages/patches/rocm-opencl-runtime-4.3-nocltrace.patch \
+  %D%/packages/patches/rocm-opencl-runtime-4.3-noopencl.patch \
   %D%/packages/patches/ruby-sanitize-system-libxml.patch	\
   %D%/packages/patches/rust-1.19-mrustc.patch			\
   %D%/packages/patches/rust-1.25-accept-more-detailed-gdb-lines.patch \
@@ -1655,13 +1735,15 @@ dist_patch_DATA =						\
   %D%/packages/patches/rust-bootstrap-stage0-test.patch		\
   %D%/packages/patches/rust-coresimd-doctest.patch		\
   %D%/packages/patches/rust-ndarray-remove-blas-src-dep.patch	\
+  %D%/packages/patches/rust-ndarray-0.13-remove-blas-src.patch	\
   %D%/packages/patches/rust-nettle-disable-vendor.patch		 \
   %D%/packages/patches/rust-nettle-sys-disable-vendor.patch	 \
   %D%/packages/patches/rust-reproducible-builds.patch		 \
   %D%/packages/patches/rust-openssl-sys-no-vendor.patch	\
-  %D%/packages/patches/rxvt-unicode-escape-sequences.patch	\
   %D%/packages/patches/sbc-fix-build-non-x86.patch		\
+  %D%/packages/patches/sbcl-burgled-batteries3-fix-signals.patch	\
   %D%/packages/patches/sbcl-clml-fix-types.patch		\
+  %D%/packages/patches/sbcl-png-fix-sbcl-compatibility.patch	\
   %D%/packages/patches/scalapack-blacs-mpi-deprecations.patch	\
   %D%/packages/patches/scheme48-tests.patch			\
   %D%/packages/patches/scotch-build-parallelism.patch		\
@@ -1683,6 +1765,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/slim-login.patch				\
   %D%/packages/patches/slim-display.patch			\
   %D%/packages/patches/snappy-add-O2-flag-in-CmakeLists.txt.patch	\
+  %D%/packages/patches/snappy-add-inline-for-GCC.patch		\
   %D%/packages/patches/sphinxbase-fix-doxygen.patch		\
   %D%/packages/patches/sssd-fix-samba.patch			\
   %D%/packages/patches/sssd-system-directories.patch		\
@@ -1725,18 +1808,24 @@ dist_patch_DATA =						\
   %D%/packages/patches/tipp10-remove-license-code.patch		\
   %D%/packages/patches/tipp10-qt5.patch			\
   %D%/packages/patches/tk-find-library.patch			\
+  %D%/packages/patches/tla2tools-build-xml.patch		\
+  %D%/packages/patches/tlf-support-hamlib-4.2+.patch		\
   %D%/packages/patches/transcode-ffmpeg.patch	\
   %D%/packages/patches/transmission-honor-localedir.patch	\
+  %D%/packages/patches/transmission-remote-gtk-fix-appstream.patch	\
   %D%/packages/patches/ttf2eot-cstddef.patch			\
   %D%/packages/patches/tup-unbundle-dependencies.patch		\
   %D%/packages/patches/tuxpaint-stamps-path.patch		\
   %D%/packages/patches/twinkle-bcg729.patch			\
+  %D%/packages/patches/u-boot-nintendo-nes-serial.patch		\
+  %D%/packages/patches/u-boot-rockchip-inno-usb.patch		\
+  %D%/packages/patches/u-boot-sifive-prevent-reloc-initrd-fdt.patch	\
   %D%/packages/patches/u-boot-riscv64-fix-extlinux.patch	\
   %D%/packages/patches/ucx-tcp-iface-ioctl.patch		\
   %D%/packages/patches/udiskie-no-appindicator.patch		\
   %D%/packages/patches/ungoogled-chromium-extension-search-path.patch	\
+  %D%/packages/patches/ungoogled-chromium-ffmpeg-compat.patch	\
   %D%/packages/patches/ungoogled-chromium-system-nspr.patch	\
-  %D%/packages/patches/ungoogled-chromium-system-opus.patch	\
   %D%/packages/patches/unison-fix-ocaml-4.08.patch		\
   %D%/packages/patches/unknown-horizons-python-3.8-distro.patch	\
   %D%/packages/patches/unzip-CVE-2014-8139.patch		\
@@ -1788,11 +1877,11 @@ dist_patch_DATA =						\
   %D%/packages/patches/vte-CVE-2012-2738-pt1.patch			\
   %D%/packages/patches/vte-CVE-2012-2738-pt2.patch			\
   %D%/packages/patches/vtk-fix-freetypetools-build-failure.patch	\
+  %D%/packages/patches/vtk-8-fix-freetypetools-build-failure.patch	\
   %D%/packages/patches/warsow-qfusion-fix-bool-return-type.patch	\
   %D%/packages/patches/webkitgtk-share-store.patch		\
   %D%/packages/patches/webkitgtk-bind-all-fonts.patch		\
   %D%/packages/patches/websocketpp-fix-for-cmake-3.15.patch	\
-  %D%/packages/patches/wgetpaste-update-bpaste.patch		\
   %D%/packages/patches/wicd-bitrate-none-fix.patch		\
   %D%/packages/patches/wicd-get-selected-profile-fix.patch	\
   %D%/packages/patches/wicd-urwid-1.3.patch			\
@@ -1814,18 +1903,22 @@ dist_patch_DATA =						\
   %D%/packages/patches/xf86-video-voodoo-pcitag.patch		\
   %D%/packages/patches/xfce4-panel-plugins.patch		\
   %D%/packages/patches/xfce4-settings-defaults.patch		\
+  %D%/packages/patches/xgboost-use-system-dmlc-core.patch       \
   %D%/packages/patches/xmonad-dynamic-linking.patch		\
+  %D%/packages/patches/xnnpack-system-libraries.patch		\
   %D%/packages/patches/xplanet-1.3.1-cxx11-eof.patch		\
   %D%/packages/patches/xplanet-1.3.1-libdisplay_DisplayOutput.cpp.patch	\
   %D%/packages/patches/xplanet-1.3.1-libimage_gif.c.patch	\
   %D%/packages/patches/xplanet-1.3.1-xpUtil-Add2017LeapSecond.cpp.patch	\
-  %D%/packages/patches/xpra-4.0.1-systemd-run.patch	\
+  %D%/packages/patches/xpra-4.2-systemd-run.patch		\
   %D%/packages/patches/xsane-fix-memory-leak.patch		\
   %D%/packages/patches/xsane-fix-pdf-floats.patch		\
   %D%/packages/patches/xsane-fix-snprintf-buffer-length.patch	\
   %D%/packages/patches/xsane-support-ipv6.patch			\
   %D%/packages/patches/xsane-tighten-default-umask.patch	\
   %D%/packages/patches/yggdrasil-extra-config.patch	\
+  %D%/packages/patches/ytfzf-programs.patch        \
+  %D%/packages/patches/ytfzf-updates.patch        \
   %D%/packages/patches/ytnef-CVE-2021-3403.patch	\
   %D%/packages/patches/ytnef-CVE-2021-3404.patch	\
   %D%/packages/patches/zstd-CVE-2021-24031_CVE-2021-24032.patch	\

gnu/machine/digital-ocean.scm

@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org>
+;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -234,7 +235,7 @@ cat > /etc/bootstrap-config.scm << EOF
   (timezone \"Etc/UTC\")
   (bootloader (bootloader-configuration
                (bootloader grub-bootloader)
-               (target \"/dev/vda\")
+               (targets '(\"/dev/vda\"))
                (terminal-outputs '(console))))
   (file-systems (cons (file-system
                         (mount-point \"/\")
@@ -256,7 +257,7 @@ cat > /etc/bootstrap-config.scm << EOF
                  (service openssh-service-type
                           (openssh-configuration
                            (log-level 'debug)
-                           (permit-root-login 'without-password))))
+                           (permit-root-login 'prohibit-password))))
            %base-services)))
 EOF
 # guix pull

gnu/machine/ssh.scm

@@ -38,6 +38,9 @@
   #:use-module (guix store)
   #:use-module (guix utils)
   #:use-module ((guix self) #:select (make-config.scm))
+  #:use-module ((guix inferior)
+                #:select (inferior-exception?
+                          inferior-exception-arguments))
   #:use-module (gcrypt pk-crypto)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
@@ -443,17 +446,47 @@ have you run 'guix archive --generate-key?'")
   (mlet %store-monad ((_ (check-deployment-sanity machine))
                       (boot-parameters (machine-boot-parameters machine)))
     (let* ((os (machine-operating-system machine))
+           (host (machine-ssh-configuration-host-name
+                  (machine-configuration machine)))
            (eval (cut machine-remote-eval machine <>))
            (menu-entries (map boot-parameters->menu-entry boot-parameters))
            (bootloader-configuration (operating-system-bootloader os))
            (bootcfg (operating-system-bootcfg os menu-entries)))
+      (define-syntax-rule (eval/error-handling condition handler ...)
+        ;; Return a wrapper around EVAL such that HANDLER is evaluated if an
+        ;; exception is raised.
+        (lambda (exp)
+          (lambda (store)
+            (guard (condition ((inferior-exception? condition)
+                               (values (begin handler ...) store)))
+              (values (run-with-store store (eval exp))
+                      store)))))
+
       (mbegin %store-monad
         (with-roll-back #f
-          (switch-to-system eval os))
+          (switch-to-system (eval/error-handling c
+                              (raise (formatted-message
+                                      (G_ "\
+failed to switch systems while deploying '~a':~%~{~s ~}")
+                                      host
+                                      (inferior-exception-arguments c))))
+                            os))
         (with-roll-back #t
           (mbegin %store-monad
-            (upgrade-shepherd-services eval os)
+            (upgrade-shepherd-services (eval/error-handling c
-            (install-bootloader eval bootloader-configuration bootcfg)))))))
+                                         (warning (G_ "\
+an error occurred while upgrading services on '~a':~%~{~s ~}~%")
+                                                  host
+                                                  (inferior-exception-arguments
+                                                   c)))
+                                       os)
+            (install-bootloader (eval/error-handling c
+                                  (raise (formatted-message
+                                          (G_ "\
+failed to install bootloader on '~a':~%~{~s ~}~%")
+                                          host
+                                          (inferior-exception-arguments c))))
+                                bootloader-configuration bootcfg)))))))
 
 
 ;;;
@@ -540,4 +573,6 @@ for environment of type '~a'")
 
 ;; Local Variables:
 ;; eval: (put 'remote-let 'scheme-indent-function 1)
+;; eval: (put 'with-roll-back 'scheme-indent-function 1)
+;; eval: (put 'eval/error-handling 'scheme-indent-function 1)
 ;; End:

gnu/packages/abiword.scm

@@ -3,7 +3,7 @@
 ;;; Copyright © 2016, 2018 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
-;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2018, 2021 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2020 Oleg Pykhalov <go.wigust@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -48,7 +48,7 @@
 (define-public abiword
   (package
     (name "abiword")
-    (version "3.0.4")
+    (version "3.0.5")
     (source
       (origin
         (method url-fetch)
@@ -56,7 +56,7 @@
           (string-append "https://www.abisource.com/downloads/abiword/" version
                          "/source/abiword-" version ".tar.gz"))
         (sha256
-         (base32 "1mx5l716n0z5788i19qmad30cck4v9ggr071cafw2nrf375rcc79"))
+         (base32 "1d1179pnslijpjhz1q155fsc828rrlqf7lsn2inqsl3hk5z28mqj"))
         (patches
          (search-patches "abiword-explictly-cast-bools.patch"))))
 

gnu/packages/ada.scm

@@ -177,43 +177,3 @@ specification in our Python DSL and Langkit will generate for you an
 Ada library with bindings for the C and Python programming languages.")
       (home-page "https://github.com/AdaCore/langkit/")
       (license license:gpl3+))))   ; and gcc runtime library exception
-
-(define-public python2-libadalang
-  (let ((commit "9b205e9bacdd50a68117727332e16fbef5f6ac49")
-        (revision "0"))
-    (package
-      (name "python2-libadalang")
-      (version (git-version "0.0.0" revision commit))
-      (source (origin
-                (method git-fetch)
-                (uri (git-reference
-                      (url "https://github.com/AdaCore/libadalang")
-                      (commit commit)))
-                (sha256
-                 (base32
-                  "06hsnzj2syqpq2yhg1bb0zil7ydbyqkdmkjbf8j9b5sdgkyh5xrp"))
-                (file-name (string-append name "-" version "-checkout"))))
-      (build-system python-build-system)
-      (native-inputs
-       `(("python2-langkit" ,python2-langkit)
-         ("python2-quex" ,python2-quex-0.67.3)))
-      (arguments
-       `(#:python ,python-2
-         #:phases
-         (modify-phases %standard-phases
-           (replace 'build
-             (lambda _
-               (invoke "python2" "ada/manage.py" "generate")
-               (invoke "python2" "ada/manage.py" "build")))
-           (replace 'check
-             (lambda _
-               (invoke "python2" "ada/manage.py" "test")))
-           (replace 'install
-             (lambda* (#:key outputs #:allow-other-keys)
-               (let* ((out (assoc-ref outputs "out")))
-                 (invoke "python2" "ada/manage.py" "install" out)))))))
-      (synopsis "Semantic Analysis for Ada in Python")
-      (description "@code{libadalang} provides a high-performance semantic
-engine for the Ada programming language.")
-      (home-page "https://github.com/AdaCore/libadalang")
-      (license license:gpl3)))) ; and gcc runtime gcc lib exception

gnu/packages/admin.scm

@@ -2,7 +2,7 @@
 ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
 ;;; Copyright © 2014, 2015, 2016, 2018, 2019, 2020 Mark H Weaver <mhw@netris.org>
-;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2020 Eric Bavier <bavier@posteo.net>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2020, 2021 Eric Bavier <bavier@posteo.net>
 ;;; Copyright © 2015, 2016 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
 ;;; Copyright © 2015 Alex Sassmannshausen <alex.sassmannshausen@gmail.com>
 ;;; Copyright © 2015 Eric Dvorsak <eric@dvorsak.fr>
@@ -17,7 +17,7 @@
 ;;; Copyright © 2016 John Darrington <jmd@gnu.org>
 ;;; Copyright © 2017 Ben Sturmfels <ben@sturm.com.au>
 ;;; Copyright © 2017 Ethan R. Jones <doubleplusgood23@gmail.com>
-;;; Copyright © 2017 Christopher Allan Webber <cwebber@dustycloud.org>
+;;; Copyright © 2017 Christine Lemmer-Webber <cwebber@dustycloud.org>
 ;;; Copyright © 2017, 2018, 2020 Marius Bakke <mbakke@fastmail.com>
 ;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net>
 ;;; Copyright © 2018 Pierre-Antoine Rouby <pierre-antoine.rouby@inria.fr>
@@ -29,7 +29,7 @@
 ;;; Copyright © 2019 Hartmut Goebel <h.goebel@crazy-compilers.com>
 ;;; Copyright © 2019 Alex Griffin <a@ajgrf.com>
 ;;; Copyright © 2019, 2021 Guillaume Le Vaillant <glv@posteo.net>
-;;; Copyright © 2019, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2019, 2020, 2021 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2020 Oleg Pykhalov <go.wigust@gmail.com>
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2020, 2021 Michael Rohleder <mike@rohleder.de>
@@ -40,6 +40,10 @@
 ;;; Copyright © 2021 qblade <qblade@protonmail.com>
 ;;; Copyright © 2021 Hyunseok Kim <lasnesne@lagunposprasihopre.org>
 ;;; Copyright © 2021 David Larsson <david.larsson@selfhosted.xyz>
+;;; Copyright © 2021 WinterHound <winterhound@yandex.com>
+;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
+;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -132,11 +136,14 @@
   #:use-module (gnu packages qt)
   #:use-module (gnu packages readline)
   #:use-module (gnu packages ruby)
+  #:use-module (gnu packages selinux)
   #:use-module (gnu packages serialization)
+  #:use-module (gnu packages ssh)
   #:use-module (gnu packages sphinx)
   #:use-module (gnu packages tcl)
   #:use-module (gnu packages terminals)
   #:use-module (gnu packages texinfo)
+  #:use-module (gnu packages time)
   #:use-module (gnu packages tls)
   #:use-module (gnu packages version-control)
   #:use-module (gnu packages web)
@@ -469,6 +476,34 @@ services.")
     (license license:public-domain)
     (home-page "https://cr.yp.to/daemontools.html")))
 
+(define-public daemonize
+  (package
+    (name "daemonize")
+    (version "1.7.8")
+    (source
+     (origin
+       (method git-fetch)
+       (uri (git-reference
+             (url "https://github.com/bmc/daemonize")
+             (commit (string-append "release-" version))))
+       (file-name (git-file-name name version))
+       (sha256
+        (base32 "0w4g0iyssyw7dd0061881z8s5czcl01mz6v00znax57zfxjqpvnm"))))
+    (build-system gnu-build-system)
+    (arguments '(#:tests? #f))          ; No tests available.
+    (home-page "http://software.clapper.org/daemonize/")
+    (synopsis "Command line utility to run a program as a daemon")
+    (description
+     "daemonize runs a command as a Unix daemon.  It will close all open file
+descriptors, change working directory of the process to the root filesystem,
+reset its umask, run in the background, ignore I/O signals, handle
+@code{SIGCLD}, etc.  Most programs that are designed to be run as daemons do
+that work for themselves.  However, you’ll occasionally run across one that
+does not.  When you must run a daemon program that does not properly make
+itself into a true Unix daemon, you can use daemonize to force it to run as a
+true daemon.")
+    (license license:bsd-3)))
+
 (define-public dfc
   (package
    (name "dfc")
@@ -602,7 +637,7 @@ console.")
 (define-public htop
   (package
     (name "htop")
-    (version "3.0.5")
+    (version "3.1.0")
     (source
      (origin
        (method git-fetch)
@@ -610,7 +645,7 @@ console.")
              (url "https://github.com/htop-dev/htop")
              (commit version)))
        (sha256
-        (base32 "10lp6cbfvigzp6pq5nwj3s3l4vs7cv92krz2r08nwrz8vl6rqdzp"))
+        (base32 "1ngvidaka6xbfb3l4zxmlksk2ms93fy3sb76w7917kjgn9mh53zz"))
        (file-name (git-file-name name version))))
     (build-system gnu-build-system)
     (inputs
@@ -652,14 +687,13 @@ memory, disks, network and processes.")
 (define-public bpytop
   (package
     (name "bpytop")
-    (version "1.0.63")
+    (version "1.0.67")
     (source
      (origin
        (method url-fetch)
        (uri (pypi-uri "bpytop" version))
        (sha256
-        (base32
+        (base32 "1fwmiwvs8ax9az3hbp1p79x6m3wq73pn3vkbhcg9jvps4wv8wcwb"))))
-         "0ql72s842g56rnzdqja6m53lw5y68c4gb540ihp1bjg7x9ycim11"))))
     (build-system python-build-system)
     (inputs
      `(("python-psutil" ,python-psutil)))
@@ -674,19 +708,19 @@ memory, disks, network and processes.")
                                             (package-version python))
                                           "/site-packages/bpytop-themes")))
                (mkdir-p themes)
-               (copy-recursively "bpytop-themes" themes)))))))
+               (copy-recursively "themes" themes)))))))
     (home-page
      "https://github.com/aristocratos/bpytop")
     (synopsis "Resource monitor")
     (description "Resource monitor that shows usage and stats for processor,
-memory, disks, network and processes.  It's a Python port of
+memory, disks, network and processes.  It's a Python port and continuation of
 @command{bashtop}.")
     (license license:asl2.0)))
 
 (define-public pies
   (package
     (name "pies")
-    (version "1.5")
+    (version "1.6")
     (source
      (origin
        (method url-fetch)
@@ -694,7 +728,7 @@ memory, disks, network and processes.  It's a Python port of
                            version ".tar.bz2"))
        (sha256
         (base32
-         "11j168qljsinaj5dwmg7nkm2z1aghi6gc3d0wf0pikflnh2q2wqf"))))
+         "0ad5bg1czwmr4qw33aszxzc6ll99a9lfs32lyfb1wl5x9s1cc7az"))))
     (build-system gnu-build-system)
     (arguments
      '(#:phases (modify-phases %standard-phases
@@ -791,6 +825,17 @@ hostname.")
 
        #:phases
        (modify-phases %standard-phases
+         ,@(if (%current-target-system)
+               '((add-before 'configure 'set-runtime-shell
+                   (lambda* (#:key inputs #:allow-other-keys)
+                     (let ((shell (string-append
+                                   (assoc-ref inputs "bash")
+                                   "/bin/bash")))
+                       (setenv "RUNTIME_SHELL" shell)
+                       (substitute* "configure.ac"
+                         (("\\$SHELL")
+                          "$RUNTIME_SHELL"))))))
+               '())
          (add-before 'build 'set-nscd-file-name
            (lambda* (#:key inputs #:allow-other-keys)
              ;; Use the right file name for nscd.
@@ -815,7 +860,10 @@ hostname.")
     (inputs
      `(,@(if (hurd-target?)
            '()
-           `(("linux-pam" ,linux-pam)))))
+           `(("linux-pam" ,linux-pam)))
+       ,@(if (%current-target-system)
+             `(("bash" ,bash-minimal))
+             '())))
     (home-page "https://github.com/shadow-maint/shadow")
     (synopsis "Authentication-related tools such as passwd, su, and login")
     (description
@@ -1108,7 +1156,7 @@ connection alive.")
 (define-public isc-dhcp
   (let* ((bind-major-version "9")
          (bind-minor-version "11")
-         (bind-patch-version "29")
+         (bind-patch-version "32")
          (bind-release-type "")         ; for patch release, use "-P"
          (bind-release-version "")      ; for patch release, e.g. "6"
          (bind-version (string-append bind-major-version
@@ -1120,14 +1168,15 @@ connection alive.")
                                       bind-release-version)))
     (package
       (name "isc-dhcp")
-      (version "4.4.2")
+      (version "4.4.2-P1")
       (source (origin
                 (method url-fetch)
                 (uri (string-append "https://ftp.isc.org/isc/dhcp/"
                                     version "/dhcp-" version ".tar.gz"))
+                (patches (search-patches "isc-dhcp-gcc-compat.patch"))
                 (sha256
                  (base32
-                  "08a5003zdxgl41b29zjkxa92h2i40zyjgxg0npvnhpkfl5jcsz0s"))))
+                  "06jsr0cg5rsmyibshrpcb9za0qgwvqccashdma7mlm1rflrh8pmh"))))
       (build-system gnu-build-system)
       (arguments
        `(#:parallel-build? #f
@@ -1199,7 +1248,11 @@ connection alive.")
                            "--owner=root:0"
                            "--group=root:0")))))
            (add-after 'install 'post-install
-             (lambda* (#:key inputs outputs #:allow-other-keys)
+             ;; TODO(core-updates): native-inputs isn't required anymore.
+             (lambda* (#:key ,@(if (%current-target-system)
+                                   '(native-inputs)
+                                   '())
+                       inputs outputs #:allow-other-keys)
                ;; Install the dhclient script for GNU/Linux and make sure
                ;; if finds all the programs it needs.
                (let* ((out       (assoc-ref outputs "out"))
@@ -1224,6 +1277,19 @@ connection alive.")
                              (string-append dir "/bin:"
                                             dir "/sbin"))
                            (list inetutils net-tools coreutils sed))))
+                 ;; TODO(core-updates): should not be required anymore,
+                 ;; once <https://issues.guix.gnu.org/49290> has been merged.
+                 ,@(if (%current-target-system)
+                       '((for-each
+                          (lambda (file)
+                            (substitute* file
+                              (((assoc-ref native-inputs "bash"))
+                               (assoc-ref inputs "bash"))))
+                          (list (string-append libexec
+                                               "/dhclient-script")
+                                (string-append libexec
+                                               "/.dhclient-script-real"))))
+                       '())
                  #t))))))
 
       (native-inputs
@@ -1231,6 +1297,11 @@ connection alive.")
          ("file" ,file)))
 
       (inputs `(("inetutils" ,inetutils)
+                ;; TODO(core-updates): simply make this unconditional
+                ,@(if (%current-target-system)
+                      ;; for wrap-program
+                      `(("bash" ,(canonical-package bash-minimal)))
+                      '())
                 ,@(if (hurd-target?) '()
                       `(("net-tools" ,net-tools)
                         ("iproute" ,iproute)))
@@ -1245,12 +1316,12 @@ connection alive.")
                                         "/bind-" bind-version ".tar.gz"))
                     (sha256
                      (base32
-                      "01vvkvlhsxz4ffz2fw86z0fsf170b93jjnn5710ai6vfri8wgfy7"))))
+                      "0hhkb4d14hvly2751cxl2s2xyim3bri8qaisgkcm456xfi5wpy6b"))))
 
                 ("coreutils*" ,coreutils)
                 ("sed*" ,sed)))
 
-      (home-page "https://www.isc.org/products/DHCP/")
+      (home-page "https://www.isc.org/dhcp/")
       (synopsis "Dynamic Host Configuration Protocol (DHCP) tools")
       (description
        "ISC's Dynamic Host Configuration Protocol (DHCP) distribution provides a
@@ -1259,24 +1330,64 @@ tools: server, client, and relay agent.")
       (license license:mpl2.0)
       (properties '((cpe-name . "dhcp"))))))
 
+(define-public radvd
+  (package
+    (name "radvd")
+    (version "2.19")
+    (source
+     (origin
+       (method git-fetch)
+       (uri (git-reference
+             (url "https://github.com/radvd-project/radvd")
+             (commit (string-append "v" version))))
+       (file-name (git-file-name name version))
+       (sha256
+        (base32 "1df827m3vkjq2bcs5y9wg2cygvpdwl8ppl446qqhyym584gz54nl"))))
+    (build-system gnu-build-system)
+    (native-inputs
+     `(("autoconf" ,autoconf)
+       ("automake" ,automake)
+       ("bison" ,bison)
+       ("check" ,check)
+       ("flex" ,flex)
+       ("pkg-config" ,pkg-config)))
+    (arguments
+     `(#:configure-flags '("--with-check")))
+    (home-page "https://radvd.litech.org/")
+    (synopsis "IPv6 Router Advertisement Daemon")
+    (description
+     "The Router Advertisement Daemon (radvd) is run on systems acting as IPv6
+routers.  It sends Router Advertisement messages specified by RFC 2461
+periodically and when requested by a node sending a Router Solicitation
+message.  These messages are required for IPv6 stateless autoconfiguration.")
+    (license (license:non-copyleft "file://COPYRIGHT"))))
+
 (define-public libpcap
   (package
     (name "libpcap")
-    (version "1.10.0")
+    (version "1.10.1")
     (source (origin
               (method url-fetch)
               (uri (string-append "https://www.tcpdump.org/release/libpcap-"
                                   version ".tar.gz"))
               (sha256
                (base32
-                "07ibr6zzfh1wk5gqcbnlyh6v0dfmhpfd0fqj5y3yxvzf4ckb84ld"))))
+                "1m5x26vlbymp90k1qh0w3nj2nxzyvfrmfmwpj17k81dgri55ya7d"))))
     (build-system gnu-build-system)
     (native-inputs
      `(("bison" ,bison)
        ("flex" ,flex)))
     (arguments
      ;; There are some tests in testprogs/, but no automated test suite.
-     '(#:tests? #f))
+     `(#:tests? #f
+       #:phases
+       (modify-phases %standard-phases
+         (add-after 'unpack 'omit-static-library
+           ;; Neither build nor install libpcap.a.
+           (lambda _
+             (substitute* "Makefile.in"
+               ((" libpcap\\.a") "")
+               ((" install-archive ") " ")))))))
     (home-page "https://www.tcpdump.org")
     (synopsis "Network packet capture library")
     (description
@@ -1290,14 +1401,14 @@ network statistics collection, security monitoring, network debugging, etc.")
 (define-public tcpdump
   (package
     (name "tcpdump")
-    (version "4.99.0")
+    (version "4.99.1")
     (source (origin
               (method url-fetch)
               (uri (string-append "https://www.tcpdump.org/release/tcpdump-"
                                   version ".tar.gz"))
               (sha256
                (base32
-                "0hmqh2fx8rgs9v1mk3vpywj61xvkifz260q685xllxr8jmxg3wlc"))))
+                "1ghfs5gifzrk3813zf9zalfbjs70wg6llz6q31k180r7zf2nkcvr"))))
     (build-system gnu-build-system)
     (inputs `(("libpcap" ,libpcap)
               ("openssl" ,openssl)))
@@ -1559,7 +1670,7 @@ system administrator.")
 (define-public sudo
   (package
     (name "sudo")
-    (version "1.9.6p1")
+    (version "1.9.8p2")
     (source (origin
               (method url-fetch)
               (uri
@@ -1569,12 +1680,11 @@ system administrator.")
                                     version ".tar.gz")))
               (sha256
                (base32
-                "146alf6cwnzjcckia8m0ibcj9ram2z469f5z7v6vkzpsb30cvsd9"))
+                "0b8gd15l2g22w4fhhz0gzmq5c8370klanmy2c1p3px6yly6qnfwy"))
               (modules '((guix build utils)))
               (snippet
                '(begin
-                  (delete-file-recursively "lib/zlib")
+                  (delete-file-recursively "lib/zlib")))))
-                  #t))))
     (build-system gnu-build-system)
     (outputs (list "out"))
     (arguments
@@ -1627,8 +1737,7 @@ system administrator.")
              ;; not the task of the build system, and fails.
              (substitute* "plugins/sudoers/Makefile.in"
                (("^pre-install:" match)
-                (string-append match "\ndisabled-" match)))
+                (string-append match "\ndisabled-" match))))))
-             #t)))
 
        ;; XXX: The 'testsudoers' test series expects user 'root' to exist, but
        ;; the chroot's /etc/passwd doesn't have it.  Turn off the tests.
@@ -1672,18 +1781,27 @@ commands and their arguments.")
     (arguments
      `(#:phases
        (modify-phases %standard-phases
+         (add-before 'configure 'pre-configure
+           (lambda* (#:key outputs #:allow-other-keys)
+             (substitute* "GNUmakefile"
+               (("^\tchown.*$") ""))
+             ;; OpenDoas look for binaries in safepath when a rule specify a
+             ;; relative command, such as “permit keepenv :wheel cmd guix”.
+             (substitute* "doas.c"
+               (("safepath =" match)
+                (string-append match " \""
+                               "/run/setuid-programs:"
+                               "/run/current-system/profile/bin:"
+                               "/run/current-system/profile/sbin:"
+                               "\" ")))
+             #t))
          (replace 'configure
            ;; The configure script doesn't accept most of the default flags.
            (lambda* (#:key configure-flags #:allow-other-keys)
              ;; The configure script can be told which compiler to use only
              ;; through environment variables.
              (setenv "CC" ,(cc-for-target))
-             (apply invoke "./configure" configure-flags)))
+             (apply invoke "./configure" configure-flags))))
-         (add-before 'install 'fix-makefile
-           (lambda* (#:key outputs #:allow-other-keys)
-             (substitute* "GNUmakefile"
-               (("^\tchown.*$") ""))
-             #t)))
        #:configure-flags
        (list (string-append "--prefix=" (assoc-ref %outputs "out"))
              "--with-timestamp")
@@ -1839,7 +1957,7 @@ command.")
   (package
     (inherit wpa-supplicant)
     (name "wpa-supplicant-gui")
-    (inputs `(("qtbase" ,qtbase)
+    (inputs `(("qtbase" ,qtbase-5)
               ("qtsvg" ,qtsvg)
               ,@(package-inputs wpa-supplicant)))
     (native-inputs
@@ -2027,7 +2145,7 @@ module slots, and the list of I/O ports (e.g. serial, parallel, USB).")
 (define-public acpica
   (package
     (name "acpica")
-    (version "20210331")
+    (version "20210730")
     (source (origin
               (method url-fetch)
               (uri (string-append
@@ -2035,7 +2153,7 @@ module slots, and the list of I/O ports (e.g. serial, parallel, USB).")
                     version ".tar.gz"))
               (sha256
                (base32
-                "1h98pvc9iy1c49cid0ppjwk5zsy2m1xbvfqb72pkwkrd4rn35arx"))))
+                "02z0492vrpk001m7xcy72lp7sd968lja3wp6jn3q6k9nm46h4v7h"))))
     (build-system gnu-build-system)
     (native-inputs `(("flex" ,flex)
                      ("bison" ,bison)))
@@ -2110,7 +2228,7 @@ system is under heavy load.")
 (define-public detox
   (package
     (name "detox")
-    (version "1.3.3")
+    (version "1.4.5")
     (source (origin
               (method git-fetch)
               (uri (git-reference
@@ -2119,21 +2237,23 @@ system is under heavy load.")
               (file-name (git-file-name name version))
               (sha256
                (base32
-                "13mhs62m7bpff45liy65pajq5jg3i12jj90vwdkra94z9mlr2rlz"))))
+                "116bgpbkh3c96h6vq0880rmnpb5kbnnlvvkpsrcib6928bj8lfvi"))))
     (build-system gnu-build-system)
     (native-inputs
      `(("autoconf" ,autoconf)
        ("automake" ,automake)
        ("flex" ,flex)))
     (arguments
-     `(#:tests? #f                    ;no 'check' target
+     `(#:phases (modify-phases %standard-phases
-       #:phases (modify-phases %standard-phases
                   (add-after 'unpack 'delete-configure
                     ;; The "configure" script is present, but otherwise the
                     ;; project is not bootstrapped: missing install-sh and
                     ;; Makefile.in, so delete it so the bootstrap phase will
                     ;; take over.
-                    (lambda _ (delete-file "configure") #t)))))
+                    (lambda _ (delete-file "configure") #t))
+                  (replace 'check
+                    (lambda _
+                      (invoke "./tests/test.sh" "src/detox"))))))
     (home-page "https://github.com/dharple/detox")
     (synopsis "Clean up file names")
     (description
@@ -2382,40 +2502,29 @@ Statsd, Librato and InfluxDB.  Graphios can emit Nagios metrics to any number
 of supported upstream metrics systems simultaneously.")
    (license license:gpl2+)))
 
-(define-public ansible
+(define-public ansible-core
   (package
-    (name "ansible")
+    (name "ansible-core")
-    (version "2.9.18")
+    (version "2.11.4")
     (source
      (origin
        (method url-fetch)
-       (uri (pypi-uri "ansible" version))
+       (uri (pypi-uri "ansible-core" version))
        (sha256
-        (base32 "0g6rsnh02zq5nizamgakl2wvgz7hk1lpnjn9akldrcpa55vygzjm"))))
+        (base32
+         "0jgahcv2pyc5ky0wir55a1h9q9d6rgqj60rqmvlpbj76vz1agsi2"))))
     (build-system python-build-system)
-    (native-inputs
-     `(("python-bcrypt" ,python-bcrypt)
-       ("python-pynacl" ,python-pynacl)
-       ("python-httplib2" ,python-httplib2)
-       ("python-passlib" ,python-passlib)
-       ("python-nose" ,python-nose)
-       ("python-mock" ,python-mock)
-       ("python-jinja2" ,python-jinja2)
-       ("python-pyyaml" ,python-pyyaml)
-       ("python-paramiko" ,python-paramiko)))
-    (inputs
-     `(("python-cryptography" ,python-cryptography)
-       ("python-jinja2" ,python-jinja2)
-       ("python-pyyaml" ,python-pyyaml)
-       ("python-paramiko" ,python-paramiko)))
     (arguments
-     `(#:phases
+     `(#:modules ((guix build python-build-system)
+                  (guix build utils)
+                  (ice-9 ftw))
+       #:phases
        (modify-phases %standard-phases
          ;; Several ansible commands (ansible-config, ansible-console, etc.)
-         ;; are just symlinks to a single ansible executable. The ansible
+         ;; are just symlinks to a single ansible executable.  The ansible
-         ;; executable behaves differently based on the value of
+         ;; executable behaves differently based on the value of sys.argv[0].
-         ;; sys.argv[0]. This does not work well with our wrap phase, and
+         ;; This does not work well with our wrap phase, and therefore the
-         ;; therefore the following two phases are required as a workaround.
+         ;; following two phases are required as a workaround.
          (add-after 'unpack 'hide-wrapping
            (lambda _
              ;; Overwrite sys.argv[0] to hide the wrapper script from it.
@@ -2424,27 +2533,138 @@ of supported upstream metrics systems simultaneously.")
                 (string-append all "
 import re
 sys.argv[0] = re.sub(r'\\.([^/]*)-real$', r'\\1', sys.argv[0])
-")))
+")))))
-             #t))
          (add-after 'install 'replace-symlinks
            (lambda* (#:key outputs #:allow-other-keys)
              ;; Replace symlinks with duplicate copies of the ansible
-             ;; executable.
+             ;; executable so that sys.argv[0] has the correct value.
-             (let ((out (assoc-ref outputs "out")))
+             (define bin (string-append (assoc-ref outputs "out") "/bin"))
+             (with-directory-excursion bin
                (for-each
-                (lambda (subprogram)
+                (lambda (ansible-symlink)
-                  (delete-file (string-append out "/bin/ansible-" subprogram))
+                  (delete-file ansible-symlink)
-                  (copy-file (string-append out "/bin/ansible")
+                  (copy-file "ansible" ansible-symlink))
-                             (string-append out "/bin/ansible-" subprogram)))
+                (scandir "." (lambda (x)
-                (list "config" "console" "doc" "galaxy"
+                               (and (eq? 'symlink (stat:type (lstat x)))
-                      "inventory" "playbook" "pull" "vault")))
+                                    (string-prefix? "ansible-" x)
-             #t)))))
+                                    (string=? "ansible" (readlink x)))))))))
+         (add-after 'unpack 'preserve-pythonpath
+           (lambda _
+             (substitute* "test/lib/ansible_test/_internal/ansible_util.py"
+               (("PYTHONPATH=get_ansible_python_path\\(args\\)" all)
+                (string-append all "+ ':' + os.environ['PYTHONPATH']")))))
+         (add-after 'unpack 'patch-paths
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (substitute* "lib/ansible/module_utils/compat/selinux.py"
+               (("libselinux.so.1" name)
+                (string-append (assoc-ref inputs "libselinux")
+                               "/lib/" name)))
+             (substitute* "test/units/modules/test_async_wrapper.py"
+               (("/usr/bin/python")
+                (which "python")))))
+         (replace 'check
+           ;; The environment for the test suite can be tricky to get right.
+           ;; The environment used for Ansible's CI defined in the following
+           ;; Dockerfile can be used as a reference:
+           ;; https://raw.githubusercontent.com/ansible/
+           ;; default-test-container/master/Dockerfile.
+           (lambda* (#:key inputs outputs tests? #:allow-other-keys)
+             (when tests?
+               ;; Otherwise Ansible fails to create its config directory.
+               (setenv "HOME" "/tmp")
+               (setenv "PATH" (string-append (getenv "PATH") ":"
+                                             (assoc-ref outputs "out") "/bin"))
+               (add-installed-pythonpath inputs outputs)
+               ;; This test module messes up with sys.path and causes many
+               ;; test failures.
+               (delete-file "test/units/_vendor/test_vendor.py")
+               ;; The test fails when run in the container, for reasons
+               ;; unknown.
+               (delete-file "test/units/utils/test_display.py")
+               ;; This test fail for reasons unknown.
+               (delete-file "test/units/cli/test_adhoc.py")
+               ;; The test suite needs to be run with 'ansible-test', which
+               ;; does some extra environment setup.  Taken from
+               ;; https://raw.githubusercontent.com/ansible/ansible/\
+               ;; devel/test/utils/shippable/shippable.sh.
+               (invoke "ansible-test" "units" "-v")))))))
+    (native-inputs
+     `(("openssh" ,openssh)
+       ("openssl" ,openssl)
+       ("python-mock" ,python-mock)
+       ("python-pycrypto" ,python-pycrypto)
+       ("python-pytest" ,python-pytest)
+       ("python-pytest-forked" ,python-pytest-forked)
+       ("python-pytest-mock" ,python-pytest-mock)
+       ("python-pytest-xdist" ,python-pytest-xdist)
+       ("python-pytz" ,python-pytz)))
+    (inputs                    ;optional dependencies captured in wrap scripts
+     `(("libselinux" ,libselinux)
+       ("python-paramiko" ,python-paramiko)
+       ("python-passlib" ,python-passlib)
+       ("python-pexpect" ,python-pexpect)
+       ("sshpass" ,sshpass)))
+    (propagated-inputs      ;core dependencies listed in egg-info/requires.txt
+     `(("python-cryptography" ,python-cryptography)
+       ("python-jinja2" ,python-jinja2)
+       ("python-pyyaml" ,python-pyyaml)
+       ("python-packaging" ,python-packaging) ;for version number parsing
+       ("python-resolvelib" ,python-resolvelib-0.5)))
     (home-page "https://www.ansible.com/")
     (synopsis "Radically simple IT automation")
-    (description "Ansible is a radically simple IT automation system.  It
+    (description "Ansible aims to be a radically simple IT automation system.
-handles configuration management, application deployment, cloud provisioning,
+It handles configuration management, application deployment, cloud
-ad hoc task execution, and multinode orchestration---including trivializing
+provisioning, ad-hoc task execution, network automation, and multi-node
-things like zero-downtime rolling updates with load balancers.")
+orchestration.  Ansible facilitates complex changes like zero-downtime rolling
+updates with load balancers.  This package is the core of Ansible, which
+provides the following commands:
+@itemize
+@item ansible
+@item ansible-config
+@item ansible-connection
+@item ansible-console
+@item ansible-doc
+@item ansible-galaxy
+@item ansible-inventory
+@item ansible-playbook
+@item ansible-pull
+@item ansible-test
+@item ansible-vault
+@end itemize")
+    (license license:gpl3+)))
+
+(define-public ansible
+  (package
+    (name "ansible")
+    (version "4.4.0")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (pypi-uri "ansible" version))
+       (sha256
+        (base32 "031n22j0lsmh69x6i6gkva81j68b4yzh1pbg3q2h4bknl85q46ag"))))
+    (build-system python-build-system)
+    (propagated-inputs
+     `(("ansible-core" ,ansible-core)))
+    ;; The Ansible collections are found by ansible-core via PYTHONPATH; the
+    ;; following search path ensures that they are found even when Python is
+    ;; not present in the profile.
+    (native-search-paths
+     ;; XXX: Attempting to use (package-native-search-paths python)
+     ;; here would cause an error about python being an unbound
+     ;; variable in the tests/cpan.scm test.
+     (list (search-path-specification
+            (variable "PYTHONPATH")
+            (files (list "lib/python3.8/site-packages")))))
+    (home-page "https://www.ansible.com/")
+    (synopsis "Radically simple IT automation")
+    (description "Ansible aims to be a radically simple IT automation system.
+It handles configuration management, application deployment, cloud
+provisioning, ad-hoc task execution, network automation, and multi-node
+orchestration.  Ansible facilitates complex changes like zero-downtime rolling
+updates with load balancers.  This package provides a curated set of
+community-maintained Ansible collections, which contain playbooks, roles,
+modules and plugins that extend Ansible.")
     (license license:gpl3+)))
 
 (define-public debops
@@ -2803,14 +3023,14 @@ done with the @code{auditctl} utility.")
 (define-public nmap
   (package
     (name "nmap")
-    (version "7.80")
+    (version "7.91")
     (source (origin
               (method url-fetch)
               (uri (string-append "https://nmap.org/dist/nmap-" version
                                   ".tar.bz2"))
               (sha256
                (base32
-                "1aizfys6l9f9grm82bk878w56mg0zpkfns3spzj157h98875mypw"))
+                "001kb5xadqswyw966k2lqi6jr6zz605jpp9w4kmm272if184pk0q"))
               (modules '((guix build utils)))
               (snippet
                '(begin
@@ -2886,6 +3106,7 @@ tool.  It is also useful for tasks such as network inventory, managing service
 upgrade schedules, and monitoring host or service uptime.  It also provides an
 advanced netcat implementation (ncat), a utility for comparing scan
 results (ndiff), and a packet generation and response analysis tool (nping).")
+    ;; See <https://github.com/nmap/nmap/issues/2199#issuecomment-792048244>.
     ;; This package uses nmap's bundled versions of libdnet and liblinear, which
     ;; both use a 3-clause BSD license.
     (license (list license:nmap license:bsd-3))))
@@ -3035,7 +3256,7 @@ produce uniform output across heterogeneous networks.")
      `(#:tests? #f                      ; no tests
        #:make-flags
        (list (string-append "PREFIX=" (assoc-ref %outputs "out"))
-             "CC=gcc")
+             ,(string-append "CC=" (cc-for-target)))
        #:phases
        (modify-phases %standard-phases
          (delete 'configure))))         ; no configure script
@@ -3305,7 +3526,7 @@ buffers.")
 (define-public igt-gpu-tools
   (package
     (name "igt-gpu-tools")
-    (version "1.25")
+    (version "1.26")
     (source
      (origin
        (method git-fetch)
@@ -3314,7 +3535,7 @@ buffers.")
              (commit (string-append "igt-gpu-tools-" version))))
        (file-name (git-file-name name version))
        (sha256
-        (base32 "1lvhkdhilw0fn4nzkpfwvrhiv8d92h811qs2v6ac3p5w7v86a9zm"))))
+        (base32 "0m124pqv7zna25jnvk566c4kk628jr0w8mgnp8mr5xqz9cprgczm"))))
     (build-system meson-build-system)
     (arguments
      `(#:tests? #f))            ; many of the tests try to load kernel modules
@@ -3344,52 +3565,6 @@ Intel DRM Driver.")
     (supported-systems '("i686-linux" "x86_64-linux"))
     (license license:expat)))
 
-(define-public fabric
-  (package
-    (name "fabric")
-    (version "1.14.1")
-    (source
-     (origin
-       (method url-fetch)
-       (uri (pypi-uri "Fabric" version))
-       (sha256
-        (base32
-         "1a3ndlpdw6bhn8fcw1jgznl117a8pnr84az9rb5fwnrypf1ph2b6"))))
-    (build-system python-build-system)
-    (arguments
-     `(#:python ,python-2               ; Python 2 only
-       #:phases
-       (modify-phases %standard-phases
-         (replace 'check
-           (lambda _
-             (invoke
-              "nosetests" "-v" "tests/"
-              ;; This test hangs indefinitely when run on a single core VM
-              ;; (see GNU bug #26647 and Debian bug #850230).
-              "--exclude=test_nested_execution_with_explicit_ports"
-              ;; This test randomly fails in certain environments causing too
-              ;; much noise to be useful (see Debian bug #854686).
-              "--exclude=test_should_use_sentinel_for_tasks_that_errored"))))))
-    (native-inputs
-     `(("python2-fudge" ,python2-fudge) ; Requires < 1.0
-       ("python2-jinja2" ,python2-jinja2) ; Requires < 3.0
-       ("python2-nose" ,python2-nose) ; Requires < 2.0
-       ("python2-pynacl" ,python2-pynacl)
-       ("python2-bcrypt" ,python2-bcrypt)))
-    (propagated-inputs
-     `(("python2-paramiko" ,python2-paramiko)))
-    (home-page "https://www.fabfile.org/")
-    (synopsis "Simple Pythonic remote execution and deployment tool")
-    (description
-     "Fabric is designed to upload files and run shell commands on a number of
-servers in parallel or serially.  These commands are grouped in tasks (which
-are regular Python functions) and specified in a @dfn{fabfile}.
-
-It is similar to Capistrano, except it's implemented in Python and doesn't
-expect you to be deploying Rails applications.  Fabric is a simple, Pythonic
-tool for remote execution and deployment.")
-    (license license:bsd-2)))
-
 (define-public neofetch
   (package
     (name "neofetch")
@@ -3567,14 +3742,14 @@ information tool.")
 (define-public nnn
   (package
     (name "nnn")
-    (version "3.6")
+    (version "4.1.1")
     (source
      (origin
        (method url-fetch)
        (uri (string-append "https://github.com/jarun/nnn/releases/download/v"
                            version "/nnn-v" version ".tar.gz"))
        (sha256
-        (base32 "1dbq16cdipij5ws59ab3alfmxli7n4wx28ip7gsyq8ncxg598l47"))))
+        (base32 "1fnf35s3b2nfp18s712n5vhg6idx4rfgwdfv74nc2933v9l2dq7h"))))
     (build-system gnu-build-system)
     (inputs
      `(("ncurses" ,ncurses)
@@ -3585,33 +3760,26 @@ information tool.")
      `(#:tests? #f                      ; no tests
        #:phases
        (modify-phases %standard-phases
-         (delete 'configure)            ; no configure script
+         (delete 'configure))           ; no configure script
-         (add-after 'unpack 'patch-pkg-config
-           (lambda _
-             (substitute* "Makefile"
-               (("pkg-config")
-                (or (which "pkg-config")
-                    (string-append ,(%current-target-system)
-                                   "-pkg-config"))))
-             #t)))
        #:make-flags
        (list
         (string-append "PREFIX="
                        (assoc-ref %outputs "out"))
-        (string-append "CC=" ,(cc-for-target)))))
+        (string-append "CC=" ,(cc-for-target))
+        (string-append "PKG_CONFIG=" ,(pkg-config-for-target)))))
     (home-page "https://github.com/jarun/nnn")
     (synopsis "Terminal file browser")
-    (description "@command{nnn} is a fork of @command{noice}, a blazing-fast
+    (description
-lightweight terminal file browser with easy keyboard shortcuts for
+     "@command{nnn} is a fork of @command{noice}, a fast and minimal text
-navigation, opening files and running tasks.  There is no config file and
+terminal file browser with keyboard shortcuts for navigation, opening files and
-mime associations are hard-coded.  The incredible user-friendliness and speed
+running tasks.  There is no configuration file and MIME associations are
-make it a perfect utility on modern distros.")
+hard-coded.")
     (license license:bsd-2)))
 
 (define-public thermald
   (package
     (name "thermald")
-    (version "2.4.3")
+    (version "2.4.6")
     (source
      (origin
       (method git-fetch)
@@ -3620,7 +3788,7 @@ make it a perfect utility on modern distros.")
              (commit (string-append "v" version))))
       (file-name (git-file-name name version))
       (sha256
-       (base32 "1ibihgpmx038xci0k2h471scs5ssn7z5kcvjrfz63qf2ppdf9yh8"))))
+       (base32 "1lgaky8cmxbi17zpymy2v9wgknx1g92bq50j6kfpsm8qgb7djjb6"))))
     (build-system gnu-build-system)
     (arguments
      `(#:configure-flags
@@ -3634,13 +3802,7 @@ make it a perfect utility on modern distros.")
        (modify-phases %standard-phases
          (add-before 'bootstrap 'no-early-./configure
            (lambda _
-             (setenv "NO_CONFIGURE" "yet")
+             (setenv "NO_CONFIGURE" "yet"))))))
-             ;; XXX thd_trip_point.h redefines "__STDC_LIMIT_MACROS" after
-             ;; <xz>/include/lzma.h.  ./configure forcibly appends -Werror
-             ;; to CXXFLAGS, overriding any -Wno-error we'd add.
-             (substitute* "configure.ac"
-               (("-Werror") ""))
-             #t)))))
     (native-inputs
      `(("autoconf" ,autoconf)
        ("autoconf-archive" ,autoconf-archive)
@@ -3809,7 +3971,7 @@ Python loading in HPC environments.")
   (let ((real-name "inxi"))
     (package
       (name "inxi-minimal")
-      (version "3.3.03-1")
+      (version "3.3.06-1")
       (source
        (origin
          (method git-fetch)
@@ -3818,7 +3980,7 @@ Python loading in HPC environments.")
                (commit version)))
          (file-name (git-file-name real-name version))
          (sha256
-          (base32 "1pahns10i5farw47v9v8cykrk5arq8218vpsa8c0bmaia0rf2n1q"))))
+          (base32 "1qk40iyrdp52vmbiqwxicvlcycm2v2bf1gg4lzq0b4619sd6d1m7"))))
       (build-system trivial-build-system)
       (inputs
        `(("bash" ,bash-minimal)
@@ -4019,7 +4181,7 @@ cache of unix and unix-like systems.")
 (define-public solaar
   (package
     (name "solaar")
-    (version "1.0.5")
+    (version "1.0.6")
     (source (origin
               (method git-fetch)
               (uri (git-reference
@@ -4028,7 +4190,7 @@ cache of unix and unix-like systems.")
               (file-name (git-file-name name version))
               (sha256
                (base32
-                "17gkr2lf1kzp1198gcdr30j3c8xd81kg7ly12aar1jrgi6lc7klk"))))
+                "04zclzfc31l2fj5shcsngnmcvcmmhnc567l3wb9yfhs8k39k9kb2"))))
     (build-system python-build-system)
     (arguments
      `(#:phases
@@ -4057,7 +4219,7 @@ Logitech Unifying Receiver.")
   (package
     (name "lynis")
     ;; Also update the ‘lynis-sdk’ input to the commit matching this release.
-    (version "3.0.3")
+    (version "3.0.5")
     (source
      (origin
        (method git-fetch)
@@ -4066,7 +4228,7 @@ Logitech Unifying Receiver.")
              (commit version)))
        (file-name (git-file-name name version))
        (sha256
-        (base32 "0sdjh2f1563qalp740vkaaxdxl56ny98h168cggpm10h2yq366gr"))
+        (base32 "11kl54hbvjl7q2i1jz8a726vlkdmknvbp4zac3j4fgljg27qp410"))
        (modules '((guix build utils)))
        (snippet
         '(begin
@@ -4083,10 +4245,10 @@ Logitech Unifying Receiver.")
            (method git-fetch)
            (uri (git-reference
                  (url "https://github.com/CISOfy/lynis-sdk")
-                 (commit "ea7a39774fbd71113a1955cf1a4937b489935174")))
+                 (commit "99f79c4deb4cb2221d7fccfe82baf58c0a55b9e7")))
            (file-name (git-file-name "lynis-sdk" version))
            (sha256
-            (base32 "0q5j2myshjkz9qwvcg8n7c33yw2cp80yvzhckd60qmzabv4g4qb5"))))))
+            (base32 "1nc2rhzj6l08d2mnjrzkm4mxla1mjkddcxl8n05c1kdz9ycn6cpl"))))))
     (arguments
      `(#:phases
        (modify-phases %standard-phases
@@ -4253,7 +4415,7 @@ file-types for easier parsing in scripts.")
 (define-public jtbl
   (package
     (name "jtbl")
-    (version "1.1.6")
+    (version "1.1.7")
     (source (origin
               (method git-fetch)
               (uri (git-reference
@@ -4262,7 +4424,7 @@ file-types for easier parsing in scripts.")
               (file-name (git-file-name name version))
               (sha256
                (base32
-                "1zzd7rd63xva50f22d1rfja4r302aizrafarhwm67vv181swvdya"))))
+                "19i21fqz2m40cds9pb17brjxkczqagmx2f7mfb0xdvbygaply5wz"))))
     (build-system python-build-system)
     (inputs
      `(("python-tabulate" ,python-tabulate)))
@@ -4391,14 +4553,14 @@ Netgear devices.")
 (define-public atop
   (package
     (name "atop")
-    (version "2.5.0")
+    (version "2.6.0")
     (source (origin
               (method url-fetch)
               (uri (string-append "https://www.atoptool.nl/download/atop-"
                                   version ".tar.gz"))
               (sha256
                (base32
-                "0crzz4i2nabyh7d6xg7fvl65qls87nbca5ihidp3nijhrrbi14ab"))))
+                "0wlg0n0h9vwpjp2dcb623jvvqck422jrjpq9mbpzg4hnawxcmhly"))))
     (build-system gnu-build-system)
     (arguments
      `(#:tests? #f ; no test suite
@@ -4590,3 +4752,49 @@ the XMODEM/YMODEM/ZMODEM file transfer protocols.")
 setup, maintenance, supervision, or any long-running processes.")
     (home-page "https://github.com/leahneukirchen/nq")
     (license license:public-domain)))
+
+(define-public lsofgraph
+  (let ((commit "1d414bdc727c00a8c6cbfffc3c43128c60d6f0de")
+        (revision "1"))
+    (package
+      (name "lsofgraph")
+      (version (git-version "0.0.1" revision commit)) ;no upstream release
+      (source (origin
+                (method git-fetch)
+                (uri (git-reference
+                      (url "https://github.com/zevv/lsofgraph")
+                      (commit commit)))
+                (file-name (git-file-name name version))
+                (sha256
+                 (base32
+                  "058x04yp6bc77hbl3qchqm7pa8f9vqfl9jryr88m8pzl7kvpif54"))))
+      (build-system trivial-build-system)
+      (inputs
+       `(("lua" ,lua)))
+      (arguments
+       `(#:modules ((guix build utils))
+         #:builder
+         (begin
+           (use-modules (guix build utils))
+           ;; copy source
+           (copy-recursively (assoc-ref %build-inputs "source") ".")
+           ;; patch-shebang phase
+           (setenv "PATH"
+                   (string-append (assoc-ref %build-inputs "lua") "/bin"
+                                  ":" (getenv "PATH")))
+           (substitute* "lsofgraph"
+             (("#!/usr/bin/env lua")
+              (string-append "#!" (which "lua"))))
+           ;; install phase
+           (install-file "lsofgraph" (string-append %output "/bin"))
+           (let ((doc (string-append
+                       %output "/share/doc/" ,name "-" ,version)))
+             (mkdir-p doc)
+             (install-file "LICENSE" doc)
+             (install-file "README.md" doc))
+           #t)))
+      (home-page "https://github.com/zevv/lsofgraph")
+      (synopsis "Convert @code{lsof} output to @code{graphviz}")
+      (description "Utility to convert @code{lsof} output to a graph showing
+FIFO and UNIX interprocess communication.")
+      (license license:bsd-2))))

gnu/packages/aidc.scm

@@ -195,7 +195,7 @@ C/C++ programs to use its capabilities without restrictions or overhead.")
        ("imagemagick" ,imagemagick)
        ("libjpeg" ,libjpeg-turbo)
        ("python" ,python)
-       ("qtbase" ,qtbase)
+       ("qtbase" ,qtbase-5)
        ("qtx11extras" ,qtx11extras)
        ("v4l-utils" ,v4l-utils)))
     (synopsis "Bar code reader")

gnu/packages/algebra.scm

@@ -3,11 +3,11 @@
 ;;; Copyright © 2013, 2015, 2017, 2018, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016, 2017, 2018, 2019, 2020, 2021 Nicolas Goaziou <mail@nicolasgoaziou.fr>
 ;;; Copyright © 2014, 2018 Mark H Weaver <mhw@netris.org>
-;;; Copyright © 2016, 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2016, 2018, 2019, 2021 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2017, 2020 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2017–2021 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
-;;; Copyright © 2017, 2019 Eric Bavier <bavier@member.fsf.org>
+;;; Copyright © 2017, 2019, 2021 Eric Bavier <bavier@posteo.net>
 ;;; Copyright © 2019 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2020 Björn Höfling <bjoern.hoefling@bjoernhoefling.de>
 ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
@@ -34,6 +34,7 @@
   #:use-module (gnu packages)
   #:use-module (gnu packages autotools)
   #:use-module (gnu packages bison)
+  #:use-module (gnu packages boost)
   #:use-module (gnu packages check)
   #:use-module (gnu packages compression)
   #:use-module (gnu packages cpp)
@@ -59,6 +60,7 @@
   #:use-module (gnu packages tex)
   #:use-module (gnu packages texinfo)
   #:use-module (gnu packages xiph)
+  #:use-module (gnu packages xml)
   #:use-module (gnu packages xorg)
   #:use-module (guix build-system ant)
   #:use-module (guix build-system gnu)
@@ -76,7 +78,7 @@
 (define-public mpfrcx
   (package
    (name "mpfrcx")
-   (version "0.6")
+   (version "0.6.3")
    (source (origin
             (method url-fetch)
             (uri (string-append
@@ -84,7 +86,7 @@
                   version ".tar.gz"))
             (sha256
              (base32
-              "0gz5rma9al2jrifpknqkcnd9dkf8l05jcxy3s4ghwhd4y3h5dwia"))))
+              "1545vgizpypqi2rrriad0ybqv0qwbn9zr0ibxpk00gha9ihv7acx"))))
    (build-system gnu-build-system)
    (propagated-inputs
      `(("gmp" ,gmp)
@@ -235,7 +237,7 @@ the real span of the lattice.")
 (define-public pari-gp
   (package
     (name "pari-gp")
-    (version "2.13.1")
+    (version "2.13.2")
     (source (origin
               (method url-fetch)
               (uri (string-append
@@ -243,11 +245,11 @@ the real span of the lattice.")
                     version ".tar.gz"))
               (sha256
                (base32
-                "1cgwdpw8b797883z9y92ixxjkv72kiy65zsw2qqf5and1kbzgv41"))))
+                "095s7vdlsxmxa0n0l1a082m6gjaypqfqkaj99z8j7dx0ji89hy8n"))))
     (build-system gnu-build-system)
     (native-inputs
      `(("texlive" ,(texlive-union
-                    (list texlive-amsfonts)))))
+                    (list texlive-amsfonts/patched)))))
     (inputs `(("gmp" ,gmp)
               ("libx11" ,libx11)
               ("perl" ,perl)
@@ -341,7 +343,7 @@ precision.")
 (define-public giac
   (package
     (name "giac")
-    (version "1.7.0-1")
+    (version "1.7.0-33")
     (source
      (origin
        (method url-fetch)
@@ -353,7 +355,7 @@ precision.")
                            "~parisse/debian/dists/stable/main/source/"
                            "giac_" version ".tar.gz"))
        (sha256
-        (base32 "0s926aza2larfz02hrhdlpxn77yjlrhjg844b3fhwz11yj942p9q"))))
+        (base32 "0kz2q5vjynplbybn6j3qk11ww1dr72pqsm9gp9w2hb3h9gv4gk9w"))))
     (build-system gnu-build-system)
     (arguments
      `(#:modules ((ice-9 ftw)
@@ -366,14 +368,12 @@ precision.")
            (lambda _
              (substitute* (cons "micropython-1.12/xcas/Makefile"
                                 (find-files "doc" "^Makefile"))
-               (("/bin/cp") (which "cp")))
+               (("/bin/cp") (which "cp")))))
-             #t))
          (add-after 'unpack 'disable-failing-test
            ;; FIXME: Test failing.  Not sure why.
            (lambda _
              (substitute* "check/Makefile.in"
-               (("chk_fhan11") ""))
+               (("chk_fhan11") ""))))
-             #t))
          (add-after 'install 'fix-doc
            (lambda* (#:key outputs #:allow-other-keys)
              (let ((out (assoc-ref outputs "out")))
@@ -386,13 +386,11 @@ precision.")
                ;; Remove duplicate documentation in
                ;; "%out/share/doc/giac/", where Xcas does not expect
                ;; to find it.
-               (delete-file-recursively (string-append out "/share/doc/giac"))
+               (delete-file-recursively (string-append out "/share/doc/giac")))))
-               #t)))
          (add-after 'install 'remove-unnecessary-executable
            (lambda* (#:key outputs #:allow-other-keys)
              (let ((out (assoc-ref outputs "out")))
-               (delete-file (string-append out "/bin/xcasnew"))
+               (delete-file (string-append out "/bin/xcasnew"))))))))
-               #t))))))
     (inputs
      ;; TODO: Add libnauty, unbundle "libmicropython.a".
      `(("fltk" ,fltk)
@@ -1071,6 +1069,33 @@ features, and more.")
                        "# Do not build the tests for unsupported features.\n"))
                     #t)))))))
 
+(define-public eigen-for-tensorflow-lite
+  ;; This commit was taken from
+  ;; tensorflow/lite/tools/cmake/modules/eigen.cmake
+  (let ((commit "d10b27fe37736d2944630ecd7557cefa95cf87c9")
+        (revision "1"))
+    (package (inherit eigen)
+      (name "eigen-for-tensorflow-lite")
+      (version (git-version "3.3.7" revision commit))
+      (source (origin
+                (method git-fetch)
+                (uri (git-reference
+                      (url "https://gitlab.com/libeigen/eigen")
+                      (commit commit)))
+                (sha256
+                 (base32
+                  "0v8a20cwvwmp3hw4275b37frw33v92z0mr8f4dn6y8k0rz92hrrf"))
+                (file-name (git-file-name name version))
+                (modules '((guix build utils)))
+                (snippet
+                 ;; Ther are test failures in the "unsupported" directory, but
+                 ;; maintainers say it's unsupported anyway, so just skip
+                 ;; them.
+                 '(begin
+                    (substitute* "unsupported/CMakeLists.txt"
+                      (("add_subdirectory\\(test.*")
+                       "# Do not build the tests for unsupported features.\n")))))))))
+
 (define-public xtensor
   (package
     (name "xtensor")
@@ -1244,6 +1269,47 @@ objects.")
     ;; safe side, we drop them for now.
     (license license:gpl2+)))
 
+(define-public gappa
+  (package
+   (name "gappa")
+   (version "1.3.5")
+   (source (origin
+            (method url-fetch)
+            (uri (string-append "https://gforge.inria.fr/frs/download.php/latestfile/"
+                                "2699/gappa-" version ".tar.gz"))
+            (sha256
+             (base32
+              "0q1wdiwqj6fsbifaayb1zkp20bz8a1my81sqjsail577jmzwi07w"))))
+   (build-system gnu-build-system)
+   (inputs
+    `(("boost" ,boost)
+      ("gmp" ,gmp)
+      ("mpfr" ,mpfr)))
+   (arguments
+    `(#:phases
+      (modify-phases %standard-phases
+        (add-after 'unpack 'patch-remake-shell
+          (lambda _
+            (substitute* "remake.cpp"
+             (("/bin/sh") (which "sh")))
+            #t))
+        (replace 'build
+          (lambda _ (invoke "./remake" "-s" "-d")))
+        (replace 'install
+          (lambda _ (invoke "./remake" "-s" "-d" "install")))
+        (replace 'check
+          (lambda _ (invoke "./remake" "check"))))))
+   (home-page "http://gappa.gforge.inria.fr/")
+   (synopsis "Proof generator for arithmetic properties")
+   (description "Gappa is a tool intended to help verifying and formally
+proving properties on numerical programs dealing with floating-point or
+fixed-point arithmetic.  It has been used to write robust floating-point
+filters for CGAL and it is used to certify elementary functions in CRlibm.
+While Gappa is intended to be used directly, it can also act as a backend
+prover for the Why3 software verification platform or as an automatic tactic
+for the Coq proof assistant.")
+   (license (list license:gpl3+ license:cecill-c)))) ; either/or
+
 (define-public givaro
   (package
     (name "givaro")
@@ -1607,3 +1673,48 @@ no more than about 20 bits long).")
 (@dfn{DCT}), Discrete Sine Transform (@dfn{DST}) and Discrete Hartley Transform
 (@dfn{DHT}).")
     (license license:gpl2+)))
+
+(define-public sollya
+  (package
+   (name "sollya")
+   (version "7.0")
+   (source (origin
+            (method url-fetch)
+            (uri (string-append "https://www.sollya.org/releases/"
+                                "sollya-" version "/sollya-" version ".tar.bz2"))
+            (sha256
+             (base32
+              "11290ivi9h665cxi8f1shlavhy10vzb8s28m57hrcgnxyxqmhx0m"))))
+   (build-system gnu-build-system)
+   (inputs
+    `(("fplll" ,fplll)
+      ("gmp" ,gmp)
+      ("gnuplot" ,gnuplot)
+      ("libxml2" ,libxml2)
+      ("mpfi" ,mpfi)
+      ("mpfr" ,mpfr)))
+   (arguments
+    `(#:configure-flags
+      (list (string-append "--docdir=${datadir}/doc/sollya-" ,version))
+      #:phases
+      (modify-phases %standard-phases
+        (add-after 'unpack 'patch-test-shebang
+          (lambda _
+            (substitute* (list "tests-tool/Makefile.in"
+                               "tests-lib/Makefile.in")
+             (("#!/bin/sh") (string-append "#!" (which "sh"))))
+            #t))
+        (add-before 'build 'patch-gnuplot-reference
+          (lambda _
+            (substitute* "general.c"
+             (("\"gnuplot\"") (string-append "\"" (which "gnuplot") "\"")))
+            #t)))))
+   (home-page "https://www.sollya.org")
+   (synopsis "Development environment for safe floating-point code")
+   (description "Sollya is a computer program whose purpose is to
+provide an environment for safe floating-point code development.  It
+is particularly targeted to the automated implementation of
+mathematical floating-point libraries (libm).  Amongst other features,
+it offers a certified infinity norm, an automatic polynomial
+implementer, and a fast Remez algorithm.")
+   (license license:cecill-c)))

gnu/packages/android.scm

@@ -4,12 +4,11 @@
 ;;; Copyright © 2016, 2020 Marius Bakke <mbakke@fastmail.com>
 ;;; Copyright © 2017 Julien Lepiller <julien@lepiller.eu>
 ;;; Copyright © 2017 Hartmut Goebel <h.goebel@crazy-compilers.com>
-;;; Copyright © 2017 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2017, 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2018, 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2019, 2020 Andreas Enge <andreas@enge.fr>
 ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
-;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2020 Sergey Trofimov <sarg@sarg.org.ru>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -148,6 +147,7 @@ use their packages mostly unmodified in our Android NDK build system.")
                      "libutils-remove-damaging-includes.patch"
                      "libutils-add-includes.patch"
                      "adb-add-libraries.patch"
+                     "adb-libssl_11-compatibility.patch"
                      "libziparchive-add-includes.patch"))))
 
 (define (android-platform-system-extras version)
@@ -388,7 +388,7 @@ various Android core host applications.")
      `(("android-libbase" ,android-libbase)
        ("android-libcutils" ,android-libcutils)
        ("android-liblog" ,android-liblog)
-       ("openssl" ,openssl-1.0)))
+       ("openssl" ,openssl)))
     (home-page "https://developer.android.com/studio/command-line/adb.html")
     (synopsis "Android Debug Bridge")
     (description

gnu/packages/animation.scm

@@ -2,7 +2,7 @@
 ;;; Copyright © 2015, 2017 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2018–2021 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2019 Pkill -9 <pkill9@runbox.com>
-;;; Copyright © 2020 Vinicius Monego <monego@posteo.net>
+;;; Copyright © 2020, 2021 Vinicius Monego <monego@posteo.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -25,10 +25,12 @@
   #:use-module (guix git-download)
   #:use-module (guix utils)
   #:use-module ((guix licenses) #:prefix license:)
+  #:use-module (guix build-system cmake)
   #:use-module (guix build-system gnu)
   #:use-module (guix build-system meson)
   #:use-module (gnu packages)
   #:use-module (gnu packages algebra)
+  #:use-module (gnu packages assembly)
   #:use-module (gnu packages autotools)
   #:use-module (gnu packages boost)
   #:use-module (gnu packages check)
@@ -45,6 +47,8 @@
   #:use-module (gnu packages image)
   #:use-module (gnu packages imagemagick)
   #:use-module (gnu packages jemalloc)
+  #:use-module (gnu packages networking)
+  #:use-module (gnu packages pcre)
   #:use-module (gnu packages perl)
   #:use-module (gnu packages pkg-config)
   #:use-module (gnu packages pulseaudio)
@@ -174,7 +178,7 @@ C++ @dfn{Standard Template Library} (STL).")
        ("imagemagick" ,imagemagick)
        ("libxml++" ,libxml++)
        ("libsigc++" ,libsigc++)
-       ("mlt" ,mlt)
+       ("mlt" ,mlt-6)
        ("openexr" ,openexr)
        ("pango" ,pango)))
     (native-inputs
@@ -320,6 +324,78 @@ audio or video backends, ensuring good performance.")
       (home-page "https://www.gnu.org/software/gnash/")
       (license license:gpl3+))))
 
+;; This package provides a standalone (no browser plugin) version of
+;; Lightspark.
+(define-public lightspark
+  (package
+    (name "lightspark")
+    (version "0.8.5")
+    (source
+     (origin
+       (method git-fetch)
+       (uri (git-reference
+             (url "https://github.com/lightspark/lightspark")
+             (commit version)))
+       (file-name (git-file-name name version))
+       (sha256
+        (base32 "00535ndzjbz5xyr95cih01wlkc2mgvg60bv6amz4lnnglk0c5v0p"))))
+    (build-system cmake-build-system)
+    (arguments
+     `(#:tests? #f ;requires Adobe Flex SDK, see README.tests
+       ;; Disable browser plugins because neither NPAPI nor PPAPI is
+       ;; supported in the browsers we have.
+       #:configure-flags
+       '("-DCOMPILE_NPAPI_PLUGIN=FALSE"
+         "-DCOMPILE_PPAPI_PLUGIN=FALSE")
+       #:phases
+       (modify-phases %standard-phases
+         (add-after 'unpack 'prepare-build-environment
+           (lambda _
+             ;; Use relative etc path.
+             (substitute* "CMakeLists.txt" (("\\/etc") "etc"))))
+         (replace 'check
+           (lambda* (#:key tests? #:allow-other-keys)
+             (when tests?
+               (invoke "./tests")))))))
+    (native-inputs
+     `(("gettext" ,gettext-minimal)
+       ("glib:bin" ,glib "bin")
+       ("nasm" ,nasm)
+       ("perl" ,perl)
+       ("pkg-config" ,pkg-config)
+       ("python" ,python-wrapper)))
+    (inputs
+     `(("cairo" ,cairo)
+       ("curl" ,curl)
+       ("ffmpeg" ,ffmpeg)
+       ("freeglut" ,freeglut)
+       ("glew" ,glew)
+       ("glibmm" ,glibmm)
+       ("gnash" ,gnash)
+       ("gnutls" ,gnutls)
+       ("libjpeg" ,libjpeg-turbo)
+       ("openssl" ,openssl)
+       ("pango" ,pango)
+       ("pcre2" ,pcre2)
+       ("rtmpdump" ,rtmpdump)
+       ("sdl2" ,sdl2)
+       ("sdl2-mixer" ,sdl2-mixer)
+       ("zlib" ,zlib)))
+    (home-page "https://lightspark.github.io/")
+    (synopsis "Flash player implementation")
+    (description
+     "Lightspark is a Flash player implementation for playing files in the SWF
+format.  It supports SWF files written on all versions of the ActionScript
+language.")
+    ;; NOTE: The bundled pugixml is a fork specific to Lightspark and
+    ;; incompatible with the one we have.
+    ;; FIXME: we also have jxrlib, but the build fails to find JXRMeta.h so we
+    ;; use the bundled one for now.
+    (license (list license:lgpl3+ ;lightspark
+                   license:mpl2.0 ;avmplus
+                   license:bsd-2 ;jxrlib
+                   license:expat)))) ;pugixml, PerlinNoise
+
 (define-public papagayo
   (let ((commit "e143684b30e59fe4a554f965cb655d23cbe93ee7")
         (revision "1"))
@@ -374,7 +450,7 @@ audio or video backends, ensuring good performance.")
                            qt)))
                  #t))))))
       (inputs
-       `(("qt" ,qtbase)
+       `(("qt" ,qtbase-5)
          ("qtmultimedia" ,qtmultimedia)
          ("libsndfile" ,libsndfile)))
       (native-inputs
@@ -404,7 +480,7 @@ waveform until they line up with the proper sounds.")
                 "0b1nwiwyg01087q318vymg4si76dw41ykxbn2zwd6dqbxzbpr1dh"))))
     (build-system gnu-build-system)
     (inputs
-     `(("qtbase" ,qtbase)
+     `(("qtbase" ,qtbase-5)
        ("qtxmlpatterns" ,qtxmlpatterns)
        ("qtmultimedia" ,qtmultimedia)
        ("qtsvg" ,qtsvg)))

gnu/packages/antivirus.scm

@@ -44,14 +44,14 @@
 (define-public clamav
   (package
     (name "clamav")
-    (version "0.103.2")
+    (version "0.103.3")
     (source (origin
               (method url-fetch)
               (uri (string-append "https://www.clamav.net/downloads/production/"
                                   "clamav-" version ".tar.gz"))
               (sha256
                (base32
-                "1lhv4xw89sszi519agvc9mi6jz5aiivm9yr6lciy8qk2csnd1dfl"))
+                "1sba4zccgwjqk29b5qkgfc9gm794hmk6j7bpj8wilgcz8hc3svlz"))
               (modules '((guix build utils)))
               (snippet
                '(begin

gnu/packages/aspell.scm

@@ -12,6 +12,7 @@
 ;;; Copyright © 2020 Jonathan Brielmaier <jonathan.brielmaier@web.de>
 ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
 ;;; Copyright © 2020 Noah Landis <noahlandis@posteo.net>
+;;; Copyright © 2021 Sergiu Ivanov <sivanov@colimite.fr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -202,10 +203,10 @@ dictionaries, including personal ones.")
 
 (define-public aspell-dict-en
   (aspell-dictionary "en" "English"
-                     #:version "2019.10.06-0"
+                     #:version "2020.12.07-0"
                      #:sha256
                      (base32
-                      "1zai9wrqwgb9z9vfgb22qhrvxvg73jg0ix44j1khm2f6m96lncr4")))
+                      "1cwzqkm8gr1w51rpckwlvb43sb0b5nbwy7s8ns5vi250515773sc")))
 
 (define-public aspell-dict-eo
   (aspell-dictionary "eo" "Esperanto"
@@ -356,6 +357,14 @@ dictionaries, including personal ones.")
                      (base32
                       "137i4njvnslab6l4s291s11xijr5jsy75lbdph32f9y183lagy9m")))
 
+(define-public aspell-dict-ro
+  (aspell-dictionary "ro" "Romanian"
+                     #:version "3.3-2"
+                     #:prefix "aspell5-"
+                     #:sha256
+                     (base32
+                      "0gb8j9iy1acdl11jq76idgc2lbc1rq3w04favn8cyh55d1v8phsk")))
+
 
 ;;;
 ;;; Hunspell packages made from the Aspell word lists.
@@ -388,6 +397,10 @@ dictionaries, including personal ones.")
     (arguments
      `(#:phases
        (modify-phases %standard-phases
+         (add-after 'unpack 'make-reproducible
+           (lambda _
+             (substitute* "speller/README_en.txt.sh"
+               (("\\bdate\\b") ""))))
          (delete 'configure)
          (delete 'check)
          (replace 'build
@@ -476,14 +489,14 @@ under permissive licensing terms.  See the 'Copyright' file."))))
 (define-public ispell
   (package
     (name "ispell")
-    (version "3.4.02")
+    (version "3.4.04")
     (source
      (origin
        (method url-fetch)
        (uri (string-append "https://www.cs.hmc.edu/~geoff/tars/ispell-"
                            version ".tar.gz"))
        (sha256
-        (base32 "0b6rqzqjdhwf323sf1dv8qzx5pxa5asz618922r59zjp65660yb6"))))
+        (base32 "0gp1rwn8grkvz28wgisc2j9w9svldnaiahl3lyis118xabqddg47"))))
     (build-system gnu-build-system)
     (arguments
      `(#:parallel-build? #f

gnu/packages/assembly.scm

@@ -7,7 +7,7 @@
 ;;; Copyright © 2019 Guy Fleury Iteriteka <hoonandon@gmail.com>
 ;;; Copyright © 2019 Andy Tai <atai@atai.org>
 ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
-;;; Copyright © 2020 Christopher Lemmer Webber <cwebber@dustycloud.org>
+;;; Copyright © 2020 Christine Lemmer-Webber <cwebber@dustycloud.org>
 ;;; Copyright © 2020 B. Wilson <elaexuotee@wilsonb.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -228,7 +228,7 @@ It has macro abilities and focuses on operating system portability.")
     (build-system gnu-build-system)
     (arguments
      `(#:parallel-build? #f ; They use submakes wrong
-       #:make-flags (list "CC=gcc"
+       #:make-flags (list ,(string-append "CC=" (cc-for-target))
                           (string-append "PREFIX="
                                          (assoc-ref %outputs "out")))
        #:system "i686-linux" ; Standalone ld86 had problems otherwise

gnu/packages/astronomy.scm

@@ -4,7 +4,7 @@
 ;;; Copyright © 2018, 2019, 2020, 2021 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2019 by Amar Singh <nly@disroot.org>
 ;;; Copyright © 2020 R Veera Kumar <vkor@vkten.in>
-;;; Copyright © 2020 Guillaume Le Vaillant <glv@posteo.net>
+;;; Copyright © 2020, 2021 Guillaume Le Vaillant <glv@posteo.net>
 ;;; Copyright © 2021 Sharlatan Hellseher <sharlatanus@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -228,7 +228,7 @@ astronomical image-processing packages like Drizzle, Swarp or SExtractor.")
 (define-public gnuastro
   (package
     (name "gnuastro")
-    (version "0.14")
+    (version "0.15")
     (source
      (origin
        (method url-fetch)
@@ -236,7 +236,7 @@ astronomical image-processing packages like Drizzle, Swarp or SExtractor.")
                            version ".tar.lz"))
        (sha256
         (base32
-         "1xp6n42qxv0x6yigi2w2l5k8006smv27lhrcssysgsvzbydghzg5"))))
+         "1jjr3ixxbpsr5m4s7ahh12ymcnlvjzwcp02ya16b1lvzrz1wmhy4"))))
     (build-system gnu-build-system)
     (arguments
      '(#:configure-flags '("--disable-static")))
@@ -401,7 +401,7 @@ deconvolution).  Such post-processing is not performed by Stackistry.")
 (define-public stellarium
   (package
     (name "stellarium")
-    (version "0.21.0")
+    (version "0.21.1")
     (source
      (origin
        (method url-fetch)
@@ -409,10 +409,10 @@ deconvolution).  Such post-processing is not performed by Stackistry.")
                            "/releases/download/v" version
                            "/stellarium-" version ".tar.gz"))
        (sha256
-        (base32 "04vg2asj9gygwnrs32scqc8192ln2lyqa9v7cjqk8zd4frkwszwp"))))
+        (base32 "049jlc8vx06pad5h2syrmf7f1l346yr5iraai0wkn8s8pk30j8q7"))))
     (build-system cmake-build-system)
     (inputs
-     `(("qtbase" ,qtbase)
+     `(("qtbase" ,qtbase-5)
        ("qtlocation" ,qtlocation)
        ("qtmultimedia" ,qtmultimedia)
        ("qtscript" ,qtscript)
@@ -421,7 +421,7 @@ deconvolution).  Such post-processing is not performed by Stackistry.")
     (native-inputs
      `(("gettext" ,gettext-minimal)     ; xgettext is used at compile time
        ("perl" ,perl)                   ; for pod2man
-       ("qtbase" ,qtbase)               ; Qt MOC is needed at compile time
+       ("qtbase" ,qtbase-5)               ; Qt MOC is needed at compile time
        ("qttools" ,qttools)))
     (arguments
      `(#:test-target "test"
@@ -792,10 +792,43 @@ provide you with detailed information about each pass.")
     (home-page "http://gpredict.oz9aec.net/index.php")
     (license license:gpl2+)))
 
+(define-public sgp4
+  ;; No tagged releases, use commit directly.
+  (let ((commit "ca9d4d97af4ee62461de6f13e0c85d1dc6000040")
+        (revision "1"))
+    (package
+      (name "sgp4")
+      (version (git-version "0.0.0" revision commit))
+      (source
+       (origin
+         (method git-fetch)
+         (uri (git-reference
+               (url "https://github.com/dnwrnr/sgp4")
+               (commit commit)))
+         (file-name (git-file-name name version))
+         (sha256
+          (base32 "1xwfa6papmd2qz5w0hwzvijmzvp9np8dlw3q3qz4bmsippzjv8p7"))))
+      (build-system cmake-build-system)
+      (arguments
+       `(#:phases
+         (modify-phases %standard-phases
+           (replace 'check
+             (lambda _
+               ;; Tests fails, probably because of a few "(e <= -0.001)" errors.
+               ;; Or maybe this is not the right way to run the tests?
+               ;; (invoke "runtest/runtest")
+               #t)))))
+      (home-page "https://github.com/dnwrnr/sgp4")
+      (synopsis "Simplified perturbations models library")
+      (description
+       "This is a library implementing the simplified perturbations model.
+It can be used to calculate the trajectory of satellites.")
+      (license license:asl2.0))))
+
 (define-public indi
   (package
     (name "indi")
-    (version "1.8.9")
+    (version "1.9.1")
     (source
      (origin
        (method git-fetch)
@@ -804,7 +837,7 @@ provide you with detailed information about each pass.")
              (commit (string-append "v" version))))
        (file-name (git-file-name name version))
        (sha256
-        (base32 "0nw4b2cdsg244slcm3yf1v11jlxbbjrpvi6ax90svs7rlandz8jv"))))
+        (base32 "0zhsm60hgnmy9lvwckijf6f6yikbvdbxy2qlgclv09p14lgr6wd9"))))
     (build-system cmake-build-system)
     (arguments
      `(#:configure-flags
@@ -816,17 +849,15 @@ provide you with detailed information about each pass.")
           (string-append "-DUDEVRULES_INSTALL_DIR=" out "/lib/udev/rules.d")))
        #:phases
        (modify-phases %standard-phases
-         (replace  'check
+         (replace 'check
-           (lambda _
+           (lambda* (#:key tests? #:allow-other-keys)
-             (chdir "test")
+             (when tests?
-             (invoke "ctest")
+               (with-directory-excursion "test"
-             (chdir "..")
+                 (invoke "ctest")))))
-             #t))
          (add-before 'install 'set-install-directories
            (lambda* (#:key outputs #:allow-other-keys)
              (let ((out (assoc-ref outputs "out")))
-               (mkdir-p (string-append out "/lib/udev/rules.d")))
+               (mkdir-p (string-append out "/lib/udev/rules.d"))))))))
-             #t)))))
     (native-inputs
      `(("googletest" ,googletest)))
     (inputs
@@ -887,13 +918,13 @@ JPL ephemerides use to predict raw (x,y,z) planetary positions.")
 (define-public python-pyerfa
   (package
     (name "python-pyerfa")
-    (version "1.7.2")
+    (version "1.7.3")
     (source
      (origin
        (method url-fetch)
        (uri (pypi-uri "pyerfa" version))
        (sha256
-        (base32 "1s78mdyrxha2jcckfs0wg5ynkf0pwh1bw9mmh99vprinxh9n4xri"))
+        (base32 "1jqqrxvrgly4r0br5f6dsy8nab2xmhz915vp6md5f31ysr2sdwvc"))
        (modules '((guix build utils)))
        (snippet
         '(begin
@@ -953,13 +984,13 @@ of stand-alone functions and classes.")
 (define-public python-asdf
   (package
     (name "python-asdf")
-    (version "2.7.2")
+    (version "2.7.4")
     (source
      (origin
        (method url-fetch)
        (uri (pypi-uri "asdf" version))
        (sha256
-        (base32 "1y47zhkd90i8wmm2i35amfl0rvjqlb3fcx90xp7n9kr2z0byzyzg"))))
+        (base32 "1mj52l2m8pbhiqacgjakjpvqi8kyx470yw151lcsswbq5wp0rsc6"))))
     (build-system python-build-system)
     (arguments
      ;; TODO: (Sharlatan-20210207T165820+0000): Tests depend on astropy, astropy
@@ -1011,23 +1042,23 @@ astronomical images, especially when there is no WCS information available.")
 (define-public python-skyfield
   (package
     (name "python-skyfield")
-    (version "1.38")
+    (version "1.39")
     (source
      (origin
        (method url-fetch)
        (uri (pypi-uri "skyfield" version))
        (sha256
-        (base32 "1qi1l8qn6irdv6w41qq30s2yjwak7h6ayywr1pry9gwcm2c25bv5"))))
+        (base32 "1qh3k7g9dm6idppk87hnwxpx9a22xx98vav0zk31p6291drak3as"))))
     (build-system python-build-system)
     (arguments
      ;; NOTE: (Sharlatan-20210207T163305+0000): tests depend on custom test
      ;; framework https://github.com/brandon-rhodes/assay
      `(#:tests? #f))
     (inputs
-     `(("certifi" ,python-certifi)
+     `(("python-certifi" ,python-certifi)
-       ("jplephem" ,python-jplephem)
+       ("python-jplephem" ,python-jplephem)
-       ("numpy" ,python-numpy)
+       ("python-numpy" ,python-numpy)
-       ("sgp4" ,python-sgp4)))
+       ("python-sgp4" ,python-sgp4)))
     (home-page "https://rhodesmill.org/skyfield/")
     (synopsis "Astronomy for Python")
     (description

gnu/packages/audio.scm

@@ -21,18 +21,18 @@
 ;;; Copyright © 2019, 2021 Pierre Langlois <pierre.langlois@gmx.com>
 ;;; Copyright © 2019, 2021 Leo Famulari <leo@famulari.name>
 ;;; Copyright © 2019 Rutger Helling <rhelling@mykolab.com>
-;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2019, 2021 Arun Isaac <arunisaac@systemreboot.net>
 ;;; Copyright © 2019 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2019, 2020 Alexandros Theodotou <alex@zrythm.org>
-;;; Copyright © 2019 Christopher Lemmer Webber <cwebber@dustycloud.org>
+;;; Copyright © 2019 Christine Lemmer-Webber <cwebber@dustycloud.org>
 ;;; Copyright © 2019 Jan Wielkiewicz <tona_kosmicznego_smiecia@interia.pl>
 ;;; Copyright © 2019 Hartmt Goebel <h.goebel@crazy-compilers.com>
 ;;; Copyright © 2019, 2021 Nicolas Goaziou <mail@nicolasgoaziou.fr>
 ;;; Copyright © 2020 Vincent Legoll <vincent.legoll@gmail.com>
-;;; Copyright © 2020 Guillaume Le Vaillant <glv@posteo.net>
+;;; Copyright © 2020, 2021 Guillaume Le Vaillant <glv@posteo.net>
 ;;; Copyright © 2020 Jonathan Frederickson <jonathan@terracrypt.net>
 ;;; Copyright © 2020 Giacomo Leidi <goodoldpaul@autistici.org>
-;;; Copyright © 2020 Vinicius Monego <monego@posteo.net>
+;;; Copyright © 2020, 2021 Vinicius Monego <monego@posteo.net>
 ;;; Copyright © 2020 Michael Rohleder <mike@rohleder.de>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -78,12 +78,14 @@
   #:use-module (gnu packages gnome)
   #:use-module (gnu packages gnunet) ; libmicrohttpd
   #:use-module (gnu packages gperf)
+  #:use-module (gnu packages groff)
   #:use-module (gnu packages gstreamer)
   #:use-module (gnu packages gtk)
   #:use-module (gnu packages guile)
   #:use-module (gnu packages icu4c)
   #:use-module (gnu packages image)
   #:use-module (gnu packages libbsd)
+  #:use-module (gnu packages libffi)
   #:use-module (gnu packages libusb)
   #:use-module (gnu packages linux)
   #:use-module (gnu packages llvm)
@@ -107,6 +109,7 @@
   #:use-module (gnu packages serialization)
   #:use-module (gnu packages telephony)
   #:use-module (gnu packages linphone)
+  #:use-module (gnu packages linux)
   #:use-module (gnu packages tls)
   #:use-module (gnu packages valgrind)
   #:use-module (gnu packages video)
@@ -302,7 +305,7 @@ Linux kernel.")
 (define-public libopenmpt
   (package
     (name "libopenmpt")
-    (version "0.5.4")
+    (version "0.5.9")
     (source
      (origin
        (method url-fetch)
@@ -310,7 +313,7 @@ Linux kernel.")
         (string-append "https://download.openmpt.org/archive/libopenmpt/src/"
                        "libopenmpt-" version "+release.autotools.tar.gz"))
        (sha256
-        (base32 "0h7gpjx1221jwsq3k91p8zhf1h77qaxyasakc88s3g57vawhckgk"))))
+        (base32 "0h86p8mnpm98vc4v6jbvrmm02fch7dnn332i26fg3a2s1738m04d"))))
     (build-system gnu-build-system)
     (arguments
      `(#:configure-flags
@@ -407,7 +410,7 @@ by MusicIP.")
 (define-public libtimidity
   (package
     (name "libtimidity")
-    (version "0.2.6")
+    (version "0.2.7")
     (source
      (origin
        (method url-fetch)
@@ -415,7 +418,7 @@ by MusicIP.")
         (string-append "https://sourceforge.net/projects/" name "/files/"
                        name "/" version "/" name "-" version ".tar.gz"))
        (sha256
-        (base32 "0p2px0m907gi1zpdr0l9adq25jl89j85c11ag9s2g4yc6n1nhgfm"))))
+        (base32 "0sif6lxa058b1mg19zwjm8rl2sg8cg0443k4dgi65clz0jy7qi16"))))
     (build-system gnu-build-system)
     (arguments
      `(#:tests? #f))       ; XXX: LibTiMidity could not be initialised
@@ -495,7 +498,7 @@ implementation of Adaptive Multi Rate Narrowband and Wideband
        ("jack" ,jack-1)
        ("ladspa" ,ladspa)
        ("liblo" ,liblo)
-       ("qtbase" ,qtbase)))
+       ("qtbase" ,qtbase-5)))
     (native-inputs
      `(("pkg-config" ,pkg-config)
        ("qttools" ,qttools)))
@@ -568,7 +571,7 @@ streams from live audio.")
 (define-public ardour
   (package
     (name "ardour")
-    (version "6.6")
+    (version "6.8")
     (source (origin
               (method git-fetch)
               (uri (git-reference
@@ -586,7 +589,7 @@ namespace ARDOUR { const char* revision = \"" version "\" ; const char* date = \
                     #t)))
               (sha256
                (base32
-                "0k5rxh8b3d8si3lj01gfqj0pmd448d8sj4asnb205mwhwbfgn0cp"))
+                "16x7bkzbrk0rgywq5vrkhf2z3jj08jw1bvaq9vwlf2b4h4sd7i4s"))
               (file-name (string-append name "-" version))))
     (build-system waf-build-system)
     (arguments
@@ -981,21 +984,18 @@ tools (analyzer, mono/stereo tools, crossovers).")
 (define-public caps-plugins-lv2
   (package
     (name "caps-plugins-lv2")
-    (version "0.9.24") ; version that has been ported.
+    (version "0.9.26")
     (source
      (origin
        ;; The Github project hasn't tagged a release.
        (method git-fetch)
        (uri (git-reference
-             ;; Actually https://github.com/moddevices/caps-lv2.git, but it's
+             (url "https://github.com/moddevices/caps-lv2.git")
-             ;; missing fixes for newer glibc, so using the origin of a pull
+             (commit "5d52a0c6e8863c058c2aab2dea9f901a90d96eb9")))
-             ;; request regarding this issue:
-             (url "https://github.com/jujudusud/caps-lv2")
-             (commit "9c9478b7fbd8f9714f552ebe2a6866398b0babfb")))
        (file-name (git-file-name name version))
        (sha256
         (base32
-         "1idfnazin3cca41zw1a8vwgnxjnkrap7bxxjamjqvgpmvydgcam1"))))
+         "0hdl7n3ra5gqgwkdfqkw8dj9gb1cgb76bn1v91w06d2w4lj9s8xa"))))
     (build-system gnu-build-system)
     (arguments
      `(#:tests? #f ; no check target
@@ -1022,7 +1022,7 @@ generators of mostly elementary and occasionally exotic nature.")
 (define-public infamous-plugins
   (package
     (name "infamous-plugins")
-    (version "0.2.04")
+    (version "0.3.0")
     (source (origin
               (method git-fetch)
               (uri (git-reference
@@ -1031,7 +1031,7 @@ generators of mostly elementary and occasionally exotic nature.")
               (file-name (git-file-name name version))
               (sha256
                (base32
-                "0hmqk80w4qxq09iag7b7srf2g0wigkyhzq0ywxvhz2iz0hq9k0dh"))))
+                "1r72agk5nxf5k0mghcc2j90z43j5d9i7rqjmf49jfyqnd443isip"))))
     (build-system cmake-build-system)
     (arguments
      `(#:tests? #f                      ; there are no tests
@@ -1041,6 +1041,12 @@ generators of mostly elementary and occasionally exotic nature.")
            (lambda _
              (substitute* (find-files "." "CMakeLists.txt")
                (("-msse2 -mfpmath=sse") ""))
+             #t))
+         (add-after 'unpack 'fix-build-with-newer-lv2
+           (lambda _
+             ;; https://github.com/ssj71/infamousPlugins/commit/4c7275b1fa8ea3296446421cbd29ec2df66588c0
+             (substitute* (find-files "src" ".*\\.cxx")
+               (("_LV2UI_Descriptor") "LV2UI_Descriptor"))
              #t)))))
     (inputs
      `(("cairo" ,cairo)
@@ -2141,7 +2147,7 @@ synchronous execution of all clients, and low latency operation.")
        ("gtk2" ,gtk+-2)
        ("gtk3" ,gtk+)
        ("gtkmm" ,gtkmm-2)
-       ("qtbase" ,qtbase)
+       ("qtbase" ,qtbase-5)
        ("jack" ,jack-1)))
     (native-inputs
      `(("pkg-config" ,pkg-config)))
@@ -2339,6 +2345,18 @@ implementation of the Open Sound Control (@dfn{OSC}) protocol.")
        (sha256
         (base32 "156c2dgh6jrsyfn1y89nslvaxm4yifmxridsb708yvkaym02w2l8"))))
     (build-system cmake-build-system)
+    (arguments
+     `(#:phases
+       (modify-phases %standard-phases
+         ;; The header that pkg-config expects is include/rtaudio/RtAudio.h,
+         ;; but this package installs it as include/RtAudio.h by default.
+         (add-after 'install 'fix-inc-path
+           (lambda* (#:key outputs #:allow-other-keys)
+             (let* ((out (assoc-ref outputs "out"))
+                    (inc (string-append out "/include")))
+               (mkdir-p (string-append inc "/rtaudio"))
+               (rename-file (string-append inc "/RtAudio.h")
+                            (string-append inc "/rtaudio/RtAudio.h"))))))))
     (native-inputs
      `(("pkg-config" ,pkg-config)))
     (inputs
@@ -2419,6 +2437,99 @@ included are the command line utilities @code{send_osc} and @code{dump_osc}.")
 (define-public python2-pyliblo
   (package-with-python2 python-pyliblo))
 
+(define-public python-soundfile
+  (package
+    (name "python-soundfile")
+    (version "0.10.3.post1")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (pypi-uri "SoundFile" version))
+       (sha256
+        (base32
+         "0yqhrfz7xkvqrwdxdx2ydy4h467sk7z3gf984y1x2cq7cm1gy329"))))
+    (build-system python-build-system)
+    (propagated-inputs
+     `(("python-cffi" ,python-cffi)
+       ("python-numpy" ,python-numpy)
+       ("libsndfile" ,libsndfile)))
+    (native-inputs
+     `(("python-pytest" ,python-pytest)))
+    (arguments
+     `(#:tests? #f ; missing OGG support
+       #:phases
+       (modify-phases %standard-phases
+         (add-after 'unpack 'patch
+           (lambda* (#:key inputs #:allow-other-keys)
+             (substitute* "soundfile.py"
+               (("_find_library\\('sndfile'\\)")
+                (string-append "\"" (assoc-ref inputs "libsndfile")
+                               "/lib/libsndfile.so\""))))))))
+    (home-page "https://github.com/bastibe/SoundFile")
+    (synopsis "Python bindings for libsndfile")
+    (description "This package provides python bindings for libsndfile based on
+CFFI and NumPy.")
+    (license license:expat)))
+
+(define-public python-python3-midi
+  (package
+    (name "python-python3-midi")
+    (version "0.2.5")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (pypi-uri "python3_midi" version))
+       (sha256
+        (base32
+         "1z9j1w7mpn3xhkcpxmqm5rvmj6nffb5rf14bv7n3sdh07nf6n7sf"))))
+    (build-system python-build-system)
+    (home-page "https://github.com/NFJones/python3-midi")
+    (synopsis "Python MIDI API")
+    (description "This package provides a python API to read and write MIDI
+files.")
+    (license license:expat)))
+
+(define-public audio-to-midi
+  (package
+    (name "audio-to-midi")
+    (version "2020.7")
+    (source
+      (origin
+        (method git-fetch)
+        (uri (git-reference
+              (url "https://github.com/NFJones/audio-to-midi")
+              (commit (string-append "v" version))))
+        (file-name (git-file-name name version))
+        (sha256
+          (base32
+            "12wf17abn3psbsg2r2lk0xdnk8n5cd5rrvjlpxjnjfhd09n7qqgm"))))
+    (build-system python-build-system)
+    (propagated-inputs
+      `(("python-cffi" ,python-cffi)
+        ("python-cython" ,python-cython)
+        ("python-numpy" ,python-numpy)
+        ("python-progressbar2" ,python-progressbar2)
+        ("python-pycparser" ,python-pycparser)
+        ("python-python3-midi" ,python-python3-midi)
+        ("python-soundfile" ,python-soundfile)))
+    (native-inputs
+     `(("libsndfile" ,libsndfile)))
+    (arguments
+     `(#:phases
+       (modify-phases %standard-phases
+         (add-after 'unpack 'fix-versions
+           (lambda _
+             (substitute* "requirements.txt" (("==") ">=")))))))
+    (home-page "https://github.com/NFJones/audio-to-midi")
+    (synopsis "Convert audio to multichannel MIDI.")
+    (description "@command{audio-to-midi} converts audio files to multichannel
+MIDI files.  It accomplishes this by performing FFTs on all channels of the
+audio data at user-specified time steps.  It then separates the resulting
+frequency analysis into equivalence classes which correspond to the twelve tone
+scale; the volume of each class being the average volume of its constituent
+frequencies.  This data is then formatted to MIDI and written to disk.")
+    (license license:expat)))
+
 (define-public lilv
   (package
     (name "lilv")
@@ -2718,22 +2829,22 @@ different audio devices such as ALSA or PulseAudio.")
 (define-public qjackctl
   (package
     (name "qjackctl")
-    (version "0.9.1")
+    (version "0.9.4")
     (source (origin
               (method url-fetch)
               (uri (string-append "mirror://sourceforge/qjackctl/qjackctl/"
                                   version "/qjackctl-" version ".tar.gz"))
               (sha256
                (base32
-                "0m72kglwwvn91dxnka4lx765p3r0bcpqw251svymxr2wxjc4rgjg"))))
+                "186rg3j67rac9ds1r7gnrib2d0smgv15cmr5gwb7v83mywcp1gzy"))))
-    (build-system gnu-build-system)
+    (build-system cmake-build-system)
     (arguments
      '(#:tests? #f))                    ; no check target
     (inputs
      `(("jack" ,jack-1)
        ("alsa-lib" ,alsa-lib)
        ("portaudio" ,portaudio)
-       ("qtbase" ,qtbase)
+       ("qtbase" ,qtbase-5)
        ("qtx11extras" ,qtx11extras)))
     (native-inputs
      `(("pkg-config" ,pkg-config)
@@ -2767,11 +2878,11 @@ into various outputs and to start, stop and configure jackd")
                      (string-append "PREFIX="
                                     (assoc-ref outputs "out"))))))))
     (native-inputs
-     `(("qtbase" ,qtbase))) ; for qmake
+     `(("qtbase" ,qtbase-5))) ; for qmake
     (inputs
      `(("jack" ,jack-1)
        ("libsndfile" ,libsndfile)
-       ("qtbase" ,qtbase)))
+       ("qtbase" ,qtbase-5)))
     (home-page "https://sourceforge.net/projects/qjackrcd/")
     (synopsis "Stereo audio recorder for JACK")
     (description "QJackRcd is a simple graphical stereo recorder for JACK
@@ -2880,7 +2991,7 @@ link REQUIRED)"))
        ("boost" ,boost)
        ("boost-sync" ,boost-sync)
        ("yaml-cpp" ,yaml-cpp)
-       ("qtbase" ,qtbase)
+       ("qtbase" ,qtbase-5)
        ("qtdeclarative" ,qtdeclarative)
        ("qtsvg" ,qtsvg)
        ("qtwebchannel" ,qtwebchannel)
@@ -3082,7 +3193,7 @@ the Turtle syntax.")
      `(("lv2" ,lv2)
        ("gtk+" ,gtk+-2)
        ("gtk+" ,gtk+)
-       ("qt" ,qtbase)))
+       ("qt" ,qtbase-5)))
     (native-inputs
      `(("pkg-config" ,pkg-config)))
     (home-page "https://drobilla.net/software/suil/")
@@ -3558,7 +3669,7 @@ interface.")
        ("pkg-config" ,pkg-config)))
     (inputs
      `(("fluidsynth" ,fluidsynth)
-       ("qtbase" ,qtbase)
+       ("qtbase" ,qtbase-5)
        ("qtx11extras" ,qtx11extras)))
     (home-page "https://qsynth.sourceforge.io")
     (synopsis "Graphical user interface for FluidSynth")
@@ -4314,7 +4425,7 @@ representations.")
 (define-public cava
   (package
     (name "cava")
-    (version "0.7.3")
+    (version "0.7.4")
     (source (origin
               (method git-fetch)
               (uri (git-reference
@@ -4323,7 +4434,7 @@ representations.")
               (file-name (git-file-name name version))
               (sha256
                (base32
-                "04j5hb29hivcbk542sfsx9m57dbnj2s6qpvy9fs488zvgjbgxrai"))))
+                "1mziklmqifhnb4kg9ia2r56r8wjn6xp40bkpf484hsgqvnrccl86"))))
     (build-system gnu-build-system)
     (native-inputs
      `(("autoconf" ,autoconf)
@@ -4466,7 +4577,7 @@ library.")
 (define-public faudio
   (package
     (name "faudio")
-    (version "21.04")
+    (version "21.09")
     (source
      (origin
        (method git-fetch)
@@ -4475,7 +4586,7 @@ library.")
              (commit version)))
        (file-name (git-file-name name version))
        (sha256
-        (base32 "1g3zp7igh4ns31sqnxddxqhgibijngkbcqqsj23i9d1lah6k4747"))))
+        (base32 "0411fj5b9gvjz1z1gpvy07hkm7rz2nmwggw2v3hbn7ran7w3w5zy"))))
     (arguments
      '(#:tests? #f                      ; No tests.
        #:configure-flags '("-DGSTREAMER=ON")))
@@ -4734,7 +4845,7 @@ as is the case with audio plugins.")
        ;; (ModuleNotFoundError: No module named 'PyQt5')
        ("python-wrapper" ,python-wrapper)
        ("libx11" ,libx11)
-       ("qtbase" ,qtbase)
+       ("qtbase" ,qtbase-5)
        ("zlib" ,zlib)
 
        ;; For WRAP-SCRIPT above.
@@ -4801,7 +4912,7 @@ in the package.")
       (origin
         (method git-fetch)
         (uri (git-reference
-               (url "https://git.zrythm.org/git/libaudec")
+               (url "https://git.zrythm.org/zrythm/libaudec")
                (commit (string-append "v" version))))
         (file-name (git-file-name name version))
         (sha256
@@ -4822,7 +4933,7 @@ in the package.")
    (description "libaudec is a wrapper library over ffmpeg, sndfile and
 libsamplerate for reading and resampling audio files, based on Robin Gareus'
 @code{audio_decoder} code.")
-   (home-page "https://git.zrythm.org/cgit/libaudec")
+   (home-page "https://git.zrythm.org/zrythm/libaudec")
    (license license:agpl3+)))
 
 (define-public lv2lint
@@ -4901,7 +5012,7 @@ with the provided metadata and adhere to well-known best practices.")
      (origin
        (method git-fetch)
        (uri (git-reference
-             (url "https://git.zrythm.org/git/ztoolkit")
+             (url "https://git.zrythm.org/zrythm/ztoolkit")
              (commit (string-append "v" version))))
        (file-name (git-file-name name version))
        (sha256
@@ -4922,7 +5033,7 @@ the user and provides a high-level API for managing the UI and custom
 widgets.  ZToolkit is written in C and was created to be used for building
 audio plugin UIs, where the dependencies often need to be kept to a
 minimum.")
-    (home-page "https://git.zrythm.org/cgit/ztoolkit/")
+    (home-page "https://git.zrythm.org/zrythm/ztoolkit")
     (license license:agpl3+)))
 
 (define-public libinstpatch
@@ -5036,6 +5147,32 @@ digital radio.")
     (home-page "https://www.rowetel.com/?page_id=452")
     (license license:lgpl2.1)))
 
+(define-public mbelib
+  ;; No release since 2016, use commit directly.
+  (let ((commit "9a04ed5c78176a9965f3d43f7aa1b1f5330e771f")
+        (revision "1"))
+    (package
+      (name "mbelib")
+      (version (git-version "1.3.0" revision commit))
+      (source
+       (origin
+         (method git-fetch)
+         (uri (git-reference
+               (url "https://github.com/szechyjs/mbelib")
+               (commit commit)))
+         (file-name (git-file-name name version))
+         (sha256
+          (base32 "0a7xmf87xnjzm5b437j2vnwv39x0ascja1j04c5wj6xs1529gw8h"))))
+      (build-system cmake-build-system)
+      (home-page "https://github.com/szechyjs/mbelib")
+      (synopsis "P25 Phase 1 and ProVoice vocoder")
+      (description
+       "The mbelib library provides support for the 7200x4400 bit/s codec used
+in P25 Phase 1, the 7100x4400 bit/s codec used in ProVoice and the @emph{Half
+Rate} 3600x2250 bit/s vocoder used in various radio systems.")
+      (license (list license:bsd-3      ; test/ framework
+                     license:isc)))))   ; the rest
+
 (define-public ableton-link
   (package
     (name "ableton-link")
@@ -5067,7 +5204,7 @@ digital radio.")
      `(("catch" ,catch-framework)
        ("python" ,python)       ;for running tests
        ("portaudio" ,portaudio) ;for portaudio examples
-       ("qtbase" ,qtbase)       ;for Qt examples
+       ("qtbase" ,qtbase-5)       ;for Qt examples
        ("qtdeclarative" ,qtdeclarative)
        ("qttools" ,qttools)))
     (inputs
@@ -5140,14 +5277,18 @@ while still staying in time.")
 (define-public butt
   (package
     (name "butt")
-    (version "0.1.29")
+    (version "0.1.31")
     (source (origin
               (method url-fetch)
               (uri (string-append "mirror://sourceforge/butt/butt/butt-"
                                   version "/butt-" version ".tar.gz"))
               (sha256
                (base32
-                "0nbz0z4d7krvhmnwn10594gwc61gn2dlb5fazmynjfisrfdswqlg"))))
+                "19zvdi5vr6vqnrpc60jir7550nz9a5x1c61lh13355cdny2zp28z"))
+              (modules '((guix build utils)))
+              (snippet
+               '(substitute* "src/butt.cpp"
+                  ((".*zica.*") "")))))
     (build-system gnu-build-system)
     (arguments
      `(#:phases
@@ -5184,9 +5325,88 @@ while still staying in time.")
                                         version "_manual.pdf"))
                     (sha256
                      (base32
-                      "1hhgdhdg5s86hjcbwh856gcd3kcch0i5xgi3i3v02zz3xmzl7gg3"))))))
+                      "0a0kgd069whfp1v8xgw6qm67w02n8b7b4h5ay5665wgq947hxanp"))))))
     (home-page "https://danielnoethen.de/butt/")
     (synopsis "Audio streaming tool")
     (description "Butt is a tool to stream audio to a ShoutCast or
 Icecast server.")
     (license license:gpl2+)))
+
+(define-public siggen
+  (package
+    (name "siggen")
+    (version "2.3.10")
+    (source
+     (origin
+       (method git-fetch)
+       (uri (git-reference
+             (url "https://github.com/bleskodev/siggen")
+             (commit "a407611b59d59c7770bbe62ba9b8e9a948cf3210")))
+       (file-name (git-file-name name version))
+       (sha256
+        (base32
+         "0szhgfd9kddr6qsz0imp0x66jjn6ry236f35vjl82ivc1v2bllcb"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:make-flags (list (string-append "INSDIR=" %output "/bin")
+                          (string-append "MANDIR=" %output "/share/man"))
+       #:tests? #f                      ; no tests
+       #:phases
+       (modify-phases %standard-phases
+         ;; Patch misc.c to prevent a segfault.
+         (add-after 'unpack 'patch-segfault
+           (lambda _
+             (substitute* "misc.c"
+               (("#include <stdio.h>\n" all)
+                (string-append all "#include <string.h>\n")))))
+         (delete 'configure)
+         (replace 'install
+           (lambda* (#:key make-flags outputs #:allow-other-keys)
+             (let ((out (assoc-ref outputs "out")))
+               (for-each (lambda (dir)
+                           (mkdir-p (string-append out dir)))
+                         (list "/bin" "/share/man/man1" "/share/man/man5"))
+               (apply invoke "make" "sysinstall" make-flags)))))))
+    (inputs
+     `(("ncurses" ,ncurses)))
+    (native-inputs
+     `(("groff" ,groff-minimal)         ; for nroff
+       ("util-linux" ,util-linux)))     ; for col
+    (home-page "https://github.com/bleskodev/siggen")
+    (synopsis "Signal generation tools")
+    (description "siggen is a set of tools for imitating a laboratory signal
+generator, generating audio signals out of Linux's /dev/dsp audio
+device.  There is support for mono and/or stereo and 8 or 16 bit samples.")
+    (license license:gpl2)))
+
+(define-public mda-lv2
+  (package
+    (name "mda-lv2")
+    (version "1.2.6")
+    (source
+      (origin
+        (method url-fetch)
+        (uri (string-append "http://download.drobilla.net/mda-lv2-"
+                            version ".tar.bz2"))
+        (sha256
+         (base32 "1nspk2j11l65m5r9z5isw8j749vh9a89wgx8mkrrq15f4iq12rnd"))))
+    (build-system waf-build-system)
+    (arguments
+     `(#:tests? #f  ; There are no tests.
+       #:configure-flags
+       (list (string-append "--prefix="
+                            (assoc-ref %outputs "out")))))
+    (inputs
+     `(("lv2" ,lv2)))
+    (native-inputs
+     `(("pkg-config" ,pkg-config)))
+    (native-search-paths
+     (list (search-path-specification
+            (variable "LV2_PATH")
+            (files '("lib/lv2")))))
+    (home-page "https://drobilla.net/software/mda-lv2")
+    (synopsis "Audio plug-in pack for LV2")
+    (description
+     "MDA-LV2 is an LV2 port of the MDA plugins.  It includes effects and a few
+instrument plugins.")
+    (license license:gpl3+)))

gnu/packages/authentication.scm

@@ -24,6 +24,8 @@
   #:use-module (gnu packages linux)
   #:use-module (gnu packages pkg-config)
   #:use-module (gnu packages security-token)
+  #:use-module (gnu packages tls)
+  #:use-module (gnu packages xml)
   #:use-module (guix build-system gnu)
   #:use-module (guix download)
   #:use-module (guix git-download)
@@ -33,19 +35,21 @@
 (define-public oath-toolkit
   (package
     (name "oath-toolkit")
-    (version "2.6.6")
+    (version "2.6.7")
     (source
      (origin
        (method url-fetch)
        (uri (string-append "https://download.savannah.nongnu.org/releases/"
                            name "/" name "-" version ".tar.gz"))
        (sha256
-        (base32 "0v4lrgip08b8xlivsfn3mwql3nv8hmcpzrn6pi3xp88vqwav6s7x"))))
+        (base32 "1aa620k05lsw3l3slkp2mzma40q3p9wginspn9zk8digiz7dzv9n"))))
     (build-system gnu-build-system)
     (arguments
      ;; TODO ‘--enable-pskc’ causes xmlsec-related test suite failures.
      `(#:configure-flags
-       (list "--enable-pam")
+       (list "--enable-pam"
+             "--enable-pskc"
+             "--with-xmlsec-crypto-engine=openssl")
        #:phases
        (modify-phases %standard-phases
          (add-after 'install 'delete-static-libraries
@@ -55,16 +59,16 @@
                (for-each delete-file (find-files lib "\\.a$"))
                #t))))))
     (native-inputs
-     `(("pkg-config" ,pkg-config)))
+     `(("pkg-config" ,pkg-config)
+
+       ;; XXX: Perhaps this should be propagated from xmlsec.
+       ("libltdl" ,libltdl)))
     (inputs
-     `(("linux-pam" ,linux-pam)))       ; for --enable-pam
+     `(("linux-pam" ,linux-pam)
+       ("openssl" ,openssl)
+       ("xmlsec-openssl" ,xmlsec-openssl)))
     (home-page "https://www.nongnu.org/oath-toolkit/")
     (synopsis "One-time password (OTP) components")
-    ;; TODO Add the following items after they've been enabled.
-    ;; @item @command{pskctool}, a command-line tool for manipulating secret key
-    ;; files in the Portable Symmetric Key Container (@dfn{PSKC}) format
-    ;; described in RFC6030.
-    ;; @item @code{libpskc}, a shared and static C library for PSKC handling.
     (description
      "The @dfn{OATH} (Open AuTHentication) Toolkit provides various components
 for building one-time password (@dfn{OTP}) authentication systems:
@@ -72,11 +76,18 @@ for building one-time password (@dfn{OTP}) authentication systems:
 @itemize
 @item @command{oathtool}, a command-line tool for generating & validating OTPs.
 @item @code{liboath}, a C library for OATH handling.
+@item @command{pskctool}, a command-line tool for manipulating secret key
+files in the Portable Symmetric Key Container (@dfn{PSKC}) format
+described in RFC6030.
+@item @code{libpskc}, a shared and static C library for PSKC handling.
 @item @code{pam_oath}, a PAM module for pluggable login authentication.
 @end itemize
 
-Supported technologies include the event-based @dfn{HOTP} algorithm (RFC4226)
+Supported technologies include the event-based @acronym{HOTP, Hash-based Message
-and the time-based @dfn{TOTP} algorithm (RFC6238).")
+Authentication Code One-Time Password} algorithm (RFC4226), the time-based
+@acronym{TOTP, Time-based One-Time Password} algorithm (RFC6238), and
+@acronym{PSKC, Portable Symmetric Key Container} (RFC6030) to manage secret key
+data.")
     (license (list license:lgpl2.1+     ; the libraries (liboath/ & libpskc/)
                    license:gpl3+))))    ; the tools (everything else)
 

gnu/packages/autotools.scm

@@ -135,7 +135,18 @@ know anything about Autoconf or M4.")
                                  (find-files "bin"
                                              (lambda (file stat)
                                                (executable-file? file)))))
-               #t))))))))
+               #t))
+           (add-after 'install 'unpatch-shebangs
+             (lambda* (#:key outputs #:allow-other-keys)
+               ;; Scripts that "autoconf -i" installs (config.guess,
+               ;; config.sub, and install-sh) must use a regular shebang
+               ;; rather than a reference to the store.  Restore it.
+               ;; TODO: Move this phase to 'autoconf-2.69'.
+               (let* ((out (assoc-ref outputs "out"))
+                      (build-aux (string-append
+                                  out "/share/autoconf/build-aux")))
+                 (substitute* (find-files build-aux)
+                   (("^#!.*/bin/sh") "#!/bin/sh")))))))))))
 
 (define-public autoconf autoconf-2.69)
 

gnu/packages/aux-files/linux-libre/4.14-arm.conf

@@ -875,12 +875,12 @@ CONFIG_CPU_FREQ=y
 CONFIG_CPU_FREQ_GOV_ATTR_SET=y
 CONFIG_CPU_FREQ_GOV_COMMON=y
 CONFIG_CPU_FREQ_STAT=y
-CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE=y
+# CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_POWERSAVE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_USERSPACE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_ONDEMAND is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_CONSERVATIVE is not set
-# CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL is not set
+CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL=y
 CONFIG_CPU_FREQ_GOV_PERFORMANCE=y
 CONFIG_CPU_FREQ_GOV_POWERSAVE=m
 CONFIG_CPU_FREQ_GOV_USERSPACE=m

gnu/packages/aux-files/linux-libre/4.14-i686.conf

@@ -763,12 +763,12 @@ CONFIG_CPU_FREQ=y
 CONFIG_CPU_FREQ_GOV_ATTR_SET=y
 CONFIG_CPU_FREQ_GOV_COMMON=y
 CONFIG_CPU_FREQ_STAT=y
-CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE=y
+# CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_POWERSAVE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_USERSPACE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_ONDEMAND is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_CONSERVATIVE is not set
-# CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL is not set
+CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL=y
 CONFIG_CPU_FREQ_GOV_PERFORMANCE=y
 CONFIG_CPU_FREQ_GOV_POWERSAVE=y
 CONFIG_CPU_FREQ_GOV_USERSPACE=y

gnu/packages/aux-files/linux-libre/4.14-x86_64.conf

@@ -786,12 +786,12 @@ CONFIG_CPU_FREQ=y
 CONFIG_CPU_FREQ_GOV_ATTR_SET=y
 CONFIG_CPU_FREQ_GOV_COMMON=y
 CONFIG_CPU_FREQ_STAT=y
-CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE=y
+# CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_POWERSAVE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_USERSPACE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_ONDEMAND is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_CONSERVATIVE is not set
-# CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL is not set
+CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL=y
 CONFIG_CPU_FREQ_GOV_PERFORMANCE=y
 CONFIG_CPU_FREQ_GOV_POWERSAVE=y
 CONFIG_CPU_FREQ_GOV_USERSPACE=y
@@ -879,7 +879,7 @@ CONFIG_HOTPLUG_PCI_SHPC=m
 #
 # PCI host controller drivers
 #
-# CONFIG_VMD is not set
+CONFIG_VMD=m
 
 #
 # PCI Endpoint

gnu/packages/aux-files/linux-libre/4.19-arm.conf

@@ -688,12 +688,12 @@ CONFIG_CPU_FREQ=y
 CONFIG_CPU_FREQ_GOV_ATTR_SET=y
 CONFIG_CPU_FREQ_GOV_COMMON=y
 CONFIG_CPU_FREQ_STAT=y
-CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE=y
+# CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_POWERSAVE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_USERSPACE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_ONDEMAND is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_CONSERVATIVE is not set
-# CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL is not set
+CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL=y
 CONFIG_CPU_FREQ_GOV_PERFORMANCE=y
 CONFIG_CPU_FREQ_GOV_POWERSAVE=m
 CONFIG_CPU_FREQ_GOV_USERSPACE=m

gnu/packages/aux-files/linux-libre/4.19-arm64.conf

@@ -520,12 +520,12 @@ CONFIG_CPU_FREQ=y
 CONFIG_CPU_FREQ_GOV_ATTR_SET=y
 CONFIG_CPU_FREQ_GOV_COMMON=y
 CONFIG_CPU_FREQ_STAT=y
-CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE=y
+# CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_POWERSAVE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_USERSPACE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_ONDEMAND is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_CONSERVATIVE is not set
-# CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL is not set
+CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL=y
 CONFIG_CPU_FREQ_GOV_PERFORMANCE=y
 CONFIG_CPU_FREQ_GOV_POWERSAVE=m
 CONFIG_CPU_FREQ_GOV_USERSPACE=m

gnu/packages/aux-files/linux-libre/4.19-i686.conf

@@ -535,12 +535,12 @@ CONFIG_CPU_FREQ=y
 CONFIG_CPU_FREQ_GOV_ATTR_SET=y
 CONFIG_CPU_FREQ_GOV_COMMON=y
 CONFIG_CPU_FREQ_STAT=y
-CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE=y
+# CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_POWERSAVE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_USERSPACE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_ONDEMAND is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_CONSERVATIVE is not set
-# CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL is not set
+CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL=y
 CONFIG_CPU_FREQ_GOV_PERFORMANCE=y
 CONFIG_CPU_FREQ_GOV_POWERSAVE=y
 CONFIG_CPU_FREQ_GOV_USERSPACE=y

gnu/packages/aux-files/linux-libre/4.19-x86_64.conf

@@ -538,12 +538,12 @@ CONFIG_CPU_FREQ=y
 CONFIG_CPU_FREQ_GOV_ATTR_SET=y
 CONFIG_CPU_FREQ_GOV_COMMON=y
 CONFIG_CPU_FREQ_STAT=y
-CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE=y
+# CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_POWERSAVE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_USERSPACE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_ONDEMAND is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_CONSERVATIVE is not set
-# CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL is not set
+CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL=y
 CONFIG_CPU_FREQ_GOV_PERFORMANCE=y
 CONFIG_CPU_FREQ_GOV_POWERSAVE=y
 CONFIG_CPU_FREQ_GOV_USERSPACE=y
@@ -630,7 +630,7 @@ CONFIG_HOTPLUG_PCI_SHPC=y
 #
 # Cadence PCIe controllers support
 #
-# CONFIG_VMD is not set
+CONFIG_VMD=m
 
 #
 # DesignWare PCI Core Support

gnu/packages/aux-files/linux-libre/4.9-i686.conf

@@ -714,12 +714,12 @@ CONFIG_CPU_FREQ_GOV_ATTR_SET=y
 CONFIG_CPU_FREQ_GOV_COMMON=y
 CONFIG_CPU_FREQ_STAT=y
 CONFIG_CPU_FREQ_STAT_DETAILS=y
-CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE=y
+# CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_POWERSAVE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_USERSPACE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_ONDEMAND is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_CONSERVATIVE is not set
-# CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL is not set
+CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL=y
 CONFIG_CPU_FREQ_GOV_PERFORMANCE=y
 CONFIG_CPU_FREQ_GOV_POWERSAVE=y
 CONFIG_CPU_FREQ_GOV_USERSPACE=y

gnu/packages/aux-files/linux-libre/4.9-x86_64.conf

@@ -723,12 +723,12 @@ CONFIG_CPU_FREQ_GOV_ATTR_SET=y
 CONFIG_CPU_FREQ_GOV_COMMON=y
 CONFIG_CPU_FREQ_STAT=y
 CONFIG_CPU_FREQ_STAT_DETAILS=y
-CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE=y
+# CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_POWERSAVE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_USERSPACE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_ONDEMAND is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_CONSERVATIVE is not set
-# CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL is not set
+CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL=y
 CONFIG_CPU_FREQ_GOV_PERFORMANCE=y
 CONFIG_CPU_FREQ_GOV_POWERSAVE=y
 CONFIG_CPU_FREQ_GOV_USERSPACE=y
@@ -816,7 +816,7 @@ CONFIG_HOTPLUG_PCI_SHPC=m
 # PCI host controller drivers
 #
 # CONFIG_PCIE_DW_PLAT is not set
-# CONFIG_VMD is not set
+CONFIG_VMD=m
 # CONFIG_ISA_BUS is not set
 CONFIG_ISA_DMA_API=y
 CONFIG_AMD_NB=y

gnu/packages/aux-files/linux-libre/5.10-arm.conf

@@ -648,12 +648,12 @@ CONFIG_CPU_FREQ=y
 CONFIG_CPU_FREQ_GOV_ATTR_SET=y
 CONFIG_CPU_FREQ_GOV_COMMON=y
 CONFIG_CPU_FREQ_STAT=y
-CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE=y
+# CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_POWERSAVE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_USERSPACE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_ONDEMAND is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_CONSERVATIVE is not set
-# CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL is not set
+CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL=y
 CONFIG_CPU_FREQ_GOV_PERFORMANCE=y
 CONFIG_CPU_FREQ_GOV_POWERSAVE=m
 CONFIG_CPU_FREQ_GOV_USERSPACE=m

gnu/packages/aux-files/linux-libre/5.10-arm64.conf

@@ -544,12 +544,12 @@ CONFIG_CPU_FREQ=y
 CONFIG_CPU_FREQ_GOV_ATTR_SET=y
 CONFIG_CPU_FREQ_GOV_COMMON=y
 CONFIG_CPU_FREQ_STAT=y
-CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE=y
+# CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_POWERSAVE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_USERSPACE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_ONDEMAND is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_CONSERVATIVE is not set
-# CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL is not set
+CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL=y
 CONFIG_CPU_FREQ_GOV_PERFORMANCE=y
 CONFIG_CPU_FREQ_GOV_POWERSAVE=m
 CONFIG_CPU_FREQ_GOV_USERSPACE=m

gnu/packages/aux-files/linux-libre/5.10-i686.conf

@@ -574,10 +574,10 @@ CONFIG_CPU_FREQ=y
 CONFIG_CPU_FREQ_GOV_ATTR_SET=y
 CONFIG_CPU_FREQ_GOV_COMMON=y
 CONFIG_CPU_FREQ_STAT=y
-CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE=y
+# CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_POWERSAVE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_USERSPACE is not set
-# CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL is not set
+CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL=y
 CONFIG_CPU_FREQ_GOV_PERFORMANCE=y
 CONFIG_CPU_FREQ_GOV_POWERSAVE=y
 CONFIG_CPU_FREQ_GOV_USERSPACE=y
@@ -10612,7 +10612,7 @@ CONFIG_BRANCH_PROFILE_NONE=y
 CONFIG_BLK_DEV_IO_TRACE=y
 CONFIG_KPROBE_EVENTS=y
 # CONFIG_KPROBE_EVENTS_ON_NOTRACE is not set
-# CONFIG_UPROBE_EVENTS is not set
+CONFIG_UPROBE_EVENTS=y
 CONFIG_BPF_EVENTS=y
 CONFIG_DYNAMIC_EVENTS=y
 CONFIG_PROBE_EVENTS=y

gnu/packages/aux-files/linux-libre/5.10-x86_64.conf

@@ -589,10 +589,10 @@ CONFIG_CPU_FREQ=y
 CONFIG_CPU_FREQ_GOV_ATTR_SET=y
 CONFIG_CPU_FREQ_GOV_COMMON=y
 CONFIG_CPU_FREQ_STAT=y
-CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE=y
+# CONFIG_CPU_FREQ_DEFAULT_GOV_PERFORMANCE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_POWERSAVE is not set
 # CONFIG_CPU_FREQ_DEFAULT_GOV_USERSPACE is not set
-# CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL is not set
+CONFIG_CPU_FREQ_DEFAULT_GOV_SCHEDUTIL=y
 CONFIG_CPU_FREQ_GOV_PERFORMANCE=y
 CONFIG_CPU_FREQ_GOV_POWERSAVE=y
 CONFIG_CPU_FREQ_GOV_USERSPACE=y
@@ -2104,7 +2104,7 @@ CONFIG_HOTPLUG_PCI_SHPC=y
 #
 # PCI controller drivers
 #
-# CONFIG_VMD is not set
+CONFIG_VMD=m
 CONFIG_PCI_HYPERV_INTERFACE=m
 
 #
@@ -10620,7 +10620,7 @@ CONFIG_BRANCH_PROFILE_NONE=y
 CONFIG_BLK_DEV_IO_TRACE=y
 CONFIG_KPROBE_EVENTS=y
 # CONFIG_KPROBE_EVENTS_ON_NOTRACE is not set
-# CONFIG_UPROBE_EVENTS is not set
+CONFIG_UPROBE_EVENTS=y
 CONFIG_BPF_EVENTS=y
 CONFIG_DYNAMIC_EVENTS=y
 CONFIG_PROBE_EVENTS=y