diff options
Diffstat (limited to 'gnu/build/file-systems.scm')
| -rw-r--r-- | gnu/build/file-systems.scm | 54 |
1 files changed, 14 insertions, 40 deletions
diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm index 145b3b14e7..3dd7358fd3 100644 --- a/gnu/build/file-systems.scm +++ b/gnu/build/file-systems.scm @@ -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 @@ were found." (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 @@ the following: ;; 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 @@ the following: (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 @@ run a file system check." ""))))) (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)))) |