Merge branch 'master' into core-updates

3 files changed, 31 insertions, 2 deletions

diff --git a/guix/download.scm b/guix/download.scm
index 377e8186f3..66d97eed44 100644
--- a/guix/download.scm
+++ b/guix/download.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013, 2014, 2015 Andreas Enge <andreas@enge.fr>
 ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
 ;;; Copyright © 2016 Alex Griffin <a@ajgrf.com>
@@ -509,6 +509,8 @@ own.  This helper makes it easier to deal with \"tar bombs\"."
                                       #:system system
                                       #:guile guile)))
     ;; Take the tar bomb, and simply unpack it as a directory.
+    ;; Use ungrafted tar/gzip so that the resulting tarball doesn't depend on
+    ;; whether grafts are enabled.
     (gexp->derivation (or name file-name)
                       (with-imported-modules '((guix build utils))
                         #~(begin
@@ -518,6 +520,7 @@ own.  This helper makes it easier to deal with \"tar bombs\"."
                             (chdir #$output)
                             (invoke (string-append #$tar "/bin/tar")
                                     "xf" #$drv)))
+                      #:graft? #f
                       #:local-build? #t)))
 
 (define* (url-fetch/zipbomb url hash-algo hash
@@ -541,6 +544,8 @@ own.  This helper makes it easier to deal with \"zip bombs\"."
                                       #:system system
                                       #:guile guile)))
     ;; Take the zip bomb, and simply unpack it as a directory.
+    ;; Use ungrafted unzip so that the resulting tarball doesn't depend on
+    ;; whether grafts are enabled.
     (gexp->derivation (or name file-name)
                       (with-imported-modules '((guix build utils))
                         #~(begin
@@ -549,6 +554,7 @@ own.  This helper makes it easier to deal with \"zip bombs\"."
                             (chdir #$output)
                             (invoke (string-append #$unzip "/bin/unzip")
                                     #$drv)))
+                      #:graft? #f
                       #:local-build? #t)))
 
 (define* (download-to-store store url #:optional (name (basename url))
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 c6d0704cfa..07c78289ff 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -66,6 +66,7 @@
   #:use-module (texinfo string-utils)
   #:re-export (G_ N_ P_)                          ;backward compatibility
   #:export (report-error
+            display-hint
             leave
             make-user-module
             load*