Merge branch 'master' into core-updates

2 files changed, 79 insertions, 9 deletions

diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm
index c6c7e7fd3b..30f5e87d5a 100644
--- a/gnu/build/activation.scm
+++ b/gnu/build/activation.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -247,7 +247,19 @@ they already exist."
                          string<?))
       (mkdir-p %setuid-directory))
 
-  (for-each make-setuid-program programs))
+  (for-each (lambda (program)
+              (catch 'system-error
+                (lambda ()
+                  (make-setuid-program program))
+                (lambda args
+                  ;; If we fail to create a setuid program, better keep going
+                  ;; so that we don't leave %SETUID-DIRECTORY empty or
+                  ;; half-populated.  This can happen if PROGRAMS contains
+                  ;; incorrect file names: <https://bugs.gnu.org/38800>.
+                  (format (current-error-port)
+                          "warning: failed to make '~a' setuid-root: ~a~%"
+                          program (strerror (system-error-errno args))))))
+            programs))
 
 (define (activate-special-files special-files)
   "Install the files listed in SPECIAL-FILES.  Each element of SPECIAL-FILES
@@ -269,9 +281,13 @@ second element is the name it should appear at, such as:
 
 (define (activate-modprobe modprobe)
   "Tell the kernel to use MODPROBE to load modules."
-  (call-with-output-file "/proc/sys/kernel/modprobe"
-    (lambda (port)
-      (display modprobe port))))
+
+  ;; If the kernel was built without loadable module support, this file is
+  ;; unavailable, so check for its existence first.
+  (when (file-exists? "/proc/sys/kernel/modprobe")
+    (call-with-output-file "/proc/sys/kernel/modprobe"
+      (lambda (port)
+        (display modprobe port)))))
 
 (define (activate-firmware directory)
   "Tell the kernel to look for device firmware under DIRECTORY.  This
diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index 13c44aa728..ee6375515f 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -3,6 +3,8 @@
 ;;; 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 David C. Trudgian <dave@trudgian.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -296,6 +298,45 @@ string.  Trailing spaces are trimmed."
 
 
 ;;;
+;;; JFS file systems.
+;;;
+
+;; Taken from <linux-libre>/fs/jfs/jfs_superblock.h.
+
+(define-syntax %jfs-endianness
+  ;; Endianness of JFS file systems.
+  (identifier-syntax (endianness little)))
+
+(define (jfs-superblock? sblock)
+  "Return #t when SBLOCK is a JFS superblock."
+  (bytevector=? (sub-bytevector sblock 0 4)
+                (string->utf8 "JFS1")))
+
+(define (read-jfs-superblock device)
+  "Return the raw contents of DEVICE's JFS superblock as a bytevector, or #f
+if DEVICE does not contain a JFS file system."
+  (read-superblock device 32768 184 jfs-superblock?))
+
+(define (jfs-superblock-uuid sblock)
+  "Return the UUID of JFS superblock SBLOCK as a 16-byte bytevector."
+  (sub-bytevector sblock 136 16))
+
+(define (jfs-superblock-volume-name sblock)
+  "Return the volume name of SBLOCK as a string of at most 16 characters, or
+#f if SBLOCK has no volume name."
+  (null-terminated-latin1->string (sub-bytevector sblock 152 16)))
+
+(define (check-jfs-file-system device)
+  "Return the health of a JFS file system on DEVICE."
+  (match (status:exit-val
+          (system* "jfs_fsck" "-p" "-v" device))
+    (0 'pass)
+    (1 'errors-corrected)
+    (2 'reboot-required)
+    (_ 'fatal-error)))
+
+
+;;;
 ;;; LUKS encrypted devices.
 ;;;
 
@@ -303,6 +344,10 @@ string.  Trailing spaces are trimmed."
 ;; <https://gitlab.com/cryptsetup/cryptsetup/wikis/Specification>.  We follow
 ;; version 1.2.1 of this document.
 
+;; The LUKS2 header format is described in "LUKS2 On-Disk Format Specification":
+;; <https://gitlab.com/cryptsetup/LUKS2-docs/blob/master/luks2_doc_wip.pdf>.
+;; It is a WIP document.
+
 (define-syntax %luks-endianness
   ;; Endianness of LUKS headers.
   (identifier-syntax (endianness big)))
@@ -316,12 +361,16 @@ string.  Trailing spaces are trimmed."
   (let ((magic   (sub-bytevector sblock 0 6))
         (version (bytevector-u16-ref sblock 6 %luks-endianness)))
     (and (bytevector=? magic %luks-magic)
-         (= version 1))))
+         (or (= version 1) (= version 2)))))
 
 (define (read-luks-header file)
   "Read a LUKS header from FILE.  Return the raw header on success, and #f if
 not valid header was found."
-  ;; Size in bytes of the LUKS header, including key slots.
+  ;; Size in bytes of the LUKS binary header, which includes key slots in
+  ;; LUKS1.  In LUKS2 the binary header is partially backward compatible, so
+  ;; that UUID can be extracted as for LUKS1. Keyslots and other metadata are
+  ;; not part of this header in LUKS2, but are included in the JSON metadata
+  ;; area that follows.
   (read-superblock file 0 592 luks-superblock?))
 
 (define (luks-header-uuid header)
@@ -420,7 +469,9 @@ partition field reader that returned a value."
         (partition-field-reader read-fat32-superblock
                                 fat32-superblock-volume-name)
         (partition-field-reader read-fat16-superblock
-                                fat16-superblock-volume-name)))
+                                fat16-superblock-volume-name)
+        (partition-field-reader read-jfs-superblock
+                                jfs-superblock-volume-name)))
 
 (define %partition-uuid-readers
   (list (partition-field-reader read-iso9660-superblock
@@ -432,7 +483,9 @@ partition field reader that returned a value."
         (partition-field-reader read-fat32-superblock
                                 fat32-superblock-uuid)
         (partition-field-reader read-fat16-superblock
-                                fat16-superblock-uuid)))
+                                fat16-superblock-uuid)
+        (partition-field-reader read-jfs-superblock
+                                jfs-superblock-uuid)))
 
 (define read-partition-label
   (cut read-partition-field <> %partition-label-readers))
@@ -527,6 +580,7 @@ were found."
      ((string-prefix? "ext" type) check-ext2-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)
      (else #f)))
 
   (if check-procedure