apteryx pushed a commit to branch allow-booting-from-btrfs-subvolume
in repository guix.
commit af61745d8b686755a5d9deb9e21c9eac624fb43e
Author: Maxim Cournoyer <maxim.courno...@gmail.com>
AuthorDate: Wed Sep 25 22:43:41 2019 +0900
file-systems: Represent the file system options as an alist.
This allows accessing the parameter values easily, without having to parse a
string.
* gnu/system/file-systems.scm (<file-system>): Update the default value of
the
OPTIONS field, doc.
(%file-system-options): Field accessor renamed from `file-system-options'.
(file-system-options, file-system-options->string): New procedures.
* gnu/build/file-systems.scm (mount-file-system): Adapt.
* gnu/services/base.scm (file-system->fstab-entry): Likewise.
* tests/file-systems.scm: New tests.
* doc/guix.texi (File Systems): Document the modified default value of the
'file-system-options' field.
---
doc/guix.texi | 11 ++++++-----
gnu/build/file-systems.scm | 15 +++++++++------
gnu/services/base.scm | 35 +++++++++++++++++++----------------
gnu/system/file-systems.scm | 35 +++++++++++++++++++++++++++++++++--
tests/file-systems.scm | 24 ++++++++++++++++++++++++
5 files changed, 91 insertions(+), 29 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 85cfabc..5d526b1 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -11405,11 +11405,12 @@ update time on the in-memory version of the file
inode), and
@xref{Mount-Unmount-Remount,,, libc, The GNU C Library Reference
Manual}, for more information on these flags.
-@item @code{options} (default: @code{#f})
-This is either @code{#f}, or a string denoting mount options passed to the
-file system driver. @xref{Mount-Unmount-Remount,,, libc, The GNU C Library
-Reference Manual}, for details and run @command{man 8 mount} for options for
-various file systems.
+@item @code{options} (default: @code{'()})
+A list of parameters and/or of pairs of parameter name and values, as
+strings. Those represent the mount options that are passed to the file
+system driver. @xref{Mount-Unmount-Remount,,, libc, The GNU C Library
+Reference Manual}, for details and run @command{man 8 mount} for options
+for various file systems.
@item @code{mount?} (default: @code{#t})
This value indicates whether to automatically mount the file system when
diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index ee63755..cfa3898 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -662,12 +662,15 @@ corresponds to the symbols listed in FLAGS."
(if options
(string-append "," options)
"")))))
- (let ((type (file-system-type fs))
- (options (file-system-options 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))))
+ (let* ((type (file-system-type fs))
+ (fs-options (file-system-options fs))
+ (options (if (null? fs-options)
+ #f
+ (file-system-options->string fs-options)))
+ (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))))
(when (file-system-check? fs)
(check-file-system source type))
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 0c154d1..6104b47 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -313,22 +313,25 @@ 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 (match (file-system-device file-system)
- ((? file-system-label? label)
- (string-append "LABEL="
- (file-system-label->string label)))
- ((? 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"
- (or (file-system-options file-system) "defaults") "\t"
-
- ;; XXX: Omit the 'fs_freq' and 'fs_passno' fields because we
- ;; don't have anything sensible to put in there.
- ))
+ (let ((options (file-system-options file-system)))
+ (string-append (match (file-system-device file-system)
+ ((? file-system-label? label)
+ (string-append "LABEL="
+ (file-system-label->string label)))
+ ((? 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"
+ (if (null? options)
+ "defaults"
+ (file-system-options->string options)) "\t"
+
+ ;; XXX: Omit the 'fs_freq' and 'fs_passno' fields because we
+ ;; don't have anything sensible to put in there.
+ )))
(define (file-systems->fstab file-systems)
"Return a @file{/etc} entry for an @file{fstab} describing
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index fc383d8..6dc0e68 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès
<l...@gnu.org>
+;;; Copyright © 2020 Maxim Cournoyer <maxim.courno...@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -37,6 +38,7 @@
file-system-needed-for-boot?
file-system-flags
file-system-options
+ file-system-options->string
file-system-mount?
file-system-check?
file-system-create-mount-point?
@@ -97,8 +99,8 @@
(type file-system-type) ; string
(flags file-system-flags ; list of symbols
(default '()))
- (options file-system-options ; string or #f
- (default #f))
+ (options %file-system-options ; list of strings and/or
+ (default '())) ; pair of strings
(mount? file-system-mount? ; Boolean
(default #t))
(needed-for-boot? %file-system-needed-for-boot? ; Boolean
@@ -250,6 +252,35 @@ UUID-TYPE, a symbol such as 'dce or 'iso9660."
((? string?)
device)))
+(define (file-system-options fs)
+ "Return the options of a <file-system> record, as a list of options or
+option/value pairs."
+
+ ;; Support the deprecated options format (a string).
+ (define (options-string->options-list str)
+ (let ((option-list (string-split str #\,)))
+ (map (lambda (param)
+ (if (string-contains param "=")
+ (apply cons (string-split param #\=))
+ param))
+ option-list)))
+
+ (let ((fs-options (%file-system-options fs)))
+ (if (string? fs-options)
+ (options-string->options-list fs-options)
+ fs-options)))
+
+(define (file-system-options->string options)
+ "Return the string representation of the OPTIONS field of a <file-system>
+record"
+ (string-join (map (match-lambda
+ ((key . value)
+ (string-append key "=" value))
+ (key
+ key))
+ options)
+ ","))
+
(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/tests/file-systems.scm b/tests/file-systems.scm
index 4c28d0e..b9f4f50 100644
--- a/tests/file-systems.scm
+++ b/tests/file-systems.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015, 2017 Ludovic Courtès <l...@gnu.org>
+;;; Copyright © 2020 Maxim Cournoyer <maxim.courno...@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -64,4 +65,27 @@
(_ #f))
(source-module-closure '((gnu system file-systems)))))
+(define %fs-with-deprecated-options-string
+ (file-system
+ (device (file-system-label "btrfs-pool"))
+ (mount-point "/home")
+ (type "btrfs")
+ (options "autodefrag,subvol=home,compress=lzo")))
+
+(define %fs
+ (file-system
+ (device (file-system-label "btrfs-pool"))
+ (mount-point "/root")
+ (type "btrfs")
+ (options '("autodefrag" ("subvol" . "root") ("compress" . "lzo")))))
+
+(test-equal "<file-system> options given as a string (deprecated)"
+ '("autodefrag" ("subvol" . "home") ("compress" . "lzo"))
+ (file-system-options %fs-with-deprecated-options-string))
+
+(test-equal "<file-system> options conversion to string"
+ "autodefrag,subvol=root,compress=lzo"
+ (file-system-options->string
+ (file-system-options %fs)))
+
(test-end)
