summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gnu/system/file-systems.scm9
-rw-r--r--guix/scripts/system.scm24
-rw-r--r--guix/ui.scm1
3 files changed, 32 insertions, 2 deletions
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index 7f5afb00fe..c0c635508c 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 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
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index b50cabcd1a..af501eb8f7 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -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))
@@ -611,6 +617,22 @@ any, are available. Raise an error if they're not."
(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~%")
(file-system-location* fs)
diff --git a/guix/ui.scm b/guix/ui.scm
index cb49a15c4d..536c36e3fe 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -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*