guix system: Report wrong file system 'device' fields.

Previously, if you wrote (device "my-label") without (title 'label),
you'd get:

  guix system: error: stat: No such file or directory: "my-label"

Now you get a proper error and a hint.

Reported by Pierre-Antoine Rouby.

* guix/scripts/system.scm (check-file-system-availability)[literal]: New
variable.  Loop over LITERAL.
* gnu/system/file-systems.scm (%pseudo-file-system-types): New variable.
* guix/ui.scm (display-hint): Make public.
This commit is contained in:
Ludovic Courtès 2018-04-27 15:31:37 +02:00
parent 60912a888d
commit 6ddb59607b
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 32 additions and 2 deletions

@ -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>
;;;
;;; This file is part of GNU Guix.
;;;
@ -47,6 +47,7 @@
spec->file-system
specification->file-system-mapping
%pseudo-file-system-types
%fuse-control-file-system
%binary-format-file-system
%shared-memory-file-system
@ -203,6 +204,12 @@ TARGET in the other system."
;;; Common file systems.
;;;
(define %pseudo-file-system-types
;; List of know pseudo file system types. This is used when validating file
;; system definitions.
'("binfmt_misc" "cgroup" "devpts" "devtmpfs" "fusectl"
"proc" "sysfs" "tmpfs"))
(define %fuse-control-file-system
;; Control file system for Linux' file systems in user-space (FUSE).
(file-system

@ -583,7 +583,8 @@ any, are available. Raise an error if they're not."
(define relevant
(filter (lambda (fs)
(and (file-system-mount? fs)
(not (string=? "tmpfs" (file-system-type fs)))
(not (member (file-system-type fs)
%pseudo-file-system-types))
(not (memq 'bind-mount (file-system-flags fs)))))
file-systems))
@ -592,6 +593,11 @@ any, are available. Raise an error if they're not."
(eq? (file-system-title fs) 'label))
relevant))
(define literal
(filter (lambda (fs)
(eq? (file-system-title fs) 'device))
relevant))
(define uuid
(filter (lambda (fs)
(eq? (file-system-title fs) 'uuid))
@ -610,6 +616,22 @@ any, are available. Raise an error if they're not."
(set! fail? #t)
(format (current-error-port)
args ...))))))
(for-each (lambda (fs)
(catch 'system-error
(lambda ()
(stat (file-system-device fs)))
(lambda args
(let ((errno (system-error-errno args))
(device (file-system-device fs)))
(error (G_ "~a: error: device '~a' not found: ~a~%")
(file-system-location* fs) device
(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)))))))
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~%")

@ -60,6 +60,7 @@
#:use-module (texinfo string-utils)
#:re-export (G_ N_ P_) ;backward compatibility
#:export (report-error
display-hint
leave
make-user-module
load*