Merge remote-tracking branch 'origin/master' into core-updates

3 files changed, 69 insertions, 35 deletions

diff --git a/gnu/system/examples/beaglebone-black.tmpl b/gnu/system/examples/beaglebone-black.tmpl
index 609b801cab..4b090e0fb7 100644
--- a/gnu/system/examples/beaglebone-black.tmpl
+++ b/gnu/system/examples/beaglebone-black.tmpl
@@ -15,6 +15,11 @@
   (bootloader (bootloader-configuration
                (bootloader u-boot-beaglebone-black-bootloader)
                (target "/dev/mmcblk1")))
+  (initrd (lambda (fs . rest)
+            (apply base-initrd fs
+                   ;; This module is required to mount the sd card.
+                   #:extra-modules (list "omap_hsmmc")
+                   rest)))
   (file-systems (cons (file-system
                         (device "my-root")
                         (title 'label)
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index 27734e892a..7f5afb00fe 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -279,46 +279,47 @@ TARGET in the other system."
                    ;; parent directory.
                    (dependencies (list parent))))
                '("cpuset" "cpu" "cpuacct" "memory" "devices" "freezer"
-                 "blkio" "perf_event" "hugetlb")))))
+                 "blkio" "perf_event")))))
 
 (define %elogind-file-systems
   ;; We don't use systemd, but these file systems are needed for elogind,
   ;; which was extracted from systemd.
-  (list (file-system
-          (device "none")
-          (mount-point "/run/systemd")
-          (type "tmpfs")
-          (check? #f)
-          (flags '(no-suid no-dev no-exec))
-          (options "mode=0755")
-          (create-mount-point? #t))
-        (file-system
-          (device "none")
-          (mount-point "/run/user")
-          (type "tmpfs")
-          (check? #f)
-          (flags '(no-suid no-dev no-exec))
-          (options "mode=0755")
-          (create-mount-point? #t))
-        ;; Elogind uses cgroups to organize processes, allowing it to map PIDs
-        ;; to sessions.  Elogind's cgroup hierarchy isn't associated with any
-        ;; resource controller ("subsystem").
-        (file-system
-          (device "cgroup")
-          (mount-point "/sys/fs/cgroup/elogind")
-          (type "cgroup")
-          (check? #f)
-          (options "none,name=elogind")
-          (create-mount-point? #t)
-          (dependencies (list (car %control-groups))))))
+  (append
+   (list (file-system
+           (device "none")
+           (mount-point "/run/systemd")
+           (type "tmpfs")
+           (check? #f)
+           (flags '(no-suid no-dev no-exec))
+           (options "mode=0755")
+           (create-mount-point? #t))
+         (file-system
+           (device "none")
+           (mount-point "/run/user")
+           (type "tmpfs")
+           (check? #f)
+           (flags '(no-suid no-dev no-exec))
+           (options "mode=0755")
+           (create-mount-point? #t))
+         ;; Elogind uses cgroups to organize processes, allowing it to map PIDs
+         ;; to sessions.  Elogind's cgroup hierarchy isn't associated with any
+         ;; resource controller ("subsystem").
+         (file-system
+           (device "cgroup")
+           (mount-point "/sys/fs/cgroup/elogind")
+           (type "cgroup")
+           (check? #f)
+           (options "none,name=elogind")
+           (create-mount-point? #t)
+           (dependencies (list (car %control-groups)))))
+   %control-groups))
 
 (define %base-file-systems
   ;; List of basic file systems to be mounted.  Note that /proc and /sys are
   ;; currently mounted by the initrd.
-  (append (list %pseudo-terminal-file-system
-                %shared-memory-file-system
-                %immutable-store)
-          %control-groups))
+  (list %pseudo-terminal-file-system
+        %shared-memory-file-system
+        %immutable-store))
 
 ;; File systems for Linux containers differ from %base-file-systems in that
 ;; they impose additional restrictions such as no-exec or need different
diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm
index 17cf6b7163..dbeb0d3436 100644
--- a/gnu/system/mapped-devices.scm
+++ b/gnu/system/mapped-devices.scm
@@ -22,23 +22,32 @@
   #:use-module (guix gexp)
   #:use-module (guix records)
   #:use-module (guix modules)
+  #:use-module (guix i18n)
+  #:use-module ((guix utils)
+                #:select (source-properties->location
+                          &error-location))
   #:use-module (gnu services)
   #:use-module (gnu services shepherd)
   #:use-module (gnu system uuid)
+  #:autoload   (gnu build file-systems) (find-partition-by-luks-uuid)
   #:autoload   (gnu packages cryptsetup) (cryptsetup-static)
   #:autoload   (gnu packages linux) (mdadm-static)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
   #:use-module (ice-9 match)
   #:export (mapped-device
             mapped-device?
             mapped-device-source
             mapped-device-target
             mapped-device-type
+            mapped-device-location
 
             mapped-device-kind
             mapped-device-kind?
             mapped-device-kind-open
             mapped-device-kind-close
+            mapped-device-kind-check
 
             device-mapping-service-type
             device-mapping-service
@@ -58,14 +67,18 @@
   mapped-device?
   (source    mapped-device-source)                ;string | list of strings
   (target    mapped-device-target)                ;string
-  (type      mapped-device-type))                 ;<mapped-device-kind>
+  (type      mapped-device-type)                  ;<mapped-device-kind>
+  (location  mapped-device-location
+             (default (current-source-location)) (innate)))
 
 (define-record-type* <mapped-device-type> mapped-device-kind
   make-mapped-device-kind
   mapped-device-kind?
   (open      mapped-device-kind-open)             ;source target -> gexp
   (close     mapped-device-kind-close             ;source target -> gexp
-             (default (const #~(const #f)))))
+             (default (const #~(const #f))))
+  (check     mapped-device-kind-check             ;source -> Boolean
+             (default (const #t))))
 
 
 ;;;
@@ -138,11 +151,26 @@
   #~(zero? (system* #$(file-append cryptsetup-static "/sbin/cryptsetup")
                     "close" #$target)))
 
+(define (check-luks-device md)
+  "Ensure the source of MD is valid."
+  (let ((source (mapped-device-source md)))
+    (or (not (uuid? source))
+        (not (zero? (getuid)))
+        (find-partition-by-luks-uuid (uuid-bytevector source))
+        (raise (condition
+                (&message
+                 (message (format #f (G_ "no LUKS partition with UUID '~a'")
+                                  (uuid->string source))))
+                (&error-location
+                 (location (source-properties->location
+                            (mapped-device-location md)))))))))
+
 (define luks-device-mapping
   ;; The type of LUKS mapped devices.
   (mapped-device-kind
    (open open-luks-device)
-   (close close-luks-device)))
+   (close close-luks-device)
+   (check check-luks-device)))
 
 (define (open-raid-device sources target)
   "Return a gexp that assembles SOURCES (a list of devices) to the RAID device