doc: Update URLs for the manual and cookbook translations.

* doc/htmlxref.cnf: Update URLs for "guix" and "guix-cookbook".

Makefile.am

@@ -426,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

NEWS

@@ -34,6 +34,7 @@ Please send Guix bug reports to bug-guix@gnu.org.
 *** ‘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
@@ -52,6 +53,7 @@ Please send Guix bug reports to bug-guix@gnu.org.
 *** 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
@@ -78,9 +80,28 @@ Please send Guix bug reports to bug-guix@gnu.org.
 *** 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
+*** Chromium extensions are now built in a deterministic fashion
+*** The ‘rsync’ service lets you specify individual “modules”
+*** New services
+
+anonip, bitmask, fail2ban, gitile, greetd, jami, lightdm, log-cleanup,
+nar-herder, opendht, rasdaemon, samba, seatd, strongswan, wsdd
+
+*** 5311 new packages
+
+*** 6573 package updates
+
+Noteworthy updates:
+bash 5.1.8, binutils 2.37, clojure 1.11.1, cups 2.3.3op2, emacs 28.2,
+enlightenment 0.25.4, gcc-toolchain 12.2.0, gdb 12.1, ghc 8.10.7,
+gimp 2.10.32, glibc 2.33, gnome 42.4, gnupg 2.2.32, go 1.19.1, guile 3.0.8,
+icecat 102.5.0-guix0-preview1, icedtea 3.19.0, inkscape 1.2.1, julia 1.6.7,
+libreoffice 7.4.3.2, linux-libre 6.0.10, ocaml 4.14.0, octave 7.2.0,
+openjdk 18, perl 5.34.0, python2 2.7.18, python 3.9.9, racket 8.7,
+rust 1.60.0, r 4.2.2, sbcl 2.2.10, shepherd 0.9.3, xorg-server 21.1.4
 
 ** Programming interfaces
-*** Package input fields can now plain package lists
+*** Package input fields can now be 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
@@ -90,7 +111,7 @@ Please send Guix bug reports to bug-guix@gnu.org.
 *** ‘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 platform) module
 *** New (guix read-print) module
 
 It provides a comment-preserving reader and a comment-preserving
@@ -101,11 +122,14 @@ pretty-printer smarter than (ice-9 pretty-print).
 This build system lets you build Guix instances from channel specifications,
 similar to how 'guix time-machine' would do it, as regular packages.
 
+*** New ‘pyproject-build-system’
+
+This is an extension of ‘python-build-system’ with support for PEP-517 and
+‘pyproject.toml’ files.  It may eventually get merged back into
+‘python-build-system’.
+
 *** 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
