From 6ddb59607be810caa1aa40b402b38564d8d9a6bc Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 27 Apr 2018 15:31:37 +0200
Subject: 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.
---
 guix/scripts/system.scm | 24 +++++++++++++++++++++++-
 1 file changed, 23 insertions(+), 1 deletion(-)

(limited to 'guix/scripts/system.scm')

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 @@ (define (check-file-system-availability file-systems)
   (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 @@ (define labeled
               (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 @@ (define (file-system-location* fs)
                            (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~%")
-- 
cgit v1.2.3