aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gnu/services/base.scm15
-rw-r--r--gnu/services/dmd.scm2
-rw-r--r--gnu/system.scm11
-rw-r--r--gnu/system/file-systems.scm3
-rw-r--r--gnu/system/linux-initrd.scm4
-rw-r--r--gnu/system/vm.scm1
-rw-r--r--guix/build/linux-initrd.scm11
7 files changed, 29 insertions, 18 deletions
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 3643f7cfc1..4442203524 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -89,9 +89,11 @@ This service must be the root of the service dependency graph so that its
(respawn? #f)))))
(define* (file-system-service device target type
- #:key (check? #t) options)
+ #:key (check? #t) options (title 'any))
"Return a service that mounts DEVICE on TARGET as a file system TYPE with
-OPTIONS. When CHECK? is true, check the file system before mounting it."
+OPTIONS. TITLE is a symbol specifying what kind of name DEVICE is: 'label for
+a partition label, 'device for a device file name, or 'any. When CHECK? is
+true, check the file system before mounting it."
(with-monad %store-monad
(return
(service
@@ -99,10 +101,11 @@ OPTIONS. When CHECK? is true, check the file system before mounting it."
(requirement '(root-file-system))
(documentation "Check, mount, and unmount the given file system.")
(start #~(lambda args
- #$(if check?
- #~(check-file-system #$device #$type)
- #~#t)
- (mount #$device #$target #$type 0 #$options)
+ (let ((device (canonicalize-device-spec #$device '#$title)))
+ #$(if check?
+ #~(check-file-system device #$type)
+ #~#t)
+ (mount device #$target #$type 0 #$options))
#t))
(stop #~(lambda args
;; Normally there are no processes left at this point, so
diff --git a/gnu/services/dmd.scm b/gnu/services/dmd.scm
index 982c196fe4..74adb27885 100644
--- a/gnu/services/dmd.scm
+++ b/gnu/services/dmd.scm
@@ -50,7 +50,7 @@
(use-modules (ice-9 ftw)
(guix build syscalls)
((guix build linux-initrd)
- #:select (check-file-system)))
+ #:select (check-file-system canonicalize-device-spec)))
(register-services
#$@(map (lambda (service)
diff --git a/gnu/system.scm b/gnu/system.scm
index d05ec60b29..548184f5d5 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -182,8 +182,10 @@ as 'needed-for-boot'."
(sequence %store-monad
(map (match-lambda
- (($ <file-system> device target type flags opts #f check?)
+ (($ <file-system> device title target type flags opts
+ #f check?)
(file-system-service device target type
+ #:title title
#:check? check?
#:options opts)))
file-systems)))
@@ -449,7 +451,7 @@ we're running in the final root."
(define (operating-system-root-file-system os)
"Return the root file system of OS."
(find (match-lambda
- (($ <file-system> _ "/") #t)
+ (($ <file-system> _ _ "/") #t)
(_ #f))
(operating-system-file-systems os)))
@@ -457,9 +459,10 @@ we're running in the final root."
"Return a gexp denoting the initrd file of OS."
(define boot-file-systems
(filter (match-lambda
- (($ <file-system> device "/")
+ (($ <file-system> device title "/")
#t)
- (($ <file-system> device mount-point type flags options boot?)
+ (($ <file-system> device title mount-point type flags
+ options boot?)
boot?))
(operating-system-file-systems os)))
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index 485150ea51..7852a6ab26 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -22,6 +22,7 @@
file-system
file-system?
file-system-device
+ file-system-title
file-system-mount-point
file-system-type
file-system-needed-for-boot?
@@ -42,6 +43,8 @@
make-file-system
file-system?
(device file-system-device) ; string
+ (title file-system-title ; 'device | 'label | 'uuid
+ (default 'device))
(mount-point file-system-mount-point) ; string
(type file-system-type) ; string
(flags file-system-flags ; list of symbols
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index b80ff10f1e..17fec4f7f4 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -198,8 +198,8 @@ a list of Guile module names to be embedded in the initrd."
"Return a list corresponding to file-system FS that can be passed to the
initrd code."
(match fs
- (($ <file-system> device mount-point type flags options _ check?)
- (list device mount-point type flags options check?))))
+ (($ <file-system> device title mount-point type flags options _ check?)
+ (list device title mount-point type flags options check?))))
(define* (qemu-initrd file-systems
#:key
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 184f2512f1..c85445cd5f 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -290,6 +290,7 @@ to USB sticks meant to be read-only."
(file-systems (cons (file-system
(mount-point "/")
(device root-label)
+ (title 'label)
(type file-system-type))
file-systems-to-keep)))))
diff --git a/guix/build/linux-initrd.scm b/guix/build/linux-initrd.scm
index 05f6bf14bf..c1a0247aff 100644
--- a/guix/build/linux-initrd.scm
+++ b/guix/build/linux-initrd.scm
@@ -37,6 +37,7 @@
disk-partitions
partition-label-predicate
find-partition-by-label
+ canonicalize-device-spec
check-file-system
mount-file-system
@@ -485,7 +486,7 @@ UNIONFS."
"Mount the file system described by SPEC under ROOT. SPEC must have the
form:
- (DEVICE MOUNT-POINT TYPE (FLAGS ...) OPTIONS CHECK?)
+ (DEVICE TITLE MOUNT-POINT TYPE (FLAGS ...) OPTIONS CHECK?)
DEVICE, MOUNT-POINT, and TYPE must be strings; OPTIONS can be a string or #f;
FLAGS must be a list of symbols. CHECK? is a Boolean indicating whether to
@@ -500,8 +501,8 @@ run a file system check."
0)))
(match spec
- ((source mount-point type (flags ...) options check?)
- (let ((source (canonicalize-device-spec source))
+ ((source title mount-point type (flags ...) options check?)
+ (let ((source (canonicalize-device-spec source title))
(mount-point (string-append root "/" mount-point)))
(when check?
(check-file-system source type))
@@ -596,12 +597,12 @@ to it are lost."
(define root-mount-point?
(match-lambda
- ((device "/" _ ...) #t)
+ ((device _ "/" _ ...) #t)
(_ #f)))
(define root-fs-type
(or (any (match-lambda
- ((device "/" type _ ...) type)
+ ((device _ "/" type _ ...) type)
(_ #f))
mounts)
"ext4"))