@@ -120,7 +144,6 @@ nar-herder, opendht, rasdaemon, samba, seatd, strongswan, wsdd
     (<https://issues.guix.gnu.org/51425>)
 *** Fonts can now be discovered in any profile via XDG_DATA_DIRS
     (<https://issues.guix.gnu.org/31403>)
-*** Python modules are searched in GUIX_PYTHONPATH instead of PYTHONPATH
 *** Various Python reproducibility fixes
 *** The installer now supports MSDOS disk labels on UEFI systems
     (<https://issues.guix.gnu.org/47889>)
@@ -128,10 +151,10 @@ nar-herder, opendht, rasdaemon, samba, seatd, strongswan, wsdd
     (<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://bugs.gnu.org/47458>)
+    (<https://issues.guix.gnu.org/47458>)
 *** The bootloader configuration now accepts multiple targets
-    (<https://issues.guix.gnu.org/40997>.)
-*** A file system mount point is always created when ‘create?’ is true
+    (<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
@@ -142,10 +165,12 @@ nar-herder, opendht, rasdaemon, samba, seatd, strongswan, wsdd
     (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
+*** 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)

doc/contributing.texi

@@ -1089,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

doc/guix.texi

@@ -10,8 +10,8 @@
 @include version.texi
 
 @c Identifier of the OpenPGP key used to sign tarballs and such.
-@set OPENPGP-SIGNING-KEY-ID 27D586A4F8900854329FF09F1260E46482E63562
-@set OPENPGP-SIGNING-KEY-URL https://sv.gnu.org/people/viewgpg.php?user_id=127547
+@set OPENPGP-SIGNING-KEY-ID 3CE464558A84FDC69DB40CFB090B11993D9AEBB5
+@set OPENPGP-SIGNING-KEY-URL https://sv.gnu.org/people/viewgpg.php?user_id=15145
 
 @c Base URL for downloads.
 @set BASE-URL https://ftp.gnu.org/gnu/guix
@@ -11706,8 +11706,7 @@ This is the declarative counterpart of @code{text-file}.
 @end deffn
 
 @deffn {Scheme Procedure} computed-file @var{name} @var{gexp} @
-          [#:local-build? #t]
-          [#:options '()]
+  [#:local-build? #t] [#:options '()]
 Return an object representing the store item @var{name}, a file or
 directory computed by @var{gexp}.  When @var{local-build?} is true (the
 default), the derivation is built locally.  @var{options} is a list of
@@ -39224,7 +39223,7 @@ $ qemu-system-x86_64 \
    -nic user,model=virtio-net-pci \
    -enable-kvm -m 2048 \
    -device virtio-blk,drive=myhd \
-   -drive if=none,file=/tmp/qemu-image,id=myhd
+   -drive if=none,file=guix-system-vm-image-@value{VERSION}.x86_64-linux.qcow2,id=myhd
 @end example
 
 Here is what each of these options means:
@@ -39260,8 +39259,9 @@ better performance than if it were emulating a complete disk drive.  See the
 QEMU and KVM documentation for more info.
 
 @item -drive if=none,file=/tmp/qemu-image,id=myhd
-Use our QCOW image, the @file{/tmp/qemu-image} file, as the backing
-store of the ``myhd'' drive.
+Use our QCOW image, the
+@file{guix-system-vm-image-@value{VERSION}.x86_64-linux.qcow2} file, as
+the backing store of the ``myhd'' drive.
 @end table
 
 The default @command{run-vm.sh} script that is returned by an invocation of

doc/htmlxref.cnf

@@ -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-08-04.13; # UTC
+htmlxrefversion=2022-12-18.15; # UTC
 
 # Copyright 2010-2020, 2022 Free Software Foundation, Inc.
 # 
@@ -409,6 +409,8 @@ GUILE_GNOME = ${GS}/guile-gnome/docs
 
 guile-gtk	node	${GS}/guile-gtk/docs/guile-gtk/
 
+guile-netlink	mono	https://git.lepiller.eu/guile-netlink/manual/manual.html
+
 guile-rpc	mono	${GS}/guile-rpc/manual/guile-rpc.html
 guile-rpc	node	${GS}/guile-rpc/manual/html_node/
 
@@ -420,6 +422,8 @@ GUIX = ${GUIX_ROOT}/manual
  guix.es	node	${GUIX}/es/html_node/
  guix.fr	mono	${GUIX}/fr/guix.fr.html
  guix.fr	node	${GUIX}/fr/html_node/
+ guix.pt_BR	mono	${GUIX}/pt-br/guix.pt_BR.html
+ guix.pt_BR	node	${GUIX}/pt-br/html_node/
  guix.ru	mono	${GUIX}/ru/guix.ru.html
  guix.ru	node	${GUIX}/ru/html_node/
  guix.zh_CN	mono	${GUIX}/zh-cn/guix.zh_CN.html
@@ -428,10 +432,12 @@ GUIX = ${GUIX_ROOT}/manual
  guix		node	${GUIX}/en/html_node/
 
 GUIX_COOKBOOK = ${GUIX_ROOT}/cookbook
- guix-cookbook.de	mono	${GUIX_COOKBOOK}/de/guix-cookbook.html
+ guix-cookbook.de	mono	${GUIX_COOKBOOK}/de/guix-cookbook.de.html
  guix-cookbook.de	node    ${GUIX_COOKBOOK}/de/html_node/
- guix-cookbook.fr	mono    ${GUIX_COOKBOOK}/fr/guix-cookbook.html
+ guix-cookbook.fr	mono    ${GUIX_COOKBOOK}/fr/guix-cookbook.fr.html
  guix-cookbook.fr	node    ${GUIX_COOKBOOK}/fr/html_node/
+ guix-cookbook.sk	mono    ${GUIX_COOKBOOK}/sk/guix-cookbook.sk.html
+ guix-cookbook.sk	node    ${GUIX_COOKBOOK}/sk/html_node/
  guix-cookbook		mono    ${GUIX_COOKBOOK}/en/guix-cookbook.html
  guix-cookbook		node	${GUIX_COOKBOOK}/en/html_node/
 

etc/guix-install.sh

@@ -492,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?"; 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
 }
 

gnu/build/install.scm

@@ -1,5 +1,5 @@
 ;;; 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>
 ;;;
@@ -282,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))))

gnu/home/services/mcron.scm

@@ -77,35 +77,35 @@ Each message is also prefixed by a timestamp by GNU Shepherd."))
 (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  log? log-format)
-     (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-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-mcron))
 

gnu/home/services/shells.scm

@@ -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)
@@ -479,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)

gnu/home/services/xdg.scm

@@ -383,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

gnu/installer.scm

@@ -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)
@@ -52,6 +54,7 @@
   #: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?
@@ -315,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
@@ -429,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 ()

gnu/installer/final.scm

@@ -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.
 ;;;
@@ -114,6 +114,8 @@ it can interact with the rest of the system."
     ;; Catch SIGINT and kill the container process.
     (sigaction SIGINT
       (lambda (signum)
+        ;: FIXME: Use of SIGKILL prevents the dynamic-wind exit handler of
+        ;; THUNK to run.
         (false-if-exception
          (kill pid SIGKILL))))
 
@@ -196,14 +198,16 @@ or #f.  Return #t on success and #f on failure."
              ;; the loaded cow-store locale files will prevent umounting.
              (install-locale locale)
 
-             ;; Save the database, so that it can be restored once the
-             ;; cow-store is umounted.
+             ;; Stop the daemon and save the database, so that it can be
+             ;; restored once the cow-store is umounted.
+             (stop-service 'guix-daemon)
              (copy-file database-file saved-database)
+
+             (installer-log-line "mounting copy-on-write store")
              (mount-cow-store (%installer-target-dir) backing-directory))
            (lambda ()
              ;; We need to drag the guix-daemon to the container MNT
              ;; namespace, so that it can operate on the cow-store.
-             (stop-service 'guix-daemon)
              (start-service 'guix-daemon (list (number->string (getpid))))
 
              (setvbuf (current-output-port) 'none)
@@ -213,11 +217,25 @@ or #f.  Return #t on success and #f on failure."
 
              (set! ret (run-command install-command #:tty? #t)))
            (lambda ()
-             ;; Restart guix-daemon so that it does no keep the MNT namespace
+             ;; Stop guix-daemon so that it does no keep the MNT namespace
              ;; alive.
-             (restart-service 'guix-daemon)
+             (stop-service 'guix-daemon)
+
+             ;; Restore the database and restart it.  As part of restoring the
+             ;; database, remove the WAL and shm files in case they were left
+             ;; behind after guix-daemon was stopped.  Failing to do so,
+             ;; sqlite might behave as if transactions that appear in the WAL
+             ;; file were committed.  (See <https://www.sqlite.org/wal.html>.)
+             (installer-log-line "restoring store database from '~a'"
+                                 saved-database)
              (copy-file saved-database database-file)
+             (for-each (lambda (suffix)
+                         (false-if-exception
+                          (delete-file (string-append database-file suffix))))
+                       '("-wal" "-shm"))
+             (start-service 'guix-daemon)
 
              ;; Finally umount the cow-store and exit the container.
+             (installer-log-line "unmounting copy-on-write store")
              (unmount-cow-store (%installer-target-dir) backing-directory)
              (assert-exit ret))))))))

gnu/installer/newt.scm

@@ -116,7 +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")))
+          (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))

gnu/installer/parted.scm

@@ -379,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))

gnu/installer/utils.scm

@@ -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.
 ;;;
@@ -159,7 +159,9 @@ 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
@@ -186,7 +188,7 @@ in a pseudoterminal."
 
   (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))
@@ -264,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)
@@ -293,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
@@ -309,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)))))))
 
 
 ;;;

