diff mbox series

[bug#36477,v3,46/48] system: vm: Support cross-compilation.

Message ID 20190902153333.11190-47-m.othacehe@gmail.com
State Accepted
Headers show
Series Add --target support to guix system | expand

Commit Message

Mathieu Othacehe Sept. 2, 2019, 3:33 p.m. UTC 
* 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,
move qemu from inputs list to a new native-inputs list and adapt
set-path-environment-variable call accordingly. Pass target to qemu-command
and gexp->derivation calls.
(iso9660-image): Move qemu from inputs to a new native-inputs list and adapt
set-path-environment-variable accordingly.
(qemu-image): Add target argument, move qemu from inputs list to a new
native-inputs list and adapt set-path-environment-variable call
accordingly. Pass target argument to expression->derivation-in-linux-vm call.
---
 gnu/system.scm    | 15 ++++++++-------
 gnu/system/vm.scm | 25 ++++++++++++++++++-------
 2 files changed, 26 insertions(+), 14 deletions(-)

Comments

Ludovic Courtès Sept. 4, 2019, 12:46 p.m. UTC | #1 
Mathieu Othacehe <m.othacehe@gmail.com> skribis:

> * 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,
> move qemu from inputs list to a new native-inputs list and adapt
> set-path-environment-variable call accordingly. Pass target to qemu-command
> and gexp->derivation calls.
> (iso9660-image): Move qemu from inputs to a new native-inputs list and adapt
> set-path-environment-variable accordingly.
> (qemu-image): Add target argument, move qemu from inputs list to a new
> native-inputs list and adapt set-path-environment-variable call
> accordingly. Pass target argument to expression->derivation-in-linux-vm call.

[...]

>  (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)))

Uh, passing ‘os’ to ‘system-linux-image-file-name’ never worked, right?

[...]

> -              (let* ((inputs  '#$(list qemu (canonical-package coreutils)))
> +              (let* ((inputs  '#$(list (canonical-package coreutils)))
> +                     (native-inputs '#+(list qemu))

All these inputs are added to $PATH just after, which shows that we run
them natively.  Thus, they must all be native.

IOW, all we have to do is replace #$ by #+.

(Also, make sure to test all this without a qemu-binfmt service set up.)

>             (let ((inputs
> -                  '#$(append (list qemu parted e2fsprogs dosfstools xorriso)
> +                  '#$(append (list parted e2fsprogs dosfstools xorriso)
>                               (map canonical-package
>                                    (list sed grep coreutils findutils gawk))))
> +                 (native-inputs '#+(list qemu))

Same here: this is added to $PATH so it must be native.

>             (let ((inputs
> -                  '#$(append (list qemu parted e2fsprogs dosfstools)
> +                  '#$(append (list util-linux parted e2fsprogs dosfstools)
>                               (map canonical-package
>                                    (list sed grep coreutils findutils gawk))))
> +                 (native-inputs '#+(list qemu))

Likewise.

Thanks,
Ludo’.
Mathieu Othacehe Oct. 2, 2019, 9:30 a.m. UTC | #2 
> Uh, passing ‘os’ to ‘system-linux-image-file-name’ never worked, right?

Right!

> All these inputs are added to $PATH just after, which shows that we run
> them natively.  Thus, they must all be native.
>
> IOW, all we have to do is replace #$ by #+.

Yes that's true for expression->derivation-in-linux-vm where inputs are
added to PATH an turned to be native-inputs.

> Same here: this is added to $PATH so it must be native.
>
>>             (let ((inputs
>> -                  '#$(append (list qemu parted e2fsprogs dosfstools)
>> +                  '#$(append (list util-linux parted e2fsprogs dosfstools)
>>                               (map canonical-package
>>                                    (list sed grep coreutils findutils gawk))))
>> +                 (native-inputs '#+(list qemu))
>
> Likewise.

However, here, those inputs are added to PATH, but this is the PATH on
the running VM, so they are supposed to be inputs and not native-inputs.

The issue I have is that qemu is not cross-compilable for now, plus it
is useless on the running VM. So I just removed it from both inputs
list.

Mathieu
diff mbox series

Patch

diff --git a/gnu/system.scm b/gnu/system.scm
index 485896ba0a..85059119cc 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -439,20 +439,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
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 07cee2d4f5..759745c277 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -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* ((inputs  '#$(list (canonical-package coreutils)))
+                     (native-inputs '#+(list qemu))
                      (linux   (string-append #$linux "/"
                                              #$(system-linux-image-file-name)))
                      (initrd  #$initrd)
@@ -222,16 +223,19 @@  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")
+                                               (append inputs 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 +252,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)))
@@ -299,9 +304,10 @@  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))))
+                 (native-inputs '#+(list qemu))
 
 
                  (graphs     '#$(match inputs
@@ -315,7 +321,8 @@  INPUTS is a list of inputs (as for packages)."
                             ((name thing output) `(,thing ,output)))
                           inputs)))
 
-             (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
+             (set-path-environment-variable "PATH" '("bin" "sbin")
+                                            (append inputs native-inputs))
              (make-iso9660-image #$xorriso
                                  '#$grub-mkrescue-environment
                                  #$(bootloader-package bootloader)
@@ -346,6 +353,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,9 +412,10 @@  system."
            (setlocale LC_ALL "en_US.utf8")
 
            (let ((inputs
-                  '#$(append (list qemu parted e2fsprogs dosfstools)
+                  '#$(append (list util-linux parted e2fsprogs dosfstools)
                              (map canonical-package
                                   (list sed grep coreutils findutils gawk))))
+                 (native-inputs '#+(list qemu))
 
                  ;; This variable is unused but allows us to add INPUTS-TO-COPY
                  ;; as inputs.
@@ -416,7 +425,8 @@  system."
                             ((name thing output) `(,thing ,output)))
                           inputs)))
 
-             (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
+             (set-path-environment-variable "PATH" '("bin" "sbin")
+                                            (append inputs native-inputs))
 
              (let* ((graphs     '#$(match inputs
                                      (((names . _) ...)
@@ -483,6 +493,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