diff options
Diffstat (limited to 'gnu')
| -rw-r--r-- | gnu/installer.scm | 14 | ||||
| -rw-r--r-- | gnu/installer/final.scm | 9 | ||||
| -rw-r--r-- | gnu/installer/kernel.scm | 41 | ||||
| -rw-r--r-- | gnu/installer/newt.scm | 5 | ||||
| -rw-r--r-- | gnu/installer/newt/kernel.scm | 45 | ||||
| -rw-r--r-- | gnu/installer/newt/partition.scm | 10 | ||||
| -rw-r--r-- | gnu/installer/newt/services.scm | 31 | ||||
| -rw-r--r-- | gnu/installer/parted.scm | 89 | ||||
| -rw-r--r-- | gnu/installer/record.scm | 3 | ||||
| -rw-r--r-- | gnu/installer/services.scm | 46 | ||||
| -rw-r--r-- | gnu/installer/steps.scm | 14 | ||||
| -rw-r--r-- | gnu/installer/tests.scm | 11 | ||||
| -rw-r--r-- | gnu/local.mk | 2 | ||||
| -rw-r--r-- | gnu/system/hurd.scm | 3 | ||||
| -rw-r--r-- | gnu/tests/install.scm | 6 |
15 files changed, 269 insertions, 60 deletions
diff --git a/gnu/installer.scm b/gnu/installer.scm index 39a83c44557..31c0ff7ff40 100644 --- a/gnu/installer.scm +++ b/gnu/installer.scm | |||
| @@ -308,6 +308,18 @@ selected keymap." | |||
| 308 | ((installer-user-page current-installer)))) | 308 | ((installer-user-page current-installer)))) |
| 309 | (configuration-formatter users->configuration)) | 309 | (configuration-formatter users->configuration)) |
| 310 | 310 | ||
| 311 | ;; Ask the user to select the kernel for the system, | ||
| 312 | ;; for x86 systems only. | ||
| 313 | (installer-step | ||
| 314 | (id 'kernel) | ||
| 315 | (description (G_ "Kernel")) | ||
| 316 | (compute (lambda _ | ||
| 317 | (if (target-x86?) | ||
| 318 | ((installer-kernel-page current-installer)) | ||
| 319 | '()))) | ||
| 320 | (configuration-formatter (lambda (result) | ||
| 321 | (kernel->configuration result #$dry-run?)))) | ||
| 322 | |||
| 311 | ;; Ask the user to choose one or many desktop environment(s). | 323 | ;; Ask the user to choose one or many desktop environment(s). |
| 312 | (installer-step | 324 | (installer-step |
| 313 | (id 'services) | 325 | (id 'services) |
| @@ -419,6 +431,7 @@ purposes." | |||
| 419 | (gnu installer dump) | 431 | (gnu installer dump) |
| 420 | (gnu installer final) | 432 | (gnu installer final) |
| 421 | (gnu installer hostname) | 433 | (gnu installer hostname) |
| 434 | (gnu installer kernel) | ||
| 422 | (gnu installer locale) | 435 | (gnu installer locale) |
| 423 | (gnu installer parted) | 436 | (gnu installer parted) |
| 424 | (gnu installer services) | 437 | (gnu installer services) |
| @@ -431,6 +444,7 @@ purposes." | |||
| 431 | (gnu services herd) | 444 | (gnu services herd) |
| 432 | (guix i18n) | 445 | (guix i18n) |
| 433 | (guix build utils) | 446 | (guix build utils) |
| 447 | (guix utils) | ||
| 434 | ((system repl debug) | 448 | ((system repl debug) |
| 435 | #:select (terminal-width)) | 449 | #:select (terminal-width)) |
| 436 | (ice-9 match) | 450 | (ice-9 match) |
diff --git a/gnu/installer/final.scm b/gnu/installer/final.scm index 069426a3b8d..64c054cd86c 100644 --- a/gnu/installer/final.scm +++ b/gnu/installer/final.scm | |||
| @@ -1,6 +1,7 @@ | |||
| 1 | ;;; GNU Guix --- Functional package management for GNU | 1 | ;;; GNU Guix --- Functional package management for GNU |
| 2 | ;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com> | 2 | ;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com> |
| 3 | ;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org> | 3 | ;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org> |
| 4 | ;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org> | ||
| 4 | ;;; | 5 | ;;; |
| 5 | ;;; This file is part of GNU Guix. | 6 | ;;; This file is part of GNU Guix. |
| 6 | ;;; | 7 | ;;; |
| @@ -25,6 +26,7 @@ | |||
| 25 | #:use-module (gnu services herd) | 26 | #:use-module (gnu services herd) |
| 26 | #:use-module (guix build syscalls) | 27 | #:use-module (guix build syscalls) |
| 27 | #:use-module (guix build utils) | 28 | #:use-module (guix build utils) |
| 29 | #:use-module (guix utils) | ||
| 28 | #:use-module (gnu build accounts) | 30 | #:use-module (gnu build accounts) |
| 29 | #:use-module (gnu build install) | 31 | #:use-module (gnu build install) |
| 30 | #:use-module (gnu build linux-container) | 32 | #:use-module (gnu build linux-container) |
| @@ -164,8 +166,11 @@ or #f. Return #t on success and #f on failure." | |||
| 164 | "/tmp/installer-system-init-options" | 166 | "/tmp/installer-system-init-options" |
| 165 | read)) | 167 | read)) |
| 166 | (const '()))) | 168 | (const '()))) |
| 167 | (install-command (append (list "guix" "system" "init" | 169 | (install-command (append `( "guix" "system" "init" |
| 168 | "--fallback") | 170 | "--fallback" |
| 171 | ,@(if (target-hurd?) | ||
| 172 | '("--target=i586-pc-gnu") | ||
| 173 | '())) | ||
| 169 | options | 174 | options |
| 170 | (list (%installer-configuration-file) | 175 | (list (%installer-configuration-file) |
| 171 | (%installer-target-dir)))) | 176 | (%installer-target-dir)))) |
diff --git a/gnu/installer/kernel.scm b/gnu/installer/kernel.scm new file mode 100644 index 00000000000..c82b06fb830 --- /dev/null +++ b/gnu/installer/kernel.scm | |||
| @@ -0,0 +1,41 @@ | |||
| 1 | ;;; GNU Guix --- Functional package management for GNU | ||
| 2 | ;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org> | ||
| 3 | ;;; | ||
| 4 | ;;; This file is part of GNU Guix. | ||
| 5 | ;;; | ||
| 6 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | ||
| 7 | ;;; under the terms of the GNU General Public License as published by | ||
| 8 | ;;; the Free Software Foundation; either version 3 of the License, or (at | ||
| 9 | ;;; your option) any later version. | ||
| 10 | ;;; | ||
| 11 | ;;; GNU Guix is distributed in the hope that it will be useful, but | ||
| 12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 14 | ;;; GNU General Public License for more details. | ||
| 15 | ;;; | ||
| 16 | ;;; You should have received a copy of the GNU General Public License | ||
| 17 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | ||
| 18 | |||
| 19 | (define-module (gnu installer kernel) | ||
| 20 | #:use-module (gnu system hurd) | ||
| 21 | #:use-module (guix read-print) | ||
| 22 | #:export (kernel->configuration)) | ||
| 23 | |||
| 24 | (define-syntax-rule (G_ str) | ||
| 25 | ;; In this file, translatable strings are annotated with 'G_' so xgettext | ||
| 26 | ;; catches them, but translation happens later on at run time. | ||
| 27 | str) | ||
| 28 | |||
| 29 | (define (kernel->configuration kernel dry-run?) | ||
| 30 | (if (equal? kernel "Hurd") | ||
| 31 | `((kernel %hurd-default-operating-system-kernel) | ||
| 32 | ,(comment (G_ ";; \"noide\" disables the gnumach IDE driver, enabling rumpdisk.\n")) | ||
| 33 | (kernel-arguments '("noide")) | ||
| 34 | (firmware '()) | ||
| 35 | (hurd hurd) | ||
| 36 | (locale-libcs (list glibc/hurd)) | ||
| 37 | (name-service-switch #f) | ||
| 38 | (essential-services (hurd-default-essential-services this-operating-system)) | ||
| 39 | (privileged-programs '()) | ||
| 40 | (setuid-programs %setuid-programs/hurd)) | ||
| 41 | '())) | ||
diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm index d53bc058b3c..1fe710340fb 100644 --- a/gnu/installer/newt.scm +++ b/gnu/installer/newt.scm | |||
| @@ -25,6 +25,7 @@ | |||
| 25 | #:use-module (gnu installer newt final) | 25 | #:use-module (gnu installer newt final) |
| 26 | #:use-module (gnu installer newt parameters) | 26 | #:use-module (gnu installer newt parameters) |
| 27 | #:use-module (gnu installer newt hostname) | 27 | #:use-module (gnu installer newt hostname) |
| 28 | #:use-module (gnu installer newt kernel) | ||
| 28 | #:use-module (gnu installer newt keymap) | 29 | #:use-module (gnu installer newt keymap) |
| 29 | #:use-module (gnu installer newt locale) | 30 | #:use-module (gnu installer newt locale) |
| 30 | #:use-module (gnu installer newt menu) | 31 | #:use-module (gnu installer newt menu) |
| @@ -193,6 +194,9 @@ report it by email to ~a.") uploaded-name %guix-bug-report-address) | |||
| 193 | (define (hostname-page) | 194 | (define (hostname-page) |
| 194 | (run-hostname-page)) | 195 | (run-hostname-page)) |
| 195 | 196 | ||
| 197 | (define (kernel-page) | ||
| 198 | (run-kernel-page)) | ||
| 199 | |||
| 196 | (define (user-page) | 200 | (define (user-page) |
| 197 | (run-user-page)) | 201 | (run-user-page)) |
| 198 | 202 | ||
| @@ -216,6 +220,7 @@ report it by email to ~a.") uploaded-name %guix-bug-report-address) | |||
| 216 | (exit-error exit-error) | 220 | (exit-error exit-error) |
| 217 | (final-page final-page) | 221 | (final-page final-page) |
| 218 | (keymap-page keymap-page) | 222 | (keymap-page keymap-page) |
| 223 | (kernel-page kernel-page) | ||
| 219 | (locale-page locale-page) | 224 | (locale-page locale-page) |
| 220 | (menu-page menu-page) | 225 | (menu-page menu-page) |
| 221 | (network-page network-page) | 226 | (network-page network-page) |
diff --git a/gnu/installer/newt/kernel.scm b/gnu/installer/newt/kernel.scm new file mode 100644 index 00000000000..3117247312f --- /dev/null +++ b/gnu/installer/newt/kernel.scm | |||
| @@ -0,0 +1,45 @@ | |||
| 1 | ;;; GNU Guix --- Functional package management for GNU | ||
| 2 | ;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org> | ||
| 3 | ;;; | ||
| 4 | ;;; This file is part of GNU Guix. | ||
| 5 | ;;; | ||
| 6 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | ||
| 7 | ;;; under the terms of the GNU General Public License as published by | ||
| 8 | ;;; the Free Software Foundation; either version 3 of the License, or (at | ||
| 9 | ;;; your option) any later version. | ||
| 10 | ;;; | ||
| 11 | ;;; GNU Guix is distributed in the hope that it will be useful, but | ||
| 12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 14 | ;;; GNU General Public License for more details. | ||
| 15 | ;;; | ||
| 16 | ;;; You should have received a copy of the GNU General Public License | ||
| 17 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | ||
| 18 | |||
| 19 | (define-module (gnu installer newt kernel) | ||
| 20 | #:use-module (gnu installer newt page) | ||
| 21 | #:use-module (guix i18n) | ||
| 22 | #:use-module (guix utils) | ||
| 23 | #:export (run-kernel-page)) | ||
| 24 | |||
| 25 | (define (run-kernel-page) | ||
| 26 | (let* ((kernels `(,@(if (target-x86?) '("Hurd") '()) | ||
| 27 | "Linux Libre")) | ||
| 28 | (result | ||
| 29 | (run-listbox-selection-page | ||
| 30 | #:title (G_ "Kernel") | ||
| 31 | #:info-text | ||
| 32 | (G_ "Please select a kernel. When in doubt, choose \"Linux Libre\". | ||
| 33 | The Hurd is offered as a technology preview and development aid; many packages \ | ||
| 34 | are not yet available in Guix, such as a desktop environment or even a windowing \ | ||
| 35 | system (X, Wayland).") | ||
| 36 | #:listbox-items kernels | ||
| 37 | #:listbox-item->text identity | ||
| 38 | #:listbox-default-item "Linux Libre" | ||
| 39 | #:button-text (G_ "Back") | ||
| 40 | #:button-callback-procedure | ||
| 41 | (lambda _ | ||
| 42 | (abort-to-prompt 'installer-step 'abort))))) | ||
| 43 | (when (equal? result "Hurd") | ||
| 44 | (%current-target-system "i586-pc-gnu")) | ||
| 45 | result)) | ||
diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm index 48dd3060809..3a7e6795776 100644 --- a/gnu/installer/newt/partition.scm +++ b/gnu/installer/newt/partition.scm | |||
| @@ -26,6 +26,7 @@ | |||
| 26 | #:use-module (gnu installer newt page) | 26 | #:use-module (gnu installer newt page) |
| 27 | #:use-module (gnu installer newt utils) | 27 | #:use-module (gnu installer newt utils) |
| 28 | #:use-module (guix i18n) | 28 | #:use-module (guix i18n) |
| 29 | #:use-module (guix utils) | ||
| 29 | #:use-module (ice-9 format) | 30 | #:use-module (ice-9 format) |
| 30 | #:use-module (ice-9 match) | 31 | #:use-module (ice-9 match) |
| 31 | #:use-module (srfi srfi-1) | 32 | #:use-module (srfi srfi-1) |
| @@ -115,6 +116,7 @@ all data on disk will be lost, are you sure you want to proceed?") item) | |||
| 115 | Be careful, all data on the disk will be lost.") | 116 | Be careful, all data on the disk will be lost.") |
| 116 | #:title (G_ "Partition table") | 117 | #:title (G_ "Partition table") |
| 117 | #:listbox-items '("msdos" "gpt") | 118 | #:listbox-items '("msdos" "gpt") |
| 119 | #:listbox-default-item (if (target-hurd?) "msdos" "gpt") | ||
| 118 | #:listbox-item->text identity | 120 | #:listbox-item->text identity |
| 119 | #:listbox-callback-procedure | 121 | #:listbox-callback-procedure |
| 120 | (run-label-confirmation-page button-callback) | 122 | (run-label-confirmation-page button-callback) |
| @@ -147,6 +149,8 @@ Be careful, all data on the disk will be lost.") | |||
| 147 | #:title (G_ "File-system type") | 149 | #:title (G_ "File-system type") |
| 148 | #:listbox-items '(btrfs ext4 jfs xfs | 150 | #:listbox-items '(btrfs ext4 jfs xfs |
| 149 | swap | 151 | swap |
| 152 | ;; This is for the Hurd | ||
| 153 | ext2 | ||
| 150 | ;; These lack basic Unix features. Their only use | 154 | ;; These lack basic Unix features. Their only use |
| 151 | ;; on GNU is for interoperation, e.g., with UEFI. | 155 | ;; on GNU is for interoperation, e.g., with UEFI. |
| 152 | fat32 fat16 ntfs) | 156 | fat32 fat16 ntfs) |
| @@ -767,7 +771,11 @@ by pressing the Exit button.~%~%"))) | |||
| 767 | (define (run-page devices) | 771 | (define (run-page devices) |
| 768 | (let* ((items | 772 | (let* ((items |
| 769 | `((entire . ,(G_ "Guided - using the entire disk")) | 773 | `((entire . ,(G_ "Guided - using the entire disk")) |
| 770 | (entire-encrypted . ,(G_ "Guided - using the entire disk with encryption")) | 774 | ,@(if (target-hurd?) |
| 775 | '() | ||
| 776 | `((entire-encrypted | ||
| 777 | . | ||
| 778 | ,(G_ "Guided - using the entire disk with encryption")))) | ||
| 771 | (manual . ,(G_ "Manual")))) | 779 | (manual . ,(G_ "Manual")))) |
| 772 | (result (run-listbox-selection-page | 780 | (result (run-listbox-selection-page |
| 773 | #:info-text (G_ "Please select a partitioning method.") | 781 | #:info-text (G_ "Please select a partitioning method.") |
diff --git a/gnu/installer/newt/services.scm b/gnu/installer/newt/services.scm index d1035b65240..848683e8c77 100644 --- a/gnu/installer/newt/services.scm +++ b/gnu/installer/newt/services.scm | |||
| @@ -1,7 +1,7 @@ | |||
| 1 | ;;; GNU Guix --- Functional package management for GNU | 1 | ;;; GNU Guix --- Functional package management for GNU |
| 2 | ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com> | 2 | ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com> |
| 3 | ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> | 3 | ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> |
| 4 | ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> | 4 | ;;; Copyright © 2020, 2024 Janneke Nieuwenhuizen <janneke@gnu.org> |
| 5 | ;;; Copyright © 2021 Tobias Geerinckx-Rice <me@tobias.gr> | 5 | ;;; Copyright © 2021 Tobias Geerinckx-Rice <me@tobias.gr> |
| 6 | ;;; Copyright © 2021 Leo Famulari <leo@famulari.name> | 6 | ;;; Copyright © 2021 Leo Famulari <leo@famulari.name> |
| 7 | ;;; | 7 | ;;; |
| @@ -26,6 +26,7 @@ | |||
| 26 | #:use-module (gnu installer newt page) | 26 | #:use-module (gnu installer newt page) |
| 27 | #:use-module (gnu installer newt utils) | 27 | #:use-module (gnu installer newt utils) |
| 28 | #:use-module (guix i18n) | 28 | #:use-module (guix i18n) |
| 29 | #:use-module (guix utils) | ||
| 29 | #:use-module (srfi srfi-34) | 30 | #:use-module (srfi srfi-34) |
| 30 | #:use-module (srfi srfi-35) | 31 | #:use-module (srfi srfi-35) |
| 31 | #:export (run-services-page)) | 32 | #:export (run-services-page)) |
| @@ -33,11 +34,13 @@ | |||
| 33 | (define (run-desktop-environments-cbt-page) | 34 | (define (run-desktop-environments-cbt-page) |
| 34 | "Run a page allowing the user to choose between various desktop | 35 | "Run a page allowing the user to choose between various desktop |
| 35 | environments." | 36 | environments." |
| 36 | (let ((items (filter desktop-system-service? %system-services))) | 37 | (let ((items (filter desktop-system-service? (%system-services)))) |
| 37 | (run-checkbox-tree-page | 38 | (run-checkbox-tree-page |
| 38 | #:info-text (G_ "Please select the desktop environment(s) you wish to \ | 39 | #:info-text (if (target-hurd?) |
| 40 | (G_ "Currently, none of these is available for the Hurd.") | ||
| 41 | (G_ "Please select the desktop environment(s) you wish to \ | ||
| 39 | install. If you select multiple desktop environments here, you will be able \ | 42 | install. If you select multiple desktop environments here, you will be able \ |
| 40 | to choose from them later when you log in.") | 43 | to choose from them later when you log in.")) |
| 41 | #:title (G_ "Desktop environment") | 44 | #:title (G_ "Desktop environment") |
| 42 | #:items items | 45 | #:items items |
| 43 | #:selection (map system-service-recommended? items) | 46 | #:selection (map system-service-recommended? items) |
| @@ -51,7 +54,7 @@ to choose from them later when you log in.") | |||
| 51 | "Run a page allowing the user to select networking services." | 54 | "Run a page allowing the user to select networking services." |
| 52 | (let ((items (filter (lambda (service) | 55 | (let ((items (filter (lambda (service) |
| 53 | (eq? 'networking (system-service-type service))) | 56 | (eq? 'networking (system-service-type service))) |
| 54 | %system-services))) | 57 | (%system-services)))) |
| 55 | (run-checkbox-tree-page | 58 | (run-checkbox-tree-page |
| 56 | #:info-text (G_ "You can now select networking services to run on your \ | 59 | #:info-text (G_ "You can now select networking services to run on your \ |
| 57 | system.") | 60 | system.") |
| @@ -69,7 +72,7 @@ system.") | |||
| 69 | (let ((items (filter (lambda (service) | 72 | (let ((items (filter (lambda (service) |
| 70 | (eq? 'document | 73 | (eq? 'document |
| 71 | (system-service-type service))) | 74 | (system-service-type service))) |
| 72 | %system-services))) | 75 | (%system-services)))) |
| 73 | (run-checkbox-tree-page | 76 | (run-checkbox-tree-page |
| 74 | #:info-text (G_ "You can now select the CUPS printing service to run on your \ | 77 | #:info-text (G_ "You can now select the CUPS printing service to run on your \ |
| 75 | system.") | 78 | system.") |
| @@ -88,7 +91,7 @@ systems." | |||
| 88 | (let ((items (filter (lambda (service) | 91 | (let ((items (filter (lambda (service) |
| 89 | (eq? 'administration | 92 | (eq? 'administration |
| 90 | (system-service-type service))) | 93 | (system-service-type service))) |
| 91 | %system-services))) | 94 | (%system-services)))) |
| 92 | (run-checkbox-tree-page | 95 | (run-checkbox-tree-page |
| 93 | #:title (G_ "Console services") | 96 | #:title (G_ "Console services") |
| 94 | #:info-text (G_ "Select miscellaneous services to run on your \ | 97 | #:info-text (G_ "Select miscellaneous services to run on your \ |
| @@ -103,7 +106,11 @@ non-graphical system.") | |||
| 103 | 106 | ||
| 104 | (define (run-network-management-page) | 107 | (define (run-network-management-page) |
| 105 | "Run a page to select among several network management methods." | 108 | "Run a page to select among several network management methods." |
| 106 | (let ((title (G_ "Network management"))) | 109 | (let ((title (G_ "Network management")) |
| 110 | (items (filter (lambda (service) | ||
| 111 | (eq? 'network-management | ||
| 112 | (system-service-type service))) | ||
| 113 | (%system-services)))) | ||
| 107 | (run-listbox-selection-page | 114 | (run-listbox-selection-page |
| 108 | #:title title | 115 | #:title title |
| 109 | #:info-text (G_ "Choose the method to manage network connections. | 116 | #:info-text (G_ "Choose the method to manage network connections. |
| @@ -112,10 +119,10 @@ We recommend NetworkManager or Connman for a WiFi-capable laptop; the DHCP \ | |||
| 112 | client may be enough for a server.") | 119 | client may be enough for a server.") |
| 113 | #:info-textbox-width 70 | 120 | #:info-textbox-width 70 |
| 114 | #:listbox-height 7 | 121 | #:listbox-height 7 |
| 115 | #:listbox-items (filter (lambda (service) | 122 | #:listbox-items `(,@items |
| 116 | (eq? 'network-management | 123 | ,@(if (target-hurd?) |
| 117 | (system-service-type service))) | 124 | (list system-service-none) |
| 118 | %system-services) | 125 | '())) |
| 119 | #:listbox-item->text (compose G_ system-service-name) | 126 | #:listbox-item->text (compose G_ system-service-name) |
| 120 | #:sort-listbox-items? #f | 127 | #:sort-listbox-items? #f |
| 121 | #:button-text (G_ "Exit") | 128 | #:button-text (G_ "Exit") |
diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm index b36b238d8be..ccddc64f115 100644 --- a/gnu/installer/parted.scm +++ b/gnu/installer/parted.scm | |||
| @@ -152,7 +152,7 @@ | |||
| 152 | (crypt-password user-partition-crypt-password ; <secret> | 152 | (crypt-password user-partition-crypt-password ; <secret> |
| 153 | (default #f)) | 153 | (default #f)) |
| 154 | (fs-type user-partition-fs-type | 154 | (fs-type user-partition-fs-type |
| 155 | (default 'ext4)) | 155 | (default (if (target-hurd?) 'ext2 'ext4))) |
| 156 | (bootable? user-partition-bootable? | 156 | (bootable? user-partition-bootable? |
| 157 | (default #f)) | 157 | (default #f)) |
| 158 | (esp? user-partition-esp? | 158 | (esp? user-partition-esp? |
| @@ -223,11 +223,13 @@ inferior to MAX-SIZE, #f otherwise." | |||
| 223 | 223 | ||
| 224 | (define (efi-installation?) | 224 | (define (efi-installation?) |
| 225 | "Return #t if an EFI installation should be performed, #f otherwise." | 225 | "Return #t if an EFI installation should be performed, #f otherwise." |
| 226 | (file-exists? "/sys/firmware/efi")) | 226 | (and (file-exists? "/sys/firmware/efi") |
| 227 | (not (target-hurd?)))) | ||
| 227 | 228 | ||
| 228 | (define (user-fs-type-name fs-type) | 229 | (define (user-fs-type-name fs-type) |
| 229 | "Return the name of FS-TYPE as specified by libparted." | 230 | "Return the name of FS-TYPE as specified by libparted." |
| 230 | (case fs-type | 231 | (case fs-type |
| 232 | ((ext2) "ext2") | ||
| 231 | ((ext4) "ext4") | 233 | ((ext4) "ext4") |
| 232 | ((btrfs) "btrfs") | 234 | ((btrfs) "btrfs") |
| 233 | ((fat16) "fat16") | 235 | ((fat16) "fat16") |
| @@ -240,6 +242,7 @@ inferior to MAX-SIZE, #f otherwise." | |||
| 240 | (define (user-fs-type->mount-type fs-type) | 242 | (define (user-fs-type->mount-type fs-type) |
| 241 | "Return the mount type of FS-TYPE." | 243 | "Return the mount type of FS-TYPE." |
| 242 | (case fs-type | 244 | (case fs-type |
| 245 | ((ext2) "ext2") | ||
| 243 | ((ext4) "ext4") | 246 | ((ext4) "ext4") |
| 244 | ((btrfs) "btrfs") | 247 | ((btrfs) "btrfs") |
| 245 | ((fat16) "vfat") | 248 | ((fat16) "vfat") |
| @@ -255,6 +258,7 @@ of <user-partition> record." | |||
| 255 | (and fs-type | 258 | (and fs-type |
| 256 | (let ((name (filesystem-type-name fs-type))) | 259 | (let ((name (filesystem-type-name fs-type))) |
| 257 | (cond | 260 | (cond |
| 261 | ((string=? name "ext2") 'ext2) | ||
| 258 | ((string=? name "ext4") 'ext4) | 262 | ((string=? name "ext4") 'ext4) |
| 259 | ((string=? name "btrfs") 'btrfs) | 263 | ((string=? name "btrfs") 'btrfs) |
| 260 | ((string=? name "fat16") 'fat16) | 264 | ((string=? name "fat16") 'fat16) |
| @@ -296,7 +300,7 @@ of <user-partition> record." | |||
| 296 | (file-name (partition-get-path partition)) | 300 | (file-name (partition-get-path partition)) |
| 297 | (disk-file-name (device-path device)) | 301 | (disk-file-name (device-path device)) |
| 298 | (fs-type (or (partition-filesystem-user-type partition) | 302 | (fs-type (or (partition-filesystem-user-type partition) |
| 299 | 'ext4)) | 303 | (if (target-hurd?) 'ext2 'ext4))) |
| 300 | (mount-point (and (esp-partition? partition) | 304 | (mount-point (and (esp-partition? partition) |
| 301 | (default-esp-mount-point))) | 305 | (default-esp-mount-point))) |
| 302 | (bootable? (boot-partition? partition)) | 306 | (bootable? (boot-partition? partition)) |
| @@ -1045,18 +1049,20 @@ exists." | |||
| 1045 | non-boot-partitions) | 1049 | non-boot-partitions) |
| 1046 | 1050 | ||
| 1047 | (let* ((start-partition | 1051 | (let* ((start-partition |
| 1048 | (if (efi-installation?) | 1052 | (cond ((target-hurd?) #f) |
| 1049 | (and (not esp-partition) | 1053 | ((efi-installation?) |
| 1050 | (user-partition | 1054 | (and (not esp-partition) |
| 1051 | (fs-type 'fat32) | 1055 | (user-partition |
| 1052 | (esp? #t) | 1056 | (fs-type 'fat32) |
| 1053 | (size new-esp-size) | 1057 | (esp? #t) |
| 1054 | (mount-point (default-esp-mount-point)))) | 1058 | (size new-esp-size) |
| 1055 | (user-partition | 1059 | (mount-point (default-esp-mount-point))))) |
| 1056 | (fs-type 'ext4) | 1060 | (else |
| 1057 | (bootable? #t) | 1061 | (user-partition |
| 1058 | (bios-grub? #t) | 1062 | (fs-type 'ext4) |
| 1059 | (size bios-grub-size)))) | 1063 | (bootable? #t) |
| 1064 | (bios-grub? #t) | ||
| 1065 | (size bios-grub-size))))) | ||
| 1060 | (new-partitions | 1066 | (new-partitions |
| 1061 | (cond | 1067 | (cond |
| 1062 | ((or (eq? scheme 'entire-root) | 1068 | ((or (eq? scheme 'entire-root) |
| @@ -1065,13 +1071,13 @@ exists." | |||
| 1065 | `(,@(if start-partition | 1071 | `(,@(if start-partition |
| 1066 | `(,start-partition) | 1072 | `(,start-partition) |
| 1067 | '()) | 1073 | '()) |
| 1068 | ,@(if encrypted? | 1074 | ,@(if (or encrypted? (target-hurd?)) |
| 1069 | '() | 1075 | '() |
| 1070 | `(,(user-partition | 1076 | `(,(user-partition |
| 1071 | (fs-type 'swap) | 1077 | (fs-type 'swap) |
| 1072 | (size swap-size)))) | 1078 | (size swap-size)))) |
| 1073 | ,(user-partition | 1079 | ,(user-partition |
| 1074 | (fs-type 'ext4) | 1080 | (fs-type (if (target-hurd?) 'ext2 'ext4)) |
| 1075 | (bootable? has-extended?) | 1081 | (bootable? has-extended?) |
| 1076 | (crypt-label (and encrypted? "cryptroot")) | 1082 | (crypt-label (and encrypted? "cryptroot")) |
| 1077 | (size "100%") | 1083 | (size "100%") |
| @@ -1083,7 +1089,7 @@ exists." | |||
| 1083 | `(,start-partition) | 1089 | `(,start-partition) |
| 1084 | '()) | 1090 | '()) |
| 1085 | ,(user-partition | 1091 | ,(user-partition |
| 1086 | (fs-type 'ext4) | 1092 | (fs-type (if (target-hurd?) 'ext2 'ext4)) |
| 1087 | (bootable? has-extended?) | 1093 | (bootable? has-extended?) |
| 1088 | (crypt-label (and encrypted? "cryptroot")) | 1094 | (crypt-label (and encrypted? "cryptroot")) |
| 1089 | (size "33%") | 1095 | (size "33%") |
| @@ -1105,7 +1111,7 @@ exists." | |||
| 1105 | (type (if has-extended? | 1111 | (type (if has-extended? |
| 1106 | 'logical | 1112 | 'logical |
| 1107 | 'normal)) | 1113 | 'normal)) |
| 1108 | (fs-type 'ext4) | 1114 | (fs-type (if (target-hurd?) 'ext2 'ext4)) |
| 1109 | (crypt-label (and encrypted? "crypthome")) | 1115 | (crypt-label (and encrypted? "crypthome")) |
| 1110 | (size "100%") | 1116 | (size "100%") |
| 1111 | (mount-point "/home"))))))) | 1117 | (mount-point "/home"))))))) |
| @@ -1186,6 +1192,15 @@ list and return the updated list." | |||
| 1186 | "Create a btrfs file-system for PARTITION file-name." | 1192 | "Create a btrfs file-system for PARTITION file-name." |
| 1187 | ((%run-command-in-installer) "mkfs.btrfs" "-f" partition)) | 1193 | ((%run-command-in-installer) "mkfs.btrfs" "-f" partition)) |
| 1188 | 1194 | ||
| 1195 | (define (create-ext2-file-system partition) | ||
| 1196 | "Create an ext2 file-system for PARTITION file-name, when TARGET-HURD?, | ||
| 1197 | for the Hurd." | ||
| 1198 | (apply (%run-command-in-installer) | ||
| 1199 | `("mkfs.ext2" ,@(if (target-hurd?) | ||
| 1200 | '("-o" "hurd") | ||
| 1201 | '()) | ||
| 1202 | "-F" ,partition))) | ||
| 1203 | |||
| 1189 | (define (create-ext4-file-system partition) | 1204 | (define (create-ext4-file-system partition) |
| 1190 | "Create an ext4 file-system for PARTITION file-name." | 1205 | "Create an ext4 file-system for PARTITION file-name." |
| 1191 | ;; Enable the 'large_dir' feature so users can have a store of several TiBs. | 1206 | ;; Enable the 'large_dir' feature so users can have a store of several TiBs. |
| @@ -1291,6 +1306,10 @@ NEED-FORMATTING? field set to #t." | |||
| 1291 | (and need-formatting? | 1306 | (and need-formatting? |
| 1292 | (not (eq? type 'extended)) | 1307 | (not (eq? type 'extended)) |
| 1293 | (create-btrfs-file-system file-name))) | 1308 | (create-btrfs-file-system file-name))) |
| 1309 | ((ext2) | ||
| 1310 | (and need-formatting? | ||
| 1311 | (not (eq? type 'extended)) | ||
| 1312 | (create-ext2-file-system file-name))) | ||
| 1294 | ((ext4) | 1313 | ((ext4) |
| 1295 | (and need-formatting? | 1314 | (and need-formatting? |
| 1296 | (not (eq? type 'extended)) | 1315 | (not (eq? type 'extended)) |
| @@ -1463,7 +1482,11 @@ from (gnu system mapped-devices) and return it." | |||
| 1463 | "Return the bootloader configuration field for USER-PARTITIONS." | 1482 | "Return the bootloader configuration field for USER-PARTITIONS." |
| 1464 | (let ((root-partition (find root-user-partition? user-partitions))) | 1483 | (let ((root-partition (find root-user-partition? user-partitions))) |
| 1465 | (match user-partitions | 1484 | (match user-partitions |
| 1466 | (() '()) | 1485 | (() (if (target-hurd?) |
| 1486 | '(bootloader-configuration | ||
| 1487 | (bootloader grub-minimal-bootloader) | ||
| 1488 | (targets "/dev/sdaX")) | ||
| 1489 | '())) | ||
| 1467 | (_ | 1490 | (_ |
| 1468 | (let ((root-partition-disk (user-partition-disk-file-name | 1491 | (let ((root-partition-disk (user-partition-disk-file-name |
| 1469 | root-partition))) | 1492 | root-partition))) |
| @@ -1471,7 +1494,9 @@ from (gnu system mapped-devices) and return it." | |||
| 1471 | ,@(if (efi-installation?) | 1494 | ,@(if (efi-installation?) |
| 1472 | `((bootloader grub-efi-bootloader) | 1495 | `((bootloader grub-efi-bootloader) |
| 1473 | (targets (list ,(default-esp-mount-point)))) | 1496 | (targets (list ,(default-esp-mount-point)))) |
| 1474 | `((bootloader grub-bootloader) | 1497 | `((bootloader ,(if (target-hurd?) |
| 1498 | 'grub-minimal-bootloader | ||
| 1499 | 'grub-bootloader)) | ||
| 1475 | (targets (list ,root-partition-disk)))) | 1500 | (targets (list ,root-partition-disk)))) |
| 1476 | 1501 | ||
| 1477 | ;; XXX: Assume we defined the 'keyboard-layout' field of | 1502 | ;; XXX: Assume we defined the 'keyboard-layout' field of |
| @@ -1491,22 +1516,28 @@ modules to access USER-PARTITIONS." | |||
| 1491 | (const '()))) | 1516 | (const '()))) |
| 1492 | (delete-duplicates | 1517 | (delete-duplicates |
| 1493 | (map user-partition-file-name | 1518 | (map user-partition-file-name |
| 1494 | (cons root devices))))))) | 1519 | (filter identity |
| 1520 | (cons root devices)))))))) | ||
| 1495 | 1521 | ||
| 1496 | (define (initrd-configuration user-partitions) | 1522 | (define (initrd-configuration user-partitions) |
| 1497 | "Return an 'initrd-modules' field with everything needed for | 1523 | "Return an 'initrd-modules' field with everything needed for |
| 1498 | USER-PARTITIONS, or return nothing." | 1524 | USER-PARTITIONS, or return nothing." |
| 1499 | (match (user-partition-missing-modules user-partitions) | 1525 | (if (target-hurd?) |
| 1500 | (() | 1526 | '((initrd #f) |
| 1501 | '()) | 1527 | (initrd-modules '())) |
| 1502 | ((modules ...) | 1528 | (match (user-partition-missing-modules user-partitions) |
| 1503 | `((initrd-modules (append ',modules | 1529 | (() |
| 1504 | %base-initrd-modules)))))) | 1530 | '()) |
| 1531 | ((modules ...) | ||
| 1532 | `((initrd-modules (append ',modules | ||
| 1533 | %base-initrd-modules))))))) | ||
| 1505 | 1534 | ||
| 1506 | (define (user-partitions->configuration user-partitions) | 1535 | (define (user-partitions->configuration user-partitions) |
| 1507 | "Return the configuration field for USER-PARTITIONS." | 1536 | "Return the configuration field for USER-PARTITIONS." |
| 1508 | (let* ((swap-user-partitions (find-swap-user-partitions user-partitions)) | 1537 | (let* ((swap-user-partitions (find-swap-user-partitions user-partitions)) |
| 1509 | (swap-devices (map user-partition-file-name swap-user-partitions)) | 1538 | (swap-devices (if (target-hurd?) |
| 1539 | '() | ||
| 1540 | (map user-partition-file-name swap-user-partitions))) | ||
| 1510 | (encrypted-partitions | 1541 | (encrypted-partitions |
| 1511 | (filter user-partition-crypt-label user-partitions))) | 1542 | (filter user-partition-crypt-label user-partitions))) |
| 1512 | `((bootloader ,@(bootloader-configuration user-partitions)) | 1543 | `((bootloader ,@(bootloader-configuration user-partitions)) |
diff --git a/gnu/installer/record.scm b/gnu/installer/record.scm index 334af44a0cb..22adad279c7 100644 --- a/gnu/installer/record.scm +++ b/gnu/installer/record.scm | |||
| @@ -30,6 +30,7 @@ | |||
| 30 | installer-exit | 30 | installer-exit |
| 31 | installer-exit-error | 31 | installer-exit-error |
| 32 | installer-final-page | 32 | installer-final-page |
| 33 | installer-kernel-page | ||
| 33 | installer-keymap-page | 34 | installer-keymap-page |
| 34 | installer-locale-page | 35 | installer-locale-page |
| 35 | installer-menu-page | 36 | installer-menu-page |
| @@ -69,6 +70,8 @@ | |||
| 69 | (exit-error installer-exit-error) | 70 | (exit-error installer-exit-error) |
| 70 | ;; procedure void -> void | 71 | ;; procedure void -> void |
| 71 | (final-page installer-final-page) | 72 | (final-page installer-final-page) |
| 73 | ;; procedure void -> void | ||
| 74 | (kernel-page installer-kernel-page) | ||
| 72 | ;; procedure (layouts context) -> (list layout variant options) | 75 | ;; procedure (layouts context) -> (list layout variant options) |
| 73 | (keymap-page installer-keymap-page) | 76 | (keymap-page installer-keymap-page) |
| 74 | ;; procedure: (#:key supported-locales iso639-languages iso3166-territories) | 77 | ;; procedure: (#:key supported-locales iso639-languages iso3166-territories) |
diff --git a/gnu/installer/services.scm b/gnu/installer/services.scm index 1cb9dc579cd..d5a382606c4 100644 --- a/gnu/installer/services.scm +++ b/gnu/installer/services.scm | |||
| @@ -1,7 +1,7 @@ | |||
| 1 | ;;; GNU Guix --- Functional package management for GNU | 1 | ;;; GNU Guix --- Functional package management for GNU |
| 2 | ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com> | 2 | ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com> |
| 3 | ;;; Copyright © 2019, 2022 Ludovic Courtès <ludo@gnu.org> | 3 | ;;; Copyright © 2019, 2022 Ludovic Courtès <ludo@gnu.org> |
| 4 | ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> | 4 | ;;; Copyright © 2020, 2024 Janneke Nieuwenhuizen <janneke@gnu.org> |
| 5 | ;;; Copyright © 2021 Tobias Geerinckx-Rice <me@tobias.gr> | 5 | ;;; Copyright © 2021 Tobias Geerinckx-Rice <me@tobias.gr> |
| 6 | ;;; Copyright © 2021 Leo Famulari <leo@famulari.name> | 6 | ;;; Copyright © 2021 Leo Famulari <leo@famulari.name> |
| 7 | ;;; Copyright © 2023 Denys Nykula <vegan@libre.net.ua> | 7 | ;;; Copyright © 2023 Denys Nykula <vegan@libre.net.ua> |
| @@ -24,6 +24,7 @@ | |||
| 24 | (define-module (gnu installer services) | 24 | (define-module (gnu installer services) |
| 25 | #:use-module (guix records) | 25 | #:use-module (guix records) |
| 26 | #:use-module (guix read-print) | 26 | #:use-module (guix read-print) |
| 27 | #:use-module (guix utils) | ||
| 27 | #:use-module (ice-9 match) | 28 | #:use-module (ice-9 match) |
| 28 | #:use-module (srfi srfi-1) | 29 | #:use-module (srfi srfi-1) |
| 29 | #:export (system-service? | 30 | #:export (system-service? |
| @@ -34,6 +35,7 @@ | |||
| 34 | system-service-packages | 35 | system-service-packages |
| 35 | 36 | ||
| 36 | desktop-system-service? | 37 | desktop-system-service? |
| 38 | system-service-none | ||
| 37 | 39 | ||
| 38 | %system-services | 40 | %system-services |
| 39 | system-services->configuration)) | 41 | system-services->configuration)) |
| @@ -55,7 +57,13 @@ | |||
| 55 | (packages system-service-packages ;list of sexps | 57 | (packages system-service-packages ;list of sexps |
| 56 | (default '()))) | 58 | (default '()))) |
| 57 | 59 | ||
| 58 | (define %system-services | 60 | (define system-service-none |
| 61 | (system-service | ||
| 62 | (name (G_ "None")) | ||
| 63 | (type 'network-management) | ||
| 64 | (snippet '()))) | ||
| 65 | |||
| 66 | (define (%system-services) | ||
| 59 | (let-syntax ((desktop-environment (syntax-rules () | 67 | (let-syntax ((desktop-environment (syntax-rules () |
| 60 | ((_ fields ...) | 68 | ((_ fields ...) |
| 61 | (system-service | 69 | (system-service |
| @@ -105,7 +113,11 @@ | |||
| 105 | (G_ "\ | 113 | (G_ "\ |
| 106 | ;; To configure OpenSSH, pass an 'openssh-configuration' | 114 | ;; To configure OpenSSH, pass an 'openssh-configuration' |
| 107 | ;; record as a second argument to 'service' below.\n")) | 115 | ;; record as a second argument to 'service' below.\n")) |
| 108 | (service openssh-service-type)))) | 116 | ,(if (target-hurd?) |
| 117 | '(service openssh-service-type | ||
| 118 | (openssh-configuration | ||
| 119 | (openssh openssh-sans-x))) | ||
| 120 | '(service openssh-service-type))))) | ||
| 109 | (system-service | 121 | (system-service |
| 110 | (name (G_ "Tor anonymous network router")) | 122 | (name (G_ "Tor anonymous network router")) |
| 111 | (type 'networking) | 123 | (type 'networking) |
| @@ -115,7 +127,7 @@ | |||
| 115 | (system-service | 127 | (system-service |
| 116 | (name (G_ "Network time service (NTP), to set the clock automatically")) | 128 | (name (G_ "Network time service (NTP), to set the clock automatically")) |
| 117 | (type 'administration) | 129 | (type 'administration) |
| 118 | (recommended? #t) | 130 | (recommended? (not (target-hurd?))) |
| 119 | (snippet '((service ntp-service-type)))) | 131 | (snippet '((service ntp-service-type)))) |
| 120 | (system-service | 132 | (system-service |
| 121 | (name (G_ "GPM mouse daemon, to use the mouse on the console")) | 133 | (name (G_ "GPM mouse daemon, to use the mouse on the console")) |
| @@ -154,8 +166,12 @@ | |||
| 154 | (packages (append-map system-service-packages services)) | 166 | (packages (append-map system-service-packages services)) |
| 155 | (desktop? (find desktop-system-service? services)) | 167 | (desktop? (find desktop-system-service? services)) |
| 156 | (base (if desktop? | 168 | (base (if desktop? |
| 157 | '%desktop-services | 169 | (if (target-hurd?) |
| 158 | '%base-services)) | 170 | '%desktop-services/hurd |
| 171 | '%desktop-services) | ||
| 172 | (if (target-hurd?) | ||
| 173 | '%base-services/hurd | ||
| 174 | '%base-services))) | ||
| 159 | (native-console-font (match (getenv "LANGUAGE") | 175 | (native-console-font (match (getenv "LANGUAGE") |
| 160 | ((or "be" "bg" "el" "eo" "kk" "ky" | 176 | ((or "be" "bg" "el" "eo" "kk" "ky" |
| 161 | "mk" "mn" "ru" "sr" "tg" "uk") | 177 | "mk" "mn" "ru" "sr" "tg" "uk") |
| @@ -181,18 +197,28 @@ | |||
| 181 | 197 | ||
| 182 | (if (null? snippets) | 198 | (if (null? snippets) |
| 183 | `(,@(if (null? packages) | 199 | `(,@(if (null? packages) |
| 184 | '() | 200 | (if (target-hurd?) |
| 201 | `(,@package-heading | ||
| 202 | (packages %base-packages/hurd)) | ||
| 203 | '()) | ||
| 185 | `(,@package-heading | 204 | `(,@package-heading |
| 186 | (packages (append (list ,@packages) | 205 | (packages (append (list ,@packages) |
| 187 | %base-packages)))) | 206 | ,(if (target-hurd?) |
| 207 | '%base-packages/hurd | ||
| 208 | '%base-packages))))) | ||
| 188 | 209 | ||
| 189 | ,@service-heading | 210 | ,@service-heading |
| 190 | (services ,services)) | 211 | (services ,services)) |
| 191 | `(,@(if (null? packages) | 212 | `(,@(if (null? packages) |
| 192 | '() | 213 | (if (target-hurd?) |
| 214 | `(,@package-heading | ||
| 215 | (packages %base-packages/hurd)) | ||
| 216 | '()) | ||
| 193 | `(,@package-heading | 217 | `(,@package-heading |
| 194 | (packages (append (list ,@packages) | 218 | (packages (append (list ,@packages) |
| 195 | %base-packages)))) | 219 | ,(if (target-hurd?) |
| 220 | '%base-packages/hurd | ||
| 221 | '%base-packages))))) | ||
| 196 | 222 | ||
| 197 | ,@service-heading | 223 | ,@service-heading |
| 198 | (services (append (list ,@snippets | 224 | (services (append (list ,@snippets |
diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm index de0a852f02a..34dd14c9d56 100644 --- a/gnu/installer/steps.scm +++ b/gnu/installer/steps.scm | |||
| @@ -23,6 +23,7 @@ | |||
| 23 | #:use-module (guix build utils) | 23 | #:use-module (guix build utils) |
| 24 | #:use-module (guix i18n) | 24 | #:use-module (guix i18n) |
| 25 | #:use-module (guix read-print) | 25 | #:use-module (guix read-print) |
| 26 | #:use-module (guix utils) | ||
| 26 | #:use-module (gnu installer utils) | 27 | #:use-module (gnu installer utils) |
| 27 | #:use-module (ice-9 match) | 28 | #:use-module (ice-9 match) |
| 28 | #:use-module (srfi srfi-1) | 29 | #:use-module (srfi srfi-1) |
| @@ -240,17 +241,20 @@ found in RESULTS." | |||
| 240 | ,(comment (G_ "\ | 241 | ,(comment (G_ "\ |
| 241 | ;; Indicate which modules to import to access the variables | 242 | ;; Indicate which modules to import to access the variables |
| 242 | ;; used in this configuration.\n")) | 243 | ;; used in this configuration.\n")) |
| 243 | (use-modules (gnu)) | 244 | ,@(if (target-hurd?) |
| 245 | '((use-modules (gnu) (gnu system hurd)) | ||
| 246 | (use-package-modules hurd ssh)) | ||
| 247 | '((use-modules (gnu)))) | ||
| 244 | (use-service-modules cups desktop networking ssh xorg)))) | 248 | (use-service-modules cups desktop networking ssh xorg)))) |
| 245 | `(,@modules | 249 | `(,@modules |
| 246 | ,(vertical-space 1) | 250 | ,(vertical-space 1) |
| 247 | (operating-system ,@configuration)))) | 251 | (operating-system ,@configuration)))) |
| 248 | 252 | ||
| 249 | (define* (configuration->file configuration | 253 | (define* (configuration->file configuration |
| 250 | #:key (filename (%installer-configuration-file))) | 254 | #:key (file-name (%installer-configuration-file))) |
| 251 | "Write the given CONFIGURATION to FILENAME." | 255 | "Write the given CONFIGURATION to FILE-NAME." |
| 252 | (mkdir-p (dirname filename)) | 256 | (mkdir-p (dirname file-name)) |
| 253 | (call-with-output-file filename | 257 | (call-with-output-file file-name |
| 254 | (lambda (port) | 258 | (lambda (port) |
| 255 | ;; TRANSLATORS: This is a comment within a Scheme file. Each line must | 259 | ;; TRANSLATORS: This is a comment within a Scheme file. Each line must |
| 256 | ;; start with ";; " (two semicolons and a space). Please keep line | 260 | ;; start with ";; " (two semicolons and a space). Please keep line |
diff --git a/gnu/installer/tests.scm b/gnu/installer/tests.scm index 8785cd9a9f2..a9a5d5d9880 100644 --- a/gnu/installer/tests.scm +++ b/gnu/installer/tests.scm | |||
| @@ -1,6 +1,7 @@ | |||
| 1 | ;;; GNU Guix --- Functional package management for GNU | 1 | ;;; GNU Guix --- Functional package management for GNU |
| 2 | ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> | 2 | ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> |
| 3 | ;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com> | 3 | ;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com> |
| 4 | ;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org> | ||
| 4 | ;;; | 5 | ;;; |
| 5 | ;;; This file is part of GNU Guix. | 6 | ;;; This file is part of GNU Guix. |
| 6 | ;;; | 7 | ;;; |
| @@ -35,6 +36,7 @@ | |||
| 35 | 36 | ||
| 36 | choose-locale+keyboard | 37 | choose-locale+keyboard |
| 37 | enter-host-name+passwords | 38 | enter-host-name+passwords |
| 39 | choose-kernel | ||
| 38 | choose-services | 40 | choose-services |
| 39 | choose-partitioning | 41 | choose-partitioning |
| 40 | start-installation | 42 | start-installation |
| @@ -211,6 +213,15 @@ ROOT-PASSWORD, and USERS." | |||
| 211 | (password ,password))) | 213 | (password ,password))) |
| 212 | names passwords)))))) | 214 | names passwords)))))) |
| 213 | 215 | ||
| 216 | (define* (choose-kernel port #:key (kernel "Linux Libre")) | ||
| 217 | "Converse over PORT with the guided installer to choose the specified | ||
| 218 | KERNEL." | ||
| 219 | (converse port | ||
| 220 | ((list-selection (title "Kernel") | ||
| 221 | (multiple-choices? #f) | ||
| 222 | (items _)) | ||
| 223 | kernel))) | ||
| 224 | |||
| 214 | (define* (choose-services port | 225 | (define* (choose-services port |
| 215 | #:key | 226 | #:key |
| 216 | (choose-desktop-environment? (const #f)) | 227 | (choose-desktop-environment? (const #f)) |
diff --git a/gnu/local.mk b/gnu/local.mk index 03cf70ffa87..a97e988adde 100644 --- a/gnu/local.mk +++ b/gnu/local.mk | |||
| @@ -864,6 +864,7 @@ INSTALLER_MODULES = \ | |||
| 864 | %D%/installer/final.scm \ | 864 | %D%/installer/final.scm \ |
| 865 | %D%/installer/hardware.scm \ | 865 | %D%/installer/hardware.scm \ |
| 866 | %D%/installer/hostname.scm \ | 866 | %D%/installer/hostname.scm \ |
| 867 | %D%/installer/kernel.scm \ | ||
| 867 | %D%/installer/keymap.scm \ | 868 | %D%/installer/keymap.scm \ |
| 868 | %D%/installer/locale.scm \ | 869 | %D%/installer/locale.scm \ |
| 869 | %D%/installer/newt.scm \ | 870 | %D%/installer/newt.scm \ |
| @@ -882,6 +883,7 @@ INSTALLER_MODULES = \ | |||
| 882 | %D%/installer/newt/final.scm \ | 883 | %D%/installer/newt/final.scm \ |
| 883 | %D%/installer/newt/parameters.scm \ | 884 | %D%/installer/newt/parameters.scm \ |
| 884 | %D%/installer/newt/hostname.scm \ | 885 | %D%/installer/newt/hostname.scm \ |
| 886 | %D%/installer/newt/kernel.scm \ | ||
| 885 | %D%/installer/newt/keymap.scm \ | 887 | %D%/installer/newt/keymap.scm \ |
| 886 | %D%/installer/newt/locale.scm \ | 888 | %D%/installer/newt/locale.scm \ |
| 887 | %D%/installer/newt/menu.scm \ | 889 | %D%/installer/newt/menu.scm \ |
diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm index 283bae6f109..9a351529e84 100644 --- a/gnu/system/hurd.scm +++ b/gnu/system/hurd.scm | |||
| @@ -48,6 +48,7 @@ | |||
| 48 | #:export (%base-packages/hurd | 48 | #:export (%base-packages/hurd |
| 49 | %base-services/hurd | 49 | %base-services/hurd |
| 50 | %base-services+qemu-networking/hurd | 50 | %base-services+qemu-networking/hurd |
| 51 | %desktop-services/hurd | ||
| 51 | %hurd-default-operating-system | 52 | %hurd-default-operating-system |
| 52 | %hurd-default-operating-system-kernel | 53 | %hurd-default-operating-system-kernel |
| 53 | %setuid-programs/hurd)) | 54 | %setuid-programs/hurd)) |
| @@ -107,6 +108,8 @@ | |||
| 107 | %qemu-static-networking)) | 108 | %qemu-static-networking)) |
| 108 | %base-services/hurd)) | 109 | %base-services/hurd)) |
| 109 | 110 | ||
| 111 | (define %desktop-services/hurd %base-services/hurd) | ||
| 112 | |||
| 110 | (define %setuid-programs/hurd | 113 | (define %setuid-programs/hurd |
| 111 | ;; Default set of setuid-root programs. | 114 | ;; Default set of setuid-root programs. |
| 112 | (map file-like->setuid-program | 115 | (map file-like->setuid-program |
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm index 36dbd9111fc..c8dccd38b0e 100644 --- a/gnu/tests/install.scm +++ b/gnu/tests/install.scm | |||
| @@ -3,7 +3,7 @@ | |||
| 3 | ;;; Copyright © 2017, 2019, 2021 Tobias Geerinckx-Rice <me@tobias.gr> | 3 | ;;; Copyright © 2017, 2019, 2021 Tobias Geerinckx-Rice <me@tobias.gr> |
| 4 | ;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com> | 4 | ;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com> |
| 5 | ;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org> | 5 | ;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org> |
| 6 | ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> | 6 | ;;; Copyright © 2020, 2024 Janneke Nieuwenhuizen <janneke@gnu.org> |
| 7 | ;;; Copyright © 2020, 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com> | 7 | ;;; Copyright © 2020, 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com> |
| 8 | ;;; | 8 | ;;; |
| 9 | ;;; This file is part of GNU Guix. | 9 | ;;; This file is part of GNU Guix. |
| @@ -1869,6 +1869,10 @@ build (current-guix) and then store a couple of full system images.") | |||
| 1869 | #$marionette) | 1869 | #$marionette) |
| 1870 | (screenshot "installer-services.ppm") | 1870 | (screenshot "installer-services.ppm") |
| 1871 | 1871 | ||
| 1872 | (when #$(target-x86?) | ||
| 1873 | (marionette-eval* '(choose-kernel installer-socket) #$marionette) | ||
| 1874 | (screenshot "installer-kernel.ppm")) | ||
| 1875 | |||
| 1872 | (marionette-eval* '(choose-services installer-socket | 1876 | (marionette-eval* '(choose-services installer-socket |
| 1873 | #:choose-desktop-environment? | 1877 | #:choose-desktop-environment? |
| 1874 | (const #$desktop?) | 1878 | (const #$desktop?) |
