From patchwork Tue Oct 22 19:18:32 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Janneke Nieuwenhuizen X-Patchwork-Id: 69350 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 9986D27BBEA; Tue, 22 Oct 2024 20:20:11 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-7.6 required=5.0 tests=BAYES_00,DKIMWL_WL_HIGH, DKIM_SIGNED,DKIM_VALID,MAILING_LIST_MULTI,RCVD_IN_DNSWL_BLOCKED, RCVD_IN_VALIDITY_CERTIFIED,RCVD_IN_VALIDITY_RPBL,RCVD_IN_VALIDITY_SAFE, SPF_HELO_PASS,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 55A3B27BBE2 for ; Tue, 22 Oct 2024 20:20:09 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1t3KPq-00060V-W1; Tue, 22 Oct 2024 15:19:39 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1t3KPn-00060F-Mw for guix-patches@gnu.org; Tue, 22 Oct 2024 15:19:35 -0400 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1t3KPn-0007dA-A5 for guix-patches@gnu.org; Tue, 22 Oct 2024 15:19:35 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:Date:References:In-Reply-To:From:To:Subject; bh=C9ggdLXnZp4vhghCOSBhEIIvSMTxBGTKzjfS2KEzh8g=; b=O1RDYTJTXPiDAgyGBs5xkfAKFGcxkGB2Ha0Yt9mqtThhmlz69Wa8G7Xd3UjXwcaHpiG6suUHBuUEy2+1N75wOM0j8XcuLR+LpTjh3rmNIpLkKamgAiPK4lSc2P3+8pJPxzWcAqWgqZf1wuqvHChS1pUq2SSuKnBqXwCLSr+Zl4+AffNDnDIOwqoaQexcK7tpCuTHBFipeRl+JbOLT6RxCxhQf4JHlClUY2JUVMyXBr5zPNuZgHYs6Pq1I52GEr/44XAYb5Bxk9VKny8BQjdB64bK1x8EpvXebs/Q77TRie2jhbZSIiWVJpesyOIlK0IMSjS0j+aVduHFzYXnn3b9eg==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1t3KQE-0003F0-Jo for guix-patches@gnu.org; Tue, 22 Oct 2024 15:20:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#73927] [PATCH v2 14/16] installer: Add "Kernel" page to select the Hurd. Resent-From: Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 22 Oct 2024 19:20:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 73927 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Mathieu Othacehe Cc: 73927@debbugs.gnu.org, Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 73927-submit@debbugs.gnu.org id=B73927.172962476312398 (code B ref 73927); Tue, 22 Oct 2024 19:20:02 +0000 Received: (at 73927) by debbugs.gnu.org; 22 Oct 2024 19:19:23 +0000 Received: from localhost ([127.0.0.1]:57536 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1t3KPZ-0003Dq-9n for submit@debbugs.gnu.org; Tue, 22 Oct 2024 15:19:23 -0400 Received: from eggs.gnu.org ([209.51.188.92]:35340) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1t3KPV-0003Dc-PI for 73927@debbugs.gnu.org; Tue, 22 Oct 2024 15:19:19 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1t3KOw-0007as-0S; Tue, 22 Oct 2024 15:18:42 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:Date:References:In-Reply-To:Subject:To: From; bh=C9ggdLXnZp4vhghCOSBhEIIvSMTxBGTKzjfS2KEzh8g=; b=FEWf5XbTm/53j8CyZ9CZ 9NBWvMou7kUkNBkO3rhW6xTCBG6jYJkVIZ8Iv2D/Ks3rCRAJE9PLxVtDD/H8tqlOyUwRvS676oxwn DlODbL4Mmujj9x9h2MJav4LDVDIEGuypwbwdUlaBpo9kn/GVD8XyBlCuPvCN2xup+SxXAOyy3FtvV NLlD7Yt1cBp3Bb9ma6gqdptamkPx9AyMRPkouTmpewS4Wdt6mKxTWt5Dv07WyetosF43vpw+XzmGS 9NRRGRoCulPdzeQ1Imbr8o0XeKsi7DR3ZgHJpCXjbHaGFN2fq7erBKHs3X3L8wS4vJGHEgnmySkgh 6/22OCBUPMcItA==; From: In-Reply-To: <87sesoovw6.fsf@gnu.org> (Mathieu Othacehe's message of "Tue, 22 Oct 2024 20:06:01 +0200") Organization: AvatarAcademy.nl References: <87ttd5cohr.fsf@gnu.org> <87v7xkcyda.fsf@gnu.org> <87ldygcild.fsf@gnu.org> <87sesoovw6.fsf@gnu.org> X-Url: http://AvatarAcademy.nl Date: Tue, 22 Oct 2024 21:18:32 +0200 Message-ID: <874j54c5fb.fsf_-_@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) 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-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches Mathieu Othacehe writes: Hi, > The ppm stuff is just about keeping screenshots around to debug any test > failures. Ok. In any case we can see about that later. > According to the log that you sent, I would say that the issue > is a mismatch between the installation step that is expected by the > marionette and the actual installation step: > > pattern: ((quote input) ((quote title) "System administrator password") ((quote text) _) ((quote default) _)). > sexp: (list-selection (title "Kernel") (multiple-choices? #f) (items ("Hurd" "Linux Libre"))). > > > The system administrator password page is expected but the kernel > selection page is sent. Ah, the test combines host-name and users together, makes sense. Kind of obvious when you see it :) > It seems that you have chosen to display the Kernel selection page > between the host-name page and the network selection page. I guess that > by moving the Kernel step here: > > ;; Prompt for users (name, group and home directory). > (installer-step > (id 'user) > (description (G_ "User creation")) > (compute (lambda _ > ((installer-user-page current-installer)))) > (configuration-formatter users->configuration)) > > -> Kernel step > > ;; Ask the user to choose one or many desktop environment(s). > (installer-step > (id 'services) > (description (G_ "Services")) > (compute (lambda _ > ((installer-services-page current-installer)))) > (configuration-formatter system-services->configuration)) > > the test would match with the actual installation step. Good call. > Hope that will help, It does thanks; test passed! --8<---------------cut here---------------start------------->8--- make check-system TESTS="gui-installed-os" ... successfully built /gnu/store/68yvz94hgnicavcps2i96wpddsygq9fz-gui-installed-os.drv /gnu/store/84n7zjm5l41m279i72cfp7z0cxa9h20p-gui-installed-os --8<---------------cut here---------------end--------------->8--- Find v2 attached; as only this patch has changed. Greetings, Janneke From e6bd56aa544deb45764baf3138668849aab2b86b Mon Sep 17 00:00:00 2001 Message-ID: In-Reply-To: <1fbb300ade6667d5390dbe1a2e8e82ff4af7d1a0.1729624171.git.janneke@gnu.org> References: <1fbb300ade6667d5390dbe1a2e8e82ff4af7d1a0.1729624171.git.janneke@gnu.org> From: Janneke Nieuwenhuizen Date: Sun, 20 Oct 2024 15:13:16 +0200 Subject: [PATCH v2 14/16] installer: Add "Kernel" page to select the Hurd. This adds a "Kernel" page to the installer with the option to (cross-) install the Hurd, if applicable (only available on x86 machines for now). * gnu/installer/newt.scm (kernel-page): New procedure. (newt-installer)[kernel-page]: New field. * gnu/installer/kernel.scm, gnu/installer/newt/kernel.scm: New files. * gnu/local.mk (INSTALLER_MODULES): Add them. * gnu/installer.scm (installer-steps): Use them to select kernel if applicable. * gnu/installer/newt/partition.scm (run-fs-type-page): Add ext2 for the hurd. (run-partitioning-page-partition): Remove `entire-encrypted' option when installing the Hurd. * gnu/installer/services.scm (system-services->configuration): Cater for the Hurd with %base-services/hurd, and with %base-packages/hurd that must always be set. (%system-services): Change to procedure. When installing the the Hurd, do not recommend `ntp-service-type' and USE `openssh-sans-x' package for `openssh-service-type'. (system-service-none): New variable. * gnu/installer/newt/services.scm (run-network-management-page): Include it when installing the Hurd. (run-desktop-environments-cbt-page): When installing the Hurd, recommend to not select any desktop enviroment. Update users. * gnu/installer/parted.scm (create-ext2-file-system): New procedure. (user-fs-type-name, user-fs-type->mount-type, partition-filesystem-user-type, format-user-partitions): Support `ext2'. ( partition->user-partition): Use `ext2' when installing the Hurd. (auto-partition!): Likewise. No swap partition when installing the Hurd. * gnu/installer/final.scm (install-system): Cater for cross installation of the Hurd. (bootloader-configuration): Use `grub-minimal-bootloader' when installing the Hurd. (user-partition-missing-modules): Cater for empty user-partitions. (initrd-configuration, user-partitions->configuration): Cater for the Hurd. * gnu/installer/steps.scm (format-configuration, configuration->file): Cater for the Hurd. * gnu/system/hurd.scm (%desktop-services/hurd): New variable. * gnu/installer/tests.scm (choose-kernel): New procedure. * gnu/tests/install.scm (gui-test-program): Use it. Change-Id: Ifafb27b8a2f933944c77223a27ec151757237e36 --- gnu/installer.scm | 14 ++++++++ gnu/installer/final.scm | 10 ++++-- gnu/installer/kernel.scm | 34 ++++++++++++++++++ gnu/installer/newt.scm | 5 +++ gnu/installer/newt/kernel.scm | 45 +++++++++++++++++++++++ gnu/installer/newt/partition.scm | 9 ++++- gnu/installer/newt/services.scm | 31 +++++++++------- gnu/installer/parted.scm | 62 +++++++++++++++++++++++--------- gnu/installer/record.scm | 3 ++ gnu/installer/services.scm | 46 ++++++++++++++++++------ gnu/installer/steps.scm | 14 +++++--- gnu/installer/tests.scm | 11 ++++++ gnu/local.mk | 2 ++ gnu/system/hurd.scm | 3 ++ gnu/tests/install.scm | 5 ++- 15 files changed, 246 insertions(+), 48 deletions(-) create mode 100644 gnu/installer/kernel.scm create mode 100644 gnu/installer/newt/kernel.scm diff --git a/gnu/installer.scm b/gnu/installer.scm index 39a83c4455..31c0ff7ff4 100644 --- a/gnu/installer.scm +++ b/gnu/installer.scm @@ -308,6 +308,18 @@ (define* (installer-steps #:key dry-run?) ((installer-user-page current-installer)))) (configuration-formatter users->configuration)) + ;; Ask the user to select the kernel for the system, + ;; for x86 systems only. + (installer-step + (id 'kernel) + (description (G_ "Kernel")) + (compute (lambda _ + (if (target-x86?) + ((installer-kernel-page current-installer)) + '()))) + (configuration-formatter (lambda (result) + (kernel->configuration result #$dry-run?)))) + ;; Ask the user to choose one or many desktop environment(s). (installer-step (id 'services) @@ -419,6 +431,7 @@ (define* (installer-program #:key dry-run?) (gnu installer dump) (gnu installer final) (gnu installer hostname) + (gnu installer kernel) (gnu installer locale) (gnu installer parted) (gnu installer services) @@ -431,6 +444,7 @@ (define* (installer-program #:key dry-run?) (gnu services herd) (guix i18n) (guix build utils) + (guix utils) ((system repl debug) #:select (terminal-width)) (ice-9 match) diff --git a/gnu/installer/final.scm b/gnu/installer/final.scm index 069426a3b8..5fcf223315 100644 --- a/gnu/installer/final.scm +++ b/gnu/installer/final.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018, 2020 Mathieu Othacehe ;;; Copyright © 2019, 2020, 2022 Ludovic Courtès +;;; Copyright © 2024 Janneke Nieuwenhuizen ;;; ;;; This file is part of GNU Guix. ;;; @@ -25,6 +26,7 @@ (define-module (gnu installer final) #:use-module (gnu services herd) #:use-module (guix build syscalls) #:use-module (guix build utils) + #:use-module (guix utils) #:use-module (gnu build accounts) #:use-module (gnu build install) #:use-module (gnu build linux-container) @@ -164,8 +166,12 @@ (define* (install-system locale #:key (users '())) "/tmp/installer-system-init-options" read)) (const '()))) - (install-command (append (list "guix" "system" "init" - "--fallback") + (install-command (append `( "guix" "system" "init" + "--fallback" + ,@(if (target-hurd?) + '("--target=i586-pc-gnu" + "--skip-checks") + '())) options (list (%installer-configuration-file) (%installer-target-dir)))) diff --git a/gnu/installer/kernel.scm b/gnu/installer/kernel.scm new file mode 100644 index 0000000000..059659ec75 --- /dev/null +++ b/gnu/installer/kernel.scm @@ -0,0 +1,34 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2024 Janneke Nieuwenhuizen +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu installer kernel) + #:use-module (gnu system hurd) + #:export (kernel->configuration)) + +(define (kernel->configuration kernel dry-run?) + (if (equal? kernel "Hurd") + `((kernel %hurd-default-operating-system-kernel) + (kernel-arguments '("noide")) + (firmware '()) + (hurd hurd) + (locale-libcs (list glibc/hurd)) + (name-service-switch #f) + (essential-services (hurd-default-essential-services this-operating-system)) + (privileged-programs '()) + (setuid-programs %setuid-programs/hurd)) + '())) diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm index d53bc058b3..1fe710340f 100644 --- a/gnu/installer/newt.scm +++ b/gnu/installer/newt.scm @@ -25,6 +25,7 @@ (define-module (gnu installer newt) #:use-module (gnu installer newt final) #:use-module (gnu installer newt parameters) #:use-module (gnu installer newt hostname) + #:use-module (gnu installer newt kernel) #:use-module (gnu installer newt keymap) #:use-module (gnu installer newt locale) #:use-module (gnu installer newt menu) @@ -193,6 +194,9 @@ (define (substitutes-page) (define (hostname-page) (run-hostname-page)) +(define (kernel-page) + (run-kernel-page)) + (define (user-page) (run-user-page)) @@ -216,6 +220,7 @@ (define newt-installer (exit-error exit-error) (final-page final-page) (keymap-page keymap-page) + (kernel-page kernel-page) (locale-page locale-page) (menu-page menu-page) (network-page network-page) diff --git a/gnu/installer/newt/kernel.scm b/gnu/installer/newt/kernel.scm new file mode 100644 index 0000000000..3117247312 --- /dev/null +++ b/gnu/installer/newt/kernel.scm @@ -0,0 +1,45 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2024 Janneke Nieuwenhuizen +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu installer newt kernel) + #:use-module (gnu installer newt page) + #:use-module (guix i18n) + #:use-module (guix utils) + #:export (run-kernel-page)) + +(define (run-kernel-page) + (let* ((kernels `(,@(if (target-x86?) '("Hurd") '()) + "Linux Libre")) + (result + (run-listbox-selection-page + #:title (G_ "Kernel") + #:info-text + (G_ "Please select a kernel. When in doubt, choose \"Linux Libre\". +The Hurd is offered as a technology preview and development aid; many packages \ +are not yet available in Guix, such as a desktop environment or even a windowing \ +system (X, Wayland).") + #:listbox-items kernels + #:listbox-item->text identity + #:listbox-default-item "Linux Libre" + #:button-text (G_ "Back") + #:button-callback-procedure + (lambda _ + (abort-to-prompt 'installer-step 'abort))))) + (when (equal? result "Hurd") + (%current-target-system "i586-pc-gnu")) + result)) diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm index 48dd306080..b88393405b 100644 --- a/gnu/installer/newt/partition.scm +++ b/gnu/installer/newt/partition.scm @@ -26,6 +26,7 @@ (define-module (gnu installer newt partition) #:use-module (gnu installer newt page) #:use-module (gnu installer newt utils) #:use-module (guix i18n) + #:use-module (guix utils) #:use-module (ice-9 format) #:use-module (ice-9 match) #:use-module (srfi srfi-1) @@ -147,6 +148,8 @@ (define (run-fs-type-page) #:title (G_ "File-system type") #:listbox-items '(btrfs ext4 jfs xfs swap + ;; This is for the Hurd + ext2 ;; These lack basic Unix features. Their only use ;; on GNU is for interoperation, e.g., with UEFI. fat32 fat16 ntfs) @@ -767,7 +770,11 @@ (define (run-partitioning-page) (define (run-page devices) (let* ((items `((entire . ,(G_ "Guided - using the entire disk")) - (entire-encrypted . ,(G_ "Guided - using the entire disk with encryption")) + ,@(if (target-hurd?) + '() + `((entire-encrypted + . + ,(G_ "Guided - using the entire disk with encryption")))) (manual . ,(G_ "Manual")))) (result (run-listbox-selection-page #:info-text (G_ "Please select a partitioning method.") diff --git a/gnu/installer/newt/services.scm b/gnu/installer/newt/services.scm index d1035b6524..848683e8c7 100644 --- a/gnu/installer/newt/services.scm +++ b/gnu/installer/newt/services.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018 Mathieu Othacehe ;;; Copyright © 2019, 2020 Ludovic Courtès -;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen +;;; Copyright © 2020, 2024 Janneke Nieuwenhuizen ;;; Copyright © 2021 Tobias Geerinckx-Rice ;;; Copyright © 2021 Leo Famulari ;;; @@ -26,6 +26,7 @@ (define-module (gnu installer newt services) #:use-module (gnu installer newt page) #:use-module (gnu installer newt utils) #:use-module (guix i18n) + #:use-module (guix utils) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:export (run-services-page)) @@ -33,11 +34,13 @@ (define-module (gnu installer newt services) (define (run-desktop-environments-cbt-page) "Run a page allowing the user to choose between various desktop environments." - (let ((items (filter desktop-system-service? %system-services))) + (let ((items (filter desktop-system-service? (%system-services)))) (run-checkbox-tree-page - #:info-text (G_ "Please select the desktop environment(s) you wish to \ + #:info-text (if (target-hurd?) + (G_ "Currently, none of these is available for the Hurd.") + (G_ "Please select the desktop environment(s) you wish to \ install. If you select multiple desktop environments here, you will be able \ -to choose from them later when you log in.") +to choose from them later when you log in.")) #:title (G_ "Desktop environment") #:items items #:selection (map system-service-recommended? items) @@ -51,7 +54,7 @@ (define (run-networking-cbt-page) "Run a page allowing the user to select networking services." (let ((items (filter (lambda (service) (eq? 'networking (system-service-type service))) - %system-services))) + (%system-services)))) (run-checkbox-tree-page #:info-text (G_ "You can now select networking services to run on your \ system.") @@ -69,7 +72,7 @@ (define (run-printing-services-cbt-page) (let ((items (filter (lambda (service) (eq? 'document (system-service-type service))) - %system-services))) + (%system-services)))) (run-checkbox-tree-page #:info-text (G_ "You can now select the CUPS printing service to run on your \ system.") @@ -88,7 +91,7 @@ (define (run-console-services-cbt-page) (let ((items (filter (lambda (service) (eq? 'administration (system-service-type service))) - %system-services))) + (%system-services)))) (run-checkbox-tree-page #:title (G_ "Console services") #:info-text (G_ "Select miscellaneous services to run on your \ @@ -103,7 +106,11 @@ (define (run-console-services-cbt-page) (define (run-network-management-page) "Run a page to select among several network management methods." - (let ((title (G_ "Network management"))) + (let ((title (G_ "Network management")) + (items (filter (lambda (service) + (eq? 'network-management + (system-service-type service))) + (%system-services)))) (run-listbox-selection-page #:title title #:info-text (G_ "Choose the method to manage network connections. @@ -112,10 +119,10 @@ (define (run-network-management-page) client may be enough for a server.") #:info-textbox-width 70 #:listbox-height 7 - #:listbox-items (filter (lambda (service) - (eq? 'network-management - (system-service-type service))) - %system-services) + #:listbox-items `(,@items + ,@(if (target-hurd?) + (list system-service-none) + '())) #:listbox-item->text (compose G_ system-service-name) #:sort-listbox-items? #f #:button-text (G_ "Exit") diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm index b36b238d8b..e9a0cc36d0 100644 --- a/gnu/installer/parted.scm +++ b/gnu/installer/parted.scm @@ -152,7 +152,7 @@ (define-record-type* (crypt-password user-partition-crypt-password ; (default #f)) (fs-type user-partition-fs-type - (default 'ext4)) + (default (if (target-hurd?) 'ext2 'ext4))) (bootable? user-partition-bootable? (default #f)) (esp? user-partition-esp? @@ -228,6 +228,7 @@ (define (efi-installation?) (define (user-fs-type-name fs-type) "Return the name of FS-TYPE as specified by libparted." (case fs-type + ((ext2) "ext2") ((ext4) "ext4") ((btrfs) "btrfs") ((fat16) "fat16") @@ -240,6 +241,7 @@ (define (user-fs-type-name fs-type) (define (user-fs-type->mount-type fs-type) "Return the mount type of FS-TYPE." (case fs-type + ((ext2) "ext2") ((ext4) "ext4") ((btrfs) "btrfs") ((fat16) "vfat") @@ -255,6 +257,7 @@ (define (partition-filesystem-user-type partition) (and fs-type (let ((name (filesystem-type-name fs-type))) (cond + ((string=? name "ext2") 'ext2) ((string=? name "ext4") 'ext4) ((string=? name "btrfs") 'btrfs) ((string=? name "fat16") 'fat16) @@ -296,7 +299,7 @@ (define (partition->user-partition partition) (file-name (partition-get-path partition)) (disk-file-name (device-path device)) (fs-type (or (partition-filesystem-user-type partition) - 'ext4)) + (if (target-hurd?) 'ext2 'ext4))) (mount-point (and (esp-partition? partition) (default-esp-mount-point))) (bootable? (boot-partition? partition)) @@ -1053,7 +1056,7 @@ (define* (auto-partition! disk (size new-esp-size) (mount-point (default-esp-mount-point)))) (user-partition - (fs-type 'ext4) + (fs-type (if (target-hurd?) 'ext2 'ext4)) (bootable? #t) (bios-grub? #t) (size bios-grub-size)))) @@ -1065,13 +1068,13 @@ (define* (auto-partition! disk `(,@(if start-partition `(,start-partition) '()) - ,@(if encrypted? + ,@(if (or encrypted? (target-hurd?)) '() `(,(user-partition (fs-type 'swap) (size swap-size)))) ,(user-partition - (fs-type 'ext4) + (fs-type (if (target-hurd?) 'ext2 'ext4)) (bootable? has-extended?) (crypt-label (and encrypted? "cryptroot")) (size "100%") @@ -1083,7 +1086,7 @@ (define* (auto-partition! disk `(,start-partition) '()) ,(user-partition - (fs-type 'ext4) + (fs-type (if (target-hurd?) 'ext2 'ext4)) (bootable? has-extended?) (crypt-label (and encrypted? "cryptroot")) (size "33%") @@ -1105,7 +1108,7 @@ (define* (auto-partition! disk (type (if has-extended? 'logical 'normal)) - (fs-type 'ext4) + (fs-type (if (target-hurd?) 'ext2 'ext4)) (crypt-label (and encrypted? "crypthome")) (size "100%") (mount-point "/home"))))))) @@ -1186,6 +1189,15 @@ (define (create-btrfs-file-system partition) "Create a btrfs file-system for PARTITION file-name." ((%run-command-in-installer) "mkfs.btrfs" "-f" partition)) +(define (create-ext2-file-system partition) + "Create an ext2 file-system for PARTITION file-name, when TARGET-HURD?, +for the Hurd." + (apply (%run-command-in-installer) + `("mkfs.ext2" ,@(if (target-hurd?) + '("-o" "hurd") + '()) + "-F" ,partition))) + (define (create-ext4-file-system partition) "Create an ext4 file-system for PARTITION file-name." ;; Enable the 'large_dir' feature so users can have a store of several TiBs. @@ -1291,6 +1303,10 @@ (define (format-user-partitions user-partitions) (and need-formatting? (not (eq? type 'extended)) (create-btrfs-file-system file-name))) + ((ext2) + (and need-formatting? + (not (eq? type 'extended)) + (create-ext2-file-system file-name))) ((ext4) (and need-formatting? (not (eq? type 'extended)) @@ -1463,7 +1479,11 @@ (define (bootloader-configuration user-partitions) "Return the bootloader configuration field for USER-PARTITIONS." (let ((root-partition (find root-user-partition? user-partitions))) (match user-partitions - (() '()) + (() (if (target-hurd?) + '(bootloader-configuration + (bootloader grub-minimal-bootloader) + (targets "/dev/sdaX")) + '())) (_ (let ((root-partition-disk (user-partition-disk-file-name root-partition))) @@ -1471,7 +1491,9 @@ (define (bootloader-configuration user-partitions) ,@(if (efi-installation?) `((bootloader grub-efi-bootloader) (targets (list ,(default-esp-mount-point)))) - `((bootloader grub-bootloader) + `((bootloader ,(if (target-hurd?) + 'grub-minimal-bootloader + 'grub-bootloader)) (targets (list ,root-partition-disk)))) ;; XXX: Assume we defined the 'keyboard-layout' field of @@ -1491,22 +1513,28 @@ (define (user-partition-missing-modules user-partitions) (const '()))) (delete-duplicates (map user-partition-file-name - (cons root devices))))))) + (filter identity + (cons root devices)))))))) (define (initrd-configuration user-partitions) "Return an 'initrd-modules' field with everything needed for USER-PARTITIONS, or return nothing." - (match (user-partition-missing-modules user-partitions) - (() - '()) - ((modules ...) - `((initrd-modules (append ',modules - %base-initrd-modules)))))) + (if (target-hurd?) + '((initrd #f) + (initrd-modules '())) + (match (user-partition-missing-modules user-partitions) + (() + '()) + ((modules ...) + `((initrd-modules (append ',modules + %base-initrd-modules))))))) (define (user-partitions->configuration user-partitions) "Return the configuration field for USER-PARTITIONS." (let* ((swap-user-partitions (find-swap-user-partitions user-partitions)) - (swap-devices (map user-partition-file-name swap-user-partitions)) + (swap-devices (if (target-hurd?) + '() + (map user-partition-file-name swap-user-partitions))) (encrypted-partitions (filter user-partition-crypt-label user-partitions))) `((bootloader ,@(bootloader-configuration user-partitions)) diff --git a/gnu/installer/record.scm b/gnu/installer/record.scm index 334af44a0c..22adad279c 100644 --- a/gnu/installer/record.scm +++ b/gnu/installer/record.scm @@ -30,6 +30,7 @@ (define-module (gnu installer record) installer-exit installer-exit-error installer-final-page + installer-kernel-page installer-keymap-page installer-locale-page installer-menu-page @@ -69,6 +70,8 @@ (define-record-type* (exit-error installer-exit-error) ;; procedure void -> void (final-page installer-final-page) + ;; procedure void -> void + (kernel-page installer-kernel-page) ;; procedure (layouts context) -> (list layout variant options) (keymap-page installer-keymap-page) ;; procedure: (#:key supported-locales iso639-languages iso3166-territories) diff --git a/gnu/installer/services.scm b/gnu/installer/services.scm index 1cb9dc579c..d5a382606c 100644 --- a/gnu/installer/services.scm +++ b/gnu/installer/services.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018 Mathieu Othacehe ;;; Copyright © 2019, 2022 Ludovic Courtès -;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen +;;; Copyright © 2020, 2024 Janneke Nieuwenhuizen ;;; Copyright © 2021 Tobias Geerinckx-Rice ;;; Copyright © 2021 Leo Famulari ;;; Copyright © 2023 Denys Nykula @@ -24,6 +24,7 @@ (define-module (gnu installer services) #:use-module (guix records) #:use-module (guix read-print) + #:use-module (guix utils) #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:export (system-service? @@ -34,6 +35,7 @@ (define-module (gnu installer services) system-service-packages desktop-system-service? + system-service-none %system-services system-services->configuration)) @@ -55,7 +57,13 @@ (define-record-type* (packages system-service-packages ;list of sexps (default '()))) -(define %system-services +(define system-service-none + (system-service + (name (G_ "None")) + (type 'network-management) + (snippet '()))) + +(define (%system-services) (let-syntax ((desktop-environment (syntax-rules () ((_ fields ...) (system-service @@ -105,7 +113,11 @@ (define %system-services (G_ "\ ;; To configure OpenSSH, pass an 'openssh-configuration' ;; record as a second argument to 'service' below.\n")) - (service openssh-service-type)))) + ,(if (target-hurd?) + '(service openssh-service-type + (openssh-configuration + (openssh openssh-sans-x))) + '(service openssh-service-type))))) (system-service (name (G_ "Tor anonymous network router")) (type 'networking) @@ -115,7 +127,7 @@ (define %system-services (system-service (name (G_ "Network time service (NTP), to set the clock automatically")) (type 'administration) - (recommended? #t) + (recommended? (not (target-hurd?))) (snippet '((service ntp-service-type)))) (system-service (name (G_ "GPM mouse daemon, to use the mouse on the console")) @@ -154,8 +166,12 @@ (define (system-services->configuration services) (packages (append-map system-service-packages services)) (desktop? (find desktop-system-service? services)) (base (if desktop? - '%desktop-services - '%base-services)) + (if (target-hurd?) + '%desktop-services/hurd + '%desktop-services) + (if (target-hurd?) + '%base-services/hurd + '%base-services))) (native-console-font (match (getenv "LANGUAGE") ((or "be" "bg" "el" "eo" "kk" "ky" "mk" "mn" "ru" "sr" "tg" "uk") @@ -181,18 +197,28 @@ (define (system-services->configuration services) (if (null? snippets) `(,@(if (null? packages) - '() + (if (target-hurd?) + `(,@package-heading + (packages %base-packages/hurd)) + '()) `(,@package-heading (packages (append (list ,@packages) - %base-packages)))) + ,(if (target-hurd?) + '%base-packages/hurd + '%base-packages))))) ,@service-heading (services ,services)) `(,@(if (null? packages) - '() + (if (target-hurd?) + `(,@package-heading + (packages %base-packages/hurd)) + '()) `(,@package-heading (packages (append (list ,@packages) - %base-packages)))) + ,(if (target-hurd?) + '%base-packages/hurd + '%base-packages))))) ,@service-heading (services (append (list ,@snippets diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm index de0a852f02..34dd14c9d5 100644 --- a/gnu/installer/steps.scm +++ b/gnu/installer/steps.scm @@ -23,6 +23,7 @@ (define-module (gnu installer steps) #:use-module (guix build utils) #:use-module (guix i18n) #:use-module (guix read-print) + #:use-module (guix utils) #:use-module (gnu installer utils) #:use-module (ice-9 match) #:use-module (srfi srfi-1) @@ -240,17 +241,20 @@ (define (format-configuration steps results) ,(comment (G_ "\ ;; Indicate which modules to import to access the variables ;; used in this configuration.\n")) - (use-modules (gnu)) + ,@(if (target-hurd?) + '((use-modules (gnu) (gnu system hurd)) + (use-package-modules hurd ssh)) + '((use-modules (gnu)))) (use-service-modules cups desktop networking ssh xorg)))) `(,@modules ,(vertical-space 1) (operating-system ,@configuration)))) (define* (configuration->file configuration - #:key (filename (%installer-configuration-file))) - "Write the given CONFIGURATION to FILENAME." - (mkdir-p (dirname filename)) - (call-with-output-file filename + #:key (file-name (%installer-configuration-file))) + "Write the given CONFIGURATION to FILE-NAME." + (mkdir-p (dirname file-name)) + (call-with-output-file file-name (lambda (port) ;; TRANSLATORS: This is a comment within a Scheme file. Each line must ;; start with ";; " (two semicolons and a space). Please keep line diff --git a/gnu/installer/tests.scm b/gnu/installer/tests.scm index 8785cd9a9f..a9a5d5d988 100644 --- a/gnu/installer/tests.scm +++ b/gnu/installer/tests.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2020 Ludovic Courtès ;;; Copyright © 2020 Mathieu Othacehe +;;; Copyright © 2024 Janneke Nieuwenhuizen ;;; ;;; This file is part of GNU Guix. ;;; @@ -35,6 +36,7 @@ (define-module (gnu installer tests) choose-locale+keyboard enter-host-name+passwords + choose-kernel choose-services choose-partitioning start-installation @@ -211,6 +213,15 @@ (define* (enter-host-name+passwords port (password ,password))) names passwords)))))) +(define* (choose-kernel port #:key (kernel "Linux Libre")) + "Converse over PORT with the guided installer to choose the specified +KERNEL." + (converse port + ((list-selection (title "Kernel") + (multiple-choices? #f) + (items _)) + kernel))) + (define* (choose-services port #:key (choose-desktop-environment? (const #f)) diff --git a/gnu/local.mk b/gnu/local.mk index 6d0c20f5be..8d35272bc8 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -859,6 +859,7 @@ INSTALLER_MODULES = \ %D%/installer/final.scm \ %D%/installer/hardware.scm \ %D%/installer/hostname.scm \ + %D%/installer/kernel.scm \ %D%/installer/keymap.scm \ %D%/installer/locale.scm \ %D%/installer/newt.scm \ @@ -877,6 +878,7 @@ INSTALLER_MODULES = \ %D%/installer/newt/final.scm \ %D%/installer/newt/parameters.scm \ %D%/installer/newt/hostname.scm \ + %D%/installer/newt/kernel.scm \ %D%/installer/newt/keymap.scm \ %D%/installer/newt/locale.scm \ %D%/installer/newt/menu.scm \ diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm index 283bae6f10..9a351529e8 100644 --- a/gnu/system/hurd.scm +++ b/gnu/system/hurd.scm @@ -48,6 +48,7 @@ (define-module (gnu system hurd) #:export (%base-packages/hurd %base-services/hurd %base-services+qemu-networking/hurd + %desktop-services/hurd %hurd-default-operating-system %hurd-default-operating-system-kernel %setuid-programs/hurd)) @@ -107,6 +108,8 @@ (define %base-services+qemu-networking/hurd %qemu-static-networking)) %base-services/hurd)) +(define %desktop-services/hurd %base-services/hurd) + (define %setuid-programs/hurd ;; Default set of setuid-root programs. (map file-like->setuid-program diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm index 36dbd9111f..6be582373d 100644 --- a/gnu/tests/install.scm +++ b/gnu/tests/install.scm @@ -3,7 +3,7 @@ ;;; Copyright © 2017, 2019, 2021 Tobias Geerinckx-Rice ;;; Copyright © 2020 Mathieu Othacehe ;;; Copyright © 2020 Danny Milosavljevic -;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen +;;; Copyright © 2020, 2024 Janneke Nieuwenhuizen ;;; Copyright © 2020, 2021, 2022 Maxim Cournoyer ;;; ;;; This file is part of GNU Guix. @@ -1869,6 +1869,9 @@ (define* (gui-test-program marionette #$marionette) (screenshot "installer-services.ppm") + (marionette-eval* '(choose-kernel installer-socket) #$marionette) + (screenshot "installer-kernel.ppm") + (marionette-eval* '(choose-services installer-socket #:choose-desktop-environment? (const #$desktop?) -- 2.46.0