vm: 'vm-image' images refer to the root file system by UUID.

This avoids the hard-coded "/dev/sda1", which only made sense when the
image is run with "qemu-system-x86_64 -hda", not when it's passed to
Xen, etc.

Reported by Andreas Enge <andreas@enge.fr>.

* gnu/system/vm.scm (system-qemu-image): Define 'root-uuid', use it as
the 'device' field for "/", and pass it to 'qemu-image'.
This commit is contained in:
Ludovic Courtès 2018-01-07 15:06:36 +01:00
parent beb7e659f2
commit 61b94b8c32
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 15 additions and 3 deletions

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
;;; Copyright © 2016, 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
@ -503,6 +503,14 @@ of the GNU system as described by OS."
(string-prefix? "/dev/" source))))
(operating-system-file-systems os)))
(define root-uuid
;; UUID of the root file system.
(operating-system-uuid os
(if (string=? file-system-type "iso9660")
'iso9660
'dce)))
(let ((os (operating-system (inherit os)
;; Use an initrd with the whole QEMU shebang.
(initrd (lambda (file-systems . rest)
@ -511,10 +519,13 @@ of the GNU system as described by OS."
#:virtio? #t
rest)))
;; Force our own root file system.
;; Force our own root file system. Refer to it by UUID so that
;; it works regardless of how the image is used ("qemu -hda",
;; Xen, etc.).
(file-systems (cons (file-system
(mount-point "/")
(device "/dev/sda1")
(device root-uuid)
(title 'uuid)
(type file-system-type))
file-systems-to-keep)))))
(mlet* %store-monad
@ -526,6 +537,7 @@ of the GNU system as described by OS."
(operating-system-bootloader os))
#:disk-image-size disk-image-size
#:file-system-type file-system-type
#:file-system-uuid root-uuid
#:inputs `(("system" ,os-drv)
("bootcfg" ,bootcfg))
#:copy-inputs? #t))))