ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-05 10:56:56 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

system: vm: Support cross-compilation.

Browse source 
* 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 2019-08-21 09:19:58 +02:00
parent fd02b831ba
commit 4ba3c0da4f
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 @@ (define (swap-services os)
"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 gcrypt-sqlite3&co
(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 @@ (define builder
(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 @@ (define builder
(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 @@ (define builder
(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 @@ (define* (iso9660-image #:key
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 @@ (define schema
(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 @@ (define schema
#: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 @@ (define schema
(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 @@ (define schema
(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 @@ (define schema
#: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