diff options
Diffstat (limited to 'gnu/system/file-systems.scm')
| -rw-r--r-- | gnu/system/file-systems.scm | 71 |
1 files changed, 67 insertions, 4 deletions
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm index e69cfd06e6..e1d1fb72cc 100644 --- a/gnu/system/file-systems.scm +++ b/gnu/system/file-systems.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <[email protected]> +;;; Copyright © 2013-2021 Ludovic Courtès <[email protected]> ;;; Copyright © 2020 Google LLC ;;; Copyright © 2020 Jakub Kądziołka <[email protected]> ;;; Copyright © 2020, 2021 Maxim Cournoyer <[email protected]> @@ -30,7 +30,8 @@ #:use-module (srfi srfi-35) #:use-module (srfi srfi-9 gnu) #:use-module (guix records) - #:use-module ((guix diagnostics) #:select (&fix-hint)) + #:use-module ((guix diagnostics) + #:select (source-properties->location leave &fix-hint)) #:use-module (guix i18n) #:use-module (gnu system uuid) #:re-export (uuid ;backward compatibility @@ -96,7 +97,14 @@ %store-mapping %network-configuration-files - %network-file-mappings)) + %network-file-mappings + + swap-space + swap-space? + swap-space-target + swap-space-dependencies + swap-space-priority + swap-space-discard?)) ;;; Commentary: ;;; @@ -107,6 +115,45 @@ ;;; ;;; Code: +(eval-when (expand load eval) + (define invalid-file-system-flags + ;; Note: Keep in sync with 'mount-flags->bit-mask'. + (let ((known-flags '(read-only + bind-mount no-suid no-dev no-exec + no-atime strict-atime lazy-time))) + (lambda (flags) + "Return the subset of FLAGS that is invalid." + (remove (cut memq <> known-flags) flags)))) + + (define (%validate-file-system-flags flags location) + "Raise an error if FLAGS contains invalid mount flags; otherwise return +FLAGS." + (match (invalid-file-system-flags flags) + (() flags) + (invalid + (leave (source-properties->location location) + (N_ "invalid file system mount flag:~{ ~s~}~%" + "invalid file system mount flags:~{ ~s~}~%" + (length invalid)) + invalid))))) + +(define-syntax validate-file-system-flags + (lambda (s) + "Validate the given file system mount flags, raising an error if invalid +flags are found." + (syntax-case s (quote) + ((_ (quote (symbols ...))) ;validate at expansion time + (begin + (%validate-file-system-flags (syntax->datum #'(symbols ...)) + (syntax-source s)) + #'(quote (symbols ...)))) + ((_ flags) + #`(%validate-file-system-flags flags + '#,(datum->syntax s (syntax-source s)))) + (id + (identifier? #'id) + #'%validate-file-system-flags)))) + ;; File system declaration. (define-record-type* <file-system> %file-system make-file-system @@ -115,7 +162,8 @@ (mount-point file-system-mount-point) ; string (type file-system-type) ; string (flags file-system-flags ; list of symbols - (default '())) + (default '()) + (sanitize validate-file-system-flags)) (options file-system-options ; string or #f (default #f)) (mount? file-system-mount? ; Boolean @@ -671,4 +719,19 @@ subvolume name is unknown.")) (G_ "Use the @code{subvol} Btrfs file system option.")))))))) +;;; +;;; Swap space +;;; + +(define-record-type* <swap-space> swap-space make-swap-space + swap-space? + this-swap-space + (target swap-space-target) + (dependencies swap-space-dependencies + (default '())) + (priority swap-space-priority + (default #f)) + (discard? swap-space-discard? + (default #f))) + ;;; file-systems.scm ends here |