From af61745d8b686755a5d9deb9e21c9eac624fb43e Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Wed, 25 Sep 2019 22:43:41 +0900 Subject: [PATCH 5/9] 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 (): 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 85cfabc2f3..5d526b1aee 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 ee6375515f..cfa3898f83 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 0c154d1c4e..6104b47870 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 fc383d8a5a..6dc0e6814e 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 +;;; Copyright © 2020 Maxim Cournoyer ;;; ;;; 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 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 +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 4c28d0ebc5..b9f4f50aad 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 +;;; Copyright © 2020 Maxim Cournoyer ;;; ;;; 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 " options given as a string (deprecated)" + '("autodefrag" ("subvol" . "home") ("compress" . "lzo")) + (file-system-options %fs-with-deprecated-options-string)) + +(test-equal " options conversion to string" + "autodefrag,subvol=root,compress=lzo" + (file-system-options->string + (file-system-options %fs))) + (test-end) -- 2.23.0