Package: guix-patches;
Reported by: Jan Nieuwenhuizen <janneke <at> gnu.org>
Date: Sun, 17 May 2020 10:02:01 UTC
Severity: normal
Tags: patch
Done: Mathieu Othacehe <othacehe <at> gnu.org>
Bug is archived. No further changes may be made.
Message #14 received at 41350 <at> debbugs.gnu.org (full text, mbox):
From: "Jan (janneke) Nieuwenhuizen" <janneke <at> gnu.org> To: 41350 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 3/3] system: vm: Build vm-image using native qemu. Date: Sun, 17 May 2020 12:03:43 +0200
Cross-building a vm-image used to be done using a cross-qemu, e.g, qemu-ARM.
That does not work for the Hurd, as there is no qemu-HURD.
This patch switches to cross building vm-images using a native qemu vm.
* gnu/system/vm.scm (expression->derivation-in-linux-vm): Run native
qemu-command; use native linux, initrd, bootloader-package and
bootloader-installer.
[preserve-target]: New helper to install cross-packages into the native vm.
* gnu/bootloader/grub.scm (eye-candy): Use native font.
Co-authored-by: Ludovic Courtès <ludo <at> gnu.org>
---
gnu/bootloader/grub.scm | 4 ++--
gnu/system/vm.scm | 46 ++++++++++++++++++++++++++---------------
2 files changed, 31 insertions(+), 19 deletions(-)
diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index 8c5b5eac0c..842592ccc9 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -211,8 +211,8 @@ else
set menu_color_highlight=white/blue
fi~%"
#$setup-gfxterm-body
- #$(grub-root-search store-device font-file)
- #$(setup-gfxterm config font-file)
+ #+(grub-root-search store-device font-file)
+ #+(setup-gfxterm config font-file)
#$(grub-setup-io config)
#$(strip-mount-point store-mount-point image)
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 97b0bf461b..aa094b0a06 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -5,6 +5,7 @@
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe <at> gmail.com>
;;; Copyright © 2017 Marius Bakke <mbakke <at> fastmail.com>
;;; Copyright © 2018 Chris Marusich <cmmarusich <at> gmail.com>
+;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke <at> gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -180,19 +181,30 @@ made available under the /xchg CIFS share.
SUBSTITUTABLE? determines whether the returned derivation should be marked as
substitutable."
(define user-builder
- (program-file "builder-in-linux-vm" exp))
+ (scheme-file "builder-in-linux-vm" exp))
+
+ (define (preserve-target obj)
+ (if target
+ (with-parameters ((%current-target-system target))
+ obj)
+ obj))
(define loader
- ;; Invoke USER-BUILDER instead using 'primitive-load'. The reason for
- ;; this is to allow USER-BUILDER to dlopen stuff by using a full-featured
- ;; Guile, which it couldn't do using the statically-linked guile used in
- ;; the initrd. See example at
+ ;; Instead of using 'primitive-load', evaluate USER-BUILDER in a
+ ;; full-featured Guile so it can use dlopen stuff, which it couldn't do
+ ;; using the statically-linked guile used in the initrd. See example at
;; <https://lists.gnu.org/archive/html/guix-devel/2017-10/msg00233.html>.
(program-file "linux-vm-loader"
- ;; Communicate USER-BUILDER's exit status via /xchg so that
- ;; the host can distinguish between success, failure, and
- ;; kernel panic.
- #~(let ((status (system* #$user-builder)))
+ ;; When cross-compiling, USER-BUILDER refers to the target
+ ;; (cross-compiled) system. Preserve that, even though
+ ;; LOADER itself is executed as a native program.
+ #~(let ((status (system* #+(file-append (default-guile)
+ "/bin/guile")
+ "--no-auto-compile"
+ #$(preserve-target user-builder))))
+ ;; Communicate USER-BUILDER's exit status via /xchg so
+ ;; that the host can distinguish between success,
+ ;; failure, and kernel panic.
(call-with-output-file "/xchg/.exit-status"
(lambda (port)
(write status port)))
@@ -226,10 +238,10 @@ substitutable."
(let* ((native-inputs
'#+(list qemu (canonical-package coreutils)))
- (linux (string-append #$linux "/"
- #$(system-linux-image-file-name)))
- (initrd #$initrd)
- (loader #$loader)
+ (linux (string-append #+linux "/"
+ #+(system-linux-image-file-name)))
+ (initrd #+initrd)
+ (loader #+loader)
(graphs '#$(match references-graphs
(((graph-files . _) ...) graph-files)
(_ #f)))
@@ -245,7 +257,7 @@ substitutable."
(load-in-linux-vm loader
#:output #$output
#:linux linux #:initrd initrd
- #:qemu (qemu-command target)
+ #:qemu (qemu-command)
#:memory-size #$memory-size
#:make-disk-image? #$make-disk-image?
#:single-file-output? #$single-file-output?
@@ -348,7 +360,7 @@ system that is passed to 'populate-root-file-system'."
(setlocale LC_ALL "en_US.utf8")
(let ((inputs
- '#$(append (list parted e2fsprogs dosfstools)
+ '#+(append (list parted e2fsprogs dosfstools)
(map canonical-package
(list sed grep coreutils findutils gawk))))
@@ -425,12 +437,12 @@ system that is passed to 'populate-root-file-system'."
#:partitions partitions
#:grub-efi grub-efi
#:bootloader-package
- #$(bootloader-package bootloader)
+ #+(bootloader-package bootloader)
#:bootcfg #$bootcfg-drv
#:bootcfg-location
#$(bootloader-configuration-file bootloader)
#:bootloader-installer
- #$(bootloader-installer bootloader)))))))
+ #+(bootloader-installer bootloader)))))))
#:system system
#:target target
#:make-disk-image? #t
--
2.26.0
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.