04/04: vm: Use 9p mount tags below 32 chars.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit dffc5ab5e47e45b94188828205c8d567994926ad
Author: Ludovic Courtès <address@hidden>
Date:   Thu Mar 8 11:55:06 2018 +0100

    vm: Use 9p mount tags below 32 chars.
    
    Fixes <https://bugs.gnu.org/30667>.
    Reported by Björn Höfling <address@hidden>.
    
    * gnu/system/vm.scm (file-system->mount-tag): Use 'sha1' to compute the
    tag.
---
 gnu/system/vm.scm | 14 ++++++++------
 1 file changed, 8 insertions(+), 6 deletions(-)

diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 91ff32c..ae8780d 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."