system: vm: Support cross-compilation.
* gnu/system.scm (system-linux-image-file-name): Add support for cross-built systems. Remove system argument that was ignored, (operating-system-kernel-file): adapt by removing ignored os argument. * gnu/system/vm.scm (expression->derivation-in-linux-vm): Add target argument and turn inputs into native-inputs. Pass target to qemu-command and gexp->derivation calls. (iso9660-image): Add target argument and pass it to expression->derivation-in-linux-vm. Remove qemu from inputs as it is not necessary. (qemu-image): Add target argument, also remove qemu from inputs. Pass target argument to expression->derivation-in-linux-vm call.
This commit is contained in:
Mathieu Othacehe
parent
39c746f081
commit
d4ddf22d54
@ -447,20 +447,21 @@ from the initrd."
|
||||
"Return the list of swap services for OS."
|
||||
(map swap-service (operating-system-swap-devices os)))
|
||||
|
||||
(define* (system-linux-image-file-name #:optional (system (%current-system)))
|
||||
(define* (system-linux-image-file-name)
|
||||
"Return the basename of the kernel image file for SYSTEM."
|
||||
;; FIXME: Evaluate the conditional based on the actual current system.
|
||||
(cond
|
||||
((string-prefix? "arm" (%current-system)) "zImage")
|
||||
((string-prefix? "mips" (%current-system)) "vmlinuz")
|
||||
((string-prefix? "aarch64" (%current-system)) "Image")
|
||||
(else "bzImage")))
|
||||
(let ((target (or (%current-target-system) (%current-system))))
|
||||
(cond
|
||||
((string-prefix? "arm" target) "zImage")
|
||||
((string-prefix? "mips" target) "vmlinuz")
|
||||
((string-prefix? "aarch64" target) "Image")
|
||||
(else "bzImage"))))
|
||||
|
||||
(define (operating-system-kernel-file os)
|
||||
"Return an object representing the absolute file name of the kernel image of
|
||||
OS."
|
||||
(file-append (operating-system-kernel os)
|
||||
"/" (system-linux-image-file-name os)))
|
||||
"/" (system-linux-image-file-name)))
|
||||
|
||||
(define* (operating-system-directory-base-entries os)
|
||||
"Return the basic entries of the 'system' directory of OS for use as the
|
||||
|
||||
@ -143,7 +143,7 @@
|
||||
|
||||
(define* (expression->derivation-in-linux-vm name exp
|
||||
#:key
|
||||
(system (%current-system))
|
||||
(system (%current-system)) target
|
||||
(linux linux-libre)
|
||||
initrd
|
||||
(qemu qemu-minimal)
|
||||
@ -214,7 +214,8 @@ made available under the /xchg CIFS share."
|
||||
(use-modules (guix build utils)
|
||||
(gnu build vm))
|
||||
|
||||
(let* ((inputs '#$(list qemu (canonical-package coreutils)))
|
||||
(let* ((native-inputs
|
||||
'#+(list qemu (canonical-package coreutils)))
|
||||
(linux (string-append #$linux "/"
|
||||
#$(system-linux-image-file-name)))
|
||||
(initrd #$initrd)
|
||||
@ -222,16 +223,18 @@ made available under the /xchg CIFS share."
|
||||
(graphs '#$(match references-graphs
|
||||
(((graph-files . _) ...) graph-files)
|
||||
(_ #f)))
|
||||
(target #$(or (%current-target-system) (%current-system)))
|
||||
(size #$(if (eq? 'guess disk-image-size)
|
||||
#~(+ (* 70 (expt 2 20)) ;ESP
|
||||
(estimated-partition-size graphs))
|
||||
disk-image-size)))
|
||||
|
||||
(set-path-environment-variable "PATH" '("bin") inputs)
|
||||
(set-path-environment-variable "PATH" '("bin") native-inputs)
|
||||
|
||||
(load-in-linux-vm loader
|
||||
#:output #$output
|
||||
#:linux linux #:initrd initrd
|
||||
#:qemu (qemu-command target)
|
||||
#:memory-size #$memory-size
|
||||
#:make-disk-image? #$make-disk-image?
|
||||
#:single-file-output? #$single-file-output?
|
||||
@ -248,6 +251,7 @@ made available under the /xchg CIFS share."
|
||||
(gexp->derivation name builder
|
||||
;; TODO: Require the "kvm" feature.
|
||||
#:system system
|
||||
#:target target
|
||||
#:env-vars env-vars
|
||||
#:guile-for-build guile-for-build
|
||||
#:references-graphs references-graphs)))
|
||||
@ -263,6 +267,7 @@ made available under the /xchg CIFS share."
|
||||
file-system-label
|
||||
file-system-uuid
|
||||
(system (%current-system))
|
||||
(target (%current-target-system))
|
||||
(qemu qemu-minimal)
|
||||
os
|
||||
bootcfg-drv
|
||||
@ -299,7 +304,7 @@ INPUTS is a list of inputs (as for packages)."
|
||||
(setlocale LC_ALL "en_US.utf8")
|
||||
|
||||
(let ((inputs
|
||||
'#$(append (list qemu parted e2fsprogs dosfstools xorriso)
|
||||
'#$(append (list parted e2fsprogs dosfstools xorriso)
|
||||
(map canonical-package
|
||||
(list sed grep coreutils findutils gawk))))
|
||||
|
||||
@ -328,6 +333,7 @@ INPUTS is a list of inputs (as for packages)."
|
||||
#:volume-uuid #$(and=> file-system-uuid
|
||||
uuid-bytevector))))))
|
||||
#:system system
|
||||
#:target target
|
||||
|
||||
;; Keep a local file system for /tmp so that we can populate it directly as
|
||||
;; root and have files owned by root. See <https://bugs.gnu.org/31752>.
|
||||
@ -346,6 +352,7 @@ INPUTS is a list of inputs (as for packages)."
|
||||
(define* (qemu-image #:key
|
||||
(name "qemu-image")
|
||||
(system (%current-system))
|
||||
(target (%current-target-system))
|
||||
(qemu qemu-minimal)
|
||||
(disk-image-size 'guess)
|
||||
(disk-image-format "qcow2")
|
||||
@ -404,7 +411,7 @@ system."
|
||||
(setlocale LC_ALL "en_US.utf8")
|
||||
|
||||
(let ((inputs
|
||||
'#$(append (list qemu parted e2fsprogs dosfstools)
|
||||
'#$(append (list parted e2fsprogs dosfstools)
|
||||
(map canonical-package
|
||||
(list sed grep coreutils findutils gawk))))
|
||||
|
||||
@ -481,6 +488,7 @@ system."
|
||||
#:bootloader-installer
|
||||
#$(bootloader-installer bootloader)))))))
|
||||
#:system system
|
||||
#:target target
|
||||
#:make-disk-image? #t
|
||||
#:disk-image-size disk-image-size
|
||||
#:disk-image-format disk-image-format
|
||||
|
||||
Loading…
Reference in New Issue
Block a user