Package: guix-patches;
Reported by: Ludovic Courtès <ludo <at> gnu.org>
Date: Fri, 18 May 2018 22:13:02 UTC
Severity: normal
Tags: patch
Done: ludo <at> gnu.org (Ludovic Courtès)
Bug is archived. No further changes may be made.
To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 31523 in the body.
You can then email your comments to 31523 AT debbugs.gnu.org in the normal way.
Toggle the display of automated, internal messages from the tracker.
View this report as an mbox folder, status mbox, maintainer mbox
guix-patches <at> gnu.org:bug#31523; Package guix-patches.
(Fri, 18 May 2018 22:13:02 GMT) Full text and rfc822 format available.Ludovic Courtès <ludo <at> gnu.org>:guix-patches <at> gnu.org.
(Fri, 18 May 2018 22:13:02 GMT) Full text and rfc822 format available.Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: guix-patches <at> gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 0/2] Getting rid of 'title' in 'file-system' declarations Date: Sat, 19 May 2018 00:12:05 +0200
Hello Guix!
These patches allow us to get rid of the infamous ‘title’ field in
‘file-system’ declarations, which has always been problematic. It does
so by introducing a new <file-system-label> data type, such that one can
write:
(file-system
(mount-point "/home")
(type "ext4")
(device (file-system-label "my-home")))
which probably looks clearer and is definitely less error prone.
The ‘title’ field is removed but some macrology takes care of
implementing backward compatibility by detecting ‘title’ fields, issuing
a deprecation warning, and adjusting the ‘device’ value according to the
‘title’.
The “installed-os” test passes.
Feedback welcome!
Ludo’.
Ludovic Courtès (2):
file-systems: Remove 'title' field and add <file-system-label>.
system: Remove uses of the 'title' field of <file-system>.
doc/guix.texi | 68 ++++++------
gnu/bootloader/grub.scm | 10 +-
gnu/build/file-systems.scm | 54 +++-------
gnu/build/linux-boot.scm | 12 ++-
gnu/build/shepherd.scm | 3 +-
gnu/services/base.scm | 17 ++-
gnu/system.scm | 36 ++++---
gnu/system/examples/bare-bones.tmpl | 3 +-
gnu/system/examples/beaglebone-black.tmpl | 3 +-
gnu/system/examples/lightweight-desktop.tmpl | 4 +-
gnu/system/examples/vm-image.tmpl | 3 +-
gnu/system/file-systems.scm | 108 ++++++++++++++++---
gnu/system/install.scm | 4 +-
gnu/system/vm.scm | 7 +-
gnu/tests.scm | 3 +-
gnu/tests/install.scm | 26 ++---
guix/scripts/system.scm | 31 +++---
tests/guix-system.sh | 9 +-
tests/system.scm | 6 +-
19 files changed, 227 insertions(+), 180 deletions(-)
--
2.17.0
guix-patches <at> gnu.org:bug#31523; Package guix-patches.
(Fri, 18 May 2018 22:21:02 GMT) Full text and rfc822 format available.Message #8 received at 31523 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 31523 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 2/2] system: Remove uses of the 'title' field of <file-system>. Date: Sat, 19 May 2018 00:19:51 +0200
* gnu/system/install.scm (installation-os): Remove uses of the 'title'
field of 'file-system'; use 'file-system-label' as appropriate.
* gnu/system/vm.scm (system-disk-image, system-qemu-image): Likewise.
* gnu/tests.scm (%simple-os): Likewise.
* gnu/tests/install.scm (%minimal-os, %minimal-extlinux-os)
(%minimal-os-on-vda, %separate-home-os, %separate-store-os)
(%raid-root-os, %encrypted-root-os, %btrfs-root-os): Likewise.
* gnu/build/shepherd.scm (default-mounts)[tmpfs]: Likewise.
* tests/guix-system.sh: Likewise.
* tests/system.scm (%root-fs): Likewise.
("operating-system-boot-mapped-devices, implicit dependency"): Likewise.
---
gnu/build/shepherd.scm | 3 +--
gnu/system/install.scm | 4 +---
gnu/system/vm.scm | 2 --
gnu/tests.scm | 3 +--
gnu/tests/install.scm | 26 ++++++++------------------
tests/guix-system.sh | 9 +++------
tests/system.scm | 6 ++----
7 files changed, 16 insertions(+), 37 deletions(-)
diff --git a/gnu/build/shepherd.scm b/gnu/build/shepherd.scm
index c955e3c83..f38325992 100644
--- a/gnu/build/shepherd.scm
+++ b/gnu/build/shepherd.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017 Ludovic Courtès <ludo <at> gnu.org>
+;;; Copyright © 2017, 2018 Ludovic Courtès <ludo <at> gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -55,7 +55,6 @@
(define (tmpfs directory)
(file-system
(device "none")
- (title 'device)
(mount-point directory)
(type "tmpfs")
(check? #f)))
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index a2917e485..b20b53e63 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -327,8 +327,7 @@ You have been warned. Thanks for being so brave.\x1b[0m
;; the appropriate one.
(cons* (file-system
(mount-point "/")
- (device "GuixSD_image")
- (title 'label)
+ (device (file-system-label "GuixSD_image"))
(type "ext4"))
;; Make /tmp a tmpfs instead of keeping the overlayfs. This
@@ -340,7 +339,6 @@ You have been warned. Thanks for being so brave.\x1b[0m
(file-system
(mount-point "/tmp")
(device "none")
- (title 'device)
(type "tmpfs")
(check? #f))
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index d11ec169e..645b0e252 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -571,7 +571,6 @@ to USB sticks meant to be read-only."
(file-systems (cons (file-system
(mount-point "/")
(device root-uuid)
- (title 'uuid)
(type file-system-type))
file-systems-to-keep)))))
@@ -636,7 +635,6 @@ of the GNU system as described by OS."
(file-systems (cons (file-system
(mount-point "/")
(device root-uuid)
- (title 'uuid)
(type file-system-type))
file-systems-to-keep)))))
(mlet* %store-monad
diff --git a/gnu/tests.scm b/gnu/tests.scm
index 2aef370af..5d4a4f806 100644
--- a/gnu/tests.scm
+++ b/gnu/tests.scm
@@ -208,8 +208,7 @@ the system under test."
(bootloader grub-bootloader)
(target "/dev/sdX")))
(file-systems (cons (file-system
- (device "my-root")
- (title 'label)
+ (device (file-system-label "my-root"))
(mount-point "/")
(type "ext4"))
%base-file-systems))
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index e3bb1b46a..4764ffffd 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -66,8 +66,7 @@
(target "/dev/vdb")))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
- (device "my-root")
- (title 'label)
+ (device (file-system-label "my-root"))
(mount-point "/")
(type "ext4"))
%base-file-systems))
@@ -105,8 +104,7 @@
(target "/dev/vdb")))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
- (device "my-root")
- (title 'label)
+ (device (file-system-label "my-root"))
(mount-point "/")
(type "ext4"))
%base-file-systems))
@@ -351,8 +349,7 @@ per %test-installed-os, this test is expensive in terms of CPU and storage.")
(target "/dev/vda")))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
- (device "my-root")
- (title 'label)
+ (device (file-system-label "my-root"))
(mount-point "/")
(type "ext4"))
%base-file-systems))
@@ -428,13 +425,11 @@ reboot\n")
(target "/dev/vdb")))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons* (file-system
- (device "my-root")
- (title 'label)
+ (device (file-system-label "my-root"))
(mount-point "/")
(type "ext4"))
(file-system
(device "none")
- (title 'device)
(type "tmpfs")
(mount-point "/home")
(type "tmpfs"))
@@ -488,13 +483,11 @@ partition. In particular, home directories must be correctly created (see
(target "/dev/vdb")))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons* (file-system
- (device "root-fs")
- (title 'label)
+ (device (file-system-label "root-fs"))
(mount-point "/")
(type "ext4"))
(file-system
- (device "store-fs")
- (title 'label)
+ (device (file-system-label "store-fs"))
(mount-point "/gnu")
(type "ext4"))
%base-file-systems))
@@ -574,8 +567,7 @@ where /gnu lives on a separate partition.")
(target "/dev/md0")
(type raid-device-mapping))))
(file-systems (cons (file-system
- (device "root-fs")
- (title 'label)
+ (device (file-system-label "root-fs"))
(mount-point "/")
(type "ext4")
(dependencies mapped-devices))
@@ -658,7 +650,6 @@ by 'mdadm'.")
(type luks-device-mapping))))
(file-systems (cons (file-system
(device "/dev/mapper/the-root-device")
- (title 'device)
(mount-point "/")
(type "ext4"))
%base-file-systems))
@@ -779,8 +770,7 @@ build (current-guix) and then store a couple of full system images.")
(target "/dev/vdb")))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
- (device "my-root")
- (title 'label)
+ (device (file-system-label "my-root"))
(mount-point "/")
(type "btrfs"))
%base-file-systems))
diff --git a/tests/guix-system.sh b/tests/guix-system.sh
index 2b94bc051..36ba5fbd5 100644
--- a/tests/guix-system.sh
+++ b/tests/guix-system.sh
@@ -111,8 +111,7 @@ cat > "$tmpfile" <<EOF
(bootloader (GRUB-config (device "/dev/sdX"))) ; 9
(file-systems (cons (file-system
- (device "root")
- (title 'label)
+ (device (file-system-label "root"))
(mount-point "/")
(type "ext4"))
%base-file-systems)))
@@ -140,8 +139,7 @@ OS_BASE='
(bootloader grub-bootloader)
(device "/dev/sdX")))
(file-systems (cons (file-system
- (device "root")
- (title (string->symbol "label"))
+ (device (file-system-label "root"))
(mount-point "/")
(type "ext4"))
%base-file-systems))
@@ -213,8 +211,7 @@ make_user_config ()
(bootloader grub-bootloader)
(device "/dev/sdX")))
(file-systems (cons (file-system
- (device "root")
- (title 'label)
+ (device (file-system-label "root"))
(mount-point "/")
(type "ext4"))
%base-file-systems))
diff --git a/tests/system.scm b/tests/system.scm
index 6a7f45c59..7d55da717 100644
--- a/tests/system.scm
+++ b/tests/system.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016 Ludovic Courtès <ludo <at> gnu.org>
+;;; Copyright © 2016, 2018 Ludovic Courtès <ludo <at> gnu.org>
;;; Copyright © 2017 Tobias Geerinckx-Rice <me <at> tobias.gr>
;;;
;;; This file is part of GNU Guix.
@@ -27,8 +27,7 @@
(define %root-fs
(file-system
- (device "my-root")
- (title 'label)
+ (device (file-system-label "my-root"))
(mount-point "/")
(type "ext4")))
@@ -114,7 +113,6 @@
(inherit %os-with-mapped-device)
(file-systems (cons (file-system
(device "/dev/mapper/my-luks-device")
- (title 'device)
(mount-point "/")
(type "ext4"))
%base-file-systems)))))
--
2.17.0
guix-patches <at> gnu.org:bug#31523; Package guix-patches.
(Fri, 18 May 2018 22:21:02 GMT) Full text and rfc822 format available.Message #11 received at 31523 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 31523 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 1/2] file-systems: Remove 'title' field and add <file-system-label>. Date: Sat, 19 May 2018 00:19:50 +0200
The 'title' field was easily overlooked and was an endless source of
confusion. Now, the value of the 'device' field is self-contained.
* gnu/system/file-systems.scm (<file-system>): Change constructor name
to '%file-system'.
[title]: Remove.
(<file-system-label>): New record type with printer.
(report-deprecation, device-expression)
(process-file-system-declaration, file-system): New macros.
(file-system-title): New procedure.
(file-system->spec, spec->file-system): Adjust to handle
<file-system-label>.
* gnu/system.scm (bootable-kernel-arguments): Add case for
'file-system-label?'.
(read-boot-parameters): Likewise.
(mapped-device-user): Avoid 'file-system-title'.
(fs->boot-device): Remove.
(operating-system-boot-parameters): Use 'file-system-device' instead of
'fs->boot-device'.
(device->sexp): Add case for 'file-system-label?'.
* gnu/bootloader/grub.scm (grub-root-search): Add case for
'file-system-label?'.
* gnu/system/examples/bare-bones.tmpl,
gnu/system/examples/beaglebone-black.tmpl,
gnu/system/examples/lightweight-desktop.tmpl,
gnu/system/examples/vm-image.tmpl: Remove uses of 'title'.
* gnu/system/vm.scm (virtualized-operating-system): Remove uses of
'file-system-title'.
* guix/scripts/system.scm (check-file-system-availability): Likewise,
and adjust fix-it hint.
(check-initrd-modules)[file-system-/dev]: Likewise.
* gnu/build/file-systems.scm (canonicalize-device-spec): Remove 'title'
parameter.
[canonical-title]: Remove.
Match on SPEC's type rather than on CANONICAL-TITLE.
(mount-file-system): Adjust caller.
* gnu/build/linux-boot.scm (boot-system): Interpret ROOT here.
* gnu/services/base.scm (file-system->fstab-entry): Remove use of
'file-system-title'.
* doc/guix.texi (File Systems): Remove documentation of the 'title'
field. Rewrite documentation of 'device' and document
'file-system-label'.
---
doc/guix.texi | 68 ++++++------
gnu/bootloader/grub.scm | 10 +-
gnu/build/file-systems.scm | 54 +++-------
gnu/build/linux-boot.scm | 12 ++-
gnu/services/base.scm | 17 ++-
gnu/system.scm | 36 ++++---
gnu/system/examples/bare-bones.tmpl | 3 +-
gnu/system/examples/beaglebone-black.tmpl | 3 +-
gnu/system/examples/lightweight-desktop.tmpl | 4 +-
gnu/system/examples/vm-image.tmpl | 3 +-
gnu/system/file-systems.scm | 108 ++++++++++++++++---
gnu/system/vm.scm | 5 +-
guix/scripts/system.scm | 31 +++---
13 files changed, 211 insertions(+), 143 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index a12210db8..3432c6535 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -9203,36 +9203,9 @@ This is a string specifying the type of the file system---e.g.,
This designates the place where the file system is to be mounted.
@item @code{device}
-This names the ``source'' of the file system. By default it is the name
-of a node under @file{/dev}, but its meaning depends on the @code{title}
-field described below.
-
-@item @code{title} (default: @code{'device})
-This is a symbol that specifies how the @code{device} field is to be
-interpreted.
-
-When it is the symbol @code{device}, then the @code{device} field is
-interpreted as a file name; when it is @code{label}, then @code{device}
-is interpreted as a file system label name; when it is @code{uuid},
-@code{device} is interpreted as a file system unique identifier (UUID).
-
-UUIDs may be converted from their string representation (as shown by the
-@command{tune2fs -l} command) using the @code{uuid} form <at> footnote{The
-@code{uuid} form expects 16-byte UUIDs as defined in
-@uref{https://tools.ietf.org/html/rfc4122, RFC <at> tie{}4122}. This is the
-form of UUID used by the ext2 family of file systems and others, but it
-is different from ``UUIDs'' found in FAT file systems, for instance.},
-like this:
-
-@example
-(file-system
- (mount-point "/home")
- (type "ext4")
- (title 'uuid)
- (device (uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb")))
-@end example
-
-The @code{label} and @code{uuid} options offer a way to refer to file
+This names the ``source'' of the file system. It can be one of three
+things: a file system label, a file system UUID, or the name of a
+@file{/dev} node. Labels and UUIDs offer a way to refer to file
systems without having to hard-code their actual device
name <at> footnote{Note that, while it is tempting to use
@file{/dev/disk/by-uuid} and similar device names to achieve the same
@@ -9240,10 +9213,39 @@ result, this is not recommended: These special device nodes are created
by the udev daemon and may be unavailable at the time the device is
mounted.}.
-However, when the source of a file system is a mapped device (@pxref{Mapped
+@findex file-system-label
+File system labels are created using the @code{file-system-label}
+procedure, UUIDs are created using @code{uuid}, and @file{/dev} node are
+plain strings. Here's an example of a file system referred to by its
+label, as shown by the @command{e2label} command:
+
+@example
+(file-system
+ (mount-point "/home")
+ (type "ext4")
+ (device (file-system-label "my-home")))
+@end example
+
+@findex uuid
+UUIDs are converted from their string representation (as shown by the
+@command{tune2fs -l} command) using the @code{uuid} form <at> footnote{The
+@code{uuid} form expects 16-byte UUIDs as defined in
+@uref{https://tools.ietf.org/html/rfc4122, RFC <at> tie{}4122}. This is the
+form of UUID used by the ext2 family of file systems and others, but it
+is different from ``UUIDs'' found in FAT file systems, for instance.},
+like this:
+
+@example
+(file-system
+ (mount-point "/home")
+ (type "ext4")
+ (device (uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb")))
+@end example
+
+When the source of a file system is a mapped device (@pxref{Mapped
Devices}), its @code{device} field @emph{must} refer to the mapped
-device name---e.g., @file{/dev/mapper/root-partition}---and consequently
-@code{title} must be set to @code{'device}. This is required so that
+device name---e.g., @file{"/dev/mapper/root-partition"}.
+This is required so that
the system knows that mounting the file system depends on having the
corresponding device mapping established.
diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index 3b01125c7..eca6d97b1 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo <at> gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo <at> gnu.org>
;;; Copyright © 2016 Chris Marusich <cmmarusich <at> gmail.com>
;;; Copyright © 2017 Leo Famulari <leo <at> famulari.name>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe <at> gmail.com>
@@ -31,6 +31,7 @@
#:use-module (gnu system)
#:use-module (gnu bootloader)
#:use-module (gnu system uuid)
+ #:use-module (gnu system file-systems)
#:autoload (gnu packages bootloaders) (grub)
#:autoload (gnu packages compression) (gzip)
#:autoload (gnu packages gtk) (guile-cairo guile-rsvg)
@@ -303,9 +304,10 @@ code."
((? uuid? uuid)
(format #f "search --fs-uuid --set ~a"
(uuid->string device)))
- ((? string? label)
- (format #f "search --label --set ~a" label))
- (#f
+ ((? file-system-label? label)
+ (format #f "search --label --set ~a"
+ (file-system-label->string label)))
+ ((or #f (? string?))
#~(format #f "search --file --set ~a" #$file)))))
(define* (grub-configuration-file config entries
diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index 145b3b14e..3dd7358fd 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo <at> gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo <at> gnu.org>
;;; Copyright © 2016, 2017 David Craven <david <at> craven.ch>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe <at> gmail.com>
;;;
@@ -473,17 +473,9 @@ were found."
(find-partition luks-partition-uuid-predicate))
-(define* (canonicalize-device-spec spec #:optional (title 'any))
- "Return the device name corresponding to SPEC. TITLE is a symbol, one of
-the following:
-
- • 'device', in which case SPEC is known to designate a device node--e.g.,
- \"/dev/sda1\";
- • 'label', in which case SPEC is known to designate a partition label--e.g.,
- \"my-root-part\";
- • 'uuid', in which case SPEC must be a UUID designating a partition;
- • 'any', in which case SPEC can be anything.
-"
+(define (canonicalize-device-spec spec)
+ "Return the device name corresponding to SPEC, which can be a <uuid>, a
+<file-system-label>, or a string (typically a /dev file name)."
(define max-trials
;; Number of times we retry partition label resolution, 1 second per
;; trial. Note: somebody reported a delay of 16 seconds (!) before their
@@ -491,19 +483,6 @@ the following:
;; this long.
20)
- (define canonical-title
- ;; The realm of canonicalization.
- (if (eq? title 'any)
- (if (string? spec)
- ;; The "--root=SPEC" kernel command-line option always provides a
- ;; string, but the string can represent a device, a UUID, or a
- ;; label. So check for all three.
- (cond ((string-prefix? "/" spec) 'device)
- ((string->uuid spec) 'uuid)
- (else 'label))
- 'uuid)
- title))
-
(define (resolve find-partition spec fmt)
(let loop ((count 0))
(let ((device (find-partition spec)))
@@ -518,23 +497,19 @@ the following:
(sleep 1)
(loop (+ 1 count))))))))
- (case canonical-title
- ((device)
+ (match spec
+ ((? string?)
;; Nothing to do.
spec)
- ((label)
+ ((? file-system-label?)
;; Resolve the label.
- (resolve find-partition-by-label spec identity))
- ((uuid)
+ (resolve find-partition-by-label
+ (file-system-label->string spec)
+ identity))
+ ((? uuid?)
(resolve find-partition-by-uuid
- (cond ((string? spec)
- (string->uuid spec))
- ((uuid? spec)
- (uuid-bytevector spec))
- (else spec))
- uuid->string))
- (else
- (error "unknown device title" title))))
+ (uuid-bytevector spec)
+ uuid->string))))
(define (check-file-system device type)
"Run a file system check of TYPE on DEVICE."
@@ -615,8 +590,7 @@ run a file system check."
"")))))
(let ((type (file-system-type fs))
(options (file-system-options fs))
- (source (canonicalize-device-spec (file-system-device fs)
- (file-system-title fs)))
+ (source (canonicalize-device-spec (file-system-device fs)))
(mount-point (string-append root "/"
(file-system-mount-point fs)))
(flags (mount-flags->bit-mask (file-system-flags fs))))
diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index 18d87260a..44b350628 100644
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.scm
@@ -507,9 +507,15 @@ upon error."
(error "pre-mount actions failed")))
(if root
- (mount-root-file-system (canonicalize-device-spec root)
- root-fs-type
- #:volatile-root? volatile-root?)
+ ;; The "--root=SPEC" kernel command-line option always provides a
+ ;; string, but the string can represent a device, a UUID, or a
+ ;; label. So check for all three.
+ (let ((root (cond ((string-prefix? "/" root) root)
+ ((uuid root) => identity)
+ (else (file-system-label root)))))
+ (mount-root-file-system (canonicalize-device-spec root)
+ root-fs-type
+ #:volatile-root? volatile-root?))
(mount "none" "/root" "tmpfs"))
;; Mount the specified file systems.
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index eb82b2ddc..09a1ce95e 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -303,15 +303,14 @@ seconds after @code{SIGTERM} has been sent are terminated with
(define (file-system->fstab-entry file-system)
"Return a @file{/etc/fstab} entry for @var{file-system}."
- (string-append (case (file-system-title file-system)
- ((label)
- (string-append "LABEL=" (file-system-device file-system)))
- ((uuid)
- (string-append
- "UUID="
- (uuid->string (file-system-device file-system))))
- (else
- (file-system-device file-system)))
+ (string-append (match (file-system-device file-system)
+ ((? file-system-label? label)
+ (string-append "LABEL="
+ (file-system-label->string file-system)))
+ ((? uuid? uuid)
+ (string-append "UUID=" (uuid->string uuid)))
+ ((? string? device)
+ device))
"\t"
(file-system-mount-point file-system) "\t"
(file-system-type file-system) "\t"
diff --git a/gnu/system.scm b/gnu/system.scm
index 1052e9355..288c1e880 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -131,13 +131,16 @@
"Prepend extra arguments to KERNEL-ARGUMENTS that allow SYSTEM.DRV to be
booted from ROOT-DEVICE"
(cons* (string-append "--root="
- (if (uuid? root-device)
+ (cond ((uuid? root-device)
- ;; Note: Always use the DCE format because that's
- ;; what (gnu build linux-boot) expects for the
- ;; '--root' kernel command-line option.
- (uuid->string (uuid-bytevector root-device) 'dce)
- root-device))
+ ;; Note: Always use the DCE format because that's
+ ;; what (gnu build linux-boot) expects for the
+ ;; '--root' kernel command-line option.
+ (uuid->string (uuid-bytevector root-device)
+ 'dce))
+ ((file-system-label? root-device)
+ (file-system-label->string root-device))
+ (else root-device)))
#~(string-append "--system=" #$system.drv)
#~(string-append "--load=" #$system.drv "/boot")
kernel-arguments))
@@ -251,10 +254,16 @@ file system labels."
(match-lambda
(('uuid (? symbol? type) (? bytevector? bv))
(bytevector->uuid bv type))
+ (('file-system-label (? string? label))
+ (file-system-label label))
((? bytevector? bv) ;old format
(bytevector->uuid bv 'dce))
((? string? device)
- device)))
+ ;; It used to be that we would not distinguish between labels and
+ ;; device names. Try to infer the right thing here.
+ (if (string-prefix? "/dev/" device)
+ device
+ (file-system-label device)))))
(match (read port)
(('boot-parameters ('version 0)
@@ -377,7 +386,7 @@ marked as 'needed-for-boot'."
(let ((target (string-append "/dev/mapper/" (mapped-device-target device))))
(find (lambda (fs)
(or (member device (file-system-dependencies fs))
- (and (eq? 'device (file-system-title fs))
+ (and (string? (file-system-device fs))
(string=? (file-system-device fs) target))))
file-systems)))
@@ -934,13 +943,6 @@ listed in OS. The C library expects to find it under
(bootloader-configuration-bootloader bootloader-conf))
bootloader-conf (list entry) #:old-entries old-entries)))
-(define (fs->boot-device fs)
- "Given FS, a <file-system> object, return a value suitable for use as the
-device in a <menu-entry>."
- (case (file-system-title fs)
- ((uuid label device) (file-system-device fs))
- (else #f)))
-
(define (operating-system-boot-parameters os system.drv root-device)
"Return a monadic <boot-parameters> record that describes the boot parameters
of OS. SYSTEM.DRV is either a derivation or #f. If it's a derivation, adds
@@ -962,7 +964,7 @@ kernel arguments for that derivation to <boot-parameters>."
(operating-system-user-kernel-arguments os)))
(initrd initrd)
(bootloader-name bootloader-name)
- (store-device (ensure-not-/dev (fs->boot-device store)))
+ (store-device (ensure-not-/dev (file-system-device store)))
(store-mount-point (file-system-mount-point store))))))
(define (device->sexp device)
@@ -970,6 +972,8 @@ kernel arguments for that derivation to <boot-parameters>."
(match device
((? uuid? uuid)
`(uuid ,(uuid-type uuid) ,(uuid-bytevector uuid)))
+ ((? file-system-label? label)
+ `(file-system-label ,(file-system-label->string label)))
(_
device)))
diff --git a/gnu/system/examples/bare-bones.tmpl b/gnu/system/examples/bare-bones.tmpl
index 7e0c8fbee..cb6d2623d 100644
--- a/gnu/system/examples/bare-bones.tmpl
+++ b/gnu/system/examples/bare-bones.tmpl
@@ -16,8 +16,7 @@
(bootloader grub-bootloader)
(target "/dev/sdX")))
(file-systems (cons (file-system
- (device "my-root")
- (title 'label)
+ (device (file-system-label "my-root"))
(mount-point "/")
(type "ext4"))
%base-file-systems))
diff --git a/gnu/system/examples/beaglebone-black.tmpl b/gnu/system/examples/beaglebone-black.tmpl
index 97201330c..d1130c76b 100644
--- a/gnu/system/examples/beaglebone-black.tmpl
+++ b/gnu/system/examples/beaglebone-black.tmpl
@@ -20,8 +20,7 @@
(initrd-modules (cons "omap_hsmmc" %base-initrd-modules))
(file-systems (cons (file-system
- (device "my-root")
- (title 'label)
+ (device (file-system-label "my-root"))
(mount-point "/")
(type "ext4"))
%base-file-systems))
diff --git a/gnu/system/examples/lightweight-desktop.tmpl b/gnu/system/examples/lightweight-desktop.tmpl
index 65a8ee180..360ee62ff 100644
--- a/gnu/system/examples/lightweight-desktop.tmpl
+++ b/gnu/system/examples/lightweight-desktop.tmpl
@@ -20,13 +20,11 @@
;; Assume the target root file system is labelled "my-root",
;; and the EFI System Partition has UUID 1234-ABCD.
(file-systems (cons* (file-system
- (device "my-root")
- (title 'label)
+ (device (file-system-label "my-root"))
(mount-point "/")
(type "ext4"))
(file-system
(device (uuid "1234-ABCD" 'fat))
- (title 'uuid)
(mount-point "/boot/efi")
(type "vfat"))
%base-file-systems))
diff --git a/gnu/system/examples/vm-image.tmpl b/gnu/system/examples/vm-image.tmpl
index ce3653c8b..36e272722 100644
--- a/gnu/system/examples/vm-image.tmpl
+++ b/gnu/system/examples/vm-image.tmpl
@@ -31,8 +31,7 @@ partprobe, and then 2) resizing the filesystem with resize2fs.\n"))
(target "/dev/sda")
(terminal-outputs '(console))))
(file-systems (cons (file-system
- (device "my-root")
- (title 'label)
+ (device (file-system-label "my-root"))
(mount-point "/")
(type "ext4"))
%base-file-systems))
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index 93289dbd5..2b5948256 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -20,6 +20,8 @@
#:use-module (ice-9 match)
#:use-module (rnrs bytevectors)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-9 gnu)
#:use-module (guix records)
#:use-module (gnu system uuid)
#:re-export (uuid ;backward compatibility
@@ -28,7 +30,7 @@
#:export (file-system
file-system?
file-system-device
- file-system-title
+ file-system-title ;deprecated
file-system-mount-point
file-system-type
file-system-needed-for-boot?
@@ -42,6 +44,10 @@
file-system-type-predicate
+ file-system-label
+ file-system-label?
+ file-system-label->string
+
file-system->spec
spec->file-system
specification->file-system-mapping
@@ -82,12 +88,10 @@
;;; Code:
;; File system declaration.
-(define-record-type* <file-system> file-system
+(define-record-type* <file-system> %file-system
make-file-system
file-system?
- (device file-system-device) ; string
- (title file-system-title ; 'device | 'label | 'uuid
- (default 'device))
+ (device file-system-device) ; string | <uuid> | <file-system-label>
(mount-point file-system-mount-point) ; string
(type file-system-type) ; string
(flags file-system-flags ; list of symbols
@@ -108,6 +112,83 @@
(default (current-source-location))
(innate)))
+;; A file system label for use in the 'device' field.
+(define-record-type <file-system-label>
+ (file-system-label label)
+ file-system-label?
+ (label file-system-label->string))
+
+(set-record-type-printer! <file-system-label>
+ (lambda (obj port)
+ (format port "#<file-system-label ~s>"
+ (file-system-label->string obj))))
+
+(define-syntax report-deprecation
+ (lambda (s)
+ "Report the use of the now-deprecated 'title' field."
+ (syntax-case s ()
+ ((_ field)
+ (let* ((source (syntax-source #'field))
+ (file (and source (assq-ref source 'filename)))
+ (line (and source
+ (and=> (assq-ref source 'line) 1+)))
+ (column (and source (assq-ref source 'column))))
+ (format (current-error-port)
+ "~a:~a:~a: warning: 'title' field is deprecated~%"
+ file line column)
+ #t)))))
+
+;; Helper for 'process-file-system-declaration'.
+(define-syntax device-expression
+ (syntax-rules (quote label uuid device)
+ ((_ (quote label) dev)
+ (file-system-label dev))
+ ((_ (quote uuid) dev)
+ (if (uuid? dev) dev (uuid dev)))
+ ((_ (quote device) dev)
+ dev)
+ ((_ title dev)
+ (case title
+ ((label) (file-system-label dev))
+ ((uuid) (uuid dev))
+ (else dev)))))
+
+;; Helper to interpret the now-deprecated 'title' field. Detect forms like
+;; (title 'label), remove them, and adjust the 'device' field accordingly.
+;; TODO: Remove this once 'title' has been deprecated long enough.
+(define-syntax process-file-system-declaration
+ (syntax-rules (device title)
+ ((_ () (rest ...) #f #f) ;no 'title' and no 'device' field
+ (%file-system rest ...))
+ ((_ () (rest ...) dev #f) ;no 'title' field
+ (%file-system rest ... (device dev)))
+ ((_ () (rest ...) dev titl) ;got a 'title' field
+ (%file-system rest ...
+ (device (device-expression titl dev))))
+ ((_ ((title titl) rest ...) (previous ...) dev _)
+ (begin
+ (report-deprecation (title titl))
+ (process-file-system-declaration (rest ...)
+ (previous ...)
+ dev titl)))
+ ((_ ((device dev) rest ...) (previous ...) _ titl)
+ (process-file-system-declaration (rest ...)
+ (previous ...)
+ dev titl))
+ ((_ (field rest ...) (previous ...) dev titl)
+ (process-file-system-declaration (rest ...)
+ (previous ... field)
+ dev titl))))
+
+(define-syntax-rule (file-system fields ...)
+ (process-file-system-declaration (fields ...) () #f #f))
+
+(define (file-system-title fs) ;deprecated
+ (match (file-system-device fs)
+ ((? file-system-label?) 'label)
+ ((? uuid?) 'uuid)
+ ((? string?) 'device)))
+
;; Note: This module is used both on the build side and on the host side.
;; Arrange not to pull (guix store) and (guix config) because the latter
;; differs from user to user.
@@ -160,23 +241,26 @@ store--e.g., if FS is the root file system."
"Return a list corresponding to file-system FS that can be passed to the
initrd code."
(match fs
- (($ <file-system> device title mount-point type flags options _ _ check?)
- (list (if (uuid? device)
- `(uuid ,(uuid-type device) ,(uuid-bytevector device))
- device)
- title mount-point type flags options check?))))
+ (($ <file-system> device mount-point type flags options _ _ check?)
+ (list (cond ((uuid? device)
+ `(uuid ,(uuid-type device) ,(uuid-bytevector device)))
+ ((file-system-label? device)
+ `(file-system-label ,(file-system-label->string device)))
+ (else device))
+ mount-point type flags options check?))))
(define (spec->file-system sexp)
"Deserialize SEXP, a list, to the corresponding <file-system> object."
(match sexp
- ((device title mount-point type flags options check?)
+ ((device mount-point type flags options check?)
(file-system
(device (match device
(('uuid (? symbol? type) (? bytevector? bv))
(bytevector->uuid bv type))
+ (('file-system-label (? string? label))
+ (file-system-label label))
(_
device)))
- (title title)
(mount-point mount-point) (type type)
(flags flags) (options options)
(check? check?)))))
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 09a11af86..d11ec169e 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -693,13 +693,12 @@ environment with the store shared with the host. MAPPINGS is a list of
(source (file-system-device fs)))
(or (string=? target (%store-prefix))
(string=? target "/")
- (and (eq? 'device (file-system-title fs))
+ (and (string? source)
(string-prefix? "/dev/" source))
;; Labels and UUIDs are necessarily invalid in the VM.
(and (file-system-mount? fs)
- (or (eq? 'label (file-system-title fs))
- (eq? 'uuid (file-system-title fs))
+ (or (file-system-label? source)
(uuid? source))))))
(operating-system-file-systems os)))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index af501eb8f..5d0df1492 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -590,17 +590,17 @@ any, are available. Raise an error if they're not."
(define labeled
(filter (lambda (fs)
- (eq? (file-system-title fs) 'label))
+ (file-system-label? (file-system-device fs)))
relevant))
(define literal
(filter (lambda (fs)
- (eq? (file-system-title fs) 'device))
+ (string? (file-system-device fs)))
relevant))
(define uuid
(filter (lambda (fs)
- (eq? (file-system-title fs) 'uuid))
+ (uuid? (file-system-device fs)))
relevant))
(define fail? #f)
@@ -628,15 +628,15 @@ any, are available. Raise an error if they're not."
(strerror errno))
(unless (string-prefix? "/" device)
(display-hint (format #f (G_ "If '~a' is a file system
-label, you need to add @code{(title 'label)} to your @code{file-system}
-definition.")
- device)))))))
+label, write @code{(file-system-label ~s)} in your @code{device} field.")
+ device device)))))))
literal)
(for-each (lambda (fs)
- (unless (find-partition-by-label (file-system-device fs))
- (error (G_ "~a: error: file system with label '~a' not found~%")
- (file-system-location* fs)
- (file-system-device fs))))
+ (let ((label (file-system-label->string
+ (file-system-device fs))))
+ (unless (find-partition-by-label label)
+ (error (G_ "~a: error: file system with label '~a' not found~%")
+ (file-system-location* fs) label))))
labeled)
(for-each (lambda (fs)
(unless (find-partition-by-uuid (file-system-device fs))
@@ -677,10 +677,13 @@ available in the initrd. Note that mapped devices are responsible for
checking this by themselves in their 'check' procedure."
(define (file-system-/dev fs)
(let ((device (file-system-device fs)))
- (match (file-system-title fs)
- ('device device)
- ('uuid (find-partition-by-uuid device))
- ('label (find-partition-by-label device)))))
+ (match device
+ ((? string?)
+ device)
+ ((? uuid?)
+ (find-partition-by-uuid device))
+ ((? file-system-label?)
+ (find-partition-by-label (file-system-label->string device))))))
(define file-systems
(filter file-system-needed-for-boot?
--
2.17.0
guix-patches <at> gnu.org:bug#31523; Package guix-patches.
(Sat, 26 May 2018 13:25:01 GMT) Full text and rfc822 format available.Message #14 received at 31523 <at> debbugs.gnu.org (full text, mbox):
From: ludo <at> gnu.org (Ludovic Courtès) To: 31523 <at> debbugs.gnu.org Subject: Re: [bug#31523] [PATCH 0/2] Getting rid of 'title' in 'file-system' declarations Date: Sat, 26 May 2018 15:24:44 +0200
Ludovic Courtès <ludo <at> gnu.org> skribis: > These patches allow us to get rid of the infamous ‘title’ field in > ‘file-system’ declarations, which has always been problematic. It does > so by introducing a new <file-system-label> data type, such that one can > write: > > (file-system > (mount-point "/home") > (type "ext4") > (device (file-system-label "my-home"))) Ping! What do people think? Ludo’.
guix-patches <at> gnu.org:bug#31523; Package guix-patches.
(Sat, 26 May 2018 14:11:02 GMT) Full text and rfc822 format available.Message #17 received at 31523 <at> debbugs.gnu.org (full text, mbox):
From: Nils Gillmann <ng0 <at> n0.is> To: Ludovic Courtès <ludo <at> gnu.org> Cc: 31523 <at> debbugs.gnu.org Subject: Re: [bug#31523] [PATCH 0/2] Getting rid of 'title' in 'file-system' declarations Date: Sat, 26 May 2018 14:10:43 +0000
Ludovic Courtès transcribed 2.0K bytes: > Hello Guix! > > These patches allow us to get rid of the infamous ‘title’ field in > ‘file-system’ declarations, which has always been problematic. It does > so by introducing a new <file-system-label> data type, such that one can > write: > > (file-system > (mount-point "/home") > (type "ext4") > (device (file-system-label "my-home"))) > > which probably looks clearer and is definitely less error prone. > > The ‘title’ field is removed but some macrology takes care of > implementing backward compatibility by detecting ‘title’ fields, issuing > a deprecation warning, and adjusting the ‘device’ value according to the > ‘title’. > > The “installed-os” test passes. > > Feedback welcome! I can not test it at the moment, but I like the example, which looks like it could make it less confusing for newcomers. > Ludo’. > > Ludovic Courtès (2): > file-systems: Remove 'title' field and add <file-system-label>. > system: Remove uses of the 'title' field of <file-system>. > > doc/guix.texi | 68 ++++++------ > gnu/bootloader/grub.scm | 10 +- > gnu/build/file-systems.scm | 54 +++------- > gnu/build/linux-boot.scm | 12 ++- > gnu/build/shepherd.scm | 3 +- > gnu/services/base.scm | 17 ++- > gnu/system.scm | 36 ++++--- > gnu/system/examples/bare-bones.tmpl | 3 +- > gnu/system/examples/beaglebone-black.tmpl | 3 +- > gnu/system/examples/lightweight-desktop.tmpl | 4 +- > gnu/system/examples/vm-image.tmpl | 3 +- > gnu/system/file-systems.scm | 108 ++++++++++++++++--- > gnu/system/install.scm | 4 +- > gnu/system/vm.scm | 7 +- > gnu/tests.scm | 3 +- > gnu/tests/install.scm | 26 ++--- > guix/scripts/system.scm | 31 +++--- > tests/guix-system.sh | 9 +- > tests/system.scm | 6 +- > 19 files changed, 227 insertions(+), 180 deletions(-) > > -- > 2.17.0 > > > >
ludo <at> gnu.org (Ludovic Courtès):Ludovic Courtès <ludo <at> gnu.org>:Message #22 received at 31523-done <at> debbugs.gnu.org (full text, mbox):
From: ludo <at> gnu.org (Ludovic Courtès) To: Nils Gillmann <ng0 <at> n0.is> Cc: 31523-done <at> debbugs.gnu.org Subject: Re: [bug#31523] [PATCH 0/2] Getting rid of 'title' in 'file-system' declarations Date: Mon, 28 May 2018 14:53:41 +0200
Hello, I’ve pushed it now. Thanks for your support Nils & Tobias! :-) Ludo’.
guix-patches <at> gnu.org:bug#31523; Package guix-patches.
(Tue, 29 May 2018 13:12:02 GMT) Full text and rfc822 format available.Message #25 received at 31523-done <at> debbugs.gnu.org (full text, mbox):
From: ludo <at> gnu.org (Ludovic Courtès) To: Tobias Geerinckx-Rice <me <at> tobias.gr> Cc: 31523-done <at> debbugs.gnu.org Subject: Re: [bug#31523] [PATCH 0/2] Getting rid of 'title' in 'file-system' declarations Date: Tue, 29 May 2018 15:11:06 +0200
Hello Tobias, Tobias Geerinckx-Rice <me <at> tobias.gr> skribis: > gnu/services/base.scm:309:35: In procedure file-system->fstab-entry: > In procedure file-system-label->string: Wrong type argument: > #<<file-system> device: #<file-system-label "EFI"> mount-point: Oops, fixed in 0d56d9c714dc986fd049e07d8ad423d1e944771f. Thanks for the heads-up! Ludo’.
Debbugs Internal Request <help-debbugs <at> gnu.org>
to internal_control <at> debbugs.gnu.org.
(Wed, 27 Jun 2018 11:24:05 GMT) Full text and rfc822 format available.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.