mirror of
https://codeberg.org/guix/guix.git
synced 2025-10-02 02:15:12 +00: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
|
|
@ -20,6 +20,8 @@
|
|||
#: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 @@
|
|||
#: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 @@
|
|||
|
||||
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 @@
|
|||
;;; 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 @@
|
|||
(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 @@ store--e.g., if FS is the root file system."
|
|||
"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?)))))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue