From patchwork Mon Aug 30 16:24:27 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Mathieu Othacehe X-Patchwork-Id: 32411 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id F002527BBE4; Mon, 30 Aug 2021 17:25:18 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, RCVD_IN_MSPIKE_H2,SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 98A1E27BBE1 for ; Mon, 30 Aug 2021 17:25:17 +0100 (BST) Received: from localhost ([::1]:43818 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mKk60-0005XA-MZ for patchwork@mira.cbaines.net; Mon, 30 Aug 2021 12:25:16 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:46870) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mKk5m-0005VE-7P for guix-patches@gnu.org; Mon, 30 Aug 2021 12:25:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:48507) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mKk5l-00055V-VS for guix-patches@gnu.org; Mon, 30 Aug 2021 12:25:01 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1mKk5l-0001Lr-Rl for guix-patches@gnu.org; Mon, 30 Aug 2021 12:25:01 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#45020] [PATCH 0/2] image: Add system field. Resent-From: Mathieu Othacehe Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 30 Aug 2021 16:25:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 45020 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Maxim Cournoyer Cc: Vagrant Cascadian , dannym@scratchpost.org, Ludovic =?utf-8?q?Court=C3=A8s?= , 45020@debbugs.gnu.org Received: via spool by 45020-submit@debbugs.gnu.org id=B45020.16303406855164 (code B ref 45020); Mon, 30 Aug 2021 16:25:01 +0000 Received: (at 45020) by debbugs.gnu.org; 30 Aug 2021 16:24:45 +0000 Received: from localhost ([127.0.0.1]:60053 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mKk5R-0001L8-Lq for submit@debbugs.gnu.org; Mon, 30 Aug 2021 12:24:45 -0400 Received: from eggs.gnu.org ([209.51.188.92]:58918) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mKk5M-0001Ki-Dc for 45020@debbugs.gnu.org; Mon, 30 Aug 2021 12:24:40 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:52686) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mKk5G-0004fB-Ka; Mon, 30 Aug 2021 12:24:30 -0400 Received: from [2a01:e0a:19b:d9a0:f2f7:a404:c3d3:f8b4] (port=37360 helo=meije) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mKk5F-000379-4U; Mon, 30 Aug 2021 12:24:30 -0400 From: Mathieu Othacehe References: <20201203105353.149482-1-othacehe@gnu.org> <87eejw5lsn.fsf@gnu.org> <87h7orpgsh.fsf@gnu.org> <87czze3obq.fsf@gnu.org> <87czzbfl0k.fsf@gnu.org> <87o8b3m2tk.fsf_-_@gmail.com> Date: Mon, 30 Aug 2021 18:24:27 +0200 In-Reply-To: <87o8b3m2tk.fsf_-_@gmail.com> (Maxim Cournoyer's message of "Thu, 15 Jul 2021 22:04:39 -0400") Message-ID: <87czpuaojo.fsf_-_@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.2 (gnu/linux) MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches Hey, Here's a patchset based on Ludo suggestion of introduction a platform record. It is for now limited to system, target, and linux-architecture fields but we could extend it to add the kernel, gcc, ... fields when needed. WDYT? Thanks, Mathieu From 8a5c6d75cb2bd9c26ec535229b52a2ab1b86c4b4 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Mon, 30 Aug 2021 17:48:10 +0200 Subject: [PATCH 2/2] image: Add platform field. Fixes: . * gnu/image.scm ()[target]: Remove this field and replace it with ... [platform]: ... this new field. image-target): Remove it. (image-platform, os+platform->image): New procedures. * gnu/system/image.scm (arm32-disk-image, arm64-disk-image, arm32-image-type, arm64-image-type): Remove them. (raw-with-offset-disk-image, raw-with-offset-image-type): New procedures. (system-image): Adapt it to use the image platform field. * gnu/system/images/hurd.scm (hurd-disk-image): Remove the target field. (hurd-barebones-disk-image, hurd-barebones-qcow2-image): Use os+platform->image procedure. * gnu/system/images/novena.scm (novena-image-type, novena-barebones-raw-image): Use the os+platform->image. * gnu/system/images/pine64.scm (pine64-image-type, pine64-barebones-raw-image): Use the os+platform->image. * gnu/system/images/pinebook-pro.scm (pinebook-pro-image-type, pinebook-pro-barebones-raw-image): Use the os+platform->image. * gnu/system/images/rock64.scm (rock64-image-type, rock64-barebones-raw-image): Use the os+platform->image. * guix/scripts/system.scm (process-action): Use the image platform field. --- gnu/image.scm | 13 ++++++-- gnu/system/image.scm | 51 ++++++++++++++++++------------ gnu/system/images/hurd.scm | 8 +++-- gnu/system/images/novena.scm | 6 ++-- gnu/system/images/pine64.scm | 6 ++-- gnu/system/images/pinebook-pro.scm | 6 ++-- gnu/system/images/rock64.scm | 8 +++-- guix/scripts/system.scm | 5 ++- 8 files changed, 66 insertions(+), 37 deletions(-) diff --git a/gnu/image.scm b/gnu/image.scm index 75d489490d..2381efa208 100644 --- a/gnu/image.scm +++ b/gnu/image.scm @@ -17,6 +17,7 @@ ;;; along with GNU Guix. If not, see . (define-module (gnu image) + #:use-module (gnu platform) #:use-module (guix records) #:export (partition partition? @@ -34,7 +35,7 @@ image? image-name image-format - image-target + image-platform image-size image-operating-system image-partitions @@ -47,7 +48,8 @@ image-type-name image-type-constructor - os->image)) + os->image + os+platform->image)) ;;; @@ -78,7 +80,7 @@ (name image-name ;symbol (default #f)) (format image-format) ;symbol - (target image-target + (platform image-platform ; (default #f)) (size image-size ;size in bytes as integer (default 'guess)) @@ -112,3 +114,8 @@ (define* (os->image os #:key type) (let ((constructor (image-type-constructor type))) (constructor os))) + +(define* (os+platform->image os platform #:key type) + (image + (inherit (os->image os #:type type)) + (platform platform))) diff --git a/gnu/system/image.scm b/gnu/system/image.scm index 1012fa6158..7a807b8226 100644 --- a/gnu/system/image.scm +++ b/gnu/system/image.scm @@ -31,6 +31,7 @@ #:use-module (gnu bootloader) #:use-module (gnu bootloader grub) #:use-module (gnu image) + #:use-module (gnu platform) #:use-module (gnu services) #:use-module (gnu services base) #:use-module (gnu system) @@ -66,16 +67,14 @@ efi-disk-image iso9660-image - arm32-disk-image - arm64-disk-image + raw-with-offset-disk-image image-with-os efi-raw-image-type qcow2-image-type iso-image-type uncompressed-iso-image-type - arm32-image-type - arm64-image-type + raw-with-offset-image-type image-with-label system-image @@ -128,10 +127,9 @@ (label "GUIX_IMAGE") (flags '(boot))))))) -(define* (arm32-disk-image #:optional (offset root-offset)) +(define* (raw-with-offset-disk-image #:optional (offset root-offset)) (image (format 'disk-image) - (target "arm-linux-gnueabihf") (partitions (list (partition (inherit root-partition) @@ -140,11 +138,6 @@ ;; fails. (volatile-root? #f))) -(define* (arm64-disk-image #:optional (offset root-offset)) - (image - (inherit (arm32-disk-image offset)) - (target "aarch64-linux-gnu"))) - ;;; ;;; Images types. @@ -186,15 +179,10 @@ set to the given OS." (compression? #f)) <>)))) -(define arm32-image-type - (image-type - (name 'arm32-raw) - (constructor (cut image-with-os (arm32-disk-image) <>)))) - -(define arm64-image-type +(define raw-with-offset-image-type (image-type - (name 'arm64-raw) - (constructor (cut image-with-os (arm64-disk-image) <>)))) + (name 'raw-with-offset) + (constructor (cut image-with-os (raw-with-offset-disk-image) <>)))) ;; @@ -615,7 +603,30 @@ it can be used for bootloading." "Return the derivation of IMAGE. It can be a raw disk-image or an ISO9660 image, depending on IMAGE format." (define substitutable? (image-substitutable? image)) - (define target (image-target image)) + (define platform (image-platform image)) + + ;; The image platform definition may provide the appropriate "system" + ;; architecture for the image. If we are already running on this system, + ;; the image can be built natively. If we are running on a different + ;; system, then we need to cross-compile, using the "target" provided by the + ;; image definition. + (define system (and=> platform platform-system)) + (define target (cond + ;; No defined platform, let's use the user defined + ;; system/target parameters. + ((not platform) + (%current-target-system)) + ;; The current system is the same as the platform system, no + ;; need to cross-compile. + ((and system + (string=? system (%current-system))) + #f) + ;; If there is a user defined target let's override the + ;; platform target. Otherwise, we can cross-compile to the + ;; platform target. + (else + (or (%current-target-system) + (and=> platform platform-target))))) (with-parameters ((%current-target-system target)) (let* ((os (operating-system-for-image image)) diff --git a/gnu/system/images/hurd.scm b/gnu/system/images/hurd.scm index fc2dbe3209..77f7ff5e2b 100644 --- a/gnu/system/images/hurd.scm +++ b/gnu/system/images/hurd.scm @@ -23,6 +23,7 @@ #:use-module (gnu bootloader grub) #:use-module (gnu image) #:use-module (gnu packages ssh) + #:use-module (gnu platforms hurd) #:use-module (gnu services) #:use-module (gnu services ssh) #:use-module (gnu system) @@ -75,7 +76,6 @@ (define hurd-disk-image (image (format 'disk-image) - (target "i586-pc-gnu") (partitions (list (partition (size 'guess) @@ -103,13 +103,15 @@ (define hurd-barebones-disk-image (image (inherit - (os->image hurd-barebones-os #:type hurd-image-type)) + (os+platform->image hurd-barebones-os hurd + #:type hurd-image-type)) (name 'hurd-barebones-disk-image))) (define hurd-barebones-qcow2-image (image (inherit - (os->image hurd-barebones-os #:type hurd-qcow2-image-type)) + (os+platform->image hurd-barebones-os hurd + #:type hurd-qcow2-image-type)) (name 'hurd-barebones.qcow2))) ;; Return the default image. diff --git a/gnu/system/images/novena.scm b/gnu/system/images/novena.scm index 63227af509..3ce62fbf3b 100644 --- a/gnu/system/images/novena.scm +++ b/gnu/system/images/novena.scm @@ -22,6 +22,7 @@ #:use-module (gnu bootloader u-boot) #:use-module (gnu image) #:use-module (gnu packages linux) + #:use-module (gnu platforms arm) #:use-module (gnu services) #:use-module (gnu services base) #:use-module (gnu system) @@ -52,12 +53,13 @@ (define novena-image-type (image-type (name 'novena-raw) - (constructor (cut image-with-os (arm32-disk-image) <>)))) + (constructor (cut image-with-os (raw-with-offset-disk-image) <>)))) (define novena-barebones-raw-image (image (inherit - (os->image novena-barebones-os #:type novena-image-type)) + (os+platform->image novena-barebones-os armv7-linux + #:type novena-image-type)) (name 'novena-barebones-raw-image))) ;; Return the default image. diff --git a/gnu/system/images/pine64.scm b/gnu/system/images/pine64.scm index 808c71295f..aaec458766 100644 --- a/gnu/system/images/pine64.scm +++ b/gnu/system/images/pine64.scm @@ -21,6 +21,7 @@ #:use-module (gnu bootloader u-boot) #:use-module (gnu image) #:use-module (gnu packages linux) + #:use-module (gnu platforms arm) #:use-module (gnu services) #:use-module (gnu services base) #:use-module (gnu system) @@ -57,12 +58,13 @@ (define pine64-image-type (image-type (name 'pine64-raw) - (constructor (cut image-with-os (arm64-disk-image) <>)))) + (constructor (cut image-with-os (raw-with-offset-disk-image) <>)))) (define pine64-barebones-raw-image (image (inherit - (os->image pine64-barebones-os #:type pine64-image-type)) + (os+platform->image pine64-barebones-os aarch64-linux + #:type pine64-image-type)) (name 'pine64-barebones-raw-image))) ;; Return the default image. diff --git a/gnu/system/images/pinebook-pro.scm b/gnu/system/images/pinebook-pro.scm index b6b844cef6..1bfac7a8bb 100644 --- a/gnu/system/images/pinebook-pro.scm +++ b/gnu/system/images/pinebook-pro.scm @@ -21,6 +21,7 @@ #:use-module (gnu bootloader u-boot) #:use-module (gnu image) #:use-module (gnu packages linux) + #:use-module (gnu platforms arm) #:use-module (gnu services) #:use-module (gnu services base) #:use-module (gnu system) @@ -58,13 +59,14 @@ (image-type (name 'pinebook-pro-raw) (constructor (cut image-with-os - (arm64-disk-image (* 9 (expt 2 20))) ;9MiB + (raw-with-offset-disk-image (* 9 (expt 2 20))) ;9MiB <>)))) (define pinebook-pro-barebones-raw-image (image (inherit - (os->image pinebook-pro-barebones-os #:type pinebook-pro-image-type)) + (os+platform->image pinebook-pro-barebones-os aarch64-linux + #:type pinebook-pro-image-type)) (name 'pinebook-pro-barebones-raw-image))) ;; Return the default image. diff --git a/gnu/system/images/rock64.scm b/gnu/system/images/rock64.scm index 68d3742adc..d25d55e528 100644 --- a/gnu/system/images/rock64.scm +++ b/gnu/system/images/rock64.scm @@ -21,6 +21,7 @@ #:use-module (gnu bootloader u-boot) #:use-module (gnu image) #:use-module (gnu packages linux) + #:use-module (gnu platforms arm) #:use-module (gnu services) #:use-module (gnu services base) #:use-module (gnu services networking) @@ -53,12 +54,15 @@ (define rock64-image-type (image-type (name 'rock64-raw) - (constructor (cut image-with-os (arm64-disk-image (expt 2 24)) <>)))) + (constructor (cut image-with-os + (raw-with-offset-disk-image (expt 2 24)) + <>)))) (define rock64-barebones-raw-image (image (inherit - (os->image rock64-barebones-os #:type rock64-image-type)) + (os+platform->image rock64-barebones-os aarch64-linux + #:type rock64-image-type)) (name 'rock64-barebones-raw-image))) rock64-barebones-raw-image diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 83bbefd3dc..a98a97e121 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -63,6 +63,7 @@ (device-module-aliases matching-modules) #:use-module (gnu system linux-initrd) #:use-module (gnu image) + #:use-module (gnu platform) #:use-module (gnu system) #:use-module (gnu bootloader) #:use-module (gnu system file-systems) @@ -1204,13 +1205,11 @@ resulting from command-line parsing." (base-image (if (operating-system? obj) (os->image obj #:type image-type) - obj)) - (base-target (image-target base-image))) + obj))) (image (inherit (if label (image-with-label base-image label) base-image)) - (target (or base-target target)) (size image-size) (volatile-root? volatile?)))) (os (image-operating-system image)) -- 2.32.0