deduplicate: Use 'sendfile' only with file ports.

Fixes a regression introduced in b129026e2e. * guix/store/deduplication.scm (dump-file/deduplicate): Use 'sendfile' only when INPUT' is a file port.
install: 'umount-cow-store' retries upon EBUSY.
2026-07-18 19:04:07 +02:00 · 2022-12-10 18:13:39 +01:00 · 2022-12-10 14:34:35 +01:00 · 2022-12-10 11:23:27 +01:00 · 2022-12-10 10:56:48 +01:00 · 2022-12-09 17:49:22 +01:00
907 changed files with 638197 additions and 255377 deletions
@@ -10,11 +10,25 @@
      . "\\(<https?://\\bugs\\.gnu\\.org/\\([0-9]+\\)>\\)")
     (bug-reference-url-format . "https://bugs.gnu.org/%s")

+     (eval . (add-to-list 'completion-ignored-extensions ".go"))
+
     ;; Emacs-Guix
     (eval . (setq-local guix-directory
                         (locate-dominating-file default-directory
                                                 ".dir-locals.el")))

+     ;; YASnippet
+     (eval . (with-eval-after-load
+                 'yasnippet
+               (let ((guix-yasnippets
+                      (expand-file-name
+                       "etc/snippets/yas"
+                       (locate-dominating-file default-directory
+                                               ".dir-locals.el"))))
+                 (unless (member guix-yasnippets yas-snippet-dirs)
+                   (add-to-list 'yas-snippet-dirs guix-yasnippets)
+                   (yas-reload-all)))))
+
     ;; Geiser
     ;; This allows automatically setting the `geiser-guile-load-path'
     ;; variable when using various Guix checkouts (e.g., via git worktrees).
@@ -118,6 +132,7 @@
   (eval . (put 'munless 'scheme-indent-function 1))
   (eval . (put 'mlet* 'scheme-indent-function 2))
   (eval . (put 'mlet 'scheme-indent-function 2))
+   (eval . (put 'mparameterize 'scheme-indent-function 2))
   (eval . (put 'run-with-store 'scheme-indent-function 1))
   (eval . (put 'run-with-state 'scheme-indent-function 1))
   (eval . (put 'wrap-program 'scheme-indent-function 1))
@@ -156,7 +171,31 @@
   ;; preceding symbol is one of these.
   (eval . (modify-syntax-entry ?~ "'"))
   (eval . (modify-syntax-entry ?$ "'"))
-   (eval . (modify-syntax-entry ?+ "'"))))
+   (eval . (modify-syntax-entry ?+ "'"))
+
+   ;; Emacs 28 changed the behavior of 'lisp-fill-paragraph', which causes the
+   ;; first line of package descriptions to extrude past 'fill-column', and
+   ;; somehow that is deemed more correct upstream (see:
+   ;; https://issues.guix.gnu.org/56197).
+   (eval . (progn
+             (require 'lisp-mode)
+             (defun emacs27-lisp-fill-paragraph (&optional justify)
+               (interactive "P")
+               (or (fill-comment-paragraph justify)
+                   (let ((paragraph-start
+                          (concat paragraph-start
+                                  "\\|\\s-*\\([(;\"]\\|\\s-:\\|`(\\|#'(\\)"))
+                         (paragraph-separate
+                          (concat paragraph-separate "\\|\\s-*\".*[,\\.]$"))
+                         (fill-column (if (and (integerp emacs-lisp-docstring-fill-column)
+                                               (derived-mode-p 'emacs-lisp-mode))
+                                          emacs-lisp-docstring-fill-column
+                                        fill-column)))
+                     (fill-paragraph justify))
+                   ;; Never return nil.
+                   t))
+             (setq-local fill-paragraph-function #'emacs27-lisp-fill-paragraph)))))
+
 (emacs-lisp-mode . ((indent-tabs-mode . nil)))
 (texinfo-mode    . ((indent-tabs-mode . nil)
                     (fill-column . 72))))
@@ -0,0 +1,16 @@
+root = true
+
+[*.{c,h,cpp,hpp,el,scm,ac,am,m4,po}{,.in}]
+end_of_line = lf
+insert_final_newline = true
+charset = utf-8
+trim_trailing_whitespace = true
+
+[*.{c,h,cpp,hpp,ac,am,m4,el,scm}{,.in}]
+max_line_length = 85
+
+[*.{c,h,cpp,hpp,ac,m4,el,scm}{,.in}]
+indent_style = space
+
+[*.{c,h,cpp,hpp}{,.in}]
+indent_size = 4
@@ -4,12 +4,15 @@
 (authorizations
 (version 0)

- (("AD17 A21E F8AE D8F1 CC02  DBD9 F7D5 C9BF 765C 61E3"
-   (name "andreas"))
+ (;; primary: "D963 A5A3 8A80 3D52 4461  F914 7483 0A27 6C32 8EC2"
+  ("2841 9AC6 5038 7440 C7E9  2FFA 2208 D209 58C1 DEB0"
+   (name "abcdw"))
  ("4FB9 9F49 2B12 A365 7997  E664 8246 0C08 2A0E E98F"
   (name "alezost"))
  ("50F3 3E2E 5B0C 3D90 0424  ABE8 9BDC F497 A4BB CC7F"
   (name "ambrevar"))
+  ("AD17 A21E F8AE D8F1 CC02  DBD9 F7D5 C9BF 765C 61E3"
+   (name "andreas"))
  ("27D5 86A4 F890 0854 329F  F09F 1260 E464 82E6 3562"
   (name "apteryx"))
  ("7F73 0343 F2F0 9F3C 77BF  79D3 2E25 EE8B 6180 2BB3"
@@ -32,10 +35,8 @@
  (;; primary: "295A F991 6F46 F8A1 34B0  29DA 8086 3842 F0FE D83B"
   "76CE C6B1 7274 B465 C02D  B3D9 E71A 3554 2C30 BAA5"
   (name "dannym"))
-  ("B3C0 DB4D AD73 BA5D 285E  19AE 5143 0234 CEFD 87C3"
-   (name "davexunit"))
-  ("8CCB A7F5 52B9 CBEA E1FB  2915 8328 C747 0FF1 D807" ;FIXME: to be confirmed!
-   (name "davexunit (2nd)"))
+  ("8CCB A7F5 52B9 CBEA E1FB  2915 8328 C747 0FF1 D807"
+   (name "dthompson"))
  ("A28B F40C 3E55 1372 662D  14F7 41AA E7DC CA3D 8351"
   (name "efraim"))
  (;; primary: "2453 02B1 BAB1 F867 FDCA  96BC 8F3F 861F 82EB 7A9A"
@@ -64,8 +65,6 @@
  (;; primary: "4F71 6F9A 8FA2 C80E F1B5  E1BA 5E35 F231 DE1A C5E0"
   "B051 5948 F1E7 D3C1 B980  38A0 2646 FA30 BACA 7F08"
   (name "lfam"))
-  ("925C 8EBD F446 931D 1B64  4498 2D58 A112 6E2D FC90"
-   (name "magali"))
  ("CBF5 9755 CBE7 E7EF EF18  3FB1 DD40 9A15 D822 469D"
   (name "marusich"))
  ("BBB0 2DDF 2CEA F6A8 0D1D  E643 A2A0 6DF2 A33A 54FA"
@@ -130,6 +130,7 @@ MODULES =					\
  guix/cve.scm					\
  guix/workers.scm				\
  guix/least-authority.scm			\
+  guix/read-print.scm				\
  guix/ipfs.scm					\
  guix/platform.scm                             \
  guix/platforms/arm.scm                        \
@@ -141,6 +142,7 @@ MODULES =					\
  guix/build-system/android-ndk.scm		\
  guix/build-system/ant.scm			\
  guix/build-system/cargo.scm			\
+  guix/build-system/channel.scm			\
  guix/build-system/chicken.scm			\
  guix/build-system/clojure.scm			\
  guix/build-system/cmake.scm			\
@@ -164,6 +166,7 @@ MODULES =					\
  guix/build-system/maven.scm			\
  guix/build-system/node.scm			\
  guix/build-system/perl.scm			\
+  guix/build-system/pyproject.scm		\
  guix/build-system/python.scm			\
  guix/build-system/renpy.scm			\
  guix/build-system/ocaml.scm			\
@@ -220,6 +223,7 @@ MODULES =					\
  guix/build/minetest-build-system.scm		\
  guix/build/node-build-system.scm		\
  guix/build/perl-build-system.scm		\
+  guix/build/pyproject-build-system.scm		\
  guix/build/python-build-system.scm		\
  guix/build/ocaml-build-system.scm		\
  guix/build/qt-build-system.scm		\
@@ -341,7 +345,6 @@ MODULES =					\
  guix/scripts/size.scm				\
  guix/scripts/git.scm				\
  guix/scripts/git/authenticate.scm		\
-  guix/scripts/git/log.scm			\
  guix/scripts/graph.scm			\
  guix/scripts/weather.scm			\
  guix/scripts/container.scm			\
@@ -396,10 +399,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.18-arm.conf	\
-  gnu/packages/aux-files/linux-libre/5.18-arm64.conf	\
-  gnu/packages/aux-files/linux-libre/5.18-i686.conf	\
-  gnu/packages/aux-files/linux-libre/5.18-x86_64.conf	\
+  gnu/packages/aux-files/linux-libre/6.0-arm.conf	\
+  gnu/packages/aux-files/linux-libre/6.0-arm64.conf	\
+  gnu/packages/aux-files/linux-libre/6.0-i686.conf	\
+  gnu/packages/aux-files/linux-libre/6.0-x86_64.conf	\
  gnu/packages/aux-files/linux-libre/5.15-arm.conf	\
  gnu/packages/aux-files/linux-libre/5.15-arm64.conf	\
  gnu/packages/aux-files/linux-libre/5.15-i686.conf	\
@@ -423,6 +426,7 @@ AUX_FILES =						\
  gnu/packages/aux-files/linux-libre/4.9-x86_64.conf	\
  gnu/packages/aux-files/pack-audit.c			\
  gnu/packages/aux-files/python/sanity-check.py		\
+  gnu/packages/aux-files/python/sanity-check-next.py	\
  gnu/packages/aux-files/python/sitecustomize.py	\
  gnu/packages/aux-files/renpy/renpy.in	\
  gnu/packages/aux-files/run-in-namespace.c
@@ -525,12 +529,14 @@ SCM_TESTS =					\
  tests/profiles.scm				\
  tests/publish.scm				\
  tests/pypi.scm				\
+  tests/read-print.scm				\
  tests/records.scm				\
  tests/scripts.scm				\
  tests/search-paths.scm			\
  tests/services.scm				\
  tests/services/file-sharing.scm		\
  tests/services/configuration.scm		\
+  tests/services/lightdm.scm			\
  tests/services/linux.scm			\
  tests/services/telephony.scm			\
  tests/sets.scm				\
@@ -579,6 +585,7 @@ SH_TESTS =					\
  tests/guix-package.sh				\
  tests/guix-package-aliases.sh			\
  tests/guix-package-net.sh			\
+  tests/guix-style.sh				\
  tests/guix-system.sh				\
  tests/guix-home.sh				\
  tests/guix-archive.sh				\
@@ -654,48 +661,49 @@ dist_fishcompletion_DATA = etc/completion/fish/guix.fish
 nodist_selinux_policy_DATA = etc/guix-daemon.cil

 EXTRA_DIST +=						\
-  HACKING						\
-  ROADMAP						\
-  TODO							\
-  CODE-OF-CONDUCT					\
  .dir-locals.el					\
  .guix-authorizations					\
  .guix-channel						\
-  scripts/guix.in					\
+  CODE-OF-CONDUCT					\
+  HACKING						\
+  ROADMAP						\
+  TODO							\
+  bootstrap						\
+  build-aux/build-self.scm				\
+  build-aux/check-channel-news.scm			\
+  build-aux/check-final-inputs-self-contained.scm	\
+  build-aux/compile-all.scm				\
+  build-aux/compile-as-derivation.scm			\
+  build-aux/config.rpath				\
+  build-aux/convert-xref.scm			\
+  build-aux/cuirass/hurd-manifest.scm			\
+  build-aux/generate-authors.scm			\
+  build-aux/test-driver.scm				\
+  build-aux/update-NEWS.scm				\
+  build-aux/update-guix-package.scm			\
+  doc/build.scm						\
  etc/disarchive-manifest.scm				\
  etc/guix-install.sh					\
+  etc/historical-authorizations				\
  etc/news.scm						\
  etc/release-manifest.scm				\
  etc/source-manifest.scm				\
  etc/system-tests.scm					\
-  etc/historical-authorizations				\
-  build-aux/build-self.scm				\
-  build-aux/compile-all.scm				\
-  build-aux/cuirass/hurd-manifest.scm			\
-  build-aux/check-final-inputs-self-contained.scm	\
-  build-aux/check-channel-news.scm			\
-  build-aux/compile-as-derivation.scm			\
-  build-aux/convert-xref.scm			\
-  build-aux/generate-authors.scm			\
-  build-aux/test-driver.scm				\
-  build-aux/update-guix-package.scm			\
-  build-aux/update-NEWS.scm				\
-  tests/test.drv					\
+  etc/time-travel-manifest.scm				\
+  scripts/guix.in					\
  tests/cve-sample.json					\
-  tests/keys/signing-key.pub				\
-  tests/keys/signing-key.sec				\
  tests/keys/civodul.pub				\
-  tests/keys/rsa.pub					\
  tests/keys/dsa.pub					\
-  tests/keys/ed25519.pub				\
-  tests/keys/ed25519.sec				\
  tests/keys/ed25519-2.pub				\
  tests/keys/ed25519-2.sec				\
  tests/keys/ed25519-3.pub				\
  tests/keys/ed25519-3.sec				\
-  build-aux/config.rpath				\
-  bootstrap						\
-  doc/build.scm						\
+  tests/keys/ed25519.pub				\
+  tests/keys/ed25519.sec				\
+  tests/keys/rsa.pub					\
+  tests/keys/signing-key.pub				\
+  tests/keys/signing-key.sec				\
+  tests/test.drv					\
  $(TESTS)

 if !BUILD_DAEMON_OFFLOAD
@@ -744,20 +752,35 @@ endef
 # 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))
-MODULES_PO       = guix/build/po.scm
+first_half :=								\
+  gnu/packages/a% gnu/packages/b% gnu/packages/c% gnu/packages/d%	\
+  gnu/packages/e% gnu/packages/f% gnu/packages/g% gnu/packages/h%	\
+  gnu/packages/i% gnu/packages/j% gnu/packages/k% gnu/packages/l%
+
+MODULES_CORE      := guix.scm $(filter-out guix/scripts/%,$(filter guix/%,$(MODULES)))
+MODULES_PACKAGES1 := $(filter $(first_half),$(MODULES))
+MODULES_PACKAGES2 := $(filter-out $(first_half),$(filter gnu/packages/%,$(MODULES)))
+MODULES_PACKAGES  := $(MODULES_PACKAGES1) $(MODULES_PACKAGES2)
+MODULES_SYSTEM    := gnu.scm $(filter-out gnu/packages/%,$(filter gnu/%,$(MODULES)))
+MODULES_CLI       := $(filter guix/scripts/%,$(MODULES))
+MODULES_PO        := guix/build/po.scm

 $(eval $(call guile-compilation-rule,make-core-go,	\
  $(MODULES_CORE) guix/config.scm $(dist_noinst_DATA),	\
  0))
 .PHONY: make-core-go

-$(eval $(call guile-compilation-rule,make-packages-go,	\
-  $(MODULES_PACKAGES) make-core-go,			\
+$(eval $(call guile-compilation-rule,make-packages1-go,	\
+  $(MODULES_PACKAGES1) make-core-go,			\
  $(words $(MODULES_CORE))))
+.PHONY: make-packages1-go
+
+$(eval $(call guile-compilation-rule,make-packages2-go,	\
+  $(MODULES_PACKAGES2) make-core-go make-packages1-go,	\
+  $(words $(MODULES_CORE) $(MODULES_PACKAGES1))))
+.PHONY: make-packages2-go
+
+make-packages-go: make-packages1-go make-packages2-go
 .PHONY: make-packages-go

 $(eval $(call guile-compilation-rule,make-system-go,	\
@@ -973,25 +996,21 @@ release: dist-with-updated-version all
 	  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	\
-		"`git rev-parse HEAD`"
-	git add $(top_srcdir)/gnu/packages/package-management.scm
-	git commit -m "gnu: guix: Update to `git rev-parse HEAD | cut -c1-7`."
-	$(top_builddir)/pre-inst-env guix build guix			\
+# Build 'current-guix' to speed things up for the next step.
+	$(top_builddir)/pre-inst-env guix build				\
+	      -e '((@ (gnu packages package-management) current-guix))'	\
 	      $(call system_flags,$(GUIX_SYSTEM_SUPPORTED_SYSTEMS))	\
 	      -v1 --no-grafts --fallback
 # Generate the ISO installation images.
 	for system in $(GUIX_SYSTEM_SUPPORTED_SYSTEMS) ; do				\
+	  GUIX_DISPLAYED_VERSION="`git describe --match=v* | sed -'es/^v//'`" ;		\
 	  image=`$(top_builddir)/pre-inst-env						\
-	    guix system image -t iso9660                                           	\
+	    guix system image -t iso9660						\
 	    --label="GUIX_$${system}_$(VERSION)"					\
            --system=$$system --fallback						\
 	    gnu/system/install.scm` ;							\
 	  if [ ! -f "$$image" ] ; then							\
-	    echo "failed to produce Guix installation image for $$system" >&2 ;	\
+	    echo "failed to produce Guix installation image for $$system" >&2 ;		\
 	    exit 1 ;									\
 	  fi ;										\
 	  cp "$$image" "$(releasedir)/$(GUIX_SYSTEM_IMAGE_BASE).$$system.iso.tmp" ;	\
@@ -1000,6 +1019,7 @@ release: dist-with-updated-version all
 	done
 # Generate the VM images.
 	for system in $(GUIX_SYSTEM_VM_SYSTEMS) ; do					\
+	  GUIX_DISPLAYED_VERSION="`git describe --match=v* | sed -'es/^v//'`" ;		\
 	  image=`$(top_builddir)/pre-inst-env						\
 	    guix system image -t qcow2 $(GUIX_SYSTEM_VM_IMAGE_FLAGS)			\
 	    --save-provenance								\
@@ -2,9 +2,10 @@
 #+TITLE: Guix NEWS – history of user-visible changes
 #+STARTUP: content hidestars

-Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+Copyright © 2013-2022 Ludovic Courtès <ludo@gnu.org>
 Copyright © 2016, 2017, 2018 Ricardo Wurmus <rekado@elephly.net>
-Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+Copyright © 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+Copyright © 2022 Mathieu Othacehe <othacehe@gnu.org>

  Copying and distribution of this file, with or without modification,
  are permitted in any medium without royalty provided the copyright
@@ -16,22 +17,98 @@ Please send Guix bug reports to bug-guix@gnu.org.
 ** Package management
 *** New ‘guix home’ command, for home environment management
 *** New ‘guix shell’ command, the successor to ‘guix environment’
+*** New ‘guix system edit’ command, to edit services
 *** New ‘deb’ format for the ‘guix pack’ command
 *** New ‘guix import minetest’ command, to import Minetest extensions
+*** New ‘guix import elm’ command, to import Elm packages
+*** New ‘guix import egg’ command, to import CHICKEN egg packages
+*** New ‘guix import hexpm’ command, to import Erlang and Elixir packages
+*** New 'guix style' command, to auto-format package definitions
 *** ‘guix import texlive’ rewritten to use the TLPDB as its source
 *** ‘guix import elpa’ now supports the non-GNU ELPA repository
 *** ‘guix import pypi’ can now import a specific version
 *** ‘guix import cran’ can now import a specific version
 *** New updater (see ‘guix refresh’): ‘generic-git’
 *** ‘guix graph’ has a new ‘--max-depth’ option
+*** ‘guix deploy’ has a new ‘--execute’ option
+*** ‘guix shell’ has a new ‘--emulate-fhs’ option
+*** ‘guix shell’ has a new ‘--symlink’ option
 *** ‘--with-commit’ option now accepts strings returned by ‘git describe’
+*** ‘--with-source’ option now applied recursively
+*** Align tabular data output by commands like ‘guix package --list-available’
+*** Improved ‘guix import go’ importer via a new PEG parser
+*** Improved Software Heritage downloader
+*** New 'web.archive.org’ download fall-back
+*** Various performance enhancements
+*** New ‘--tune’ package transformation option
+*** ‘guix refresh’ ‘-L’ option is repurposed to ‘load-path’ modification
+*** ‘guix system image’ supersedes the ‘docker-image’ sub-command
+
 ** Distribution
 *** The installation script can now enable local substitute servers discovery
+*** The installation script can now customize the Bash prompt for Guix
 *** More control over boot-time file system checks and repairs
 *** XFS file systems can be created by the installer and mounted by label/UUID
 *** New interface for declaring swap space
+*** GNOME is now at version 42
+*** TeX Live is now at version 2021
+*** Multiple TeX Live trees can now be used via GUIX_TEXMF
+*** Python modules are searched in GUIX_PYTHONPATH instead of PYTHONPATH
+*** Python is now faster thanks to being built with optimizations
+*** The Rust bootstrap now starts from 1.54 instead of 1.19
+*** Most Python 2 packages have been removed
+*** Guix now makes use of parallel xz compression
+*** Faster shared libraries discovery via a per-package dynamic linker cache
+*** Package inputs can now be plain package lists
+*** A package origin can now be a single file rather than an archive
+*** New sanity-check phase to detect Python packaging problems at build time
+*** Fetching sources can now fall-back to use Disarchive
+*** Improved CI and infrastructure
+*** Multiple cross-compilation tooling addition and fixes
+*** Many Qt 6 modules are now packaged
+*** Configuring setuid programs is now more flexible
+*** Add support for the XFS file system
+*** Add partial support for LUKS2 headers when using GRUB
+*** GDM now supports Wayland
+*** Guix System static networking support is improved
+*** The installer final configuration is prettified
+*** The installer external command handling is improved
+*** The installer now has a crash dump upload mechanism
+*** Emacs now supports native compilation
+*** GRUB bootloader now supports chain-loading
+*** The GNU Shepherd was upgraded to 0.9.3
+*** The init RAM disk honors more arguments—e.g. ‘root’ and ‘rootflags’
+*** ‘guix system image’ can now generate WSL images
+*** The mcron task scheduler logs now contain the jobs exit statuses
+
 ** Programming interfaces
+*** Package input fields can now plain package lists
+*** G-expressions can now be used in build phases
+*** New ‘modify-inputs’ macro to ease customizing a list of package inputs
+*** New ‘this-package-input’ and ‘this-package-native-input’ macros
+*** Build phases are no longer required to return a boolean
 *** (guix records) now supports “field sanitizers”
+*** Various improvements to the helpers in (gnu service configuration)
+*** ‘texlive-union’ is now deprecated in favor of ‘texlive-updmap.cfg’
+*** New (guix cpu) module
+*** New (guix least-authority) module
+*** New (guix plaform) module
+*** New (guix read-print) module
+
+It provides a comment-preserving reader and a comment-preserving
+pretty-printer smarter than (ice-9 pretty-print).
+
+*** New ‘channel-build-system’
+
+This build system lets you build Guix instances from channel specifications,
+similar to how 'guix time-machine' would do it, as regular packages.
+
+*** New ‘elm-build-system’
+*** New ‘rebar-build-system’
+*** New services
+anonip, bitmask, fail2ban, gitile, greetd, jami, lightdm, log-cleanup,
+nar-herder, opendht, rasdaemon, samba, seatd, strongswan, wsdd
+
 ** Noteworthy bug fixes
 *** Fall back to Software Heritage when cloning a channel
    (<https://issues.guix.gnu.org/44187>)
@@ -43,6 +120,42 @@ Please send Guix bug reports to bug-guix@gnu.org.
    (<https://issues.guix.gnu.org/24937>)
 *** File system flags are validated before system instantiation
    (<https://issues.guix.gnu.org/51425>)
+*** Fonts can now be discovered in any profile via XDG_DATA_DIRS
+    (<https://issues.guix.gnu.org/31403>)
+*** Various Python reproducibility fixes
+*** The installer now supports MSDOS disk labels on UEFI systems
+    (<https://issues.guix.gnu.org/47889>)
+*** The installer can now properly mount FAT16 partitions
+    (<https://issues.guix.gnu.org/48419>)
+*** The installer no longer crashes when deleting a free space partition
+*** Emacs handles major upgrades better without a re-login
+    (<https://issues.guix.gnu.org/47458>)
+*** The bootloader configuration now accepts multiple targets
+    (<https://issues.guix.gnu.org/40997>)
+*** File system mount point is always created when ‘create?’ is true
+    (<https://issues.guix.gnu.org/40158>)
+*** Build the man database only if ‘man-db’ is in the profile
+*** gdk-pixbuf now discovers pixbuf loaders via a search path
+    (<https://issues.guix.gnu.org/50957>)
+*** Gitolite home directory permissions are fixed
+    (https://issues.guix.gnu.org/56444)
+*** The man-db database is indexed via man pages names
+    (https://issues.guix.gnu.org/38838)
+*** ‘chfn’ can now change the user's full name
+    (https://issues.guix.gnu.org/52539)
+*** GNOME Settings Bluetooth panel is now working
+    (https://issues.guix.gnu.org/32166)
+*** Inferiors are now caching store connections
+    (https://issues.guix.gnu.org/48007)
+*** Retry downloads when a substitute has become unavailable
+    (https://issues.guix.gnu.org/57978)
+*** The installer doesn't segfault when removing an extended partition
+*** The installer doesn't ship an older Guix revision
+    (https://issues.guix.gnu.org/53210)
+*** The installer cannot proceed without any non-root user accounts
+    (https://issues.guix.gnu.org/54666)
+*** <operating-system> compiler truly honors the 'system' argument
+    (https://issues.guix.gnu.org/55951)

 * Changes in 1.3.0 (since 1.2.0)
 ** Package management
@@ -66,7 +66,7 @@

 (define %manual-languages
  ;; Available translations for the 'guix-manual' text domain.
-  '("de" "en" "es" "fr" "ru" "zh_CN"))
+  '("de" "en" "es" "fr" "pt_BR" "ru" "zh_CN"))

 (define %cookbook-languages
  ;; Available translations for the 'guix-cookbook' text domain.
@@ -29,6 +29,7 @@ choice.
 * Tracking Bugs and Patches::   Keeping it all organized.
 * Commit Access::               Pushing to the official repository.
 * Updating the Guix Package::   Updating the Guix package definition.
+* Writing Documentation::       Improving documentation in GNU Guix.
 * Translating Guix::            Make Guix speak your native language.
@end menu

@@ -224,8 +225,7 @@ $ ./pre-inst-env guile -c '(use-modules (guix utils)) (pk (%current-system))'
@noindent
@cindex REPL
@cindex read-eval-print loop
-@dots{} and for a REPL (@pxref{Using Guile Interactively,,, guile, Guile
-Reference Manual}):
+@dots{} and for a REPL (@pxref{Using Guix Interactively}):

@example
 $ ./pre-inst-env guile
@@ -278,8 +278,8 @@ prepared Guile object (@file{.go}) files.

 You can run @command{make} automatically as you work using
@command{watchexec} from the @code{watchexec} package.  For example,
-to build again each time you update a package file, you can run
-@samp{watchexec -w gnu/packages make -j4}.
+to build again each time you update a package file, run
+@samp{watchexec -w gnu/packages -- make -j4}.

@node The Perfect Setup
@section The Perfect Setup
@@ -291,7 +291,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 emacs-geiser-guile
+guix install emacs guile emacs-geiser emacs-geiser-guile
@end example

 Geiser allows for interactive and incremental development from within
@@ -320,15 +320,25 @@ s-expression, etc.
@cindex reducing boilerplate
 We also provide templates for common git commit messages and package
 definitions in the @file{etc/snippets} directory.  These templates can
-be used with @url{https://joaotavora.github.io/yasnippet/, YASnippet} to
-expand short trigger strings to interactive text snippets.  You may want
-to add the snippets directory to the @var{yas-snippet-dirs} variable in
+be used to expand short trigger strings to interactive text snippets. If
+you use @url{https://joaotavora.github.io/yasnippet/, YASnippet}, you
+may want to add the @file{etc/snippets/yas} snippets directory to the
+@var{yas-snippet-dirs} variable.  If you use
+@url{https://github.com/minad/tempel/, Tempel}, you may want to add the
+@file{etc/snippets/tempel/*} path to the @var{tempel-path} variable in
 Emacs.

@lisp
 ;; @r{Assuming the Guix checkout is in ~/src/guix.}
+;; @r{Yasnippet configuration}
 (with-eval-after-load 'yasnippet
-  (add-to-list 'yas-snippet-dirs "~/src/guix/etc/snippets"))
+  (add-to-list 'yas-snippet-dirs "~/src/guix/etc/snippets/yas"))
+;; @r{Tempel configuration}
+(with-eval-after-load 'tempel
+   ;; Ensure tempel-path is a list -- it may also be a string.
+   (unless (listp 'tempel-path)
+     (setq tempel-path (list tempel-path)))
+   (add-to-list 'tempel-path "~/src/guix/etc/snippets/tempel/*"))
@end lisp

 The commit message snippets depend on @url{https://magit.vc/, Magit} to
@@ -664,7 +674,7 @@ hyperlinks (@pxref{Overview,,, texinfo, GNU Texinfo}).  However you
 should be careful when using some characters for example @samp{@@} and
 curly braces which are the basic special characters in Texinfo
 (@pxref{Special Characters,,, texinfo, GNU Texinfo}).  User interfaces
-such as @command{guix package --show} take care of rendering it
+such as @command{guix show} take care of rendering it
 appropriately.

 Synopses and descriptions are translated by volunteers
@@ -776,12 +786,29 @@ for instance, the module python-dateutil is packaged under the names
 starts with @code{py} (e.g.@: @code{pytz}), we keep it and prefix it as
 described above.

+@quotation Note
+Currently there are two different build systems for Python packages in Guix:
+@var{python-build-system} and @var{pyproject-build-system}.  For the
+longest time, Python packages were built from an informally specified
+@file{setup.py} file.  That worked amazingly well, considering Python's
+success, but was difficult to build tooling around.  As a result, a host
+of alternative build systems emerged and the community eventually settled on a
+@url{https://peps.python.org/pep-0517/, formal standard} for specifying build
+requirements.  @var{pyproject-build-system} is Guix's implementation of this
+standard.  It is considered ``experimental'' in that it does not yet support
+all the various PEP-517 @emph{build backends}, but you are encouraged to try
+it for new Python packages and report any problems.  It will eventually be
+deprecated and merged into @var{python-build-system}.
+@end quotation
+
@subsubsection Specifying Dependencies
@cindex inputs, for Python packages

 Dependency information for Python packages is usually available in the
 package source tree, with varying degrees of accuracy: in the
-@file{setup.py} file, in @file{requirements.txt}, or in @file{tox.ini}.
+@file{pyproject.toml} file, the @file{setup.py} file, in
+@file{requirements.txt}, or in @file{tox.ini} (the latter mostly for
+test dependencies).

 Your mission, when writing a recipe for a Python package, is to map
 these dependencies to the appropriate type of ``input'' (@pxref{package
@@ -792,10 +819,12 @@ following check list to determine which dependency goes where.
@itemize

@item
-We currently package Python 2 with @code{setuptools} and @code{pip}
-installed like Python 3.4 has per default.  Thus you don't need to
-specify either of these as an input.  @command{guix lint} will warn you
-if you do.
+We currently package Python with @code{setuptools} and @code{pip}
+installed per default.  This is about to change, and users are encouraged
+to use @code{python-toolchain} if they want a build environment for Python.
+
+@command{guix lint} will warn if @code{setuptools} or @code{pip} are
+added as native-inputs because they are generally not necessary.

@item
 Python dependencies required at run time go into
@@ -804,9 +833,10 @@ Python dependencies required at run time go into
@file{requirements.txt} file.

@item
-Python packages required only at build time---e.g., those listed with
-the @code{setup_requires} keyword in @file{setup.py}---or only for
-testing---e.g., those in @code{tests_require}---go into
+Python packages required only at build time---e.g., those listed under
+@code{build-system.requires} in @file{pyproject.toml} or with the
+@code{setup_requires} keyword in @file{setup.py}---or dependencies only
+for testing---e.g., those in @code{tests_require} or @file{tox.ini}---go into
@code{native-inputs}.  The rationale is that (1) they do not need to be
 propagated because they are not needed at run time, and (2) in a
 cross-compilation context, it's the ``native'' input that we'd want.
@@ -1059,11 +1089,16 @@ and then to browse them ``by hand'' using @code{car}, @code{cdr},
 notably the fact that it is hard to read, error-prone, and a hindrance
 to proper type error reports.

+@findex define-record-type*
+@findex match-record
+@cindex pattern matching
 Guix code should define appropriate data types (for instance, using
@code{define-record-type*}) rather than abuse lists.  In addition, it
 should use pattern matching, via Guile’s @code{(ice-9 match)} module,
 especially when matching lists (@pxref{Pattern Matching,,, guile, GNU
-Guile Reference Manual}).
+Guile Reference Manual}); pattern matching for records is better done
+using @code{match-record} from @code{(guix records)}, which, unlike
+@code{match}, verifies field names at macro-expansion time.

@node Formatting Code
@subsection Formatting Code
@@ -1118,18 +1153,18 @@ Development is done using the Git distributed version control system.
 Thus, access to the repository is not strictly necessary.  We welcome
 contributions in the form of patches as produced by @code{git
 format-patch} sent to the @email{guix-patches@@gnu.org} mailing list
-(@pxref{submitting patches,, Submitting patches to a project, git, Git
-User Manual}).  Contributors are encouraged to take a moment to set some
-Git repository options (@pxref{Configuring Git}) first, which can
-improve the readability of patches.  Seasoned Guix developers may also
-want to look at the section on commit access (@pxref{Commit Access}).
+(@pxref{Submitting patches to a project,,, git, Git User Manual}).
+Contributors are encouraged to take a moment to set some Git repository
+options (@pxref{Configuring Git}) first, which can improve the
+readability of patches.  Seasoned Guix developers may also want to look
+at the section on commit access (@pxref{Commit Access}).

 This mailing list is backed by a Debbugs instance, which allows us to
 keep track of submissions (@pxref{Tracking Bugs and Patches}).  Each
 message sent to that mailing list gets a new tracking number assigned;
 people can then follow up on the submission by sending email to
-@code{@var{NNN}@@debbugs.gnu.org}, where @var{NNN} is the tracking
-number (@pxref{Sending a Patch Series}).
+@code{@var{ISSUE_NUMBER}@@debbugs.gnu.org}, where @var{ISSUE_NUMBER} is
+the tracking number (@pxref{Sending a Patch Series}).

 Please write commit logs in the ChangeLog format (@pxref{Change Logs,,,
 standards, GNU Coding Standards}); you can check the commit history for
@@ -1139,15 +1174,6 @@ 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
-When generating your patches with @code{git format-patch} or @code{git
-send-email}, we recommend using the option @code{--base=}, perhaps with
-the value @code{auto}.  This option adds a note to the patch stating
-which commit the patch is based on.  This helps reviewers understand how
-to apply and review your patches.
-
@item
 If the authors of the packaged software provide a cryptographic
 signature for the release tarball, make an effort to verify the
@@ -1331,12 +1357,13 @@ guix pull --url=/path/to/your/checkout --profile=/tmp/guix.master
 When posting a patch to the mailing list, use @samp{[PATCH] @dots{}} as
 a subject, if your patch is to be applied on a branch other than
@code{master}, say @code{core-updates}, specify it in the subject like
-@samp{[PATCH core-updates] @dots{}}.  You may use your email client or
-the @command{git send-email} command (@pxref{Sending a Patch Series}).
-We prefer to get patches in plain text messages, either inline or as
-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.
+@samp{[PATCH core-updates] @dots{}}.
+
+You may use your email client or the @command{git send-email} command
+(@pxref{Sending a Patch Series}).  We prefer to get patches in plain
+text messages, either inline or as 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
@@ -1344,7 +1371,7 @@ 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}.
+@email{@var{ISSUE_NUMBER}-done@@debbugs.gnu.org}.

@node Configuring Git
@subsection Configuring Git
@@ -1382,19 +1409,180 @@ git config --local format.thread shallow
 git config --local sendemail.thread no
@end example

-@unnumberedsubsec Sending a Patch Series
-@anchor{Sending a Patch Series}
+@node Sending a Patch Series
+@subsection Sending a Patch Series
@cindex patch series
@cindex @code{git send-email}
+@cindex @code{git format-patch}

-When sending a patch series (e.g., using @code{git send-email}), please
-first send one message to @email{guix-patches@@gnu.org}, and then send
-subsequent patches to @email{@var{NNN}@@debbugs.gnu.org} to make sure
-they are kept together.  See
-@uref{https://debbugs.gnu.org/Advanced.html, the Debbugs documentation}
-for more information.  You can install @command{git send-email} with
-@command{guix install git:send-email}.
-@c Debbugs bug: https://debbugs.gnu.org/db/15/15361.html
+@unnumberedsubsubsec Single Patches
+@anchor{Single Patches}
+The @command{git send-email} command is the best way to send both single
+patches and patch series (@pxref{Multiple Patches}) to the Guix mailing
+list.  Sending patches as email attachments may make them difficult to
+review in some mail clients, and @command{git diff} does not store commit
+metadata.
+
+@quotation Note
+The @command{git send-email} command is provided by the @code{send-email}
+output of the @code{git} package, i.e. @code{git:send-email}.
+@end quotation
+
+The following command will create a patch email from the latest commit,
+open it in your @var{EDITOR} or @var{VISUAL} for editing, and send it to
+the Guix mailing list to be reviewed and merged:
+
+@example
+$ git send-email -1 -a --base=auto --to=guix-patches@@gnu.org
+@end example
+
+@quotation Tip
+To add a prefix to the subject of your patch, you may use the
+@option{--subject-prefix} option.  The Guix project uses this to
+specify that the patch is intended for a branch or repository
+other than the @code{master} branch of
+@url{https://git.savannah.gnu.org/cgit/guix.git}.
+
+@example
+git send-email -1 -a --base=auto \
+    --subject-prefix='PATCH core-updates' \
+    --to=guix-patches@@gnu.org
+@end example
+@end quotation
+
+The patch email contains a three-dash separator line after the commit
+message.  You may ``annotate'' the patch with explanatory text by adding
+it under this line.  If you do not wish to annotate the email, you may
+drop the @option{-a} flag (which is short for @option{--annotate}).
+
+The @option{--base=auto} flag automatically adds a note at the bottom
+of the patch of the commit it was based on, making it easier for
+maintainers to rebase and merge your patch.
+
+If you need to send a revised patch, don't resend it like this or send
+a ``fix'' patch to be applied on top of the last one; instead, use
+@command{git commit -a} or @url{https://git-rebase.io, @command{git rebase}}
+to modify the commit, and use the @email{@var{ISSUE_NUMBER}@@debbugs.gnu.org}
+address and the @option{-v} flag with @command{git send-email}.
+
+@example
+$ git commit -a
+$ git send-email -1 -a --base=auto -v @var{REVISION} \
+      --to=@var{ISSUE_NUMBER}@@debbugs.gnu.org
+@end example
+
+You can find out @var{ISSUE_NUMBER} either by searching on the mumi
+interface at @url{issues.guix.gnu.org} for the name of your patch or
+reading the acknowledgement email sent automatically by Debbugs in
+reply to incoming bugs and patches, which contains the bug number.
+
+@unnumberedsubsubsec Notifying Teams
+@anchor{Notifying Teams}
+@cindex teams
+The @file{etc/teams.scm} script may be used to notify all those who
+may be interested in your patch of its existence (@pxref{Teams}).
+Use @command{etc/teams.scm list-teams} to display all the teams,
+decide which team(s) your patch relates to, and use
+@command{etc/teams.scm cc} to output various @command{git send-email}
+flags which will notify the appropriate team members, or use
+@command{etc/teams.scm cc-members} to detect the appropriate teams
+automatically.
+
+@unnumberedsubsubsec Multiple Patches
+@anchor{Multiple Patches}
+@cindex cover letter
+While @command{git send-email} alone will suffice for a single
+patch, an unfortunate flaw in Debbugs means you need to be more
+careful when sending multiple patches: if you send them all to the
+@email{guix-patches@@gnu.org} address, a new issue will be created
+for each patch!
+
+When sending a series of patches, it's best to send a Git ``cover
+letter'' first, to give reviewers an overview of the patch series.
+We can create a directory called @file{outgoing} containing both
+our patch series and a cover letter called @file{0000-cover-letter.patch}
+with @command{git format-patch}.
+
+@example
+$ git format-patch -@var{NUMBER_COMMITS} -o outgoing \
+      --cover-letter --base=auto
+@end example
+
+We can now send @emph{just} the cover letter to the
+@email{guix-patches@@gnu.org} address, which will create an issue
+that we can send the rest of the patches to.
+
+@example
+$ git send-email outgoing/0000-cover-letter.patch -a \
+      --to=guix-patches@@debbugs.gnu.org \
+      $(etc/teams.scm cc-members ...)
+$ rm outgoing/0000-cover-letter.patch # we don't want to resend it!
+@end example
+
+Ensure you edit the email to add an appropriate subject line and
+blurb before sending it.  Note the automatically generated shortlog
+and diffstat below the blurb.
+
+Once the Debbugs mailer has replied to your cover letter email, you
+can send the actual patches to the newly-created issue address.
+
+@example
+$ git send-email outgoing/*.patch \
+      --to=@var{ISSUE_NUMBER}@@debbugs.gnu.org \
+      $(etc/teams.scm cc-members ...)
+$ rm -rf outgoing # we don't need these anymore
+@end example
+
+Thankfully, this @command{git format-patch} dance is not necessary
+to send an amended patch series, since an issue already exists for
+the patchset.
+
+@example
+$ git send-email -@var{NUMBER_COMMITS} \
+      -v@var{REVISION} --base=auto \
+      --to @var{ISSUE_NUMBER}@@debbugs.gnu.org
+@end example
+
+If need be, you may use @option{--cover-letter -a} to send another cover
+letter, e.g. for explaining what's changed since the last revision, and
+these changes are necessary.
+
+@node Teams
+@subsection Teams
+@cindex teams
+
+There are several teams mentoring different parts of the Guix source
+code.  To list all those teams, you can run from a Guix checkout:
+
+@example
+$ ./etc/teams.scm list-teams
+id: mentors
+name: Mentors
+description: A group of mentors who chaperone contributions by newcomers.
+members:
+ Christopher Baines <mail@@cbaines.net>
+ Ricardo Wurmus <rekado@@elephly.net>
+ Mathieu Othacehe <othacehe@@gnu.org>
+ jgart <jgart@@dismail.de>
+ Ludovic Courtès <ludo@@gnu.org>
+@dots{}
+@end example
+
+You can run the following command to have the @code{Mentors} team put in
+CC of a patch series:
+
+@example
+$ git send-email --to @var{ISSUE_NUMBER}@@debbugs.gnu.org $(./etc/teams.scm cc mentors) *.patch
+@end example
+
+The appropriate team or teams can also be inferred from the modified
+files.  For instance, if you want to send the two latest commits of the
+current Git repository to review, you can run:
+
+@example
+$ guix shell -D guix
+[env]$ git send-email --to @var{ISSUE_NUMBER}@@debbugs.gnu.org $(./etc/teams.scm cc-members HEAD~2 HEAD) *.patch
+@end example

@node Tracking Bugs and Patches
@section Tracking Bugs and Patches
@@ -1617,14 +1805,23 @@ 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 located at
-@file{etc/git/pre-push}:
+To check that commits are signed with correct key, use:
+
+@example
+make authenticate
+@end example
+
+You can prevent yourself from accidentally pushing unsigned or signed
+with the wrong key 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

+It additionally calls @code{make check-channel-news} to be sure
+@file{news.scm} file is correct.
+
@subsection Commit Policy

 If you get commit access, please make sure to follow
@@ -1779,6 +1976,47 @@ This check can be disabled, @emph{at your own peril}, by setting the
 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 documentation
+@node Writing Documentation
+@section Writing Documentation
+
+Guix is documented using the Texinfo system.  If you are not yet
+familiar with it, we accept contributions for documentation in most
+formats.  That includes plain text, Markdown, Org, etc.
+
+Documentation contributions can be sent to
+@email{guix-patches@@gnu.org}.  Prepend @samp{[DOCUMENTATION]} to the
+subject.
+
+When you need to make more than a simple addition to the documentation,
+we prefer that you send a proper patch as opposed to sending an email
+as described above.  @xref{Submitting Patches} for more information on
+how to send your patches.
+
+To modify the documentation, you need to edit @file{doc/guix.texi} and
+@file{doc/contributing.texi} (which contains this documentation
+section), or @file{doc/guix-cookbook.texi} for the cookbook.  If
+you compiled the Guix repository before, you will have
+many more @file{.texi} files that are translations of these
+documents.  Do not modify them, the translation is managed through
+@uref{https://translate.fedoraproject.org/projects/guix, Weblate}.
+@xref{Translating Guix} for more information.
+
+To render documentation, you must first make sure that you ran
+@command{./configure} in your source tree (@pxref{Running Guix Before
+It Is Installed}).  After that you can run one of the following
+commands:
+
+@itemize
+@item @samp{make doc/guix.info} to compile the Info manual.
+      You can check it with @command{info doc/guix.info}.
+@item @samp{make doc/guix.html} to compile the HTML version.
+      You can point your browser to the relevant file in the
+      @file{doc/guix.html} directory.
+@item @samp{make doc/guix-cookbook.info} for the cookbook Info manual.
+@item @samp{make doc/guix-cookbook.html} for the cookbook HTML version.
+@end itemize
+
@cindex translation
@cindex l10n
@cindex i18n
@@ -11,7 +11,7 @@
@set SUBSTITUTE-TOR-URL https://4zwzi66wwdaalbhgnix55ea3ab4pvvw66ll2ow53kjub6se4q2bclcyd.onion

@copying
-Copyright @copyright{} 2019 Ricardo Wurmus@*
+Copyright @copyright{} 2019, 2022 Ricardo Wurmus@*
 Copyright @copyright{} 2019 Efraim Flashner@*
 Copyright @copyright{} 2019 Pierre Neidhardt@*
 Copyright @copyright{} 2020 Oleg Pykhalov@*
@@ -21,6 +21,7 @@ Copyright @copyright{} 2020 Brice Waegeneire@*
 Copyright @copyright{} 2020 André Batista@*
 Copyright @copyright{} 2020 Christine Lemmer-Webber@*
 Copyright @copyright{} 2021 Joshua Branson@*
+Copyright @copyright{} 2022 Maxim Cournoyer*

 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -71,6 +72,7 @@ Weblate} (@pxref{Translating Guix,,, guix, GNU Guix reference manual}).
 * Scheme tutorials::            Meet your new favorite language!
 * Packaging::                   Packaging tutorials
 * System Configuration::        Customizing the GNU System
+* Containers::                  Isolated environments and nested systems
 * Advanced package management:: Power to the users!
 * Environment management::      Control environment

@@ -91,8 +93,17 @@ Packaging

 System Configuration

-* 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.
+* 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.
+* Using security keys::             How to use security keys with Guix System.
+* Connecting to Wireguard VPN::     Connecting to a Wireguard VPN.
+* Customizing a Window Manager::    Handle customization of a Window manager on Guix System.
+* Running Guix on a Linode Server:: Running Guix on a Linode Server.  Running Guix on a Linode Server
+* Setting up a bind mount::         Setting up a bind mount in the file-systems definition.
+* Getting substitutes from Tor::    Configuring Guix daemon to get substitutes through Tor.
+* Setting up NGINX with Lua::       Configuring NGINX web-server to load Lua modules.
+* Music Server with Bluetooth Audio:: Headless music player with Bluetooth output.

@end detailmenu
@end menu
@@ -122,7 +133,7 @@ language, install it with @code{guix install guile} and start a
@dfn{REPL}---short for @uref{https://en.wikipedia.org/wiki/Read%E2%80%93eval%E2%80%93print_loop,
@dfn{read-eval-print loop}}---by running @code{guile} from the command line.

-Alternatively you can also run @code{guix environment --ad-hoc guile -- guile}
+Alternatively you can also run @code{guix shell guile -- guile}
 if you'd rather not have Guile installed in your user profile.

 In the following examples, lines show what you would type at the REPL;
@@ -284,24 +295,41 @@ depends on the @code{(guix store)} module and it exports two variables,
@code{ruby-build} and @code{ruby-build-system}.
@end itemize

-For a more detailed introduction, check out
-@uref{http://www.troubleshooters.com/codecorn/scheme_guile/hello.htm, Scheme
-at a Glance}, by Steve Litt.
+@quotation Going further
+Scheme is a language that has been widely used to teach programming and
+you'll find plenty of material using it as a vehicle.  Here's a
+selection of documents to learn more about Scheme:

-One of the reference Scheme books is the seminal ``Structure and
-Interpretation of Computer Programs'', by Harold Abelson and Gerald Jay
-Sussman, with Julie Sussman.  You'll find a
-@uref{https://mitpress.mit.edu/sites/default/files/sicp/index.html, free copy
-online}, together with
-@uref{https://ocw.mit.edu/courses/electrical-engineering-and-computer-science/6-001-structure-and-interpretation-of-computer-programs-spring-2005/video-lectures/,
-videos of the lectures by the authors}.  The book is available in Texinfo
-format as the @code{sicp} Guix package.  Go ahead, run @code{guix install
-sicp} and start reading with @code{info sicp} (@pxref{Top,,, sicp, Structure and Interpretation of Computer Programs}).
-An @uref{https://sarabander.github.io/sicp/, unofficial ebook is also
-available}.
+@itemize
+@item
+@uref{https://spritely.institute/static/papers/scheme-primer.html, @i{A
+Scheme Primer}}, by Christine Lemmer-Webber and the Spritely Institute.
+
+@item
+@uref{http://www.troubleshooters.com/codecorn/scheme_guile/hello.htm,
+@i{Scheme at a Glance}}, by Steve Litt.
+
+@item
+@uref{https://mitpress.mit.edu/sites/default/files/sicp/index.html,
+@i{Structure and Interpretation of Computer Programs}}, by Harold
+Abelson and Gerald Jay Sussman, with Julie Sussman.  Colloquially known
+as ``SICP'', this book is a reference.
+
+You can also install it and read it from your computer:
+
+@example
+guix install sicp info-reader
+info sicp
+@end example
+
+An @uref{https://sarabander.github.io/sicp/, unofficial ebook} is also
+available.
+
+@end itemize

 You'll find more books, tutorials and other resources at
@url{https://schemers.org/}.
+@end quotation


@c *********************************************************************
@@ -1354,12 +1382,14 @@ reference.
 * 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.
+* Using security keys::          How to use security keys with Guix System.
 * Connecting to Wireguard VPN::  Connecting to a Wireguard VPN.
 * Customizing a Window Manager:: Handle customization of a Window manager on Guix System.
 * Running Guix on a Linode Server:: Running Guix on a Linode Server
 * Setting up a bind mount:: Setting up a bind mount in the file-systems definition.
 * Getting substitutes from Tor:: Configuring Guix daemon to get substitutes through Tor.
 * Setting up NGINX with Lua:: Configuring NGINX web-server to load Lua modules.
+* Music Server with Bluetooth Audio:: Headless music player with Bluetooth output.
@end menu

@node Auto-Login to a Specific TTY
@@ -1600,7 +1630,7 @@ letting you know what you're missing.  If the file is blank then you're
 missing everything.  The next step is to run:

@example shell
-guix environment linux-libre -- make localmodconfig
+guix shell -D linux-libre -- make localmodconfig
@end example

 and note the output.  Do note that the @file{.config} file is still empty.
@@ -1856,6 +1886,65 @@ guix system image --image-type=hurd-qcow2 my-hurd-os.scm

 will instead produce a Hurd QEMU image.

+@node Using security keys
+@section Using security keys
+@cindex 2FA, two-factor authentication
+@cindex U2F, Universal 2nd Factor
+@cindex security key, configuration
+
+The use of security keys can improve your security by providing a second
+authentication source that cannot be easily stolen or copied, at least
+for a remote adversary (something that you have), to the main secret (a
+passphrase -- something that you know), reducing the risk of
+impersonation.
+
+The example configuration detailed below showcases what minimal
+configuration needs to be made on your Guix System to allow the use of a
+Yubico security key.  It is hoped the configuration can be useful for
+other security keys as well, with minor adjustments.
+
+@subsection Configuration for use as a two-factor authenticator (2FA)
+
+To be usable, the udev rules of the system should be extended with
+key-specific rules.  The following shows how to extend your udev rules
+with the @file{lib/udev/rules.d/70-u2f.rules} udev rule file provided by
+the @code{libfido2} package from the @code{(gnu packages
+security-token)} module and add your user to the @samp{"plugdev"} group
+it uses:
+
+@lisp
+(use-package-modules ... security-token ...)
+...
+(operating-system
+ ...
+ (users (cons* (user-account
+               (name "your-user")
+               (group "users")
+               (supplementary-groups
+		'("wheel" "netdev" "audio" "video"
+                  "plugdev"))           ;<- added system group
+               (home-directory "/home/your-user"))
+              %base-user-accounts))
+ ...
+ (services
+  (cons*
+   ...
+   (udev-rules-service 'fido2 libfido2 #:groups '("plugdev")))))
+@end lisp
+
+After re-configuring your system and re-logging in your graphical
+session so that the new group is in effect for your user, you can verify
+that your key is usable by launching:
+
+@example
+guix shell ungoogled-chromium -- chromium chrome://settings/securityKeys
+@end example
+
+and validating that the security key can be reset via the ``Reset your
+security key'' menu.  If it works, congratulations, your security key is
+ready to be used with applications supporting two-factor authentication
+(2FA).
+
@node Connecting to Wireguard VPN
@section Connecting to Wireguard VPN

@@ -2437,6 +2526,594 @@ ngx.say(stdout)
                                                        #$(local-file "index.lua"))))))))))))))
@end lisp

+@node Music Server with Bluetooth Audio
+@section Music Server with Bluetooth Audio
+@cindex mpd
+@cindex music server, headless
+@cindex bluetooth, ALSA configuration
+
+MPD, the Music Player Daemon, is a flexible server-side application for
+playing music.  Client programs on different machines on the network ---
+a mobile phone, a laptop, a desktop workstation --- can connect to it to
+control the playback of audio files from your local music collection.
+MPD decodes the audio files and plays them back on one or many outputs.
+
+By default MPD will play to the default audio device.  In the example
+below we make things a little more interesting by setting up a headless
+music server.  There will be no graphical user interface, no Pulseaudio
+daemon, and no local audio output.  Instead we will configure MPD with
+two outputs: a bluetooth speaker and a web server to serve audio streams
+to any streaming media player.
+
+Bluetooth is often rather frustrating to set up.  You will have to pair
+your Bluetooth device and make sure that the device is automatically
+connected as soon as it powers on.  The Bluetooth system service
+returned by the @code{bluetooth-service} procedure provides the
+infrastructure needed to set this up.
+
+Reconfigure your system with at least the following services and
+packages:
+
+@lisp
+(operating-system
+  ;; …
+  (packages (cons* bluez bluez-alsa
+                   %base-packages))
+  (services
+   ;; …
+   (dbus-service #:services (list bluez-alsa))
+   (bluetooth-service #:auto-enable? #t)))
+@end lisp
+
+Start the @code{bluetooth} service and then use @command{bluetoothctl}
+to scan for Bluetooth devices.  Try to identify your Bluetooth speaker
+and pick out its device ID from the resulting list of devices that is
+indubitably dominated by a baffling smorgasbord of your neighbors' home
+automation gizmos.  This only needs to be done once:
+
+@example
+$ bluetoothctl 
+[NEW] Controller 00:11:22:33:95:7F BlueZ 5.40 [default]
+
+[bluetooth]# power on
+[bluetooth]# Changing power on succeeded
+
+[bluetooth]# agent on
+[bluetooth]# Agent registered
+
+[bluetooth]# default-agent
+[bluetooth]# Default agent request successful
+
+[bluetooth]# scan on
+[bluetooth]# Discovery started
+[CHG] Controller 00:11:22:33:95:7F Discovering: yes
+[NEW] Device AA:BB:CC:A4:AA:CD My Bluetooth Speaker
+[NEW] Device 44:44:FF:2A:20:DC My Neighbor's TV
+@dots{}
+
+[bluetooth]# pair AA:BB:CC:A4:AA:CD
+Attempting to pair with AA:BB:CC:A4:AA:CD
+[CHG] Device AA:BB:CC:A4:AA:CD Connected: yes
+
+[My Bluetooth Speaker]# [CHG] Device AA:BB:CC:A4:AA:CD UUIDs: 0000110b-0000-1000-8000-00xxxxxxxxxx
+[CHG] Device AA:BB:CC:A4:AA:CD UUIDs: 0000110c-0000-1000-8000-00xxxxxxxxxx
+[CHG] Device AA:BB:CC:A4:AA:CD UUIDs: 0000110e-0000-1000-8000-00xxxxxxxxxx
+[CHG] Device AA:BB:CC:A4:AA:CD Paired: yes
+Pairing successful
+
+[CHG] Device AA:BB:CC:A4:AA:CD Connected: no
+
+[bluetooth]# 
+[bluetooth]# trust AA:BB:CC:A4:AA:CD
+[bluetooth]# [CHG] Device AA:BB:CC:A4:AA:CD Trusted: yes
+Changing AA:BB:CC:A4:AA:CD trust succeeded
+
+[bluetooth]# 
+[bluetooth]# connect AA:BB:CC:A4:AA:CD
+Attempting to connect to AA:BB:CC:A4:AA:CD
+[bluetooth]# [CHG] Device AA:BB:CC:A4:AA:CD RSSI: -63
+[CHG] Device AA:BB:CC:A4:AA:CD Connected: yes
+Connection successful
+
+[My Bluetooth Speaker]# scan off
+[CHG] Device AA:BB:CC:A4:AA:CD RSSI is nil
+Discovery stopped
+[CHG] Controller 00:11:22:33:95:7F Discovering: no
+@end example
+
+Congratulations, you can now automatically connect to your Bluetooth
+speaker!
+
+It is now time to configure ALSA to use the @emph{bluealsa} Bluetooth
+module, so that you can define an ALSA pcm device corresponding to your
+Bluetooth speaker.  For a headless server using @emph{bluealsa} with a
+fixed Bluetooth device is likely simpler than configuring Pulseaudio and
+its stream switching behavior.  We configure ALSA by crafting a custom
+@code{alsa-configuration} for the @code{alsa-service-type}.  The
+configuration will declare a @code{pcm} type @code{bluealsa} from the
+@code{bluealsa} module provided by the @code{bluez-alsa} package, and
+then define a @code{pcm} device of that type for your Bluetooth speaker.
+
+All that is left then is to make MPD send audio data to this ALSA
+device.  We also add a secondary MPD output that makes the currently
+played audio files available as a stream through a web server on port
+8080.  When enabled a device on the network could listen to the audio
+stream by connecting any capable media player to the HTTP server on port
+8080, independent of the status of the Bluetooth speaker.
+
+What follows is the outline of an @code{operating-system} declaration
+that should accomplish the above-mentioned tasks:
+
+@lisp
+(use-modules (gnu))
+(use-service-modules audio dbus sound #;… etc)
+(use-package-modules audio linux #;… etc)
+(operating-system
+  ;; …
+  (packages (cons* bluez bluez-alsa
+                   %base-packages))
+  (services
+   ;; …
+   (service mpd-service-type
+            (mpd-configuration
+             (user "your-username")
+             (music-dir "/path/to/your/music")
+             (address "192.168.178.20")
+             (outputs (list (mpd-output
+                             (type "alsa")
+                             (name "MPD")
+                             (extra-options
+                              ;; Use the same name as in the ALSA
+                              ;; configuration below.
+                              '((device . "pcm.btspeaker"))))
+                            (mpd-output
+                             (type "httpd")
+                             (name "streaming")
+                             (enabled? #false)
+                             (always-on? #true)
+                             (tags? #true)
+                             (mixer-type 'null)
+                             (extra-options
+                              '((encoder . "vorbis")
+                                (port    . "8080")
+                                (bind-to-address . "192.168.178.20")
+                                (max-clients . "0") ;no limit
+                                (quality . "5.0")
+                                (format  . "44100:16:1"))))))))
+   (dbus-service #:services (list bluez-alsa))
+   (bluetooth-service #:auto-enable? #t)
+   (service alsa-service-type
+            (alsa-configuration
+             (pulseaudio? #false) ;we don't need it
+             (extra-options
+              #~(string-append "\
+# Declare Bluetooth audio device type \"bluealsa\" from bluealsa module
+pcm_type.bluealsa @{
+    lib \"" #$(file-append bluez-alsa "/lib/alsa-lib/libasound_module_pcm_bluealsa.so") "\"
+@}
+
+# Declare control device type \"bluealsa\" from the same module
+ctl_type.bluealsa @{
+    lib \"" #$(file-append bluez-alsa "/lib/alsa-lib/libasound_module_ctl_bluealsa.so") "\"
+@}
+
+# Define the actual Bluetooth audio device.
+pcm.btspeaker @{
+    type bluealsa
+    device \"AA:BB:CC:A4:AA:CD\" # unique device identifier
+    profile \"a2dp\"
+@}
+
+# Define an associated controller.
+ctl.btspeaker @{
+    type bluealsa
+@}
+"))))))
+@end lisp
+
+Enjoy the music with the MPD client of your choice or a media player
+capable of streaming via HTTP!
+
+
+@c *********************************************************************
+@node Containers
+@chapter Containers
+
+The kernel Linux provides a number of shared facilities that are
+available to processes in the system.  These facilities include a shared
+view on the file system, other processes, network devices, user and
+group identities, and a few others.  Since Linux 3.19 a user can choose
+to @emph{unshare} some of these shared facilities for selected
+processes, providing them (and their child processes) with a different
+view on the system.
+
+A process with an unshared @code{mount} namespace, for example, has its
+own view on the file system --- it will only be able to see directories
+that have been explicitly bound in its mount namespace.  A process with
+its own @code{proc} namespace will consider itself to be the only
+process running on the system, running as PID 1.
+
+Guix uses these kernel features to provide fully isolated environments
+and even complete Guix System containers, lightweight virtual machines
+that share the host system's kernel.  This feature comes in especially
+handy when using Guix on a foreign distribution to prevent interference
+from foreign libraries or configuration files that are available
+system-wide.
+
+@menu
+* Guix Containers::            Perfectly isolated environments
+* Guix System Containers::     A system inside your system
+@end menu
+
+@node Guix Containers
+@section Guix Containers
+
+The easiest way to get started is to use @command{guix shell} with the
+@option{--container} option.  @xref{Invoking guix shell,,, guix, GNU
+Guix Reference Manual} for a reference of valid options.
+
+The following snippet spawns a minimal shell process with most
+namespaces unshared from the system.  The current working directory is
+visible to the process, but anything else on the file system is
+unavailable.  This extreme isolation can be very useful when you want to
+rule out any sort of interference from environment variables, globally
+installed libraries, or configuration files.
+
+@example
+guix shell --container
+@end example
+
+It is a bleak environment, barren, desolate.  You will find that not
+even the GNU coreutils are available here, so to explore this deserted
+wasteland you need to use built-in shell commands.  Even the usually
+gigantic @file{/gnu/store} directory is reduced to a faint shadow of
+itself.
+
+@example sh
+$ echo /gnu/store/*
+/gnu/store/@dots{}-gcc-10.3.0-lib
+/gnu/store/@dots{}-glibc-2.33
+/gnu/store/@dots{}-bash-static-5.1.8
+/gnu/store/@dots{}-ncurses-6.2.20210619
+/gnu/store/@dots{}-bash-5.1.8
+/gnu/store/@dots{}-profile
+/gnu/store/@dots{}-readline-8.1.1
+@end example
+
+@cindex exiting a container
+There isn't much you can do in an environment like this other than
+exiting it.  You can use @key{^D} or @command{exit} to terminate this
+limited shell environment.
+
+@cindex exposing directories, container
+@cindex sharing directories, container
+@cindex mapping locations, container
+You can make other directories available inside of the container
+environment; use @option{--expose=DIRECTORY} to bind-mount the given
+directory as a read-only location inside the container, or use
+@option{--share=DIRECTORY} to make the location writable.  With an
+additional mapping argument after the directory name you can control the
+name of the directory inside the container.  In the following example we
+map @file{/etc} on the host system to @file{/the/host/etc} inside a
+container in which the GNU coreutils are installed.
+
+@example sh
+$ guix shell --container --share=/etc=/the/host/etc coreutils
+$ ls /the/host/etc
+@end example
+
+Similarly, you can prevent the current working directory from being
+mapped into the container with the @option{--no-cwd} option.  Another
+good idea is to create a dedicated directory that will serve as the
+container's home directory, and spawn the container shell from that
+directory.
+
+@cindex hide system libraries, container
+@cindex avoid ABI mismatch, container
+On a foreign system a container environment can be used to compile
+software that cannot possibly be linked with system libraries or with
+the system's compiler toolchain.  A common use-case in a research
+context is to install packages from within an R session.  Outside of a
+container environment there is a good chance that the foreign compiler
+toolchain and incompatible system libraries are found first, resulting
+in incompatible binaries that cannot be used by R.  In a container shell
+this problem disappears, as system libraries and executables simply
+aren't available due to the unshared @code{mount} namespace.
+
+Let's take a comprehensive manifest providing a comfortable development
+environment for use with R:
+
+@lisp
+(specifications->manifest
+  (list "r-minimal"
+
+        ;; base packages
+        "bash-minimal"
+        "glibc-locales"
+        "nss-certs"
+
+        ;; Common command line tools lest the container is too empty.
+        "coreutils"
+        "grep"
+        "which"
+        "wget"
+        "sed"
+
+        ;; R markdown tools
+        "pandoc"
+
+        ;; Toolchain and common libraries for "install.packages"
+        "gcc-toolchain@@10"
+        "gfortran-toolchain"
+        "gawk"
+        "tar"
+        "gzip"
+        "unzip"
+        "make"
+        "cmake"
+        "pkg-config"
+        "cairo"
+        "libxt"
+        "openssl"
+        "curl"
+        "zlib"))
+@end lisp
+
+Let's use this to run R inside a container environment.  For convenience
+we share the @code{net} namespace to use the host system's network
+interfaces.  Now we can build R packages from source the traditional way
+without having to worry about ABI mismatch or incompatibilities.
+
+@example sh
+$ guix shell --container --network --manifest=manifest.scm -- R
+
+R version 4.2.1 (2022-06-23) -- "Funny-Looking Kid"
+Copyright (C) 2022 The R Foundation for Statistical Computing
+@dots{}
+> e <- Sys.getenv("GUIX_ENVIRONMENT")
+> Sys.setenv(GIT_SSL_CAINFO=paste0(e, "/etc/ssl/certs/ca-certificates.crt"))
+> Sys.setenv(SSL_CERT_FILE=paste0(e, "/etc/ssl/certs/ca-certificates.crt"))
+> Sys.setenv(SSL_CERT_DIR=paste0(e, "/etc/ssl/certs"))
+> install.packages("Cairo", lib=paste0(getwd()))
+@dots{}
+* installing *source* package 'Cairo' ...
+@dots{}
+* DONE (Cairo)
+
+The downloaded source packages are in
+	'/tmp/RtmpCuwdwM/downloaded_packages'
+> library("Cairo", lib=getwd())
+> # success!
+@end example
+
+Using container shells is fun, but they can become a little cumbersome
+when you want to go beyond just a single interactive process.  Some
+tasks become a lot easier when they sit on the rock solid foundation of
+a proper Guix System and its rich set of system services.  The next
+section shows you how to launch a complete Guix System inside of a
+container.
+
+
+@node Guix System Containers
+@section Guix System Containers
+
+The Guix System provides a wide array of interconnected system services
+that are configured declaratively to form a dependable stateless GNU
+System foundation for whatever tasks you throw at it.  Even when using
+Guix on a foreign distribution you can benefit from the design of Guix
+System by running a system instance as a container.  Using the same
+kernel features of unshared namespaces mentioned in the previous
+section, the resulting Guix System instance is isolated from the host
+system and only shares file system locations that you explicitly
+declare.
+
+A Guix System container differs from the shell process created by
+@command{guix shell --container} in a number of important ways.  While
+in a container shell the containerized process is a Bash shell process,
+a Guix System container runs the Shepherd as PID 1.  In a system
+container all system services (@pxref{Services,,, guix, GNU Guix
+Reference Manual}) are set up just as they would be on a Guix System in
+a virtual machine or on bare metal---this includes daemons managed by
+the GNU@tie{}Shepherd (@pxref{Shepherd Services,,, guix, GNU Guix
+Reference Manual}) as well as other kinds of extensions to the operating
+system (@pxref{Service Composition,,, guix, GNU Guix Reference Manual}).
+
+The perceived increase in complexity of running a Guix System container
+is easily justified when dealing with more complex applications that
+have higher or just more rigid requirements on their execution
+contexts---configuration files, dedicated user accounts, directories for
+caches or log files, etc.  In Guix System the demands of this kind of
+software are satisfied through the deployment of system services.
+
+
+@node A Database Container
+@subsection A Database Container
+
+A good example might be a PostgreSQL database server.  Much of the
+complexity of setting up such a database server is encapsulated in this
+deceptively short service declaration:
+
+@lisp
+(service postgresql-service-type
+         (postgresql-configuration
+          (postgresql postgresql-14)))
+@end lisp
+
+A complete operating system declaration for use with a Guix System
+container would look something like this:
+
+@lisp
+(use-modules (gnu))
+(use-package-modules databases)
+(use-service-modules databases)
+
+(operating-system
+  (host-name "container")
+  (timezone "Europe/Berlin")
+  (file-systems (cons (file-system
+                        (device (file-system-label "does-not-matter"))
+                        (mount-point "/")
+                        (type "ext4"))
+                      %base-file-systems))
+  (bootloader (bootloader-configuration
+               (bootloader grub-bootloader)
+               (targets '("/dev/sdX"))))
+  (services
+   (cons* (service postgresql-service-type
+                   (postgresql-configuration
+                    (postgresql postgresql-14)
+                    (config-file
+                     (postgresql-config-file
+                      (log-destination "stderr")
+                      (hba-file
+                       (plain-file "pg_hba.conf"
+                                   "\
+local	all	all			trust
+host	all	all	10.0.0.1/32 	trust"))
+                      (extra-config
+                       '(("listen_addresses" "*")
+                         ("log_directory"    "/var/log/postgresql")))))))
+          (service postgresql-role-service-type
+                   (postgresql-role-configuration
+                    (roles
+                     (list (postgresql-role
+                            (name "test")
+                            (create-database? #t))))))
+          %base-services)))
+@end lisp
+
+With @code{postgresql-role-service-type} we define a role ``test'' and
+create a matching database, so that we can test right away without any
+further manual setup.  The @code{postgresql-config-file} settings allow
+a client from IP address 10.0.0.1 to connect without requiring
+authentication---a bad idea in production systems, but convenient for
+this example.
+
+Let's build a script that will launch an instance of this Guix System as
+a container.  Write the @code{operating-system} declaration above to a
+file @file{os.scm} and then use @command{guix system container} to build
+the launcher.  (@pxref{Invoking guix system,,, guix, GNU Guix Reference
+Manual}).
+
+@example
+$ guix system container os.scm
+The following derivations will be built:
+  /gnu/store/@dots{}-run-container.drv
+  @dots{}
+building /gnu/store/@dots{}-run-container.drv...
+/gnu/store/@dots{}-run-container
+@end example
+
+Now that we have a launcher script we can run it to spawn the new system
+with a running PostgreSQL service.  Note that due to some as yet
+unresolved limitations we need to run the launcher as the root user, for
+example with @command{sudo}.
+
+@example
+$ sudo /gnu/store/@dots{}-run-container
+system container is running as PID 5983
+@dots{}
+@end example
+
+Background the process with @key{Ctrl-z} followed by @command{bg}.  Note
+the process ID in the output; we will need it to connect to the
+container later.  You know what?  Let's try attaching to the container
+right now.  We will use @command{nsenter}, a tool provided by the
+@code{util-linux} package:
+
+@example
+$ guix shell util-linux
+$ sudo nsenter -a -t 5983
+root@@container /# pgrep -a postgres
+49 /gnu/store/@dots{}-postgresql-14.4/bin/postgres -D /var/lib/postgresql/data --config-file=/gnu/store/@dots{}-postgresql.conf -p 5432
+51 postgres: checkpointer
+52 postgres: background writer
+53 postgres: walwriter
+54 postgres: autovacuum launcher
+55 postgres: stats collector
+56 postgres: logical replication launcher
+root@@container /# exit
+@end example
+
+The PostgreSQL service is running in the container!
+
+
+@node Container Networking
+@subsection Container Networking
+@cindex container networking
+
+What good is a Guix System running a PostgreSQL database service as a
+container when we can only talk to it with processes originating in the
+container?  It would be much better if we could talk to the database
+over the network.
+
+The easiest way to do this is to create a pair of connected virtual
+Ethernet devices (known as @code{veth}).  We move one of the devices
+(@code{ceth-test}) into the @code{net} namespace of the container and
+leave the other end (@code{veth-test}) of the connection on the host
+system.
+
+@example
+pid=5983
+ns="guix-test"
+host="veth-test"
+client="ceth-test"
+
+# Attach the new net namespace "guix-test" to the container PID.
+sudo ip netns attach $ns $pid
+
+# Create the pair of devices
+sudo ip link add $host type veth peer name $client
+
+# Move the client device into the container's net namespace
+sudo ip link set $client netns $ns
+@end example
+
+Then we configure the host side:
+
+@example
+sudo ip link set $host up
+sudo ip addr add 10.0.0.1/24 dev $host
+@end example
+
+@dots{}and then we configure the client side:
+
+@example
+sudo ip netns exec $ns  ip link set lo up
+sudo ip netns exec $ns  ip link set $client up
+sudo ip netns exec $ns  ip addr add 10.0.0.2/24 dev $client
+@end example
+
+At this point the host can reach the container at IP address 10.0.0.2,
+and the container can reach the host at IP 10.0.0.1.  This is all we
+need to talk to the database server inside the container from the host
+system on the outside.
+
+@example
+$ psql -h 10.0.0.2 -U test
+psql (14.4)
+Type "help" for help.
+
+test=> CREATE TABLE hello (who TEXT NOT NULL);
+CREATE TABLE
+test=> INSERT INTO hello (who) VALUES ('world');
+INSERT 0 1
+test=> SELECT * FROM hello;
+  who
+-------
+ world
+(1 row)
+@end example
+
+Now that we're done with this little demonstration let's clean up:
+
+@example
+sudo kill $pid
+sudo ip netns del $ns
+sudo ip link del $host
+@end example
+
+
@c *********************************************************************
@node Advanced package management
@chapter Advanced package management
@@ -2787,7 +3464,7 @@ Maybe a dependency from our manifest has been updated; or we may have run
 garbage-collected.

@item
-Eventually, we set to work on that project again, so we run @code{guix environment
+Eventually, we set to work on that project again, so we run @code{guix shell
   -m manifest.scm}.  But now we have to wait for Guix to build and install
 stuff!
@end enumerate
@@ -2826,8 +3503,8 @@ to reproduce the exact same profile:
 GUIX_EXTRA_PROFILES=$HOME/.guix-extra-profiles
 GUIX_EXTRA=$HOME/.guix-extra

-mkdir "$GUIX_EXTRA"/my-project
-guix pull --channels=channel-specs.scm --profile "$GUIX_EXTRA/my-project/guix"
+mkdir -p "$GUIX_EXTRA"/my-project
+guix pull --channels=channel-specs.scm --profile="$GUIX_EXTRA/my-project/guix"

 mkdir -p "$GUIX_EXTRA_PROFILES/my-project"
 "$GUIX_EXTRA"/my-project/guix/bin/guix package --manifest=/path/to/guix-my-project-manifest.scm --profile="$GUIX_EXTRA_PROFILES"/my-project/my-project
@@ -1,7 +1,7 @@
 # htmlxref.cnf - reference file for free Texinfo manuals on the web.
 # Modified by Ludovic Courtès <ludo@gnu.org> for the GNU Guix manual.

-htmlxrefversion=2022-06-16.15; # UTC
+htmlxrefversion=2022-08-04.13; # UTC

 # Copyright 2010-2020, 2022 Free Software Foundation, Inc.
 # 
@@ -413,7 +413,7 @@ guile-rpc	mono	${GS}/guile-rpc/manual/guile-rpc.html
 guile-rpc	node	${GS}/guile-rpc/manual/html_node/

 GUIX_ROOT = https://guix.gnu.org
-GUIX = ${GUIX_ROOT}/guix/manual
+GUIX = ${GUIX_ROOT}/manual
 guix.de	mono	${GUIX}/de/guix.de.html
 guix.de	node	${GUIX}/de/html_node/
 guix.es	mono	${GUIX}/es/guix.es.html
@@ -179,19 +179,31 @@ sub_commands_mans =				\
  $(srcdir)/%D%/guix-archive.1			\
  $(srcdir)/%D%/guix-build.1			\
  $(srcdir)/%D%/guix-challenge.1		\
+  $(srcdir)/%D%/guix-container.1		\
+  $(srcdir)/%D%/guix-copy.1			\
  $(srcdir)/%D%/guix-deploy.1			\
+  $(srcdir)/%D%/guix-describe.1			\
  $(srcdir)/%D%/guix-download.1			\
  $(srcdir)/%D%/guix-edit.1			\
  $(srcdir)/%D%/guix-environment.1		\
  $(srcdir)/%D%/guix-gc.1			\
+  $(srcdir)/%D%/guix-git.1			\
+  $(srcdir)/%D%/guix-graph.1			\
  $(srcdir)/%D%/guix-hash.1			\
+  $(srcdir)/%D%/guix-home.1			\
  $(srcdir)/%D%/guix-import.1			\
  $(srcdir)/%D%/guix-lint.1			\
+  $(srcdir)/%D%/guix-offload.1			\
+  $(srcdir)/%D%/guix-pack.1			\
  $(srcdir)/%D%/guix-package.1			\
+  $(srcdir)/%D%/guix-processes.1		\
  $(srcdir)/%D%/guix-publish.1			\
  $(srcdir)/%D%/guix-pull.1			\
  $(srcdir)/%D%/guix-refresh.1			\
+  $(srcdir)/%D%/guix-repl.1			\
+  $(srcdir)/%D%/guix-shell.1			\
  $(srcdir)/%D%/guix-size.1			\
+  $(srcdir)/%D%/guix-style.1			\
  $(srcdir)/%D%/guix-system.1			\
  $(srcdir)/%D%/guix-time-machine.1		\
  $(srcdir)/%D%/guix-weather.1
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021-2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -30,11 +30,12 @@
  (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.
+     ;; As of version 0.4.0, Disarchive can only deal with raw tarballs,
+     ;; gzip-compressed tarballs, and xz-compressed tarballs.
     (and (origin-hash origin)
          (or (string-suffix? ".tar.gz" file)
              (string-suffix? ".tgz" file)
+              (string-suffix? ".tar.xz" file)
              (string-suffix? ".tar" file))))))

 (define (origin->disarchive origin)
@@ -98,6 +99,20 @@ an empty directory if ORIGIN could not be disassembled."
  (directory-union "disarchive-collection"
                   (filter-map (lambda (origin)
                                 (and (tarball-origin? origin)
+
+                                      ;; Dismiss origins with (sha256 #f) such
+                                      ;; as that of IceCat.
+                                      (and=> (origin-hash origin)
+                                             content-hash-value)
+
+                                      ;; FIXME: Exclude the Chromium tarball
+                                      ;; because it's huge and "disarchive
+                                      ;; disassemble" exceeds the max-silent
+                                      ;; timeout.
+                                      (not (string-prefix?
+                                            "chromium-"
+                                            (origin-actual-file-name origin)))
+
                                      (origin->disarchive origin)))
                               origins)
                   #:copy? #t))
@@ -9,10 +9,16 @@ Description=Build daemon for GNU Guix
 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
 StandardError=syslog

+# Work around a nasty systemd ‘feature’ that kills the entire process tree
+# (including the daemon!) if any child, such as cc1plus, runs out of memory.
+OOMPolicy=continue
+
+# Despite the name, this is rate-limited: a broken daemon will eventually fail.
+Restart=always
+
 # See <https://lists.gnu.org/archive/html/guix-devel/2016-04/msg00608.html>.
 # Some package builds (for example, go@1.8.1) may require even more than
 # 1024 tasks.
@@ -3,13 +3,14 @@
 # Copyright © 2017 sharlatan <sharlatanus@gmail.com>
 # Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
 # Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
-# Copyright © 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
+# Copyright © 2019–2020, 2022 Tobias Geerinckx-Rice <me@tobias.gr>
 # Copyright © 2020 Morgan Smith <Morgan.J.Smith@outlook.com>
 # Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com>
 # 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>
+# Copyright © 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+# Copyright © 2022 Prafulla Giri <prafulla.giri@protonmail.com>
 #
 # This file is part of GNU Guix.
 #
@@ -33,7 +34,7 @@ then
    exec bash "$0" "$@"
 fi

-set -e
+set -eo pipefail

 [ "$UID" -eq 0 ] || { echo "This script must be run as root."; exit 1; }

@@ -92,17 +93,20 @@ _debug()
    fi
 }

-# Return true if user answered yes, false otherwise.
+die()
+{
+    _err "${ERR}$*"
+    exit 1
+}
+
+# Return true if user answered yes, false otherwise.  The prompt is
+# yes-biased, that is, when the user simply enter newline, it is equivalent to
+# answering "yes".
 # $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
+    local -l yn
+    read -rp "$1 [Y/n]" yn
+    [[ ! $yn || $yn = y || $yn = yes ]] || return 1
 }

 chk_require()
@@ -134,21 +138,27 @@ chk_gpg_keyring()
        gpg_key_id=${GPG_SIGNING_KEYS[$user_id]}
        # Without --dry-run this command will create a ~/.gnupg owned by root on
        # systems where gpg has never been used, causing errors and confusion.
-        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 \
+        if gpg --dry-run --list-keys "$gpg_key_id" >/dev/null 2>&1; then
+            continue
+        fi
+        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).
+Would you like me to fetch it for you?"; then
+            # Use a reasonable time-out here so users don't report silent
+            # ‘freezes’ when Savannah goes out to lunch, as has happened.
+            if wget "https://sv.gnu.org/people/viewgpg.php?user_id=$user_id" \
+                    --timeout=30 --no-verbose -O- | gpg --import -; then
+                continue
+            fi
+        fi
+	# If we reach this point, the key is (still) missing.  Report further
+	# missing keys, if any, but then abort the installation.
+        _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
+        exit_flag=yes
    done
    if [ "$exit_flag" = yes ]; then
        exit 1
@@ -220,8 +230,7 @@ chk_sys_arch()
            local arch=powerpc64le
            ;;
        *)
-            _err "${ERR}Unsupported CPU type: ${arch}"
-            exit 1
+            die "Unsupported CPU type: ${arch}"
    esac

    case "$os" in
@@ -229,8 +238,7 @@ chk_sys_arch()
            local os=linux
            ;;
        *)
-            _err "${ERR}Your operation system (${os}) is not supported."
-            exit 1
+            die "Your operation system (${os}) is not supported."
    esac

    ARCH_OS="${arch}-${os}"
@@ -254,7 +262,7 @@ chk_sys_nscd()
 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
+discover substitute servers on the local network?"; then
        sed -i 's/--discover=no/--discover=yes/' "$1"
    fi
 }
@@ -285,8 +293,7 @@ guix_get_bin_list()
    if [[ "${#bin_ver_ls}" -ne "0" ]]; then
        _msg "${PAS}Release for your system: ${default_ver}"
    else
-        _err "${ERR}Could not obtain list of Guix releases."
-        exit 1
+        die "Could not obtain list of Guix releases."
    fi

    # Use default to download according to the list and local ARCH_OS.
@@ -311,8 +318,7 @@ guix_get_bin()
            "${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
+        die "could not download ${url}/${bin_ver}.tar.xz."
    fi

    pushd "${dl_path}" >/dev/null
@@ -320,8 +326,7 @@ guix_get_bin()
        _msg "${PAS}Signature is valid."
        popd >/dev/null
    else
-        _err "${ERR}could not verify the signature."
-        exit 1
+        die "could not verify the signature."
    fi
 }

@@ -333,8 +338,7 @@ sys_create_store()
    _debug "--- [ ${FUNCNAME[0]} ] ---"

    if [[ -e "/var/guix" || -e "/gnu" ]]; then
-        _err "${ERR}A previous Guix installation was found.  Refusing to overwrite."
-        exit 1
+        die "A previous Guix installation was found.  Refusing to overwrite."
    fi

    cd "$tmp_path"
@@ -488,14 +492,22 @@ sys_enable_guix_daemon()
 }

 sys_authorize_build_farms()
-{ # authorize the public key of the build farm
+{ # authorize the public key(s) of the build farm(s)
+    local hosts=(
+	ci.guix.gnu.org
+	bordeaux.guix.gnu.org
+    )
+
    if prompt_yes_no "Permit downloading pre-built package binaries from the \
-project's build farm? (yes/no)"; then
-        guix archive --authorize \
-             < ~root/.config/guix/current/share/guix/ci.guix.gnu.org.pub \
-            && _msg "${PAS}Authorized public key for ci.guix.gnu.org"
-        else
-            _msg "${INF}Skipped authorizing build farm public keys"
+project's build farms?"; then
+	for host in "${hosts[@]}"; do
+	    local key=~root/.config/guix/current/share/guix/$host.pub
+	    [ -f "$key" ] \
+		&& guix archive --authorize < "$key" \
+		&& _msg "${PAS}Authorized public key for $host"
+	done
+    else
+        _msg "${INF}Skipped authorizing build farm public keys"
    fi
 }

@@ -503,7 +515,17 @@ sys_create_init_profile()
 { # 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
+    cat <<"EOF" > /etc/profile.d/zzz-guix.sh
+# Explicitly initialize XDG base directory variables to ease compatibility
+# with Guix System: see <https://issues.guix.gnu.org/56050#3>.
+export XDG_DATA_HOME="${XDG_DATA_HOME:-$HOME/.local/share}"
+export XDG_CONFIG_HOME="${XDG_CONFIG_HOME:-$HOME/.config}"
+export XDG_STATE_HOME="${XDG_STATE_HOME:-$HOME/.local/state}"
+export XDG_DATA_DIRS="${XDG_DATA_DIRS:-/usr/local/share/:/usr/share/}"
+export XDG_CONFIG_DIRS="${XDG_CONFIG_DIRS:-/etc/xdg}"
+export XDG_CACHE_HOME="${XDG_CACHE_HOME:-$HOME/.cache}"
+# no default for XDG_RUNTIME_DIR (depends on foreign distro for semantics)
+
 # _GUIX_PROFILE: `guix pull` profile
 _GUIX_PROFILE="$HOME/.config/guix/current"
 export PATH="$_GUIX_PROFILE/bin${PATH:+:}$PATH"
@@ -514,15 +536,14 @@ export PATH="$_GUIX_PROFILE/bin${PATH:+:}$PATH"
 export INFOPATH="$_GUIX_PROFILE/share/info:$INFOPATH"

 # GUIX_PROFILE: User's default profile
-GUIX_PROFILE="$HOME/.guix-profile"
+# Prefer the one from 'guix home' if it exists.
+GUIX_PROFILE="$HOME/.guix-home/profile"
+[ -L $GUIX_PROFILE ] || GUIX_PROFILE="$HOME/.guix-profile"
 [ -L $GUIX_PROFILE ] || return
 GUIX_LOCPATH="$GUIX_PROFILE/lib/locale"
 export GUIX_LOCPATH

 [ -f "$GUIX_PROFILE/etc/profile" ] && . "$GUIX_PROFILE/etc/profile"
-
-# set XDG_DATA_DIRS to include Guix installations
-export XDG_DATA_DIRS="$GUIX_PROFILE/share:${XDG_DATA_DIRS:-/usr/local/share/:/usr/share/}"
 EOF
 }

@@ -545,9 +566,28 @@ sys_create_shell_completion()
        _msg "${PAS}installed shell completion"
 }

+sys_customize_bashrc()
+{
+    prompt_yes_no "Customize users Bash shell prompt for Guix?" || return
+    for bashrc in /home/*/.bashrc /root/.bashrc; do
+        test -f "$bashrc" || continue
+        grep -Fq '$GUIX_ENVIRONMENT' "$bashrc" && continue
+        cp "${bashrc}" "${bashrc}.bak"
+        echo '
+# Automatically added by the Guix install script.
+if [ -n "$GUIX_ENVIRONMENT" ]; then
+    if [[ $PS1 =~ (.*)"\\$" ]]; then
+        PS1="${BASH_REMATCH[1]} [env]\\\$ "
+    fi
+fi
+' >> "$bashrc"
+    done
+    _msg "${PAS}Bash shell prompt successfully customized for Guix"
+}

 welcome()
 {
+    local char
    cat<<"EOF"
    ░░░                                     ░░░
    ░░▒▒░░░░░░░░░               ░░░░░░░░░▒▒░░
@@ -573,8 +613,15 @@ This script installs GNU Guix on your system

 https://www.gnu.org/software/guix/
 EOF
-    echo -n "Press return to continue..."
-    read -r
+    # Don't use ‘read -p’ here!  It won't display when run non-interactively.
+    echo -n "Press return to continue..."$'\r'
+    read -r char
+    if [ "$char" ]; then
+	echo
+	echo "...that ($char) was not a return!"
+	_msg "${WAR}Use newlines to automate installation, e.g.: yes '' | ${0##*/}"
+	_msg "${WAR}Any other method is unsupported and likely to break in future."
+    fi
 }

 main()
@@ -594,7 +641,7 @@ main()
    _msg "${INF}system is ${ARCH_OS}"

    umask 0022
-    tmp_path="$(mktemp -t -d guix.XXX)"
+    tmp_path="$(mktemp -t -d guix.XXXXXX)"

    if [ -z "${GUIX_BINARY_FILE_NAME}" ]; then
        guix_get_bin_list "${GNU_URL}"
@@ -614,6 +661,7 @@ main()
    sys_authorize_build_farms
    sys_create_init_profile
    sys_create_shell_completion
+    sys_customize_bashrc

    _msg "${INF}cleaning up ${tmp_path}"
    rm -r "${tmp_path}"
@@ -11,10 +11,12 @@ After=guix-daemon.service
 [Service]
 ExecStart=@localstatedir@/guix/profiles/per-user/root/current-guix/bin/guix publish --user=nobody --port=8181
 Environment='GUIX_LOCPATH=@localstatedir@/guix/profiles/per-user/root/guix-profile/lib/locale' LC_ALL=en_US.utf8
-RemainAfterExit=yes
 StandardOutput=syslog
 StandardError=syslog

+# Despite the name, this is rate-limited: a broken daemon will eventually fail.
+Restart=always
+
 # See <https://lists.gnu.org/archive/html/guix-devel/2016-04/msg00608.html>.
 TasksMax=1024

@@ -6,7 +6,7 @@
 ;; Copyright © 2019, 2020 Konrad Hinsen <konrad.hinsen@fastmail.net>
 ;; Copyright © 2019, 2020, 2021 Julien Lepiller <julien@lepiller.eu>
 ;; Copyright © 2019–2022 Florian Pelz <pelzflorian@pelzflorian.de>
-;; Copyright © 2020 Marius Bakke <mbakke@fastmail.com>
+;; Copyright © 2020, 2022 Marius Bakke <marius@gnu.org>
 ;; Copyright © 2020, 2021 Mathieu Othacehe <m.othacehe@gmail.com>
 ;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;; Copyright © 2020, 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
@@ -17,6 +17,7 @@
 ;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
 ;; Copyright © 2021 Jonathan Brielmaier <jonathan.brielmaier@web.de>
+;; Copyright © 2022 Thiago Jung Bauermann <bauermann@kolabnow.com>
 ;;
 ;; Copying and distribution of this file, with or without modification, are
 ;; permitted in any medium without royalty provided the copyright notice and
@@ -25,15 +26,403 @@
 (channel-news
 (version 0)

+ (entry (commit "788602b37ff42f730d4b7b569b0fb51465f147da")
+        (title
+         (en "New @option{--symlink} option for @command{guix shell}")
+         (de "Neue Option @option{--symlink} für @command{guix shell}")
+         (fr "Nouvelle option @option{--symlink} pour @command{guix shell}"))
+        (body
+         (en "The @command{guix shell} command has a new
+@option{--symlink} (or @option{-S}) option, to be used in conjunction with the
+@option{--container} (or @option{-C}) option to create a symbolic link inside
+the container.  Run @command{info \"(guix) Invoking guix shell\"} for more
+information.")
+         (de "Der Befehl @command{guix shell} verfügt jetzt über eine neue
+Befehlszeilenoption @option{--symlink} (oder @option{-S}), die zusammen mit der
+Option @option{--container} (oder @option{-C}) benutzt werden kann, um eine
+symbolische Verknüpfung im Container anzulegen.  Führen Sie
+@command{info \"(guix.de) Aufruf von guix shell\"} aus, um mehr zu erfahren.")
+         (fr "La commande @command{guix shell} dispose d'une nouvelle option,
+@option{--symlink} (ou @option{-S}), qui doit être utilisée en conjonction
+avec l'option @option{--container} (ou @option{-C}) pour créer un lien
+symbolique dans le conteneur.  Lancer @command{info \"(guix.fr) Invoquer guix
+shell\"} pour plus d'informations.")))
+
+ (entry (commit "82a0a395d7051eab7b9f15ec4740d58c86413604")
+        (title
+         (en "Linux-libre kernel updated to 6.0")
+         (de "Linux-libre-Kernel wird auf 6.0 aktualisiert")
+         (fr "Le noyau linux-libre est mis à jour vers la 6.0")
+         (pt "Kernel linux-libre atualizado para 6.0"))
+        (body
+         (en "The default version of the linux-libre kernel has been
+              updated to the 6.0 release series.")
+         (de "Der standardmäßig verwendete @code{linux-libre}-Kernel basiert
+              jetzt auf der 6.0-Versionsreihe.")
+         (fr "La version par défaut du noyau linux-libre est mise à jour
+              vers la série des 6.0.")
+         (pt "A versão padrão do kernel linux-libre foi atualizada para a
+              série do kernel 6.0.")))
+
+ (entry (commit "400a7a4c80efbde1905ae98a298bbb5882d46a0d")
+        (title
+         (en "New build system for Python packages")
+         (de "Neues Erstellungssystem für Python-Pakete")
+         (fr "Nouveau système de construction pour les paquets Python")
+         (pt "Novo sistema de compilação para pacotes Python"))
+        (body
+         (en "A new @var{pyproject-build-system} has been added.  This
+is a redesign of @var{python-build-system} with support for @dfn{PEP 517}
+and @file{pyproject.toml} files.  It also has built-in support for various
+test frameworks such as @command{pytest} and @code{nosetests}.
+
+There is a complementary @code{python-toolchain} package that comes with
+updated versions of @command{pip}, @command{setuptools} and others.
+
+The build system will eventually be merged into @var{python-build-system}
+but you are encouraged to use it for packages in the @code{guix} channel.
+Third party channels may want to wait until the API is stable (see the
+Guix manual for caveats).
+
+Despite the name, @var{pyproject-build-system} also works with the
+``legacy'' @file{setup.py} format.")
+         (de "Ein neues Erstellungssystem @var{pyproject-build-system} ist
+verfügbar.  Es ist eine Neuauflage des @var{python-build-system}, die
+@dfn{PEP 517} und @file{pyproject.toml}-Dateien unterstützt.  Auch wurde
+Unterstützung für Testrahmen wie @command{pytest} und @code{nosetests}
+eingebaut.
+
+Ergänzend gibt es ein Paket @code{python-toolchain} mit aktualisierten Versionen
+von @command{pip}, @command{setuptools} und mehr.
+
+Das Erstellungssystem wird in Zukunft Teil von @var{python-build-system} werden,
+aber wir würden es begrüßen, wenn Sie es für Pakete auf dem @code{guix}-Kanal
+verwenden würden.  Drittanbieterkanäle warten vielleicht lieber auf eine
+stabile Programmierschnittstelle (siehe die im Guix-Handbuch genannten
+Einschränkungen).
+
+Trotz dem Namen funktioniert @var{pyproject-build-system} auch mit dem „alten“
+@file{setup.py}-Format.")
+         (fr "Un nouveau système de construction, @var{pyproject-build-system},
+a été ajouté.  Il s'agit d'une refonte du @var{python-build-system} qui rajoute
+la prise en charge de @dfn{PEP 517} et des fichiers @file{pyproject.toml}.
+Il intègre aussi la prise en charge de divers cadriciels de test comme
+@command{pytest} ou @code{nosetests}.
+
+Un paquet supplémentaire @code{python-toolchain} fournit des versions à jour
+de @command{pip}, @command{setuptools} et autres.
+
+Le système de construction finira par être intégré au @var{python-build-system}
+mais nous vous encourageons à l'utiliser pour les paquets du canal @code{guix}.
+Les canaux tiers devraient attendre que l'API se stabilise (voir le manuel de
+Guix pour les mises en garde).
+
+Contrairement à ce qu'indique son nom, @var{pyproject-build-system} fonctionne
+aussi avec « l'ancien » format @file{setup.py}.")
+         (pt "Um novo sistema de compilação chamado @var{pyproject-build-system}
+foi adicionado.  É um redesign do @var{python-build-system} com suporte à
+@dfn{PEP 517} e a arquivos @file{pyproject.toml}.  Ele também inclui suporte a
+vários frameworks de teste tais como @command{pytest} e @code{nosetests}.
+
+Há um pacote complementar @code{python-toolchain} que contém versões
+atualizadas do @command{pip}, @command{setuptools} e outros.
+
+O sistema de compilação será eventualmente incorporado ao
+@var{python-build-system}, mas encorajamos você a usá-lo para pacotes no canal
+@code{guix}.  Canais de terceiros podem querer esperar até a API se
+estabilizar (veja o manual do Guix para ressalvas).
+
+Apesar do nome, o @var{pyproject-build-system} também funciona com o formato
+“legado” do @file{setup.py}.")))
+
+ (entry (commit "c7ba5f38b80433b040d3946b8fc0b1e8621ba30a")
+        (title
+         (en "New @option{--emulate-fhs} option for @command{guix shell}")
+         (de "Neue Option @option{--emulate-fhs} für @command{guix shell}")
+         (fr "Nouvelle option @option{--emulate-fhs} pour @command{guix shell}")
+         (pt "Nova opção @option{--emulate-fhs} para o @command{guix shell}"))
+        (body
+         (en "The @command{guix shell} command has a new
+@option{--emulate-fhs} (or @option{-F}) option.  Combined with
+@option{--container} (or @option{-C}), it emulates the file and directory
+layout specified by the Filesystem Hierarchy Standard (FHS), providing
+@file{/bin}, @file{/lib}, etc. within the container.
+
+For example, the following command runs @file{/bin/ls} within such a
+container:
+
+@example
+guix shell -CF coreutils -- /bin/ls
+@end example
+
+Run @command{info \"(guix) Invoking guix shell\"} for more information.")
+         (de "Der Befehl @command{guix shell} verfügt jetzt über eine neue
+Befehlszeilenoption @option{--emulate-fhs} (oder @option{-F}).  Zusammen mit
+@option{--container} (oder @option{-C}) kann so die Datei- und
+Verzeichnisstruktur, die im @i{Filesystem Hierarchy Standard} (FHS) vorgegeben
+wird, nachgebildet werden. Das heißt, in der Container-Umgebung gibt es
+@file{/bin}, @file{/lib} und so weiter.
+
+Zum Beispiel wird folgender Befehl @file{/bin/ls} in einem solchen Container
+ausführen:
+
+@example
+guix shell -CF coreutils -- /bin/ls
+@end example
+
+Führen Sie @command{info \"(guix.de) Aufruf von guix shell\"} aus, um mehr
+zu erfahren.")
+         (fr "La commande @command{guix shell} dispose d'une nouvelle option,
+@option{--emulate-fhs} (ou @option{-F}).  Avec @option{--container} (ou
+@option{-C}), elle permet d'imiter la disposition des fichiers et répertoires
+spécifiée par le @i{Filesystem Hierarchy Standard} (FHS) en fournissant
+@file{/bin}, @file{/lib}, etc. dans le conteneur.
+
+Par exemple, la commande ci-dessous lance @file{/bin/ls} dans un tel
+conteneur :
+
+@example
+guix shell -CF coreutils -- /bin/ls
+@end example
+
+Lancer @command{info \"(guix.fr) Invoquer guix shell\"} pour plus
+d'informations.")
+         (pt "O comando @command{guix shell} tem uma nova opção
+@option{--emulate-fhs} (ou @option{-F}).  Combinada com
+@option{--container} (ou @option{-C}), ela emula o layout de arquivos e
+diretórios especificado pelo Padrão de Hierarquia do Sistema de
+Arquivos (Filesystem Hierarchy Standard — FHS), provendo @file{/bin},
+@file{/lib}, etc. dentro do contêiner.
+
+Por exemplo, o comando seguinte executa @file{/bin/ls} dentro de um contêiner
+desse tipo:
+
+@example
+guix shell -CF coreutils -- /bin/ls
+@end example
+
+Execute @command{info \"(guix) Invoking guix shell\"} para mais informações.")))
+
+ (entry (commit "28ade1bab207974cce6a014e7187968511fc5526")
+        (title
+         (en "@option{--with-source} is now recursive")
+         (de "@option{--with-source} ist jetzt rekursiv")
+         (fr "@option{--with-source} est dorénavant récursive")
+         (pt "@option{--with-source} agora é recursiva"))
+        (body
+         (en "The @option{--with-source} package transformation option now
+uses the specified source for all matching packages, including dependencies.
+This option is useful for all package maintainers, developers, and, in
+general, all users who want Guix to facilitate their rights to modify their
+software and share their changes.
+
+Run @command{info \"(guix) Package Transformation Options\"} for more
+info.")
+         (de "Die Paketumwandlungsoption @option{--with-source} wird jetzt den
+angegebenen Quellcode für sämtliche passende Pakete benutzen, Abhängigkeiten
+eingeschlossen. Die Option hilft Paketbetreuern, Entwicklern und allgemein allen
+Nutzern, die Guix benutzen, das Recht, ihre Software anzupassen und
+Änderungen zu teilen, leichter auszuüben.
+
+Führen Sie für mehr Informationen @command{info \"(guix.de)
+Paketumwandlungsoptionen\"} aus.")
+         (fr "L'option de transformation de paquet @option{--with-source}
+s'applique désormais à tous les paquets correspondant, y compris les
+dépendances.  Cette option est utile pour les personnes qui maintiennent un
+logiciel, en développent un ou, plus généralement, pour toute personne qui
+souhaite que Guix facilite l'exercice de ses droits à modifier le logiciel et
+à partager ses changements.
+
+Lancer @command{info \"(guix.fr) Options de transformation de paquets\"} pour
+plus d'informations.")
+         (pt "A opção de transformação de pacote @option{--with-source} agora
+usa a fonte especificada para todos os pacotes correspondentes, incluindo
+dependências.  Essa opção é útil para todos os mantenedores de pacotes,
+desenvolvedores e usuários em geral que querem que o Guix facilite seu direito
+de modificar seu software e compartilhar suas mudanças.
+
+Execute @command{info \"(guix) Package Transformation Options\"} para mais
+informações.")))
+
+ (entry (commit "a13f5ead0265cf0fe11e60150547c09dfc8c45b0")
+        (title
+         (en "Guix System image creation is now documented")
+         (de "Es gibt eine Dokumentation, wie Sie Guix-System-Abbilder („Images“) erzeugen")
+         (fr "La création d'images pour Guix System est à présent documentée")
+         (pt "A criação de imagens do Guix System agora está documentada"))
+        (body
+         (en "The Guix System image API that allows you to create customized
+system images and turn them into actual bootable images is now documented in
+the @code{Creating System Images} chapter of the Guix documentation.  This
+should be particularly useful for people trying to port Guix System to new
+hardware.")
+         (de "Sie können nun im Kapitel @code{Creating System Images} der
+Dokumentation nachlesen, wie Sie mit der Schnittstelle für Guix-System-Abbilder
+anpassbare, bootfähige Systemabbilder erzeugen können.  Das sollte vor allem
+Personen unterstützen, die versuchen, Guix System auf neuer Hardware zum Laufen
+zu bringen.")
+         (fr "L'interface de programmation d'images pour Guix System,
+permettant de créer des images personnalisées et de les transformer en images
+amorçables est désormais documentée dans le chapitre @code{Création d'images
+système}.  Cette interface devrait être particulièrement utile aux personnes
+qui essaient de faire fonctionner Guix sur de nouvelles machines.")
+         (pt "A API de imagens do Guix System que permite criar imagens de
+sistema customizadas e torná-las inicializáveis agora está documentada no
+capítulo @code{Creating System Images} da documentação do Guix.  Isso é
+particularmente útil para pessoas tentando portar o Guix System para um novo
+hardware.")))
+ (entry (commit "c8112f3bd95269ce4aca12dedbfe61bb6b37acae")
+        (title
+         (en "WSL system images support")
+         (de "WSL-Systemabbilder werden unterstützt")
+         (fr "Support pour les images système WSL")
+         (pt "Suporte a imagens de sistema WSL"))
+        (body
+         (en "The @command{guix system image} command can now generate system
+images for the Windows Subsystem for Linux.  To get started, you can for
+instance run from a Guix checkout:
+
+@command{guix system image gnu/system/images/wsl2.scm},
+
+and import the resulting image this way:
+
+@command{wsl --import Guix ./guix ./wsl2-image.tar.gz}
+@command{wsl -d Guix}.")
+         (de "Mit dem Befehl @command{guix system image} können Sie
+Systemabbilder erzeugen, die auf dem Windows-Subsystem für Linux laufen.  Wenn
+Sie das ausprobieren möchten, führen Sie zum Beispiel Folgendes aus einem
+Guix-Checkout heraus aus:
+
+@command{guix system image gnu/system/images/wsl2.scm},
+
+Das resultierende Abbild können Sie so importieren:
+
+@command{wsl --import Guix ./guix ./wsl2-image.tar.gz}
+@command{wsl -d Guix}.")
+         (fr "La commande @command{guix system image} peut désormais générer
+des images système pour le Windows Subystem for Linux.  Vous pouvez par
+exemple lancer la commande suivante depuis un répertoire de sources Guix :
+
+@command{guix system image gnu/system/images/wsl2.scm},
+
+et importer l'image obtenue de cette manière :
+
+@command{wsl --import Guix ./guix ./wsl2-image.tar.gz}
+@command{wsl -d Guix}.")
+         (pt "Agora o comando @command{guix system image} pode gerar imagens
+de sistema para o Subsistema do Windows para Linux.  Para começar, você pode
+por exemplo rodar a partir de um checkout do repositório do Guix:
+
+@command{guix system image gnu/system/images/wsl2.scm},
+
+e importar a imagem resultante da seguinte maneira:
+
+@command{wsl --import Guix ./guix ./wsl2-image.tar.gz}
+@command{wsl -d Guix}.")))
+ (entry (commit "11a06d1e49f4d50d6789e05bbf35e2e145ff7838")
+        (title
+         (en "Emacs now supports native compilation")
+         (de "Emacs kann Pakete nun nativ kompilieren")
+         (pt "O Emacs agora suporta compilação nativa"))
+        (body
+         (en "Emacs can now compile packages natively.  Under the default
+configuration, this means that Emacs packages will now be just-in-time (JIT)
+compiled as you use them, and the results stored in a subdirectory of your
+@code{user-emacs-directory}.
+
+Furthermore, the build system for Emacs packages transparently supports native
+compilation, but note, that @code{emacs-minimal}---the default Emacs for
+building packages---has been configured without native compilation.
+To natively compile your emacs packages ahead of time, use a transformation
+like @option{--with-input=emacs-minimal=emacs}.")
+         (de "Emacs kann nun native Maschinenbefehle erzeugen.  Standardgemäß
+kompiliert es nun Pakete „just in time“, während Sie diese laden, und platziert
+die so erzeugten nativen Bibliotheken in einem Unterverzeichnis Ihres
+@code{user-emacs-directory}.
+
+Darüber hinaus unterstützt das Erstellungssystem für Emacs-Pakete die Erzeugung
+nativer Maschinenbefehle.  Beachten Sie jedoch, dass @code{emacs-minimal} –
+die Emacs-Variante, mit der normalerweise Emacs-Pakete erstellt werden –
+weiterhin keine nativen Befehle generiert.  Um native Befehle für Ihre
+Emacs-Pakete schon im Voraus zu erzeugen, nutzen Sie eine Transformation, z.B.
+@option{--with-input=emacs-minimal=emacs}.")
+         (pt "Agora o Emacs pode compilar pacotes nativamente.  Na
+configuração padrão os pacotes do Emacs serão compilados “just-in-time” (JIT)
+conforme forem usados, e os resultados armazenados em um subdiretório de
+@code{user-emacs-directory}.
+
+Além disso, o sistema de compilação para pacotes do Emacs suporta compilação
+nativa de forma transparente.  Note porém que o @code{emacs-minimal} --- a
+variante padrão do Emacs para compilar pacotes --- foi configurado sem
+compilação nativa.  Para pré-compilar nativamente seus pacotes do Emacs use
+uma transformação, como por exemplo
+@code{--with-input=emacs-minimal=emacs}.")))
+
+ (entry (commit "c188cf57f161c0c26e2d7c8516bd1ddd1492d686")
+        (title
+         (en "Linux-libre kernel updated to 5.19")
+         (de "Linux-libre-Kernel wird auf 5.19 aktualisiert")
+         (fr "Le noyau linux-libre est mis à jour vers la 5.19")
+         (pt "Kernel linux-libre atualizado para 5.19"))
+        (body
+         (en "The default version of the linux-libre kernel has been
+              updated to the 5.19 release series.")
+         (de "Der standardmäßig verwendete @code{linux-libre}-Kernel basiert
+              jetzt auf der 5.19-Versionsreihe.")
+         (fr "La version par défaut du noyau linux-libre est mise à jour
+              vers la série des 5.19.")
+         (pt "A versão padrão do kernel linux-libre foi atualizada para a
+              série do kernel 5.19.")))
+
+ (entry (commit "a15542d26df42dabdb5e2f76d150ae200230c3b0")
+        (title
+         (en "New @option{--whole-file} option for @command{guix style}")
+         (de "Neue Option @option{--whole-file} für @command{guix style}")
+         (fr "Nouvelle option @option{--whole-file} pour @command{guix style}")
+         (pt "Nova opção @option{--whole-file} para @command{guix style}"))
+        (body
+         (en "The @command{guix style} command has a new @option{--whole-file}
+option: instead of formatting individual package definitions, this option lets
+you reformat entire Scheme files.  You might want to use it to format your
+operating system configuration file, for instance.
+
+Run @command{info \"(guix) Invoking guix style\"} for more info.")
+         (de "Der Befehl @command{guix style} verfügt über eine neue
+Befehlszeilenoption @option{--whole-file}: Mit ihr werden keine einzelnen
+Paketdefinitionen umformatiert, sondern ganze Scheme-Dateien werden in die
+richtige Darstellungsform gebracht.  Sie können damit zum Beispiel die
+Konfigurationsdatei für Ihr Betriebssystem formatieren lassen.
+
+Führen Sie @command{info \"(guix.de) Aufruf von guix style\"} aus, um mehr
+Informationen zu erhalten.")
+         (fr "La commande @command{guix style} a désormais une nouvelle option
+@option{--whole-file} : au lieu de mettre en forme des définitions de paquets,
+cette option permet de mettre en forme des fichiers Scheme entiers.  Ça peut
+s'avérer utile par exemple pour mettre en forme son fichier de configuration
+du système d'exploitation.
+
+Lancer @command{info \"(guix.fr) Invoquer guix style\"} pour plus
+d'informations.")
+         (pt "O comando @command{guix style} tem uma nova opção
+@option{--whole-file}: ao invés de formatar definições de pacote
+individualmente, esta opção permite a reformatação de arquivos Scheme por
+inteiro.  Você pode querer usá-la para formatar seu arquivo de configuração do
+sistema operacional, por exemplo.
+
+Execute @command{info \"(guix) Invoking guix style\"} para mais informações.")))
+
 (entry (commit "2ec7ab2610eb67e26dab52b671eb29e46f64ea0f")
        (title
-          (en "Linux-libre kernel updated to 5.18")
-          (de "Linux-libre-Kernel wird auf 5.18 aktualisiert"))
+         (en "Linux-libre kernel updated to 5.18")
+         (de "Linux-libre-Kernel wird auf 5.18 aktualisiert")
+         (fr "Le noyau linux-libre est mis à jour vers la 5.18"))
        (body
-          (en "The default version of the linux-libre kernel has been
+         (en "The default version of the linux-libre kernel has been
              updated to the 5.18 release series.")
-          (de "Der standardmäßig verwendete @code{linux-libre}-Kernel basiert
-jetzt auf der 5.18-Versionsreihe.")))
+         (de "Der standardmäßig verwendete @code{linux-libre}-Kernel basiert
+jetzt auf der 5.18-Versionsreihe.")
+         (fr "La version par défaut du noyau linux-libre est mise à jour
+              vers la série des 5.18.")))

 (entry (commit "bdf422176739b473add66eb8cac9fdd8c654f794")
        (title
@@ -161,12 +550,15 @@ Cela vient avec un nouveau système de construction pour paquets Elm---lancer

 (entry (commit "b6b2de2a0d52530bc1ee128c61580bed662ee15c")
        (title (en "Linux-libre kernel updated to 5.17")
-               (de "Linux-libre-Kernel wird auf 5.17 aktualisiert"))
+               (de "Linux-libre-Kernel wird auf 5.17 aktualisiert")
+               (fr "Le noyau linux-libre est mis à jour vers la 5.17"))
        (body
-          (en "The default version of the linux-libre kernel has been
+         (en "The default version of the linux-libre kernel has been
              updated to the 5.17 release series.")
-          (de "Der standardmäßig verwendete @code{linux-libre}-Kernel basiert
-jetzt auf der 5.17-Versionsreihe.")))
+         (de "Der standardmäßig verwendete @code{linux-libre}-Kernel basiert
+jetzt auf der 5.17-Versionsreihe.")
+         (fr "La version par défaut du noyau linux-libre est mise à jour
+              vers la série des 5.17.")))

 (entry (commit "c42b7baf13c7633b4512e94da7445299c57b247d")
        (title
@@ -385,7 +777,7 @@ Bezeichnungen aus Paketeingaben entfernt werden. Wenn Sie {--styling}
 weglassen, passiert das Gleiche wie wenn Sie @samp{--styling=format} angeben;
 früher war es das Gleiche wie @samp{--styling=inputs}.

-Führen Sie @command{info \"(guix) Invoking guix style\"} aus, um mehr
+Führen Sie @command{info \"(guix.de) Aufruf von guix style\"} aus, um mehr
 Informationen zu erhalten.")
         (fr "La commande @command{guix style}, récemment introduite, peut
 désormais être utilisée pour mettre en forme des définitions de paquets
@@ -872,7 +1264,7 @@ das Löschen, Ersetzen, Hinzufügen von Eingaben.

 Um den Übergang zum „neuen Stil“ zu erleichtern, steht ein neuer
 Befehl @command{guix style} zur Verfügung.  Führen Sie @command{info
-\"(guix) Invoking guix style\"} aus, um mehr Informationen zu
+\"(guix.de) Aufruf von guix style\"} aus, um mehr Informationen zu
 erhalten.")))

 (entry (commit "82daab42811a2e3c7684ebdf12af75ff0fa67b99")
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -26,6 +26,7 @@
             ((guix platform) #:select (targets))
             ((gnu services xorg) #:select (%default-xorg-modules))
             (guix utils)
+             (guix gexp)
             (srfi srfi-1)
             (srfi srfi-26))

@@ -50,18 +51,17 @@ TARGET."
         "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))
+  ;; The guix package doesn't build natively on armhf due to Guile memory
+  ;; issues compiling the package modules
+  (remove (lambda (package)
+            (string=? (package-name package) "guix"))
+          %base-packages))

 (define %base-packages/hurd
  ;; XXX: For now we are less demanding of "i586-gnu".
  (map specification->package
       '("coreutils" "grep" "findutils" "gawk" "make"
-         "gcc-toolchain" "tar" "xz")))
+         #;"gcc-toolchain" "tar" "xz")))

 (define %system-packages
  ;; Key packages proposed by the Guix System installer.
@@ -111,8 +111,6 @@ TARGET."
                      (cond ((string=? system "i586-gnu")
                             %base-packages/hurd)
                            ((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
@@ -142,9 +140,16 @@ TARGET."
                      (if (target-mingw? target)
                          %packages-to-cross-build-for-mingw
                          %packages-to-cross-build)))
-               ;; XXX: Important bits like libsigsegv and libffi don't support
-               ;; RISCV at the moment, so don't require RISCV support.
-               (delete "riscv64-linux-gnu" (targets)))))
+               (fold delete (targets)
+                     '(;; Like in (gnu ci), dismiss cross-compilation to x86:
+                       ;; it's pointless.
+                       "x86_64-linux-gnu"
+                       "i686-linux-gnu"
+
+                       ;; XXX: Important bits like libsigsegv and libffi don't
+                       ;; support RISCV at the moment, so don't require RISCV
+                       ;; support.
+                       "riscv64-linux-gnu")))))

 (define %cross-bootstrap-manifest
  (manifest
@@ -0,0 +1,89 @@
+-*- mode: lisp-data -*-
+
+scheme-mode
+
+(package...
+ "(define-public " (s name)
+ n> "(package"
+ n  > "(name \"" (s name) "\")"
+ n  > "(version \"" p "\")"
+ n  > "(source origin...)"
+ n  > "(build-system " (p "gnu") "-build-system)"
+ n  > "(home-page \"" p "\")"
+ n  > "(synopsis \"" p "\")"
+ n  > "(description \"" p "\")"
+ n  > "(license license:" (p "unknown") ")))" n)
+
+(origin...
+ "(origin"
+ n> "(method " (p "url-fetch" method) ")"
+ n> "(uri " (cl-case (and method (intern method))
+              ('git-fetch "git-reference...")
+              ('svn-fetch "svn-reference...")
+              ('hg-fetch  "hg-reference...")
+              ('cvs-fetch "cvs-reference...")
+              ('bzr-fetch "bzr-reference...")
+              (t          "\"https://...\""))
+ ")"
+ n>
+ (cl-case (and method (intern method))
+   ('git-fetch
+    (insert "(file-name (git-file-name name version))")
+    (newline)
+    (indent-according-to-mode))
+   ('hg-fetch
+    (insert "(file-name (hg-file-name name version))")
+    (newline)
+    (indent-according-to-mode))
+   ('svn-fetch
+    (insert "(file-name (string-append name \"-\" version \"-checkout\"))")
+    (newline)
+    (indent-according-to-mode))
+   ('cvs-fetch
+    (insert "(file-name (string-append name \"-\" version \"-checkout\"))")
+    (newline)
+    (indent-according-to-mode))
+   ('bzr-fetch
+    (insert "(file-name (string-append name \"-\" version \"-checkout\"))")
+    (newline)
+    (indent-according-to-mode))
+   (t          ""))
+ > "(sha256"
+ n > "(base32 \""
+ ;; hash of an empty directory
+ (p "0sjjj9z1dhilhpc8pq4154czrb79z9cm044jvn75kxcjv6v5l2m5") "\")))")
+
+(git-reference...
+ "(git-reference"
+ n> "(url \"" p "\")"
+ n> "(commit \"" p "\"))")
+
+(svn-reference...
+ "(svn-reference"
+ n> "(url \"" p "\")"
+ n> "(revision \"" p "\"))")
+
+(cvs-reference...
+ "(cvs-reference"
+ n> "(root-directory \"" p "\")"
+ n> "(module \"" p "\")"
+ n> "(revision \"" p "\"))")
+
+(hg-reference...
+ "(hg-reference"
+ n> "(url \"" p "\")"
+ n> "(changeset \"" p "\"))")
+
+(bzr-reference...
+ "(bzr-reference"
+ n> "(url \"" p "\")"
+ n> "(revision \"" p "\"))")
+
+(:phases\ "#:phases (modify-phases %standard-phases"
+          n> p ")")
+
+(add-before\ "(add-before '" p " '" p
+             n > p ")")
+(add-after\ "(add-after '" p " '" p
+            n > p ")")
+(replace\ "(replace '" p " " p")")
@@ -0,0 +1,158 @@
+-*- mode: lisp-data -*-
+
+text-mode :when (and (fboundp 'git-commit-mode) (git-commit-mode))
+
+(add\ "gnu: Add "
+      (p (with-temp-buffer
+           (magit-git-wash #'magit-diff-wash-diffs
+             "diff" "--staged")
+           (goto-char (point-min))
+           (when (re-search-forward "\\+(define-public \\(\\S-+\\)"
+                                    nil 'noerror)
+             (match-string-no-properties 1)))
+         var)
+      "." n n
+      "* " (p (or (car (magit-staged-files)) ""))
+      " (" (s var ) "): New variable.")
+
+(remove\ "gnu: Remove "
+         (p (with-temp-buffer
+              (magit-git-wash #'magit-diff-wash-diffs
+                "diff" "--staged")
+              (goto-char (point-min))
+              (when (re-search-forward "\\-(define-public \\(\\S-+\\)"
+                                       nil 'noerror)
+                (match-string-no-properties 1)))
+            var)
+         "." n n
+         "* " (p (or (car (magit-staged-files)) ""))
+         " (" (s var) "): Delete variable.")
+
+(rename\ "gnu: "
+         (p (with-temp-buffer
+              (magit-git-wash #'magit-diff-wash-diffs
+                "diff" "--staged")
+              (beginning-of-buffer)
+              (when (search-forward "-(define-public " nil 'noerror)
+                (thing-at-point 'sexp 'no-properties)))
+            prev-var)
+         ": Rename package to "
+         (p (with-temp-buffer
+              (magit-git-wash #'magit-diff-wash-diffs
+                "diff" "--staged")
+              (beginning-of-buffer)
+              (when (search-forward "+(define-public " nil 'noerror)
+                (thing-at-point 'sexp 'no-properties)))
+            new-var)
+         "." n n
+         "* " (p (or (car (magit-staged-files)) "")) " (" (s prev-var) "): "
+         "Define in terms of" n
+         "'deprecated-package'." n
+         "(" (s new-var) "): New variable, formerly known as \""
+         (s prev-var) "\".")
+
+(update\ "gnu: "
+         (p (with-temp-buffer
+              (magit-git-wash #'magit-diff-wash-diffs
+                "diff" "--staged")
+              (goto-char (point-min))
+              (when (re-search-forward "^[ ]*(define-public \\(\\S-+\\)"
+                                       nil 'noerror)
+                (match-string-no-properties 1)))
+            var)
+         ": Update to "
+         (p (with-temp-buffer
+              (magit-git-wash #'magit-diff-wash-diffs
+                "diff" "--staged")
+              (goto-char (point-min))
+              (search-forward "name" nil 'noerror)
+              (search-forward "+" nil 'noerror)   ; first change
+              (when (and (search-forward "version " nil 'noerror)
+                         (looking-at-p "\""))
+                (let ((end (save-excursion (search-forward "\")"
+                                                           nil 'noerror))))
+                  (when end
+                    (forward-char)
+                    (buffer-substring-no-properties (point) (- end 2))))))
+            version)
+         "." n n
+         "* " (p (or (car (magit-staged-files)) "")) " (" (s var) "): "
+         "Update to " (s version) "." n
+         (mapconcat (lambda (file) (concat "* " file))
+                    (cdr (magit-staged-files))
+                    "\n"))
+
+(addcl\ "gnu: Add cl-"
+        (p (replace-regexp-in-string
+            "^cl-" "" (with-temp-buffer
+                        (magit-git-wash #'magit-diff-wash-diffs
+                          "diff" "--staged")
+                        (beginning-of-buffer)
+                        (when (search-forward "+(define-public " nil 'noerror)
+                          (replace-regexp-in-string
+                           "^sbcl-" ""
+                           (thing-at-point 'sexp 'no-properties)))))
+           var)
+        "." n n
+        "* " (p (or (car (magit-staged-files)) ""))
+        " (cl-" (s var)
+        ", ecl-" (s var)
+        ", sbcl-" (s var) "): New variables.")
+
+(https\ "gnu: "
+        (p (with-temp-buffer
+             (magit-git-wash #'magit-diff-wash-diffs
+               "diff" "--staged")
+             (goto-char (point-min))
+             (when (re-search-forward "^[ ]*(define-public \\(\\S-+\\)"
+                                      nil 'noerror)
+               (match-string-no-properties 1)))
+           var)
+        ": Use HTTPS home page." n n
+        "* " (p (or (car (magit-staged-files)) ""))
+        " (" (s var) ")[home-page]: Use HTTPS."
+        n
+        (mapconcat (lambda (file) (concat "* " file))
+                   (cdr (magit-staged-files))
+                   "\n"))
+
+(move\ "gnu: "
+       (p (with-temp-buffer
+            (magit-git-wash #'magit-diff-wash-diffs
+              "diff" "--staged")
+            (goto-char (point-min))
+            (when (re-search-forward "\\-(define-public \\(\\S-+\\)"
+                                     nil 'noerror)
+              (match-string-no-properties 1)))
+          var)
+       ": Move to ("
+       (p (with-temp-buffer
+            (magit-git-wash #'magit-diff-wash-diffs
+              "diff" "--staged")
+            (goto-char (point-min))
+            (when (and
+                   (re-search-forward "\\+(define-public \\(\\S-+\\)"
+                                      nil 'noerror)
+                   (re-search-backward "modified[ ]*\\(\\S-+\\)"
+                                       nil 'noerror))
+              (string-replace
+               "\.scm" ""
+               (string-replace "/" " "
+                               (match-string-no-properties 1)))))
+          new-module)
+       ")." n
+       n
+       "* " (p (with-temp-buffer
+                  (magit-git-wash #'magit-diff-wash-diffs
+                    "diff" "--staged")
+                  (goto-char (point-min))
+                  (when (and
+                         (re-search-forward "\\-(define-public \\(\\S-+\\)"
+                                            nil 'noerror)
+                         (re-search-backward "modified[ ]*\\(\\S-+\\)"
+                                             nil 'noerror))
+                    (match-string-no-properties 1)))
+                source)
+       " (" (s var) "): Move from here…" n
+       "* " (concat (string-replace " " "/" new-module) ".scm")
+       " (" (s var) "): …to here.")
@@ -11,6 +11,7 @@
                                          "ant-build-system"
                                          "asdf-build-system"
                                          "cargo-build-system"
+                                          "chicken-build-system"
                                          "clojure-build-system"
                                          "cmake-build-system"
                                          "copy-build-system"
@@ -27,6 +28,7 @@
                                          "linux-module-build-system"
                                          "maven-build-system"
                                          "meson-build-system"
+                                          "minetest-build-system"
                                          "minify-build-system"
                                          "node-build-system"
                                          "ocaml-build-system"
@@ -35,6 +37,8 @@
                                          "qt-build-system"
                                          "r-build-system"
                                          "rakudo-build-system"
+                                          "rebar-build-system"
+                                          "renpy-build-system"
                                          "ruby-build-system"
                                          "scons-build-system"
                                          "texlive-build-system"
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2018-2020, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -20,7 +20,6 @@
             (gnu packages package-management)
             (guix monads)
             (guix store)
-             ((gnu ci) #:select (channel-source->package))
             ((guix git-download) #:select (git-predicate))
             ((guix utils) #:select (current-source-directory))
             (git)
@@ -43,21 +42,6 @@ determined."
          (repository-close! repository))
        #f))))

-(define-syntax mparameterize
-  (syntax-rules ()
-    "This form implements dynamic scoping, similar to 'parameterize', but in a
-monadic context."
-    ((_ monad ((parameter value) rest ...) body ...)
-     (let ((old-value (parameter)))
-       (mbegin monad
-         ;; XXX: Non-local exits are not correctly handled.
-         (return (parameter value))
-         (mlet monad ((result (mparameterize monad (rest ...) body ...)))
-           (parameter old-value)
-           (return result)))))
-    ((_ monad () body ...)
-     (mbegin monad body ...))))
-
 (define (tests-for-current-guix source commit)
  "Return a list of tests for perform, using Guix built from SOURCE, a channel
 instance."
@@ -4,6 +4,7 @@

 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2022 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2022 Mathieu Othacehe <othacehe@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -22,23 +23,28 @@

 ;;; Commentary:

-;; This code defines development teams and team members.
+;; This code defines development teams and team members, as well as their
+;; scope.

 ;;; Code:

 (use-modules (srfi srfi-1)
             (srfi srfi-9)
+             (srfi srfi-26)
             (ice-9 format)
+             (ice-9 regex)
             (ice-9 match)
-             (guix ui))
+             (guix ui)
+             (git))

 (define-record-type <team>
-  (make-team id name description members)
+  (make-team id name description members scope)
  team?
  (id          team-id)
  (name        team-name)
  (description team-description)
-  (members     team-members set-team-members!))
+  (members     team-members set-team-members!)
+  (scope       team-scope))

 (define-record-type <person>
  (make-person name email)
@@ -49,11 +55,13 @@
 (define* (person name #:optional email)
  (make-person name email))

-(define* (team id #:key name description (members '()))
+(define* (team id #:key name description (members '())
+               (scope '()))
  (make-team id
             (or name (symbol->string id))
             description
-             members))
+             members
+             scope))

 (define %teams
  (make-hash-table))
@@ -84,41 +92,98 @@
  (team 'python
        #:name "Python team"
        #:description
-        "Python, Python packages, the \"pypi\" importer, and the python-build-system."))
+        "Python, Python packages, the \"pypi\" importer, and the python-build-system."
+        #:scope
+        (list "gnu/packages/django.scm"
+              "gnu/packages/jupyter.scm"
+              ;; Match haskell.scm and haskell-*.scm.
+              (make-regexp "^gnu/packages/python(-.+|)\\.scm$")
+              "gnu/packages/sphinx.scm"
+              "gnu/packages/tryton.scm"
+              "guix/build/pyproject-build-system.scm"
+              "guix/build-system/pyproject.scm"
+              "guix/build/python-build-system.scm"
+              "guix/build-system/python.scm"
+              "guix/import/pypi.scm"
+              "guix/scripts/import/pypi.scm"
+              "tests/pypi.scm")))

 (define-team haskell
  (team 'haskell
        #:name "Haskell team"
        #:description
        "GHC, Hugs, Haskell packages, the \"hackage\" and \"stackage\" importers, and
-the haskell-build-system."))
+the haskell-build-system."
+        #:scope
+        (list "gnu/packages/dhall.scm"
+              ;; Match haskell.scm and haskell-*.scm.
+              (make-regexp "^gnu/packages/haskell(-.+|)\\.scm$")
+              "gnu/packages/purescript.scm"
+              "guix/build/haskell-build-system.scm"
+              "guix/build-system/haskell.scm"
+              "guix/import/cabal.scm"
+              "guix/import/hackage.scm"
+              "guix/import/stackage.scm"
+              "guix/scripts/import/hackage.scm")))

 (define-team r
  (team 'r
        #:name "R team"
        #:description
        "The R language, CRAN and Bioconductor repositories, the \"cran\" importer,
-and the r-build-system."))
+and the r-build-system."
+        #:scope (list "gnu/packages/bioconductor.scm"
+                      "gnu/packages/cran.scm"
+                      "guix/build/r-build-system.scm"
+                      "guix/build-system/r.scm"
+                      "guix/import/cran.scm"
+                      "guix/scripts/import/cran.scm"
+                      "tests/cran.scm")))

 (define-team julia
  (team 'julia
        #:name "Julia team"
        #:description
-        "The Julia language, Julia packages, and the julia-build-system."))
+        "The Julia language, Julia packages, and the julia-build-system."
+        #:scope (list (make-regexp "^gnu/packages/julia(-.+|)\\.scm$")
+                      "guix/build/julia-build-system.scm"
+                      "guix/build-system/julia.scm")))

 (define-team ocaml
  (team 'ocaml
        #:name "OCaml and Dune team"
        #:description
        "The OCaml language, the Dune build system, OCaml packages, the \"opam\"
-importer, and the ocaml-build-system."))
+importer, and the ocaml-build-system."
+        #:scope
+        (list "gnu/packages/ocaml.scm"
+              "gnu/packages/coq.scm"
+              "guix/build/ocaml-build-system.scm"
+              "guix/build/dune-build-system.scm"
+              "guix/build-system/ocaml.scm"
+              "guix/build-system/dune.scm"
+              "guix/import/opam.scm"
+              "guix/scripts/import/opam.scm"
+              "tests/opam.scm")))

 (define-team java
  (team 'java
        #:name "Java and Maven team"
        #:description
        "The JDK and JRE, the Maven build system, Java packages, the ant-build-system,
-and the maven-build-system."))
+and the maven-build-system."
+        #:scope
+        (list ;; Match java.scm and java-*.scm.
+              (make-regexp "^gnu/packages/java(-.+|)\\.scm$")
+              ;; Match maven.scm and maven-*.scm
+              (make-regexp "^gnu/packages/maven(-.+|)\\.scm$")
+              "guix/build/ant-build-system.scm"
+              "guix/build/java-utils.scm"
+              "guix/build/maven-build-system.scm"
+              ;; The maven directory
+              (make-regexp "^guix/build/maven/")
+              "guix/build-system/ant.scm"
+              "guix/build-system/maven.scm")))

 (define-team science
  (team 'science
@@ -126,19 +191,47 @@ and the maven-build-system."))

 (define-team emacs
  (team 'emacs
-        #:name "Emacs team"))
+        #:name "Emacs team"
+        #:description "The extensible, customizable text editor and its
+ecosystem."
+        #:scope (list (make-regexp "^gnu/packages/emacs(-.+|)\\.scm$")
+                      "guix/build/emacs-build-system.scm"
+                      "guix/build/emacs-utils.scm"
+                      "guix/build-system/emacs.scm"
+                      "guix/import/elpa.scm"
+                      "guix/scripts/import/elpa.scm"
+                      "tests/elpa.scm")))

 (define-team lisp
  (team 'lisp
-        #:name "Lisp team"))
+        #:name "Lisp team"
+        #:description
+        "Common Lisp and similar languages, Common Lisp packages and the
+asdf-build-system."
+        #:scope (list (make-regexp "^gnu/packages/lisp(-.+|)\\.scm$")
+                      "guix/build/asdf-build-system.scm"
+                      "guix/build/lisp-utils.scm"
+                      "guix/build-system/asdf.scm")))

 (define-team ruby
  (team 'ruby
-        #:name "Ruby team"))
+        #:name "Ruby team"
+        #:scope (list "gnu/packages/ruby.scm"
+                      "guix/build/ruby-build-system.scm"
+                      "guix/build-system/ruby.scm"
+                      "guix/import/gem.scm"
+                      "guix/scripts/import/gem.scm"
+                      "tests/gem.scm")))

 (define-team go
  (team 'go
-        #:name "Go team"))
+        #:name "Go team"
+        #:scope (list "gnu/packages/golang.scm"
+                      "guix/build/go-build-system.scm"
+                      "guix/build-system/go.scm"
+                      "guix/import/go.scm"
+                      "guix/scripts/import/go.scm"
+                      "tests/go.scm")))

 (define-team embedded-bootstrap
  (team 'embedded-bootstrap
@@ -146,31 +239,138 @@ and the maven-build-system."))

 (define-team rust
  (team 'rust
-        #:name "Rust"))
+        #:name "Rust"
+        #:scope (list (make-regexp "^gnu/packages/(crates|rust)(-.+|)\\.scm$")
+                      "guix/build/cargo-build-system.scm"
+                      "guix/build/cargo-utils.scm"
+                      "guix/build-system/cargo.scm"
+                      "guix/import/crate.scm"
+                      "guix/scripts/import/crate.scm"
+                      "tests/crate.scm")))

 (define-team kernel
  (team 'kernel
-        #:name "Linux-libre kernel team"))
+        #:name "Linux-libre kernel team"
+        #:scope (list "gnu/build/linux-modules.scm"
+                      "gnu/packages/linux.scm"
+                      "gnu/tests/linux-modules.scm"
+                      "guix/build/linux-module-build-system.scm"
+                      "guix/build-system/linux-module.scm")))

 (define-team core
  (team 'core
-        #:name "Core / Tools / Internals"))
+        #:name "Core / Tools / Internals"
+        #:scope
+        (list "guix/avahi.scm"
+              "guix/base16.scm"
+              "guix/base32.scm"
+              "guix/base64.scm"
+              "guix/bzr-download.scm"
+              "guix/cache.scm"
+              "guix/channels.scm"
+              "guix/ci.scm"
+              "guix/colors.scm"
+              "guix/combinators.scm"
+              "guix/config.scm"
+              "guix/cpio.scm"
+              "guix/cpu.scm"
+              "guix/cve.scm"
+              "guix/cvs-download.scm"
+              "guix/deprecation.scm"
+              "guix/derivations.scm"
+              "guix/describe.scm"
+              "guix/diagnostics.scm"
+              "guix/discovery.scm"
+              "guix/docker.scm"
+              "guix/download.scm"
+              "guix/elf.scm"
+              "guix/ftp-client.scm"
+              "guix/gexp.scm"
+              "guix/git-authenticate.scm"
+              "guix/git-download.scm"
+              "guix/git.scm"
+              "guix/glob.scm"
+              "guix/gnu-maintenance.scm"
+              "guix/gnupg.scm"
+              "guix/grafts.scm"
+              "guix/graph.scm"
+              "guix/hash.scm"
+              "guix/hg-download.scm"
+              "guix/http-client.scm"
+              "guix/i18n.scm"
+              "guix/inferior.scm"
+              "guix/ipfs.scm"
+              "guix/least-authority.scm"
+              "guix/licenses.scm"
+              "guix/lint.scm"
+              "guix/man-db.scm"
+              "guix/memoization.scm"
+              "guix/modules.scm"
+              "guix/monad-repl.scm"
+              "guix/monads.scm"
+              "guix/narinfo.scm"
+              "guix/nar.scm"
+              "guix/openpgp.scm"
+              "guix/packages.scm"
+              "guix/pki.scm"
+              "guix/platform.scm"
+              "guix/profiles.scm"
+              "guix/profiling.scm"
+              "guix/progress.scm"
+              "guix/quirks.scm"
+              "guix/read-print.scm"
+              "guix/records.scm"
+              "guix/remote.scm"
+              "guix/repl.scm"
+              "guix/search-paths.scm"
+              "guix/self.scm"
+              "guix/serialization.scm"
+              "guix/sets.scm"
+              "guix/ssh.scm"
+              "guix/status.scm"
+              "guix/store.scm"
+              "guix/substitutes.scm"
+              "guix/svn-download.scm"
+              "guix/swh.scm"
+              "guix/tests.scm"
+              "guix/transformations.scm"
+              "guix/ui.scm"
+              "guix/upstream.scm"
+              "guix/utils.scm"
+              "guix/workers.scm"
+              (make-regexp "^guix/platforms/")
+              (make-regexp "^guix/scripts/")
+              (make-regexp "^guix/store/"))))

 (define-team games
  (team 'games
-        #:name "Games and Videos"))
+        #:name "Games and Toys"
+        #:description "Packaging programs for amusement."
+        #:scope (list "gnu/packages/games.scm"
+                      "gnu/packages/game-development.scm"
+                      "gnu/packages/minetest.scm"
+                      "gnu/packages/esolangs.scm" ; granted, rather niche
+                      "gnu/packages/motti.scm"
+                      "guix/build/minetest-build-system.scm")))

 (define-team translations
  (team 'translations
-        #:name "Translations"))
+        #:name "Translations"
+        #:scope (list "etc/news.scm"
+                      (make-regexp "^po/"))))

 (define-team installer
  (team 'installer
-        #:name "Installer script and system installer"))
+        #:name "Installer script and system installer"
+        #:scope (list (make-regexp "^gnu/installer(\\.scm$|/)"))))

 (define-team home
  (team 'home
-        #:name "Team for \"guix home\""))
+        #:name "Team for \"Guix Home\""
+        #:scope (list (make-regexp "^(gnu|guix/scripts)/home(\\.scm$|/)")
+                      "tests/guix-home.sh"
+                      "tests/home-import.scm"
+                      "tests/home-services.scm")))

 (define-team mentors
  (team 'mentors
@@ -178,7 +378,40 @@ and the maven-build-system."))
        #:description
        "A group of mentors who chaperone contributions by newcomers."))

+(define-team mozilla
+  (team 'mozilla
+        #:name "Mozilla"
+        #:description
+        "Taking care about Icecat and Icedove, built from Mozilla Firefox
+and Thunderbird."
+        #:scope (list "gnu/packages/gnuzilla.scm")))
+
+(define-team racket
+  (team 'racket
+        #:name "Racket team"
+        #:description
+        "The Racket language and Racket-based languages, Racket packages,
+Racket's variant of Chez Scheme, and development of a Racket build system and
+importer."
+        #:scope (list "gnu/packages/racket.scm")))
+

+(define-member (person "Thiago Jung Bauermann"
+                       "bauermann@kolabnow.com")
+  embedded-bootstrap translations)
+
+(define-member (person "Eric Bavier"
+                       "bavier@posteo.net")
+  science)
+
+(define-member (person "Lars-Dominik Braun"
+                       "lars@6xq.net")
+  python haskell)
+
+(define-member (person "Jonathan Brielmaier"
+                       "jonathan.brielmaier@web.de")
+  mozilla)
+
 (define-member (person "Ludovic Courtès"
                       "ludo@gnu.org")
  core home embedded-bootstrap mentors)
@@ -187,6 +420,42 @@ and the maven-build-system."))
                       "andreas@enge.fr")
  science)

+(define-member (person "Björn Höfling"
+                       "bjoern.hoefling@bjoernhoefling.de")
+  java)
+
+(define-member (person "Leo Famulari"
+                       "leo@famulari.name")
+  kernel)
+
+(define-member (person "Efraim Flashner"
+                       "efraim@flashner.co.il")
+  embedded-bootstrap julia rust science)
+
+(define-member (person "jgart"
+                       "jgart@dismail.de")
+  python lisp mentors)
+
+(define-member (person "Guillaume Le Vaillant"
+                       "glv@posteo.net")
+  lisp)
+
+(define-member (person "Julien Lepiller"
+                       "julien@lepiller.eu")
+  java ocaml translations)
+
+(define-member (person "Philip McGrath"
+                       "philip@philipmcgrath.com")
+  racket)
+
+(define-member (person "Mathieu Othacehe"
+                       "othacehe@gnu.org")
+  core installer mentors)
+
+(define-member (person "Florian Pelz"
+                       "pelzflorian@pelzflorian.de")
+  translations)
+
 (define-member (person "Liliana Marie Prikler"
                       "liliana.prikler@gmail.com")
  emacs games)
@@ -195,12 +464,58 @@ and the maven-build-system."))
                       "rekado@elephly.net")
  r core mentors)

+(define-member (person "Christopher Baines"
+                       "mail@cbaines.net")
+  core mentors ruby)
+
+(define-member (person "Andrew Tropin"
+                       "andrew@trop.in")
+  home emacs)
+
+(define-member (person "pukkamustard"
+                       "pukkamustard@posteo.net")
+  ocaml)
+
+(define-member (person "Josselin Poiret"
+                       "dev@jpoiret.xyz")
+  core installer)
+
+(define-member (person "("
+                       "paren@disroot.org")
+  home mentors)
+
+(define-member (person "Simon Tournier"
+                       "zimon.toutoune@gmail.com")
+  julia core mentors)
+
+(define-member (person "Raghav Gururajan"
+                       "rg@raghavgururajan.name")
+  mentors)
+

 (define (find-team name)
  (or (hash-ref %teams (string->symbol name))
      (error (format #false
                           "no such team: ~a~%" name))))

+(define (find-team-by-scope files)
+  "Return the team(s) which scope matches at least one of the FILES, as list
+of file names as string."
+  (hash-fold
+   (lambda (key team acc)
+     (if (any (lambda (file)
+                (any (match-lambda
+                       ((? string? scope)
+                        (string=? scope file))
+                       ((? regexp? scope)
+                        (regexp-exec scope file)))
+                     (team-scope team)))
+              files)
+         (cons team acc)
+         acc))
+   '()
+   %teams))
+
 (define (cc . teams)
  "Return arguments for `git send-email' to notify the members of the given
 TEAMS when a patch is received by Debbugs."
@@ -219,20 +534,22 @@ TEAMS when a patch is received by Debbugs."
             prefix
             (person-name member)
             (person-email member)))
-   (team-members team)))
+   (sort
+    (team-members team)
+    (lambda (m1 m2) (string<? (person-name m1) (person-name m2))))))

 (define (list-teams)
-  "Print all teams and their members."
+  "Print all teams, their scope and their members."
  (define port* (current-output-port))
  (define width* (%text-width))
-  (hash-for-each
-   (lambda (key team)
+  (for-each
+   (lambda (team)
     (format port*
             "\
 id: ~a
 name: ~a
 description: ~a
-members:
+~amembers:
 "
             (team-id team)
             (team-name team)
@@ -241,15 +558,52 @@ members:
                          (string->recutils
                           (fill-paragraph text width*
                                           (string-length "description: ")))))
-                 "<none>"))
+                 "<none>")
+             (match (team-scope team)
+               (() "")
+               (scope (format #f "scope: ~{~s ~}~%" scope))))
     (list-members team port* "+ ")
     (newline))
-   %teams))
+   (sort
+    (hash-map->list (lambda (key value) value) %teams)
+    (lambda (team1 team2)
+      (string<? (symbol->string (team-id team1))
+                (symbol->string (team-id team2)))))))

+
+(define (diff-revisions rev-start rev-end)
+  "Return the list of added, modified or removed files between REV-START
+and REV-END, two git revision strings."
+  (let* ((repository (repository-open (getcwd)))
+         (commit1 (commit-lookup repository
+                                 (object-id
+                                  (revparse-single repository rev-start))))
+         (commit2 (commit-lookup repository
+                                 (object-id
+                                  (revparse-single repository rev-end))))
+         (diff (diff-tree-to-tree repository
+                                  (commit-tree commit1)
+                                  (commit-tree commit2)))
+         (files '()))
+    (diff-foreach
+     diff
+     (lambda (delta progress)
+       (set! files
+             (cons (diff-file-path (diff-delta-old-file delta)) files))
+       0)
+     (const 0)
+     (const 0)
+     (const 0))
+    files))
+
+
 (define (main . args)
  (match args
    (("cc" . team-names)
     (apply cc (map find-team team-names)))
+    (("cc-members" rev-start rev-end)
+     (apply cc (find-team-by-scope
+                (diff-revisions rev-start rev-end))))
    (("list-teams" . args)
     (list-teams))
    (("list-members" . team-names)
@@ -259,6 +613,12 @@ members:
      team-names))
    (anything
     (format (current-error-port)
-             "Usage: etc/teams.scm <command> [<args>]~%"))))
+             "Usage: etc/teams.scm <command> [<args>]
+
+Commands:
+  cc <team-name>            get git send-email flags for cc-ing <team-name>
+  cc-members <start> <end>  cc teams related to files changed between revisions
+  list-teams                list teams and their members
+  list-members <team-name>  list members belonging to <team-name>~%"))))

 (apply main (cdr (command-line)))
@@ -0,0 +1,84 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 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 entries to build past Guix
+;;; releases from the current Guix, as per 'guix time-machine'.
+
+(use-modules (srfi srfi-9) (ice-9 match)
+             (guix channels) (guix gexp)
+             ((guix store) #:select (%store-monad))
+             ((guix monads) #:select (mparameterize return))
+             ((guix git) #:select (%repository-cache-directory))
+             ((guix build utils) #:select (mkdir-p)))
+
+;; Representation of the latest channels.  This type exists just so we can
+;; refer to such records in a gexp.
+(define-record-type <guix-instance>
+  (guix-instance channels)
+  guix-instance?
+  (channels guix-instance-channels))
+
+(define-gexp-compiler (guix-instance-compiler (instance <guix-instance>)
+                                              system target)
+  (match instance
+    (($ <guix-instance> channels)
+     ;; When this manifest is evaluated by Cuirass, make sure it does not
+     ;; fiddle with the cached checkout that Cuirass is also using since
+     ;; concurrent accesses are unsafe.
+     (mparameterize %store-monad ((%repository-cache-directory
+                                   (string-append (%repository-cache-directory)
+                                                  "/time-travel/" system)))
+       (return (mkdir-p (%repository-cache-directory)))
+       (latest-channel-derivation channels)))))
+
+(define (guix-instance->manifest-entry instance)
+  "Return a manifest entry for INSTANCE."
+  (define (shorten commit)
+    (string-take commit 7))
+
+  (manifest-entry
+    (name "guix")
+    (version (string-join (map (compose shorten channel-commit)
+                               (guix-instance-channels instance))
+                          "-"))
+    (item instance)))
+
+(define (commit->guix-instance commit)
+  "Return a Guix instance for COMMIT."
+  (guix-instance (list (channel
+                        (inherit %default-guix-channel)
+                        (commit commit)))))
+
+(define %release-commits
+  ;; Release commits: the list of version/commit pairs.
+  '(("1.3.0" . "a0178d34f582b50e9bdbb0403943129ae5b560ff")
+    ("1.2.0" . "a099685659b4bfa6b3218f84953cbb7ff9e88063")
+    ("1.1.0" . "d62c9b2671be55ae0305bebfda17b595f33797f2")
+    ("1.0.1" . "d68de958b60426798ed62797ff7c96c327a672ac")
+    ("1.0.0" . "6298c3ffd9654d3231a6f25390b056483e8f407c")
+    ("0.16.0" . "4a0b87f0ec5b6c2dcf82b372dd20ca7ea6acdd9c")))
+
+(manifest
+ (map (match-lambda
+        ((version . commit)
+         (let ((entry (guix-instance->manifest-entry
+                       (commit->guix-instance commit))))
+           (manifest-entry
+             (inherit entry)
+             (version version)))))
+      %release-commits))
@@ -29,7 +29,7 @@
 ;;; Code:

 (define %artwork-repository
-  (let ((commit "2f2fe74c1078be605a6a93c2193fd6c715cebbb0"))
+  (let ((commit "4c7f2ce6428a63e202cd2a9474a06f68a946934d"))
    (origin
      (method git-fetch)
      (uri (git-reference
@@ -39,6 +39,6 @@
                                "-checkout"))
      (sha256
       (base32
-        "0c8r0phvm3wgf914n2kw1461cwdjl2zbzqvzq9x7d9pwkgv7xmq7")))))
+        "1rl569759q9wm1dxn7nkq3873d2k92giic7aa6jwzwr3n16prc7y")))))

 ;;; artwork.scm ends here
@@ -1,9 +1,11 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017 David Craven <david@craven.ch>
-;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2017, 2020, 2022 Mathieu Othacehe <othacehe@gnu.org>
 ;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
 ;;; Copyright © 2019, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>
+;;; Copyright © 2022 Reza Alizadeh Majd <r.majd@pantherx.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,6 +23,8 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

 (define-module (gnu bootloader)
+  #:use-module (gnu system file-systems)
+  #:use-module (gnu system uuid)
  #:use-module (guix discovery)
  #:use-module (guix gexp)
  #:use-module (guix profiles)
@@ -30,6 +34,8 @@
  #:use-module (guix diagnostics)
  #:use-module (guix i18n)
  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
  #:use-module (ice-9 match)
  #:export (menu-entry
            menu-entry?
@@ -42,6 +48,7 @@
            menu-entry-multiboot-kernel
            menu-entry-multiboot-arguments
            menu-entry-multiboot-modules
+            menu-entry-chain-loader

            menu-entry->sexp
            sexp->menu-entry
@@ -69,7 +76,7 @@
            bootloader-configuration-terminal-inputs
            bootloader-configuration-serial-unit
            bootloader-configuration-serial-speed
-            bootloader-configuration-additional-configuration
+            bootloader-configuration-device-tree-support?

            %bootloaders
            lookup-bootloader-by-name
@@ -100,34 +107,77 @@
  (multiboot-arguments menu-entry-multiboot-arguments
                       (default '()))      ; list of string-valued gexps
  (multiboot-modules menu-entry-multiboot-modules
-                     (default '())))       ; list of multiboot commands, where
+                     (default '()))        ; list of multiboot commands, where
                                           ; a command is a list of <string>
+  (chain-loader     menu-entry-chain-loader
+                    (default #f)))         ; string, path of efi file
+
+(define (report-menu-entry-error menu-entry)
+  (raise
+   (condition
+    (&message
+     (message
+      (format #f (G_ "invalid menu-entry: ~a") menu-entry)))
+    (&fix-hint
+     (hint
+      (G_ "Please chose only one of:
+@enumerate
+@item direct boot by specifying fields @code{linux},
+@code{linux-arguments} and @code{linux-modules},
+@item multiboot by specifying fields @code{multiboot-kernel},
+@code{multiboot-arguments} and @code{multiboot-modules},
+@item chain-loader by specifying field @code{chain-loader}.
+@end enumerate"))))))

 (define (menu-entry->sexp entry)
  "Return ENTRY serialized as an sexp."
+  (define (device->sexp device)
+    (match device
+      ((? uuid? uuid)
+       `(uuid ,(uuid-type uuid) ,(uuid->string uuid)))
+      ((? file-system-label? label)
+       `(label ,(file-system-label->string label)))
+      (_ device)))
  (match entry
-    (($ <menu-entry> label device mount-point linux linux-arguments initrd #f
-                     ())
+    (($ <menu-entry> label device mount-point
+                     (? identity linux) linux-arguments (? identity initrd)
+                     #f () () #f)
     `(menu-entry (version 0)
                  (label ,label)
-                  (device ,device)
+                  (device ,(device->sexp device))
                  (device-mount-point ,mount-point)
                  (linux ,linux)
                  (linux-arguments ,linux-arguments)
                  (initrd ,initrd)))
    (($ <menu-entry> label device mount-point #f () #f
-                     multiboot-kernel multiboot-arguments multiboot-modules)
+                     (? identity multiboot-kernel) multiboot-arguments
+                     multiboot-modules #f)
     `(menu-entry (version 0)
                  (label ,label)
-                  (device ,device)
+                  (device ,(device->sexp device))
                  (device-mount-point ,mount-point)
                  (multiboot-kernel ,multiboot-kernel)
                  (multiboot-arguments ,multiboot-arguments)
-                  (multiboot-modules ,multiboot-modules)))))
+                  (multiboot-modules ,multiboot-modules)))
+    (($ <menu-entry> label device mount-point #f () #f #f () ()
+                     (? identity chain-loader))
+     `(menu-entry (version 0)
+                  (label ,label)
+                  (device ,(device->sexp device))
+                  (device-mount-point ,mount-point)
+                  (chain-loader ,chain-loader)))
+    (_ (report-menu-entry-error entry))))

 (define (sexp->menu-entry sexp)
  "Turn SEXP, an sexp as returned by 'menu-entry->sexp', into a <menu-entry>
 record."
+  (define (sexp->device device-sexp)
+    (match device-sexp
+      (('uuid type uuid-string)
+       (uuid uuid-string type))
+      (('label label)
+       (file-system-label label))
+      (_ device-sexp)))
  (match sexp
    (('menu-entry ('version 0)
                  ('label label) ('device device)
@@ -136,7 +186,7 @@ record."
                  ('initrd initrd) _ ...)
     (menu-entry
      (label label)
-      (device device)
+      (device (sexp->device device))
      (device-mount-point mount-point)
      (linux linux)
      (linux-arguments linux-arguments)
@@ -149,11 +199,20 @@ record."
                  ('multiboot-modules multiboot-modules) _ ...)
     (menu-entry
      (label label)
-      (device device)
+      (device (sexp->device device))
      (device-mount-point mount-point)
      (multiboot-kernel multiboot-kernel)
      (multiboot-arguments multiboot-arguments)
-      (multiboot-modules multiboot-modules)))))
+      (multiboot-modules multiboot-modules)))
+    (('menu-entry ('version 0)
+                  ('label label) ('device device)
+                  ('device-mount-point mount-point)
+                  ('chain-loader chain-loader) _ ...)
+     (menu-entry
+      (label label)
+      (device (sexp->device device))
+      (device-mount-point mount-point)
+      (chain-loader chain-loader)))))


 ;;;
@@ -194,29 +253,33 @@ instead~%")))
 (define-record-type* <bootloader-configuration>
  bootloader-configuration make-bootloader-configuration
  bootloader-configuration?
-  (bootloader         bootloader-configuration-bootloader) ;<bootloader>
-  (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
-                      (default 0))
-  (timeout            bootloader-configuration-timeout ;seconds as integer
-                      (default 5))
-  (keyboard-layout    bootloader-configuration-keyboard-layout ;<keyboard-layout> | #f
-                      (default #f))
-  (theme              bootloader-configuration-theme ;bootloader-specific theme
-                      (default #f))
-  (terminal-outputs   bootloader-configuration-terminal-outputs ;list of symbols
-                      (default '(gfxterm)))
-  (terminal-inputs    bootloader-configuration-terminal-inputs ;list of symbols
-                      (default '()))
-  (serial-unit        bootloader-configuration-serial-unit ;integer | #f
-                      (default #f))
-  (serial-speed       bootloader-configuration-serial-speed ;integer | #f
-                      (default #f)))
+  (bootloader
+   bootloader-configuration-bootloader) ;<bootloader>
+  (targets               %bootloader-configuration-targets
+                         (default #f))     ;list of strings
+  (target                %bootloader-configuration-target ;deprecated
+                         (default #f)
+                         (sanitize warn-target-field-deprecation))
+  (menu-entries          bootloader-configuration-menu-entries
+                         (default '()))   ;list of <menu-entry>
+  (default-entry         bootloader-configuration-default-entry
+                         (default 0))     ;integer
+  (timeout               bootloader-configuration-timeout
+                         (default 5))     ;seconds as integer
+  (keyboard-layout       bootloader-configuration-keyboard-layout
+                         (default #f))    ;<keyboard-layout> | #f
+  (theme                 bootloader-configuration-theme
+                         (default #f))    ;bootloader-specific theme
+  (terminal-outputs      bootloader-configuration-terminal-outputs
+                         (default '(gfxterm)))   ;list of symbols
+  (terminal-inputs       bootloader-configuration-terminal-inputs
+                         (default '()))   ;list of symbols
+  (serial-unit           bootloader-configuration-serial-unit
+                         (default #f))    ;integer | #f
+  (serial-speed          bootloader-configuration-serial-speed
+                         (default #f))    ;integer | #f
+  (device-tree-support?  bootloader-configuration-device-tree-support?
+                         (default #t)))   ;boolean

 (define-deprecated (bootloader-configuration-target config)
  bootloader-configuration-targets
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017 David Craven <david@craven.ch>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2022 Reza Alizadeh Majd <r.majd@pantherx.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -38,6 +39,9 @@ corresponding to old generations of the system."
  (define all-entries
    (append entries (bootloader-configuration-menu-entries config)))

+  (define with-fdtdir?
+    (bootloader-configuration-device-tree-support? config))
+
  (define (menu-entry->gexp entry)
    (let ((label (menu-entry-label entry))
          (kernel (menu-entry-linux entry))
@@ -46,12 +50,16 @@ corresponding to old generations of the system."
      #~(format port "LABEL ~a
  MENU LABEL ~a
  KERNEL ~a
-  FDTDIR ~a/lib/dtbs
+  ~a
  INITRD ~a
  APPEND ~a
 ~%"
                #$label #$label
-                #$kernel (dirname #$kernel) #$initrd
+                #$kernel
+                (if #$with-fdtdir?
+                    (string-append "FDTDIR " (dirname #$kernel) "/lib/dtbs")
+                    "")
+                #$initrd
                (string-join (list #$@kernel-arguments)))))

  (define builder
@@ -374,44 +374,57 @@ when booting a root file system on a Btrfs subvolume."
    (let ((label (menu-entry-label entry))
          (linux (menu-entry-linux entry))
          (device (menu-entry-device entry))
-          (device-mount-point (menu-entry-device-mount-point entry)))
-      (if linux
-          (let ((arguments (menu-entry-linux-arguments entry))
-                (linux (normalize-file linux
-                                       device-mount-point
-                                       store-directory-prefix))
-                (initrd (normalize-file (menu-entry-initrd entry)
-                                        device-mount-point
-                                        store-directory-prefix)))
-         ;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point.
-         ;; Use the right file names for LINUX and INITRD in case
-         ;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a
-         ;; separate partition.
+          (device-mount-point (menu-entry-device-mount-point entry))
+          (multiboot-kernel (menu-entry-multiboot-kernel entry))
+          (chain-loader (menu-entry-chain-loader entry)))
+      (cond
+       (linux
+        (let ((arguments (menu-entry-linux-arguments entry))
+              (linux (normalize-file linux
+                                     device-mount-point
+                                     store-directory-prefix))
+              (initrd (normalize-file (menu-entry-initrd entry)
+                                      device-mount-point
+                                      store-directory-prefix)))
+          ;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point.
+          ;; Use the right file names for LINUX and INITRD in case
+          ;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a
+          ;; separate partition.

-         ;; When BTRFS-SUBVOLUME-FILE-NAME is defined, prepend it the linux and
-         ;; initrd paths, to allow booting from a Btrfs subvolume.
-         #~(format port "menuentry ~s {
+          ;; When BTRFS-SUBVOLUME-FILE-NAME is defined, prepend it the linux and
+          ;; initrd paths, to allow booting from a Btrfs subvolume.
+          #~(format port "menuentry ~s {
  ~a
  linux ~a ~a
  initrd ~a
 }~%"
-                   #$label
-                   #$(grub-root-search device linux)
-                   #$linux (string-join (list #$@arguments))
-                   #$initrd))
-          (let ((kernel (menu-entry-multiboot-kernel entry))
-                (arguments (menu-entry-multiboot-arguments entry))
-                (modules (menu-entry-multiboot-modules entry))
-                (root-index 1))            ; XXX EFI will need root-index 2
-        #~(format port "
+                    #$label
+                    #$(grub-root-search device linux)
+                    #$linux (string-join (list #$@arguments))
+                    #$initrd)))
+       (multiboot-kernel
+        (let ((kernel (menu-entry-multiboot-kernel entry))
+              (arguments (menu-entry-multiboot-arguments entry))
+              (modules (menu-entry-multiboot-modules entry))
+              (root-index 1))            ; XXX EFI will need root-index 2
+          #~(format port "
 menuentry ~s {
  multiboot ~a root=device:hd0s~a~a~a
+}~%"
+                    #$label
+                    #$kernel
+                    #$root-index (string-join (list #$@arguments) " " 'prefix)
+                    (string-join (map string-join '#$modules)
+                                 "\n  module " 'prefix))))
+       (chain-loader
+        #~(format port "
+menuentry ~s {
+  ~a
+  chainloader ~a
 }~%"
                  #$label
-                  #$kernel
-                  #$root-index (string-join (list #$@arguments) " " 'prefix)
-                  (string-join (map string-join '#$modules)
-                               "\n  module " 'prefix))))))
+                  #$(grub-root-search device chain-loader)
+                  #$chain-loader)))))

  (define (crypto-devices)
    (define (crypto-device->cryptomount dev)
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2020, 2021 Marius Bakke <marius@gnu.org>
+;;; Copyright © 2022 Nicolas Graves <ngraves@ngraves.fr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -19,10 +20,9 @@
 (define-module (gnu build chromium-extension)
  #:use-module (guix gexp)
  #:use-module (guix packages)
-  #:use-module (gnu packages chromium)
  #:use-module (gnu packages gnupg)
  #:use-module (gnu packages tls)
-  #:use-module (gnu packages xorg)
+  #:use-module (gnu packages node-xyz)
  #:use-module (guix build-system trivial)
  #:export (make-chromium-extension))

@@ -69,24 +69,14 @@ in PACKAGE-OUTPUT of PACKAGE.  The extension will be signed with SIGNING-KEY."
   (string-append name "-" version ".crx")
   (with-imported-modules '((guix build utils))
     #~(begin
-         ;; This is not great.  We pull Xorg and Chromium just to Zip and
-         ;; sign an extension.  This should be implemented with something
-         ;; lighter.  (TODO: where is the CRXv3 documentation..?)
         (use-modules (guix build utils))
-         (let ((chromium #$(file-append ungoogled-chromium "/bin/chromium"))
-               (xvfb #$(file-append xorg-server "/bin/Xvfb"))
+         (let ((crx3 #+(file-append node-crx3 "/bin/crx3"))
               (packdir (string-append (getcwd) "/extension")))
           (mkdir packdir)
           (copy-recursively (ungexp package package-output) packdir
                             ;; Ensure consistent file modification times.
                             #:keep-mtime? #t)
-           (system (string-append xvfb " :1 &"))
-           (setenv "DISPLAY" ":1")
-           (sleep 2)                    ;give Xorg some time to initialize...
-           (invoke chromium
-                   "--user-data-dir=chromium-profile"
-                   (string-append "--pack-extension=" packdir)
-                   (string-append "--pack-extension-key=" #$signing-key))
+           (invoke crx3 "--keyPath" #$signing-key packdir)
           (copy-file (string-append packdir ".crx") #$output))))
   #:local-build? #t))

@@ -6,6 +6,7 @@
 ;;; 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>
+;;; Copyright © 2022 Oleg Pykhalov <go.wigust@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -97,6 +98,18 @@ standard input is /dev/null."
             system*/console)
         program args))

+(define (call-with-input-file file proc)
+  "Like 'call-with-input-file', but pass O_CLOEXEC."
+  (let ((port #f))
+    (dynamic-wind
+      (lambda ()
+        (set! port (open file (logior O_RDONLY O_CLOEXEC))))
+      (lambda ()
+        (proc port))
+      (lambda ()
+        (close-port port)
+        (set! port #f)))))
+
 (define (bind-mount source target)
  "Bind-mount SOURCE at TARGET."
  (mount source target "" MS_BIND))
@@ -886,6 +899,10 @@ caught and lead to a warning and #f as the result."
                 (format (current-error-port)
                         "warning: failed to read from device '~a'~%" device)
                 #f)
+                ((= EMEDIUMTYPE errno)            ;inaccessible, like DRBD secondaries
+                 (format (current-error-port)
+                         "warning: failed to open device '~a'~%" device)
+                 #f)
                (else
                 (apply throw args))))))))

@@ -1110,7 +1127,7 @@ corresponds to the symbols listed in FLAGS."
      (('read-only rest ...)
       (logior MS_RDONLY (loop rest)))
      (('bind-mount rest ...)
-       (logior MS_BIND (loop rest)))
+       (logior MS_REC (logior MS_BIND (loop rest))))
      (('no-suid rest ...)
       (logior MS_NOSUID (loop rest)))
      (('no-dev rest ...)
@@ -1119,10 +1136,14 @@ corresponds to the symbols listed in FLAGS."
       (logior MS_NOEXEC (loop rest)))
      (('no-atime rest ...)
       (logior MS_NOATIME (loop rest)))
+      (('no-diratime rest ...)
+       (logior MS_NODIRATIME (loop rest)))
      (('strict-atime rest ...)
       (logior MS_STRICTATIME (loop rest)))
      (('lazy-time rest ...)
       (logior MS_LAZYTIME (loop rest)))
+      (('shared rest ...)
+       (loop rest))
      (()
       0))))

@@ -1180,12 +1201,16 @@ corresponds to the symbols listed in FLAGS."
                 (not (file-is-directory? source)))
            (unless (file-exists? target)
              (mkdir-p (dirname target))
-              (call-with-output-file target (const #t)))
+              (close-fdes
+               (open-fdes target (logior O_WRONLY O_CREAT O_CLOEXEC))))
            (mkdir-p target))

        (cond
         ((string-prefix? "nfs" type)
          (mount-nfs source target type flags options))
+         ((memq 'shared (file-system-flags fs))
+          (mount source target type flags options)
+          (mount "none" target #f MS_SHARED))
         (else
          (mount source target type flags options)))

@@ -83,11 +83,13 @@ turn doesn't take any constant overhead into account, force a 1-MiB minimum."
        (fs-options (partition-file-system-options partition))
        (label (partition-label partition))
        (uuid (partition-uuid partition))
-        (flags (partition-flags partition))
        (journal-options "lazy_itable_init=1,lazy_journal_init=1"))
    (apply invoke
           `("fakeroot" "mke2fs" "-t" ,fs "-d" ,root
-             "-L" ,label "-U" ,(uuid->string uuid)
+             "-L" ,label
+             ,@(if uuid
+                   `("-U" ,(uuid->string uuid))
+                   '())
             "-E" ,(format #f "root_owner=~a:~a,~a"
                           owner-uid owner-gid journal-options)
             ,@fs-options
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013-2020, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
+;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -56,19 +57,24 @@ that the fonts, background images, etc. referred to by BOOTCFG are not GC'd."
 (define* (evaluate-populate-directive directive target
                                      #:key
                                      (default-gid 0)
-                                      (default-uid 0))
+                                      (default-uid 0)
+                                      (error-on-dangling-symlink? #t))
  "Evaluate DIRECTIVE, an sexp describing a file or directory to create under
 directory TARGET.  DEFAULT-UID and DEFAULT-GID are the default UID and GID in
 the context of the caller.  If the directive matches those defaults then,
-'chown' won't be run."
+'chown' won't be run.  When ERROR-ON-DANGLING-SYMLINK? is true, abort with an
+error when a dangling symlink would be created."
+  (define target* (if (string-suffix? "/" target)
+                      target
+                      (string-append target "/")))
  (let loop ((directive directive))
    (catch 'system-error
      (lambda ()
        (match directive
          (('directory name)
-           (mkdir-p (string-append target name)))
+           (mkdir-p (string-append target* name)))
          (('directory name uid gid)
-           (let ((dir (string-append target name)))
+           (let ((dir (string-append target* name)))
             (mkdir-p dir)
             ;; If called from a context without "root" permissions, "chown"
             ;; to root will fail.  In that case, do not try to run "chown"
@@ -78,27 +84,38 @@ the context of the caller.  If the directive matches those defaults then,
                 (chown dir uid gid))))
          (('directory name uid gid mode)
           (loop `(directory ,name ,uid ,gid))
-           (chmod (string-append target name) mode))
+           (chmod (string-append target* name) mode))
          (('file name)
-           (call-with-output-file (string-append target name)
+           (call-with-output-file (string-append target* name)
             (const #t)))
          (('file name (? string? content))
-           (call-with-output-file (string-append target name)
+           (call-with-output-file (string-append target* name)
             (lambda (port)
               (display content port))))
          ((new '-> old)
-           (let try ()
-             (catch 'system-error
-               (lambda ()
-                 (symlink old (string-append target new)))
-               (lambda args
-                 ;; When doing 'guix system init' on the current '/', some
-                 ;; symlinks may already exists.  Override them.
-                 (if (= EEXIST (system-error-errno args))
-                     (begin
-                       (delete-file (string-append target new))
-                       (try))
-                     (apply throw args))))))))
+           (let ((new* (string-append target* new)))
+             (let try ()
+               (catch 'system-error
+                 (lambda ()
+                   (when error-on-dangling-symlink?
+                     ;; When the symbolic link points to a relative path,
+                     ;; checking if its target exists must be done relatively
+                     ;; to the link location.
+                     (unless (if (string-prefix? "/" old)
+                                 (file-exists? old)
+                                 (with-directory-excursion (dirname new*)
+                                   (file-exists? old)))
+                       (error (format #f "symlink `~a' points to nonexistent \
+file `~a'" new* old))))
+                   (symlink old new*))
+                 (lambda args
+                   ;; When doing 'guix system init' on the current '/', some
+                   ;; symlinks may already exists.  Override them.
+                   (if (= EEXIST (system-error-errno args))
+                       (begin
+                         (delete-file new*)
+                         (try))
+                       (apply throw args)))))))))
      (lambda args
        ;; Usually we can only get here when installing to an existing root,
        ;; as with 'guix system init foo.scm /'.
@@ -142,7 +159,10 @@ STORE."
 includes /etc, /var, /run, /bin/sh, etc., and all the symlinks to SYSTEM.
 EXTRAS is a list of directives appended to the built-in directives to populate
 TARGET."
-  (for-each (cut evaluate-populate-directive <> target)
+  ;; It's expected that some symbolic link targets do not exist yet, so do not
+  ;; error on dangling links.
+  (for-each (cut evaluate-populate-directive <> target
+                 #:error-on-dangling-symlink? #f)
            (append (directives (%store-directory)) extras))

  ;; Add system generation 1.
@@ -262,12 +282,31 @@ disk."
    (mount "/.rw-store" (%store-directory) "" MS_MOVE)
    (rmdir "/.rw-store")))

+(define (umount* directory)
+  "Unmount DIRECTORY, but retry a few times upon EBUSY."
+  (let loop ((attempts 5))
+    (catch 'system-error
+      (lambda ()
+        (umount directory))
+      (lambda args
+        (if (and (= EBUSY (system-error-errno args))
+                 (> attempts 0))
+            (begin
+              (sleep 1)
+              (loop (- attempts 1)))
+            (apply throw args))))))
+
 (define (unmount-cow-store target backing-directory)
  "Unmount copy-on-write store."
  (let ((tmp-dir "/remove"))
    (mkdir-p tmp-dir)
    (mount (%store-directory) tmp-dir "" MS_MOVE)
-    (umount tmp-dir)
+
+    ;; We might get EBUSY at this point, possibly because of lingering
+    ;; processes with open file descriptors.  Use 'umount*' to retry upon
+    ;; EBUSY, leaving a bit of time.  See <https://issues.guix.gnu.org/59884>.
+    (umount* tmp-dir)
+
    (rmdir tmp-dir)
    (delete-file-recursively
     (string-append target backing-directory))))
@@ -153,14 +153,11 @@ implementation detail used to identify the accounts in Jami."
        (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")))
+  "Return the public key fingerprint of ACCOUNT."
+  (assoc-ref account "Account.username"))

 (define (id->username id)
-  "Return USERNAME, the registered username associated with ID, else its
-public key fingerprint, else #f."
+  "Return the public key fingerprint corresponding to account with ID, else #f."
  (account->username (id->account id)))

 (define (get-accounts)
@@ -589,15 +589,6 @@ upon error."
        (load-linux-modules-from-directory linux-modules
                                           linux-module-directory)

-        (unless (or (member "hibernate=noresume" args)
-                    ;; Also handle the equivalent old-style argument.
-                    ;; See Documentation/admin-guide/kernel-parameters.txt.
-                    (member "noresume" args))
-          ;; Try to resume immediately after loading (storage) modules
-          ;; but before any on-disk file systems have been mounted.
-          (false-if-exception           ; failure is not fatal
-           (resume-if-hibernated (find-long-option "resume" args))))
-
        (when keymap-file
          (let ((status (system* "loadkeys" keymap-file)))
            (unless (zero? status)
@@ -631,6 +622,15 @@ the root file system...\n" root-delay)
          (unless (pre-mount)
            (error "pre-mount actions failed")))

+        (unless (or (member "hibernate=noresume" args)
+                    ;; Also handle the equivalent old-style argument.
+                    ;; See Documentation/admin-guide/kernel-parameters.txt.
+                    (member "noresume" args))
+          ;; Try to resume immediately after loading (storage) modules
+          ;; but before any on-disk file systems have been mounted.
+          (false-if-exception           ; failure is not fatal
+           (resume-if-hibernated (find-long-option "resume" args))))
+
        (setenv "EXT2FS_NO_MTAB_OK" "1")

        ;; Mount the root file system.
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
-;;; Copyright © 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017-2019, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -233,7 +233,7 @@ that host UIDs (respectively GIDs) map to in the namespace."
  ;; The parent process must initialize the user namespace for the child
  ;; before it can boot.  To negotiate this, a pipe is used such that the
  ;; child process blocks until the parent writes to it.
-  (match (socketpair PF_UNIX SOCK_STREAM 0)
+  (match (socketpair PF_UNIX (logior SOCK_CLOEXEC SOCK_STREAM) 0)
    ((child . parent)
     (let ((flags (namespaces->bit-mask namespaces)))
       (match (clone flags)
@@ -442,6 +442,10 @@ return the exit status."
  "Like 'container-excursion', but return the return value of THUNK."
  (match (pipe)
    ((in . out)
+     ;; Make sure IN and OUT are not inherited if THUNK forks + execs.
+     (fcntl in F_SETFD FD_CLOEXEC)
+     (fcntl out F_SETFD FD_CLOEXEC)
+
     (match (container-excursion pid
              (lambda ()
                (close-port in)
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2016, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2016, 2018, 2019, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2018 Danny Milosavljevic <dannym@scratchpost.org>
 ;;;
@@ -28,6 +28,7 @@
  #:use-module (rnrs io ports)
  #:use-module (rnrs bytevectors)
  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9 gnu)
  #:use-module (srfi srfi-11)
  #:use-module (srfi srfi-26)
  #:use-module (ice-9 ftw)
@@ -50,6 +51,17 @@
            load-linux-module*
            load-linux-modules-from-directory

+            pci-devices
+            pci-device?
+            pci-device-vendor
+            pci-device-id
+            pci-device-class
+            pci-device-module-alias
+            storage-pci-device?
+            network-pci-device?
+            display-pci-device?
+            load-pci-device-database
+
            current-module-debugging-port

            device-module-aliases
@@ -429,6 +441,127 @@ key such as 'MAJOR or 'DEVTYPE and each cdr is the corresponding value."
      (line
       (loop (cons (key=value->pair line) result))))))

+;; PCI device known to the Linux kernel.
+(define-immutable-record-type <pci-device>
+  (pci-device vendor device class module-alias)
+  pci-device?
+  (vendor       pci-device-vendor)                ;integer
+  (device       pci-device-id)                    ;integer
+  (class        pci-device-class)                 ;integer
+  (module-alias pci-device-module-alias))         ;string | #f
+
+(define (pci-device-class-predicate mask bits)
+  (lambda (device)
+    "Return true if DEVICE has the chosen class."
+    (= (logand mask (pci-device-class device)) bits)))
+
+(define storage-pci-device?                   ;"Mass storage controller" class
+  (pci-device-class-predicate #xff0000 #x010000))
+(define network-pci-device?                       ;"Network controller" class
+  (pci-device-class-predicate #xff0000 #x020000))
+(define display-pci-device?                       ;"Display controller" class
+  (pci-device-class-predicate #xff0000 #x030000))
+
+(define (pci-devices)
+  "Return the list of PCI devices of the system (<pci-device> records)."
+  (define (read-hex port)
+    (let ((line (read-line port)))
+      (and (string? line)
+           (string-prefix? "0x" line)
+           (string->number (string-drop line 2) 16))))
+
+  (filter-map (lambda (directory)
+                (define properties
+                  (call-with-input-file (string-append directory "/uevent")
+                    read-uevent))
+                (define vendor
+                  (call-with-input-file (string-append directory "/vendor")
+                    read-hex))
+                (define device
+                  (call-with-input-file (string-append directory "/device")
+                    read-hex))
+                (define class
+                  (call-with-input-file (string-append directory "/class")
+                    read-hex))
+
+                (pci-device vendor device class
+                            (assq-ref properties 'MODALIAS)))
+              (find-files "/sys/bus/pci/devices"
+                          #:stat lstat)))
+
+(define (read-pci-device-database port)
+  "Parse the 'pci.ids' database that ships with the pciutils package and is
+maintained at <https://pci-ids.ucw.cz/>."
+  (define (comment? str)
+    (string-prefix? "#" (string-trim str)))
+  (define (blank? str)
+    (string-null? (string-trim-both str)))
+  (define (device? str)
+    (eqv? #\tab (string-ref str 0)))
+  (define (subvendor? str)
+    (string-prefix? "\t\t" str))
+  (define (class? str)
+    (string-prefix? "C " str))
+  (define (parse-id-line str)
+    (let* ((str   (string-trim-both str))
+           (space (string-index str char-set:whitespace)))
+      (values (string->number (string-take str space) 16)
+              (string-trim (string-drop str (+ 1 space))))))
+  (define (finish vendor vendor-id devices table)
+    (fold (lambda (device table)
+            (match device
+              ((device-id . name)
+               (vhash-consv (logior (ash vendor-id 16) device-id)
+                            (cons vendor name)
+                            table))))
+          table
+          devices))
+
+  (let loop ((table vlist-null)
+             (vendor-id #f)
+             (vendor #f)
+             (devices '()))
+    (match (read-line port)
+      ((? eof-object?)
+       (let ((table (if (and vendor vendor-id)
+                        (finish vendor vendor-id devices table)
+                        table)))
+         (lambda (vendor device)
+           (match (vhash-assv (logior (ash vendor 16) device) table)
+             (#f
+              (values #f #f))
+             ((_ . (vendor . name))
+              (values vendor name))))))
+      ((? comment?)
+       (loop table vendor-id vendor devices))
+      ((? blank?)
+       (loop table vendor-id vendor devices))
+      ((? subvendor?)                             ;currently ignored
+       (loop table vendor-id vendor devices))
+      ((? class?)                                 ;currently ignored
+       (loop table vendor-id vendor devices))
+      ((? device? line)
+       (let-values (((id name) (parse-id-line line)))
+         (loop table vendor-id vendor
+               (if (and vendor-id vendor)         ;class or device?
+                   (alist-cons id name devices)
+                   devices))))
+      (line
+       (let ((table (if (and vendor vendor-id)
+                        (finish vendor vendor-id devices table)
+                        table)))
+         (let-values (((vendor-id vendor) (parse-id-line line)))
+           (loop table vendor-id vendor '())))))))
+
+(define (load-pci-device-database file)
+  "Read the 'pci.ids' database at FILE (get it from the pciutils package or
+from <https://pci-ids.ucw.cz/>) and return a lookup procedure that takes a PCI
+vendor ID and a device ID (two integers) and returns the vendor name and
+device name as two values."
+  (let ((port (open-file file "r0")))
+    (call-with-gzip-input-port port
+      read-pci-device-database)))
+
 (define (device-module-aliases device)
  "Return the list of module aliases required by DEVICE, a /dev file name, as
 in this example:
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
+;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,18 +22,19 @@
  #:use-module (srfi srfi-9)
  #:use-module (srfi srfi-26)
  #:use-module (srfi srfi-64)
+  #:use-module (srfi srfi-71)
  #:use-module (rnrs io ports)
  #:use-module (ice-9 match)
  #:use-module (ice-9 popen)
  #:use-module (ice-9 regex)
  #:export (marionette?
+            marionette-pid
            make-marionette
            marionette-eval
            wait-for-file
            wait-for-tcp-port
            wait-for-unix-socket
            marionette-control
-            marionette-screen-text
            wait-for-screen-text
            %qwerty-us-keystrokes
            marionette-type
@@ -105,11 +107,14 @@ QEMU monitor and to the guest's backdoor REPL."
          "-monitor" (string-append "unix:" socket-directory "/monitor")
          "-chardev" (string-append "socket,id=repl,path=" socket-directory
                                    "/repl")
+          "-chardev" (string-append "socket,id=qga,server=on,wait=off,path="
+                                    socket-directory "/qemu-ga")

          ;; See
          ;; <http://www.linux-kvm.org/page/VMchannel_Requirements#Invocation>.
          "-device" "virtio-serial"
-          "-device" "virtserialport,chardev=repl,name=org.gnu.guix.port.0"))
+          "-device" "virtserialport,chardev=repl,name=org.gnu.guix.port.0"
+          "-device" "virtserialport,chardev=qga,name=org.qemu.guest_agent.0"))

  (define (accept* port)
    (match (select (list port) '() (list port) timeout)
@@ -174,7 +179,18 @@ QEMU monitor and to the guest's backdoor REPL."
    (($ <marionette> command pid monitor (= force repl))
     (write exp repl)
     (newline repl)
-     (read repl))))
+     (with-exception-handler
+         (lambda (exn)
+           (simple-format
+            (current-error-port)
+            "error reading marionette response: ~A
+  remaining response: ~A\n"
+            exn
+            (get-line repl))
+           (raise-exception exn))
+       (lambda ()
+         (read repl))
+       #:unwind? #t))))

 (define* (wait-for-file file marionette
                        #:key (timeout 10) (read 'read))
@@ -183,7 +199,14 @@ FILE has not shown up after TIMEOUT seconds, raise an error."
  (match (marionette-eval
          `(let loop ((i ,timeout))
             (cond ((file-exists? ,file)
-                    (cons 'success (call-with-input-file ,file ,read)))
+                    (cons 'success
+                          (let ((content
+                                 (call-with-input-file ,file ,read)))
+                            (if (eof-object? content)
+                                ;; #<eof> can't be read, so convert to the
+                                ;; empty string
+                                ""
+                                content))))
                   ((> i 0)
                    (sleep 1)
                    (loop (- i 1)))
@@ -255,8 +278,8 @@ accept connections in MARIONETTE.  Raise an error on failure."

 (define (marionette-control command marionette)
  "Run COMMAND in the QEMU monitor of MARIONETTE.  COMMAND is a string such as
-\"sendkey ctrl-alt-f1\" or \"screendump foo.ppm\" (info \"(qemu-doc)
-pcsys_monitor\")."
+\"sendkey ctrl-alt-f1\" or \"screendump foo.ppm\" (info \"(QEMU) QEMU
+Monitor\")."
  (match marionette
    (($ <marionette> _ _ monitor)
     (display command monitor)
@@ -264,54 +287,87 @@ pcsys_monitor\")."
     ;; The "quit" command terminates QEMU immediately, with no output.
     (unless (string=? command "quit") (wait-for-monitor-prompt monitor)))))

-(define* (marionette-screen-text marionette
-                                 #:key
-                                 (ocrad "ocrad"))
-  "Take a screenshot of MARIONETTE, perform optical character
-recognition (OCR), and return the text read from the screen as a string.  Do
-this by invoking OCRAD (file name for GNU Ocrad's command)"
-  (define (random-file-name)
-    (string-append "/tmp/marionette-screenshot-"
-                   (number->string (random (expt 2 32)) 16)
-                   ".ppm"))
+(define* (invoke-ocrad-ocr image #:key (ocrad "ocrad"))
+  "Invoke the OCRAD command on image, and return the recognized text."
+  (let* ((pipe (open-pipe* OPEN_READ ocrad "-i" "-s" "10" image))
+         (text (get-string-all pipe)))
+    (unless (zero? (close-pipe pipe))
+      (error "'ocrad' failed" ocrad))
+    text))

-  (let ((image (random-file-name)))
+(define* (invoke-tesseract-ocr image #:key (tesseract "tesseract"))
+  "Invoke the TESSERACT command on IMAGE, and return the recognized text."
+  (let* ((output-basename (tmpnam))
+         (output-basename* (string-append output-basename ".txt")))
    (dynamic-wind
      (const #t)
      (lambda ()
-        (marionette-control (string-append "screendump " image)
-                            marionette)
-
-        ;; Tell Ocrad to invert the image colors (make it black on white) and
-        ;; to scale the image up, which significantly improves the quality of
-        ;; the result.  In spite of this, be aware that OCR confuses "y" and
-        ;; "V" and sometimes erroneously introduces white space.
-        (let* ((pipe (open-pipe* OPEN_READ ocrad
-                                 "-i" "-s" "10" image))
-               (text (get-string-all pipe)))
-          (unless (zero? (close-pipe pipe))
-            (error "'ocrad' failed" ocrad))
-          text))
+        (let ((exit-val (status:exit-val
+                         (system* tesseract image output-basename))))
+          (unless (zero? exit-val)
+            (error "'tesseract' failed" tesseract))
+          (call-with-input-file output-basename* get-string-all)))
      (lambda ()
-        (false-if-exception (delete-file image))))))
+        (false-if-exception (delete-file output-basename))
+        (false-if-exception (delete-file output-basename*))))))
+
+(define* (marionette-screen-text marionette #:key (ocr "ocrad"))
+  "Take a screenshot of MARIONETTE, perform optical character
+recognition (OCR), and return the text read from the screen as a string, along
+the screen dump image used.  Do this by invoking OCR, which should be the file
+name of GNU Ocrad's@command{ocrad} or Tesseract OCR's @command{tesseract}
+command.  The screen dump image returned as the second value should be deleted
+if it is not needed."
+  (define image (string-append (tmpnam) ".ppm"))
+  ;; Use the QEMU Monitor to save an image of the screen to the host.
+  (marionette-control (string-append "screendump " image) marionette)
+  ;; Process it via the OCR.
+  (cond
+   ((string-contains ocr "ocrad")
+    (values (invoke-ocrad-ocr image #:ocrad ocr) image))
+   ((string-contains ocr "tesseract")
+    (values (invoke-tesseract-ocr image #:tesseract ocr) image))
+   (else (error "unsupported ocr command"))))

 (define* (wait-for-screen-text marionette predicate
-                               #:key (timeout 30) (ocrad "ocrad"))
+                               #:key
+                               (ocr "ocrad")
+                               (timeout 30)
+                               pre-action
+                               post-action)
  "Wait for TIMEOUT seconds or until the screen text on MARIONETTE matches
-PREDICATE, whichever comes first.  Raise an error when TIMEOUT is exceeded."
+PREDICATE, whichever comes first.  Raise an error when TIMEOUT is exceeded.
+The error contains the recognized text along the preserved file name of the
+screen dump, which is relative to the current working directory.  If
+PRE-ACTION is provided, it should be a thunk to call before each OCR attempt.
+Likewise for POST-ACTION, except it runs at the end of a successful OCR."
  (define start
    (car (gettimeofday)))

  (define end
    (+ start timeout))

-  (let loop ()
+  (let loop ((last-text #f)
+             (last-screendump #f))
    (if (> (car (gettimeofday)) end)
-        (error "'wait-for-screen-text' timeout" predicate)
-        (or (predicate (marionette-screen-text marionette #:ocrad ocrad))
-            (begin
-              (sleep 1)
-              (loop))))))
+        (let ((screendump-backup (string-drop last-screendump 5)))
+          ;; Move the file from /tmp/fileXXXXXX.pmm to the current working
+          ;; directory, so that it is preserved in the test derivation output.
+          (copy-file last-screendump screendump-backup)
+          (delete-file last-screendump)
+          (error "'wait-for-screen-text' timeout"
+                 'ocr-text: last-text
+                 'screendump: screendump-backup))
+        (let* ((_ (and (procedure? pre-action) (pre-action)))
+               (text screendump (marionette-screen-text marionette #:ocr ocr))
+               (_ (and (procedure? post-action) (post-action)))
+               (result (predicate text)))
+          (cond (result
+                 (delete-file screendump)
+                 result)
+                (else
+                 (sleep 1)
+                 (loop text screendump)))))))

 (define %qwerty-us-keystrokes
  ;; Maps "special" characters to their keystrokes.
@@ -333,8 +389,10 @@ PREDICATE, whichever comes first.  Raise an error when TIMEOUT is exceeded."
    (#\> . "shift-dot")
    (#\. . "dot")
    (#\, . "comma")
+    (#\: . "shift-semicolon")
    (#\; . "semicolon")
    (#\' . "apostrophe")
+    (#\! . "shift-1")
    (#\" . "shift-apostrophe")
    (#\` . "grave_accent")
    (#\bs . "backspace")
@@ -119,7 +119,7 @@ wait for at most HANDSHAKE-TIMEOUT seconds for handshake to complete.  Return
                files)))

  (log "sending secrets to ~a~%" port)
-  (let ((sock (socket AF_INET SOCK_STREAM 0))
+  (let ((sock (socket AF_INET (logior SOCK_CLOEXEC SOCK_STREAM) 0))
        (addr (make-socket-address AF_INET INADDR_LOOPBACK port))
        (sleep (if (resolve-module '(fibers) #f)
                   (module-ref (resolve-interface '(fibers)) 'sleep)
@@ -177,7 +177,7 @@ and #f otherwise."
    ;; Wait for a TCP connection on PORT.  Note: We cannot use the
    ;; virtio-serial ports, which would be safer, because they are
    ;; (presumably) unsupported on GNU/Hurd.
-    (let ((sock (socket AF_INET SOCK_STREAM 0)))
+    (let ((sock (socket AF_INET (logior SOCK_CLOEXEC SOCK_STREAM) 0)))
      (bind sock AF_INET INADDR_ANY port)
      (listen sock 1)
      (log "waiting for secrets on port ~a...~%" port)
@@ -2,6 +2,7 @@
 ;;; Copyright © 2017, 2018, 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020 Mathieu Othacehe <othacehe@gnu.org>
 ;;; Copyright © 2022 Leo Nikkilä <hello@lnikki.la>
+;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -186,7 +187,7 @@ namespace, in addition to essential bind-mounts such /proc."
    (when log-file
      ;; Create LOG-FILE so we can map it in the container.
      (unless (file-exists? log-file)
-        (call-with-output-file log-file (const #t))
+        (close (open log-file (logior O_CREAT O_APPEND O_CLOEXEC) #o640))
        (when user
          (let ((pw (getpwnam user)))
            (chown log-file (passwd:uid pw) (passwd:gid pw))))))
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012-2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017, 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2018, 2019 Clément Lassieur <clement@lassieur.org>
 ;;; Copyright © 2020 Julien Lepiller <julien@lepiller.eu>
@@ -21,18 +21,16 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

 (define-module (gnu ci)
-  #:use-module (guix channels)
+  #:use-module (guix build-system channel)
  #:use-module (guix config)
-  #:use-module (guix describe)
+  #:autoload   (guix describe) (package-channels)
  #:use-module (guix store)
-  #:use-module (guix grafts)
  #:use-module (guix profiles)
  #:use-module (guix packages)
  #:autoload   (guix transformations) (tunable-package? tuned-package)
  #:use-module (guix channels)
  #:use-module (guix config)
  #:use-module (guix derivations)
-  #:use-module (guix build-system)
  #:use-module (guix monads)
  #:use-module (guix gexp)
  #:use-module (guix ui)
@@ -41,9 +39,10 @@
  #:use-module ((guix utils) #:select (%current-system))
  #:use-module ((guix scripts system) #:select (read-operating-system))
  #:use-module ((guix scripts pack)
-                #:select (lookup-compressor self-contained-tarball))
+                #:select (self-contained-tarball))
  #:use-module (gnu bootloader)
  #:use-module (gnu bootloader u-boot)
+  #:use-module (gnu compression)
  #:use-module (gnu image)
  #:use-module (gnu packages)
  #:use-module (gnu packages gcc)
@@ -72,7 +71,6 @@
            image->job

            %core-packages
-            channel-source->package

            arguments->systems
            cuirass-jobs))
@@ -253,77 +251,44 @@ otherwise use the IMAGE name."
         (drv (run-with-store store
                (mbegin %store-monad
                  (set-guile-for-build (default-guile))
-                  (lower-object (system-image image))))))
+                  (lower-object (system-image image) system)))))
    (parameterize ((%graft? #f))
      (derivation->job name drv))))

-(define (image-jobs store system)
+(define* (image-jobs store system
+                     #:key source commit)
  "Return a list of jobs that build images for SYSTEM."
  (define MiB
    (expt 2 20))

-  (if (member system %guix-system-supported-systems)
-      `(,(image->job store
-                     (image
-                      (inherit efi-disk-image)
-                      (operating-system installation-os))
-                     #:name "usb-image"
-                     #:system system)
-        ,(image->job
-          store
-          (image
-           (inherit (image-with-label
-                     iso9660-image
-                     (string-append "GUIX_" system "_"
-                                    (if (> (string-length %guix-version) 7)
-                                        (substring %guix-version 0 7)
-                                        %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 (cut image->job store <>
-                        #:system system)
-                   %guix-system-images)
-              '()))
-      '()))
-
-(define channel-build-system
-  ;; Build system used to "convert" a channel instance to a package.
-  (let* ((build (lambda* (name inputs
-                               #:key source commit system
-                               #:allow-other-keys)
-                  (mlet* %store-monad ((source (if (string? source)
-                                                   (return source)
-                                                   (lower-object source)))
-                                       (instance
-                                        -> (checkout->channel-instance
-                                            source #:commit commit)))
-                    (channel-instances->derivation (list instance)))))
-         (lower (lambda* (name #:key system source commit
-                               #:allow-other-keys)
-                  (bag
-                    (name name)
-                    (system system)
-                    (build build)
-                    (arguments `(#:source ,source
-                                 #:commit ,commit))))))
-    (build-system (name 'channel)
-                  (description "Turn a channel instance into a package.")
-                  (lower lower))))
-
-(define* (channel-source->package source #:key commit)
-  "Return a package for the given channel SOURCE, a lowerable object."
-  (package
-    (inherit guix)
-    (version (string-append (package-version guix) "+"))
-    (build-system channel-build-system)
-    (arguments `(#:source ,source
-                 #:commit ,commit))
-    (inputs '())
-    (native-inputs '())
-    (propagated-inputs '())))
+  (parameterize ((current-guix-package
+                  (channel-source->package source #:commit commit)))
+    (if (member system %guix-system-supported-systems)
+        `(,(image->job store
+                       (image
+                        (inherit efi-disk-image)
+                        (operating-system installation-os))
+                       #:name "usb-image"
+                       #:system system)
+          ,(image->job
+            store
+            (image
+             (inherit (image-with-label
+                       iso9660-image
+                       (string-append "GUIX_" system "_"
+                                      (if (> (string-length %guix-version) 7)
+                                          (substring %guix-version 0 7)
+                                          %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 (cut image->job store <>
+                          #:system system)
+                     %guix-system-images)
+                '()))
+        '())))

 (define* (system-test-jobs store system
                           #:key source commit)
@@ -566,7 +531,9 @@ names."
                               hello system))))
         ('images
          ;; Build Guix System images only.
-          (image-jobs store system))
+          (image-jobs store system
+                      #:source source
+                      #:commit commit))
         ('system-tests
          ;; Build Guix System tests only.
          (system-test-jobs store system
@@ -0,0 +1,69 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 Mathieu Othacehe <othacehe@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/>.
+
+(define-module (gnu compression)
+  #:use-module (guix gexp)
+  #:use-module (guix ui)
+  #:use-module ((gnu packages compression) #:hide (zip))
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (ice-9 match)
+  #:export (compressor
+            compressor?
+            compressor-name
+            compressor-extension
+            compressor-command
+            %compressors
+            lookup-compressor))
+
+;; Type of a compression tool.
+(define-record-type <compressor>
+  (compressor name extension command)
+  compressor?
+  (name       compressor-name)      ;string (e.g., "gzip")
+  (extension  compressor-extension) ;string (e.g., ".lz")
+  (command    compressor-command))  ;gexp (e.g., #~(list "/gnu/store/…/gzip"
+                                    ;                    "-9n" ))
+
+(define %compressors
+  ;; Available compression tools.
+  (list (compressor "gzip"  ".gz"
+                    #~(list #+(file-append gzip "/bin/gzip") "-9n"))
+        (compressor "lzip"  ".lz"
+                    #~(list #+(file-append lzip "/bin/lzip") "-9"))
+        (compressor "xz"    ".xz"
+                    #~(append (list #+(file-append xz "/bin/xz")
+                                    "-e")
+                              (%xz-parallel-args)))
+        (compressor "bzip2" ".bz2"
+                    #~(list #+(file-append bzip2 "/bin/bzip2") "-9"))
+        (compressor "zstd" ".zst"
+                    ;; The default level 3 compresses better than gzip in a
+                    ;; fraction of the time, while the highest level 19
+                    ;; (de)compresses more slowly and worse than xz.
+                    #~(list #+(file-append zstd "/bin/zstd") "-3"))
+        (compressor "none" "" #f)))
+
+(define (lookup-compressor name)
+  "Return the compressor object called NAME.  Error out if it could not be
+found."
+  (or (find (match-lambda
+              (($ <compressor> name*)
+               (string=? name* name)))
+            %compressors)
+      (leave (G_ "~a: compressor not found~%") name)))
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
+;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -27,7 +28,8 @@
  #:use-module (guix diagnostics)
  #:use-module (guix gexp)
  #:use-module (guix store)
-
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
  #:export (home-environment
            home-environment?
            this-home-environment
@@ -38,7 +40,9 @@
            home-environment-services
            home-environment-location

-            home-environment-with-provenance))
+            home-environment-with-provenance
+
+            home-generation-base))

 ;;; Comment:
 ;;;
@@ -92,7 +96,7 @@
           (home-environment-essential-services he))))

 (define* (home-environment-derivation he)
-  "Return a derivation that builds OS."
+  "Return a derivation that builds home environment."
  (let* ((services         (home-environment-services he))
         (home (fold-services services
                              #:target-type home-service-type)))
@@ -114,3 +118,21 @@ of HOME-PROVENANCE-SERVICE-TYPE to its services."
      (run-with-store store (home-environment-derivation he)
                      #:system system
                      #:target target)))))
+
+(define %profile-generation-rx
+  ;; Regexp that matches profile generation.
+  (make-regexp "(.*)-([0-9]+)-link$"))
+
+(define (home-generation-base file)
+  "If FILE is a Home generation GC root such as \"guix-home-42-link\",
+return its corresponding base---e.g., \"guix-home\".  Otherwise return #f.
+
+This is similar to the 'generation-profile' procedure but applied to Home
+generations."
+  (match (regexp-exec %profile-generation-rx file)
+    (#f #f)
+    (m  (let ((profile (match:substring m 1)))
+          ;; Distinguish from a "real" profile and from a system generation.
+          (and (file-exists? (string-append profile "/on-first-login"))
+               (file-exists? (string-append profile "/profile/manifest"))
+               profile)))))
@@ -20,6 +20,7 @@
 (define-module (gnu home services)
  #:use-module (gnu services)
  #:use-module ((gnu packages package-management) #:select (guix))
+  #:use-module ((gnu packages base) #:select (coreutils))
  #:use-module (guix channels)
  #:use-module (guix monads)
  #:use-module (guix store)
@@ -46,6 +47,7 @@
            home-run-on-change-service-type
            home-provenance-service-type

+            environment-variable-shell-definitions
            home-files-directory
            xdg-configuration-files-directory
            xdg-data-files-directory
@@ -169,6 +171,34 @@ packages, configuration files, activation script, and so on.")))
 configuration files that the user has declared in their
@code{home-environment} record.")))

+(define (environment-variable-shell-definitions variables)
+  "Return a gexp that evaluates to a list of POSIX shell statements defining
+VARIABLES, a list of environment variable name/value pairs.  The returned code
+ensures variable values are properly quoted."
+  #~(let ((shell-quote
+           (lambda (value)
+             ;; Double-quote VALUE, leaving dollar sign as is.
+             (let ((quoted (list->string
+                            (string-fold-right
+                             (lambda (chr lst)
+                               (case chr
+                                 ((#\" #\\)
+                                  (append (list chr #\\) lst))
+                                 (else (cons chr lst))))
+                             '()
+                             value))))
+               (string-append "\"" quoted "\"")))))
+      (string-append
+       #$@(map (match-lambda
+                 ((key . #f)
+                  "")
+                 ((key . #t)
+                  #~(string-append "export " #$key "\n"))
+                 ((key . value)
+                  #~(string-append "export " #$key "="
+                                   (shell-quote #$value) "\n")))
+               variables))))
+
 (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
@@ -181,7 +211,7 @@ 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)
+  (define (warn-about-duplicate-definitions)
    (fold
     (lambda (x acc)
       (when (equal? (car x) (car acc))
@@ -192,15 +222,18 @@ exported."
     (sort vars (lambda (a b)
                  (string<? (car a) (car b))))))

-  (warn-about-duplicate-defenitions)
+  (warn-about-duplicate-definitions)
  (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"
-               "\
+       ,(computed-file "setup-environment"
+                       #~(call-with-output-file #$output
+                           (lambda (port)
+                             (set-port-encoding! port "UTF-8")
+                             (display "\
 HOME_ENVIRONMENT=$HOME/.guix-home
 GUIX_PROFILE=\"$HOME_ENVIRONMENT/profile\"
 PROFILE_FILE=\"$HOME_ENVIRONMENT/profile/etc/profile\"
@@ -227,17 +260,10 @@ case $XCURSOR_PATH in
  *) 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)))))))
+" port)
+                             (display
+                              #$(environment-variable-shell-definitions vars)
+                              port)))))))))

 (define home-environment-variables-service-type
  (service-type (name 'home-environment-variables)
@@ -342,9 +368,11 @@ activation.")))
 (define (compute-on-first-login-script _ gexps)
  (program-file
   "on-first-login"
-   (with-imported-modules (source-module-closure '((guix i18n)))
+   (with-imported-modules (source-module-closure '((guix i18n)
+                                                   (guix diagnostics)))
     #~(begin
-       (use-modules (guix i18n))
+         (use-modules (guix i18n)
+                      (guix diagnostics))
       #$%initialize-gettext

       (let* ((xdg-runtime-dir (or (getenv "XDG_RUNTIME_DIR")
@@ -361,7 +389,7 @@ activation.")))
               (begin #$@gexps (touch flag-file-path)))
             ;; TRANSLATORS: 'on-first-login' is the name of a service and
             ;; shouldn't be translated
-             (display (G_ "XDG_RUNTIME_DIR doesn't exists, on-first-login script
+             (warning (G_ "XDG_RUNTIME_DIR doesn't exists, on-first-login script
 won't execute anything.  You can check if xdg runtime directory exists,
 XDG_RUNTIME_DIR variable is set to appropriate value and manually execute the
 script by running '$HOME/.guix-home/on-first-login'"))))))))
@@ -392,8 +420,9 @@ extended with one gexp.")))
            (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)))))
+                          ;; Absolute path of the directory of the activation
+                          ;; file if called interactively.
+                          (canonicalize-path (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))
@@ -401,8 +430,9 @@ extended with one gexp.")))
                              #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))))
+                           (format #f "source ~a && ~a -0"
+                                   (he-init-file new-home)
+                                   #$(file-append coreutils "/bin/env"))))
                  (result ((@ (ice-9 rdelim) read-delimited) "" port))
                  (vars (map (lambda (x)
                               (let ((si (string-index x #\=)))
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2022 ( <paren@disroot.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -20,6 +21,7 @@
  #:use-module (gnu home services)
  #:use-module (gnu home services shepherd)
  #:use-module (gnu services configuration)
+  #:autoload   (gnu packages glib)    (dbus)
  #:autoload   (gnu packages xdisorg) (redshift)
  #:use-module (guix records)
  #:use-module (guix gexp)
@@ -27,8 +29,10 @@
  #:use-module (ice-9 match)
  #:export (home-redshift-configuration
            home-redshift-configuration?
+            home-redshift-service-type

-            home-redshift-service-type))
+            home-dbus-configuration
+            home-dbus-service-type))


 ;;;
@@ -161,7 +165,8 @@ format."))
         (start #~(make-forkexec-constructor
                   (list #$(file-append redshift "/bin/redshift")
                         "-c" #$config-file)))
-         (stop #~(make-kill-destructor)))))
+         (stop #~(make-kill-destructor))
+         (actions (list (shepherd-configuration-action config-file))))))

 (define home-redshift-service-type
  (service-type
@@ -172,3 +177,52 @@ format."))
   (description
    "Run Redshift, a program that adjusts the color temperature of display
 according to time of day.")))
+
+
+;;;
+;;; D-Bus.
+;;;
+
+(define-record-type* <home-dbus-configuration>
+  home-dbus-configuration make-home-dbus-configuration
+  home-dbus-configuration?
+  (dbus home-dbus-dbus                  ;file-like
+        (default dbus)))
+
+(define (home-dbus-shepherd-services config)
+  (list (shepherd-service
+         (documentation "Run the D-Bus daemon in session-specific mode.")
+         (provision '(dbus))
+         (start #~(make-forkexec-constructor
+                   (list #$(file-append (home-dbus-dbus config)
+                                        "/bin/dbus-daemon")
+                         "--nofork" "--session"
+                         (format #f "--address=unix:path=~a/bus"
+                                 (or (getenv "XDG_RUNTIME_DIR")
+                                     (format #f "/run/user/~a"
+                                             (getuid)))))
+                   #:environment-variables
+                   (cons "DBUS_VERBOSE=1"
+                         (default-environment-variables))
+                   #:log-file
+                   (format #f "~a/dbus.log"
+                           (or (getenv "XDG_LOG_HOME")
+                               (format #f "~a/.local/var/log"
+                                       (getenv "HOME"))))))
+         (stop #~(make-kill-destructor)))))
+
+(define (home-dbus-environment-variables config)
+  '(("DBUS_SESSION_BUS_ADDRESS"
+     . "unix:path=${XDG_RUNTIME_DIR:-/run/user/$UID}/bus")))
+
+(define home-dbus-service-type
+  (service-type
+   (name 'home-dbus)
+   (extensions
+    (list (service-extension home-shepherd-service-type
+                             home-dbus-shepherd-services)
+          (service-extension home-environment-variables-service-type
+                             home-dbus-environment-variables)))
+   (default-value (home-dbus-configuration))
+   (description
+    "Run the session-specific D-Bus inter-process message bus.")))
@@ -0,0 +1,44 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 Reily Siegel <mail@reilysiegel.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/>.
+
+(define-module (gnu home services guix)
+  #:use-module (gnu home services)
+  #:use-module (guix channels)
+  #:use-module (guix gexp)
+  #:use-module (ice-9 pretty-print)
+  #:use-module (srfi srfi-1)
+  #:export (home-channels-service-type))
+
+(define (channels-xdg-files channels)
+  `(("guix/channels.scm"
+     ,(plain-file
+       "channels.scm"
+       (call-with-output-string
+         (lambda (port)
+           (pretty-print (cons 'list (map channel->code channels)) port)))))))
+
+(define home-channels-service-type
+  (service-type
+   (name 'home-channels)
+   (default-value %default-channels)
+   (compose concatenate)
+   (extend append)
+   (extensions
+    (list (service-extension home-xdg-configuration-files-service-type
+                             channels-xdg-files)))
+   (description "Manages the per-user Guix channels specification.")))
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -20,6 +21,7 @@
 (define-module (gnu home services mcron)
  #:use-module (gnu packages guile-xyz)
  #:use-module (gnu home services)
+  #:use-module (gnu services configuration)
  #:use-module (gnu services shepherd)
  #:use-module (gnu home services shepherd)
  #:use-module (guix records)
@@ -53,45 +55,59 @@
 ;;
 ;;; 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 list-of-gexps?
+  (list-of gexp?))
+
+(define-configuration/no-serialization home-mcron-configuration
+  (mcron (file-like mcron) "The mcron package to use.")
+  (jobs
+   (list-of-gexps '())
+   "This is a list of gexps (@pxref{G-Expressions}), where each gexp
+corresponds to an mcron job specification (@pxref{Syntax, mcron job
+specifications,, mcron, GNU@tie{}mcron}).")
+  (log? (boolean #t) "Log messages to standard output.")
+  (log-format
+   (string "~1@*~a ~a: ~a~%")
+   "@code{(ice-9 format)} format string for log messages.  The default value
+produces messages like \"@samp{@var{pid} @var{name}:
+@var{message}\"} (@pxref{Invoking mcron, Invoking,, mcron, GNU@tie{}mcron}).
+Each message is also prefixed by a timestamp by GNU Shepherd."))

 (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-shepherd-services config)
+  (match-record config <home-mcron-configuration>
+    (mcron jobs log? log-format)
+    (if (null? jobs)
+        '()                                       ;no jobs to run
+        (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 (string-append #$mcron "/bin/mcron")
+                                 #$@(if log?
+                                        #~("--log" "--log-format" #$log-format)
+                                        #~())
+                                 #$@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-profile (compose list home-mcron-configuration-mcron))

 (define (home-mcron-extend config jobs)
  (home-mcron-configuration
@@ -113,3 +129,12 @@
                (default-value (home-mcron-configuration))
                (description
                 "Install and configure the GNU mcron cron job manager.")))
+
+
+;;;
+;;; Generate documentation.
+;;;
+(define (generate-doc)
+  (configuration->documentation 'home-mcron-configuration))
+
+;;; mcron.scm ends here
@@ -0,0 +1,145 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 ( <paren@disroot.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/>.
+
+(define-module (gnu home services pm)
+  #:use-module (guix gexp)
+  #:use-module (guix packages)
+  #:use-module (guix records)
+  #:use-module (gnu home services)
+  #:use-module (gnu home services shepherd)
+  #:use-module (gnu packages monitoring)
+  #:use-module (gnu services shepherd)
+
+  #:export (home-batsignal-configuration
+            home-batsignal-service-type))
+
+;;;
+;;; batsignal
+;;;
+;;; Daemon for running commands and displaying notifications on
+;;; battery events.
+;;;
+
+(define-record-type* <home-batsignal-configuration>
+  home-batsignal-configuration make-home-batsignal-configuration
+  home-batsignal-configuration?
+  (warning-level batsignal-warning-level                    ;integer
+                 (default 15))
+  (warning-message batsignal-warning-message                ;string | #f
+                   (default #f))
+  (critical-level batsignal-critical-level                  ;integer
+                 (default 5))
+  (critical-message batsignal-critical-message              ;string | #f
+                    (default #f))
+  (danger-level batsignal-danger-level                      ;integer
+                (default 2))
+  (danger-command batsignal-danger-command                  ;file-like | string | #f
+                  (default #f))
+  (full-level batsignal-full-level                          ;integer | #f
+              (default #f))
+  (full-message batsignal-full-message                      ;string | #f
+                (default #f))
+  (batteries batsignal-batteries                            ;list of string
+             (default '()))
+  (poll-delay batsignal-poll-delay                          ;integer
+              (default 60))
+  (icon batsignal-icon                                      ;file-like | #f
+        (default #f))
+  (notifications? batsignal-notifications?                  ;boolean
+                  (default #t))
+  (notifications-expire? batsignal-notifications-expire?    ;boolean
+                         (default #f))
+  (notification-command batsignal-notification-command      ;string | #f
+                        (default #f))
+  (ignore-missing? batsignal-ignore-missing?                ;boolean
+                   (default #f)))
+
+(define (home-batsignal-shepherd-services config)
+  (let ((warning-level (batsignal-warning-level config))
+        (warning-message (batsignal-warning-message config))
+        (critical-level (batsignal-critical-level config))
+        (critical-message (batsignal-critical-message config))
+        (danger-level (batsignal-danger-level config))
+        (danger-command (batsignal-danger-command config))
+        (full-level (batsignal-full-level config))
+        (full-message (batsignal-full-message config))
+        (batteries (batsignal-batteries config))
+        (poll-delay (batsignal-poll-delay config))
+        (icon (batsignal-icon config))
+        (notifications? (batsignal-notifications? config))
+        (notifications-expire? (batsignal-notifications-expire? config))
+        (notification-command (batsignal-notification-command config))
+        (ignore-missing? (batsignal-ignore-missing? config)))
+    (list (shepherd-service
+           (provision '(batsignal))
+           (documentation "Run the batsignal battery-watching daemon.")
+           (start #~(make-forkexec-constructor
+                     (append (list #$(file-append batsignal "/bin/batsignal")
+                                   "-w" (number->string #$warning-level)
+                                   "-c" (number->string #$critical-level)
+                                   "-d" (number->string #$danger-level)
+                                   "-m" (number->string #$poll-delay))
+                             (if #$warning-message
+                                 (list "-W" #$warning-message)
+                                 (list))
+                             (if #$critical-message
+                                 (list "-C" #$critical-message)
+                                 (list))
+                             (if #$danger-command
+                                 (list "-D" #$danger-command)
+                                 (list))
+                             (if #$full-level
+                                 (list "-f" (number->string #$full-level))
+                                 (list))
+                             (if #$full-message
+                                 (list "-F" #$full-message)
+                                 (list))
+                             (if (null? (list #$@batteries))
+                                 (list)
+                                 (list "-n" (string-join (list #$@batteries) ",")))
+                             (if #$icon
+                                 (list "-I" #$icon)
+                                 (list))
+                             (if #$notifications?
+                                 (list)
+                                 (list "-N"))
+                             (if #$notifications-expire?
+                                 (list "-e")
+                                 (list))
+                             (if #$notification-command
+                                 (list "-M" #$notification-command)
+                                 (list))
+                             (if #$ignore-missing?
+                                 (list "-i")
+                                 (list)))
+                     #:log-file (string-append
+                                 (or (getenv "XDG_LOG_HOME")
+                                     (format #f "~a/.local/var/log"
+                                               (getenv "HOME")))
+                                 "/batsignal.log")))
+           (stop #~(make-kill-destructor))))))
+
+(define home-batsignal-service-type
+  (service-type
+   (name 'home-batsignal)
+   (extensions
+    (list (service-extension home-shepherd-service-type
+                             home-batsignal-shepherd-services)))
+   (default-value (home-batsignal-configuration))
+   (description
+    "Run batsignal, a battery watching and notification daemon.")))
@@ -25,6 +25,7 @@
  #:use-module (gnu packages bash)
  #:use-module (guix gexp)
  #:use-module (guix packages)
+  #:use-module (guix records)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module (ice-9 match)
@@ -111,16 +112,7 @@ service type can be extended with a list of file-like objects.")))

 (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)))
+  (environment-variable-shell-definitions val))


 ;;;
@@ -192,9 +184,9 @@ another process for example)."))
  (mixed-text-file
   "zprofile"
   "\
-# Setups system and user profiles and related variables
+# Set up the system, user profile, and related variables.
 source /etc/profile
-# Setups home environment profile
+# Set up the home environment profile.
 source ~/.profile

 # It's only necessary if zsh is a login shell, otherwise profiles will
@@ -443,9 +435,9 @@ alias grep='grep --color=auto'\n")
      ,(mixed-text-file
        "bash_profile"
        "\
-# Setups system and user profiles and related variables
+# Set up the system, user profile, and related variables.
 # /etc/profile will be sourced by bash automatically
-# Setups home environment profile
+# Set up the home environment profile.
 if [ -f ~/.profile ]; then source ~/.profile; fi

 # Honor per-interactive-shell startup file
@@ -488,31 +480,30 @@ with text blocks from other extensions and the base service.")
 with text blocks from other extensions and the base service."))

 (define (home-bash-extensions original-config extension-configs)
-  (match original-config
-    (($ <home-bash-configuration> _ _ _ environment-variables aliases
-                                  bash-profile bashrc bash-logout)
-     (home-bash-configuration
-      (inherit original-config)
-      (environment-variables
-       (append environment-variables
-               (append-map
-                home-bash-extension-environment-variables extension-configs)))
-      (aliases
-       (append aliases
-               (append-map
-                home-bash-extension-aliases extension-configs)))
-      (bash-profile
-       (append bash-profile
-               (append-map
-                home-bash-extension-bash-profile extension-configs)))
-      (bashrc
-       (append bashrc
-               (append-map
-                home-bash-extension-bashrc extension-configs)))
-      (bash-logout
-       (append bash-logout
-               (append-map
-                home-bash-extension-bash-logout extension-configs)))))))
+  (match-record original-config <home-bash-configuration>
+    (environment-variables aliases bash-profile bashrc bash-logout)
+    (home-bash-configuration
+     (inherit original-config)
+     (environment-variables
+      (append environment-variables
+              (append-map
+               home-bash-extension-environment-variables extension-configs)))
+     (aliases
+      (append aliases
+              (append-map
+               home-bash-extension-aliases extension-configs)))
+     (bash-profile
+      (append bash-profile
+              (append-map
+               home-bash-extension-bash-profile extension-configs)))
+     (bashrc
+      (append bashrc
+              (append-map
+               home-bash-extension-bashrc extension-configs)))
+     (bash-logout
+      (append bash-logout
+              (append-map
+               home-bash-extension-bash-logout extension-configs))))))

 (define home-bash-service-type
  (service-type (name 'home-bash)
@@ -45,7 +45,8 @@
               shepherd-service-auto-start?
               shepherd-service-modules

-               shepherd-action))
+               shepherd-action
+               shepherd-configuration-action))

 (define-record-type* <home-shepherd-configuration>
  home-shepherd-configuration make-home-shepherd-configuration
@@ -54,19 +55,22 @@
            (default shepherd-0.9)) ; package
  (auto-start? home-shepherd-configuration-auto-start?
               (default #t))
+  (daemonize? home-shepherd-configuration-daemonize?
+              (default #t))
  (services home-shepherd-configuration-services
            (default '())))

-(define (home-shepherd-configuration-file services shepherd)
+(define (home-shepherd-configuration-file config)
  "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))
-        )
+  (let* ((daemonize? (home-shepherd-configuration-daemonize? config))
+         (services (home-shepherd-configuration-services config))
+         (_ (assert-valid-graph services))
+         (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)
@@ -76,7 +80,11 @@ as shepherd package."
           (map
            (lambda (file) (load file))
            '#$files))
-          (action 'root 'daemonize)
+
+          #$@(if daemonize?
+                 `((action 'root 'daemonize))
+                 '())
+
          (format #t "Starting services...~%")
          (let ((services-to-start
                 '#$(append-map shepherd-service-provision
@@ -92,8 +100,7 @@ as shepherd package."
    (scheme-file "shepherd.conf" config)))

 (define (launch-shepherd-gexp config)
-  (let* ((shepherd (home-shepherd-configuration-shepherd config))
-         (services (home-shepherd-configuration-services config)))
+  (let* ((shepherd (home-shepherd-configuration-shepherd config)))
    (if (home-shepherd-configuration-auto-start? config)
        (with-imported-modules '((guix build utils))
          #~(unless (file-exists?
@@ -104,22 +111,22 @@ as shepherd package."
              (let ((log-dir (or (getenv "XDG_LOG_HOME")
                                 (format #f "~a/.local/var/log"
                                         (getenv "HOME")))))
+                ;; TODO: Remove it, 0.9.2 creates it automatically?
                ((@ (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)))))
+                 #$(home-shepherd-configuration-file config)))))
        #~"")))

 (define (reload-configuration-gexp config)
-  (let* ((shepherd (home-shepherd-configuration-shepherd config))
-         (services (home-shepherd-configuration-services config)))
+  (let* ((shepherd (home-shepherd-configuration-shepherd config)))
    #~(system*
       #$(file-append shepherd "/bin/herd")
       "load" "root"
-       #$(home-shepherd-configuration-file services shepherd))))
+       #$(home-shepherd-configuration-file config))))

 (define (ensure-shepherd-gexp config)
  #~(if (file-exists?
@@ -130,12 +137,18 @@ as shepherd package."
        #$(reload-configuration-gexp config)
        #$(launch-shepherd-gexp config)))

+(define (shepherd-xdg-configuration-files config)
+  `(("shepherd/init.scm" ,(home-shepherd-configuration-file 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-xdg-configuration-files-service-type
+                        shepherd-xdg-configuration-files)
                       (service-extension
                        home-activation-service-type
                        ensure-shepherd-gexp)
@@ -69,17 +69,19 @@
                 " " value "\n"))

 (define (address-family? obj)
-  (memv obj (list *unspecified* AF_INET AF_INET6)))
+  (memv obj (list AF_INET AF_INET6)))
+
+(define-maybe address-family)

 (define (serialize-address-family field family)
-  (if (unspecified? family)
-      ""
+  (if (maybe-value-set? family)
      (string-append "  " (serialize-field-name field) " "
                     (cond ((= family AF_INET) "inet")
                           ((= family AF_INET6) "inet6")
                           ;; The 'else' branch is unreachable.
                           (else (raise (condition (&error)))))
-                     "\n")))
+                     "\n")
+      ""))

 (define (natural-number? obj)
  (and (integer? obj) (exact? obj) (> obj 0)))
@@ -115,10 +117,10 @@
   maybe-string
   "Host name---e.g., @code{\"foo.example.org\"} or @code{\"192.168.1.2\"}.")
  (address-family
-   address-family
+   maybe-address-family
   "Address family to use when connecting to this host: one of
-@code{AF_INET} (for IPv4 only), @code{AF_INET6} (for IPv6 only), or
-@code{*unspecified*} (allowing any address family).")
+@code{AF_INET} (for IPv4 only), @code{AF_INET6} (for IPv6 only).
+Additionally, the field can be left unset to allow any address family.")
  (identity-file
   maybe-string
   "The identity file to use---e.g.,
@@ -23,6 +23,7 @@
  #:use-module (gnu packages freedesktop)
  #:use-module (gnu home services utils)
  #:use-module (guix gexp)
+  #:use-module (guix modules)
  #:use-module (guix records)
  #:use-module (guix i18n)
  #:use-module (guix diagnostics)
@@ -106,15 +107,21 @@ services more consistent."))

 (define (ensure-xdg-base-dirs-on-activation config)
  #~(map (lambda (xdg-base-dir-variable)
-           ((@@ (guix build utils) mkdir-p)
+           ((@ (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)))
+         '#$(filter-map
+             (lambda (field)
+               (let ((variable
+                      (string-append
+                       "XDG_"
+                       (object->snake-case-string
+                        (configuration-field-name field) 'upper))))
+                 ;; XDG_RUNTIME_DIR shouldn't be created during activation
+                 ;; and will be provided by elogind or other service.
+                 (and (not (string=? "XDG_RUNTIME_DIR" variable))
+                      variable)))
+             home-xdg-base-directories-configuration-fields)))

 (define (last-extension-or-cfg config extensions)
  "Picks configuration value from last provided extension.  If there
@@ -207,8 +214,8 @@ pre-populated content.")
                   home-xdg-user-directories-configuration-fields)))
    #~(let ((ensure-dir
             (lambda (path)
-               (mkdir-p
-                ((@@ (ice-9 string-fun) string-replace-substring)
+               ((@ (guix build utils) mkdir-p)
+                ((@ (ice-9 string-fun) string-replace-substring)
                 path "$HOME" (getenv "HOME"))))))
        (display "Creating XDG user directories...")
        (map ensure-dir '#$dirs)
@@ -376,25 +383,25 @@ configuration."
  (define (serialize-alist config)
    (generic-serialize-alist append 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)))))
+  (define (serialize-xdg-desktop-action desktop-action)
+    (match-record desktop-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))))))
+  (match-record 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
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2020, 2022 Mathieu Othacehe <othacehe@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,6 +21,7 @@
  #:use-module (guix records)
  #:use-module (guix diagnostics)
  #:use-module (guix i18n)
+  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-34)
  #:use-module (srfi srfi-35)
  #:export (partition
@@ -58,23 +59,78 @@
            os->image
            os+platform->image))

+
+;;;
+;;; Sanitizers.
+;;;
+
+;; Image and partition sizes can be either be a size in bytes or the 'guess
+;; symbol denoting that the size should be estimated by Guix, according to the
+;; image content.
+(define-with-syntax-properties (validate-size (value properties))
+  (unless (and value
+               (or (eq? value 'guess) (integer? value)))
+    (raise
+       (make-compound-condition
+        (condition
+         (&error-location
+          (location (source-properties->location properties))))
+        (formatted-message
+         (G_ "size (~a) can only be 'guess or a numeric expression ~%")
+         value 'field))))
+  value)
+

 ;;;
 ;;; Partition record.
 ;;;

+;; The partition offset should be a bytes count as an integer.
+(define-with-syntax-properties (validate-partition-offset (value properties))
+  (unless (and value (integer? value))
+    (raise
+       (make-compound-condition
+        (condition
+         (&error-location
+          (location (source-properties->location properties))))
+        (formatted-message
+         (G_ "the partition offset (~a) can only be a \
+numeric expression ~%") value 'field))))
+  value)
+
+;; The supported partition flags.
+(define-with-syntax-properties (validate-partition-flags (value properties))
+  (let ((bad-flags (lset-difference eq? value '(boot esp))))
+    (unless (and (list? value) (null? bad-flags))
+      (raise
+       (make-compound-condition
+        (condition
+         (&error-location
+          (location (source-properties->location properties))))
+        (formatted-message
+         (G_ "unsupported partition flag(s): ~a ~%") bad-flags)))))
+  value)
+
 (define-record-type* <partition> partition make-partition
  partition?
-  (device               partition-device (default #f))
-  (size                 partition-size)
-  (offset               partition-offset (default 0))
-  (file-system          partition-file-system (default "ext4"))
+  (size                 partition-size   ;size in bytes as integer or 'guess
+                        (default 'guess)
+                        (sanitize validate-size))
+  (offset               partition-offset
+                        (default 0)   ;offset in bytes as integer
+                        (sanitize validate-partition-offset))
+  (file-system          partition-file-system
+                        (default "ext4"))  ;string
  (file-system-options  partition-file-system-options
-                        (default '()))
-  (label                partition-label (default #f))
-  (uuid                 partition-uuid (default #f))
-  (flags                partition-flags (default '()))
-  (initializer          partition-initializer (default #f))) ;gexp | #f
+                        (default '()))  ;list of strings
+  (label                partition-label)  ;string
+  (uuid                 partition-uuid
+                        (default #false))  ;<uuid>
+  (flags                partition-flags
+                        (default '())  ;list of symbols
+                        (sanitize validate-partition-flags))
+  (initializer          partition-initializer
+                        (default #false))) ;gexp | #false


 ;;;
@@ -94,8 +150,11 @@ that is not in SET, mentioning FIELD in the error message."
        (formatted-message (G_ "~s: invalid '~a' value") value 'field))))
    value))

+;; The supported image formats.
 (define-set-sanitizer validate-image-format format
-  (disk-image compressed-qcow2 docker iso9660))
+  (disk-image compressed-qcow2 docker iso9660 tarball wsl2))
+
+;; The supported partition table types.
 (define-set-sanitizer validate-partition-table-type partition-table-type
  (mbr gpt))

@@ -103,36 +162,52 @@ that is not in SET, mentioning FIELD in the error message."
  image make-image
  image?
  (name               image-name ;symbol
-                      (default #f))
+                      (default #false))
  (format             image-format                ;symbol
                      (sanitize validate-image-format))
  (platform           image-platform ;<platform>
-                      (default #f))
+                      (default #false))
  (size               image-size  ;size in bytes as integer
-                      (default 'guess))
-  (operating-system   image-operating-system  ;<operating-system>
-                      (default #f))
+                      (default 'guess)
+                      (sanitize validate-size))
+  (operating-system   image-operating-system)  ;<operating-system>
  (partition-table-type image-partition-table-type ; 'mbr or 'gpt
                      (default 'mbr)
                      (sanitize validate-partition-table-type))
  (partitions         image-partitions ;list of <partition>
                      (default '()))
  (compression?       image-compression? ;boolean
-                      (default #t))
+                      (default #true))
  (volatile-root?     image-volatile-root? ;boolean
-                      (default #t))
+                      (default #true))
  (shared-store?      image-shared-store? ;boolean
-                      (default #f))
+                      (default #false))
  (shared-network?    image-shared-network? ;boolean
-                      (default #f))
+                      (default #false))
  (substitutable?     image-substitutable? ;boolean
-                      (default #t)))
+                      (default #true)))


 ;;;
 ;;; Image type.
 ;;;

+;; The role of this record is to provide a constructor that is able to turn an
+;; <operating-system> record into an <image> record.  Some basic <image-type>
+;; records are defined in the (gnu system image) module.  They are able to
+;; turn an <operating-system> record into an EFI or an ISO 9660 bootable
+;; image, a Docker image or even a QCOW2 image.
+;;
+;; Other <image-type> records are defined in the (gnu system images ...)
+;; modules.  They are dedicated to specific machines such as Novena and Pine64
+;; SoC boards that require specific images.
+;;
+;; All the available <image-type> records are collected by the 'image-modules'
+;; procedure.  This allows the "guix system image" command to turn a given
+;; <operating-system> record into an image, thanks to the specified
+;; <image-type>.  In that case, the <image-type> look up is done using the
+;; name field of the <image-type> record.
+
 (define-record-type* <image-type>
  image-type make-image-type
  image-type?
@@ -145,10 +220,15 @@ that is not in SET, mentioning FIELD in the error message."
 ;;;

 (define* (os->image os #:key type)
+  "Use the image constructor from TYPE, an <image-type> record to turn the
+given OS, an <operating-system> record into an image and return it."
  (let ((constructor (image-type-constructor type)))
    (constructor os)))

 (define* (os+platform->image os platform #:key type)
+  "Use the image constructor from TYPE, an <image-type> record to turn the
+given OS, an <operating-system> record into an image targeting PLATFORM, a
+<platform> record and return it."
  (image
   (inherit (os->image os #:type type))
   (platform platform)))
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
-;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>
 ;;;
@@ -27,6 +27,8 @@
  #:use-module (guix utils)
  #:use-module (guix ui)
  #:use-module ((guix self) #:select (make-config.scm))
+  #:use-module (guix describe)
+  #:use-module (guix channels)
  #:use-module (guix packages)
  #:use-module (guix git-download)
  #:use-module (gnu installer utils)
@@ -46,11 +48,13 @@
  #:use-module (gnu packages nano)
  #:use-module (gnu packages ncurses)
  #:use-module (gnu packages package-management)
+  #:use-module (gnu packages pciutils)
  #:use-module (gnu packages tls)
  #:use-module (gnu packages xorg)
  #:use-module (gnu system locale)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-1)
+  #:use-module (web uri)
  #:export (installer-program))

 (define module-to-import?
@@ -63,6 +67,7 @@
    (('gnu 'installer _ ...) #t)
    (('gnu 'build _ ...) #t)
    (('guix 'build _ ...) #t)
+    (('guix 'read-print) #t)
    (_ #f)))

 (define not-config?
@@ -225,7 +230,9 @@ selected keymap."
          (id 'welcome)
          (compute (lambda _
                     ((installer-welcome-page current-installer)
-                      #$(local-file "installer/aux-files/logo.txt")))))
+                      #$(local-file "installer/aux-files/logo.txt")
+                      #:pci-database
+                      #$(file-append pciutils "/share/hwdata/pci.ids.gz")))))

         ;; Ask the user to select a timezone under glibc format.
         (installer-step
@@ -311,6 +318,25 @@ selected keymap."
             ((installer-final-page current-installer)
              result prev-steps))))))))

+(define (provenance-sexp)
+  "Return an sexp representing the currently-used channels, for logging
+purposes."
+  (match (match (current-channels)
+           (() (and=> (repository->guix-channel (dirname (current-filename)))
+                      list))
+           (channels channels))
+    (#f
+     (warning (G_ "cannot determine installer provenance~%"))
+     'unknown)
+    ((channels ...)
+     (map (lambda (channel)
+            (let* ((uri (string->uri (channel-url channel)))
+                   (url (if (or (not uri) (eq? 'file (uri-scheme uri)))
+                            "local checkout"
+                            (channel-url channel))))
+             `(channel ,(channel-name channel) ,url ,(channel-commit channel))))
+          channels))))
+
 (define (installer-program)
  "Return a file-like object that runs the given INSTALLER."
  (define init-gettext
@@ -357,7 +383,9 @@ selected keymap."
    (with-extensions (list guile-gcrypt guile-newt
                           guile-parted guile-bytestructures
                           guile-json-3 guile-git guile-webutils
-                           guix gnutls)
+                           guile-gnutls
+                           guile-zlib           ;for (gnu build linux-modules)
+                           (current-guix))
      (with-imported-modules `(,@(source-module-closure
                                  `(,@modules
                                    (gnu services herd)
@@ -388,6 +416,12 @@ selected keymap."
                         (ice-9 match)
                         (ice-9 textual-ports))

+            ;; Enable core dump generation.
+            (setrlimit 'core #f #f)
+            (call-with-output-file "/proc/sys/kernel/core_pattern"
+              (lambda (port)
+                (format port %core-dump)))
+
            ;; Initialize gettext support so that installers can use
            ;; (guix i18n) module.
            #$init-gettext
@@ -417,6 +451,9 @@ selected keymap."
            (define current-installer newt-installer)
            (define steps (#$steps current-installer))

+            (installer-log-line "installer provenance: ~s"
+                                '#$(provenance-sexp))
+
            (dynamic-wind
              (installer-init current-installer)
              (lambda ()
@@ -446,11 +483,21 @@ selected keymap."
                                          key args)
                      (define dump-dir
                        (prepare-dump key args #:result %current-result))
+
+                      (define user-abort?
+                        (match args
+                          (((? user-abort-error? obj)) #t)
+                          (_ #f)))
+
                      (define action
-                        ((installer-exit-error current-installer)
-                         (get-string-all
-                          (open-input-file
-                           (string-append dump-dir "/installer-backtrace")))))
+                        (if user-abort?
+                            'dump
+                            ((installer-exit-error current-installer)
+                             (get-string-all
+                              (open-input-file
+                               (string-append dump-dir
+                                              "/installer-backtrace"))))))
+
                      (match action
                        ('dump
                         (let* ((dump-files
@@ -28,13 +28,17 @@
  #:use-module (web http)
  #:use-module (web response)
  #:use-module (webutils multipart)
-  #:export (prepare-dump
+  #:export (%core-dump
+            prepare-dump
            make-dump
            send-dump-report))

 ;; The installer crash dump type.
 (define %dump-type "installer-dump")

+;; The core dump file.
+(define %core-dump "/tmp/installer-core-dump")
+
 (define (result->list result)
  "Return the alist for the given RESULT."
  (hash-map->list (lambda (k v)
@@ -66,6 +70,10 @@ RESULT is the installer result hash table.  Returns the created directory path."
    ;; syslog
    (copy-file "/var/log/messages" "syslog")

+    ;; core dump
+    (when (file-exists? %core-dump)
+      (copy-file %core-dump "core-dump"))
+
    ;; dmesg
    (let ((pipe (open-pipe* OPEN_READ "dmesg")))
      (call-with-output-file "dmesg"
@@ -211,7 +211,7 @@ or #f.  Return #t on success and #f on failure."

             (setenv "PATH" "/run/current-system/profile/bin/")

-             (set! ret (run-command install-command)))
+             (set! ret (run-command install-command #:tty? #t)))
           (lambda ()
             ;; Restart guix-daemon so that it does no keep the MNT namespace
             ;; alive.
@@ -0,0 +1,90 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 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
+;;;
+;;; 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 installer hardware)
+  #:use-module (gnu build linux-modules)
+  #:use-module (guix i18n)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-71)
+  #:export (unsupported-pci-device?
+            pci-device-description))
+
+(define %unsupported-linux-modules
+  ;; List of Linux modules that are useless without non-free firmware.
+  ;;
+  ;; Currently only drivers for PCI devices are listed.  USB devices such as
+  ;; "btintel" would require support to list USB devices and read the USB
+  ;; device ID database.  Punt for now as this is usually less critical.
+  ;;
+  ;; This list is currently manually maintained based on information on
+  ;; non-free firmware available from
+  ;; <https://packages.debian.org/search?keywords=firmware&searchon=names&suite=stable&section=all>.
+  '(;; WiFi.
+    "brcmfmac"
+    "ipw2100"
+    "ipw2200"
+    "iwlwifi"
+    "mwl8k"
+    "rtl8188ee"
+    "rtl818x_pci"
+    "rtl8192ce"
+    "rtl8192de"
+    "rtl8192ee"
+
+    ;; Ethernet.
+    "bnx2"
+    "bnx2x"
+    "liquidio"
+
+    ;; Graphics.
+    "amdgpu"
+    "radeon"
+
+    ;; Multimedia.
+    "ivtv"))
+
+(define unsupported-pci-device?
+  ;; Arrange to load the module alias database only once.
+  (let ((aliases (delay (known-module-aliases))))
+    (lambda (device)
+      "Return true if DEVICE is known to not be supported by free software."
+      (any (lambda (module)
+             (member module %unsupported-linux-modules))
+           (matching-modules (pci-device-module-alias device)
+                             (force aliases))))))
+
+(define (pci-device-description pci-database)
+  "Return a procedure that, given a PCI device, returns a string describing
+it."
+  (define (with-fallback lookup)
+    (lambda (vendor-id id)
+      (let ((vendor name (lookup vendor-id id)))
+        (values (or vendor (number->string vendor-id 16))
+                (or name (number->string id 16))))))
+
+  (define pci-lookup
+    (with-fallback (load-pci-device-database pci-database)))
+
+  (lambda (device)
+    (let ((vendor name (pci-lookup (pci-device-vendor device)
+                                   (pci-device-id device))))
+      (if (network-pci-device? device)
+          ;; TRANSLATORS: The two placeholders are the manufacturer
+          ;; and name of a PCI device.
+          (format #f (G_ "~a ~a (networking device)")
+                  vendor name)
+          (string-append vendor " " name)))))
@@ -62,6 +62,9 @@
  (clear-screen))

 (define (exit-error error)
+  ;; Newt may be suspended in the context of the "install-system"
+  ;; procedure. Resume it unconditionnally.
+  (newt-resume)
  (newt-set-color COLORSET-ROOT "white" "red")
  (define action
    (run-textbox-page
@@ -113,11 +116,7 @@ report it by email to ~a.") uploaded-name %guix-bug-report-address)
  (define command-output "")
  (define (line-accumulator line)
    (set! command-output
-          (string-append/shared command-output line "\n")))
-  (define displayed-command
-    (string-join
-     (map (lambda (s) (string-append "\"" s "\"")) args)
-     " "))
+          (string-append/shared command-output line)))
  (define result (run-external-command-with-line-hooks (list line-accumulator)
                                                       args))
  (define exit-val (status:exit-val result))
@@ -173,8 +172,8 @@ report it by email to ~a.") uploaded-name %guix-bug-report-address)
 (define (timezone-page zonetab)
  (run-timezone-page zonetab))

-(define (welcome-page logo)
-  (run-welcome-page logo))
+(define* (welcome-page logo #:key pci-database)
+  (run-welcome-page logo #:pci-database pci-database))

 (define (menu-page steps)
  (run-menu-page steps))
@@ -80,16 +80,20 @@ press the button to reboot.")))
 (define (run-install-failed-page)
  (match (current-clients)
    (()
-     (match (choice-window
+     (match (ternary-window
             (G_ "Installation failed")
             (G_ "Resume")
             (G_ "Restart the installer")
+             (G_ "Report the failure")
             (G_ "The final system installation step failed.  You can resume from \
 a specific step, or restart the installer."))
       (1 (abort-to-prompt 'installer-step 'abort))
       (2
        ;; Keep going, the installer will be restarted later on.
-        #t)))
+        #t)
+       (3 (raise
+            (condition
+             (&user-abort-error))))))
    (_
     (send-to-clients '(installation-failure))
     #t)))
@@ -115,6 +115,11 @@ network devices were found. Do you want to continue anyway?"))
 (define (wait-service-online)
  "Display a newt scale until connman detects an Internet access. Do
 FULL-VALUE tentatives, spaced by 1 second."
+  (define (url-alive? url)
+    (false-if-exception
+     (= (response-code (http-request url))
+        200)))
+
  (define (ci-available?)
    (dynamic-wind
      (lambda ()
@@ -122,10 +127,8 @@ FULL-VALUE tentatives, spaced by 1 second."
          (lambda _ #f))
        (alarm 3))
      (lambda ()
-        (false-if-exception
-         (= (response-code
-             (http-request "https://ci.guix.gnu.org"))
-            200)))
+        (or (url-alive? "https://ci.guix.gnu.org")
+            (url-alive? "https://bordeaux.guix.gnu.org")))
      (lambda ()
        (alarm 0))))

@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
-;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -278,12 +278,12 @@ input box, such as FLAG-PASSWORD."
                   (destroy-form-and-pop form)
                   input))))))))

-(define (run-error-page text title)
-  "Run a page to inform the user of an error. The page contains the given TEXT
-to explain the error and an \"OK\" button to acknowledge the error. The title
-of the page is set to TITLE."
+(define* (run-error-page text title #:key (width 40))
+  "Run a page to inform the user of an error.  The page is WIDTH column wide
+and contains the given TEXT to explain the error and an \"OK\" button to
+acknowledge the error.  The title of the page is set to TITLE."
  (let* ((text-box
-          (make-reflowed-textbox -1 -1 text 40
+          (make-reflowed-textbox -1 -1 text width
                                 #:flags FLAG-BORDER))
         (grid (make-grid 1 2))
         (ok-button (make-button -1 -1 "OK"))
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018, 2019 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2018, 2019, 2022 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;;
@@ -92,17 +92,31 @@ disk.  The installation device as well as the small devices are filtered.")
         (device (car result)))
    device))

+(define (run-label-confirmation-page callback)
+  (lambda (item)
+    (match (current-clients)
+      (()
+       (and (run-confirmation-page
+             (format #f (G_ "This will create a new ~a partition table, \
+all data on disk will be lost, are you sure you want to proceed?") item)
+             (G_ "Format disk?")
+             #:exit-button-procedure callback)
+            item))
+      (_ item))))
+
 (define (run-label-page button-text button-callback)
  "Run a page asking the user to select a partition table label."
  ;; Force the GPT label if UEFI is supported.
  (if (efi-installation?)
-      "gpt"
+      ((run-label-confirmation-page button-callback) "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")
       #:listbox-items '("msdos" "gpt")
       #:listbox-item->text identity
+       #:listbox-callback-procedure
+       (run-label-confirmation-page button-callback)
       #:button-text button-text
       #:button-callback-procedure button-callback)))

@@ -188,7 +202,7 @@ encryption of partition ~a (label: ~a).") file-name crypt-label)
                   (if (string=? password confirmation)
                       (user-partition
                        (inherit user-part)
-                        (crypt-password password))
+                        (crypt-password (make-secret password)))
                       (begin
                         (run-error-page
                          (G_ "Password mismatch, please try again.")
@@ -795,13 +809,13 @@ by pressing the Exit button.~%~%")))
         (user-partitions (run-page eligible-devices))
         (user-partitions-with-pass (prompt-luks-passwords
                                     user-partitions))
-         (form (draw-formatting-page user-partitions)))
+         (form (draw-formatting-page user-partitions-with-pass)))
    ;; Make sure the disks are not in use before proceeding to formatting.
    (free-parted eligible-devices)
    (format-user-partitions user-partitions-with-pass)
    (installer-log-line "formatted ~a user partitions"
            (length user-partitions-with-pass))
-    (installer-log-line "user-partitions: ~a" user-partitions)
+    (installer-log-line "user-partitions: ~a" user-partitions-with-pass)

    (destroy-form-and-pop form)
-    user-partitions))
+    user-partitions-with-pass))
@@ -99,10 +99,8 @@ non-graphical system.")
      #:item->text (compose G_ system-service-name)
      #:checkbox-tree-height 5
      #:exit-button-callback-procedure
-      (lambda ()
-        (raise
-          (condition
-            (&installer-step-abort)))))))
+      (lambda _
+        (abort-to-prompt 'installer-step 'abort)))))

 (define (run-network-management-page)
  "Run a page to select among several network management methods."
@@ -28,7 +28,7 @@
  (match (current-clients)
    (()
     (case (choice-window
-            (G_ "Substitute server discovery.")
+            (G_ "Substitute server discovery")
            (G_ "Enable") (G_ "Disable")
            (G_ " By turning this option on, you allow Guix to fetch \
 substitutes (pre-built binaries) during installation from servers \
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
-;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020, 2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2022 Florian Pelz <pelzflorian@pelzflorian.de>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -17,6 +18,11 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

 (define-module (gnu installer newt welcome)
+  #:use-module ((gnu build linux-modules)
+                #:select (modules-loaded
+                          pci-devices))
+  #:use-module (gnu installer dump)
+  #:use-module (gnu installer hardware)
  #:use-module (gnu installer steps)
  #:use-module (gnu installer utils)
  #:use-module (gnu installer newt page)
@@ -26,6 +32,8 @@
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-34)
  #:use-module (srfi srfi-35)
+  #:use-module (srfi srfi-71)
+  #:use-module (ice-9 format)
  #:use-module (ice-9 match)
  #:use-module (ice-9 receive)
  #:use-module (newt)
@@ -117,10 +125,52 @@ we want this page to occupy all the screen space available."
        (lambda ()
          (destroy-form-and-pop form))))))

-(define (run-welcome-page logo)
+(define (check-hardware-support pci-database)
+  "Warn about unsupported devices."
+  (when (member "uvesafb" (modules-loaded))
+    (run-error-page (G_ "\
+This may be a false alarm, but possibly your graphics hardware does not
+work well with only free software.  Expect trouble.  If after installation,
+the system does not boot, perhaps you will need to add nomodeset to the
+kernel arguments and need to configure the uvesafb kernel module.")
+                    (G_ "Pre-install warning")))
+
+  (let ((devices (pci-devices)))
+    (match (filter unsupported-pci-device? devices)
+      (()                                         ;no unsupported device
+       #t)
+      (unsupported
+       (run-error-page (format #f (G_ "\
+Devices not supported by free software were found on your computer:
+
+~{  - ~a~%~}
+Unfortunately, it means those devices will not be usable.
+
+To address it, we recommend choosing hardware that respects your freedom as a \
+user--hardware for which free drivers and firmware exist.  See \"Hardware \
+Considerations\" in the manual for more information.")
+                               (map (pci-device-description pci-database)
+                                    unsupported))
+                       (G_ "Hardware support warning")
+                       #:width 76)))))
+
+(define* (run-welcome-page logo #:key pci-database)
  "Run a welcome page with the given textual LOGO displayed at the center of
 the page. Ask the user to choose between manual installation, graphical
 installation and reboot."
+  (when (file-exists? %core-dump)
+    (match (choice-window
+            (G_ "Previous installation failed")
+            (G_ "Continue")
+            (G_ "Report the failure")
+            (G_ "It seems that the previous installation exited unexpectedly \
+and generated a core dump.  Do you want to continue or to report the failure \
+first?"))
+      (1 #t)
+      (2 (raise
+          (condition
+           (&user-abort-error))))))
+
  (run-menu-page
   (G_ "GNU Guix install")
   (G_ "Welcome to GNU Guix system installer!
@@ -134,14 +184,16 @@ Documentation is accessible at any time by pressing Ctrl-Alt-F2.")
   #:listbox-items
   `((,(G_ "Graphical install using a terminal based interface")
      .
-      ,(const #t))
+      ,(lambda ()
+         (check-hardware-support pci-database)))
     (,(G_ "Install using the shell based process")
      .
      ,(lambda ()
+         (check-hardware-support pci-database)
         ;; Switch to TTY3, where a root shell is available for shell based
         ;; install. The other root TTY's would have been ok too.
         (system* "chvt" "3")
-         (run-welcome-page logo)))
+         (run-welcome-page logo #:pci-database pci-database)))
     (,(G_ "Reboot")
      .
      ,(lambda ()
@@ -1,7 +1,8 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018, 2019 Mathieu Othacehe <m.othacehe@gmail.com>
-;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -38,6 +39,7 @@
                #:select (%base-initrd-modules))
  #:use-module (guix build syscalls)
  #:use-module (guix build utils)
+  #:use-module (guix read-print)
  #:use-module (guix records)
  #:use-module (guix utils)
  #:use-module (guix i18n)
@@ -79,7 +81,6 @@
            efi-installation?
            default-esp-mount-point

-            with-delay-device-in-use?
            force-device-sync
            eligible-devices
            partition-user-type
@@ -147,7 +148,7 @@
                        (default #f))
  (crypt-label          user-partition-crypt-label
                        (default #f))
-  (crypt-password       user-partition-crypt-password
+  (crypt-password       user-partition-crypt-password ; <secret>
                        (default #f))
  (fs-type              user-partition-fs-type
                        (default 'ext4))
@@ -318,6 +319,25 @@ PARTED-OBJECT field equals PARTITION, return #f if not found."
                  partition))
        user-partitions))

+(define (read-partition-uuid/retry file-name)
+  "Call READ-PARTITION-UUID with 5 retries spaced by 1 second.  This is useful
+if the partition table is updated by the kernel at the time this function is
+called, causing the underlying /dev to be absent."
+  (define max-retries 5)
+
+  (let loop ((retry max-retries))
+    (catch #t
+      (lambda ()
+        (read-partition-uuid file-name))
+      (lambda _
+        (if (> retry 0)
+            (begin
+              (sleep 1)
+              (loop (- retry 1)))
+            (error
+             (format #f (G_ "Could not open ~a after ~a retries~%.")
+                     file-name max-retries)))))))
+

 ;;
 ;; Devices
@@ -359,12 +379,44 @@ fail. See rereadpt function in wipefs.c of util-linux for an explanation."
 (define %min-device-size
  (* 2 GIBIBYTE-SIZE)) ;2GiB

+(define (mapped-device? device)
+  "Return #true if DEVICE is a mapped device, false otherwise."
+  (string-prefix? "/dev/dm-" device))
+
+;; TODO: Use DM_TABLE_DEPS ioctl instead of dmsetup.
+(define (mapped-device-parent-partition device)
+  "Return the parent partition path of the mapped DEVICE."
+  (let* ((command `("dmsetup" "deps" ,device "-o" "devname"))
+         (parent #f)
+         (handler
+          (lambda (input)
+            ;; We are parsing an output that should look like:
+            ;; 1 dependencies  : (sda2)
+            (let ((result
+                   (string-match "\\(([^\\)]+)\\)"
+                                 (get-string-all input))))
+              (and result
+                   (set! parent
+                         (format #f "/dev/~a"
+                                 (match:substring result 1))))))))
+    (run-external-command-with-handler handler command)
+    parent))
+
 (define (eligible-devices)
  "Return all the available devices except the install device and the devices
 which are smaller than %MIN-DEVICE-SIZE."

  (define the-installer-root-partition-path
-    (installer-root-partition-path))
+    (let ((root (installer-root-partition-path)))
+      (cond
+       ((mapped-device? root)
+        ;; If the partition is a mapped device (/dev/dm-X), locate the parent
+        ;; partition.  It is the case when Ventoy is used to host the
+        ;; installation image.
+        (let ((parent (mapped-device-parent-partition root)))
+          (installer-log-line "mapped device ~a -> ~a" parent root)
+          parent))
+       (else root))))

  (define (small-device? device)
    (let ((length (device-length device))
@@ -828,6 +880,7 @@ cause them to cross."
         (installer-log-line "~/type: ~a" partition-type)
         (installer-log-line "~/filesystem-type: ~a"
                             (filesystem-type-name filesystem-type))
+         (installer-log-line "~/flags: ~a" flags)
         (installer-log-line "~/start: ~a" start-sector*)
         (installer-log-line "~/end: ~a" end-sector)
         (installer-log-line "~/start-range: [~a, ~a]"
@@ -844,15 +897,18 @@ cause them to cross."
         (when (and partition-ok? has-name? name)
           (partition-set-name partition name))

-         ;; Set flags is required.
+         ;; Both partition-set-system and partition-set-flag calls can affect
+         ;; the partition type.  Their order is important, see:
+         ;; https://issues.guix.gnu.org/55549.
+         (partition-set-system partition filesystem-type)
+
+         ;; Set flags if required.
         (for-each (lambda (flag)
                     (and (partition-is-flag-available? partition flag)
                          (partition-set-flag partition flag 1)))
                   flags)

-         (and partition-ok?
-              (partition-set-system partition filesystem-type)
-              partition))))))
+         (and partition-ok? partition))))))


 ;;
@@ -979,6 +1035,11 @@ exists."
    (for-each
     (lambda (partition)
       (and (data-partition? partition)
+            ;; Do not remove logical partitions ourselves, since
+            ;; disk-remove-partition* will remove all the logical partitions
+            ;; residing on an extended partition, which would lead to a
+            ;; double-remove and ensuing SEGFAULT.
+            (not (logical-partition? partition))
            (disk-remove-partition* disk partition)))
     non-boot-partitions)

@@ -1098,7 +1159,7 @@ Return #t if all the statements are valid."
               (need-formatting?
                (user-partition-need-formatting? user-partition)))
           (or need-formatting?
-               (read-partition-uuid file-name)
+               (read-partition-uuid/retry file-name)
               (raise
                (condition
                 (&cannot-read-uuid
@@ -1173,7 +1234,7 @@ USER-PARTITION if it is encrypted, or the plain file-name otherwise."
  "Format and open the encrypted partition pointed by USER-PARTITION."
  (let* ((file-name (user-partition-file-name user-partition))
         (label (user-partition-crypt-label user-partition))
-         (password (user-partition-crypt-password user-partition)))
+         (password (secret-content (user-partition-crypt-password user-partition))))
    (call-with-luks-key-file
     password
     (lambda (key-file)
@@ -1184,6 +1245,20 @@ USER-PARTITION if it is encrypted, or the plain file-name otherwise."
       ((run-command-in-installer) "cryptsetup" "open" "--type" "luks"
        "--key-file" key-file file-name label)))))

+(define (luks-ensure-open user-partition)
+  "Ensure partition pointed by USER-PARTITION is opened."
+  (unless (file-exists? (user-partition-upper-file-name user-partition))
+    (let* ((file-name (user-partition-file-name user-partition))
+           (label (user-partition-crypt-label user-partition))
+           (password (secret-content (user-partition-crypt-password user-partition))))
+      (call-with-luks-key-file
+       password
+       (lambda (key-file)
+         (installer-log-line "opening LUKS entry ~s at ~s"
+                             label file-name)
+         ((run-command-in-installer) "cryptsetup" "open" "--type" "luks"
+          "--key-file" key-file file-name label))))))
+
 (define (luks-close user-partition)
  "Close the encrypted partition pointed by USER-PARTITION."
  (let ((label (user-partition-crypt-label user-partition)))
@@ -1268,6 +1343,8 @@ respective mount-points."
                        (user-fs-type->mount-type fs-type))
                       (file-name
                        (user-partition-upper-file-name user-partition)))
+                  (when crypt-label
+                    (luks-ensure-open user-partition))
                  (mkdir-p target)
                  (installer-log-line "mounting ~s on ~s" file-name target)
                  (mount file-name target mount-type)))
@@ -1439,6 +1516,13 @@ USER-PARTITIONS, or return nothing."
            `((mapped-devices
               (list ,@(map user-partition->mapped-device
                            encrypted-partitions)))))
+
+      ,(vertical-space 1)
+      ,(let-syntax ((G_ (syntax-rules () ((_ str) str))))
+         (comment (G_ "\
+;; The list of file systems that get \"mounted\".  The unique
+;; file system identifiers there (\"UUIDs\") can be obtained
+;; by running 'blkid' in a terminal.\n")))
      (file-systems (cons*
                     ,@(user-partitions->file-systems user-partitions)
                     %base-file-systems)))))
@@ -89,7 +89,7 @@
  (partition-page installer-partition-page)
  ;; procedure void -> void
  (services-page installer-services-page)
-  ;; procedure (logo) -> void
+  ;; procedure (logo #:pci-database) -> void
  (welcome-page installer-welcome-page)
  ;; procedure (menu-proc) -> void
  (parameters-menu installer-parameters-menu)
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
-;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2021 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2021 Leo Famulari <leo@famulari.name>
@@ -22,6 +22,7 @@

 (define-module (gnu installer services)
  #:use-module (guix records)
+  #:use-module (guix read-print)
  #:use-module (srfi srfi-1)
  #:export (system-service?
            system-service-name
@@ -35,6 +36,11 @@
            %system-services
            system-services->configuration))

+(define-syntax-rule (G_ str)
+  ;; In this file, translatable strings are annotated with 'G_' so xgettext
+  ;; catches them, but translation happens later on at run time.
+  str)
+
 (define-record-type* <system-service>
  system-service make-system-service
  system-service?
@@ -52,9 +58,7 @@
                                      ((_ fields ...)
                                       (system-service
                                        (type 'desktop)
-                                        fields ...))))
-               (G_ (syntax-rules ()               ;for xgettext
-                     ((_ str) str))))
+                                        fields ...)))))
    (list
     ;; This is the list of desktop environments supported as services.
     (desktop-environment
@@ -94,7 +98,12 @@
     (system-service
      (name (G_ "OpenSSH secure shell daemon (sshd)"))
      (type 'networking)
-      (snippet '((service openssh-service-type))))
+      (snippet `(,(vertical-space 1)
+                 ,(comment
+                   (G_ "\
+;; To configure OpenSSH, pass an 'openssh-configuration'
+;; record as a second argument to 'service' below.\n"))
+                 (service openssh-service-type))))
     (system-service
      (name (G_ "Tor anonymous network router"))
      (type 'networking)
@@ -149,24 +158,45 @@
         (desktop? (find desktop-system-service? services))
         (base     (if desktop?
                       '%desktop-services
-                       '%base-services)))
+                       '%base-services))
+         (service-heading (list (vertical-space 1)
+                                (comment (G_ "\
+;; Below is the list of system services.  To search for available
+;; services, run 'guix system search KEYWORD' in a terminal.\n"))))
+         (package-heading (list (vertical-space 1)
+                                (comment (G_ "\
+;; Packages installed system-wide.  Users can also install packages
+;; under their own account: use 'guix search KEYWORD' to search
+;; for packages and 'guix install PACKAGE' to install a package.\n")))))
+
    (if (null? snippets)
        `(,@(if (null? packages)
                '()
-                `((packages (append (list ,@packages)
+                `(,@package-heading
+                  (packages (append (list ,@packages)
                                    %base-packages))))
+
+          ,@service-heading
          (services ,base))
        `(,@(if (null? packages)
                '()
-                `((packages (append (list ,@packages)
+                `(,@package-heading
+                  (packages (append (list ,@packages)
                                    %base-packages))))
+
+          ,@service-heading
          (services (append (list ,@snippets

                                  ,@(if desktop?
                                        ;; XXX: Assume 'keyboard-layout' is in
                                        ;; scope.
-                                        '((set-xorg-configuration
+                                        `((set-xorg-configuration
                                           (xorg-configuration
                                            (keyboard-layout keyboard-layout))))
                                        '()))
-                           ,base))))))
+
+                            ,(vertical-space 1)
+                            ,(comment (G_ "\
+;; This is the default list of services we
+;; are appending to.\n"))
+                            ,base))))))
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018, 2019 Mathieu Othacehe <m.othacehe@gmail.com>
-;;; Copyright © 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020-2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,14 +21,17 @@
  #:use-module (guix records)
  #:use-module (guix build utils)
  #:use-module (guix i18n)
+  #:use-module (guix read-print)
  #:use-module (gnu installer utils)
  #:use-module (ice-9 match)
-  #:use-module (ice-9 pretty-print)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-34)
  #:use-module (srfi srfi-35)
  #:use-module (rnrs io ports)
-  #:export (<installer-step>
+  #:export (&user-abort-error
+            user-abort-error?
+
+            <installer-step>
            installer-step
            make-installer-step
            installer-step?
@@ -50,6 +53,9 @@

            %current-result))

+(define-condition-type &user-abort-error &error
+  user-abort-error?)
+
 ;; Hash table storing the step results. Use it only for logging and debug
 ;; purposes.
 (define %current-result (make-hash-table))
@@ -224,10 +230,14 @@ found in RESULTS."
                  (conf-formatter result-step)
                  '())))
          steps))
-        (modules '((use-modules (gnu))
+        (modules `(,(vertical-space 1)
+                   ,(comment (G_ "\
+;; Indicate which modules to import to access the variables
+;; used in this configuration.\n"))
+                   (use-modules (gnu))
                   (use-service-modules cups desktop networking ssh xorg))))
    `(,@modules
-      ()
+      ,(vertical-space 1)
      (operating-system ,@configuration))))

 (define* (configuration->file configuration
@@ -241,14 +251,22 @@ found in RESULTS."
      ;; length below 60 characters.
      (display (G_ "\
 ;; This is an operating system configuration generated
-;; by the graphical installer.\n")
+;; by the graphical installer.
+;;
+;; Once installation is complete, you can learn and modify
+;; this file to tweak the system configuration, and pass it
+;; to the 'guix system reconfigure' command to effect your
+;; changes.\n")
               port)
      (newline port)
-      (for-each (lambda (part)
-                  (if (null? part)
-                      (newline port)
-                      (pretty-print part port)))
-                configuration)
+      (pretty-print-with-comments/splice port configuration
+                                         #:max-width 75
+                                         #:format-comment
+                                         (lambda (c indent)
+                                           ;; Localize C.
+                                           (comment (G_ (comment->string c))
+                                                    (comment-margin? c))))
+
      (flush-output-port port))))

 ;;; Local Variables:
@@ -280,6 +280,10 @@ instrumented for further testing."
       exp)))

  (let ((content (call-with-input-file file read-expressions)))
+    ;; XXX: Remove the file before re-writing it, to be sure there are no
+    ;; leftovers.  We shouldn't have to do that as CALL-WITH-OUTPUT-FILE uses
+    ;; the O_TRUNC flag by default.
+    (delete-file file)
    (call-with-output-file file
      (lambda (port)
        (format port "\
@@ -17,16 +17,13 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

 (define-module (gnu installer user)
+  #:use-module (gnu installer utils)
  #:use-module (guix records)
+  #:use-module (guix read-print)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-9)
  #:use-module (srfi srfi-9 gnu)
-  #:export (<secret>
-            secret?
-            make-secret
-            secret-content
-
-            <user>
+  #:export (<user>
            user
            make-user
            user-name
@@ -37,16 +34,6 @@

            users->configuration))

-(define-record-type <secret>
-  (make-secret content)
-  secret?
-  (content secret-content))
-
-(set-record-type-printer!
- <secret>
- (lambda (secret port)
-   (format port "<secret>")))
-
 (define-record-type* <user>
  user make-user
  user?
@@ -69,7 +56,11 @@
      (supplementary-groups '("wheel" "netdev"
                              "audio" "video"))))

-  `((users (cons*
+  (define-syntax-rule (G_ str) str)
+
+  `(,(vertical-space 1)
+    ,(comment (G_ ";; The list of user accounts ('root' is implicit).\n"))
+    (users (cons*
            ,@(filter-map (lambda (user)
                            ;; Do not emit a 'user-account' form for "root".
                            (and (not (string=? (user-name user) "root"))
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
-;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -20,9 +20,12 @@
 (define-module (gnu installer utils)
  #:use-module (gnu services herd)
  #:use-module (guix utils)
+  #:use-module ((guix build syscalls) #:select (openpty login-tty))
  #:use-module (guix build utils)
  #:use-module (guix i18n)
  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-9 gnu)
  #:use-module (srfi srfi-19)
  #:use-module (srfi srfi-34)
  #:use-module (srfi srfi-35)
@@ -33,11 +36,17 @@
  #:use-module (ice-9 regex)
  #:use-module (ice-9 format)
  #:use-module (ice-9 textual-ports)
-  #:export (read-lines
+  #:export (<secret>
+            secret?
+            make-secret
+            secret-content
+
+            read-lines
            read-all
            nearest-exact-integer
            read-percentage
            run-external-command-with-handler
+            run-external-command-with-handler/tty
            run-external-command-with-line-hooks
            run-command
            run-command-in-installer
@@ -58,6 +67,16 @@

            with-silent-shepherd))

+(define-record-type <secret>
+  (make-secret content)
+  secret?
+  (content secret-content))
+
+(set-record-type-printer!
+ <secret>
+ (lambda (secret port)
+   (format port "<secret>")))
+
 (define* (read-lines #:optional (port (current-input-port)))
  "Read lines from PORT and return them as a list."
  (let loop ((line (read-line port))
@@ -107,26 +126,58 @@ the child process as returned by waitpid."
    (close-port input)
    (close-pipe dummy-pipe)))

-(define (run-external-command-with-line-hooks line-hooks command)
+(define (run-external-command-with-handler/tty handler command)
+  "Run command specified by the list COMMAND in a child operating in a
+pseudoterminal with output handler HANDLER.  HANDLER is a procedure taking an
+input port, to which the command will write its standard output and error.
+Returns the integer status value of the child process as returned by waitpid."
+  (define-values (controller inferior)
+    (openpty))
+
+  (match (primitive-fork)
+    (0
+     (catch #t
+       (lambda ()
+         (close-fdes controller)
+         (login-tty inferior)
+         (apply execlp (car command) command))
+       (lambda _
+         (primitive-exit 127))))
+    (pid
+     (close-fdes inferior)
+     (let* ((port (fdopen controller "r0"))
+            (result (false-if-exception
+                     (handler port))))
+       (close-port port)
+       (cdr (waitpid pid))))))
+
+(define* (run-external-command-with-line-hooks line-hooks command
+                                               #:key (tty? #false))
  "Run command specified by the list COMMAND in a child, processing each
-output line with the procedures in LINE-HOOKS.  Returns the integer status
-value of the child process as returned by waitpid."
+output line with the procedures in LINE-HOOKS.  If TTY is set to #true, the
+COMMAND will be run in a pseudoterminal.  Returns the integer status value of
+the child process as returned by waitpid."
  (define (handler input)
    (and
-     (and=> (get-line input)
+     ;; Lines for progress bars etc. end in \r; treat is as a line ending so
+     ;; those lines are printed right away.
+     (and=> (read-delimited "\r\n" input 'concat)
            (lambda (line)
              (if (eof-object? line)
                  #f
                  (begin (for-each (lambda (f) (f line))
                                   (append line-hooks
-                                       %default-installer-line-hooks))
+                                           %default-installer-line-hooks))
                         #t))))
     (handler input)))
-  (run-external-command-with-handler handler command))
+  (if tty?
+      (run-external-command-with-handler/tty handler command)
+      (run-external-command-with-handler handler command)))

-(define* (run-command command)
+(define* (run-command command #:key (tty? #f))
  "Run COMMAND, a list of strings.  Return true if COMMAND exited
-successfully, #f otherwise."
+successfully, #f otherwise.  If TTY is set to #true, the COMMAND will be run
+in a pseudoterminal."
  (define (pause)
    (format #t (G_ "Press Enter to continue.~%"))
    (send-to-clients '(pause))
@@ -137,8 +188,8 @@ successfully, #f otherwise."

  (installer-log-line "running command ~s" command)
  (define result (run-external-command-with-line-hooks
-                  (list %display-line-hook)
-                  command))
+                  (list display) command
+                  #:tty? tty?))
  (define exit-val (status:exit-val result))
  (define term-sig (status:term-sig result))
  (define stop-sig (status:stop-sig result))
@@ -215,7 +266,10 @@ values."
      (or port (%make-void-port "w")))))

 (define (%syslog-line-hook line)
-  (format (syslog-port) "installer[~d]: ~a~%" (getpid) line))
+  (let ((line (if (string-suffix? "\r" line)
+                  (string-append (string-drop-right line 1) "\n")
+                  line)))
+    (format (syslog-port) "installer[~d]: ~a" (getpid) line)))

 (define-syntax syslog
  (lambda (s)
@@ -244,11 +298,7 @@ values."
      port)))

 (define (%installer-log-line-hook line)
-  (format (installer-log-port) "~a~%" line))
-
-(define (%display-line-hook line)
-  (display line)
-  (newline))
+  (display line (installer-log-port)))

 (define %default-installer-line-hooks
  (list %syslog-line-hook
@@ -260,9 +310,10 @@ values."
    (syntax-case s ()
      ((_ fmt args ...)
       (string? (syntax->datum #'fmt))
-       #'(let ((formatted (format #f fmt args ...)))
-               (for-each (lambda (f) (f formatted))
-                         %default-installer-line-hooks))))))
+       (with-syntax ((fmt (string-append (syntax->datum #'fmt) "\n")))
+         #'(let ((formatted (format #f fmt args ...)))
+             (for-each (lambda (f) (f formatted))
+                       %default-installer-line-hooks)))))))


 ;;;
@@ -17,7 +17,7 @@
 # Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
 # Copyright © 2017, 2018, 2019 Gábor Boskovits <boskovits@gmail.com>
 # Copyright © 2018 Amirouche Boubekki <amirouche@hypermove.net>
-# Copyright © 2018, 2019, 2020, 2021 Oleg Pykhalov <go.wigust@gmail.com>
+# Copyright © 2018, 2019, 2020, 2021, 2022 Oleg Pykhalov <go.wigust@gmail.com>
 # Copyright © 2018 Stefan Stefanović <stefanx2ovic@gmail.com>
 # Copyright © 2018, 2020, 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 # Copyright © 2019, 2020, 2021, 2022 Guillaume Le Vaillant <glv@posteo.net>
@@ -50,6 +50,12 @@
 # Copyright © 2022 Daniel Meißner <daniel.meissner-i4k@ruhr-uni-bochum.de>
 # Copyright © 2022 Remco van 't Veer <remco@remworks.net>
 # Copyright © 2022 Artyom V. Poptsov <poptsov.artyom@gmail.com>
+# Copyright © 2022 John Kehayias <john.kehayias@protonmail.com>
+# Copyright © 2022 muradm <mail@muradm.net>
+# Copyright © 2022 Hilton Chain <hako@ultrarare.space>
+# Copyright © 2022 Alex Griffin <a@ajgrf.com>
+# Copyright © 2022 ( <paren@disroot.org>
+# Copyright © 2022 jgart <jgart@dismail.de>
 #
 # This file is part of GNU Guix.
 #
@@ -78,11 +84,14 @@ GNU_SYSTEM_MODULES =				\
  %D%/bootloader/u-boot.scm                     \
  %D%/bootloader/depthcharge.scm                \
  %D%/ci.scm					\
+  %D%/compression.scm				\
  %D%/home.scm					\
  %D%/home/services.scm			\
  %D%/home/services/desktop.scm			\
  %D%/home/services/symlink-manager.scm		\
  %D%/home/services/fontutils.scm		\
+  %D%/home/services/guix.scm			\
+  %D%/home/services/pm.scm			\
  %D%/home/services/shells.scm			\
  %D%/home/services/shepherd.scm		\
  %D%/home/services/ssh.scm			\
@@ -139,6 +148,7 @@ GNU_SYSTEM_MODULES =				\
  %D%/packages/browser-extensions.scm		\
  %D%/packages/build-tools.scm			\
  %D%/packages/busybox.scm			\
+  %D%/packages/bqn.scm				\
  %D%/packages/c.scm				\
  %D%/packages/calcurse.scm			\
  %D%/packages/ccache.scm			\
@@ -300,8 +310,10 @@ GNU_SYSTEM_MODULES =				\
  %D%/packages/haskell-crypto.scm		\
  %D%/packages/haskell-web.scm			\
  %D%/packages/haskell-xyz.scm			\
+  %D%/packages/haxe.scm				\
  %D%/packages/heads.scm			\
  %D%/packages/hexedit.scm			\
+  %D%/packages/high-availability.scm			\
  %D%/packages/hugs.scm				\
  %D%/packages/hunspell.scm				\
  %D%/packages/hurd.scm				\
@@ -339,6 +351,7 @@ GNU_SYSTEM_MODULES =				\
  %D%/packages/kawa.scm				\
  %D%/packages/kde.scm				\
  %D%/packages/kde-frameworks.scm		\
+  %D%/packages/kde-games.scm			\
  %D%/packages/kde-internet.scm			\
  %D%/packages/kde-multimedia.scm		\
  %D%/packages/kde-pim.scm			\
@@ -412,7 +425,6 @@ GNU_SYSTEM_MODULES =				\
  %D%/packages/moe.scm				\
  %D%/packages/motti.scm			\
  %D%/packages/monitoring.scm			\
-  %D%/packages/mono.scm				\
  %D%/packages/moreutils.scm			\
  %D%/packages/mpd.scm				\
  %D%/packages/mp3.scm				\
@@ -495,6 +507,7 @@ GNU_SYSTEM_MODULES =				\
  %D%/packages/pure.scm				\
  %D%/packages/purescript.scm			\
  %D%/packages/pv.scm				\
+  %D%/packages/pypy.scm				\
  %D%/packages/python.scm			\
  %D%/packages/python-build.scm			\
  %D%/packages/python-check.scm			\
@@ -657,6 +670,7 @@ GNU_SYSTEM_MODULES =				\
  %D%/services/guix.scm			\
  %D%/services/hurd.scm				\
  %D%/services/kerberos.scm			\
+  %D%/services/lightdm.scm      		\
  %D%/services/linux.scm			\
  %D%/services/lirc.scm				\
  %D%/services/virtualization.scm		\
@@ -669,12 +683,14 @@ GNU_SYSTEM_MODULES =				\
  %D%/services/nfs.scm			\
  %D%/services/pam-mount.scm			\
  %D%/services/science.scm			\
+  %D%/services/security.scm			\
  %D%/services/security-token.scm		\
  %D%/services/shepherd.scm			\
  %D%/services/sound.scm			\
  %D%/services/herd.scm				\
  %D%/services/pm.scm				\
  %D%/services/rsync.scm			\
+  %D%/services/samba.scm			\
  %D%/services/sddm.scm				\
  %D%/services/spice.scm				\
  %D%/services/ssh.scm				\
@@ -682,6 +698,7 @@ GNU_SYSTEM_MODULES =				\
  %D%/services/sysctl.scm			\
  %D%/services/telephony.scm			\
  %D%/services/version-control.scm              \
+  %D%/services/vnc.scm				\
  %D%/services/vpn.scm				\
  %D%/services/web.scm				\
  %D%/services/xorg.scm				\
@@ -709,6 +726,7 @@ GNU_SYSTEM_MODULES =				\
  %D%/system/images/pine64.scm			\
  %D%/system/images/pinebook-pro.scm		\
  %D%/system/images/rock64.scm			\
+  %D%/system/images/wsl2.scm			\
 						\
  %D%/machine.scm				\
 						\
@@ -744,6 +762,7 @@ GNU_SYSTEM_MODULES =				\
  %D%/tests/guix.scm				\
  %D%/tests/monitoring.scm                      \
  %D%/tests/nfs.scm				\
+  %D%/tests/image.scm				\
  %D%/tests/install.scm				\
  %D%/tests/ldap.scm				\
  %D%/tests/linux-modules.scm			\
@@ -753,12 +772,15 @@ GNU_SYSTEM_MODULES =				\
  %D%/tests/package-management.scm		\
  %D%/tests/reconfigure.scm			\
  %D%/tests/rsync.scm				\
+  %D%/tests/samba.scm				\
+  %D%/tests/security.scm			\
  %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/vnc.scm				\
  %D%/tests/web.scm

 INSTALLER_MODULES =                             \
@@ -766,6 +788,7 @@ INSTALLER_MODULES =                             \
  %D%/installer/connman.scm			\
  %D%/installer/dump.scm			\
  %D%/installer/final.scm			\
+  %D%/installer/hardware.scm			\
  %D%/installer/hostname.scm			\
  %D%/installer/keymap.scm			\
  %D%/installer/locale.scm			\
@@ -837,6 +860,7 @@ dist_patch_DATA =						\
  %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/accountsservice-extensions.patch		\
  %D%/packages/patches/aegis-constness-error.patch         	\
  %D%/packages/patches/aegis-perl-tempdir1.patch           	\
  %D%/packages/patches/aegis-perl-tempdir2.patch           	\
@@ -855,8 +879,10 @@ dist_patch_DATA =						\
  %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/aoflagger-use-system-provided-pybind11.patch \
  %D%/packages/patches/apr-skip-getservbyname-test.patch	\
  %D%/packages/patches/ark-skip-xar-test.patch			\
+  %D%/packages/patches/aspell-CVE-2019-25051.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		\
@@ -885,6 +911,7 @@ dist_patch_DATA =						\
  %D%/packages/patches/awesome-4.3-fno-common.patch		\
  %D%/packages/patches/aws-c-auth-install-private-headers.patch	\
  %D%/packages/patches/azr3.patch				\
+  %D%/packages/patches/barony-fix-textures.patch		\
  %D%/packages/patches/bash-completion-directories.patch	\
  %D%/packages/patches/bash-linux-pgrp-pipe.patch		\
  %D%/packages/patches/bastet-change-source-of-unordered_set.patch	\
@@ -927,6 +954,7 @@ dist_patch_DATA =						\
  %D%/packages/patches/calibre-remove-test-sqlite.patch		\
  %D%/packages/patches/calibre-remove-test-unrar.patch		\
  %D%/packages/patches/catdoc-CVE-2017-11110.patch		\
+  %D%/packages/patches/chez-scheme-bin-sh.patch			\
  %D%/packages/patches/circos-remove-findbin.patch		\
  %D%/packages/patches/cdparanoia-fpic.patch			\
  %D%/packages/patches/cdrkit-libre-cross-compile.patch	\
@@ -934,7 +962,6 @@ dist_patch_DATA =						\
  %D%/packages/patches/ceph-disable-cpu-optimizations.patch	\
  %D%/packages/patches/ceph-boost-compat.patch			\
  %D%/packages/patches/ceph-rocksdb-compat.patch		\
-  %D%/packages/patches/cheese-vala-update.patch		        \
  %D%/packages/patches/chmlib-inttypes.patch			\
  %D%/packages/patches/cl-asdf-config-directories.patch		\
  %D%/packages/patches/clamav-config-llvm-libs.patch		\
@@ -951,10 +978,12 @@ dist_patch_DATA =						\
  %D%/packages/patches/clang-12.0-libc-search-path.patch	\
  %D%/packages/patches/clang-13.0-libc-search-path.patch	\
  %D%/packages/patches/clang-14.0-libc-search-path.patch	\
+  %D%/packages/patches/clang-15.0-libc-search-path.patch	\
  %D%/packages/patches/clang-runtime-asan-build-fixes.patch	\
  %D%/packages/patches/clang-runtime-esan-build-fixes.patch	\
  %D%/packages/patches/clang-runtime-9-libsanitizer-mode-field.patch	\
  %D%/packages/patches/clang-runtime-3.5-libsanitizer-mode-field.patch	\
+  %D%/packages/patches/clang-runtime-3.7-fix-build-with-python3.patch	\
  %D%/packages/patches/clang-runtime-3.9-libsanitizer-mode-field.patch	\
  %D%/packages/patches/clang-runtime-3.8-libsanitizer-mode-field.patch	\
  %D%/packages/patches/classpath-aarch64-support.patch		\
@@ -962,11 +991,15 @@ dist_patch_DATA =						\
  %D%/packages/patches/cling-use-shared-library.patch		\
  %D%/packages/patches/clucene-pkgconfig.patch			\
  %D%/packages/patches/cmake-curl-certificates.patch		\
-  %D%/packages/patches/cmh-support-fplll.patch      		\
+  %D%/packages/patches/cmake-curl-certificates-3.24.patch	\
  %D%/packages/patches/coda-use-system-libs.patch		\
  %D%/packages/patches/collectd-5.11.0-noinstallvar.patch		\
  %D%/packages/patches/combinatorial-blas-awpm.patch		\
  %D%/packages/patches/combinatorial-blas-io-fix.patch		\
+  %D%/packages/patches/connman-CVE-2022-32292.patch		\
+  %D%/packages/patches/connman-CVE-2022-32293-pt1.patch	\
+  %D%/packages/patches/connman-CVE-2022-32293-pt2.patch	\
+  %D%/packages/patches/containerd-create-pid-file.patch	\
  %D%/packages/patches/cool-retro-term-wctype.patch		\
  %D%/packages/patches/coreutils-gnulib-tests.patch		\
  %D%/packages/patches/coq-fix-envvars.patch			\
@@ -974,6 +1007,7 @@ dist_patch_DATA =						\
  %D%/packages/patches/cpuinfo-system-libraries.patch		\
  %D%/packages/patches/cpulimit-with-glib-2.32.patch		\
  %D%/packages/patches/crawl-upgrade-saves.patch		\
+  %D%/packages/patches/crc32c-unbundle-googletest.patch		\
  %D%/packages/patches/crda-optional-gcrypt.patch		\
  %D%/packages/patches/clucene-contribs-lib.patch               \
  %D%/packages/patches/cube-nocheck.patch			\
@@ -1010,13 +1044,9 @@ dist_patch_DATA =						\
  %D%/packages/patches/dstat-skip-devices-without-io.patch	\
  %D%/packages/patches/dvd+rw-tools-add-include.patch 		\
  %D%/packages/patches/dynaconf-unvendor-deps.patch		\
-  %D%/packages/patches/ecl-16-format-directive-limit.patch	\
-  %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-211.patch			\
-  %D%/packages/patches/eigen-remove-openmp-error-counting.patch	\
-  %D%/packages/patches/eigen-stabilise-sparseqr-test.patch	\
+  %D%/packages/patches/eigen-fix-strict-aliasing-bug.patch	\
  %D%/packages/patches/einstein-build.patch			\
  %D%/packages/patches/elfutils-tests-ptrace.patch		\
  %D%/packages/patches/elixir-path-length.patch			\
@@ -1031,23 +1061,32 @@ dist_patch_DATA =						\
  %D%/packages/patches/emacs-json-reformat-fix-tests.patch	\
  %D%/packages/patches/emacs-helpful-fix-docstring-test.patch	\
  %D%/packages/patches/emacs-highlight-stages-add-gexp.patch	\
-  %D%/packages/patches/emacs-hyperbole-toggle-messaging.patch	\
  %D%/packages/patches/emacs-libgit-use-system-libgit2.patch    \
  %D%/packages/patches/emacs-lispy-fix-thread-last-test.patch   \
+  %D%/packages/patches/emacs-native-comp-driver-options.patch   \
+  %D%/packages/patches/emacs-polymode-fix-lexical-variable-error.patch  \
  %D%/packages/patches/emacs-source-date-epoch.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/emacs-yasnippet-fix-tests.patch	\
+  %D%/packages/patches/emacs-kv-fix-tests.patch	\
+  %D%/packages/patches/emacs-pgtk-super-key-fix.patch	\
  %D%/packages/patches/enjarify-setup-py.patch			\
  %D%/packages/patches/enlightenment-fix-setuid-path.patch	\
-  %D%/packages/patches/eog-update-libportal-usage.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/exercism-disable-self-update.patch	\
  %D%/packages/patches/extempore-unbundle-external-dependencies.patch	\
  %D%/packages/patches/extundelete-e2fsprogs-1.44.patch		\
+  %D%/packages/patches/fail2ban-0.11.2_CVE-2021-32749.patch	\
+  %D%/packages/patches/fail2ban-0.11.2_fix-setuptools-drop-2to3.patch	\
+  %D%/packages/patches/fail2ban-0.11.2_fix-test-suite.patch	\
+  %D%/packages/patches/fail2ban-paths-guix-conf.patch		\
+  %D%/packages/patches/fail2ban-python310-server-action.patch	\
+  %D%/packages/patches/fail2ban-python310-server-actions.patch	\
+  %D%/packages/patches/fail2ban-python310-server-jails.patch	\
  %D%/packages/patches/farstream-gupnp.patch                         \
  %D%/packages/patches/farstream-make.patch                          \
  %D%/packages/patches/fastcap-mulGlobal.patch			\
@@ -1067,6 +1106,8 @@ dist_patch_DATA =						\
  %D%/packages/patches/fifo-map-fix-flags-for-gcc.patch		\
  %D%/packages/patches/fifo-map-remove-catch.hpp.patch		\
  %D%/packages/patches/findutils-localstatedir.patch		\
+  %D%/packages/patches/firebird-riscv64-support-pt1.patch	\
+  %D%/packages/patches/firebird-riscv64-support-pt2.patch	\
  %D%/packages/patches/flann-cmake-3.11.patch			\
  %D%/packages/patches/flatpak-fix-path.patch			\
  %D%/packages/patches/flatpak-unset-gdk-pixbuf-for-sandbox.patch	\
@@ -1074,12 +1115,13 @@ dist_patch_DATA =						\
  %D%/packages/patches/foobillard++-pkg-config.patch		\
  %D%/packages/patches/foomatic-filters-CVE-2015-8327.patch	\
  %D%/packages/patches/foomatic-filters-CVE-2015-8560.patch	\
+  %D%/packages/patches/fp16-implicit-double.patch		\
  %D%/packages/patches/fp16-system-libraries.patch		\
  %D%/packages/patches/fpc-reproducibility.patch		\
  %D%/packages/patches/freedink-engine-fix-sdl-hints.patch	\
-  %D%/packages/patches/freeglut-gcc-compat.patch		\
  %D%/packages/patches/freeimage-unbundle.patch		\
-  %D%/packages/patches/fuse-overlapping-headers.patch				\
+  %D%/packages/patches/fuse-glibc-2.34.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-disable-version-symlinks.patch	\
@@ -1142,18 +1184,16 @@ dist_patch_DATA =						\
  %D%/packages/patches/gdm-wayland-session-wrapper-from-env.patch	\
  %D%/packages/patches/gdm-pass-gdk-pixbuf-loader-env.patch	\
  %D%/packages/patches/geeqie-clutter.patch			\
+  %D%/packages/patches/gemmi-fix-pegtl-usage.patch		\
+  %D%/packages/patches/gemmi-fix-sajson-types.patch		\
  %D%/packages/patches/genimage-mke2fs-test.patch		\
  %D%/packages/patches/geoclue-config.patch			\
-  %D%/packages/patches/ghc-4.patch				\
  %D%/packages/patches/ghc-8.0-fall-back-to-madv_dontneed.patch	\
  %D%/packages/patches/ghc-testsuite-dlopen-pie.patch		\
  %D%/packages/patches/ghc-language-haskell-extract-ghc-8.10.patch	\
  %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/giara-fix-login.patch                      \
-  %D%/packages/patches/glade-gls-set-script-name.patch	        \
-  %D%/packages/patches/glade-test-widget-null-icon.patch	\
  %D%/packages/patches/glib-appinfo-watch.patch			\
  %D%/packages/patches/glib-networking-gnutls-binding.patch	\
  %D%/packages/patches/glib-networking-32-bit-time.patch	\
@@ -1191,22 +1231,21 @@ dist_patch_DATA =						\
  %D%/packages/patches/gmp-arm-asm-nothumb.patch		\
  %D%/packages/patches/gmp-faulty-test.patch			\
  %D%/packages/patches/gnash-fix-giflib-version.patch	        \
-  %D%/packages/patches/gnome-boxes-add-guix-logo.patch		\
-  %D%/packages/patches/gnome-builder-update-libportal.patch		\
  %D%/packages/patches/gnome-control-center-libexecdir.patch	\
  %D%/packages/patches/gnome-online-miners-tracker-3.patch	\
-  %D%/packages/patches/gnome-screenshot-meson-0.60.patch	\
  %D%/packages/patches/gnome-settings-daemon-gc.patch		\
-  %D%/packages/patches/gnome-session-support-elogind.patch      \
-  %D%/packages/patches/gnome-todo-libportal.patch		\
+  %D%/packages/patches/gnome-session-support-elogind.patch	\
  %D%/packages/patches/gnome-tweaks-search-paths.patch		\
+  %D%/packages/patches/gnupg-CVE-2022-34903.patch		\
  %D%/packages/patches/gnupg-default-pinentry.patch		\
  %D%/packages/patches/gnupg-1-build-with-gcc10.patch		\
  %D%/packages/patches/gnutls-skip-trust-store-test.patch	\
  %D%/packages/patches/gnutls-cross.patch			\
  %D%/packages/patches/gnutls-guile-eintr-eagain.patch		\
  %D%/packages/patches/gobject-introspection-absolute-shlib-path.patch \
+  %D%/packages/patches/gobject-introspection-absolute-shlib-path-1.72.patch \
  %D%/packages/patches/gobject-introspection-cc.patch		\
+  %D%/packages/patches/gobject-introspection-cc-1.72.patch	\
  %D%/packages/patches/gobject-introspection-girepository.patch	\
  %D%/packages/patches/go-fix-script-tests.patch			\
  %D%/packages/patches/go-github-com-golang-snappy-32bit-test.patch \
@@ -1218,15 +1257,12 @@ dist_patch_DATA =						\
  %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/grep-timing-sensitive-test.patch		\
  %D%/packages/patches/grfcodec-gcc-compat.patch		\
  %D%/packages/patches/gromacs-tinyxml2.patch			\
  %D%/packages/patches/groovy-add-exceptionutilsgenerator.patch	\
  %D%/packages/patches/grub-efi-fat-serial-number.patch		\
  %D%/packages/patches/grub-setup-root.patch			\
-  %D%/packages/patches/gspell-dash-test.patch			\
-  %D%/packages/patches/gst-plugins-good-fix-test.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             \
@@ -1237,8 +1273,11 @@ dist_patch_DATA =						\
  %D%/packages/patches/guile-linux-syscalls.patch		\
  %D%/packages/patches/guile-3.0-linux-syscalls.patch		\
  %D%/packages/patches/guile-ac-d-bus-fix-tests.patch		\
+  %D%/packages/patches/guile-continuation-stack-leak.patch	\
  %D%/packages/patches/guile-cross-compilation.patch		\
  %D%/packages/patches/guile-fibers-destroy-peer-schedulers.patch \
+  %D%/packages/patches/guile-fibers-epoll-instance-is-dead.patch \
+  %D%/packages/patches/guile-fibers-fd-finalizer-leak.patch	\
  %D%/packages/patches/guile-fibers-wait-for-io-readiness.patch \
  %D%/packages/patches/guile-gdbm-ffi-support-gdbm-1.14.patch	\
  %D%/packages/patches/guile-git-adjust-for-libgit2-1.2.0.patch \
@@ -1270,7 +1309,6 @@ 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/hedgewars-network-bsd.patch		\
  %D%/packages/patches/helm-fix-gcc-9-build.patch		\
  %D%/packages/patches/http-parser-CVE-2020-8287.patch		\
  %D%/packages/patches/htslib-for-stringtie.patch		\
@@ -1282,7 +1320,6 @@ dist_patch_DATA =						\
  %D%/packages/patches/i7z-gcc-10.patch				\
  %D%/packages/patches/icecat-makeicecat.patch			\
  %D%/packages/patches/icecat-avoid-bundled-libraries.patch	\
-  %D%/packages/patches/icecat-use-older-reveal-hidden-html.patch	\
  %D%/packages/patches/icecat-use-system-graphite2+harfbuzz.patch	\
  %D%/packages/patches/icecat-use-system-media-libs.patch	\
  %D%/packages/patches/icedtea-7-hotspot-aarch64-use-c++98.patch\
@@ -1303,20 +1340,19 @@ dist_patch_DATA =						\
  %D%/packages/patches/irrlicht-link-against-needed-libs.patch	\
  %D%/packages/patches/isl-0.11.1-aarch64-support.patch	\
  %D%/packages/patches/itk-snap-alt-glibc-compat.patch		\
-  %D%/packages/patches/json-c-0.13-CVE-2020-12762.patch	\
-  %D%/packages/patches/json-c-0.12-CVE-2020-12762.patch	\
-  %D%/packages/patches/jsoncpp-pkg-config-version.patch		\
-  %D%/packages/patches/jami-fix-crash-on-quit.patch		\
-  %D%/packages/patches/jami-images-loading.patch		\
-  %D%/packages/patches/jami-memory-usage.patch			\
-  %D%/packages/patches/jami-libclient-audio-managers.patch	\
+  %D%/packages/patches/jami-disable-integration-tests.patch	\
+  %D%/packages/patches/jami-fix-qml-imports.patch		\
+  %D%/packages/patches/jami-fix-unit-tests-build.patch          \
+  %D%/packages/patches/jami-libjami-headers-search.patch	\
+  %D%/packages/patches/jami-no-webengine.patch			\
+  %D%/packages/patches/jami-sip-unregister.patch		\
+  %D%/packages/patches/jami-xcb-link.patch			\
  %D%/packages/patches/jamvm-1.5.1-aarch64-support.patch	\
  %D%/packages/patches/jamvm-1.5.1-armv7-support.patch	\
  %D%/packages/patches/jamvm-2.0.0-aarch64-support.patch	\
  %D%/packages/patches/jamvm-2.0.0-disable-branch-patching.patch	\
  %D%/packages/patches/jamvm-2.0.0-opcode-guard.patch		\
  %D%/packages/patches/java-antlr4-Add-standalone-generator.patch	\
-  %D%/packages/patches/java-antlr4-fix-code-too-large.java	\
  %D%/packages/patches/java-tunnelvisionlabs-antlr-code-too-large.patch	\
  %D%/packages/patches/java-apache-ivy-port-to-latest-bouncycastle.patch	\
  %D%/packages/patches/java-commons-collections-fix-java8.patch \
@@ -1332,33 +1368,34 @@ dist_patch_DATA =						\
  %D%/packages/patches/jfsutils-add-sysmacros.patch		\
  %D%/packages/patches/jfsutils-gcc-compat.patch		\
  %D%/packages/patches/jfsutils-include-systypes.patch		\
+  %D%/packages/patches/json-c-0.13-CVE-2020-12762.patch	\
+  %D%/packages/patches/json-c-0.12-CVE-2020-12762.patch	\
+  %D%/packages/patches/jsoncpp-pkg-config-version.patch		\
  %D%/packages/patches/julia-SOURCE_DATE_EPOCH-mtime.patch	\
  %D%/packages/patches/julia-tracker-16-compat.patch		\
  %D%/packages/patches/julia-allow-parallel-build.patch		\
-  %D%/packages/patches/kdbusaddons-kinit-file-name.patch	\
  %D%/packages/patches/libffi-3.3-powerpc-fixes.patch		\
  %D%/packages/patches/libffi-float128-powerpc64le.patch	\
  %D%/packages/patches/libobjc2-unbundle-robin-map.patch	\
  %D%/packages/patches/librime-fix-build-with-gcc10.patch	\
  %D%/packages/patches/libvirt-add-install-prefix.patch	\
  %D%/packages/patches/libziparchive-add-includes.patch		\
+  %D%/packages/patches/lightdm-arguments-ordering.patch		\
+  %D%/packages/patches/lightdm-vncserver-check.patch		\
+  %D%/packages/patches/lightdm-vnc-color-depth.patch		\
  %D%/packages/patches/localed-xorg-keyboard.patch		\
+  %D%/packages/patches/kcontacts-incorrect-country-name.patch	\
+  %D%/packages/patches/kde-cli-tools-delay-mime-db.patch	\
  %D%/packages/patches/kdiagram-Fix-missing-link-libraries.patch \
  %D%/packages/patches/kiki-level-selection-crash.patch		\
  %D%/packages/patches/kiki-makefile.patch			\
  %D%/packages/patches/kiki-missing-includes.patch		\
  %D%/packages/patches/kiki-portability-64bit.patch		\
  %D%/packages/patches/kinit-kdeinit-extra_libs.patch		\
-  %D%/packages/patches/kinit-kdeinit-libpath.patch		\
  %D%/packages/patches/kio-search-smbd-on-PATH.patch		\
  %D%/packages/patches/kismet-unbundle-boost.patch		\
-  %D%/packages/patches/kmail-Fix-missing-link-libraries.patch \
  %D%/packages/patches/kmod-module-directory.patch		\
  %D%/packages/patches/kmscon-runtime-keymap-switch.patch	\
-  %D%/packages/patches/kpackage-allow-external-paths.patch	\
-  %D%/packages/patches/kpackage-fix-KF5PackageMacros.cmake.patch \
-  %D%/packages/patches/kmplayer-aarch64.patch			\
-  %D%/packages/patches/kmplayer-upstream_Fix-build-with-Qt-5.9.patch	\
  %D%/packages/patches/kobodeluxe-paths.patch			\
  %D%/packages/patches/kobodeluxe-enemies-pipe-decl.patch	\
  %D%/packages/patches/kobodeluxe-const-charp-conversion.patch	\
@@ -1368,11 +1405,8 @@ dist_patch_DATA =						\
  %D%/packages/patches/kodi-increase-test-timeout.patch		\
  %D%/packages/patches/kodi-set-libcurl-ssl-parameters.patch		\
  %D%/packages/patches/kodi-skip-test-449.patch		\
+  %D%/packages/patches/kwayland-skip-flaky-test.patch		\
  %D%/packages/patches/laby-make-install.patch			\
-  %D%/packages/patches/lcalc-default-parameters-1.patch		\
-  %D%/packages/patches/lcalc-default-parameters-2.patch		\
-  %D%/packages/patches/lcalc-lcommon-h.patch    		\
-  %D%/packages/patches/lcalc-using-namespace-std.patch 		\
  %D%/packages/patches/ldns-drill-examples.patch		\
  %D%/packages/patches/leela-zero-gtest.patch			\
  %D%/packages/patches/less-hurd-path-max.patch			\
@@ -1390,7 +1424,10 @@ dist_patch_DATA =						\
  %D%/packages/patches/libcroco-CVE-2020-12825.patch		\
  %D%/packages/patches/libcyaml-libyaml-compat.patch		\
  %D%/packages/patches/libexpected-nofetch.patch                \
-  %D%/packages/patches/libgeotiff-adapt-test-script-for-proj-6.2.patch		\
+  %D%/packages/patches/libgda-cve-2021-39359.patch		\
+  %D%/packages/patches/libgda-fix-build.patch			\
+  %D%/packages/patches/libgda-fix-missing-initialization.patch	\
+  %D%/packages/patches/libgda-skip-postgresql-tests.patch	\
  %D%/packages/patches/libgit2-mtime-0.patch			\
  %D%/packages/patches/libgnome-encoding.patch			\
  %D%/packages/patches/libgnomeui-utf8.patch			\
@@ -1402,6 +1439,7 @@ dist_patch_DATA =						\
  %D%/packages/patches/libofa-ftbfs-2.diff		\
  %D%/packages/patches/libotr-test-auth-fix.patch		\
  %D%/packages/patches/libksieve-Fix-missing-link-libraries.patch \
+  %D%/packages/patches/libksysguard-qdiriterator-follow-symlinks.patch \
  %D%/packages/patches/libmad-armv7-thumb-pt1.patch		\
  %D%/packages/patches/libmad-armv7-thumb-pt2.patch		\
  %D%/packages/patches/libmad-length-check.patch		\
@@ -1412,6 +1450,7 @@ dist_patch_DATA =						\
  %D%/packages/patches/libmpeg2-global-symbol-test.patch	\
  %D%/packages/patches/libmygpo-qt-fix-qt-5.11.patch		\
  %D%/packages/patches/libmygpo-qt-missing-qt5-modules.patch	\
+  %D%/packages/patches/libphonenumber-reproducible-build.patch	\
  %D%/packages/patches/libqalculate-3.8.0-libcurl-ssl-fix.patch	\
  %D%/packages/patches/libquicktime-ffmpeg.patch 		\
  %D%/packages/patches/librecad-support-for-boost-1.76.patch	\
@@ -1420,6 +1459,7 @@ dist_patch_DATA =						\
  %D%/packages/patches/libtgvoip-disable-sse2.patch 		\
  %D%/packages/patches/libtgvoip-disable-webrtc.patch 		\
  %D%/packages/patches/libtheora-config-guess.patch		\
+  %D%/packages/patches/libtirpc-CVE-2021-46828.patch		\
  %D%/packages/patches/libtirpc-hurd.patch			\
  %D%/packages/patches/libtommath-fix-linkage.patch		\
  %D%/packages/patches/libtool-skip-tests2.patch		\
@@ -1434,7 +1474,6 @@ dist_patch_DATA =						\
  %D%/packages/patches/libxml2-terminating-newline.patch	\
  %D%/packages/patches/libxml2-xpath-recursion-limit.patch	\
  %D%/packages/patches/libxml2-xpath0-Add-option-xpath0.patch	\
-  %D%/packages/patches/libxmlb-install-xb-tool-into-bindir.patch \
  %D%/packages/patches/libxslt-generated-ids.patch		\
  %D%/packages/patches/libxt-guix-search-paths.patch		\
  %D%/packages/patches/lierolibre-check-unaligned-access.patch	\
@@ -1443,7 +1482,8 @@ 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/linphone-desktop-without-sdk.patch           \
+  %D%/packages/patches/linphone-desktop-without-sdk.patch	\
+  %D%/packages/patches/linux-libre-infodocs-target.patch	\
  %D%/packages/patches/linux-libre-support-for-Pinebook-Pro.patch \
  %D%/packages/patches/linux-pam-no-setfsuid.patch		\
  %D%/packages/patches/linuxdcpp-openssl-1.1.patch		\
@@ -1452,13 +1492,14 @@ dist_patch_DATA =						\
  %D%/packages/patches/llhttp-bootstrap-CVE-2020-8287.patch	\
  %D%/packages/patches/llvm-3.5-fix-clang-build-with-gcc5.patch	\
  %D%/packages/patches/llvm-3.6-fix-build-with-gcc-10.patch	\
+  %D%/packages/patches/llvm-3.x.1-fix-build-with-gcc.patch	\
+  %D%/packages/patches/llvm-8-fix-build-with-gcc-10.patch	\
  %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-4.0.0-remove-isystem-usr-include.patch \
  %D%/packages/patches/llvm-roc-5.0.0-linkdl.patch \
  %D%/packages/patches/lm-sensors-hwmon-attrs.patch		\
-  %D%/packages/patches/lrcalc-includes.patch    		\
  %D%/packages/patches/lsh-fix-x11-forwarding.patch		\
  %D%/packages/patches/lsof-fatal-test-failures.patch		\
  %D%/packages/patches/lua-CVE-2014-5461.patch                      \
@@ -1468,7 +1509,6 @@ dist_patch_DATA =						\
  %D%/packages/patches/lua-liblua-so.patch                      \
  %D%/packages/patches/lua-5.4-pkgconfig.patch			\
  %D%/packages/patches/lua-5.4-liblua-so.patch			\
-  %D%/packages/patches/luajit-no_ldconfig.patch			\
  %D%/packages/patches/luit-posix.patch				\
  %D%/packages/patches/lvm2-static-link.patch			\
  %D%/packages/patches/mailutils-variable-lookup.patch		\
@@ -1490,12 +1530,17 @@ dist_patch_DATA =						\
  %D%/packages/patches/libmemcached-build-with-gcc7.patch	\
  %D%/packages/patches/libmhash-hmac-fix-uaf.patch		\
  %D%/packages/patches/libsigrokdecode-python3.9-fix.patch	\
-  %D%/packages/patches/mercurial-hg-extension-path.patch       \
+  %D%/packages/patches/memtest86+-build-reproducibly.patch	\
+  %D%/packages/patches/mercurial-hg-extension-path.patch	\
+  %D%/packages/patches/mercurial-openssl-compat.patch		\
  %D%/packages/patches/mesa-opencl-all-targets.patch		\
  %D%/packages/patches/mesa-skip-tests.patch			\
  %D%/packages/patches/meson-allow-dirs-outside-of-prefix.patch	\
  %D%/packages/patches/mhash-keygen-test-segfault.patch		\
  %D%/packages/patches/mia-fix-boost-headers.patch		\
+  %D%/packages/patches/mia-vtk9.patch				\
+  %D%/packages/patches/mia-vtk92.patch				\
+  %D%/packages/patches/mia-vtk-version.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	\
@@ -1509,20 +1554,15 @@ dist_patch_DATA =						\
  %D%/packages/patches/mpg321-gcc-10.patch			\
  %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/mrrescue-support-love-11.patch		\
  %D%/packages/patches/mtools-mformat-uninitialized.patch	\
-  %D%/packages/patches/mumps-build-parallelism.patch		\
-  %D%/packages/patches/mumps-shared-libseq.patch		\
-  %D%/packages/patches/mumps-shared-mumps.patch			\
-  %D%/packages/patches/mumps-shared-pord.patch			\
  %D%/packages/patches/mupen64plus-ui-console-notice.patch	\
  %D%/packages/patches/mupen64plus-video-z64-glew-correct-path.patch    \
  %D%/packages/patches/musl-cross-locale.patch			\
  %D%/packages/patches/mutt-store-references.patch		\
  %D%/packages/patches/m4-gnulib-libio.patch			\
-  %D%/packages/patches/nautilus-add-libportal-gtk3.patch	\
+  %D%/packages/patches/nautilus-extension-search-path.patch	\
  %D%/packages/patches/ncompress-fix-softlinks.patch		\
  %D%/packages/patches/ncftp-reproducible.patch			\
  %D%/packages/patches/netcdf-date-time.patch			\
@@ -1542,7 +1582,6 @@ dist_patch_DATA =						\
  %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-getcwd-nonnull.patch			\
  %D%/packages/patches/nss-increase-test-timeout.patch		\
  %D%/packages/patches/nss-3.56-pkgconfig.patch			\
@@ -1550,6 +1589,7 @@ dist_patch_DATA =						\
  %D%/packages/patches/nvi-dbpagesize-binpower.patch		\
  %D%/packages/patches/nvi-db4.patch				\
  %D%/packages/patches/nyacc-binary-literals.patch		\
+  %D%/packages/patches/oath-toolkit-xmlsec-compat.patch		\
  %D%/packages/patches/obs-modules-location.patch		\
  %D%/packages/patches/ocaml-dose3-add-unix-dependency.patch	\
  %D%/packages/patches/ocaml-dose3-Fix-for-ocaml-4.06.patch	\
@@ -1591,12 +1631,13 @@ dist_patch_DATA =						\
  %D%/packages/patches/password-store-tree-compat.patch		\
  %D%/packages/patches/pciutils-hurd-configure.patch		\
  %D%/packages/patches/pciutils-hurd-fix.patch			\
-  %D%/packages/patches/pitivi-fix-build-with-meson-0.60.patch	\
-  %D%/packages/patches/pjproject-install-libpjsua2.patch	\
  %D%/packages/patches/plasma-framework-fix-KF5PlasmaMacros.cmake.patch \
+  %D%/packages/patches/pocketfft-cpp-prefer-preprocessor-if.patch			\
+  %D%/packages/patches/pokerth-boost.patch			\
  %D%/packages/patches/ppsspp-disable-upgrade-and-gold.patch		\
  %D%/packages/patches/pthreadpool-system-libraries.patch	\
  %D%/packages/patches/python-chai-drop-python2.patch		\
+  %D%/packages/patches/python-louvain-fix-test.patch		\
  %D%/packages/patches/python-random2-getrandbits-test.patch		\
  %D%/packages/patches/python-poppler-qt5-fix-build.patch	\
  %D%/packages/patches/python-w3lib-fix-test-failure.patch	\
@@ -1617,6 +1658,7 @@ dist_patch_DATA =						\
  %D%/packages/patches/perl-5.14-module-pluggable-search.patch	\
  %D%/packages/patches/perl-5.14-no-sys-dirs.patch		\
  %D%/packages/patches/perl-autosplit-default-time.patch	\
+  %D%/packages/patches/perl-class-methodmaker-reproducible.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-net-amazon-s3-moose-warning.patch	\
@@ -1628,9 +1670,8 @@ dist_patch_DATA =						\
  %D%/packages/patches/perl-www-curl-fix-struct-void.patch	\
  %D%/packages/patches/perl-www-curl-remove-symbol.patch	\
  %D%/packages/patches/phoronix-test-suite-fsdg.patch		\
-  %D%/packages/patches/php-bug-74093-test.patch \
-  %D%/packages/patches/php-openssl_x509_checkpurpose_basic.patch	\
-  %D%/packages/patches/picard-fix-id3-rename-test.patch		\
+  %D%/packages/patches/php-bug-74093-test.patch			\
+  %D%/packages/patches/php-curl-compat.patch			\
  %D%/packages/patches/picprog-non-intel-support.patch		\
  %D%/packages/patches/pidgin-add-search-path.patch		\
  %D%/packages/patches/pinball-system-ltdl.patch		\
@@ -1643,21 +1684,18 @@ 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-4034.patch		\
-  %D%/packages/patches/polkit-configure-elogind.patch		\
-  %D%/packages/patches/polkit-use-duktape.patch			\
+  %D%/packages/patches/polkit-disable-systemd.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/postgresql-riscv-spinlocks.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/protobuf-fix-build-on-32bit.patch	\
  %D%/packages/patches/psm-arch.patch				\
  %D%/packages/patches/psm-disable-memory-stats.patch		\
  %D%/packages/patches/psm-ldflags.patch			\
  %D%/packages/patches/psm-repro.patch				\
-  %D%/packages/patches/public-inbox-fix-spawn-test.patch	\
  %D%/packages/patches/pulseaudio-fix-mult-test.patch		\
  %D%/packages/patches/pulseaudio-longer-test-timeout.patch	\
  %D%/packages/patches/pulseview-qt515-compat.patch		\
@@ -1679,10 +1717,12 @@ dist_patch_DATA =						\
  %D%/packages/patches/python-3-fix-tests.patch			\
  %D%/packages/patches/python-3-hurd-configure.patch		\
  %D%/packages/patches/python-3-no-static-lib.patch		\
+  %D%/packages/patches/python-apsw-3.39.2.1-test-fix.patch	\
  %D%/packages/patches/python-aionotify-0.2.0-py3.8.patch	\
  %D%/packages/patches/python-argcomplete-1.11.1-fish31.patch	\
  %D%/packages/patches/python-cross-compile.patch		\
  %D%/packages/patches/python-configobj-setuptools.patch	\
+  %D%/packages/patches/python-dateutil-pytest-compat.patch	\
  %D%/packages/patches/python-debugpy-unbundle-pydevd.patch	\
  %D%/packages/patches/python-docopt-pytest6-compat.patch	\
  %D%/packages/patches/python-execnet-read-only-fix.patch	\
@@ -1724,10 +1764,9 @@ dist_patch_DATA =						\
  %D%/packages/patches/python-versioneer-guix-support.patch	\
  %D%/packages/patches/python-waitress-fix-tests.patch		\
  %D%/packages/patches/python-werkzeug-tests.patch		\
-  %D%/packages/patches/python-mypy-12332.patch			\
-  %D%/packages/patches/python-mypy-use-sys-path.patch		\
  %D%/packages/patches/python-zeep-Fix-pytest_httpx-test-cases.patch	\
  %D%/packages/patches/qemu-build-info-manual.patch		\
+  %D%/packages/patches/qemu-disable-aarch64-migration-test.patch	\
  %D%/packages/patches/qemu-glibc-2.27.patch 			\
  %D%/packages/patches/qemu-glibc-2.30.patch 			\
  %D%/packages/patches/qemu-fix-agent-paths.patch 		\
@@ -1739,6 +1778,7 @@ dist_patch_DATA =						\
  %D%/packages/patches/qtscript-disable-tests.patch		\
  %D%/packages/patches/quagga-reproducible-build.patch          \
  %D%/packages/patches/quickswitch-fix-dmenu-check.patch	\
+  %D%/packages/patches/qtwayland-gcc-11.patch			\
  %D%/packages/patches/qtwebkit-pbutils-include.patch		\
  %D%/packages/patches/qtwebkit-fix-building-with-bison-3.7.patch \
  %D%/packages/patches/qtwebkit-fix-building-with-python-3.9.patch	\
@@ -1756,24 +1796,33 @@ dist_patch_DATA =						\
  %D%/packages/patches/readline-6.2-CVE-2014-2524.patch		\
  %D%/packages/patches/renpy-use-system-fribidi.patch		\
  %D%/packages/patches/reposurgeon-add-missing-docbook-files.patch	\
-  %D%/packages/patches/r-httpuv-1.5.5-unvendor-libuv.patch	\
+  %D%/packages/patches/r-httpuv-1.6.6-unvendor-libuv.patch	\
  %D%/packages/patches/ri-li-modernize_cpp.patch		\
  %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-minimal-sh-via-rktio.patch	\
+  %D%/packages/patches/racket-backport-8.7-pkg-strip.patch	\
+  %D%/packages/patches/racket-chez-scheme-bin-sh.patch		\
+  %D%/packages/patches/racket-rktio-bin-sh.patch		\
+  %D%/packages/patches/racket-zuo-bin-sh.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/r-mixedpower-r2power.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-4.3-noclinfo.patch \
-  %D%/packages/patches/rocm-opencl-runtime-4.3-noopencl.patch \
+  %D%/packages/patches/rocm-comgr-3.1.0-dependencies.patch 	\
+  %D%/packages/patches/rocm-opencl-runtime-4.3-noclinfo.patch 	\
+  %D%/packages/patches/rocm-opencl-runtime-4.3-noopencl.patch 	\
+  %D%/packages/patches/rottlog-direntry.patch 			\
+  %D%/packages/patches/ruby-hydra-minimal-no-byebug.patch	\
+  %D%/packages/patches/ruby-anystyle-data-immutable-install.patch	\
+  %D%/packages/patches/ruby-anystyle-fix-dictionary-populate.patch	\
+  %D%/packages/patches/ruby-latex-decode-fix-test.patch		\
  %D%/packages/patches/ruby-mustache-1.1.1-fix-race-condition-tests.patch \
  %D%/packages/patches/ruby-sanitize-system-libxml.patch	\
-  %D%/packages/patches/rustc-1.39.0-src.patch			\
+  %D%/packages/patches/rustc-1.54.0-src.patch			\
  %D%/packages/patches/rust-adblock-ignore-live-tests.patch		\
  %D%/packages/patches/i3status-rust-enable-unstable-features.patch	\
  %D%/packages/patches/rust-ndarray-remove-blas-src-dep.patch	\
@@ -1782,18 +1831,17 @@ dist_patch_DATA =						\
  %D%/packages/patches/rust-nettle-disable-vendor.patch		 \
  %D%/packages/patches/rust-nettle-sys-disable-vendor.patch	 \
  %D%/packages/patches/rust-openssl-sys-no-vendor.patch	\
-  %D%/packages/patches/rust-shell2batch-lint-fix.patch		\
  %D%/packages/patches/rust-wl-clipboard-rs-newer-wl.patch      \
  %D%/packages/patches/sbc-fix-build-non-x86.patch		\
  %D%/packages/patches/sbcl-aserve-add-HTML-5-elements.patch	\
  %D%/packages/patches/sbcl-aserve-fix-rfe12668.patch	\
  %D%/packages/patches/sbcl-burgled-batteries3-fix-signals.patch	\
  %D%/packages/patches/sbcl-clml-fix-types.patch		\
+  %D%/packages/patches/sbcl-fix-build-on-arm64-with-clisp-as-host.patch	\
  %D%/packages/patches/sbcl-png-fix-sbcl-compatibility.patch	\
  %D%/packages/patches/scalapack-gcc-10-compilation.patch	\
  %D%/packages/patches/scheme48-tests.patch			\
-  %D%/packages/patches/scotch-build-parallelism.patch		\
-  %D%/packages/patches/scotch-integer-declarations.patch	\
+  %D%/packages/patches/scons-test-environment.patch		\
  %D%/packages/patches/screen-hurd-path-max.patch		\
  %D%/packages/patches/sdl-libx11-1.6.patch			\
  %D%/packages/patches/seed-webkit.patch			\
@@ -1805,17 +1853,19 @@ dist_patch_DATA =						\
  %D%/packages/patches/serf-python3.patch			\
  %D%/packages/patches/shakespeare-spl-fix-grammar.patch		\
  %D%/packages/patches/sharutils-CVE-2018-1000097.patch		\
-  %D%/packages/patches/shishi-fix-libgcrypt-detection.patch	\
  %D%/packages/patches/slim-session.patch			\
  %D%/packages/patches/slim-config.patch			\
  %D%/packages/patches/slim-sigusr1.patch			\
  %D%/packages/patches/slim-reset.patch				\
  %D%/packages/patches/slim-login.patch				\
  %D%/packages/patches/slim-display.patch			\
+  %D%/packages/patches/stex-copy-from-immutable-store.patch	\
  %D%/packages/patches/syslinux-gcc10.patch			\
  %D%/packages/patches/syslinux-strip-gnu-property.patch	\
  %D%/packages/patches/snappy-add-O2-flag-in-CmakeLists.txt.patch	\
  %D%/packages/patches/snappy-add-inline-for-GCC.patch		\
+  %D%/packages/patches/spectre-meltdown-checker-externalize-fwdb.patch \
+  %D%/packages/patches/spectre-meltdown-checker-find-kernel.patch \
  %D%/packages/patches/sphinxbase-fix-doxygen.patch		\
  %D%/packages/patches/spice-vdagent-glib-2.68.patch		\
  %D%/packages/patches/sssd-optional-systemd.patch		\
@@ -1839,18 +1889,19 @@ dist_patch_DATA =						\
  %D%/packages/patches/tao-fix-parser-types.patch		\
  %D%/packages/patches/tar-remove-wholesparse-check.patch	\
  %D%/packages/patches/tar-skip-unreliable-tests.patch		\
-  %D%/packages/patches/tbb-fix-test-on-aarch64.patch		\
+  %D%/packages/patches/tbb-other-arches.patch			\
  %D%/packages/patches/tclxml-3.2-install.patch			\
  %D%/packages/patches/tcsh-fix-autotest.patch			\
  %D%/packages/patches/teensy-loader-cli-help.patch		\
  %D%/packages/patches/tensorflow-c-api-fix.patch		\
  %D%/packages/patches/texinfo-5-perl-compat.patch		\
+  %D%/packages/patches/telegram-desktop-allow-disable-libtgvoip.patch   \
  %D%/packages/patches/telegram-purple-adjust-test.patch	\
  %D%/packages/patches/texi2html-document-encoding.patch	\
  %D%/packages/patches/texi2html-i18n.patch			\
+  %D%/packages/patches/texlive-hyph-utf8-no-byebug.patch	\
  %D%/packages/patches/thefuck-test-environ.patch		\
  %D%/packages/patches/tidy-CVE-2015-5522+5523.patch		\
-  %D%/packages/patches/timescaledb-flaky-test.patch		\
  %D%/packages/patches/tinyxml-use-stl.patch			\
  %D%/packages/patches/tipp10-disable-downloader.patch		\
  %D%/packages/patches/tipp10-fix-compiling.patch		\
@@ -1868,6 +1919,8 @@ dist_patch_DATA =						\
  %D%/packages/patches/trytond-add-guix_trytond_path.patch	\
  %D%/packages/patches/ttf2eot-cstddef.patch			\
  %D%/packages/patches/tup-unbundle-dependencies.patch		\
+  %D%/packages/patches/turbovnc-custom-paths.patch		\
+  %D%/packages/patches/turbovnc-find-system-packages.patch	\
  %D%/packages/patches/tuxpaint-stamps-path.patch		\
  %D%/packages/patches/twinkle-bcg729.patch			\
  %D%/packages/patches/u-boot-allow-disabling-openssl.patch	\
@@ -1876,6 +1929,7 @@ dist_patch_DATA =						\
  %D%/packages/patches/u-boot-sifive-prevent-reloc-initrd-fdt.patch	\
  %D%/packages/patches/u-boot-rk3399-enable-emmc-phy.patch	\
  %D%/packages/patches/ucx-tcp-iface-ioctl.patch		\
+  %D%/packages/patches/ultrastar-deluxe-no-freesans.patch		\
  %D%/packages/patches/ungoogled-chromium-extension-search-path.patch	\
  %D%/packages/patches/ungoogled-chromium-ffmpeg-compat.patch	\
  %D%/packages/patches/ungoogled-chromium-RUNPATH.patch		\
@@ -1889,6 +1943,7 @@ dist_patch_DATA =						\
  %D%/packages/patches/unzip-CVE-2014-9636.patch		\
  %D%/packages/patches/unzip-CVE-2015-7696.patch		\
  %D%/packages/patches/unzip-CVE-2015-7697.patch		\
+  %D%/packages/patches/unzip-CVE-2022-0529+CVE-2022-0530.patch	\
  %D%/packages/patches/unzip-allow-greater-hostver-values.patch	\
  %D%/packages/patches/unzip-attribs-overflow.patch		\
  %D%/packages/patches/unzip-overflow-on-invalid-input.patch	\
@@ -1916,7 +1971,6 @@ dist_patch_DATA =						\
  %D%/packages/patches/unzip-zipbomb-part2.patch		\
  %D%/packages/patches/unzip-zipbomb-part3.patch		\
  %D%/packages/patches/unzip-32bit-zipbomb-fix.patch    \
-  %D%/packages/patches/upx-CVE-2021-20285.patch		\
  %D%/packages/patches/ustr-fix-build-with-gcc-5.patch		\
  %D%/packages/patches/util-linux-tests.patch			\
  %D%/packages/patches/util-linux-CVE-2021-3995.patch		\
@@ -1933,13 +1987,15 @@ dist_patch_DATA =						\
  %D%/packages/patches/vsearch-unbundle-cityhash.patch		\
  %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-7-gcc-10-compat.patch		\
  %D%/packages/patches/vtk-7-hdf5-compat.patch			\
  %D%/packages/patches/vtk-7-python-compat.patch		\
+  %D%/packages/patches/wacomtablet-add-missing-includes.patch	\
+  %D%/packages/patches/wacomtablet-qt5.15.patch			\
  %D%/packages/patches/warsow-qfusion-fix-bool-return-type.patch	\
  %D%/packages/patches/webkitgtk-adjust-bubblewrap-paths.patch	\
  %D%/packages/patches/webrtc-audio-processing-big-endian.patch	\
+  %D%/packages/patches/webrtc-for-telegram-desktop-fix-gcc12-cstdint.patch   \
  %D%/packages/patches/websocketpp-fix-for-cmake-3.15.patch	\
  %D%/packages/patches/widelands-add-missing-map-include.patch	\
  %D%/packages/patches/widelands-system-wide_minizip.patch	\
@@ -1951,8 +2007,6 @@ dist_patch_DATA =						\
  %D%/packages/patches/x265-arm-flags.patch			\
  %D%/packages/patches/xdg-desktop-portal-wlr-harcoded-length.patch\
  %D%/packages/patches/xf86-video-ark-remove-mibstore.patch	\
-  %D%/packages/patches/xf86-video-mach64-bool-to-boolean.patch	\
-  %D%/packages/patches/xf86-video-mach64-glibc-2.20.patch	\
  %D%/packages/patches/xf86-video-nouveau-fixup-ABI.patch	\
  %D%/packages/patches/xf86-video-qxl-fix-build.patch	\
  %D%/packages/patches/xf86-video-savage-xorg-compat.patch 	\
@@ -1,6 +1,8 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org>
 ;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
+;;; Copyright © 2022 Matthew James Kraai <kraai@ftbfs.org>
+;;; Copyright © 2022 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,6 +23,7 @@
  #:use-module (gnu machine ssh)
  #:use-module (gnu machine)
  #:use-module (gnu services)
+  #:use-module (gnu services base)
  #:use-module (gnu services networking)
  #:use-module (gnu system)
  #:use-module (gnu system pam)
@@ -33,7 +36,9 @@
  #:use-module (guix records)
  #:use-module (guix ssh)
  #:use-module (guix store)
+  #:use-module (ice-9 format)
  #:use-module (ice-9 iconv)
+  #:use-module (ice-9 string-fun)
  #:use-module (json)
  #:use-module (rnrs bytevectors)
  #:use-module (srfi srfi-1)
@@ -187,18 +192,66 @@ an environment type of 'digital-ocean-environment-type'."
 ;;; System deployment.
 ;;;

+;; XXX Copied from (gnu services base)
+(define* (ip+netmask->cidr ip netmask #:optional (family AF_INET))
+  "Return the CIDR notation (a string) for @var{ip} and @var{netmask}, two
+@var{family} address strings, where @var{family} is @code{AF_INET} or
+@code{AF_INET6}."
+  (let* ((netmask (inet-pton family netmask))
+         (bits    (logcount netmask)))
+    (string-append ip "/" (number->string bits))))
+
 ;; The following script was adapted from the guide available at
 ;; <https://wiki.pantherx.org/Installation-digital-ocean/>.
 (define (guix-infect network)
  "Given NETWORK, an alist describing the Droplet's public IPv4 network
 interface, return a Bash script that will install the Guix system."
+  (define os
+    `(operating-system
+       (host-name "gnu-bootstrap")
+       (timezone "Etc/UTC")
+       (bootloader (bootloader-configuration
+                    (bootloader grub-bootloader)
+                    (targets '("/dev/vda"))
+                    (terminal-outputs '(console))))
+       (file-systems (cons (file-system
+                             (mount-point "/")
+                             (device "/dev/vda1")
+                             (type "ext4"))
+                           %base-file-systems))
+       (services
+        (append (list (service static-networking-service-type
+                               (list (static-networking
+                                      (addresses
+                                       (list (network-address
+                                              (device "eth0")
+                                              (value ,(ip+netmask->cidr
+                                                       (assoc-ref network "ip_address")
+                                                       (assoc-ref network "netmask"))))))
+                                      (routes
+                                       (list (network-route
+                                              (destination "default")
+                                              (gateway ,(assoc-ref network "gateway")))))
+                                      (name-servers '("84.200.69.80" "84.200.70.40")))))
+                      (simple-service 'guile-load-path-in-global-env
+                                      session-environment-service-type
+                                      `(("GUILE_LOAD_PATH"
+                                         . "/run/current-system/profile/share/guile/site/3.0")
+                                        ("GUILE_LOAD_COMPILED_PATH"
+                                         . ,(string-append "/run/current-system/profile/lib/guile/3.0/site-ccache:"
+                                                           "/run/current-system/profile/share/guile/site/3.0"))))
+                      (service openssh-service-type
+                               (openssh-configuration
+                                (log-level 'debug)
+                                (permit-root-login 'prohibit-password))))
+            %base-services))))
  (format #f "#!/bin/bash

 apt-get update
 apt-get install xz-utils -y
-wget https://ftp.gnu.org/gnu/guix/guix-binary-1.0.1.x86_64-linux.tar.xz
+wget -nv https://ci.guix.gnu.org/search/latest/archive?query=spec:tarball+status:success+system:x86_64-linux+guix-binary.tar.xz -O guix-binary-nightly.x86_64-linux.tar.xz
 cd /tmp
-tar --warning=no-timestamp -xf ~~/guix-binary-1.0.1.x86_64-linux.tar.xz
+tar --warning=no-timestamp -xf ~~/guix-binary-nightly.x86_64-linux.tar.xz
 mv var/guix /var/ && mv gnu /
 mkdir -p ~~root/.config/guix
 ln -sf /var/guix/profiles/per-user/root/current-guix ~~root/.config/guix/current
@@ -228,37 +281,9 @@ export GUIX_LOCPATH=\"$HOME/.guix-profile/lib/locale\"
 guix package -i openssl
 cat > /etc/bootstrap-config.scm << EOF
 (use-modules (gnu))
-(use-service-modules networking ssh)
+(use-service-modules base networking ssh)

-(operating-system
-  (host-name \"gnu-bootstrap\")
-  (timezone \"Etc/UTC\")
-  (bootloader (bootloader-configuration
-               (bootloader grub-bootloader)
-               (targets '(\"/dev/vda\"))
-               (terminal-outputs '(console))))
-  (file-systems (cons (file-system
-                        (mount-point \"/\")
-                        (device \"/dev/vda1\")
-                        (type \"ext4\"))
-                      %base-file-systems))
-  (services
-   (append (list (static-networking-service \"eth0\" \"~a\"
-                    #:netmask \"~a\"
-                    #:gateway \"~a\"
-                    #:name-servers '(\"84.200.69.80\" \"84.200.70.40\"))
-                 (simple-service 'guile-load-path-in-global-env
-                  session-environment-service-type
-                  \\`((\"GUILE_LOAD_PATH\"
-                     . \"/run/current-system/profile/share/guile/site/2.2\")
-                    (\"GUILE_LOAD_COMPILED_PATH\"
-                     . ,(string-append \"/run/current-system/profile/lib/guile/2.2/site-ccache:\"
-                                       \"/run/current-system/profile/share/guile/site/2.2\"))))
-                 (service openssh-service-type
-                          (openssh-configuration
-                           (log-level 'debug)
-                           (permit-root-login 'prohibit-password))))
-           %base-services)))
+~a
 EOF
 # guix pull
 guix system build /etc/bootstrap-config.scm
@@ -267,9 +292,9 @@ mv /etc /old-etc
 mkdir /etc
 cp -r /old-etc/{passwd,group,shadow,gshadow,mtab,guix,bootstrap-config.scm} /etc/
 guix system reconfigure /etc/bootstrap-config.scm"
-          (assoc-ref network "ip_address")
-          (assoc-ref network "netmask")
-          (assoc-ref network "gateway")))
+          ;; Escape the bare backtick to avoid having it interpreted by Bash.
+          (string-replace-substring
+           (format #f "~y" os) "`" "\\`")))

 (define (machine-wait-until-available machine)
  "Block until the initial Debian image has been installed on the droplet
@@ -300,18 +325,26 @@ named DROPLET-NAME."
 configuration for the public IPv4 network described by the alist NETWORK."
  (operating-system
    (inherit (machine-operating-system target))
-    (services (cons* (static-networking-service "eth0"
-                        (assoc-ref network "ip_address")
-                        #:netmask (assoc-ref network "netmask")
-                        #:gateway (assoc-ref network "gateway")
-                        #:name-servers '("84.200.69.80" "84.200.70.40"))
+    (services (cons* (service static-networking-service-type
+                              (list (static-networking
+                                     (addresses
+                                      (list (network-address
+                                             (device "eth0")
+                                             (value (ip+netmask->cidr
+                                                     (assoc-ref network "ip_address")
+                                                     (assoc-ref network "netmask"))))))
+                                     (routes
+                                      (list (network-route
+                                             (destination "default")
+                                             (gateway (assoc-ref network "gateway")))))
+                                     (name-servers '("84.200.69.80" "84.200.70.40")))))
                    (simple-service 'guile-load-path-in-global-env
                                    session-environment-service-type
                                    `(("GUILE_LOAD_PATH"
-                                       . "/run/current-system/profile/share/guile/site/2.2")
+                                       . "/run/current-system/profile/share/guile/site/3.0")
                                      ("GUILE_LOAD_COMPILED_PATH"
-                                       . ,(string-append "/run/current-system/profile/lib/guile/2.2/site-ccache:"
-                                                         "/run/current-system/profile/share/guile/site/2.2"))))
+                                       . ,(string-append "/run/current-system/profile/lib/guile/3.0/site-ccache:"
+                                                         "/run/current-system/profile/share/guile/site/3.0"))))
                    (operating-system-user-services
                     (machine-operating-system target))))))

@@ -407,7 +440,7 @@ environment type of 'digital-ocean-environment-type'."
    (raise (condition
            (&message
             (message (G_ "No Digital Ocean access token was provided. This \
-may be fixed by setting the environment variable GUIX_DIGITAL_OCAEN_TOKEN to \
+may be fixed by setting the environment variable GUIX_DIGITAL_OCEAN_TOKEN to \
 one procured from https://cloud.digitalocean.com/account/api/tokens.")))))))

 (define (maybe-raise-unsupported-configuration-error machine)
@@ -42,6 +42,7 @@
  #:use-module ((guix inferior)
                #:select (inferior-exception?
                          inferior-exception-arguments))
+  #:use-module ((guix platform) #:select (systems))
  #:use-module (gcrypt pk-crypto)
  #:use-module (ice-9 format)
  #:use-module (ice-9 match)
@@ -86,7 +87,8 @@
  machine-ssh-configuration?
  this-machine-ssh-configuration
  (host-name      machine-ssh-configuration-host-name)     ; string
-  (system         machine-ssh-configuration-system)        ; string
+  (system         machine-ssh-configuration-system         ; string
+                  (sanitize validate-system-type))
  (build-locally? machine-ssh-configuration-build-locally? ; boolean
                  (default #t))
  (authorize?     machine-ssh-configuration-authorize?     ; boolean
@@ -109,6 +111,32 @@
  (host-key       machine-ssh-configuration-host-key       ; #f | string
                  (default #f)))

+(define-with-syntax-properties (validate-system-type (value properties))
+  ;; Raise an error if VALUE is not a valid system type.
+  (unless (string? value)
+    (raise (make-compound-condition
+            (condition
+             (&error-location
+              (location (source-properties->location properties))))
+            (formatted-message
+             (G_ "~a: invalid system type; must be a string")
+             value))))
+  (unless (member value (systems))
+    (raise (apply make-compound-condition
+                  (condition
+                   (&error-location
+                    (location (source-properties->location properties))))
+                  (formatted-message (G_ "~a: unknown system type") value)
+                  (let ((closest (string-closest value (systems)
+                                                 #:threshold 5)))
+                    (if closest
+                        (list (condition
+                               (&fix-hint
+                                (hint (format #f (G_ "Did you mean @code{~a}?")
+                                              closest)))))
+                        '())))))
+  value)
+
 (define (open-machine-ssh-session config)
  "Open an SSH session for CONFIG, a <machine-ssh-configuration> record."
  (let ((host-name (machine-ssh-configuration-host-name config))
@@ -339,9 +367,13 @@ by MACHINE."
  "Raise a '&message' error condition if it is clear that deploying MACHINE's
 'system' declaration would fail."
  (define assertions
-    (append (machine-check-file-system-availability machine)
-            (machine-check-initrd-modules machine)
-            (list (machine-check-forward-update machine))))
+    (parameterize ((%current-system
+                    (machine-ssh-configuration-system
+                     (machine-configuration machine)))
+                   (%current-target-system #f))
+      (append (machine-check-file-system-availability machine)
+              (machine-check-initrd-modules machine)
+              (list (machine-check-forward-update machine)))))

  (define aggregate-exp
    ;; Gather all the expressions so that a single round-trip is enough to
@@ -453,12 +485,16 @@ the 'should-roll-back' field set to SHOULD-ROLL-BACK?"
 (define (deploy-managed-host machine)
  "Internal implementation of 'deploy-machine' for MACHINE instances with an
 environment type of 'managed-host."
+  (define config (machine-configuration machine))
+  (define host   (machine-ssh-configuration-host-name config))
+  (define system (machine-ssh-configuration-system config))
+
  (maybe-raise-unsupported-configuration-error machine)
  (when (machine-ssh-configuration-authorize?
         (machine-configuration machine))
    (unless (file-exists? %public-key-file)
      (raise (formatted-message (G_ "no signing key '~a'. \
-have you run 'guix archive --generate-key?'")
+Have you run 'guix archive --generate-key'?")
                                %public-key-file)))
    (remote-authorize-signing-key (call-with-input-file %public-key-file
                                    (lambda (port)
@@ -466,50 +502,54 @@ have you run 'guix archive --generate-key?'")
                                       (get-string-all port))))
                                  (machine-ssh-session machine)
                                  (machine-become-command machine)))
+
  (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)))))
+    ;; Make sure code that check %CURRENT-SYSTEM, such as
+    ;; %BASE-INITRD-MODULES, gets to see the right value.
+    (parameterize ((%current-system system)
+                   (%current-target-system #f))
+      (let* ((os (machine-operating-system 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)
+                                        #:system system)
+                        store)))))

-      (mbegin %store-monad
-        (with-roll-back #f
-          (switch-to-system (eval/error-handling c
-                              (raise (formatted-message
-                                      (G_ "\
+        (mbegin %store-monad
+          (with-roll-back #f
+            (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/error-handling c
-                                         (warning (G_ "\
+                                        host
+                                        (inferior-exception-arguments c))))
+                              os))
+          (with-roll-back #t
+            (mbegin %store-monad
+              (upgrade-shepherd-services (eval/error-handling c
+                                           (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_ "\
+                                                    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)))))))
+                                            host
+                                            (inferior-exception-arguments c))))
+                                  bootloader-configuration bootcfg))))))))


 ;;;
@@ -4,6 +4,7 @@
 ;;; Copyright © 2018, 2021, 2022 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2019 Andrew Miloradovsky <andrew@interpretmath.pw>
 ;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2022 Hunter Jozwiak <hunter.t.joz@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -28,6 +29,7 @@
  #:use-module (guix git-download)
  #:use-module (guix build-system gnu)
  #:use-module (guix build-system glib-or-gtk)
+  #:use-module (guix build-system meson)
  #:use-module (gnu packages)
  #:use-module (gnu packages lisp)
  #:use-module (gnu packages ocaml)
@@ -316,3 +318,34 @@ works with every X Window System based GUI (depends only on libX11); or as an
 assistant for graphic designers, who need to select individual pixels.")
    ;; Licensed either under Expat or GPLv2+.
    (license (list license:expat license:gpl2+))))
+
+(define-public espeakup
+  (package
+    (name "espeakup")
+    (version "0.90")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url "https://github.com/linux-speakup/espeakup")
+                    (commit (string-append "v" version))))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32
+                "0lmjwafvfxy07zn18v3dzjwwpnid2xffgvy2dzlwkbns8gb60ds2"))))
+    (build-system meson-build-system)
+    (native-inputs (list pkg-config))
+    (inputs (list espeak-ng alsa-lib))
+    (license license:gpl3+)
+    (synopsis "Bridge for espeak and speakup")
+    (description
+     "Espeakup is a bridge between the speakup driver implemented in
+the Linux kernel and the espeak-ng text to speech synthesizer.
+In order for this package to work, you need to have the following
+kernel modules built:
+@itemize @bullet
+@item
+CONFIG_SPEAKUP=m
+@item
+CONFIG_SPEAKUP_SOFT=m
+@end itemize")
+    (home-page "ttps://github.com/linux-speakup/espeakup")))
@@ -2,7 +2,7 @@
 ;;; Copyright © 2014 John Darringon <jmd@gnu.org>
 ;;; Copyright © 2016, 2020, 2021 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2017 Hartmut Goebel <h.goebel@crazy-compilers.com>
-;;; Copyright © 2018, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2018, 2019, 2022 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
 ;;; Copyright © 2020 Leo Famulari <leo@famulari.name>
 ;;;
@@ -23,6 +23,7 @@

 (define-module (gnu packages aidc)
  #:use-module (gnu packages)
+  #:use-module (guix gexp)
  #:use-module ((guix licenses) #:prefix license:)
  #:use-module (guix packages)
  #:use-module (guix download)
@@ -63,8 +64,7 @@
                 (base32
                  "1yl2cpaqiv1g4nq9v0xfj1vd5faz55k4541vz6hsffvcxgn9nmc5"))))
      (build-system cmake-build-system)
-      (native-inputs
-       (list fmt googletest))
+      (native-inputs (list fmt-8 googletest))
      (synopsis "C++ port of ZXing")
      (description "ZXing-CPP is a barcode scanning library.")
      (home-page "https://github.com/nu-book/zxing-cpp")
@@ -148,7 +148,7 @@ characters, and is highly robust.")
 (define-public libdmtx
  (package
    (name "libdmtx")
-    (version "0.7.5")
+    (version "0.7.7")
    (source
     (origin
       (method git-fetch)
@@ -157,11 +157,11 @@ characters, and is highly robust.")
             (commit (string-append "v" version))))
       (file-name (git-file-name name version))
       (sha256
-        (base32 "0wk3fkxzf9ip75v8ia54v6ywx72ajp5s6777j4ay8barpbv869rj"))))
+        (base32 "0s95gplvb6x7gnl48yn7ywa9r15lfm8k2m60wm9i7w75ay4bq32i"))))
    (build-system gnu-build-system)
    (arguments
-     ;; XXX Test suite is broken: https://github.com/dmtx/libdmtx/issues/22
-     `(#:tests? #f))
+     (list #:configure-flags
+           #~(list "--disable-static")))
    (native-inputs
     (list autoconf automake libtool pkg-config))
    (home-page "https://github.com/dmtx")
@@ -14,6 +14,7 @@
 ;;; Copyright © 2020 Vincent Legoll <vincent.legoll@gmail.com>
 ;;; Copyright © 2020, 2021 Vinicius Monego <monego@posteo.net>
 ;;; Copyright © 2021 Lars-Dominik Braun <ldb@leibniz-psychology.org>
+;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -74,7 +75,8 @@
  #:use-module (guix hg-download)
  #:use-module ((guix licenses) #:prefix license:)
  #:use-module (guix packages)
-  #:use-module (guix utils))
+  #:use-module (guix utils)
+  #:use-module (ice-9 match))


 (define-public mpfrcx
@@ -105,24 +107,26 @@ multiplication routines such as Toom–Cook and the FFT.")

 (define-public gf2x
  (package
-   (name "gf2x")
-   (version "1.2")
-   (source (origin
-            (method url-fetch)
-            (uri (string-append
-                  "https://gforge.inria.fr/frs/download.php/file/36934/gf2x-"
-                  version ".tar.gz"))
-            (sha256
-             (base32
-              "0d6vh1mxskvv3bxl6byp7gxxw3zzpkldrxnyajhnl05m0gx7yhk1"))))
-   (build-system gnu-build-system)
-   (synopsis "Arithmetic of polynomials over binary finite fields")
-   (description
-    "The gf2x library provides arithmetic of polynomials over finite fields
+    (name "gf2x")
+    (version "1.3.0")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url "https://gitlab.inria.fr/gf2x/gf2x")
+                    (commit (string-append name "-" version))))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32
+                "04g5jg0i4vz46b4w2dvbmahwzi3k6b8g515mfw7im1inc78s14id"))))
+    (build-system gnu-build-system)
+    (native-inputs (list autoconf automake libtool))
+    (synopsis "Arithmetic of polynomials over binary finite fields")
+    (description
+     "The gf2x library provides arithmetic of polynomials over finite fields
 of characteristic 2.  It implements the multiplication, squaring and
 greatest common divisor operations.")
-   (license license:gpl3+)
-   (home-page "https://gforge.inria.fr/projects/gf2x/")))
+    (home-page "https://gitlab.inria.fr/gf2x/gf2x")
+    (license license:gpl3+)))

 (define-public cm
  (package
@@ -220,7 +224,7 @@ the real span of the lattice.")
 (define-public pari-gp
  (package
    (name "pari-gp")
-    (version "2.13.4")
+    (version "2.15.1")
    (source (origin
              (method url-fetch)
              (uri (string-append
@@ -228,11 +232,10 @@ the real span of the lattice.")
                    version ".tar.gz"))
              (sha256
               (base32
-                "11g1pkrj12dmggj1n6r00ijpnmk3f3dpqsf1h51q34hmmv79xpmw"))))
+                "0gcyj0p0z5s1i9y67z5awwmmdvqrisvyrq22gvkbx1b6gjvrsha5"))))
    (build-system gnu-build-system)
-    (native-inputs
-     `(("texlive" ,(texlive-updmap.cfg
-                    (list texlive-amsfonts)))))
+    (native-inputs (list (texlive-updmap.cfg
+                          (list texlive-amsfonts))))
    (inputs (list gmp libx11 perl readline))
    (arguments
     '(#:make-flags '("all")
@@ -260,7 +263,7 @@ PARI is also available as a C library to allow for faster computations.")
 (define-public gp2c
  (package
   (name "gp2c")
-   (version "0.0.12")
+   (version "0.0.13")
   (source (origin
            (method url-fetch)
            (uri (string-append
@@ -268,7 +271,7 @@ PARI is also available as a C library to allow for faster computations.")
                  version ".tar.gz"))
            (sha256
              (base32
-                "039ip7qkwwv46wrcdrz7y12m30kazzkjr44kqbc0h137g4wzd7zf"))))
+                "0dlxlrwwvhmjljjzsq95fsm14j5n5353snd92b0pdg9ylzn784r6"))))
   (build-system gnu-build-system)
   (native-inputs (list perl))
   (inputs (list pari-gp))
@@ -293,39 +296,38 @@ GP2C, the GP to C compiler, translates GP scripts to PARI programs.")

 (define-public cmh
  (package
-   (name "cmh")
-   (version "1.1.0")
-   (source (origin
-            (method url-fetch)
-            ;; Git repo at <https://gitlab.inria.fr/cmh/cmh>.
-            (uri (string-append "http://www.multiprecision.org/downloads/cmh-"
-                                version ".tar.gz"))
-            (sha256
-             (base32
-              "1ws2yhzxmm2l5xqqqcjcimmg40f9qq5l9i6d4i5434an9v9s8531"))
-             (patches (search-patches "cmh-support-fplll.patch"))))
-   (build-system gnu-build-system)
-   (inputs
-     (list gmp
-           mpfr
-           mpc
-           mpfrcx
-           fplll
-           pari-gp))
-   (synopsis "Igusa class polynomial computations")
-   (description
-    "The CMH software computes Igusa (genus 2) class polynomials, which
+    (name "cmh")
+    (version "1.1.1")
+    (source (origin
+              (method url-fetch)
+              ;; Git repo at <https://gitlab.inria.fr/cmh/cmh>.
+              (uri (string-append
+                    "https://www.multiprecision.org/downloads/cmh-" version
+                    ".tar.gz"))
+              (sha256
+               (base32
+                "0nadvqfmidgks1s7aljsf8dp32pz7vjaxyaym36m9bx4zr8msk91"))))
+    (build-system gnu-build-system)
+    (inputs (list gmp
+                  mpfr
+                  mpc
+                  mpfrcx
+                  fplll
+                  pari-gp))
+    (synopsis "Igusa class polynomial computations")
+    (description
+     "The CMH software computes Igusa (genus 2) class polynomials, which
 parameterize the CM points in the moduli space of 2-dimensional abelian
 varieties, i.e. Jacobians of hyperelliptic curves.
 It can also be used to compute theta constants at arbitrary
 precision.")
-   (license license:gpl3+)
-   (home-page "http://www.multiprecision.org/cmh/home.html")))
+    (license license:gpl3+)
+    (home-page "https://www.multiprecision.org/cmh/home.html")))

 (define-public giac
  (package
    (name "giac")
-    (version "1.7.0-51")
+    (version "1.9.0-29")
    (source
     (origin
       (method url-fetch)
@@ -337,7 +339,7 @@ precision.")
                           "~parisse/debian/dists/stable/main/source/"
                           "giac_" version ".tar.gz"))
       (sha256
-        (base32 "0wgqa2nxpv652348fxpchx5zvaj6ssc403jxwsdp5ky9pdpap2zs"))))
+        (base32 "03hbg5b0xmdfp919mxn5lsard1mwg1kcm9xrm8gk7wnmr9r1adgn"))))
    (build-system gnu-build-system)
    (arguments
     (list
@@ -353,9 +355,10 @@ precision.")
                                 (find-files "doc" "^Makefile"))
                (("/bin/cp") (which "cp")))))
          (add-after 'unpack 'disable-failing-test
-            ;; FIXME: Test failing.  Not sure why.
+            ;; FIXME: Tests failing.  Not sure why.
            (lambda _
              (substitute* "check/Makefile.in"
+                (("chk_fhan4") "")
                (("chk_fhan11") ""))))
          (add-after 'install 'fix-doc
            (lambda _
@@ -413,13 +416,13 @@ or text interfaces) or as a C++ library.")
 (define-public flint
  (package
   (name "flint")
-   (version "2.8.4")
+   (version "2.9.0")
   (source
    (origin
      (method url-fetch)
      (uri (string-append "http://flintlib.org/flint-" version ".tar.gz"))
      (sha256
-       (base32 "1gp4wm2s8c27g2hh53d09cys62da1bsxfwbcsj9cd7cfikm95pv1"))))
+       (base32 "0sp79ixaawjzna79afrlwlx9hg55jxil03f1wq435j9k23ar1h1g"))))
   (build-system gnu-build-system)
   (inputs
    (list ntl))
@@ -466,7 +469,7 @@ fast arithmetic.")
 (define-public arb
  (package
    (name "arb")
-    (version "2.22.1")
+    (version "2.23.0")
    (source (origin
              (method git-fetch)
              (uri (git-reference
@@ -475,7 +478,7 @@ fast arithmetic.")
              (file-name (git-file-name name version))
              (sha256
               (base32
-                "0qcyf8a7w95yxap0r3sb7xibk53nbs5kkidja3ljvqpbpk5xvpax"))))
+                "1m9vskyf857gbm0cbh3z8c8m6cqkqa765wb9hqmsv7yzfmklzpvn"))))
    (build-system gnu-build-system)
    (propagated-inputs
     (list flint))               ; flint.h is included by arf.h
@@ -540,14 +543,14 @@ these types and other mathematical functions.")
 (define-public ntl
  (package
   (name "ntl")
-   (version "11.4.4")
+   (version "11.5.1")
   (source (origin
            (method url-fetch)
            (uri (string-append "https://shoup.net/ntl/ntl-"
                                version ".tar.gz"))
            (sha256
             (base32
-              "1nr1h27j2gdz6badzz9lk2pknxhdijqdxqhd3haryh0sw616wzwx"))
+              "12ka3hym4skg63mp8vgkin79svbpdk2m6i41yvmcdjq62g1hc391"))
            (modules '((guix build utils)))
            (snippet
             '(begin
@@ -630,35 +633,42 @@ geometry and singularity theory.")

 (define-public gmp-ecm
  (package
-   (name "gmp-ecm")
-   (version "7.0.4")
-   (source (origin
-             (method url-fetch)
-             (uri
-               (let ((hash "00c4c691a1ef8605b65bdf794a71539d"))
-                    (string-append "https://gitlab.inria.fr/zimmerma/ecm/"
-                                   "uploads/" hash "/ecm-" version
-                                   ".tar.gz")))
-             (sha256 (base32
-                      "0hxs24c2m3mh0nq1zz63z3sb7dhy1rilg2s1igwwcb26x3pb7xqc"))))
-   (build-system gnu-build-system)
-   (inputs
-    (list gmp))
-   (arguments
-    `(#:configure-flags '("--enable-shared"
-                          ;; Disable specific assembly routines, which depend
-                          ;; on the subarchitecture of the build machine,
-                          ;; and use gmp instead.
-                          "--disable-asm-redc")))
-   (synopsis "Integer factorization library using the elliptic curve method")
-   (description
-    "GMP-ECM factors integers using the elliptic curve method (ECM) as well
+    (name "gmp-ecm")
+    (version "7.0.5")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url "https://gitlab.inria.fr/zimmerma/ecm")
+                    (commit (string-append "git-" version))))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32
+                "013sfsd5kyh7phhf4namcdndpcp2jnibzxf10f4g89qabr8av63m"))))
+    (build-system gnu-build-system)
+    (inputs
+     (list gmp))
+    (arguments
+     (list
+      #:configure-flags #~(list "--enable-shared"
+                                ;; Disable specific assembly routines, which
+                                ;; depend on the subarchitecture of the build
+                                ;; machine, and use gmp instead.
+                                "--disable-asm-redc")
+      #:phases #~(modify-phases %standard-phases
+                   (add-after 'unpack 'patch-paths
+                     (lambda _
+                       (substitute* "test.ecm"
+                         (("/bin/rm") (which "rm"))))))))
+    (native-inputs (list autoconf automake libtool))
+    (synopsis "Integer factorization library using the elliptic curve method")
+    (description
+     "GMP-ECM factors integers using the elliptic curve method (ECM) as well
 as the P-1 and P+1 algorithms.  It provides a library and a stand-alone
 binary.")
-   ;; Most files are under lgpl3+, but some are under gpl3+ or gpl2+,
-   ;; so the combined work is under gpl3+.
-   (license license:gpl3+)
-   (home-page "http://ecm.gforge.inria.fr/")))
+    (home-page "https://gitlab.inria.fr/zimmerma/ecm")
+    ;; Most files are under lgpl3+, but some are under gpl3+ or gpl2+, so the
+    ;; combined work is under gpl3+.
+    (license license:gpl3+)))

 (define-public bc
  (package
@@ -923,7 +933,7 @@ algorithms from the FORTRAN library MINPACK.")
 (define-public symengine
  (package
    (name "symengine")
-    (version "0.6.0")
+    (version "0.9.0")
    (source
     (origin
       (method git-fetch)
@@ -932,7 +942,7 @@ algorithms from the FORTRAN library MINPACK.")
             (commit (string-append "v" version))))
       (file-name (git-file-name name version))
       (sha256
-        (base32 "129iv9maabmb42ylfdv0l0g94mcbf3y4q3np175008rcqdr8z6h1"))))
+        (base32 "17b6byrhk0bgvarqmg92nrrqhzll9as6x1smghmyq2h9xc373ap4"))))
    (build-system cmake-build-system)
    (arguments
     '(#:configure-flags
@@ -986,20 +996,17 @@ extends it by a set of algebraic capabilities.")
 (define-public eigen
  (package
    (name "eigen")
-    (version "3.3.8")
+    (version "3.4.0")
    (source (origin
-              (method url-fetch)
-              (uri (list
-                     (string-append "https://bitbucket.org/eigen/eigen/get/"
-                                    version ".tar.bz2")
-                     (string-append "mirror://debian/pool/main/e/eigen3/eigen3_"
-                                    version ".orig.tar.bz2")))
+              (method git-fetch)
+              (uri (git-reference
+                    (url "https://gitlab.com/libeigen/eigen.git")
+                    (commit version)))
              (sha256
               (base32
-                "1vxrsncfnkyq6gwxpsannpryp12mk7lc8f42ybvz3saf7icwc582"))
-              (file-name (string-append name "-" version ".tar.bz2"))
-              (patches (search-patches "eigen-remove-openmp-error-counting.patch"
-                                       "eigen-stabilise-sparseqr-test.patch"))
+                "0k1c4qnymwwvm68rv6s0cyk08xbw65ixvwqccsh36c2axcqk3znp"))
+              (file-name (git-file-name name version))
+              (patches (search-patches "eigen-fix-strict-aliasing-bug.patch"))
              (modules '((guix build utils)))
              (snippet
               ;; There are 3 test failures in the "unsupported" directory,
@@ -1012,10 +1019,39 @@ extends it by a set of algebraic capabilities.")
                  #t))))
    (build-system cmake-build-system)
    (arguments
-     '(;; Turn off debugging symbols to save space.
+     `(;; Turn off debugging symbols to save space.
       #:build-type "Release"

+       #:modules ((ice-9 match)
+                  (guix build utils)
+                  (guix build cmake-build-system))
+
       #:phases (modify-phases %standard-phases
+                  (add-after 'unpack 'disable-some-tests
+                    ;; Not all platforms are well supported by the test suite.
+                    (lambda _
+                      ,@(match (%current-system)
+                          ("i686-linux"
+                           `((substitute* "test/CMakeLists.txt"
+                               ((".*packetmath.*") ""))))
+                          ("aarch64-linux"
+                           `((substitute* "test/CMakeLists.txt"
+                               ((".*array_cwise.*") "")
+                               ((".*vectorization_logic.*") ""))))
+                          ("armhf-linux"
+                           `((substitute* "test/CMakeLists.txt"
+                               ((".*geo_quaternion.*") "")
+                               ((".*jacobisvd.*") "")
+                               ((".*packetmath.*") "")
+                               ((".*prec_inverse.*") "")
+                               ((".*qr_colpivoting.*") "")
+                               ((".*vectorization_logic.*") ""))))
+                          ("riscv64-linux"
+                           `((substitute* "test/CMakeLists.txt"
+                               ((".*array_cwise.*") "")
+                               ((".*geo_quaternion.*") ""))))
+                          (_
+                            '((display "No tests to disable on this architecture.\n"))))))
                  (replace 'check
                    (lambda* (#:key tests? #:allow-other-keys)
                      (let* ((cores  (parallel-job-count))
@@ -1104,6 +1140,11 @@ features, and more.")
                    (substitute* "unsupported/CMakeLists.txt"
                      (("add_subdirectory\\(test.*")
                       "# Do not build the tests for unsupported features.\n"))))))
+      (arguments
+       (substitute-keyword-arguments (package-arguments eigen)
+         ((#:phases phases)
+          `(modify-phases ,phases
+             (delete 'disable-some-tests)))))
      (native-inputs
       (list gcc-7)))))

@@ -1132,7 +1173,12 @@ features, and more.")
                 '(begin
                    (substitute* "unsupported/CMakeLists.txt"
                      (("add_subdirectory\\(test.*")
-                       "# Do not build the tests for unsupported features.\n")))))))))
+                       "# Do not build the tests for unsupported features.\n"))))))
+      (arguments
+       (substitute-keyword-arguments (package-arguments eigen)
+         ((#:phases phases)
+          `(modify-phases ,phases
+             (delete 'disable-some-tests))))))))

 (define-public xtensor
  (package
@@ -1209,17 +1255,17 @@ xtensor provides:
 (define-public gap
  (package
    (name "gap")
-    (version "4.11.0")
+    (version "4.11.1")
    (source
     (origin
       (method url-fetch)
       (uri (string-append "https://files.gap-system.org/gap-"
                           (version-major+minor version)
-                           "/tar.bz2/gap-"
+                           "/tar.gz/gap-"
                           version
-                           ".tar.bz2"))
+                           ".tar.gz"))
       (sha256
-        (base32 "00l6hvy4iggnlrib4vp805sxdm3j7n3hzpv5zs9hbiiavh80l1xz"))
+        (base32 "01535s81h254zcs84zi95xqmhvvn6fn9qss8761myxc2gpdcadb6"))
       (modules '((guix build utils) (ice-9 ftw) (srfi srfi-1)))
       (snippet
        '(begin
@@ -1245,28 +1291,42 @@ xtensor provides:
                   "SmallGrp-"   ; artistic2.0
                   "transgrp"    ; artistic2.0 for data,
                                 ; gpl2 or gpl3 for code
-                   ;; Recommended package.
-                   "io-"         ; gpl3+
-                   ;; Optional packages, searched for at start,
-                   ;; and their depedencies.
+                   ;; Optional packages.
                   "alnuth-"
+                   "AutoDoc-"
+                   "automata-"
                   "autpgrp-"
+                   "crime-"
                   "crisp-"      ; bsd-2
-                   "ctbllib"     ; gpl3+, clarified in the next release;
-                                 ; see
-                                 ; http://www.math.rwth-aachen.de/~Thomas.Breuer/ctbllib/README.md
+                   "ctbllib"     ; gpl3+
+                   "datastructures"
                   "FactInt-"
                   "fga"
+                   "format"
+                   "groupoids-"
+                   "guarana"
+                   "idrel-"
+                   "images-"     ; mpl2.0
+                   "IntPic-"
+                   "io-"         ; gpl3+
                   "irredsol-"   ; bsd-2
                   "laguna-"
+                   "liering-"
+                   "MapClass-"
+                   "nilmat-"
+                   "NumericalSgps-"
+                   "OpenMath-"
+                   "orb-"        ; gpl3+
                   "polenta-"
                   "polycyclic-"
                   "radiroot-"
+                   "repsn-"
                   "resclasses-"
+                   "simpcomp"
                   "sophus-"
                   "tomlib-"
-                   "utils-"))))
-           #t))))
+                   "unipot-"
+                   "utils-"))))))))
    (build-system gnu-build-system)
    (inputs
     (list gmp readline zlib))
@@ -1283,14 +1343,12 @@ xtensor provides:
           (lambda _
             (setenv "CONFIG_SHELL" (which "bash"))
             (with-directory-excursion "pkg"
-               (invoke "../bin/BuildPackages.sh")
-             #t)))
+               (invoke "../bin/BuildPackages.sh"))))
         (add-after 'build-packages 'build-doc
           ;; The documentation is bundled, but we create it from source.
           (lambda _
             (with-directory-excursion "doc"
-               (invoke "./make_doc"))
-             #t))
+               (invoke "./make_doc"))))
         (replace 'install
           (lambda* (#:key outputs #:allow-other-keys)
             (let* ((out (assoc-ref outputs "out"))
@@ -1315,6 +1373,8 @@ xtensor provides:
               (chmod prog #o755)
               ;; Install the headers and library, which are needed by Sage.
               (invoke "make" "install-headers")
+               (install-file "gen/config.h"
+                             (string-append out "/include/gap"))
               (invoke "make" "install-libgap")
               ;; Remove information on the build directory from sysinfo.gap.
               (substitute* "sysinfo.gap"
@@ -1324,8 +1384,7 @@ xtensor provides:
               (invoke "make" "install-gaproot")
               ;; Copy the directory of compiled packages; the make target
               ;; install-pkg is currently empty.
-               (copy-recursively "pkg" (string-append share "/pkg")))
-             #t)))))
+               (copy-recursively "pkg" (string-append share "/pkg"))))))))
    (home-page "https://www.gap-system.org/")
    (synopsis
     "System for computational group theory")
@@ -1345,42 +1404,45 @@ objects.")

 (define-public gappa
  (package
-   (name "gappa")
-   (version "1.4.0")
-   (source (origin
-            (method url-fetch)
-            (uri (string-append "https://gappa.gitlabpages.inria.fr/releases/"
-                                "gappa-" version ".tar.gz"))
-            (sha256
-             (base32
-              "12x42z901pr05ldmparqdi8sq9s7fxbavhzk2dbq3l6hy247dwbb"))))
-   (build-system gnu-build-system)
-   (inputs
-    (list boost gmp 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
+    (name "gappa")
+    (version "1.4.1")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url "https://gitlab.inria.fr/gappa/gappa")
+                    (commit (string-append name "-" version))))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32
+                "0vfggzilc0gicrhqypmlx30ccrdkmyg22zzn46988c28xi9rcicj"))))
+    (build-system gnu-build-system)
+    (arguments
+     (list #:phases
+           #~(modify-phases %standard-phases
+               (add-after 'unpack 'patch-remake-shell
+                 (lambda _
+                   (substitute* "remake.cpp"
+                     (("/bin/sh") (which "sh")))))
+               (replace 'build
+                 (lambda _ (invoke "./remake" "-s" "-d")))
+               (replace 'install
+                 (lambda _ (invoke "./remake" "-s" "-d" "install")))
+               (replace 'check
+                 (lambda* (#:key tests? #:allow-other-keys)
+                   (when tests?
+                     (invoke "./remake" "check")))))))
+    (native-inputs (list autoconf automake bison flex libtool))
+    (inputs (list boost gmp mpfr))
+    (home-page "https://gitlab.inria.fr/gappa/gappa")
+    (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)))) ; either/or
+    (license (list license:gpl3+ license:cecill)))) ; either/or

 (define-public givaro
  (package
@@ -1592,16 +1654,16 @@ of M4RI from F_2 to F_{2^e}.")
 (define-public eclib
  (package
    (name "eclib")
-    (version "20190909")
+    (version "20220621")
    (source (origin
              (method git-fetch)
              (uri (git-reference
                    (url "https://github.com/JohnCremona/eclib/")
-                    (commit (string-append "v" version))))
+                    (commit version)))
              (file-name (git-file-name name version))
              (sha256
               (base32
-                "1gw27lqc3f525n8qdcmr2nyn16y9g10z9f6dnmckyyxcdzvhq35n"))))
+                "07wbkzmn6w0hrv2vim7f0il7k59ccc66x5vnn623xkmhfw32b3nz"))))
    (build-system gnu-build-system)
    (native-inputs
     (list autoconf automake libtool))
@@ -1618,7 +1680,7 @@ John Cremona to compute his elliptic curve database.")
 (define-public lrcalc
  (package
    (name "lrcalc")
-    (version "1.2")
+    (version "2.1")
    (source (origin
              (method git-fetch)
              (uri (git-reference
@@ -1627,18 +1689,10 @@ John Cremona to compute his elliptic curve database.")
              (file-name (git-file-name name version))
              (sha256
               (base32
-                "1c12d04jdyxkkav4ak8d1aqrv594gzihwhpxvc6p9js0ry1fahss"))
-              (patches (search-patches "lrcalc-includes.patch"))))
+                "0s3amf3z75hnrjyszdndrvk4wp5p630dcgyj341i6l57h43d1p4k"))))
    (build-system gnu-build-system)
    (native-inputs
     (list autoconf automake libtool))
-    (arguments
-     `(#:phases
-       (modify-phases %standard-phases
-         (add-before 'build 'fix-permission
-           (lambda _
-             (chmod "lrcalc.maple.src" #o644)
-             #t)))))
    (synopsis "Littlewood-Richardson calculator in algebraic combinatorics")
    (description "The Littlewood-Richardson Calculator (lrcalc) is a
 program designed to compute Littlewood-Richardson coefficients.  It computes
@@ -34,6 +34,7 @@
  #:use-module (guix gexp)
  #:use-module (guix git-download)
  #:use-module (guix build-system android-ndk)
+  #:use-module (guix build-system cmake)
  #:use-module (guix build-system gnu)
  #:use-module (guix build-system go)
  #:use-module (guix build-system python)
@@ -54,6 +55,8 @@
  #:use-module (gnu packages python-crypto)
  #:use-module (gnu packages python-web)
  #:use-module (gnu packages python-xyz)
+  #:use-module (gnu packages qt)
+  #:use-module (gnu packages readline)
  #:use-module (gnu packages selinux)
  #:use-module (gnu packages serialization)
  #:use-module (gnu packages sphinx)
@@ -869,7 +872,7 @@ algorithm.")
       ("libpng" ,libpng)))
    (home-page "https://developer.android.com/studio/command-line/etc1tool.html")
    (synopsis "Encode and decode PNG images to resp. from the ETC1 compression
-standard.")
+standard")
    (description
     "@command{etc1} is a command line utility that lets you encode PNG images
 to the ETC1 compression standard and decode ETC1 compressed images back to
@@ -1268,3 +1271,30 @@ Dalvik VM.  Their bytecode differs from the bytecode of normal Java
 applications.  Enjarify can translate the Dalvik bytecode back to equivalent
 Java bytecode, which simplifies the analysis of Android applications.")
    (license license:asl2.0)))
+
+(define-public android-file-transfer
+  (package
+    (name "android-file-transfer")
+    (version "4.2")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url
+                     "https://github.com/whoozle/android-file-transfer-linux/")
+                    (commit (string-append "v" version))))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32
+                "125rq8ji83nw6chfw43i0h9c38hjqh1qjibb0gnf9wrigar9zc8b"))))
+    (build-system cmake-build-system)
+    (arguments
+     (list #:tests? #f)) ;there are no tests
+    (inputs (list qtbase-5 fuse-3 libxkbcommon))
+    (native-inputs (list qttools-5 openssl readline))
+    (home-page "https://whoozle.github.io/android-file-transfer-linux/")
+    (synopsis "MTP client for Android devices")
+    (description
+     "This package provides a Qt graphical interface for transferring files
+with Android devices using MTP.  It also allows the Android device to be
+mounted via FUSE.")
+    (license license:lgpl2.1+)))
@@ -2,7 +2,8 @@
 ;;; 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, 2021 Vinicius Monego <monego@posteo.net>
+;;; Copyright © 2020, 2021, 2022 Vinicius Monego <monego@posteo.net>
+;;; Copyright © 2022 Tomasz Jeneralczyk <tj@schwi.pl>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -47,6 +48,7 @@
  #:use-module (gnu packages image)
  #:use-module (gnu packages imagemagick)
  #:use-module (gnu packages jemalloc)
+  #:use-module (gnu packages mp3)
  #:use-module (gnu packages networking)
  #:use-module (gnu packages pcre)
  #:use-module (gnu packages perl)
@@ -323,7 +325,7 @@ audio or video backends, ensuring good performance.")
 (define-public lightspark
  (package
    (name "lightspark")
-    (version "0.8.5")
+    (version "0.8.6")
    (source
     (origin
       (method git-fetch)
@@ -332,7 +334,7 @@ audio or video backends, ensuring good performance.")
             (commit version)))
       (file-name (git-file-name name version))
       (sha256
-        (base32 "00535ndzjbz5xyr95cih01wlkc2mgvg60bv6amz4lnnglk0c5v0p"))))
+        (base32 "0v7d7vwb0xqkk3v8dyks0wyk52ga57v5lg93y74v1d2wh7spmmzw"))))
    (build-system cmake-build-system)
    (arguments
     `(#:tests? #f ;requires Adobe Flex SDK, see README.tests
@@ -352,29 +354,28 @@ audio or video backends, ensuring good performance.")
             (when tests?
               (invoke "./tests")))))))
    (native-inputs
-     `(("gettext" ,gettext-minimal)
-       ("glib:bin" ,glib "bin")
-       ("nasm" ,nasm)
-       ("perl" ,perl)
-       ("pkg-config" ,pkg-config)
-       ("python" ,python-wrapper)))
+     (list gettext-minimal
+           `(,glib "bin")
+           nasm
+           perl
+           pkg-config
+           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)))
+     (list cairo
+           curl
+           ffmpeg
+           freeglut
+           glew
+           glibmm
+           gnutls
+           libjpeg-turbo
+           openssl
+           pango
+           pcre2
+           rtmpdump
+           sdl2
+           sdl2-mixer
+           zlib))
    (home-page "https://lightspark.github.io/")
    (synopsis "Flash player implementation")
    (description
@@ -435,7 +436,7 @@ language.")
           (add-after 'install 'wrap-executable
             (lambda* (#:key inputs outputs #:allow-other-keys)
               (let* ((out (assoc-ref outputs "out"))
-                      (qt '("qt" "qtmultimedia")))
+                      (qt '("qt" "qtmultimedia-5")))
                 (wrap-program (string-append out "/bin/Papagayo")
                   `("QT_PLUGIN_PATH" ":" prefix
                     ,(map (lambda (label)
@@ -445,10 +446,10 @@ language.")
                 #t))))))
      (inputs
       `(("qt" ,qtbase-5)
-         ("qtmultimedia" ,qtmultimedia)
+         ("qtmultimedia-5" ,qtmultimedia-5)
         ("libsndfile" ,libsndfile)))
      (native-inputs
-       (list qttools))
+       (list qttools-5))
      (home-page "https://www.lostmarble.com/papagayo/")
      (synopsis "Lip-syncing for animations")
      (description
@@ -474,7 +475,7 @@ waveform until they line up with the proper sounds.")
                "0b1nwiwyg01087q318vymg4si76dw41ykxbn2zwd6dqbxzbpr1dh"))))
    (build-system gnu-build-system)
    (inputs
-     (list qtbase-5 qtxmlpatterns qtmultimedia qtsvg))
+     (list qtbase-5 qtxmlpatterns qtmultimedia-5 qtsvg-5))
    (arguments
     `(#:phases
       (modify-phases %standard-phases
@@ -496,3 +497,100 @@ waveform until they line up with the proper sounds.")
 lets you create traditional hand-drawn animations (cartoons) using both bitmap
 and vector graphics.")
    (license license:gpl2)))
+
+(define-public swftools
+  ;; Last release of swftools was 0.9.2 on 2012-04-21 - it is really old and
+  ;; does not compile with what's available in guix, master on the other hand works.
+  (let ((commit "772e55a271f66818b06c6e8c9b839befa51248f4")
+        (revision "1"))
+    (package
+      (name "swftools")
+      (version (git-version "0.9.2" revision commit))
+      (source
+       (origin
+         (method git-fetch)
+         (uri (git-reference
+               (url "https://github.com/matthiaskramm/swftools")
+               (commit commit)))
+         (sha256
+                 (base32 "0a8a29rn7gpxnba3spnvkpdgr7mdlssvr273mzw5b2wjvbzard3w"))
+         (file-name (git-file-name name version))
+         (modules '((guix build utils)))
+         (snippet
+          '(begin
+             ;; XXX: Swftools includes the source tarball of an old version of
+             ;; xpdf.
+
+             ;; To fix a linking error I followed the workaround in:
+             ;; https://github.com/matthiaskramm/swftools/issues/178
+             ;; and implented it as a two-step snippet because substitute*
+             ;; does not match multiline regexes.
+             (substitute* "lib/lame/quantize.c"
+               ;; move inline keywords to the same line as their function headers
+               (("^inline.*\n") "inline "))
+             (substitute* "lib/lame/quantize.c"
+               ;; make this particular function not inline
+               (("inline (void bitpressure_strategy1)" _ f) f))))))
+      (build-system gnu-build-system)
+      (arguments
+       (list #:tests? #f)) ; no rule for check
+      (inputs (list zlib freetype giflib libjpeg-turbo lame))
+      (home-page "http://www.swftools.org")
+      (synopsis "Collection of utilities for working with Adobe Flash files")
+
+      ;; XXX: This package will built all of swftools' tools but one: PDF2SWF,
+      ;; purposefuly commented out of the description below.
+      (description "SWFTools is a collection of utilities for working with
+Adobe Flash files (SWF files).  The tool collection includes programs for
+reading SWF files, combining them, and creating them from other content (like
+images, sound files, videos or sourcecode).  The current collection is
+ comprised of the programs detailed below:
+
+@itemize
+@comment PDF2SWF is not currentlybeing  build alongside other tools.  The next
+@comment two lines should be uncommented if this will ever get fixed.
+@comment @item
+@comment @command{pdf2swf} A PDF to SWF Converter.
+
+@item
+@command{swfcombine} A multi-function tool for inserting, contatenating,
+stacking and changing parameters in SWFs.
+
+@item
+@command{swfstrings} Scans SWFs for text data.
+@item
+@command{swfdump} Prints out various information about SWFs.
+
+@item
+@command{jpeg2swf} Takes one or more JPEG pictures and generates a SWF
+slideshow from them.
+
+@item
+@command{png2swf} Like JPEG2SWF, only for PNGs.
+
+@item
+@command{gif2swf} Converts GIFs to SWF.  Also able to handle animated GIFs.
+
+@item
+@command{wav2swf} Converts WAV audio files to SWFs, using the LAME MP3
+ encoder library.
+
+@item
+@command{font2swf} Converts font files (TTF, Type1) to SWF.
+
+@item
+@command{swfbbox} reads out, optimizes and readjusts SWF bounding boxes.
+
+@item
+@command{swfc} A tool for creating SWF files from simple script files.  Supports
+both ActionScript 2.0 aand 3.0.
+
+@item
+@command{swfextract} extracts Movieclips, Sounds, Images etc. from SWF
+ files.
+
+@item
+@command{as3compile} A standalone ActionScript 3.0 compiler.  Mostly compatible
+ with Flex.
+@end itemize")
+      (license license:gpl2+))))
@@ -47,6 +47,7 @@
  (package
    (name "aspell")
    (version "0.60.8")
+    (replacement aspell/replacement)
    (source
     (origin
      (method url-fetch)
@@ -92,6 +93,16 @@ documents written in the UTF-8 encoding and its ability to use multiple
 dictionaries, including personal ones.")
    (license lgpl2.1+)))

+;; Replacement package with security fixes.
+(define aspell/replacement
+  (package
+    (inherit aspell)
+    (source
+     (origin
+       (inherit (package-source aspell))
+       (patches (append (origin-patches (package-source aspell))
+                        (search-patches "aspell-CVE-2019-25051.patch")))))))
+
 ;;;
 ;;; Dictionaries.
 ;;;
@@ -12,6 +12,7 @@
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Guillaume Le Vaillant <glv@posteo.net>
 ;;; Copyright © 2022 Felix Gruber <felgru@posteo.net>
+;;; Copyright © 2022 Andy Tai <atai@atai.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -132,14 +133,14 @@ debugging information in STABS, DWARF 2, and CodeView 8 formats.")
 (define-public lightning
  (package
    (name "lightning")
-    (version "2.1.3")
+    (version "2.2.0")
    (source (origin
             (method url-fetch)
             (uri (string-append "mirror://gnu/lightning/lightning-"
                                 version ".tar.gz"))
             (sha256
              (base32
-               "1jgxbq2cm51dzi3zhz38mmgwdcgs328mfl8iviw8dxn6dn36p1gd"))))
+               "03kwvn00qggys203vpzb2kq2asy0ql7x84ajk05a62yg3kzq8faf"))))
    (build-system gnu-build-system)
    (native-inputs (list zlib))
    (arguments
@@ -291,7 +292,7 @@ runtime")
 (define-public rgbds
  (package
    (name "rgbds")
-    (version "0.4.2")
+    (version "0.5.2")
    (source (origin
              (method git-fetch)
              (uri (git-reference
@@ -300,7 +301,7 @@ runtime")
              (file-name (git-file-name name version))
              (sha256
               (base32
-                "0lygj7jzjlq4w0mkiir7ycysrd1p1akyvzrppjcchja05mi8wy9p"))))
+                "13zy05xzh2yxyvzf78a5h59pabwrfr6qs5m453pfbdyd3msg2s7w"))))
    (build-system gnu-build-system)
    (arguments
     `(#:phases
@@ -312,8 +313,7 @@ runtime")
               (("pkg-config")
                (or (which "pkg-config")
                    (string-append ,(%current-target-system)
-                                   "-pkg-config"))))
-             #t))
+                                   "-pkg-config"))))))
         (replace 'check
           (lambda _
             (with-directory-excursion "test/asm"
@@ -14,7 +14,7 @@
 ;;; Copyright © 2018, 2020, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
 ;;; Copyright © 2018 Brett Gilio <brettg@gnu.org>
-;;; Copyright © 2018, 2019 Marius Bakke <mbakke@fastmail.com>
+;;; Copyright © 2018, 2019, 2022 Marius Bakke <marius@gnu.org>
 ;;; Copyright © 2018, 2021 Thorsten Wilms <t_w_@freenet.de>
 ;;; Copyright © 2018 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2018 Brendan Tildesley <mail@brendan.scot>
@@ -37,6 +37,8 @@
 ;;; Copyright © 2021 jgart <jgart@dismail.de>
 ;;; Copyright © 2021 Aleksandr Vityazev <avityazev@posteo.org>
 ;;; Copyright © 2022 Arjan Adriaanse <arjan@adriaan.se>
+;;; Copyright © 2022 Juliana Sims <jtsims@protonmail.com>
+;;; Copyright © 2022 Simon Streit <simon@netpanic.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -124,6 +126,7 @@
  #:use-module (gnu packages web)
  #:use-module (gnu packages webkit)
  #:use-module (gnu packages wxwidgets)
+  #:use-module (gnu packages xdisorg)
  #:use-module (gnu packages xiph)
  #:use-module (gnu packages xml)
  #:use-module (gnu packages xorg)
@@ -142,7 +145,8 @@
  #:use-module (guix packages)
  #:use-module (guix utils)
  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-26))
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 match))

 (define-public opensles
  (package
@@ -233,7 +237,7 @@ promoting the market for advanced audio.")
       ("openal" ,openal)))
    (synopsis "Software Synthesizer")
    (description "WildMIDI is a simple software midi player which has a core
-softsynth library that can be use with other applications.")
+softsynth library that can be used with other applications.")
    (home-page "https://www.mindwerks.net/projects/wildmidi/")
    (license
     (list
@@ -363,7 +367,12 @@ Linux kernel.")
                "07857vdkak306d9s5g6fhmjyxk7vijzjhkmqb15s7ihfxx9lx8xb"))))
    (build-system cmake-build-system)
    (arguments
-     '(#:tests? #f))                    ; no check target
+     '(#:tests? #f                                ;no check target
+
+       ;; XXX: Building with '-fsanitize=undefined' leads to embedded C++ STL
+       ;; header file names in libgme.so, meaning that libgme retains a
+       ;; reference to GCC.  Disable UBSAN to avoid that.
+       #:configure-flags '("-DENABLE_UBSAN=OFF")))
    (home-page "https://bitbucket.org/mpyne/game-music-emu")
    (synopsis "Video game music file playback library")
    (description
@@ -467,31 +476,6 @@ by MusicIP.")
    (home-page "https://code.google.com/archive/p/musicip-libofa/")
    (license license:gpl2+)))

-(define-public faac
-  (package
-    (name "faac")
-    (version "1.30")
-    (source
-     (origin
-       (method url-fetch)
-       (uri
-        (string-append "mirror://sourceforge/faac/faac-src"
-                       "/faac-" version "/faac-1_30.tar.gz"))
-       (sha256
-        (base32 "1lmj0dib3mjp84jhxc5ddvydkzzhb0gfrdh3ikcidjlcb378ghxd"))))
-    (build-system gnu-build-system)
-    (native-inputs
-     (list autoconf automake libtool pkg-config))
-    (synopsis "Freeware Advanced Audio Coder")
-    (description "FAAC is an MPEG-4 and MPEG-2 AAC encoder.")
-    (home-page "https://www.audiocoding.com/faac.html")
-    (license
-     (list
-      ;; ISO MPEG-4 reference code.
-      license:gpl2+
-      ;; Others.
-      license:lgpl2.0+))))
-
 (define-public libtimidity
  (package
    (name "libtimidity")
@@ -585,7 +569,7 @@ implementation of Adaptive Multi Rate Narrowband and Wideband
           liblo
           qtbase-5))
    (native-inputs
-     (list pkg-config qttools))
+     (list pkg-config qttools-5))
    (home-page "http://alsamodular.sourceforge.net/")
    (synopsis "Realtime modular synthesizer and effect processor")
    (description
@@ -631,6 +615,100 @@ attacks, performing pitch detection, tapping the beat and producing MIDI
 streams from live audio.")
    (license license:gpl3+)))

+(define-public dsp
+  (package
+    (name "dsp")
+    (version "1.9")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url "https://github.com/bmc0/dsp")
+                    (commit (string-append "v" version))))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32
+                "0iksmianwig7w78hqip2a8yy6r63sv8cv9pis8qxny6w1xap6njb"))))
+    (build-system gnu-build-system)
+    (arguments
+     (list
+      #:tests? #false                   ;no tests
+      #:make-flags
+      #~(list (string-append "CC=" #$(cc-for-target)))
+      #:phases
+      #~(modify-phases %standard-phases
+          (replace 'configure
+            (lambda _
+              (invoke "sh" "configure"
+                      (string-append "--prefix=" #$output)
+                      "--disable-pulse"))))))
+    (inputs
+     (list alsa-lib
+           ao
+           ffmpeg
+           ladspa
+           libmad
+           libsndfile
+           fftw
+           fftwf
+           zita-convolver))
+    (native-inputs
+     (list libtool pkg-config))
+    (home-page "https://github.com/bmc0/dsp")
+    (synopsis "Audio processing program with an interactive mode")
+    (description
+     "dsp is an audio processing program with an interactive mode.")
+    (license license:isc)))
+
+(define-public qm-dsp
+  (package
+    (name "qm-dsp")
+    (version "1.7.1")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url "https://github.com/c4dm/qm-dsp")
+                    (commit (string-append "v" version))))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32
+                "1vkb1xr2hjcaw88gig7rknlwsx01lm0w94d2z0rk5vz9ih4fslvv"))))
+    (build-system gnu-build-system)
+    (arguments
+     (list
+      #:make-flags
+      #~(list #$(string-append "-f" "build/"
+                               (match (or (%current-target-system)
+                                          (%current-system))
+                                 ("x86_64-linux" "linux/Makefile.linux64")
+                                 ("i686-linux"   "linux/Makefile.linux32")
+                                 (target
+                                  (if (string-suffix? "-mingw32" target)
+                                      "mingw32/Makefile.mingw32"
+                                      "general/Makefile.inc"))))
+              (string-append "CC=" #$(cc-for-target)))
+       #:phases
+       #~(modify-phases %standard-phases
+           (delete 'configure)          ;no configure script
+           (replace 'install
+             (lambda* (#:key outputs #:allow-other-keys)
+               (let* ((lib (string-append #$output "/lib"))
+                      (include (string-append #$output "/include")))
+                 (install-file "libqm-dsp.a" lib)
+                 (mkdir-p include)
+                 (for-each (lambda (file)
+                             (unless (or (string-prefix? "./build" file)
+                                         (string-prefix? "./include" file))
+                               (install-file file (string-append include "/"
+                                                                 (dirname file)))))
+                           (find-files "." "\\.h$"))))))
+       #:test-target "tests"))
+    (home-page "https://code.soundsoftware.ac.uk/projects/qm-dsp")
+    (synopsis "C++ library of functions for DSP and Music Informatics purposes")
+    (description
+     "QM-DSP is a C++ library of functions for DSP and Music Informatics
+purposes developed at Queen Mary, University of London.")
+    (license license:gpl2+)))
+
 (define (ardour-rpath-phase major-version)
  `(lambda* (#:key outputs #:allow-other-keys)
     (let ((libdir (string-append (assoc-ref outputs "out")
@@ -644,13 +722,12 @@ streams from live audio.")
                         libdir "/engines" ":"
                         libdir "/panners" ":"
                         libdir "/surfaces" ":"
-                         libdir "/vamp" "\"]"))))
-     #t))
+                         libdir "/vamp" "\"]"))))))

 (define-public ardour
  (package
    (name "ardour")
-    (version "6.9")
+    (version "7.1")
    (source (origin
              (method git-fetch)
              (uri (git-reference
@@ -664,19 +741,19 @@ streams from live audio.")
                    "libs/ardour/revision.cc"
                  (lambda (port)
                    (format port ,(string-append "#include \"ardour/revision.h\"
-namespace ARDOUR { const char* revision = \"" version "\" ; const char* date = \"\"; }"))
-                    #t)))
+namespace ARDOUR { const char* revision = \"" version "\" ; const char* date = \"\"; }")))))
              (sha256
               (base32
-                "0vlcbd70y0an881zv87kc3akmaiz4w7whsy3yaiiqqjww35jg1mm"))
+                "11ca9xpzmzafl8xl0r0w32lxjqwy532hfd2bzb0d73bdpngpvcbq"))
              (file-name (string-append name "-" version))))
    (build-system waf-build-system)
    (arguments
-     `(#:configure-flags '("--cxx11"          ; required by gtkmm
+     `(#:configure-flags '("--cxx11"              ; required by gtkmm
                           "--optimize"
-                           "--no-phone-home"  ; don't contact ardour.org
-                           "--freedesktop"    ; build .desktop file
-                           "--test")          ; build unit tests
+                           "--no-phone-home"      ; don't contact ardour.org
+                           "--freedesktop"        ; build .desktop file
+                           "--test"               ; build unit tests
+                           "--use-external-libs") ; use system libraries
       #:phases
       (modify-phases %standard-phases
         (add-after 'unpack 'set-rpath-in-LDFLAGS
@@ -701,8 +778,11 @@ namespace ARDOUR { const char* revision = \"" version "\" ; const char* date = \
                             (string-append share "/applications/"))
               (install-file (string-append "build/gtk2_ardour/ardour"
                                            ver ".appdata.xml")
-                             (string-append share "/appdata/")))
-             #t)))
+                             (string-append share "/appdata/")))))
+         (add-after 'install 'install-man-page
+           (lambda* (#:key outputs #:allow-other-keys)
+             (install-file "ardour.1" (string-append (assoc-ref outputs "out")
+                                                     "/share/man/man1")))))
       #:test-target "test"))
    (inputs
     (list alsa-lib
@@ -716,13 +796,17 @@ namespace ARDOUR { const char* revision = \"" version "\" ; const char* date = \
           fftw
           fftwf
           flac
+           fluidsynth
           glibmm
           gtkmm-2
+           hicolor-icon-theme
+           hidapi
           jack-1
           libarchive
           libart-lgpl
           libgnomecanvasmm
           liblo
+           libltc
           libogg
           libsamplerate
           libsndfile
@@ -737,6 +821,7 @@ namespace ARDOUR { const char* revision = \"" version "\" ; const char* date = \
           pangomm
           python-rdflib
           pulseaudio
+           qm-dsp
           readline
           redland
           rubberband
@@ -748,11 +833,11 @@ namespace ARDOUR { const char* revision = \"" version "\" ; const char* date = \
           taglib
           vamp))
    (native-inputs
-     `(("cppunit" ,cppunit)
-       ("gettext" ,gettext-minimal)
-       ("itstool" ,itstool)
-       ("perl" ,perl)
-       ("pkg-config" ,pkg-config)))
+     (list cppunit
+           gettext-minimal
+           itstool
+           perl
+           pkg-config))
    (home-page "https://ardour.org")
    (synopsis "Digital audio workstation")
    (description
@@ -764,19 +849,26 @@ engineers, musicians, soundtrack editors and composers.")
 (define-public audacity
  (package
    (name "audacity")
-    (version "3.1.3")
+    (version "3.2.1")
    (source
     (origin
       ;; If built from the release tag, Audacity will describe itself
       ;; as an "Alpha test version" and suggest to users that they use
       ;; the "latest stable released version".
-       (method url-fetch)
-       (uri (string-append "https://github.com/audacity/audacity/releases/download/"
-                           "Audacity-" version "/audacity-" version
-                           "-source.tar.gz"))
+       ;; XXX: For 3.2.1 we rebelliously use a git tag anyway because the only
+       ;; "processed" download is a .zip containing a .tar.gz which does not
+       ;; fare well with the patch and snippet machinery:
+       ;;   https://github.com/audacity/audacity/issues/3811
+       ;; TODO: Find a way to control the "alpha" status even when using git
+       ;; so we're not reliant on preprocessed source code.
+       (method git-fetch)
+       (uri (git-reference
+             (url "https://github.com/audacity/audacity")
+             (commit (string-append "Audacity-" version))))
+       (file-name (git-file-name name version))
       (sha256
        (base32
-         "189agx11361k9j958s6q5bngnnfx0rwaf0dwbjxy6fwvsb1wv3px"))
+         "00mal30jxbcacs1ka4yb5s8xq81zm7mv3y8l5hvg77abkyvfvdzf"))
       (patches (search-patches "audacity-ffmpeg-fallback.patch"))
       (modules '((guix build utils)))
       (snippet
@@ -806,14 +898,13 @@ engineers, musicians, soundtrack editors and composers.")
           jack-1
           expat
           lame
-           linux-libre-headers
           flac
           ffmpeg
           libid3tag
           libjpeg-turbo
-           libmad
           ;;("libsbsms" ,libsbsms)         ;bundled version is modified
           libsndfile
+           mpg123
           soundtouch
           soxr ;replaces libsamplerate
           sqlite
@@ -824,20 +915,24 @@ engineers, musicians, soundtrack editors and composers.")
           lilv ;for lv2
           suil ;for lv2
           portaudio
-           portmidi))
+           portmidi
+           wavpack))
    (native-inputs
-     `(("autoconf" ,autoconf)
-       ("automake" ,automake)
-       ("gettext" ,gettext-minimal)     ;for msgfmt
-       ("libtool" ,libtool)
-       ("pkg-config" ,pkg-config)
-       ("python" ,python)
-       ("which" ,which)))
+     (list autoconf
+           automake
+           gettext-minimal              ;for msgfmt
+           libtool
+           pkg-config
+           python
+           which))
    (arguments
     `(#:configure-flags
       (list
        "-Daudacity_conan_enabled=off"
        "-Daudacity_lib_preference=system"
+        ;; Disable support for VST 3 SDK, which is not yet in Guix (and has
+        ;; a dubious licensing agreement despite GPL code).
+        "-Daudacity_has_vst3=off"
        ;; TODO: enable this flag once we've packaged all dependencies
        ;; "-Daudacity_obey_system_dependencies=on"
        ;; disable crash reports, updates, ..., anything that phones home
@@ -859,16 +954,16 @@ engineers, musicians, soundtrack editors and composers.")
                "CMAKE_BUILD_WITH_INSTALL_RPATH TRUE")
               (("CMAKE_INSTALL_RPATH_USE_LINK_PATH [A-Z]*")
                "CMAKE_INSTALL_RPATH_USE_LINK_PATH TRUE"))
+             (substitute* "libraries/image-compiler/CMakeLists.txt"
+               (("PROPERTIES")
+                ;; This scripts needs to run during build, make sure it finds
+                ;; the required libraries.
+                "PROPERTIES BUILD_WITH_INSTALL_RPATH FALSE"))
             (substitute* "src/CMakeLists.txt"
+               ;; Despite the name, this script breaks rpath.  Don't run it.
+               (("install.*linux/fix_rpath\\.cmake.*")
+                "")
               (("-Wl,--disable-new-dtags") "-Wl,--enable-new-dtags"))))
-         (add-after 'unpack 'comment-out-revision-ident
-           (lambda _
-             (substitute* "src/CMakeLists.txt"
-               (("file\\( TOUCH \".*RevisionIdent\\.h\" \\)" directive)
-                (string-append "# " directive)))
-             (substitute* "src/AboutDialog.cpp"
-               (("(.*RevisionIdent\\.h.*)" include-line)
-                (string-append "// " include-line)))))
         (add-after 'unpack 'use-upstream-headers
           (lambda* (#:key inputs #:allow-other-keys)
             (substitute* '("libraries/lib-files/FileNames.cpp")
@@ -1114,6 +1209,39 @@ guitar amplification and a small range of classic effects, signal processors and
 generators of mostly elementary and occasionally exotic nature.")
    (license license:gpl3+)))

+(define-public iir
+  (package
+    (name "iir")
+    (version "1.9.3")
+    (source
+     (origin
+       (method git-fetch)
+       (uri (git-reference
+             (url "https://github.com/berndporr/iir1")
+             (commit version)))
+       (file-name (git-file-name name version))
+       (sha256
+        (base32 "0wbh804as740kjvmyaqx4rwvwwrbwh0fnj979dvv1ljlx1p50bk0"))))
+    (build-system cmake-build-system)
+    (arguments
+     (list
+      #:phases
+      #~(modify-phases %standard-phases
+          (add-after 'install 'delete-static-library
+            (lambda* (#:key outputs #:allow-other-keys)
+              (let ((out (assoc-ref outputs "out")))
+                (delete-file (string-append out "/lib/libiir_static.a"))))))))
+    (home-page "https://berndporr.github.io/iir1/")
+    (synopsis
+     "Real-time C++ @acronym{IIR, infinite impulse response} filter library")
+    (description
+     "This C++ library implements the Butterworth, RBJ, and Chebychev
+@acronym{IIR, infinite impulse response} filters.  Samples are processed one by
+one, in real time.  It can easily import coefficients generated with Python
+(@code{scipy}).  It also avoids memory leaks by allocating memory at compile
+time, using templates, instead of calling @code{malloc()} or @code{new}.")
+    (license license:expat)))
+
 (define-public infamous-plugins
  (package
    (name "infamous-plugins")
@@ -1393,7 +1521,7 @@ object library.")
 (define-public csound
  (package
    (name "csound")
-    (version "6.14.0")
+    (version "6.16.2")
    (source
     (origin
       (method git-fetch)
@@ -1402,7 +1530,7 @@ object library.")
             (commit version)))
       (file-name (git-file-name name version))
       (sha256
-        (base32 "1sr9knfhbm2m0wpkjq2l5n471vnl51wy4p6j4m95zqybimzb4s2j"))))
+        (base32 "1lgasyk8j4cl9178vci1dph63nks3cgwhf8y1d04z9dc8gg15dyn"))))
    (build-system cmake-build-system)
    (native-inputs
     (list bison flex gettext-minimal zlib))
@@ -1951,7 +2079,7 @@ also play midifiles using a Soundfont.")
 (define-public faust-2
  (package
    (inherit faust)
-    (version "2.5.23")
+    (version "2.41.1")
    (source (origin
              (method url-fetch)
              (uri (string-append "https://github.com/grame-cncm/faust/"
@@ -1959,15 +2087,29 @@ also play midifiles using a Soundfont.")
                                  "/faust-" version ".tar.gz"))
              (sha256
               (base32
-                "1yz5jnr76hh7rmxkpdi7gyrw1wp4gyqfpq8zyl97qdi5ga5gjznq"))))
-    (build-system gnu-build-system)
+                "0gk8ifxrbykq7ay0nvjns8fjryhp0wfhv5npgrl8xpgw9wfmw53j"))))
+    (build-system cmake-build-system)
    (arguments
-     (substitute-keyword-arguments (package-arguments faust)
-       ((#:make-flags flags)
-        `(list (string-append "prefix=" (assoc-ref %outputs "out"))
-               "world"))))
+     `(#:tests? #f ; no tests
+       #:phases
+       (modify-phases %standard-phases
+         ;; The upstream package uses make to run cmake during the build stage.
+         ;; Here we ignore the Makefile and call cmake directly.
+         (replace 'configure
+           (lambda _
+             (chdir "build")
+             (invoke "cmake" "-C" "backends/all.cmake"
+                     (string-append "-DCMAKE_INSTALL_PREFIX="
+                      (assoc-ref %outputs "out")))))
+         ;; The sound2faust tool would be built in the Makefile's "world" target
+         (add-after 'install 'sound2faust
+           (lambda _
+             (chdir "../tools/sound2faust")
+             (setenv "PREFIX" (assoc-ref %outputs "out"))
+             (invoke "make")
+             (invoke "make" "install"))))))
    (native-inputs
-     `(("llvm" ,llvm-3.8)
+     `(("llvm" ,llvm)
       ("which" ,which)
       ("xxd" ,xxd)
       ("ctags" ,emacs-minimal)  ; for ctags
@@ -2579,14 +2721,13 @@ compensation, (de)interleaving, and byte-swapping
 (define-public python-pyaudio
  (package
    (name "python-pyaudio")
-    (version "0.2.11")
+    (version "0.2.12")
    (source
     (origin
       (method url-fetch)
       (uri (pypi-uri "PyAudio" version))
       (sha256
-        (base32
-         "0x7vdsigm7xgvyg3shd3lj113m8zqj2pxmrgdyj66kmnw0qdxgwk"))))
+        (base32 "17pvc27pn2xbisbq7nibhidyw8h2kyms7g2xbyx7nlxwfbdzbpam"))))
    (build-system python-build-system)
    (inputs
     (list portaudio))
@@ -2782,6 +2923,38 @@ add functionality to support the needs of increasingly powerful audio
 software.")
    (license license:isc)))

+(define-public ttl2c
+  (package
+    (name "ttl2c")
+    (version "1.0.0")
+    (source (origin
+             (method git-fetch)
+             (uri (git-reference
+                   (url "https://github.com/lvtk/ttl2c")
+                   (commit version)))
+             (file-name (git-file-name name version))
+             (sha256
+              (base32
+               "0aybx8i5i0sridi9130a3937xgmfmjkk8m48f9whvhlhbzwy3xbl"))))
+    (build-system waf-build-system)
+    (arguments
+     (list
+      #:tests? #false  ;no check target
+      #:phases
+      `(modify-phases %standard-phases
+         (add-before 'configure 'setup-waf
+           (lambda* (#:key inputs #:allow-other-keys)
+             (let ((waf (assoc-ref inputs "python-waf")))
+               (copy-file (string-append waf "/bin/waf") "waf")))))))
+    (inputs (list boost))
+    (native-inputs (list python-waf))
+    (home-page "https://github.com/lvtk/ttl2c")
+    (synopsis "Turtle to C header conversion utility for LV2 plugins")
+    (description
+     "This package provides a conversion utility for LV2 Plugin developers to
+generate C headers from Turtle files.")
+    (license license:gpl3+)))
+
 (define-public lv2-mda-piano
  (package
    (name "lv2-mda-piano")
@@ -2805,7 +2978,7 @@ software.")
    (inputs
     (list lv2 lvtk))
    (native-inputs
-     (list pkg-config))
+     (list pkg-config ttl2c))
    (native-search-paths
     (list (search-path-specification
            (variable "LV2_PATH")
@@ -2828,14 +3001,14 @@ software.")
    (synopsis "LV2 port of the mda EPiano plugin")
    (description "An LV2 port of the mda EPiano VSTi.")))

-(define-public lvtk
+(define-public lvtk-2
  ;; Use the latest commit, as the latest release was made in 2014 and depends
  ;; on Python 2.
  (let ((commit "a73feabe772f9650aa071e6a4df660e549ab7c48")
        (revision "0"))
    (package
      (name "lvtk")
-      (version (git-version "1.2.0" revision commit))
+      (version (git-version "2" revision commit))
      (source (origin
                (method git-fetch)
                (uri (git-reference
@@ -2857,6 +3030,49 @@ extensions into easy to use C++ classes.  It is the successor of
 lv2-c++-tools.")
      (license license:isc))))

+(define-public lvtk-1
+  ;; Use the latest commit, as the latest release was made in 2014 and depends
+  ;; on Python 2.
+  (let ((commit "23dd99531d88d7821b69f6f0d60516ef322a6729")
+        (revision "0"))
+    (package
+      (name "lvtk")
+      (version (git-version "1.2.0" revision commit))
+      (source (origin
+                (method git-fetch)
+                (uri (git-reference
+                      (url "https://github.com/lvtk/lvtk")
+                      (commit commit)))
+                (file-name (git-file-name name version))
+                (sha256
+                 (base32
+                  "0iw7skvsn3whw69dhcxbbdns7mssaf6z6iyzxjav53607ibyfr8d"))))
+      (build-system waf-build-system)
+      (arguments
+       (list
+        #:tests? #false                 ;no check target
+        #:configure-flags
+        #~(list (string-append "--boost-includes="
+                               #$(this-package-input "boost")
+                               "/include"))
+        #:phases
+        `(modify-phases %standard-phases
+           (add-before 'configure 'setup-waf
+             (lambda* (#:key inputs #:allow-other-keys)
+               (let ((waf (assoc-ref inputs "python-waf")))
+                 (copy-file (string-append waf "/bin/waf") "waf")))))))
+      (inputs (list boost gtkmm lv2))
+      (native-inputs (list pkg-config python-waf))
+      (home-page "https://github.com/lvtk/lvtk")
+      (synopsis "C++ libraries for LV2 plugins")
+      (description
+       "The LV2 Toolkit (LVTK) contains libraries that wrap the LV2 C API and
+extensions into easy to use C++ classes.  It is the successor of
+lv2-c++-tools.")
+      (license license:isc))))
+
+(define-public lvtk lvtk-1)
+
 (define-public openal
  (package
    (name "openal")
@@ -2901,6 +3117,8 @@ including air absorption, occlusion, and environmental reverb, are available
 through the EFX extension.  It also facilitates streaming audio, multi-channel
 buffers, and audio capture.")
    (home-page "https://openal-soft.org/")
+    (properties
+     '((upstream-name . "openal-soft")))
    (license license:lgpl2.0+)))

 (define-public freealut
@@ -2992,21 +3210,25 @@ different audio devices such as ALSA or PulseAudio.")
 (define-public qjackctl
  (package
    (name "qjackctl")
-    (version "0.9.7")
+    (version "0.9.8")
    (source (origin
              (method url-fetch)
              (uri (string-append "mirror://sourceforge/qjackctl/qjackctl/"
                                  version "/qjackctl-" version ".tar.gz"))
              (sha256
               (base32
-                "104hfvr15v8cbkzil8slrqj48y3fl7lx060alj80q1sjh5hl6j2j"))))
+                "1rvxgxd7bbv7yazcpw3ily0jlra8ms5c0kkf7cybgivahw59zk87"))))
    (build-system cmake-build-system)
    (arguments
     '(#:tests? #f))                    ; no check target
    (inputs
-     (list jack-1 alsa-lib portaudio qtbase-5 qtx11extras))
+     (list alsa-lib
+           jack-1
+           portaudio
+           qtbase-5
+           qtsvg-5))
    (native-inputs
-     (list pkg-config qttools))
+     (list pkg-config qttools-5))
    (home-page "https://qjackctl.sourceforge.io/")
    (synopsis "Jack server control application")
    (description "Control a Jack server.  Allows you to plug various sources
@@ -3127,7 +3349,7 @@ link REQUIRED)"))))))
                             (string-append ide "/bin"))
               (delete-file scide)))))))
    (native-inputs
-     (list ableton-link pkg-config qttools xorg-server-for-tests))
+     (list ableton-link pkg-config qttools-5 xorg-server-for-tests))
    (inputs (list jack-1
                  libsndfile
                  fftw
@@ -3141,12 +3363,12 @@ link REQUIRED)"))))))
                  boost-sync
                  yaml-cpp
                  qtbase-5
-                  qtdeclarative
-                  qtsvg
-                  qtwebchannel
-                  qtwebsockets))
+                  qtdeclarative-5
+                  qtsvg-5
+                  qtwebchannel-5
+                  qtwebsockets-5))
    (propagated-inputs                  ;to get native-search-path
-     (list qtwebengine))
+     (list qtwebengine-5))
    (home-page "https://github.com/supercollider/supercollider")
    (synopsis "Synthesis engine and programming language")
    (description "SuperCollider is a synthesis engine (@code{scsynth} or
@@ -3491,7 +3713,8 @@ analysis plugins or audio feature extraction plugins.")
            (symlink
             (search-input-file inputs
                                (string-append "/share/automake-"
-                                               ,(package-version automake)
+                                               ,(version-major+minor
+                                                 (package-version automake))
                                               "/ar-lib"))
             "ar-lib")
            #t)))))
@@ -3507,19 +3730,19 @@ stretching and pitch scaling of audio.  This package contains the library.")
 (define-public libkeyfinder
  (package
    (name "libkeyfinder")
-    (version "2.2.6")
+    (version "2.2.7")
    (source
     (origin
       (method git-fetch)
       (uri (git-reference
             (url "https://github.com/mixxxdj/libkeyfinder")
-             (commit (string-append "v" version))))
+             (commit version)))
       (file-name (git-file-name name version))
       (sha256
-        (base32 "0s7nqjmv44q5qjynfcs0j6h4a6qcz4mxzandkkdjjbnwv5rxc3zg"))))
+        (base32 "0nvhdzy0m3bchk3dpnspv2f518p2v9fjcrv36z1sva1pv9a2g35w"))))
    (build-system cmake-build-system)
    (native-inputs
-     (list catch-framework2))
+     (list catch2))
    (inputs
     (list fftw))
    (home-page "https://mixxxdj.github.io/libkeyfinder/")
@@ -3812,7 +4035,7 @@ interface.")
    (arguments
     `(#:tests? #f))                    ; no "check" phase
    (native-inputs
-     (list qttools pkg-config))
+     (list qttools-5 pkg-config))
    (inputs
     (list fluidsynth qtbase-5 qtx11extras))
    (home-page "https://qsynth.sourceforge.io")
@@ -4262,7 +4485,7 @@ code, used in @code{libtoxcore}.")
 (define-public gsm
  (package
    (name "gsm")
-    (version "1.0.19")
+    (version "1.0.20")
    (source
     (origin
       (method url-fetch)
@@ -4270,8 +4493,7 @@ code, used in @code{libtoxcore}.")
        (string-append "http://www.quut.com/" name "/" name
                       "-" version ".tar.gz"))
       (sha256
-        (base32
-         "1xkha9ss5g5qnfaybi8il0mcvp8knwg9plgh8404vh58d0pna0s9"))))
+        (base32 "1gwhmqs24c14gc9qr91iqb2jkbr3qqy4dvf27yf8j7mq322w65b3"))))
    (build-system gnu-build-system)
    (arguments
     `(#:test-target "tst"
@@ -4284,8 +4506,7 @@ code, used in @code{libtoxcore}.")
             ;; mediastreamer.
             (substitute* "Makefile"
               (("^CCFLAGS.*" all)
-                (string-append all "CCFLAGS += -fPIC\n")))
-             #t))
+                (string-append all "CCFLAGS += -fPIC\n")))))
         (add-before 'install 'pre-install
           (lambda _
             (let ((out (assoc-ref %outputs "out")))
@@ -4294,8 +4515,7 @@ code, used in @code{libtoxcore}.")
               (mkdir-p (string-append out "/man/man1"))
               (mkdir-p (string-append out "/man/man3"))
               (mkdir-p (string-append out "/bin"))
-               (mkdir-p (string-append out "/lib")))
-             #t))
+               (mkdir-p (string-append out "/lib")))))
         (add-after 'install 'post-install
           (lambda _
             (let ((out (assoc-ref %outputs "out")))
@@ -4303,8 +4523,7 @@ code, used in @code{libtoxcore}.")
                            (string-append out "/include"))
               (mkdir-p (string-append out "/include/gsm"))
               (copy-recursively "inc"
-                                 (string-append out "/include/gsm")))
-             #t))
+                                 (string-append out "/include/gsm")))))
         (delete 'configure))))         ; no configure script
    (synopsis "GSM 06.10 lossy speech compression library")
    (description "This C library provides an encoder and a decoder for the GSM
@@ -4762,7 +4981,7 @@ library.")
 (define-public faudio
  (package
    (name "faudio")
-    (version "21.10")
+    (version "22.11")
    (source
     (origin
       (method git-fetch)
@@ -4771,7 +4990,7 @@ library.")
             (commit version)))
       (file-name (git-file-name name version))
       (sha256
-        (base32 "0l9bicg8v1shsyq9k48zh4wv5kwfs6lfjmm9blzd13xrgmhd07w2"))))
+        (base32 "0jdfslxgzysqy0r3nfbsyj6dz0n36fncbsczm9zznxv5phic7g87"))))
    (arguments
     '(#:tests? #f                      ; No tests.
       #:configure-flags '("-DGSTREAMER=ON")))
@@ -5368,11 +5587,11 @@ Rate} 3600x2250 bit/s vocoder used in various radio systems.")
           python ;for running tests
           portaudio ;for portaudio examples
           qtbase-5 ;for Qt examples
-           qtdeclarative
-           qttools))
+           qtdeclarative-5
+           qttools-5))
    (inputs
     (list jack-1 ;for JACK examples
-           qtquickcontrols)) ;for Qt examples
+           qtquickcontrols-5)) ;for Qt examples
    (propagated-inputs
     ;; This is because include/ableton/platforms/asio/AsioWrapper.hpp
     ;; contains '#include <asio.hpp>'.
@@ -5747,3 +5966,59 @@ source and extracts a 24-bit high resolution WAV file.  It handles both DST
 and DSD streams.")
   (home-page "https://tari.in/www/software/odio-sacd/")
   (license license:gpl3+)))
+
+(define-public qpwgraph
+  (package
+    (name "qpwgraph")
+    (version "0.3.7")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url "https://gitlab.freedesktop.org/rncbc/qpwgraph")
+                    (commit (string-append "v" version))))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32
+                "05zbwikixxp5524ps7bd0i4xialgnp1m201rfvlz284sm40wk1vv"))))
+    (build-system cmake-build-system)
+    (arguments (list #:tests? #f)) ;; no tests
+    (inputs (list alsa-lib
+                  libxkbcommon
+                  pipewire-0.3
+                  qtbase
+                  qtsvg))
+    (native-inputs (list pkg-config))
+    (synopsis "PipeWire graph manager")
+    (description
+     "qpwgraph is a graph manager dedicated to PipeWire, using the Qt C++
+framework.  It provides a visual interface to audio and video connections
+managed by PipeWire.")
+    (home-page "https://gitlab.freedesktop.org/rncbc/qpwgraph")
+    (license license:gpl2)))
+
+(define-public streamripper
+  (package
+    (name "streamripper")
+    (version "1.64.6")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append "https://sourceforge.net/projects/streamripper"
+                           "/files/streamripper%20(current)/"
+                           version "/streamripper-" version ".tar.gz"))
+       (sha256
+        (base32 "0hnyv3206r0rfprn3k7k6a0j959kagsfyrmyjm3gsf3vkhp5zmy1"))
+       (modules '((guix build utils)))
+       (snippet
+        ;; Delete bundled copy of libmad.
+        '(delete-file-recursively "libmad-0.15.1b"))))
+    (build-system gnu-build-system)
+    (native-inputs (list pkg-config))
+    (inputs (list faad2 glib libmad libvorbis))
+    (home-page "http://streamripper.sourceforge.net")
+    (synopsis "Record audio streams to your hard drive")
+    (description "Streamripper records shoutcast-compatible
+streams.  For shoutcast style streams it finds the “meta data” or track
+separation data, and uses that as a marker for where the track should
+be separated.")
+    (license license:gpl2+)))
@@ -43,6 +43,7 @@
       (method url-fetch)
       (uri (string-append "https://download.savannah.nongnu.org/releases/"
                           name "/" name "-" version ".tar.gz"))
+       (patches (search-patches "oath-toolkit-xmlsec-compat.patch"))
       (sha256
        (base32 "1aa620k05lsw3l3slkp2mzma40q3p9wginspn9zk8digiz7dzv9n"))))
    (build-system gnu-build-system)
@@ -93,7 +94,7 @@ data.")
 (define-public oauth2l
  (package
    (name "oauth2l")
-    (version "1.2.2")
+    (version "1.3.0")
    (source
     (origin
       (method git-fetch)
@@ -102,7 +103,7 @@ data.")
             (commit (string-append "v" version))))
       (file-name (git-file-name name version))
       (sha256
-        (base32 "0a9x0b31ybyjg0k7923xw6zr6crm0kigcn8g6hyr228nbvw35r8w"))))
+        (base32 "0010870xdhf0aysrs2vhl3yxd4gh87qp7mjpyp7qy1n2rz55pgbc"))))
    (build-system go-build-system)
    (arguments
     '(#:import-path "github.com/google/oauth2l"))
@@ -56,7 +56,7 @@ The files in the list do not have extensions (.el, .elc)."
  (let ((autoloads (mapcan #'guix-emacs-find-autoloads
                           (guix-emacs--non-core-load-path))))
    (mapc (lambda (f)
-            (load f 'noerror))
+            (load f 'noerror t))
          autoloads)))

 ;;;###autoload
--- a/Show More
+++ b/Show More