Merge branch 'master' into core-updates

1 files changed, 10 insertions, 14 deletions

diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 345cecedd8..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))
@@ -143,7 +145,7 @@ made available under the /xchg CIFS share."
                          (return initrd)
                          (base-initrd %linux-vm-file-systems
                                       #:linux linux
-                                      #:virtio? #t
+                                      #:linux-modules %base-initrd-modules
                                       #:qemu-networking? #t))))
 
     (define builder
@@ -512,12 +514,7 @@ of the GNU system as described by OS."
 
 
   (let ((os (operating-system (inherit os)
-              ;; Use an initrd with the whole QEMU shebang.
-              (initrd (lambda (file-systems . rest)
-                        (apply (operating-system-initrd os)
-                               file-systems
-                               #:virtio? #t
-                               rest)))
+              ;; Assume we have an initrd with the whole QEMU shebang.
 
               ;; Force our own root file system.  Refer to it by UUID so that
               ;; it works regardless of how the image is used ("qemu -hda",
@@ -549,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."
@@ -614,7 +611,6 @@ environment with the store shared with the host.  MAPPINGS is a list of
               (apply (operating-system-initrd os)
                      file-systems
                      #:volatile-root? #t
-                     #:virtio? #t
                      rest)))
 
     ;; Disable swap.