[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
03/10: file-systems: Add a 'file-system-device->string' procedure.
From: |
guix-commits |
Subject: |
03/10: file-systems: Add a 'file-system-device->string' procedure. |
Date: |
Fri, 14 Feb 2020 10:55:37 -0500 (EST) |
apteryx pushed a commit to branch allow-booting-from-btrfs-subvolume
in repository guix.
commit e8d6642d3597207657842c9ca4849f8660d06638
Author: Maxim Cournoyer <address@hidden>
AuthorDate: Tue Feb 11 23:56:45 2020 -0500
file-systems: Add a 'file-system-device->string' procedure.
* gnu/system/file-systems.scm (file-system-device->string): New procedure.
* gnu/system.scm (bootable-kernel-arguments): Use it.
* gnu/system/vm.scm (operating-system-uuid): Likewise.
* guix/scripts/system.scm (display-system-generation): Likewise.
---
gnu/system.scm | 15 +++++----------
gnu/system/file-systems.scm | 15 +++++++++++++++
gnu/system/vm.scm | 8 +-------
guix/scripts/system.scm | 7 +------
4 files changed, 22 insertions(+), 23 deletions(-)
diff --git a/gnu/system.scm b/gnu/system.scm
index 01baa24..2e6d032 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -142,16 +142,11 @@
(define (bootable-kernel-arguments system root-device)
"Return a list of kernel arguments (gexps) to boot SYSTEM from ROOT-DEVICE."
(list (string-append "--root="
- (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))
- ((file-system-label? root-device)
- (file-system-label->string root-device))
- (else root-device)))
+ ;; Note: Always use the DCE format because that's what
+ ;; (gnu build linux-boot) expects for the '--root'
+ ;; kernel command-line option.
+ (file-system-device->string root-device
+ #:uuid-type 'dce))
#~(string-append "--system=" #$system)
#~(string-append "--load=" #$system "/boot")))
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index d47a514..fc383d8 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -30,6 +30,7 @@
#:export (file-system
file-system?
file-system-device
+ file-system-device->string
file-system-title ;deprecated
file-system-mount-point
file-system-type
@@ -235,6 +236,20 @@ where both FILE1 and FILE2 are absolute file name. For
example:
(()
#f)))))))
+(define* (file-system-device->string device #:key uuid-type)
+ "Return the string representations of the DEVICE field of a <file-system>
+record. When the device is a UUID, its representation is chosen depening on
+UUID-TYPE, a symbol such as 'dce or 'iso9660."
+ (match device
+ ((? file-system-label?)
+ (file-system-label->string device))
+ ((? uuid?)
+ (if uuid-type
+ (uuid->string (uuid-bytevector device) uuid-type)
+ (uuid->string device)))
+ ((? string?)
+ device)))
+
(define (file-system-needed-for-boot? fs)
"Return true if FS has the 'needed-for-boot?' flag set, or if it holds the
store--e.g., if FS is the root file system."
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 81b2e06..03a511c 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -609,13 +609,7 @@ TYPE (one of 'iso9660 or 'dce). Return a UUID object."
(let ((device (file-system-device fs)))
(list (file-system-mount-point fs)
(file-system-type fs)
- (cond ((file-system-label? device)
- (file-system-label->string device))
- ((uuid? device)
- (uuid->string device))
- ((string? device)
- device)
- (else #f))
+ (file-system-device->string device)
(file-system-options fs))))
(if (eq? type 'iso9660)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index e69a3b6..b0386a1 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -517,12 +517,7 @@ list of services."
(cond ((uuid? root-device) 0)
((file-system-label? root-device) 1)
(else 2))
- (cond ((uuid? root-device)
- (uuid->string root-device))
- ((file-system-label? root-device)
- (file-system-label->string root-device))
- (else
- root-device)))
+ (file-system-device->string root-device))
(format #t (G_ " kernel: ~a~%") kernel)
- branch allow-booting-from-btrfs-subvolume created (now 6162b56), guix-commits, 2020/02/14
- 01/10: gnu: tests: Reduce the time required to run the system tests., guix-commits, 2020/02/14
- 02/10: gnu: linux-boot: Ensure volatile root is mounted read-only., guix-commits, 2020/02/14
- 03/10: file-systems: Add a 'file-system-device->string' procedure.,
guix-commits <=
- 06/10: gnu: linux-boot: Honor the "--root-options" kernel argument., guix-commits, 2020/02/14
- 09/10: scripts: system: Do not validate network file systems., guix-commits, 2020/02/14
- 07/10: gnu: linux-boot: Filter out file system independent options., guix-commits, 2020/02/14
- 04/10: gnu: linux-boot: Refactor boot-system., guix-commits, 2020/02/14
- 05/10: file-systems: Represent the file system options as an alist., guix-commits, 2020/02/14
- 10/10: gnu: Add fbset., guix-commits, 2020/02/14
- 08/10: bootloader: grub: Allow booting from a Btrfs subvolume., guix-commits, 2020/02/14