gnu/packages/julia-xyz.scm

@@ -1472,6 +1472,15 @@ valuable enough at this time.")
                 (("pip install")
                  (string-append (search-input-file inputs "bin/pip")
                                 " install")))))
+          (add-after 'link-depot 'fix-test-git-submodule
+            ;; Git v2.38.1 fixes security issues and changes the default
+            ;; behaviour of `git submodule`.  This substitution is a backport
+            ;; of the upstream patch, not yet released, fixing the test suite.
+            ;; https://github.com/JuliaDocs/Documenter.jl/commit/b5a5c65d02d136743e7c18ffebf8baba900484fc
+            (lambda* (#:key inputs #:allow-other-keys)
+              (substitute* "test/utilities.jl"
+                (("submodule add")
+                 "-c protocol.file.allow=always submodule add"))))
           (add-after 'link-depot 'remove-javascript-downloads
             (lambda _
               (substitute* "src/Writers/HTMLWriter.jl"

gnu/packages/package-management.scm

@@ -164,9 +164,9 @@
   ;; Latest version of Guix, which may or may not correspond to a release.
   ;; Note: the 'update-guix-package.scm' script expects this definition to
   ;; start precisely like this.
-  (let ((version "1.3.0")
-        (commit "682639c107908426fe6bf0a1b8404b98b7820290")
-        (revision 32))
+  (let ((version "1.4.0rc2")
+        (commit "7866294e32f1e758d06fce4e1b1035eca3a7d772")
+        (revision 0))
     (package
       (name "guix")
 
@@ -182,7 +182,7 @@
                       (commit commit)))
                 (sha256
                  (base32
-                  "1ap8hfq46ncp7azhdvc9s64a9q9y74xfqpgfwlcgz6sw82a09yh0"))
+                  "0np4fw5kq882nrkfgsvvwgcxqwvm6bzn3dbdf8p48nr7mfrm3rz9"))
                 (file-name (string-append "guix-" version "-checkout"))))
       (build-system gnu-build-system)
       (arguments

gnu/packages/texinfo.scm

@@ -75,7 +75,8 @@
             %standard-phases)
 
        ;; XXX: Work around <https://issues.guix.gnu.org/59616>.
-       #:tests? ,(not (hurd-target?))))
+       #:tests? ,(and (not (hurd-target?))
+                      (not (%current-target-system)))))
     (inputs (list ncurses perl))
     ;; When cross-compiling, texinfo will build some of its own binaries with
     ;; the native compiler. This means ncurses is needed both in both inputs

gnu/services/configuration.scm

@@ -249,7 +249,7 @@ does not have a default value" field kind)))
                        #'(field ...)
                        #'(field-getter ...)
                        #'(field-default ...))
-               (%location #,(id #'stem #'stem #'-location)
+               (%location #,(id #'stem #'stem #'-source-location)
                           (default (and=> (current-source-location)
                                           source-properties->location))
                           (innate)))

gnu/services/cuirass.scm

