Merge branch 'master' into staging

4 files changed, 46 insertions, 25 deletions

diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index 37c591ec3a..97f5abe0b6 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -133,7 +133,7 @@ the given target.")
       (stop #~(lambda (target)
                 ;; Delete the temporary directory, but leave everything
                 ;; mounted as there may still be processes using it since
-                ;; 'user-processes' doesn't depend on us.  The 'user-unmount'
+                ;; 'user-processes' doesn't depend on us.  The 'user-file-systems'
                 ;; service will unmount TARGET eventually.
                 (delete-file-recursively
                  (string-append target #$%backing-directory))))))))
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index e0cb59c009..1eb5f5130d 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -24,6 +24,7 @@
   #:use-module (guix store)
   #:use-module (guix gexp)
   #:use-module (guix utils)
+  #:use-module (guix i18n)
   #:use-module ((guix store)
                 #:select (%store-prefix))
   #:use-module ((guix derivations)
@@ -37,16 +38,22 @@
                 #:select (%guile-static-stripped))
   #:use-module (gnu system file-systems)
   #:use-module (gnu system mapped-devices)
+  #:autoload   (gnu build linux-modules)
+                 (device-module-aliases matching-modules)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 vlist)
+  #:use-module (ice-9 format)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
   #:export (expression->initrd
             %base-initrd-modules
             raw-initrd
             file-system-packages
-            base-initrd))
+            base-initrd
+            check-device-initrd-modules))
 
 
 ;;; Commentary:
@@ -343,4 +350,31 @@ loaded at boot time in the order in which they appear."
               #:volatile-root? volatile-root?
               #:on-error on-error))
 
+(define (check-device-initrd-modules device linux-modules location)
+  "Raise an error if DEVICE needs modules beyond LINUX-MODULES to operate.
+DEVICE must be a \"/dev\" file name."
+  (let ((modules (delete-duplicates
+                  (append-map matching-modules
+                              (device-module-aliases device)))))
+    (unless (every (cute member <> linux-modules) modules)
+      (raise (condition
+              (&message
+               (message (format #f (G_ "you may need these modules \
+in the initrd for ~a:~{ ~a~}")
+                                device modules)))
+              (&fix-hint
+               (hint (format #f (G_ "Try adding them to the
+@code{initrd-modules} field of your @code{operating-system} declaration, along
+these lines:
+
+@example
+ (operating-system
+   ;; @dots{}
+   (initrd-modules (append (list~{ ~s~})
+                           %base-initrd-modules)))
+@end example\n")
+                             modules)))
+              (&error-location
+               (location (source-properties->location location))))))))
+
 ;;; linux-initrd.scm ends here
diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm
index 5ceb5e658c..e6ac635231 100644
--- a/gnu/system/mapped-devices.scm
+++ b/gnu/system/mapped-devices.scm
@@ -29,9 +29,9 @@
   #:use-module (gnu services)
   #:use-module (gnu services shepherd)
   #:use-module (gnu system uuid)
+  #:use-module ((gnu system linux-initrd)
+                #:select (check-device-initrd-modules))
   #:autoload   (gnu build file-systems) (find-partition-by-luks-uuid)
-  #:autoload   (gnu build linux-modules)
-                 (device-module-aliases matching-modules)
   #:autoload   (gnu packages cryptsetup) (cryptsetup-static)
   #:autoload   (gnu packages linux) (mdadm-static)
   #:use-module (srfi srfi-1)
@@ -154,21 +154,6 @@
   #~(zero? (system* #$(file-append cryptsetup-static "/sbin/cryptsetup")
                     "close" #$target)))
 
-(define (check-device-initrd-modules device linux-modules location)
-  "Raise an error if DEVICE needs modules beyond LINUX-MODULES to operate.
-DEVICE must be a \"/dev\" file name."
-  (let ((modules (delete-duplicates
-                  (append-map matching-modules
-                              (device-module-aliases device)))))
-    (unless (every (cute member <> linux-modules) modules)
-      (raise (condition
-              (&message
-               (message (format #f (G_ "you may need these modules \
-in the initrd for ~a:~{ ~a~}")
-                                device modules)))
-              (&error-location
-               (location (source-properties->location location))))))))
-
 (define* (check-luks-device md #:key
                             needed-for-boot?
                             (initrd-modules '())
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 91ff32ce9a..ae8780d2e1 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -30,6 +30,8 @@
   #:use-module (guix records)
   #:use-module (guix modules)
   #:use-module (guix utils)
+  #:use-module (guix hash)
+  #:use-module (guix base32)
 
   #:use-module ((gnu build vm)
                 #:select (qemu-command))
@@ -544,13 +546,13 @@ of the GNU system as described by OS."
 
 (define (file-system->mount-tag fs)
   "Return a 9p mount tag for host file system FS."
-  ;; QEMU mount tags cannot contain slashes and cannot start with '_'.
-  ;; Compute an identifier that corresponds to the rules.
+  ;; QEMU mount tags must be ASCII, at most 31-byte long, cannot contain
+  ;; slashes, and cannot start with '_'.  Compute an identifier that
+  ;; corresponds to the rules.
   (string-append "TAG"
-                 (string-map (match-lambda
-                              (#\/ #\_)
-                              (chr chr))
-                             fs)))
+                 (string-drop (bytevector->base32-string
+                               (sha1 (string->utf8 fs)))
+                              4)))
 
 (define (mapping->file-system mapping)
   "Return a 9p file system that realizes MAPPING."