Merge branch 'master' into staging

 Conflicts:
	gnu/local.mk
	gnu/packages/gdb.scm
	gnu/packages/lisp-xyz.scm
	gnu/packages/web-browsers.scm

5 files changed, 186 insertions, 11 deletions

diff --git a/gnu/build/bootloader.scm b/gnu/build/bootloader.scm
index 5ec839f902..3916930c89 100644
--- a/gnu/build/bootloader.scm
+++ b/gnu/build/bootloader.scm
@@ -38,10 +38,13 @@
     (lambda (input)
       (let ((bv (get-bytevector-n input size)))
         (call-with-port
+         ;; Do not use "call-with-output-file" that would truncate the file.
          (open-file-output-port device
-                                (file-options no-truncate no-create)
+                                (file-options no-truncate no-fail)
                                 (buffer-mode block)
-                                (native-transcoder))
+                                ;; Use the binary-friendly ISO-8859-1
+                                ;; encoding.
+                                (make-transcoder (latin-1-codec)))
          (lambda (output)
            (seek output offset SEEK_SET)
            (put-bytevector output bv)))))))
diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index 734d648575..b762e82ad2 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -1,9 +1,9 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016, 2017 David Craven <david@craven.ch>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
-;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2019 David C. Trudgian <dave@trudgian.net>
 ;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
@@ -181,6 +181,98 @@ if DEVICE does not contain an ext2 file system."
 
 
 ;;;
