me
/
guix
Archived
1
0
Fork 0
Code

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.
master
Mathieu Othacehe 2019-08-21 09:19:58 +02:00
parent 39c746f081
commit d4ddf22d54
No known key found for this signature in database
GPG Key ID: 8354763531769CA6
2 changed files with 21 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
gnu/system.scm
View File

@ -447,20 +447,21 @@ from the initrd."
"Return the list of swap services for OS." "Return the list of swap services for OS."
(map swap-service (operating-system-swap-devices 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." "Return the basename of the kernel image file for SYSTEM."
;; FIXME: Evaluate the conditional based on the actual current system. ;; FIXME: Evaluate the conditional based on the actual current system.
(cond (let ((target (or (%current-target-system) (%current-system))))
((string-prefix? "arm" (%current-system)) "zImage") (cond
((string-prefix? "mips" (%current-system)) "vmlinuz") ((string-prefix? "arm" target) "zImage")
((string-prefix? "aarch64" (%current-system)) "Image") ((string-prefix? "mips" target) "vmlinuz")
(else "bzImage"))) ((string-prefix? "aarch64" target) "Image")
(else "bzImage"))))
(define (operating-system-kernel-file os) (define (operating-system-kernel-file os)
"Return an object representing the absolute file name of the kernel image of "Return an object representing the absolute file name of the kernel image of
OS." OS."
(file-append (operating-system-kernel 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) (define* (operating-system-directory-base-entries os)
"Return the basic entries of the 'system' directory of OS for use as the "Return the basic entries of the 'system' directory of OS for use as the

18
gnu/system/vm.scm
View File

@ -143,7 +143,7 @@
(define* (expression->derivation-in-linux-vm name exp (define* (expression->derivation-in-linux-vm name exp
#:key #:key
(system (%current-system)) (system (%current-system)) target
(linux linux-libre) (linux linux-libre)
initrd initrd
(qemu qemu-minimal) (qemu qemu-minimal)
@ -214,7 +214,8 @@ made available under the /xchg CIFS share."
(use-modules (guix build utils) (use-modules (guix build utils)
(gnu build vm)) (gnu build vm))
(let* ((inputs '#$(list qemu (canonical-package coreutils))) (let* ((native-inputs
'#+(list qemu (canonical-package coreutils)))
(linux (string-append #$linux "/" (linux (string-append #$linux "/"
#$(system-linux-image-file-name))) #$(system-linux-image-file-name)))
(initrd #$initrd) (initrd #$initrd)
@ -222,16 +223,18 @@ made available under the /xchg CIFS share."
(graphs '#$(match references-graphs (graphs '#$(match references-graphs
(((graph-files . _) ...) graph-files) (((graph-files . _) ...) graph-files)
(_ #f))) (_ #f)))
(target #$(or (%current-target-system) (%current-system)))
(size #$(if (eq? 'guess disk-image-size) (size #$(if (eq? 'guess disk-image-size)
#~(+ (* 70 (expt 2 20)) ;ESP #~(+ (* 70 (expt 2 20)) ;ESP
(estimated-partition-size graphs)) (estimated-partition-size graphs))
disk-image-size))) disk-image-size)))
(set-path-environment-variable "PATH" '("bin") inputs) (set-path-environment-variable "PATH" '("bin") native-inputs)
(load-in-linux-vm loader (load-in-linux-vm loader
#:output #$output #:output #$output
#:linux linux #:initrd initrd #:linux linux #:initrd initrd
#:qemu (qemu-command target)
#:memory-size #$memory-size #:memory-size #$memory-size
#:make-disk-image? #$make-disk-image? #:make-disk-image? #$make-disk-image?
#:single-file-output? #$single-file-output? #:single-file-output? #$single-file-output?
@ -248,6 +251,7 @@ made available under the /xchg CIFS share."
(gexp->derivation name builder (gexp->derivation name builder
;; TODO: Require the "kvm" feature. ;; TODO: Require the "kvm" feature.
#:system system #:system system
#:target target
#:env-vars env-vars #:env-vars env-vars
#:guile-for-build guile-for-build #:guile-for-build guile-for-build
#:references-graphs references-graphs))) #:references-graphs references-graphs)))
@ -263,6 +267,7 @@ made available under the /xchg CIFS share."
file-system-label file-system-label
file-system-uuid file-system-uuid
(system (%current-system)) (system (%current-system))
(target (%current-target-system))
(qemu qemu-minimal) (qemu qemu-minimal)
os os
bootcfg-drv bootcfg-drv
@ -299,7 +304,7 @@ INPUTS is a list of inputs (as for packages)."
(setlocale LC_ALL "en_US.utf8") (setlocale LC_ALL "en_US.utf8")
(let ((inputs (let ((inputs
'#$(append (list qemu parted e2fsprogs dosfstools xorriso) '#$(append (list parted e2fsprogs dosfstools xorriso)
(map canonical-package (map canonical-package
(list sed grep coreutils findutils gawk)))) (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 #:volume-uuid #$(and=> file-system-uuid
uuid-bytevector)))))) uuid-bytevector))))))
#:system system #:system system
#:target target
;; Keep a local file system for /tmp so that we can populate it directly as ;; 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>. ;; 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 (define* (qemu-image #:key
(name "qemu-image") (name "qemu-image")
(system (%current-system)) (system (%current-system))
(target (%current-target-system))
(qemu qemu-minimal) (qemu qemu-minimal)
(disk-image-size 'guess) (disk-image-size 'guess)
(disk-image-format "qcow2") (disk-image-format "qcow2")
@ -404,7 +411,7 @@ system."
(setlocale LC_ALL "en_US.utf8") (setlocale LC_ALL "en_US.utf8")
(let ((inputs (let ((inputs
'#$(append (list qemu parted e2fsprogs dosfstools) '#$(append (list parted e2fsprogs dosfstools)
(map canonical-package (map canonical-package
(list sed grep coreutils findutils gawk)))) (list sed grep coreutils findutils gawk))))
@ -481,6 +488,7 @@ system."
#:bootloader-installer #:bootloader-installer
#$(bootloader-installer bootloader))))))) #$(bootloader-installer bootloader)))))))
#:system system #:system system
#:target target
#:make-disk-image? #t #:make-disk-image? #t
#:disk-image-size disk-image-size #:disk-image-size disk-image-size
#:disk-image-format disk-image-format #:disk-image-format disk-image-format