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?