@@ -125,7 +125,7 @@
   (let ((cuirass          (cuirass-configuration-cuirass config))
         (cache-directory  (cuirass-configuration-cache-directory config))
         (web-log-file     (cuirass-configuration-web-log-file config))
-        (log-file         (cuirass-configuration-log-file config))
+        (main-log-file    (cuirass-configuration-log-file config))
         (user             (cuirass-configuration-user config))
         (group            (cuirass-configuration-group config))
         (interval         (cuirass-configuration-interval config))
@@ -169,7 +169,7 @@
 
                   #:user #$user
                   #:group #$group
-                  #:log-file #$log-file))
+                  #:log-file #$main-log-file))
         (stop #~(make-kill-destructor)))
       ,(shepherd-service
         (documentation "Run Cuirass web interface.")

gnu/services/getmail.scm

@@ -215,17 +215,6 @@ lines.")
    (parameter-alist '())
    "Extra options to include."))
 
-(define (serialize-getmail-configuration-file field-name val)
-  (match-record val <getmail-configuration-file>
-    (retriever destination options)
-    #~(string-append
-       "[retriever]\n"
-       #$(serialize-getmail-retriever-configuration #f retriever)
-       "\n[destination]\n"
-       #$(serialize-getmail-destination-configuration #f destination)
-       "\n[options]\n"
-       #$(serialize-getmail-options-configuration #f options))))
-
 (define-configuration getmail-configuration-file
   (retriever
    (getmail-retriever-configuration (getmail-retriever-configuration))
@@ -237,6 +226,17 @@ lines.")
    (getmail-options-configuration (getmail-options-configuration))
    "Configure getmail."))
 
+(define (serialize-getmail-configuration-file field-name val)
+  (match-record val <getmail-configuration-file>
+    (retriever destination options)
+    #~(string-append
+       "[retriever]\n"
+       #$(serialize-getmail-retriever-configuration #f retriever)
+       "\n[destination]\n"
+       #$(serialize-getmail-destination-configuration #f destination)
+       "\n[options]\n"
+       #$(serialize-getmail-options-configuration #f options))))
+
 (define (serialize-symbol field-name val) "")
 (define (serialize-getmail-configuration field-name val) "")
 

gnu/services/security.scm

@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2022 muradm <mail@muradm.net>
+;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -351,28 +352,27 @@ provided as a list of file-like objects."))
   (match-record config <fail2ban-configuration>
     (fail2ban run-directory)
     (let* ((fail2ban-server (file-append fail2ban "/bin/fail2ban-server"))
+           (fail2ban-client (file-append fail2ban "/bin/fail2ban-client"))
            (pid-file (in-vicinity run-directory "fail2ban.pid"))
            (socket-file (in-vicinity run-directory "fail2ban.sock"))
            (config-dir (file-append (config->fail2ban-etc-directory config)
                                     "/etc/fail2ban"))
            (fail2ban-action (lambda args
-                              #~(lambda _
-                                  (invoke #$fail2ban-server
-                                          "-c" #$config-dir
-                                          "-p" #$pid-file
-                                          "-s" #$socket-file
-                                          "-b"
-                                          #$@args)))))
+                              #~(invoke #$fail2ban-client #$@args))))
 
-      ;; TODO: Add 'reload' action.
+      ;; TODO: Add 'reload' action (see 'fail2ban.service.in' in the source).
       (list (shepherd-service
              (provision '(fail2ban))
              (documentation "Run the fail2ban daemon.")
              (requirement '(user-processes))
-             (modules `((ice-9 match)
-                        ,@%default-modules))
-             (start (fail2ban-action "start"))
-             (stop (fail2ban-action "stop")))))))
+             (start #~(make-forkexec-constructor
+                       (list #$fail2ban-server
+                             "-c" #$config-dir "-s" #$socket-file
+                             "-p" #$pid-file "-xf" "start")
+                       #:pid-file #$pid-file))
+             (stop #~(lambda (_)
+                       #$(fail2ban-action "stop")
+                       #f)))))))                  ;successfully stopped
 
 (define fail2ban-service-type
   (service-type (name 'fail2ban)

gnu/system.scm

@@ -38,6 +38,7 @@
   #:use-module (guix gexp)
   #:use-module (guix records)
   #:use-module (guix packages)
+  #:use-module (guix deprecation)
   #:use-module (guix derivations)
   #:use-module (guix profiles)
   #:use-module ((guix utils) #:select (substitute-keyword-arguments))
@@ -49,9 +50,6 @@
   #:use-module (gnu packages bash)
   #:use-module (gnu packages compression)
   #:use-module (gnu packages cross-base)
-  #:use-module (gnu packages cryptsetup)
-  #:use-module (gnu packages disk)
-  #:use-module (gnu packages file-systems)
   #:use-module (gnu packages firmware)
   #:use-module (gnu packages gawk)
   #:use-module (gnu packages guile)
@@ -858,6 +856,8 @@ of PROVENANCE-SERVICE-TYPE to its services."
  (cons* procps psmisc which
         (@ (gnu packages admin) shadow-with-man-pages) ;for 'passwd'
 
+        e2fsprogs                 ;for lsattr, chattr, etc.
+
         guile-3.0-latest
 
         ;; The packages below are also in %FINAL-INPUTS, so take them from
@@ -896,20 +896,7 @@ of PROVENANCE-SERVICE-TYPE to its services."
         ;; many people are familiar with, so keep it around.
         iw wireless-tools))
 
-(define %base-packages-disk-utilities
-  ;; A well-rounded set of packages for interacting with disks,
-  ;; partitions and filesystems, included with the Guix installation
-  ;; image.
-  (list parted gptfdisk ddrescue
-        ;; We used to provide fdisk from GNU fdisk, but as of version 2.0.0a
-        ;; it pulls Guile 1.8, which takes unreasonable space; furthermore
-        ;; util-linux's fdisk is already available, in %base-packages-linux.
-        cryptsetup mdadm
-        dosfstools
-        btrfs-progs
-        f2fs-tools
-        jfsutils
-        xfsprogs))
+(define-deprecated %base-packages-disk-utilities #f '())
 
 (define %base-packages
   ;; Default set of packages globally visible.  It should include anything

gnu/system/examples/yggdrasil.tmpl

@@ -1,60 +0,0 @@
-;; This is an operating system configuration template
-;; for a "bare bones" setup, with no X11 display server.
-
-(use-modules (gnu))
-(use-service-modules networking ssh)
-(use-package-modules admin curl networking screen)
-
-(operating-system
-  (host-name "ruby-guard-5545")
-  (timezone "Europe/Budapest")
-  (locale "en_US.utf8")
-
-  ;; Boot in "legacy" BIOS mode, assuming /dev/sdX is the
-  ;; target hard disk, and "my-root" is the label of the target
-  ;; root file system.
-  (bootloader (bootloader-configuration
-                (bootloader grub-bootloader)
-                (targets '("/dev/sdX"))))
-  (file-systems (cons (file-system
-                        (device (file-system-label "my-root"))
-                        (mount-point "/")
-                        (type "ext4"))
-                      %base-file-systems))
-  (users (cons (user-account
-                (name "alice")
-                (comment "Bob's sister")
-                (group "users")
-                ;; adding her to the yggdrasil group means she can use
-                ;; yggdrasilctl to modify the configuration
-                (supplementary-groups '("wheel" "yggdrasil")))
-               %base-user-accounts))
-
-  ;; Globally-installed packages.
-  (packages (cons* screen curl %base-packages))
-
-  ;; Add services to the baseline: a DHCP client and
-  ;; an SSH server.
-  ;; If you add an /etc/yggdrasil-private.conf, you can log in to ssh
-  ;; using your Yggdrasil IPv6 address from another machine running Yggdrasil.
-  ;; Alternatively, the client can sit behind a router that has Yggdrasil.
-  ;; That file is specifically _not_ handled by Guix, because we don't want its
-  ;; contents to sit in the world-readable /gnu/store.
-  (services
-   (append
-    (list
-     (service dhcp-client-service-type)
-     (service yggdrasil-service-type
-              (yggdrasil-configuration
-               (log-to 'stdout)
-               (log-level 'debug)
-               (autoconf? #f)
-               (json-config
-                ;; choose a few from
-                ;; https://github.com/yggdrasil-network/public-peers
-                '((peers . #("tcp://1.2.3.4:1337"))))
-               (config-file #f)))
-     (service openssh-service-type
-              (openssh-configuration
-               (port-number 2222))))
-    %base-services)))

gnu/system/image.scm

@@ -972,9 +972,9 @@ image, depending on IMAGE format."
                 (G_ "~a: unsupported image format") image-format)))))))
 
 
-;;
-;; Image detection.
-;;
+;;;
+;;; Image type discovery.
+;;;
 
 (define (image-modules)
   "Return the list of image modules."

gnu/system/install.scm

@@ -48,6 +48,9 @@
   #:use-module (gnu packages bootloaders)
   #:use-module (gnu packages certs)
   #:use-module (gnu packages compression)
+  #:use-module (gnu packages cryptsetup)
+  #:use-module (gnu packages disk)
+  #:use-module (gnu packages file-systems)
   #:use-module (gnu packages fonts)
   #:use-module (gnu packages fontutils)
   #:use-module (gnu packages guile)
@@ -281,13 +284,24 @@ templates under @file{/etc/configuration}.")))
 ;; appropriate options.  The GUI installer needs it when the machine does not
 ;; support Kernel Mode Setting.  Otherwise kmscon is missing /dev/fb0.
 (define (uvesafb-shepherd-service _)
+  (define modprobe
+    (program-file "modprobe-wrapper"
+                  #~(begin
+                      ;; Use a wrapper because shepherd 0.9.3 won't let us
+                      ;; pass environment variables to the child process:
+                      ;; <https://issues.guix.gnu.org/60106>.
+                      (setenv "LINUX_MODULE_DIRECTORY"
+                              "/run/booted-system/kernel/lib/modules")
+                      (apply execl #$(file-append kmod "/bin/modprobe")
+                             "modprobe" (cdr (command-line))))))
+
   (list (shepherd-service
          (documentation "Load the uvesafb kernel module if needed.")
          (provision '(maybe-uvesafb))
          (requirement '(file-systems))
          (start #~(lambda ()
                     (or (file-exists? "/dev/fb0")
-                        (invoke #+(file-append kmod "/bin/modprobe")
+                        (invoke #+modprobe
                                 "uvesafb"
                                 (string-append "v86d=" #$v86d "/sbin/v86d")
                                 "mode_option=1024x768"))))
@@ -458,6 +472,21 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m
 \x1b[1;33mUse Alt-F2 for documentation.\x1b[0m
 ")
 
+(define %installer-disk-utilities
+  ;; A well-rounded set of packages for interacting with disks, partitions and
+  ;; file systems, included with the Guix installation image.
+  (list parted gptfdisk ddrescue
+        ;; We used to provide fdisk from GNU fdisk, but as of version 2.0.0a
+        ;; it pulls Guile 1.8, which takes unreasonable space; furthermore
+        ;; util-linux's fdisk is already available, in %base-packages-linux.
+        cryptsetup mdadm
+        dosfstools
+        btrfs-progs
+        e2fsprogs
+        f2fs-tools
+        jfsutils
+        xfsprogs))
+
 (define installation-os
   ;; The operating system used on installation images for USB sticks etc.
   (operating-system
@@ -530,7 +559,7 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m
                       font-dejavu font-gnu-unifont
                       grub          ; mostly so xrefs to its manual work
                       nss-certs)    ; To access HTTPS, use git, etc.
-                %base-packages-disk-utilities
+                %installer-disk-utilities
                 %base-packages))))
 
 (define* (os-with-u-boot os board #:key (bootloader-target "/dev/mmcblk0")

gnu/system/vm.scm

@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; 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 Christine Lemmer-Webber <cwebber@dustycloud.org>
 ;;; Copyright © 2016, 2017 Leo Famulari <leo@famulari.name>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
@@ -234,8 +234,8 @@ with '-virtfs' options for the host file systems listed in SHARED-FS."
 
      #$@(map virtfs-option shared-fs)
      #$@(if rw-image?
-            #~((format #f "-drive file=~a,if=virtio" #$image))
-            #~((format #f "-drive file=~a,if=virtio,cache=writeback,werror=report,readonly=on"
+            #~((format #f "-drive file=~a,format=qcow2,if=virtio" #$image))
+            #~((format #f "-drive file=~a,format=raw,if=virtio,cache=writeback,werror=report,readonly=on"
                        #$image)))))
 
 (define* (system-qemu-image/shared-store-script os
@@ -303,17 +303,26 @@ useful when FULL-BOOT?  is true."
               "-m " (number->string #$memory-size)
               #$@options))
 
+    (define copy-image
+      ;; Script that "copies" BASE-IMAGE to /tmp.  Make a copy-on-write image,
+      ;; which is much cheaper than actually copying it.
+      (program-file "copy-image"
+                    (with-imported-modules '((guix build utils))
+                      #~(begin
+                          (use-modules (guix build utils))
+                          (unless (file-exists? #$rw-image)
+                            (invoke #+(file-append qemu "/bin/qemu-img")
+                                    "create" "-b" #$base-image
+                                    "-F" "raw" "-f" "qcow2" #$rw-image))))))
+
     (define builder
       #~(call-with-output-file #$output
           (lambda (port)
             (format port "#!~a~%"
                     #+(file-append bash "/bin/sh"))
-            (when (not #$volatile?)
-              (format port "~a~%"
-                      #$(program-file "copy-image"
-                                      #~(unless (file-exists? #$rw-image)
-                                          (copy-file #$base-image #$rw-image)
-                                          (chmod #$rw-image #o640)))))
+            #$@(if volatile?
+                   #~()
+                   #~((format port "~a~%" #+copy-image)))
             (format port "exec ~a \"$@\"~%"
                     (string-join #$qemu-exec " "))
             (chmod port #o555))))

gnu/tests/docker.scm

@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019 Danny Milosavljevic <dannym@scratchpost.org>
-;;; Copyright © 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019-2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -209,7 +209,7 @@ inside %DOCKER-OS."
     (virtual-machine
      (operating-system os)
      (volatile? #f)
-     (disk-image-size (* 5000 (expt 2 20)))
+     (disk-image-size (* 5500 (expt 2 20)))
      (memory-size 2048)
      (port-forwardings '())))
 

gnu/tests/install.scm

@@ -471,8 +471,6 @@ reboot\n")
     (mlet* %store-monad ((images (run-install
                                   %minimal-os-on-vda
                                   %minimal-os-on-vda-source
-                                  #:packages
-                                  (list e2fsprogs)
                                   #:script
                                   %simple-installation-script-for-/dev/vda
                                   #:installation-image-type

guix/build/syscalls.scm

@@ -447,9 +447,14 @@ If an error occurs while creating the binding, defer the error report until
 the returned procedure is called."
   (catch #t
     (lambda ()
+      ;; Note: When #:library is set, try it first and fall back to libc
+      ;; proper.  This is because libraries like libutil.so have been subsumed
+      ;; by libc.so with glibc >= 2.34.
       (let ((ptr (dynamic-func name
                                (if library
-                                   (dynamic-link library)
+                                   (or (false-if-exception
+                                        (dynamic-link library))
+                                       (dynamic-link))
                                    (dynamic-link)))))
         ;; The #:return-errno? facility was introduced in Guile 2.0.12.
         (pointer->procedure return-type ptr argument-types

guix/modules.scm

@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017, 2018, 2019, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016-2019, 2021-2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -77,7 +77,7 @@ CLAUSES."
       ((#:autoload module _ rest ...)
        (loop rest (cons module result)))
       (((or #:export #:re-export #:export-syntax #:re-export-syntax
-            #:re-export-and-replace #:replace #:version)
+            #:re-export-and-replace #:replace #:version #:declarative?)
         _ rest ...)
        (loop rest result))
       (((or #:pure #:no-backtrace) rest ...)

guix/records.scm

@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Mark H Weaver <mhw@netris.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -104,6 +104,10 @@ error-reporting purposes."
            (()
             #t)))))))
 
+(define-syntax map-fields
+  (lambda (x)
+    (syntax-violation 'map-fields "bad use of syntactic keyword" x x)))
+
 (define-syntax-parameter this-record
   (lambda (s)
     "Return the record being defined.  This macro may only be used in the
@@ -325,6 +329,15 @@ This expression returns a new object equal to 'x' except for its 'name'
 field and its 'loc' field---the latter is marked as \"innate\", so it is not
 inherited."
 
+    (define (rtd-identifier type)
+      ;; Return an identifier derived from TYPE to name its record type
+      ;; descriptor (RTD).
+      (let ((type-name (syntax->datum type)))
+        (datum->syntax
+         type
+         (string->symbol
+          (string-append "% " (symbol->string type-name) " rtd")))))
+
     (define (field-default-value s)
       (syntax-case s (default)
         ((field (default val) _ ...)
@@ -428,10 +441,31 @@ inherited."
                                             field)))
                                     field-spec)))
            #`(begin
-               (define-record-type type
+               (define-record-type #,(rtd-identifier #'type)
                  (ctor field ...)
                  pred
                  field-spec* ...)
+
+               ;; Rectify the vtable type name...
+               (set-struct-vtable-name! #,(rtd-identifier #'type) 'type)
+               (cond-expand
+                (guile-3
+                 ;; ... and the record type name.
+                 (struct-set! #,(rtd-identifier #'type) vtable-offset-user
+                              'type))
+                (else #f))
+
+               (define-syntax type
+                 (lambda (s)
+                   "This macro lets us query record type info at
+macro-expansion time."
+                   (syntax-case s (map-fields)
+                     ((_ map-fields macro)
+                      #'(macro (field ...)))
+                     (id
+                      (identifier? #'id)
+                      #'#,(rtd-identifier #'type)))))
+
                (define #,(current-abi-identifier #'type)
                  #,cookie)
 
@@ -535,19 +569,50 @@ pairs.  Stop upon an empty line (after consuming it) or EOF."
               (else
                (error "unmatched line" line))))))))
 
+
+;;;
+;;; Pattern matching.
+;;;
+
+(define-syntax lookup-field
+  (lambda (s)
+    "Look up FIELD in the given list and return an expression that represents
+its offset in the record.  Raise a syntax violation when the field is not
+found."
+    (syntax-case s ()
+      ((_ field offset ())
+       (syntax-violation 'lookup-field "unknown record type field"
+                         s #'field))
+      ((_ field offset (head tail ...))
+       (free-identifier=? #'field #'head)
+       #'offset)
+      ((_ field offset (_ tail ...))
+       #'(lookup-field field (+ 1 offset) (tail ...))))))
+
+(define-syntax match-record-inner
+  (lambda (s)
+    (syntax-case s ()
+      ((_ record type (field rest ...) body ...)
+       #`(let-syntax ((field-offset (syntax-rules ()
+			              ((_ f)
+                                       (lookup-field field 0 f)))))
+           (let* ((offset (type map-fields field-offset))
+                  (field  (struct-ref record offset)))
+             (match-record-inner record type (rest ...) body ...))))
+      ((_ record type () body ...)
+       #'(begin body ...)))))
+
 (define-syntax match-record
   (syntax-rules ()
     "Bind each FIELD of a RECORD of the given TYPE to it's FIELD name.
+The order in which fields appear does not matter.  A syntax error is raised if
+an unknown field is queried.
+
 The current implementation does not support thunked and delayed fields."
-    ((_ record type (field fields ...) body ...)
+    ;; TODO support thunked and delayed fields
+    ((_ record type (fields ...) body ...)
      (if (eq? (struct-vtable record) type)
-         ;; TODO compute indices and report wrong-field-name errors at
-         ;;      expansion time
-         ;; TODO support thunked and delayed fields
-         (let ((field ((record-accessor type 'field) record)))
-           (match-record record type (fields ...) body ...))
-         (throw 'wrong-type-arg record)))
-    ((_ record type () body ...)
-     (begin body ...))))
+         (match-record-inner record type (fields ...) body ...)
+         (throw 'wrong-type-arg record)))))
 
 ;;; records.scm ends here

guix/scripts/environment.scm

@@ -728,14 +728,21 @@ WHILE-LIST."
             (home     (getenv "HOME"))
             (uid      (if user 1000 (getuid)))
             (gid      (if user 1000 (getgid)))
-            (passwd   (let ((pwd (getpwuid (getuid))))
+
+            ;; On a foreign distro, the name service switch might be
+            ;; dysfunctional and 'getpwuid' throws.  Don't let that hamper
+            ;; operations.
+            (passwd   (let ((pwd (false-if-exception (getpwuid (getuid)))))
                         (password-entry
-                         (name (or user (passwd:name pwd)))
-                         (real-name (if user
+                         (name (or user
+                                   (and=> pwd passwd:name)
+                                   (getenv "USER")
+                                   "charlie"))
+                         (real-name (if (or user (not pwd))
                                         ""
                                         (passwd:gecos pwd)))
                          (uid uid) (gid gid) (shell bash)
-                         (directory (if user
+                         (directory (if (or user (not pwd))
                                         (string-append "/home/" user)
                                         (passwd:dir pwd))))))
             (groups   (list (group-entry (name "users") (gid gid))

guix/store/deduplication.scm

@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017 Caleb Ristvedt <caleb.ristvedt@cune.org>
-;;; Copyright © 2018-2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018-2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -262,7 +262,10 @@ down the road."
       (deduplicate file (dump-and-compute-hash) #:store store)
       (call-with-output-file file
         (lambda (output)
-          (dump-port input output size)))))
+          (if (file-port? input)
+              (sendfile output input size 0)
+              (dump-port input output size
+                         #:buffer-size %deduplication-minimum-size))))))
 
 (define* (copy-file/deduplicate source target
                                 #:key (store (%store-directory)))

nix/libstore/build.cc

@@ -2576,7 +2576,7 @@ Path DerivationGoal::openLogFile()
         closeOnExec(fd);
 
         if (!(fLogFile = fdopen(fd.borrow(), "w")))
-            throw SysError(format("opening file `%1%'") % logFileName);
+            throw SysError(format("opening log file `%1%'") % logFileName);
 
         int err;
         if (!(bzLogFile = BZ2_bzWriteOpen(&err, fLogFile, 9, 0, 0)))

nix/libutil/hash.cc

@@ -244,7 +244,7 @@ Hash hashFile(HashType ht, const Path & path)
     start(ht, ctx);
 
     AutoCloseFD fd = open(path.c_str(), O_RDONLY);
-    if (fd == -1) throw SysError(format("opening file `%1%'") % path);
+    if (fd == -1) throw SysError(format("computing hash of file `%1%'") % path);
 
     unsigned char buf[8192];
     ssize_t n;

nix/libutil/util.cc

@@ -264,7 +264,7 @@ string readFile(const Path & path, bool drain)
 {
     AutoCloseFD fd = open(path.c_str(), O_RDONLY);
     if (fd == -1)
-        throw SysError(format("opening file `%1%'") % path);
+        throw SysError(format("reading file `%1%'") % path);
     return drain ? drainFD(fd) : readFile(fd);
 }
 
@@ -273,7 +273,7 @@ void writeFile(const Path & path, const string & s)
 {
     AutoCloseFD fd = open(path.c_str(), O_WRONLY | O_TRUNC | O_CREAT, 0666);
     if (fd == -1)
-        throw SysError(format("opening file '%1%'") % path);
+        throw SysError(format("writing file '%1%'") % path);
     writeFull(fd, s);
 }
 

po/packages/LINGUAS

@@ -19,4 +19,5 @@ pt_BR
 sk
 sr
 tr
+vi
 zh_CN

tests/records.scm

@@ -528,4 +528,37 @@ Description: 1st line,
                  '("a" "b" "c")
                  '("a")))
 
+(test-equal "match-record, simple"
+  '((1 2) (a b))
+  (let ()
+    (define-record-type* <foo> foo make-foo
+      foo?
+      (first  foo-first (default 1))
+      (second foo-second))
+
+    (list (match-record (foo (second 2)) <foo>
+            (first second)
+            (list first second))
+          (match-record (foo (first 'a) (second 'b)) <foo>
+            (second first)
+            (list first second)))))
+
+(test-equal "match-record, unknown field"
+  'syntax-error
+  (catch 'syntax-error
+    (lambda ()
+      (eval '(begin
+               (use-modules (guix records))
+
+               (define-record-type* <foo> foo make-foo
+                 foo?
+                 (first  foo-first (default 1))
+                 (second foo-second))
+
+               (match-record (foo (second 2)) <foo>
+                 (one two)
+                 #f))
+            (make-fresh-user-module)))
+    (lambda (key . args) key)))
+
 (test-end)

tests/store-deduplication.scm

@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018, 2020-2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2020-2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -136,6 +136,21 @@
        (cons (apply = (map (compose stat:ino stat) identical))
              (map (compose stat:nlink stat) identical))))))
 
+(test-assert "copy-file/deduplicate, below %deduplication-minimum-size"
+  (call-with-temporary-directory
+   (lambda (store)
+     (let ((source (string-append store "/input")))
+       (call-with-output-file source
+         (lambda (port)
+           (display "Hello!\n" port)))
+       (copy-file/deduplicate source
+                              (string-append store "/a")
+                              #:store store)
+       (and (not (directory-exists? (string-append store "/.links")))
+            (file=? source (string-append store "/a"))
+            (not (= (stat:ino (stat (string-append store "/a")))
+                    (stat:ino (stat source)))))))))
+
 (test-assert "copy-file/deduplicate"
   (call-with-temporary-directory
    (lambda (store)