mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 13:28:12 -05:00
file-systems: Remove 'title' field and add <file-system-label>.
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'.
This commit is contained in:
Ludovic Courtès
parent
25816c4306
commit
a5acc17a3c
13 changed files with 201 additions and 133 deletions
|
|
@ -9210,20 +9210,31 @@ 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.
|
||||
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@footnote{Note that, while it is tempting to use
|
||||
@file{/dev/disk/by-uuid} and similar device names to achieve the same
|
||||
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.}.
|
||||
|
||||
@item @code{title} (default: @code{'device})
|
||||
This is a symbol that specifies how the @code{device} field is to be
|
||||
interpreted.
|
||||
@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:
|
||||
|
||||
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).
|
||||
@example
|
||||
(file-system
|
||||
(mount-point "/home")
|
||||
(type "ext4")
|
||||
(device (file-system-label "my-home")))
|
||||
@end example
|
||||
|
||||
UUIDs may be converted from their string representation (as shown by the
|
||||
@findex uuid
|
||||
UUIDs are converted from their string representation (as shown by the
|
||||
@command{tune2fs -l} command) using the @code{uuid} form@footnote{The
|
||||
@code{uuid} form expects 16-byte UUIDs as defined in
|
||||
@uref{https://tools.ietf.org/html/rfc4122, RFC@tie{}4122}. This is the
|
||||
|
|
@ -9235,22 +9246,13 @@ like this:
|
|||
(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
|
||||
systems without having to hard-code their actual device
|
||||
name@footnote{Note that, while it is tempting to use
|
||||
@file{/dev/disk/by-uuid} and similar device names to achieve the same
|
||||
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
|
||||
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.
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
|
||||
;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
|
||||
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
|
||||
|
|
@ -31,6 +31,7 @@ (define-module (gnu bootloader grub)
|
|||
#: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 @@ (define (grub-root-search device file)
|
|||
((? 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
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2016, 2017 David Craven <david@craven.ch>
|
||||
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
|
||||
;;;
|
||||
|
|
@ -473,17 +473,9 @@ (define find-partition-by-luks-uuid
|
|||
(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 @@ (define max-trials
|
|||
;; 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 @@ (define (resolve find-partition spec fmt)
|
|||
(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 @@ (define (mount-nfs source mount-point type flags options)
|
|||
"")))))
|
||||
(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))))
|
||||
|
|
|
|||
|
|
@ -507,9 +507,15 @@ (define (lookup-module name)
|
|||
(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.
|
||||
|
|
|
|||
|
|
@ -303,15 +303,14 @@ (define user-processes-service-type
|
|||
|
||||
(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"
|
||||
|
|
|
|||
|
|
@ -131,13 +131,16 @@ (define (bootable-kernel-arguments kernel-arguments system.drv root-device)
|
|||
"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 @@ (define device-sexp->device
|
|||
(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 @@ (define (mapped-device-user device file-systems)
|
|||
(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 @@ (define* (operating-system-bootcfg os #:optional (old-entries '()))
|
|||
(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 @@ (define (operating-system-boot-parameters os system.drv root-device)
|
|||
(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 @@ (define (device->sexp device)
|
|||
(match device
|
||||
((? uuid? uuid)
|
||||
`(uuid ,(uuid-type uuid) ,(uuid-bytevector uuid)))
|
||||
((? file-system-label? label)
|
||||
`(file-system-label ,(file-system-label->string label)))
|
||||
(_
|
||||
device)))
|
||||
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -20,6 +20,8 @@ (define-module (gnu system file-systems)
|
|||
#: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 @@ (define-module (gnu system file-systems)
|
|||
#: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 @@ (define-module (gnu system file-systems)
|
|||
|
||||
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 @@ (define-module (gnu system file-systems)
|
|||
;;; 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 @@ (define-record-type* <file-system> file-system
|
|||
(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 @@ (define (file-system->spec fs)
|
|||
"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?)))))
|
||||
|
|
|
|||
|
|
@ -693,13 +693,12 @@ (define user-file-systems
|
|||
(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)))
|
||||
|
||||
|
|
|
|||
|
|
@ -590,17 +590,17 @@ (define relevant
|
|||
|
||||
(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 @@ (define (file-system-location* fs)
|
|||
(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 @@ (define (check-initrd-modules os)
|
|||
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?
|
||||
|
|
|
|||
Loading…
Reference in a new issue