From patchwork Fri Jul 31 14:49:27 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Mathieu Othacehe X-Patchwork-Id: 23473 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 7D33D27BBE5; Fri, 31 Jul 2020 15:50:12 +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.8 required=5.0 tests=BAYES_00,DKIM_ADSP_CUSTOM_MED, DKIM_SIGNED,FREEMAIL_FROM,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2, T_DKIM_INVALID 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 ESMTP id 23E7127BBE4 for ; Fri, 31 Jul 2020 15:50:12 +0100 (BST) Received: from localhost ([::1]:55772 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1k1WMN-0005W7-J1 for patchwork@mira.cbaines.net; Fri, 31 Jul 2020 10:50:11 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:58290) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1k1WMF-0005Vq-Ed for guix-patches@gnu.org; Fri, 31 Jul 2020 10:50:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:55102) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1k1WMF-00018t-62 for guix-patches@gnu.org; Fri, 31 Jul 2020 10:50:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1k1WMF-0006MV-4K for guix-patches@gnu.org; Fri, 31 Jul 2020 10:50:03 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#42634] [PATCH 1/3] image: Add image-type support. References: <20200731144825.703211-1-othacehe@gnu.org> In-Reply-To: <20200731144825.703211-1-othacehe@gnu.org> Resent-From: Mathieu Othacehe Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 31 Jul 2020 14:50:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 42634 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 42634@debbugs.gnu.org Cc: Mathieu Othacehe Received: via spool by 42634-submit@debbugs.gnu.org id=B42634.159620698724391 (code B ref 42634); Fri, 31 Jul 2020 14:50:03 +0000 Received: (at 42634) by debbugs.gnu.org; 31 Jul 2020 14:49:47 +0000 Received: from localhost ([127.0.0.1]:38409 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1k1WLy-0006LL-PX for submit@debbugs.gnu.org; Fri, 31 Jul 2020 10:49:47 -0400 Received: from mail-wr1-f51.google.com ([209.85.221.51]:35535) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1k1WLw-0006L6-Ri for 42634@debbugs.gnu.org; Fri, 31 Jul 2020 10:49:45 -0400 Received: by mail-wr1-f51.google.com with SMTP id f1so27700490wro.2 for <42634@debbugs.gnu.org>; Fri, 31 Jul 2020 07:49:44 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:date:message-id:mime-version :content-transfer-encoding; bh=8b2BV/WlZ9M1vWEGVfEgHbdiMBnuYCqTL08PwiTe/6k=; b=o046SWUTcn7aBn5keAI/PtHSsLDaFbjyxLyFuTjotZFMAOdNZs4vSG5T2qI+Fg4ARu YjurRtOWgxrHVNzUzW0rVfoDkmrWaXgDFRelwQ8o6xTVL/j9M6xi0V13WMjaN3fbaa+Z aSdGQawjm9G2QCs8nVnclZSYekqrBupN/D1Z3592dZQ0X6uhGOQYMYAMyPk7GG9X7CrY x1p+uSYP37/mitbGDa9Tmh/ERqRyKGNftwz3Sn3wJXy/+FC85vvYVX7aLAQJLc8o0M3/ ZLxubEXDD0ZfyNpy6mM8TWeZHfDslYM20CtDssWiFH1NNQeSguh4nHtmEOFpgiRu8QkD CvEg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:date:message-id:mime-version :content-transfer-encoding; bh=8b2BV/WlZ9M1vWEGVfEgHbdiMBnuYCqTL08PwiTe/6k=; b=o4kiVdUAny1zt3V9QZAFgqJyhAoze/B4DFBXaxf6pAiuyOVzghtY+7Df4uIClVTbY4 M/XV+H797xBTibYlTI5V4fAtM4xCmzr62a2sy2k7ezs5L4QyC0eBDvQY7YtmU6okXlgt e9S4uYw4SPU9WVvxCsHpl2ajzOPP2GUqg9eQYW71Jj8IrYwmenon3PTeqA7Cjm+xvyOo KBlD89GEp5mjLcxneJ4AYrOn5HOHcAr+HHf8EOTOcfddntDOGeu8Kts6EVxIui0tRmmE UAQ64gNWSRiU/bd8Jx9RJgy6YGWV1E6eTcF0S56z/Bwz3jKOVru0pw7djOj4MaYche// R/4A== X-Gm-Message-State: AOAM5330bA3PimWsuT82e2qhZ8mSGhZ9ZmxDOv2P8eMR0wgJI/caBiUu TvfPdTiAQ8KtoBvFsuOagZ3e8nHd X-Google-Smtp-Source: ABdhPJxWakB/zqRmkwS8slcudy4RnCFi88OHTbJg+c/BF3dEiQ2QxjBxSHU3x0cfdbw6oH4rx/U/Cg== X-Received: by 2002:adf:bbca:: with SMTP id z10mr3687332wrg.425.1596206978406; Fri, 31 Jul 2020 07:49:38 -0700 (PDT) Received: from cervin.home ([2a01:cb18:832e:5f00:c08f:7d21:ea98:a1c5]) by smtp.gmail.com with ESMTPSA id n189sm12648951wmn.40.2020.07.31.07.49.37 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 31 Jul 2020 07:49:37 -0700 (PDT) From: Mathieu Othacehe X-Google-Original-From: Mathieu Othacehe Date: Fri, 31 Jul 2020 16:49:27 +0200 Message-Id: <20200731144929.703345-1-othacehe@gnu.org> X-Mailer: git-send-email 2.26.2 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 * gnu/image.scm (): New record, (image-type, image-type?, image-type-name, image-type-constructor, os->image): new procedures. --- gnu/image.scm | 29 ++++++++++++++++++++++++++++- 1 file changed, 28 insertions(+), 1 deletion(-) diff --git a/gnu/image.scm b/gnu/image.scm index dc66f2c533..6f8f4828ac 100644 --- a/gnu/image.scm +++ b/gnu/image.scm @@ -39,7 +39,14 @@ image-partitions image-compression? image-volatile-root? - image-substitutable?)) + image-substitutable? + + image-type + image-type? + image-type-name + image-type-constructor + + os->image)) ;;; @@ -84,3 +91,23 @@ (default #t)) (substitutable? image-substitutable? ;boolean (default #t))) + + +;;; +;;; Image type. +;;; + +(define-record-type* + image-type make-image-type + image-type? + (name image-type-name) ;string + (constructor image-type-constructor)) ; -> + + +;;; +;;; Image creation. +;;; + +(define* (os->image os #:key type) + (let ((constructor (image-type-constructor type))) + (constructor os))) From patchwork Fri Jul 31 14:49:28 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Mathieu Othacehe X-Patchwork-Id: 23475 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 74E3B27BBE1; Fri, 31 Jul 2020 15:50:15 +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.8 required=5.0 tests=BAYES_00,DKIM_ADSP_CUSTOM_MED, DKIM_SIGNED,FREEMAIL_FROM,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2, T_DKIM_INVALID,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 ESMTP id 623F727BBE3 for ; Fri, 31 Jul 2020 15:50:14 +0100 (BST) Received: from localhost ([::1]:55808 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1k1WMP-0005XU-PG for patchwork@mira.cbaines.net; Fri, 31 Jul 2020 10:50:13 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:58292) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1k1WMF-0005Vx-Sw for guix-patches@gnu.org; Fri, 31 Jul 2020 10:50:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:55104) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1k1WMF-00018x-Jw for guix-patches@gnu.org; Fri, 31 Jul 2020 10:50:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1k1WMF-0006Md-Hh for guix-patches@gnu.org; Fri, 31 Jul 2020 10:50:03 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#42634] [PATCH 2/3] system: image: Add image-type support. Resent-From: Mathieu Othacehe Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 31 Jul 2020 14:50:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 42634 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 42634@debbugs.gnu.org Cc: Mathieu Othacehe Received: via spool by 42634-submit@debbugs.gnu.org id=B42634.159620699124414 (code B ref 42634); Fri, 31 Jul 2020 14:50:03 +0000 Received: (at 42634) by debbugs.gnu.org; 31 Jul 2020 14:49:51 +0000 Received: from localhost ([127.0.0.1]:38412 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1k1WM3-0006Lg-1g for submit@debbugs.gnu.org; Fri, 31 Jul 2020 10:49:51 -0400 Received: from mail-wr1-f43.google.com ([209.85.221.43]:36111) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1k1WLx-0006L8-To for 42634@debbugs.gnu.org; Fri, 31 Jul 2020 10:49:50 -0400 Received: by mail-wr1-f43.google.com with SMTP id 88so28227266wrh.3 for <42634@debbugs.gnu.org>; Fri, 31 Jul 2020 07:49:45 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; bh=ToTsMo410aZEmHCcvhvcJh6u7fw+3mCmL20awHZ5Bwo=; b=W0XNrlAR8thNsv84IKPhHXR/CvPKsNacR6EY7FZwyNnZ9Fxp9dZko8SINd2uRh7si6 XK0AOm+ZV3ghNQieB64vDY6AV+PXB72DgLCmPjYw0fDdqk0UQvKWLY+inOXNtJwyFTUf fiic4ruwxFy/zUrvns2tAkNGWZ6HOiOwciKP7sS6H1r/iYgFWO+0ssNR5KtA4uJZNyOi qW21uhku5hiobfOzb9R2IeEK7/VxeZTVIGeMtldaeQDnFvw3uSOTJHKYpD1Z1Kw6CP3m BsLv3IJr1wMU8r3CTS1NKvmHE+ozIhyLP7qVRXsndXnscusNWbKyQKEz2vGbhYszYzXO vexA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:date:message-id:in-reply-to :references:mime-version:content-transfer-encoding; bh=ToTsMo410aZEmHCcvhvcJh6u7fw+3mCmL20awHZ5Bwo=; b=TW2Shhy0eNgjla2YrUIbdBEaYxXWPK2nN93sTDaxhnuh5CFUkwgWLqwjH+A3YTzb1M Z8RR5z6BXYaq0QvCIIHRXZYD46wxqpro+8PRoPZvCB8SGoyYWkmHhQ/HX2gPxRNifYSR uezMEJHaT3BiDHD4BSziChrOsImh2qYcQvg9RXfZ7E/05bfZnm7j0r39AkimgoH2lEGl OHrcWb8qIZkrSnrAKoGnZERWPi3a/s+gDMnpUvnC4/eAekLXGuAEqt0ttXfp8bt3ar0C MT30VTPi2eqiCdsfWVfXQeJBxPwcnuTGhT5gMwCfMJdEsqrvicyHiwe1WWVajzmv+zLu O2sA== X-Gm-Message-State: AOAM532YeMtY8CRde3BEmy8lF9JrpaMxj1ehHuD6pz4d9J+KeLrjwCtJ 3NE67Bot6KwsvV8xD5AeVdXmkzU4 X-Google-Smtp-Source: ABdhPJwe+SzP/4berr/x+akOk2qy5lukhYsFcQj4tYH17xxAQO6Ojrl4KVgSBcpb2gOCFRa6uNgAZQ== X-Received: by 2002:a05:6000:10cd:: with SMTP id b13mr3757021wrx.216.1596206979631; Fri, 31 Jul 2020 07:49:39 -0700 (PDT) Received: from cervin.home ([2a01:cb18:832e:5f00:c08f:7d21:ea98:a1c5]) by smtp.gmail.com with ESMTPSA id n189sm12648951wmn.40.2020.07.31.07.49.38 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 31 Jul 2020 07:49:39 -0700 (PDT) From: Mathieu Othacehe X-Google-Original-From: Mathieu Othacehe Date: Fri, 31 Jul 2020 16:49:28 +0200 Message-Id: <20200731144929.703345-2-othacehe@gnu.org> X-Mailer: git-send-email 2.26.2 In-Reply-To: <20200731144929.703345-1-othacehe@gnu.org> References: <20200731144929.703345-1-othacehe@gnu.org> 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 * gnu/system/image.scm (image-with-os): New macro. Rename the old "image-with-os" procedure to ... (image-with-os*): ... this new procedure, (system-image): adapt according, (raw-image-type, iso-image-type, uncompressed-iso-image-type %image-types): new variables, (lookup-image-type-by-name): new procedure. (find-image): remove it. * gnu/system/images/hurd.scm (hurd-image-type): New variable, use it to define ... (hurd-disk-image): ... this variable, using "os->image" procedure. * gnu/tests/install.scm (run-install): Rename installation-disk-image-file-system-type parameter to installation-image-type, use os->config instead of find-image to compute the image passed to system-image, (%test-iso-image-installer) adapt accordingly, (guided-installation-test): ditto. --- gnu/system/image.scm | 88 ++++++++++++++++++++++++++++++-------- gnu/system/images/hurd.scm | 13 ++++-- gnu/tests/install.scm | 46 ++++++++++---------- 3 files changed, 103 insertions(+), 44 deletions(-) diff --git a/gnu/system/image.scm b/gnu/system/image.scm index 36f56e237d..deee8a6412 100644 --- a/gnu/system/image.scm +++ b/gnu/system/image.scm @@ -18,6 +18,7 @@ ;;; along with GNU Guix. If not, see . (define-module (gnu system image) + #:use-module (guix discovery) #:use-module (guix gexp) #:use-module (guix modules) #:use-module (guix monads) @@ -62,8 +63,15 @@ efi-disk-image iso9660-image - find-image - system-image)) + image-with-os + raw-image-type + iso-image-type + uncompressed-iso-image-type + + system-image + + %image-types + lookup-image-type-by-name)) ;;; @@ -110,6 +118,37 @@ (label "GUIX_IMAGE") (flags '(boot))))))) + +;;; +;;; Images types. +;;; + +(define-syntax-rule (image-with-os base-image os) + "Return an image inheriting from BASE-IMAGE, with the operating-system field +set to the given OS." + (image + (inherit base-image) + (operating-system os))) + +(define raw-image-type + (image-type + (name "raw") + (constructor (cut image-with-os efi-disk-image <>)))) + +(define iso-image-type + (image-type + (name "iso9660") + (constructor (cut image-with-os iso9660-image <>)))) + +(define uncompressed-iso-image-type + (image-type + (name "uncompressed-iso9660") + (constructor (cut image-with-os + (image + (inherit iso9660-image) + (compression? #f)) + <>)))) + ;; ;; Helpers. @@ -426,7 +465,7 @@ used in the image. " image-size) (else root-size)))) -(define* (image-with-os base-image os) +(define* (image-with-os* base-image os) "Return an image based on BASE-IMAGE but with the operating-system field set to OS. Also set the UUID and the size of the root partition." (define root-file-system @@ -507,7 +546,7 @@ image, depending on IMAGE format." (with-parameters ((%current-target-system target)) (let* ((os (operating-system-for-image image)) - (image* (image-with-os image os)) + (image* (image-with-os* image os)) (register-closures? (has-guix-service-type? os)) (bootcfg (operating-system-bootcfg os)) (bootloader (bootloader-configuration-bootloader @@ -539,18 +578,33 @@ image, depending on IMAGE format." #:grub-mkrescue-environment '(("MKRESCUE_SED_MODE" . "mbr_only")))))))) -(define (find-image file-system-type target) - "Find and return an image built that could match the given FILE-SYSTEM-TYPE, -built for TARGET. This is useful to adapt to interfaces written before the -addition of the record." - (match file-system-type - ("iso9660" iso9660-image) - (_ (cond - ((and target - (hurd-triplet? target)) - (module-ref (resolve-interface '(gnu system images hurd)) - 'hurd-disk-image)) - (else - efi-disk-image))))) + +;; +;; Image detection. +;; + +(define (image-modules) + "Return the list of image modules." + (cons (resolve-interface '(gnu system image)) + (all-modules (map (lambda (entry) + `(,entry . "gnu/system/images/")) + %load-path) + #:warn warn-about-load-error))) + +(define %image-types + ;; The list of publically-known image types. + (delay (fold-module-public-variables (lambda (obj result) + (if (image-type? obj) + (cons obj result) + result)) + '() + (image-modules)))) + +(define (lookup-image-type-by-name name) + "Return the image type called NAME." + (or (srfi-1:find (lambda (image-type) + (string=? name (image-type-name image-type))) + (force %image-types)) + (leave (G_ "~a: no such image type.~%") name))) ;;; image.scm ends here diff --git a/gnu/system/images/hurd.scm b/gnu/system/images/hurd.scm index d87640e8e3..67f657d289 100644 --- a/gnu/system/images/hurd.scm +++ b/gnu/system/images/hurd.scm @@ -29,8 +29,10 @@ #:use-module (gnu system file-systems) #:use-module (gnu system hurd) #:use-module (gnu system image) + #:use-module (srfi srfi-26) #:export (hurd-barebones-os hurd-disk-image + hurd-image-type hurd-barebones-disk-image)) (define hurd-barebones-os @@ -82,8 +84,13 @@ (flags '(boot)) (initializer hurd-initialize-root-partition)))))) +(define hurd-image-type + (image-type + (name "hurd-raw") + (constructor (cut image-with-os hurd-disk-image <>)))) + (define hurd-barebones-disk-image (image - (inherit hurd-disk-image) - (name 'hurd-barebones-disk-image) - (operating-system hurd-barebones-os))) + (inherit + (os->image hurd-barebones-os #:type hurd-image-type)) + (name 'hurd-barebones-disk-image))) diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm index 9656e5f41f..0be9ee2892 100644 --- a/gnu/tests/install.scm +++ b/gnu/tests/install.scm @@ -218,7 +218,7 @@ reboot\n") #:imported-modules '((gnu services herd) (gnu installer tests) (guix combinators)))) - (installation-disk-image-file-system-type "ext4") + (installation-image-type "raw") (install-size 'guess) (target-size (* 2200 MiB))) "Run SCRIPT (a shell script following the system installation procedure) in @@ -228,10 +228,6 @@ packages defined in installation-os." (mlet* %store-monad ((_ (set-grafting #f)) (system (current-system)) - (target (current-target-system)) - (base-image -> (find-image - installation-disk-image-file-system-type - target)) ;; Since the installation system has no network access, ;; we cheat a little bit by adding TARGET to its GC @@ -239,18 +235,20 @@ packages defined in installation-os." ;; succeed. Also add guile-final, which is pulled in ;; through provenance.drv and may not always be present. (target (operating-system-derivation target-os)) + (base-image -> + (os->image + (operating-system-with-gc-roots + os (list target guile-final)) + #:type (lookup-image-type-by-name + installation-image-type))) (image -> - (system-image - (image - (inherit base-image) - (size install-size) - (operating-system - (operating-system-with-gc-roots - os (list target guile-final))) - ;; Do not compress to speed-up the tests. - (compression? #f) - ;; Don't provide substitutes; too big. - (substitutable? #f))))) + (system-image + (image + (inherit base-image) + (size install-size) + + ;; Don't provide substitutes; too big. + (substitutable? #f))))) (define install (with-imported-modules '((guix build utils) (gnu build marionette)) @@ -270,16 +268,16 @@ packages defined in installation-os." "-no-reboot" "-m" "1200" #$@(cond - ((string=? "ext4" installation-disk-image-file-system-type) + ((string=? "raw" installation-image-type) #~("-drive" ,(string-append "file=" #$image ",if=virtio,readonly"))) - ((string=? "iso9660" installation-disk-image-file-system-type) + ((string-contains installation-image-type "iso9660") #~("-cdrom" #$image)) (else (error - "unsupported installation-disk-image-file-system-type:" - installation-disk-image-file-system-type))) + "unsupported installation-image-type:" + installation-image-type))) "-drive" ,(string-append "file=" #$output ",if=virtio") ,@(if (file-exists? "/dev/kvm") @@ -443,8 +441,8 @@ reboot\n") %minimal-os-on-vda-source #:script %simple-installation-script-for-/dev/vda - #:installation-disk-image-file-system-type - "iso9660")) + #:installation-image-type + "uncompressed-iso9660")) (command (qemu-command/writable-image image))) (run-basic-test %minimal-os-on-vda command name))))) @@ -1309,8 +1307,8 @@ build (current-guix) and then store a couple of full system images.") #:os installation-os-for-gui-tests #:install-size install-size #:target-size target-size - #:installation-disk-image-file-system-type - "iso9660" + #:installation-image-type + "uncompressed-iso9660" #:gui-test (lambda (marionette) (gui-test-program From patchwork Fri Jul 31 14:49:29 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Mathieu Othacehe X-Patchwork-Id: 23474 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 C94B627BBE4; Fri, 31 Jul 2020 15:50:14 +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.8 required=5.0 tests=BAYES_00,DKIM_ADSP_CUSTOM_MED, DKIM_SIGNED,FREEMAIL_FROM,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2, T_DKIM_INVALID 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 ESMTP id 24E0527BBE1 for ; Fri, 31 Jul 2020 15:50:14 +0100 (BST) Received: from localhost ([::1]:55820 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1k1WMP-0005Xv-KH for patchwork@mira.cbaines.net; Fri, 31 Jul 2020 10:50:13 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:58294) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1k1WMG-0005W4-9G for guix-patches@gnu.org; Fri, 31 Jul 2020 10:50:04 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:55105) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1k1WMG-000191-0b for guix-patches@gnu.org; Fri, 31 Jul 2020 10:50:04 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1k1WMF-0006Ml-VG for guix-patches@gnu.org; Fri, 31 Jul 2020 10:50:03 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#42634] [PATCH 3/3] scripts: system: Add support for image-type. Resent-From: Mathieu Othacehe Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 31 Jul 2020 14:50:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 42634 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 42634@debbugs.gnu.org Cc: Mathieu Othacehe Received: via spool by 42634-submit@debbugs.gnu.org id=B42634.159620699224420 (code B ref 42634); Fri, 31 Jul 2020 14:50:03 +0000 Received: (at 42634) by debbugs.gnu.org; 31 Jul 2020 14:49:52 +0000 Received: from localhost ([127.0.0.1]:38414 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1k1WM3-0006Lj-IV for submit@debbugs.gnu.org; Fri, 31 Jul 2020 10:49:51 -0400 Received: from mail-wr1-f49.google.com ([209.85.221.49]:34557) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1k1WM0-0006LC-5o for 42634@debbugs.gnu.org; Fri, 31 Jul 2020 10:49:50 -0400 Received: by mail-wr1-f49.google.com with SMTP id f7so28284501wrw.1 for <42634@debbugs.gnu.org>; Fri, 31 Jul 2020 07:49:48 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; bh=rj55eyo1MddXUL+Dj/dKuR27TbnyLe8uhAD+U0ZfGFU=; b=VI2oJzT9UKqUDEs5Qhh7LTTLdHrv5xaggkWEKfNuVmQegvGqS9rvMFshqVZpd03OYq RC9aUBBWAi1WcyHQZz5BbGYuUXw7ZguByT+V1IW95sFX+uCXcZKkeojdIT9qT2d2S9Nt 2O8egbYH+ebFWWykdsBQdt9FhC5RY1ga9D1NwEieWy/Rh00CfG1M4qc+VCg9GNGIsZZz dumXXRzCmegmELcrxuJhhGa3EmkreAT6lRR4pejpK0brqlkM38ZM4vpRkRVNkep7dO7M EhCUqfKvRcI5xeAd2LMWXcLI2tt1+qzl4KOSgcx1zkjfxGM2VkA2zobP4hQuMp9Y5BXc YpaA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:date:message-id:in-reply-to :references:mime-version:content-transfer-encoding; bh=rj55eyo1MddXUL+Dj/dKuR27TbnyLe8uhAD+U0ZfGFU=; b=SZVCIWyyBkqM80aB+VO4ciLHQoNyokhNNCZ7l+AZBsplc+cpI6cksgy/dNjA1Ub3Dj CB5gTzzebrjU73qfakKPQ8WtWcEWE1xZXTT7KzwHUSIE4tz71yrQHoK4UZc6/kmfBqGD FOVN/e1ufbf273HIoNXMblItkNgKSbRiQA2x4nuDkPjv87aJr7Y8WyCPKMXqbfuNYw2y XWVq7Q1XNS8JY1qcskHSSRK8kboIIh9q6IB77gt7USvNiozB+31D3ZNLB49y49cyvTUt fgHQNw0dbuRUB443TgHj0fmz/65L90FlRZFNxS9Hp4T2z/zqTAZ+ZDZYm9tFzoNJ7khy s93Q== X-Gm-Message-State: AOAM532ENA9YgqstbUNNLbvF/9wBfe96jksTunJZbluxoTxO75Afm5f+ 8kGHNY88oxAcxafpuFDsVX/UdYVb X-Google-Smtp-Source: ABdhPJz+NgAV7WT/rpmwN2iBDqHHPh25zMdgFk8fj3Y63NRpKSrQNGYfMf8OIT/zYeMqSgePYolwYA== X-Received: by 2002:a5d:4c82:: with SMTP id z2mr3712104wrs.287.1596206981827; Fri, 31 Jul 2020 07:49:41 -0700 (PDT) Received: from cervin.home ([2a01:cb18:832e:5f00:c08f:7d21:ea98:a1c5]) by smtp.gmail.com with ESMTPSA id n189sm12648951wmn.40.2020.07.31.07.49.40 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 31 Jul 2020 07:49:41 -0700 (PDT) From: Mathieu Othacehe X-Google-Original-From: Mathieu Othacehe Date: Fri, 31 Jul 2020 16:49:29 +0200 Message-Id: <20200731144929.703345-3-othacehe@gnu.org> X-Mailer: git-send-email 2.26.2 In-Reply-To: <20200731144929.703345-1-othacehe@gnu.org> References: <20200731144929.703345-1-othacehe@gnu.org> 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 * guix/scripts/system.scm (list-image-types): New procedure, (%options): add "image-type" and "list-image-types" options, remove "file-system-type" option, (show-help): adapt accordingly, (%default-options): also adapt, and set the default "image-type" to "raw", (perform-action): add image-type argument and remove file-system-type argument, (process-action): adapt perform-action call, (system-derivation-for-action): remove base-image argument, add image-type argument, and use it to create the image passed to "system-image". --- guix/scripts/system.scm | 56 +++++++++++++++++++++++++---------------- 1 file changed, 35 insertions(+), 21 deletions(-) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index bfd50c7a79..4962401f36 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -659,8 +659,8 @@ checking this by themselves in their 'check' procedure." ;;; Action. ;;; -(define* (system-derivation-for-action os base-image action - #:key image-size file-system-type +(define* (system-derivation-for-action os action + #:key image-size image-type full-boot? container-shared-network? mappings) "Return as a monadic value the derivation for OS according to ACTION." @@ -686,9 +686,8 @@ checking this by themselves in their 'check' procedure." (lower-object (system-image (image - (inherit base-image) - (size image-size) - (operating-system os))))) + (inherit (os->image os #:type image-type)) + (size image-size))))) ((docker-image) (system-docker-image os #:shared-network? container-shared-network?)))) @@ -741,16 +740,17 @@ and TARGET arguments." install-bootloader? dry-run? derivations-only? use-substitutes? bootloader-target target - image-size file-system-type full-boot? - container-shared-network? + image-size image-type + full-boot? container-shared-network? (mappings '()) (gc-root #f)) "Perform ACTION for OS. INSTALL-BOOTLOADER? specifies whether to install bootloader; BOOTLOADER-TAGET is the target for the bootloader; TARGET is the target root directory; IMAGE-SIZE is the size of the image to be built, for -the 'vm-image' and 'disk-image' actions. The root file system is created as a -FILE-SYSTEM-TYPE file system. FULL-BOOT? is used for the 'vm' action; it -determines whether to boot directly to the kernel or to the bootloader. +the 'vm-image' and 'disk-image' actions. IMAGE-TYPE is the type of image to +be built. +FULL-BOOT? is used for the 'vm' action; it determines whether to boot directly +to the kernel or to the bootloader. CONTAINER-SHARED-NETWORK? determines if the container will use a separate network namespace. @@ -792,10 +792,8 @@ static checks." (check-initrd-modules os))) (mlet* %store-monad - ((target* (current-target-system)) - (image -> (find-image file-system-type target*)) - (sys (system-derivation-for-action os image action - #:file-system-type file-system-type + ((sys (system-derivation-for-action os action + #:image-type image-type #:image-size image-size #:full-boot? full-boot? #:container-shared-network? container-shared-network? @@ -876,6 +874,17 @@ upgrade, and restart each service that was not automatically restarted.\n")))))) #:node-type (shepherd-service-node-type shepherds) #:reverse-edges? #t))) + +;;; +;;; Images. +;;; + +(define (list-image-types) + "Print the available image types." + (display (G_ "The available image types are:\n")) + (newline) + (format #t "~{ - ~a ~%~}" (map image-type-name (force %image-types)))) + ;;; ;;; Options. @@ -935,9 +944,9 @@ Some ACTIONS support additional ARGS.\n")) apply STRATEGY (one of nothing-special, backtrace, or debug) when an error occurs while reading FILE")) (display (G_ " - --file-system-type=TYPE - for 'disk-image', produce a root file system of TYPE - (one of 'ext4', 'iso9660')")) + --list-image-types list available image types")) + (display (G_ " + -t, --image-type=TYPE for 'disk-image', produce an image of TYPE")) (display (G_ " --image-size=SIZE for 'vm-image', produce an image of SIZE")) (display (G_ " @@ -994,10 +1003,14 @@ Some ACTIONS support additional ARGS.\n")) (lambda (opt name arg result) (alist-cons 'on-error (string->symbol arg) result))) - (option '(#\t "file-system-type") #t #f + (option '(#\t "image-type") #t #f (lambda (opt name arg result) - (alist-cons 'file-system-type arg + (alist-cons 'image-type arg result))) + (option '("list-image-types") #f #f + (lambda (opt name arg result) + (list-image-types) + (exit 0))) (option '("image-size") #t #f (lambda (opt name arg result) (alist-cons 'image-size (size->number arg) @@ -1063,7 +1076,7 @@ Some ACTIONS support additional ARGS.\n")) (debug . 0) (verbosity . #f) ;default (validate-reconfigure . ,ensure-forward-reconfigure) - (file-system-type . "ext4") + (image-type . "raw") (image-size . guess) (install-bootloader? . #t))) @@ -1150,7 +1163,8 @@ resulting from command-line parsing." (assoc-ref opts 'skip-safety-checks?) #:validate-reconfigure (assoc-ref opts 'validate-reconfigure) - #:file-system-type (assoc-ref opts 'file-system-type) + #:image-type (lookup-image-type-by-name + (assoc-ref opts 'image-type)) #:image-size (assoc-ref opts 'image-size) #:full-boot? (assoc-ref opts 'full-boot?) #:container-shared-network?