+;;; Linux swap.
+;;;
+
+;; Linux "swap space" is not a file system but it has a UUID and volume name,
+;; like actual file systems, and we want to be able to look up swap partitions
+;; by UUID and by label.
+
+(define %linux-swap-magic
+  (string->utf8 "SWAPSPACE2"))
+
+;; Like 'PAGE_SIZE' in Linux, arch/x86/include/asm/page.h.
+;; XXX: This is always 4K on x86_64, i386, and ARMv7.  However, on AArch64,
+;; this is determined by 'CONFIG_ARM64_PAGE_SHIFT' in the kernel, which is 12
+;; by default (4K) but can be 14 or 16.
+(define %page-size 4096)
+
+(define (linux-swap-superblock? sblock)
+  "Return #t when SBLOCK is an linux-swap superblock."
+  (and (= (bytevector-length sblock) %page-size)
+       (bytevector=? (sub-bytevector sblock (- %page-size 10) 10)
+                     %linux-swap-magic)))
+
+(define (read-linux-swap-superblock device)
+  "Return the raw contents of DEVICE's linux-swap superblock as a bytevector, or #f
+if DEVICE does not contain an linux-swap file system."
+  (read-superblock device 0 %page-size linux-swap-superblock?))
+
+;; See 'union swap_header' in 'include/linux/swap.h'.
+
+(define (linux-swap-superblock-uuid sblock)
+  "Return the UUID of Linux-swap superblock SBLOCK as a 16-byte bytevector."
+  (sub-bytevector sblock (+ 1024 4 4 4) 16))
+
+(define (linux-swap-superblock-volume-name sblock)
+  "Return the label of Linux-swap superblock SBLOCK as a string."
+  (null-terminated-latin1->string
+   (sub-bytevector sblock (+ 1024 4 4 4 16) 16)))
+
+
+;;;
+;;; Bcachefs file systems.
+;;;
+
+;; <https://evilpiepirate.org/git/bcachefs-tools.git/tree/libbcachefs/bcachefs_format.h>
+
+(define-syntax %bcachefs-endianness
+  ;; Endianness of bcachefs file systems.
+  (identifier-syntax (endianness little)))
+
+(define (bcachefs-superblock? sblock)
+  "Return #t when SBLOCK is an bcachefs superblock."
+  (bytevector=? (sub-bytevector sblock 24 16)
+                #vu8(#xc6 #x85 #x73 #xf6 #x4e #x1a #x45 #xca
+                     #x82 #x65 #xf5 #x7f #x48 #xba #x6d #x81)))
+
+(define (read-bcachefs-superblock device)
+  "Return the raw contents of DEVICE's bcachefs superblock as a bytevector, or #f
+if DEVICE does not contain a bcachefs file system."
+  ;; We completely ignore the back-up superblock & any checksum errors.
+  ;; Superblock field names, with offset & length respectively, in bytes:
+  ;;  0 16 bch_csum
+  ;; 16  8 version
+  ;; 24 16 magic
+  ;; 40 16 uuid ← ‘internal UUID’, you probably don't want this
+  ;; 56 16 user_uuid ← ‘external UUID’, the one by which to mount
+  ;; 72 32 label
+  ;; … there are more & the superblock is extensible, but we don't care yet.
+  (read-superblock device 4096 104 bcachefs-superblock?))
+
+(define (bcachefs-superblock-external-uuid sblock)
+  "Return the external UUID of bcachefs superblock SBLOCK as a 16-byte
+bytevector."
+  (sub-bytevector sblock 56 16))
+
+(define (bcachefs-superblock-volume-name sblock)
+  "Return the volume name of SBLOCK as a string of at most 32 characters, or
+#f if SBLOCK has no volume name."
+  (null-terminated-latin1->string (sub-bytevector sblock 72 32)))
+
+(define (check-bcachefs-file-system device)
+  "Return the health of a bcachefs file system on DEVICE."
+  (match (status:exit-val
+          (apply system* "bcachefs" "fsck" "-p" "-v"
+                 ;; Make each multi-device member a separate argument.
+                 (string-split device #\:)))
+    (0 'pass)
+    (1 'errors-corrected)
+    (2 'reboot-required)
+    (_ 'fatal-error)))
+
+
+;;;
 ;;; Btrfs file systems.
 ;;;
 
@@ -596,6 +688,10 @@ partition field reader that returned a value."
                                 iso9660-superblock-volume-name)
         (partition-field-reader read-ext2-superblock
                                 ext2-superblock-volume-name)
+        (partition-field-reader read-linux-swap-superblock
+                                linux-swap-superblock-volume-name)
+        (partition-field-reader read-bcachefs-superblock
+                                bcachefs-superblock-volume-name)
         (partition-field-reader read-btrfs-superblock
                                 btrfs-superblock-volume-name)
         (partition-field-reader read-fat32-superblock
@@ -612,6 +708,10 @@ partition field reader that returned a value."
                                 iso9660-superblock-uuid)
         (partition-field-reader read-ext2-superblock
                                 ext2-superblock-uuid)
+        (partition-field-reader read-linux-swap-superblock
+                                linux-swap-superblock-uuid)
+        (partition-field-reader read-bcachefs-superblock
+                                bcachefs-superblock-external-uuid)
         (partition-field-reader read-btrfs-superblock
                                 btrfs-superblock-uuid)
         (partition-field-reader read-fat32-superblock
@@ -719,6 +819,7 @@ containing ':/')."
   (define check-procedure
     (cond
      ((string-prefix? "ext" type) check-ext2-file-system)
+     ((string-prefix? "bcachefs" type) check-bcachefs-file-system)
      ((string-prefix? "btrfs" type) check-btrfs-file-system)
      ((string-suffix? "fat" type) check-fat-file-system)
      ((string-prefix? "jfs" type) check-jfs-file-system)
diff --git a/gnu/build/image.scm b/gnu/build/image.scm
index 8a2d0eb5fd..640a784204 100644
--- a/gnu/build/image.scm
+++ b/gnu/build/image.scm
@@ -118,16 +118,16 @@ ROOT directory to populate the image."
      ((string=? type "vfat")
       (make-vfat-image partition target root))
      (else
-      (format (current-error-port)
-              "Unsupported partition type~%.")))))
+      (raise (condition
+              (&message
+               (message "unsupported partition type"))))))))
 
 (define (convert-disk-image image format output)
   "Convert IMAGE to OUTPUT according to the given FORMAT."
   (case format
     ((compressed-qcow2)
-     (begin
-       (invoke "qemu-img" "convert" "-c" "-f" "raw"
-               "-O" "qcow2" image output)))
+     (invoke "qemu-img" "convert" "-c" "-f" "raw"
+             "-O" "qcow2" image output))
     (else
      (copy-file image output))))
 
diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index 32e3536039..bfaac9ec1f 100644
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
 ;;;
@@ -110,6 +111,58 @@ OPTION doesn't appear in ARGUMENTS."
                        (substring arg (+ 1 (string-index arg #\=)))))
                 arguments)))
 
+(define (resume-if-hibernated device)
+  "Resume from hibernation if possible.  This is safe ONLY if no on-disk file
+systems have been mounted; calling it later risks severe file system corruption!
+See <Documentation/swsusp.txt> in the kernel source directory.  This is the
+caller's responsibility, as is catching exceptions if resumption was supposed to
+happen but didn't.
+
+Resume only from DEVICE if it's a string.  If it's #f, use the kernel's default
+hibernation device (CONFIG_PM_STD_PARTITION).  Never return if resumption
+succeeds.  Return nothing otherwise.  The kernel logs any details to dmesg."
+
+  (define (string->major:minor string)
+    "Return a string with MAJOR:MINOR numbers of the device specified by STRING"
+
+    ;; The "resume=" kernel command-line option always provides a string, which
+    ;; can represent a device, a UUID, or a label.  Check for all three.
+    (let* ((spec (cond ((string-prefix? "/" string) string)
+                       ((uuid string) => identity)
+                       (else (file-system-label string))))
+           ;; XXX The kernel's swsusp_resume_can_resume() waits if ‘resumewait’
+           ;; is found on the command line; our canonicalize-device-spec gives
+           ;; up after 20 seconds.  We could emulate the former by looping…
+           (device (canonicalize-device-spec spec))
+           (rdev (stat:rdev (stat device)))
+           ;; For backwards compatibility, device numbering is a baroque affair.
+           ;; This is the full 64-bit scheme used by glibc's <sys/sysmacros.h>.
+           (major (logior (ash (logand #x00000000000fff00 rdev) -8)
+                          (ash (logand #xfffff00000000000 rdev) -32)))
+           (minor (logior      (logand #x00000000000000ff rdev)
+                          (ash (logand #x00000ffffff00000 rdev) -12))))
+      (format #f "~a:~a" major minor)))
+
+  ;; Write the resume DEVICE to this magic file, using the MAJOR:MINOR device
+  ;; numbers if possible.  The kernel will immediately try to resume from it.
+  (let ((resume "/sys/power/resume"))
+    (when (file-exists? resume)         ; this kernel supports hibernation
+      ;; Honour the kernel's default device (only) if none other was given.
+      (let ((major:minor (if device
+                             (or (false-if-exception (string->major:minor
+                                                      device))
+                                 ;; We can't parse it.  Maybe the kernel can.
+                                 device)
+                             (let ((default (call-with-input-file resume
+                                              read-line)))
+                               ;; Don't waste time echoing 0:0 to /sys.
+                               (if (string=? "0:0" default)
+                                   #f
+                                   default)))))
+        (when major:minor
+          (call-with-output-file resume ; may throw an ‘Invalid argument’
+            (cut display major:minor <>))))))) ; may never return
+
 (define* (make-disk-device-nodes base major #:optional (minor 0))
   "Make the block device nodes around BASE (something like \"/root/dev/sda\")
 with the given MAJOR number, starting with MINOR."
@@ -507,6 +560,12 @@ upon error."
         (load-linux-modules-from-directory linux-modules
                                            linux-module-directory)
 
+        (unless (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)
diff --git a/gnu/build/shepherd.scm b/gnu/build/shepherd.scm
index 91646288d5..d7b858dea4 100644
--- a/gnu/build/shepherd.scm
+++ b/gnu/build/shepherd.scm
@@ -21,7 +21,6 @@
   #:use-module (gnu system file-systems)
   #:use-module (gnu build linux-container)
   #:use-module (guix build utils)
-  #:use-module (guix utils)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
@@ -199,11 +198,24 @@ namespace, in addition to essential bind-mounts such /proc."
   "This is a variant of 'fork+exec-command' procedure, that joins the
 namespaces of process PID beforehand.  If there is no support for containers,
 on Hurd systems for instance, fallback to direct forking."
+  (define (strip-pid args)
+    ;; TODO: Replace with 'strip-keyword-arguments' when that no longer pulls
+    ;; in (guix config).
+    (let loop ((args args)
+               (result '()))
+      (match args
+        (()
+         (reverse result))
+        ((#:pid _ . rest)
+         (loop rest result))
+        ((head . rest)
+         (loop rest (cons head result))))))
+
   (let ((container-support?
          (file-exists? "/proc/self/ns"))
         (fork-proc (lambda ()
                      (apply fork+exec-command command
-                            (strip-keyword-arguments '(#:pid) args)))))
+                            (strip-pid args)))))
     (if container-support?
         (container-excursion* pid fork-proc)
         (fork-proc))))