summaryrefslogtreecommitdiff
path: root/gnu/system
diff options
context:
space:
mode:
authorEfraim Flashner <efraim@flashner.co.il>2017-12-31 14:10:25 +0200
committerEfraim Flashner <efraim@flashner.co.il>2017-12-31 14:10:25 +0200
commit23de2e1d5f8f7548e6f73085de23d9964774edbf (patch)
treefab69d4bb55f275f14012a724b7cb14bd307b57f /gnu/system
parentec6ba5c1fe9308cbc18f06c99adcfe0d13396a18 (diff)
parent1c27f72fc2770d68243dd95b7c05adc3b2b02ea4 (diff)
Merge remote-tracking branch 'origin/master' into core-updates
Diffstat (limited to 'gnu/system')
-rw-r--r--gnu/system/examples/beaglebone-black.tmpl5
-rw-r--r--gnu/system/file-systems.scm65
-rw-r--r--gnu/system/mapped-devices.scm34
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