[PATCH 00/16] Installer support for (cross) installing the Hurd.

index d87e494348..d33dfa6ca7 100644

;;; GNU Guix --- Functional package management for GNU

;;; Copyright © 2017 Ryan Moe <ryan.moe@gmail.com>

;;; Copyright © 2018, 2020-2024 Ludovic Courtès <ludo@gnu.org>

;;; Copyright © 2021 Timotej Lazar <timotej.lazar@araneo.si>

;;; Copyright © 2022 Oleg Pykhalov <go.wigust@gmail.com>

;;; Copyright © 2022 Leo Nikkilä <hello@lnikki.la>

;; /etc/guix/acl file in the childhurd. Thus, clear

;; 'authorize-key?' so that it's not overridden at activation

;; time.

(guix-service-type config =>

(guix-configuration

(inherit config)

diff --git a/gnu/system/examples/bare-hurd.tmpl b/gnu/system/examples/bare-hurd.tmpl

index 463c7ee798..68c6d3c166 100644

;; -*-scheme-*-

;; This is an operating system configuration template

;; To build a disk image for a virtual machine, do

;;

(permit-root-login #t)

(allow-empty-passwords? #t)

(password-authentication? #t)))

%hurd-os

diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm

index 6d6a20cf57..283bae6f10 100644

;;; GNU Guix --- Functional package management for GNU

;;; Copyright © 2020-2024 Ludovic Courtès <ludo@gnu.org>

;;;

;;; This file is part of GNU Guix.

;;;

#:use-module (gnu system vm)

#:export (%base-packages/hurd

%base-services/hurd

%hurd-default-operating-system

%hurd-default-operating-system-kernel

%setuid-programs/hurd))

(define %base-services/hurd

(append (list (service hurd-console-service-type

(hurd-console-configuration (hurd hurd)))

(service guix-service-type

(guix-configuration

(extra-options '("--disable-chroot"

(tty (string-append "tty" (number->string n))))))

(iota 6 1))))

(define %setuid-programs/hurd

;; Default set of setuid-root programs.

(map file-like->setuid-program

diff --git a/gnu/system/images/hurd.scm b/gnu/system/images/hurd.scm

index 9b618f7dc6..01c422a54f 100644

(permit-root-login #t)

(allow-empty-passwords? #t)

(password-authentication? #t)))

(define hurd-initialize-root-partition

#~(lambda* (#:rest args)

--

2.46.0

index 3d2a37a1e2..e6ea920714 100644

fsck --yes --force /

fsysopts / --writable

# Note: this /hurd/ gets substituted

settrans --create /servers/socket/1 /hurd/pflocal

--

2.46.0

index 4407284acb..daf4fb41ab 100644

(define (scope dir)

(string-append root (if (string-suffix? "/" root) "" "/") dir))

;; Don't create /dev/null etc just yet; the store

;; messes-up the permission bits.

;; Don't create /dev/console, /dev/vcs, etc.: they are created by

;; console-run on first boot.

(for-each (lambda (file)

(call-with-output-file (scope (string-append "servers/" file))

(lambda (port)

"kill"

"suspend"))

;; Don't create /servers/socket/1 & co: runsystem does that on first boot.

;; TODO: Set the 'gnu.translator' extended attribute for passive translator

(for-each scope-set-translator servers)

(mkdir* "dev/vcs/1")

(mkdir* "dev/vcs/2")

(for-each scope-set-translator devices)

(false-if-EEXIST (symlink "/dev/random" (scope "dev/urandom")))

(let ((hurd/hurd (readlink* (string-append system "/profile/hurd"))))

(symlink hurd/hurd "/hurd"))

(format #t "Setting-up essential translators...\n")

(setenv "PATH" (string-append system "/profile/bin"))

(set-hurd-device-translators)

--

2.46.0

index 819d063673..7c50bc45b1 100644

#:autoload (guix diagnostics) (warning formatted-message &fix-hint)

#:autoload (guix i18n) (G_)

#:use-module (guix combinators)

#:use-module (gnu services)

#:use-module (gnu services admin)

#:use-module (gnu services shepherd)

(with-imported-modules (source-module-closure '((gnu build file-systems)))

(shepherd-service

(provision (list (swap->shepherd-service-name swap)))

(documentation "Enable the given swap space.")

(modules `((gnu build file-systems)

,@%default-modules))

(let ((device #$device-lookup))

(and device

(begin

#t)))))

(stop #~(lambda _

(let ((device #$device-lookup))

(when device

#f)))

(respawn? #f))))

(description "Turn on the virtual memory swap area.")))

diff --git a/gnu/system.scm b/gnu/system.scm

index 44f93f91d1..187a72cbf5 100644

(let ((host-name (operating-system-host-name os))

(hosts-file (%operating-system-hosts-file os))

(entries (operating-system-directory-base-entries os)))

(service user-processes-service-type)

(account-service (append (operating-system-accounts os)

(service privileged-program-service-type

(append (operating-system-privileged-programs os)

(operating-system-setuid-programs os)))

(define* (operating-system-services os)

"Return all the services of OS, including \"essential\" services."

--

2.46.0

index 5d1b316aa3..6d0c20f5be 100644

%D%/packages/patches/hubbub-sort-entities.patch \

%D%/packages/patches/hueplusplus-mbedtls.patch \

%D%/packages/patches/hurd-rumpdisk-no-hd.patch \

%D%/packages/patches/hwloc-1-test-btrfs.patch \

%D%/packages/patches/i7z-gcc-10.patch \

%D%/packages/patches/icecat-makeicecat.patch \

diff --git a/gnu/packages/hurd.scm b/gnu/packages/hurd.scm

index e6ea920714..9c1681f236 100644

(name "hurd")

(source (origin

(inherit (package-source hurd-headers))

(version (package-version hurd-headers))

(arguments

`(#:tests? #f ;no "check" target

# Note: this /hurd/ gets substituted

settrans --create /servers/socket/1 /hurd/pflocal

# parse multiboot arguments

for i in \"$@\"; do

case $i in

diff --git a/gnu/packages/patches/hurd-startup.patch b/gnu/packages/patches/hurd-startup.patch

new file mode 100644

index 0000000000..0b0dcc9537

--

2.46.0

index daf4fb41ab..23ace25d4f 100644

(let* ((args (command-line))

(system (find-long-option "gnu.system" args))

(unless (file-exists? "/servers/startup")

(format #t "Creating essential device nodes...\n")

(make-hurd-device-nodes))

(format #t "Setting-up essential translators...\n")

(set-hurd-device-translators)

(format #t "Starting pager...\n")

--

2.46.0

index 27e1d62566..ccd6268461 100644

"mumi"

"nss-certs"

"openssl" ;required if using 'smtpEncryption = tls'

--

2.46.0

index 5cd99e4013..3dfcb7581a 100644

(define set-installer-path

;; Add the specified binary to PATH for later use by the installer.

#~(let* ((inputs

cryptsetup

btrfs-progs

nano

shadow

coreutils)))

(with-output-to-port (%make-void-port "w")

(lambda ()

--

2.46.0

index d75a640519..53e440fd60 100644

#:use-module (ice-9 match)

#:use-module (srfi srfi-34)

#:use-module (srfi srfi-35)

#:export (run-ethernet-page))

(define (ethernet-services)

diff --git a/gnu/installer/newt/keymap.scm b/gnu/installer/newt/keymap.scm

index c5d4be6792..109ec55e0a 100644

#:use-module (gnu installer newt page)

#:use-module (guix i18n)

#:use-module (guix records)

#:use-module (srfi srfi-1)

#:use-module (srfi srfi-26)

#:use-module (srfi srfi-34)

diff --git a/gnu/installer/newt/locale.scm b/gnu/installer/newt/locale.scm

index 01171e253f..a226b39ba6 100644

#:use-module (gnu installer steps)

#:use-module (gnu installer newt page)

#:use-module (guix i18n)

#:use-module (srfi srfi-1)

#:use-module (srfi srfi-26)

#:use-module (srfi srfi-34)

diff --git a/gnu/installer/newt/parameters.scm b/gnu/installer/newt/parameters.scm

index 8fb1aa3abb..7c61266e4d 100644

#:use-module (guix build syscalls)

#:use-module (guix i18n)

#:use-module (ice-9 match)

#:export (run-parameters-page))

(define (run-proxy-page)

diff --git a/gnu/installer/newt/services.scm b/gnu/installer/newt/services.scm

index b22024602c..d1035b6524 100644

#:use-module (guix i18n)

#:use-module (srfi srfi-34)

#:use-module (srfi srfi-35)

#:export (run-services-page))

(define (run-desktop-environments-cbt-page)

--

2.46.0

index 3dfcb7581a..3a05843cab 100644

;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>

;;; Copyright © 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>

;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>

;;;

;;; This file is part of GNU Guix.

;;;

(id 'partition)

(description (G_ "Partitioning"))

(compute (lambda _

(configuration-formatter user-partitions->configuration))

(installer-step

diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm

index e1c4453168..6d8ea35fff 100644

;;; GNU Guix --- Functional package management for GNU

;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>

;;;

;;; This file is part of GNU Guix.

;;;

(define (user-page)

(run-user-page))

(run-partitioning-page))

(define (services-page)

(timezone-page timezone-page)

(hostname-page hostname-page)

(user-page user-page)

(services-page services-page)

(welcome-page welcome-page)

(parameters-menu parameters-menu)

diff --git a/gnu/installer/record.scm b/gnu/installer/record.scm

index 5e0264682f..334af44a0c 100644

;;; GNU Guix --- Functional package management for GNU

;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>

;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>

;;;

;;; This file is part of GNU Guix.

;;;

installer-timezone-page

installer-hostname-page

installer-user-page

installer-services-page

installer-welcome-page

installer-parameters-menu

;; procedure void -> void

(user-page installer-user-page)

;; procedure void -> void

;; procedure void -> void

(services-page installer-services-page)

;; procedure (logo #:pci-database) -> void

--

2.46.0

index e1623a51fd..64a2916826 100644

;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>

;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>

;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>

;;;

;;; This file is part of GNU Guix.

;;;

('exit-component

(let ((result

(map (match-lambda

(if (components=? edit argument)

(checkbox-value checkbox))))))

components)))

(destroy-form-and-pop form)

diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm

index 6838410166..c722e9af8f 100644

;;; GNU Guix --- Functional package management for GNU

;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>

;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>

;;;

;;; This file is part of GNU Guix.

;;;

(define (open-new-log-port)

(define now (localtime (time-second (current-time))))

(format #f "/tmp/installer.~a.log"

(strftime "%F.%T" now)))

(define installer-log-port

(let ((port #f))

--

2.46.0

index 3a05843cab..21809e4259 100644

(installer-init current-installer)

(lambda ()

(parameterize

(installer-run-command current-installer)))

(catch #t

(lambda ()

diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm

index dbdec1bba8..e59df3d8e6 100644

;;; Copyright © 2019-2020, 2022, 2024 Ludovic Courtès <ludo@gnu.org>

;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>

;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>

;;;

;;; This file is part of GNU Guix.

;;;

(define (remove-logical-devices)

"Remove all active logical devices."

(define (installer-root-partition-path)

"Return the root partition path, or #f if it could not be detected."

(define (create-btrfs-file-system partition)

"Create a btrfs file-system for PARTITION file-name."

(define (create-ext4-file-system partition)

"Create an ext4 file-system for PARTITION file-name."

;; up and adding new files would fail with ENOSPC despite there being plenty

;; of free space and inodes:

;; <https://blog.merovius.de/posts/2013-10-20-ext4-mysterious-no-space-left-on/>.

"-O" "large_dir"))

(define (create-fat16-file-system partition)

"Create a fat16 file-system for PARTITION file-name."

(define (create-fat32-file-system partition)

"Create a fat32 file-system for PARTITION file-name."

(define (create-jfs-file-system partition)

"Create a JFS file-system for PARTITION file-name."

(define (create-ntfs-file-system partition)

"Create a JFS file-system for PARTITION file-name."

(define (create-xfs-file-system partition)

"Create an XFS file-system for PARTITION file-name."

(define (create-swap-partition partition)

"Set up swap area on PARTITION file-name."

(define (call-with-luks-key-file password proc)

"Write PASSWORD in a temporary file and pass it to PROC as argument."

(lambda (key-file)

(installer-log-line "formatting and opening LUKS entry ~s at ~s"

label file-name)

file-name key-file)

"--key-file" key-file file-name label)))))

(define (luks-ensure-open user-partition)

(lambda (key-file)

(installer-log-line "opening LUKS entry ~s at ~s"

label file-name)

"--key-file" key-file file-name label))))))

(define (luks-close user-partition)

"Close the encrypted partition pointed by USER-PARTITION."

(let ((label (user-partition-crypt-label user-partition)))

(installer-log-line "closing LUKS entry ~s" label)

(define (format-user-partitions user-partitions)

"Format the <user-partition> records in USER-PARTITIONS list with

diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm

index c722e9af8f..170f036537 100644

run-external-command-with-handler/tty

run-external-command-with-line-hooks

run-command

syslog-port

%syslog-line-hook

(pause)

succeeded?)

(make-parameter

(lambda (. args)

(raise

(condition

(&serious)



;;;

--

2.46.0

index 21809e4259..39a83c4455 100644

(define* (compute-locale-step #:key

locales-name

iso639-languages-name

"Return a gexp that run the locale-page of INSTALLER, and install the

selected locale. The list of locales, languages and territories passed to

locale-page are computed in derivations named respectively LOCALES-NAME,

((installer-locale-page current-installer)

#:supported-locales #$locales-loader

#:iso639-languages #$iso639-loader

result))))

(define apply-keymap

(kmscon-update-keymap (default-keyboard-model)

layout variant options))))

"Return a gexp that runs the keymap-page of INSTALLER and install the

selected keymap."

#~(lambda (current-installer)

"/share/X11/xkb/rules/base.xml")))

(lambda (models layouts)

((installer-keymap-page current-installer)

(and result (#$apply-keymap result))

result)))

(let ((locale-step (compute-locale-step

#:locales-name "locales"

#:iso639-languages-name "iso639-languages"

(timezone-data #~(string-append #$tzdata

"/share/zoneinfo/zone.tab")))

#~(lambda (current-installer)

(lambda ()

((installer-parameters-page current-installer)

(lambda _

current-installer)))))

(list

;; Ask the user to choose a locale among those supported by

(id 'keymap)

(description (G_ "Keyboard mapping selection"))

(compute (lambda _

(configuration-formatter keyboard-layout->configuration))

;; Ask the user to input a hostname for the system.

(id 'network)

(description (G_ "Network selection"))

(compute (lambda _

;; Ask whether to enable substitute server discovery.

(installer-step

(id 'substitutes)

(description (G_ "Substitute server discovery"))

(compute (lambda _

;; Prompt for users (name, group and home directory).

(installer-step

(id 'partition)

(description (G_ "Partitioning"))

(compute (lambda _

(configuration-formatter user-partitions->configuration))

(installer-step

(compute

(lambda (result prev-steps)

((installer-final-page current-installer)

(define (provenance-sexp)

"Return an sexp representing the currently-used channels, for logging

`(channel ,(channel-name channel) ,url ,(channel-commit channel))))

channels))))

"Return a file-like object that runs the given INSTALLER."

(define init-gettext

;; Initialize gettext support, so that installer messages can be

(lambda ()

(set-path-environment-variable "PATH" '("bin" "sbin") inputs)))))

(define modules

(scheme-modules*

(string-append (current-source-directory) "/..")

;; Enable core dump generation.

(setrlimit 'core #f #f)

;; Initialize gettext support so that installers can use

;; (guix i18n) module.

(lambda ()

(parameterize

((%run-command-in-installer

(catch #t

(lambda ()

(define results

(run-installer-steps

#:rewind-strategy 'menu

#:menu-proc (installer-menu-page current-installer)

(const #f)

(lambda (key . args)

(installer-log-line "crashing due to uncaught exception: ~s ~s"

diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm

index 6d8ea35fff..d53bc058b3 100644

(term-signal term-sig)

(stop-signal stop-sig)))))))))))

(define* (locale-page #:key

supported-locales

iso639-languages

(run-locale-page

#:supported-locales supported-locales

#:iso639-languages iso639-languages

(define (timezone-page zonetab)

(run-timezone-page zonetab))

(define (menu-page steps)

(run-menu-page steps))

(define (network-page)

(run-network-page))

diff --git a/gnu/installer/newt/final.scm b/gnu/installer/newt/final.scm

index 9f950a0551..c4e53f6d79 100644

;;; GNU Guix --- Functional package management for GNU

;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>

;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>

;;;

;;; This file is part of GNU Guix.

;;;

(newt-resume)

install-ok?))

(define (wait-for-clients)

(unless (null? (current-clients))

(installer-log-line "waiting with clients before starting final step")

(if install-ok?

(run-install-success-page)

(run-install-failed-page))))

diff --git a/gnu/installer/newt/keymap.scm b/gnu/installer/newt/keymap.scm

index 109ec55e0a..57f6d6530c 100644

;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>

;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>

;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>

;;;

;;; This file is part of GNU Guix.

;;;

"grp:alt_shift_toggle"))

(list layout variant #f)))

"Run a page asking the user to select a keyboard layout and variant. LAYOUTS

is a list of supported X11-KEYMAP-LAYOUT. For non-Latin keyboard layouts, a

second layout and toggle options will be added automatically. Return a list

"xkeyboard-config")))))

(toggleable-latin-layout layout variant)))

(layout (result-step result 'layout))

(variant (result-step result 'variant)))

(and layout

diff --git a/gnu/installer/newt/locale.scm b/gnu/installer/newt/locale.scm

index a226b39ba6..0be9db449e 100644

;;; GNU Guix --- Functional package management for GNU

;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>

;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>

;;;

;;; This file is part of GNU Guix.

;;;

(define* (run-locale-page #:key

supported-locales

iso639-languages

"Run a page asking the user to select a locale language and possibly

territory, codeset and modifier. Use SUPPORTED-LOCALES as the list of glibc

available locales. ISO639-LANGUAGES is an association list associating a

;; step, turn the result into a glibc locale string and return it.

(result->locale-string

supported-locales

diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm

index 37656696c1..48dd306080 100644

;;; Copyright © 2018, 2019, 2022 Mathieu Othacehe <m.othacehe@gmail.com>

;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>

;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>

;;;

;;; This file is part of GNU Guix.

;;;

diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm

index e59df3d8e6..b36b238d8b 100644

(define (bootloader-configuration user-partitions)

"Return the bootloader configuration field for USER-PARTITIONS."

(define (user-partition-missing-modules user-partitions)

"Return the list of kernel modules missing from the default set of kernel

diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm

index 0c505e40e4..de0a852f02 100644

;;; GNU Guix --- Functional package management for GNU

;;; Copyright © 2018, 2019 Mathieu Othacehe <m.othacehe@gmail.com>

;;; Copyright © 2020-2022 Ludovic Courtès <ludo@gnu.org>

;;;

;;; This file is part of GNU Guix.

;;;

(define* (run-installer-steps #:key

steps

(rewind-strategy 'previous)

"Run the COMPUTE procedure of all <installer-step> records in STEPS

sequentially, inside a the 'installer-step prompt. When aborted to with a

parameter of 'abort, fallback to a previous install-step, accordingly to the

;; prematurely.

(sigaction SIGPIPE SIG_IGN)

index d5a382606c..8b117d9a20 100644

(name (G_ "DHCP client (dynamic IP address assignment)"))

(type 'network-management)

(snippet '((service dhcp-client-service-type))))

;; Dealing with documents.

(system-service

--

2.46.0

index 39a83c4455..64f6273c55 100644

((installer-hostname-page current-installer))))

(configuration-formatter hostname->configuration))

;; Provide an interface above connmanctl, so that the user can select

;; a network susceptible to acces Internet.

(installer-step

(gnu installer dump)

(gnu installer final)

(gnu installer hostname)

(gnu installer locale)

(gnu installer parted)

(gnu installer services)

(gnu services herd)

(guix i18n)

(guix build 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

;;; GNU Guix --- Functional package management for GNU

;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>

;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>

;;;

;;; This file is part of GNU Guix.

;;;

#:use-module (gnu services herd)

#:use-module (guix build syscalls)

#:use-module (guix build utils)

#:use-module (gnu build accounts)

#:use-module (gnu build install)

#:use-module (gnu build linux-container)

"/tmp/installer-system-init-options"

read))

(const '())))

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

diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm

index d53bc058b3..1fe710340f 100644

#:use-module (gnu installer newt final)

#:use-module (gnu installer newt parameters)

#:use-module (gnu installer newt hostname)

#:use-module (gnu installer newt keymap)

#:use-module (gnu installer newt locale)

#:use-module (gnu installer newt menu)

(define (hostname-page)

(run-hostname-page))

(define (user-page)

(run-user-page))

(exit-error exit-error)

(final-page final-page)

(keymap-page keymap-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

diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm

index 48dd306080..b88393405b 100644

#:use-module (gnu installer newt page)

#:use-module (gnu installer newt utils)

#:use-module (guix i18n)

#:use-module (ice-9 format)

#:use-module (ice-9 match)

#:use-module (srfi srfi-1)

#:title (G_ "File-system type")

#:listbox-items '(btrfs ext4 jfs xfs

swap

;; These lack basic Unix features. Their only use

;; on GNU is for interoperation, e.g., with UEFI.

fat32 fat16 ntfs)

(define (run-page devices)

(let* ((items

`((entire . ,(G_ "Guided - using the entire disk"))

(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

;;; GNU Guix --- Functional package management for GNU

;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>

;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>

;;; Copyright © 2021 Tobias Geerinckx-Rice <me@tobias.gr>

;;; Copyright © 2021 Leo Famulari <leo@famulari.name>

;;;

#:use-module (gnu installer newt page)

#:use-module (gnu installer newt utils)

#:use-module (guix i18n)

#:use-module (srfi srfi-34)

#:use-module (srfi srfi-35)

#:export (run-services-page))

(define (run-desktop-environments-cbt-page)

"Run a page allowing the user to choose between various desktop

environments."

(run-checkbox-tree-page

install. If you select multiple desktop environments here, you will be able \

#:title (G_ "Desktop environment")

#:items items

#:selection (map system-service-recommended? items)

"Run a page allowing the user to select networking services."

(let ((items (filter (lambda (service)

(eq? 'networking (system-service-type service)))

(run-checkbox-tree-page

#:info-text (G_ "You can now select networking services to run on your \

system.")

(let ((items (filter (lambda (service)

(eq? 'document

(system-service-type service)))

(run-checkbox-tree-page

#:info-text (G_ "You can now select the CUPS printing service to run on your \

system.")

(let ((items (filter (lambda (service)

(eq? 'administration

(system-service-type service)))

(run-checkbox-tree-page

#:title (G_ "Console services")

#:info-text (G_ "Select miscellaneous services to run on your \

(define (run-network-management-page)

"Run a page to select among several network management methods."

(run-listbox-selection-page

#:title title

#:info-text (G_ "Choose the method to manage network connections.

client may be enough for a server.")

#:info-textbox-width 70

#:listbox-height 7

#: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

(crypt-password user-partition-crypt-password ; <secret>

(default #f))

(fs-type user-partition-fs-type

(bootable? user-partition-bootable?

(default #f))

(esp? user-partition-esp?

(define (user-fs-type-name fs-type)

"Return the name of FS-TYPE as specified by libparted."

(case fs-type

((ext4) "ext4")

((btrfs) "btrfs")

((fat16) "fat16")

(define (user-fs-type->mount-type fs-type)

"Return the mount type of FS-TYPE."

(case fs-type

((ext4) "ext4")

((btrfs) "btrfs")

((fat16) "vfat")

(and fs-type

(let ((name (filesystem-type-name fs-type)))

(cond

((string=? name "ext4") 'ext4)

((string=? name "btrfs") 'btrfs)

((string=? name "fat16") 'fat16)

(file-name (partition-get-path partition))

(disk-file-name (device-path device))

(fs-type (or (partition-filesystem-user-type partition)

(mount-point (and (esp-partition? partition)

(default-esp-mount-point)))

(bootable? (boot-partition? partition))

(size new-esp-size)

(mount-point (default-esp-mount-point))))

(user-partition

(bootable? #t)

(bios-grub? #t)

(size bios-grub-size))))

`(,@(if start-partition

`(,start-partition)

'())

'()

`(,(user-partition

(fs-type 'swap)

(size swap-size))))

,(user-pa

index 64f6273c55..617578665e 100644

;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu installer)

#:use-module (guix discovery)

#:use-module (guix gexp)

#:use-module (guix modules)

#:use-module (guix utils)

#:use-module (guix ui)

#:use-module ((guix self) #:select (make-config.scm))

#:use-module (ice-9 match)

#:use-module (srfi srfi-1)

#:use-module (web uri)

(define module-to-import?

;; Return true for modules that should be imported. For (gnu system …) and

(execl #$(program-file "installer-real" installer-builder

#:guile guile-3.0-latest)

"installer-real"))))

--

2.46.0

index 5f34ea98a6..06d3b59dc3 100644

;;; Copyright © 2016, 2017, 2021 Alex Kost <alezost@gmail.com>

;;; Copyright © 2016, 2017 Adonay "adfeno" Felipe Nogueira <https://libreplanet.org/wiki/User:Adfeno> <adfeno@openmailbox.org>

;;; Copyright © 2016, 2021 Amirouche <amirouche@hypermove.net>

;;; Copyright © 2017 Andy Wingo <wingo@igalia.com>

;;; Copyright © 2017 David Thompson <davet@gnu.org>

;;; Copyright © 2017, 2018, 2019, 2020 Mathieu Othacehe <m.othacehe@gmail.com>

(substitute* "tests/basic.scm"

((".*spawn-fiber-chain 5000000.*") ""))

(substitute* "tests/channels.scm"

(native-inputs

(list texinfo pkg-config autoconf-2.71 automake libtool

guile-3.0 ;for 'guild compile

--

2.46.0

index 99c58f3812..7989b183ad 100644

;;; Copyright © 2017, 2019 Mathieu Othacehe <m.othacehe@gmail.com>

;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>

;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>

;;; Copyright © 2020 Julien Lepiller <julien@lepiller.eu>

;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>

;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>

#:autoload (guix progress) (progress-reporter/bar

call-with-progress-reporter)

#:use-module ((guix docker) #:select (%docker-image-max-layers))

#:use-module (gnu build image)

#:use-module (gnu build install)

#:autoload (gnu build file-systems)

(delete-file-recursively state)))

(chmod target #o755)

(let ((os-dir (derivation->output-path os-drv))

(format (lift format %store-monad))

(populate (lift2 populate-root-file-system %store-monad)))

--

2.46.0

index 2723eda5f4..c929af691b 100644

;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>

;;; Copyright © 2017 Leo Famulari <leo@famulari.name>

;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe@gmail.com>

;;; Copyright © 2019, 2020 Miguel Ángel Arruga Vivas <rosen644835@gmail.com>

;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>

;;; Copyright © 2020 Stefan <stefan-guix@vodafonemail.de>

#:use-module (guix gexp)

#:use-module (gnu artwork)

#:use-module (gnu bootloader)

#:use-module (gnu system uuid)

#:use-module (gnu system file-systems)

#:use-module (gnu system keyboard)

#:use-module (ice-9 regex)

#:use-module (srfi srfi-1)

#:use-module (srfi srfi-2)

#:export (grub-theme

grub-theme?

grub-theme-image

((or #f (? string?))

#~(format #f "search --file --set ~a" #$file)))))

(define* (make-grub-configuration grub config entries

#:key

(locale #f)

;; IDE driver ("hdX") and those understood by rumpdisk ("wdX"

;; in the "noide" case).

(disk (if (member "noide" arguments) "w" "h"))

#~(format port "

menuentry ~s {

}~%"

#$label

#$kernel

(string-join (list #$@arguments) " " 'prefix)

(string-join (map string-join '#$modules)

"\n module " 'prefix))))

--

2.46.0

index d87e494348..d33dfa6ca7 100644

;;; GNU Guix --- Functional package management for GNU

;;; Copyright © 2017 Ryan Moe <ryan.moe@gmail.com>

;;; Copyright © 2018, 2020-2024 Ludovic Courtès <ludo@gnu.org>

;;; Copyright © 2021 Timotej Lazar <timotej.lazar@araneo.si>

;;; Copyright © 2022 Oleg Pykhalov <go.wigust@gmail.com>

;;; Copyright © 2022 Leo Nikkilä <hello@lnikki.la>

;; /etc/guix/acl file in the childhurd. Thus, clear

;; 'authorize-key?' so that it's not overridden at activation

;; time.

(guix-service-type config =>

(guix-configuration

(inherit config)

diff --git a/gnu/system/examples/bare-hurd.tmpl b/gnu/system/examples/bare-hurd.tmpl

index 463c7ee798..68c6d3c166 100644

;; -*-scheme-*-

;; This is an operating system configuration template

;; To build a disk image for a virtual machine, do

;;

(permit-root-login #t)

(allow-empty-passwords? #t)

(password-authentication? #t)))

%hurd-os

diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm

index 6d6a20cf57..283bae6f10 100644

;;; GNU Guix --- Functional package management for GNU

;;; Copyright © 2020-2024 Ludovic Courtès <ludo@gnu.org>

;;;

;;; This file is part of GNU Guix.

;;;

#:use-module (gnu system vm)

#:export (%base-packages/hurd

%base-services/hurd

%hurd-default-operating-system

%hurd-default-operating-system-kernel

%setuid-programs/hurd))

(define %base-services/hurd

(append (list (service hurd-console-service-type

(hurd-console-configuration (hurd hurd)))

(service guix-service-type

(guix-configuration

(extra-options '("--disable-chroot"

(tty (string-append "tty" (number->string n))))))

(iota 6 1))))

(define %setuid-programs/hurd

;; Default set of setuid-root programs.

(map file-like->setuid-program

diff --git a/gnu/system/images/hurd.scm b/gnu/system/images/hurd.scm

index 9b618f7dc6..01c422a54f 100644

(permit-root-login #t)

(allow-empty-passwords? #t)

(password-authentication? #t)))

(define hurd-initialize-root-partition

#~(lambda* (#:rest args)

--

2.46.0

index d0a57a8807..6201dea4b8 100644

#:autoload (guix diagnostics) (warning formatted-message &fix-hint)

#:autoload (guix i18n) (G_)

#:use-module (guix combinators)

#:use-module (gnu services)

#:use-module (gnu services admin)

#:use-module (gnu services shepherd)

(with-imported-modules (source-module-closure '((gnu build file-systems)))

(shepherd-service

(provision (list (swap->shepherd-service-name swap)))

(documentation "Enable the given swap space.")

(modules `((gnu build file-systems)

,@%default-modules))

(let ((device #$device-lookup))

(and device

(begin

#t)))))

(stop #~(lambda _

(let ((device #$device-lookup))

(when device

#f)))

(respawn? #f))))

(description "Turn on the virtual memory swap area.")))

diff --git a/gnu/system.scm b/gnu/system.scm

index c19730b331..533a4154d6 100644

(let ((host-name (operating-system-host-name os))

(hosts-file (%operating-system-hosts-file os))

(entries (operating-system-directory-base-entries os)))

(service user-processes-service-type)

;; Make sure that privileged-programs activation script

(list `("hosts" ,hosts-file)))

(service hosts-service-type

(local-host-entries host-name)))

(define* (operating-system-services os)

"Return all the services of OS, including \"essential\" services."

--

2.46.0

index 911af88627..0a1357f114 100644

%D%/packages/patches/hubbub-sort-entities.patch \

%D%/packages/patches/hueplusplus-mbedtls.patch \

%D%/packages/patches/hurd-rumpdisk-no-hd.patch \

%D%/packages/patches/hwloc-1-test-btrfs.patch \

%D%/packages/patches/i7z-gcc-10.patch \

%D%/packages/patches/icecat-makeicecat.patch \

diff --git a/gnu/packages/hurd.scm b/gnu/packages/hurd.scm

index e6ea920714..9c1681f236 100644

(name "hurd")

(source (origin

(inherit (package-source hurd-headers))

(version (package-version hurd-headers))

(arguments

`(#:tests? #f ;no "check" target

# Note: this /hurd/ gets substituted

settrans --create /servers/socket/1 /hurd/pflocal

# parse multiboot arguments

for i in \"$@\"; do

case $i in

diff --git a/gnu/packages/patches/hurd-startup.patch b/gnu/packages/patches/hurd-startup.patch

new file mode 100644

index 0000000000..0b0dcc9537

--

2.46.0

index daf4fb41ab..23ace25d4f 100644

(let* ((args (command-line))

(system (find-long-option "gnu.system" args))

(unless (file-exists? "/servers/startup")

(format #t "Creating essential device nodes...\n")

(make-hurd-device-nodes))

(format #t "Setting-up essential translators...\n")

(set-hurd-device-translators)

(format #t "Starting pager...\n")

--

2.46.0

index 27e1d62566..ccd6268461 100644

"mumi"

"nss-certs"

"openssl" ;required if using 'smtpEncryption = tls'

--

2.46.0

index d75a640519..53e440fd60 100644

#:use-module (ice-9 match)

#:use-module (srfi srfi-34)

#:use-module (srfi srfi-35)

#:export (run-ethernet-page))

(define (ethernet-services)

diff --git a/gnu/installer/newt/keymap.scm b/gnu/installer/newt/keymap.scm

index c5d4be6792..109ec55e0a 100644

#:use-module (gnu installer newt page)

#:use-module (guix i18n)

#:use-module (guix records)

#:use-module (srfi srfi-1)

#:use-module (srfi srfi-26)

#:use-module (srfi srfi-34)

diff --git a/gnu/installer/newt/locale.scm b/gnu/installer/newt/locale.scm

index 01171e253f..a226b39ba6 100644

#:use-module (gnu installer steps)

#:use-module (gnu installer newt page)

#:use-module (guix i18n)

#:use-module (srfi srfi-1)

#:use-module (srfi srfi-26)

#:use-module (srfi srfi-34)

diff --git a/gnu/installer/newt/parameters.scm b/gnu/installer/newt/parameters.scm

index 8fb1aa3abb..7c61266e4d 100644

#:use-module (guix build syscalls)

#:use-module (guix i18n)

#:use-module (ice-9 match)

#:export (run-parameters-page))

(define (run-proxy-page)

diff --git a/gnu/installer/newt/services.scm b/gnu/installer/newt/services.scm

index b22024602c..d1035b6524 100644

#:use-module (guix i18n)

#:use-module (srfi srfi-34)

#:use-module (srfi srfi-35)

#:export (run-services-page))

(define (run-desktop-environments-cbt-page)

--

2.46.0

index 5cd99e4013..3dfcb7581a 100644

(define set-installer-path

;; Add the specified binary to PATH for later use by the installer.

#~(let* ((inputs

cryptsetup

btrfs-progs

nano

shadow

coreutils)))

(with-output-to-port (%make-void-port "w")

(lambda ()

--

2.46.0

index 3dfcb7581a..3a05843cab 100644

;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>

;;; Copyright © 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>

;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>

;;;

;;; This file is part of GNU Guix.

;;;

(id 'partition)

(description (G_ "Partitioning"))

(compute (lambda _

(configuration-formatter user-partitions->configuration))

(installer-step

diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm

index e1c4453168..6d8ea35fff 100644

;;; GNU Guix --- Functional package management for GNU

;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>

;;;

;;; This file is part of GNU Guix.

;;;

(define (user-page)

(run-user-page))

(run-partitioning-page))

(define (services-page)

(timezone-page timezone-page)

(hostname-page hostname-page)

(user-page user-page)

(services-page services-page)

(welcome-page welcome-page)

(parameters-menu parameters-menu)

diff --git a/gnu/installer/record.scm b/gnu/installer/record.scm

index 5e0264682f..334af44a0c 100644

;;; GNU Guix --- Functional package management for GNU

;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>

;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>

;;;

;;; This file is part of GNU Guix.

;;;

installer-timezone-page

installer-hostname-page

installer-user-page

installer-services-page

installer-welcome-page

installer-parameters-menu

;; procedure void -> void

(user-page installer-user-page)

;; procedure void -> void

;; procedure void -> void

(services-page installer-services-page)

;; procedure (logo #:pci-database) -> void

--

2.46.0

index e1623a51fd..64a2916826 100644

;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>

;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>

;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>

;;;

;;; This file is part of GNU Guix.

;;;

('exit-component

(let ((result

(map (match-lambda

(if (components=? edit argument)

(checkbox-value checkbox))))))

components)))

(destroy-form-and-pop form)

diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm

index 6838410166..c722e9af8f 100644

;;; GNU Guix --- Functional package management for GNU

;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>

;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>

;;;

;;; This file is part of GNU Guix.

;;;

(define (open-new-log-port)

(define now (localtime (time-second (current-time))))

(format #f "/tmp/installer.~a.log"

(strftime "%F.%T" now)))

(define installer-log-port

(let ((port #f))

--

2.46.0

index 3a05843cab..21809e4259 100644

(installer-init current-installer)

(lambda ()

(parameterize

(installer-run-command current-installer)))

(catch #t

(lambda ()

diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm

index dbdec1bba8..e59df3d8e6 100644

;;; Copyright © 2019-2020, 2022, 2024 Ludovic Courtès <ludo@gnu.org>

;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>

;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>

;;;

;;; This file is part of GNU Guix.

;;;

(define (remove-logical-devices)

"Remove all active logical devices."

(define (installer-root-partition-path)

"Return the root partition path, or #f if it could not be detected."

(define (create-btrfs-file-system partition)

"Create a btrfs file-system for PARTITION file-name."

(define (create-ext4-file-system partition)

"Create an ext4 file-system for PARTITION file-name."

;; up and adding new files would fail with ENOSPC despite there being plenty

;; of free space and inodes:

;; <https://blog.merovius.de/posts/2013-10-20-ext4-mysterious-no-space-left-on/>.

"-O" "large_dir"))

(define (create-fat16-file-system partition)

"Create a fat16 file-system for PARTITION file-name."

(define (create-fat32-file-system partition)

"Create a fat32 file-system for PARTITION file-name."

(define (create-jfs-file-system partition)

"Create a JFS file-system for PARTITION file-name."

(define (create-ntfs-file-system partition)

"Create a JFS file-system for PARTITION file-name."

(define (create-xfs-file-system partition)

"Create an XFS file-system for PARTITION file-name."

(define (create-swap-partition partition)

"Set up swap area on PARTITION file-name."

(define (call-with-luks-key-file password proc)

"Write PASSWORD in a temporary file and pass it to PROC as argument."

(lambda (key-file)

(installer-log-line "formatting and opening LUKS entry ~s at ~s"

label file-name)

file-name key-file)

"--key-file" key-file file-name label)))))

(define (luks-ensure-open user-partition)

(lambda (key-file)

(installer-log-line "opening LUKS entry ~s at ~s"

label file-name)

"--key-file" key-file file-name label))))))

(define (luks-close user-partition)

"Close the encrypted partition pointed by USER-PARTITION."

(let ((label (user-partition-crypt-label user-partition)))

(installer-log-line "closing LUKS entry ~s" label)

(define (format-user-partitions user-partitions)

"Format the <user-partition> records in USER-PARTITIONS list with

diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm

index c722e9af8f..170f036537 100644

run-external-command-with-handler/tty

run-external-command-with-line-hooks

run-command

syslog-port

%syslog-line-hook

(pause)

succeeded?)

(make-parameter

(lambda (. args)

(raise

(condition

(&serious)



;;;

--

2.46.0

index 21809e4259..39a83c4455 100644

(define* (compute-locale-step #:key

locales-name

iso639-languages-name

"Return a gexp that run the locale-page of INSTALLER, and install the

selected locale. The list of locales, languages and territories passed to

locale-page are computed in derivations named respectively LOCALES-NAME,

((installer-locale-page current-installer)

#:supported-locales #$locales-loader

#:iso639-languages #$iso639-loader

result))))

(define apply-keymap

(kmscon-update-keymap (default-keyboard-model)

layout variant options))))

"Return a gexp that runs the keymap-page of INSTALLER and install the

selected keymap."

#~(lambda (current-installer)

"/share/X11/xkb/rules/base.xml")))

(lambda (models layouts)

((installer-keymap-page current-installer)

(and result (#$apply-keymap result))

result)))

(let ((locale-step (compute-locale-step

#:locales-name "locales"

#:iso639-languages-name "iso639-languages"

(timezone-data #~(string-append #$tzdata

"/share/zoneinfo/zone.tab")))

#~(lambda (current-installer)

(lambda ()

((installer-parameters-page current-installer)

(lambda _

current-installer)))))

(list

;; Ask the user to choose a locale among those supported by

(id 'keymap)

(description (G_ "Keyboard mapping selection"))

(compute (lambda _

(configuration-formatter keyboard-layout->configuration))

;; Ask the user to input a hostname for the system.

(id 'network)

(description (G_ "Network selection"))

(compute (lambda _

;; Ask whether to enable substitute server discovery.

(installer-step

(id 'substitutes)

(description (G_ "Substitute server discovery"))

(compute (lambda _

;; Prompt for users (name, group and home directory).

(installer-step

(id 'partition)

(description (G_ "Partitioning"))

(compute (lambda _

(configuration-formatter user-partitions->configuration))

(installer-step

(compute

(lambda (result prev-steps)

((installer-final-page current-installer)

(define (provenance-sexp)

"Return an sexp representing the currently-used channels, for logging

`(channel ,(channel-name channel) ,url ,(channel-commit channel))))

channels))))

"Return a file-like object that runs the given INSTALLER."

(define init-gettext

;; Initialize gettext support, so that installer messages can be

(lambda ()

(set-path-environment-variable "PATH" '("bin" "sbin") inputs)))))

(define modules

(scheme-modules*

(string-append (current-source-directory) "/..")

;; Enable core dump generation.

(setrlimit 'core #f #f)

;; Initialize gettext support so that installers can use

;; (guix i18n) module.

(lambda ()

(parameterize

((%run-command-in-installer

(catch #t

(lambda ()

(define results

(run-installer-steps

#:rewind-strategy 'menu

#:menu-proc (installer-menu-page current-installer)

(const #f)

(lambda (key . args)

(installer-log-line "crashing due to uncaught exception: ~s ~s"

diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm

index 6d8ea35fff..d53bc058b3 100644

(term-signal term-sig)

(stop-signal stop-sig)))))))))))

(define* (locale-page #:key

supported-locales

iso639-languages

(run-locale-page

#:supported-locales supported-locales

#:iso639-languages iso639-languages

(define (timezone-page zonetab)

(run-timezone-page zonetab))

(define (menu-page steps)

(run-menu-page steps))

(define (network-page)

(run-network-page))

diff --git a/gnu/installer/newt/final.scm b/gnu/installer/newt/final.scm

index 9f950a0551..c4e53f6d79 100644

;;; GNU Guix --- Functional package management for GNU

;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>

;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>

;;;

;;; This file is part of GNU Guix.

;;;

(newt-resume)

install-ok?))

(define (wait-for-clients)

(unless (null? (current-clients))

(installer-log-line "waiting with clients before starting final step")

(if install-ok?

(run-install-success-page)

(run-install-failed-page))))

diff --git a/gnu/installer/newt/keymap.scm b/gnu/installer/newt/keymap.scm

index 109ec55e0a..57f6d6530c 100644

;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>

;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>

;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>

;;;

;;; This file is part of GNU Guix.

;;;

"grp:alt_shift_toggle"))

(list layout variant #f)))

"Run a page asking the user to select a keyboard layout and variant. LAYOUTS

is a list of supported X11-KEYMAP-LAYOUT. For non-Latin keyboard layouts, a

second layout and toggle options will be added automatically. Return a list

"xkeyboard-config")))))

(toggleable-latin-layout layout variant)))

(layout (result-step result 'layout))

(variant (result-step result 'variant)))

(and layout

diff --git a/gnu/installer/newt/locale.scm b/gnu/installer/newt/locale.scm

index a226b39ba6..0be9db449e 100644

;;; GNU Guix --- Functional package management for GNU

;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>

;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>

;;;

;;; This file is part of GNU Guix.

;;;

(define* (run-locale-page #:key

supported-locales

iso639-languages

"Run a page asking the user to select a locale language and possibly

territory, codeset and modifier. Use SUPPORTED-LOCALES as the list of glibc

available locales. ISO639-LANGUAGES is an association list associating a

;; step, turn the result into a glibc locale string and return it.

(result->locale-string

supported-locales

diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm

index 37656696c1..48dd306080 100644

;;; Copyright © 2018, 2019, 2022 Mathieu Othacehe <m.othacehe@gmail.com>

;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>

;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>

;;;

;;; This file is part of GNU Guix.

;;;

diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm

index e59df3d8e6..b36b238d8b 100644

(define (bootloader-configuration user-partitions)

"Return the bootloader configuration field for USER-PARTITIONS."

(define (user-partition-missing-modules user-partitions)

"Return the list of kernel modules missing from the default set of kernel

diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm

index 0c505e40e4..de0a852f02 100644

;;; GNU Guix --- Functional package management for GNU

;;; Copyright © 2018, 2019 Mathieu Othacehe <m.othacehe@gmail.com>

;;; Copyright © 2020-2022 Ludovic Courtès <ludo@gnu.org>

;;;

;;; This file is part of GNU Guix.

;;;

(define* (run-installer-steps #:key

steps

(rewind-strategy 'previous)

"Run the COMPUTE procedure of all <installer-step> records in STEPS

sequentially, inside a the 'installer-step prompt. When aborted to with a

parameter of 'abort, fallback to a previous install-step, accordingly to the

;; prematurely.

(sigaction SIGPIPE SIG_IGN)

index d5a382606c..8b117d9a20 100644

(name (G_ "DHCP client (dynamic IP address assignment)"))

(type 'network-management)

(snippet '((service dhcp-client-service-type))))

;; Dealing with documents.

(system-service

--

2.46.0

index 39a83c4455..31c0ff7ff4 100644

((installer-user-page current-installer))))

(configuration-formatter users->configuration))

;; Ask the user to choose one or many desktop environment(s).

(installer-step

(id 'services)

(gnu installer dump)

(gnu installer final)

(gnu installer hostname)

(gnu installer locale)

(gnu installer parted)

(gnu installer services)

(gnu services herd)

(guix i18n)

(guix build 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

;;; GNU Guix --- Functional package management for GNU

;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>

;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>

;;;

;;; This file is part of GNU Guix.

;;;

#:use-module (gnu services herd)

#:use-module (guix build syscalls)

#:use-module (guix build utils)

#:use-module (gnu build accounts)

#:use-module (gnu build install)

#:use-module (gnu build linux-container)

"/tmp/installer-system-init-options"

read))

(const '())))

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..c82b06fb83

diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm

index d53bc058b3..1fe710340f 100644

#:use-module (gnu installer newt final)

#:use-module (gnu installer newt parameters)

#:use-module (gnu installer newt hostname)

#:use-module (gnu installer newt keymap)

#:use-module (gnu installer newt locale)

#:use-module (gnu installer newt menu)

(define (hostname-page)

(run-hostname-page))

(define (user-page)

(run-user-page))

(exit-error exit-error)

(final-page final-page)

(keymap-page keymap-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

diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm

index 48dd306080..b88393405b 100644

#:use-module (gnu installer newt page)

#:use-module (gnu installer newt utils)

#:use-module (guix i18n)

#:use-module (ice-9 format)

#:use-module (ice-9 match)

#:use-module (srfi srfi-1)

#:title (G_ "File-system type")

#:listbox-items '(btrfs ext4 jfs xfs

swap

;; These lack basic Unix features. Their only use

;; on GNU is for interoperation, e.g., with UEFI.

fat32 fat16 ntfs)

(define (run-page devices)

(let* ((items

`((entire . ,(G_ "Guided - using the entire disk"))

(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

;;; GNU Guix --- Functional package management for GNU

;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>

;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>

;;; Copyright © 2021 Tobias Geerinckx-Rice <me@tobias.gr>

;;; Copyright © 2021 Leo Famulari <leo@famulari.name>

;;;

#:use-module (gnu installer newt page)

#:use-module (gnu installer newt utils)

#:use-module (guix i18n)

#:use-module (srfi srfi-34)

#:use-module (srfi srfi-35)

#:export (run-services-page))

(define (run-desktop-environments-cbt-page)

"Run a page allowing the user to choose between various desktop

environments."

(run-checkbox-tree-page

install. If you select multiple desktop environments here, you will be able \

#:title (G_ "Desktop environment")

#:items items

#:selection (map system-service-recommended? items)

"Run a page allowing the user to select networking services."

(let ((items (filter (lambda (service)

(eq? 'networking (system-service-type service)))

(run-checkbox-tree-page

#:info-text (G_ "You can now select networking services to run on your \

system.")

(let ((items (filter (lambda (service)

(eq? 'document

(system-service-type service)))

(run-checkbox-tree-page

#:info-text (G_ "You can now select the CUPS printing service to run on your \

system.")

(let ((items (filter (lambda (service)

(eq? 'administration

(system-service-type service)))

(run-checkbox-tree-page

#:title (G_ "Console services")

#:info-text (G_ "Select miscellaneous services to run on your \

(define (run-network-management-page)

"Run a page to select among several network management methods."

(run-listbox-selection-page

#:title title

#:info-text (G_ "Choose the method to manage network connections.

client may be enough for a server.")

#:info-textbox-width 70

#:listbox-height 7

#: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..dfdd4ed60f 100644

(crypt-password user-partition-crypt-password ; <secret>

(default #f))

(fs-type user-partition-fs-type

(bootable? user-partition-bootable?

(default #f))

(esp? user-partition-esp?

(define (efi-installation?)

"Return #t if an EFI installation should be performed, #f otherwise."

(define (user-fs-type-name fs-type)

"Return the name of FS-TYPE as specified by libparted."

(case fs-type

((ext4) "ext4")

((btrfs) "btrfs")

((fat16) "fat16")

(define (user-fs-type->mount-type fs-type)

"Return the mount type of FS-TYPE."

(case fs-type

((ext4) "ext4")

((btrfs) "btrfs")

((fat16) "vfat")

(and fs-type

(let ((name (filesystem-type-name fs-type)))

(cond

((string=? name "ext4") 'ext4)

((string=? name "btrfs") 'btrfs)

((string=? name "fat16") 'fat16)

(file-name (partition-get-path partition))

(disk-file-name (device-path device))

(fs-type (or (partition-filesystem-user-type partition)

(mount-point (and (esp-partition? partition)

(default-esp-mount-point)))

(bootable? (boot-partition? partition))

(size new-esp-size)

(mount-point (default-esp-mount-point))))

(user-partition

(bootable? #t)

(bios-grub? #t)

(size bios-grub-size))))

index 31c0ff7ff4..981687990a 100644

;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu installer)

#:use-module (guix discovery)

#:use-module (guix gexp)

#:use-module (guix modules)

#:use-module (guix utils)

#:use-module (guix ui)

#:use-module ((guix self) #:select (make-config.scm))

#:use-module (ice-9 match)

#:use-module (srfi srfi-1)

#:use-module (web uri)

(define module-to-import?

;; Return true for modules that should be imported. For (gnu system …) and

(execl #$(program-file "installer-real" installer-builder

#:guile guile-3.0-latest)

"installer-real"))))

--

2.46.0

index 5f34ea98a6..06d3b59dc3 100644

;;; Copyright © 2016, 2017, 2021 Alex Kost <alezost@gmail.com>

;;; Copyright © 2016, 2017 Adonay "adfeno" Felipe Nogueira <https://libreplanet.org/wiki/User:Adfeno> <adfeno@openmailbox.org>

;;; Copyright © 2016, 2021 Amirouche <amirouche@hypermove.net>

;;; Copyright © 2017 Andy Wingo <wingo@igalia.com>

;;; Copyright © 2017 David Thompson <davet@gnu.org>

;;; Copyright © 2017, 2018, 2019, 2020 Mathieu Othacehe <m.othacehe@gmail.com>

(substitute* "tests/basic.scm"

((".*spawn-fiber-chain 5000000.*") ""))

(substitute* "tests/channels.scm"

(native-inputs

(list texinfo pkg-config autoconf-2.71 automake libtool

guile-3.0 ;for 'guild compile

--

Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org

Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com

index 604ba08fee..ddb561d28c 100644

;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>

;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org>

;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net>

;;;

;;; This file is part of GNU Guix.

;;;

(eval #~(parameterize ((current-warning-port (%make-void-port "w")))

(primitive-load #$(install-bootloader-program installer

disk-installer

bootcfg

bootcfg-file

devices

--

Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org

Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com

index 2723eda5f4..ef516b1e13 100644

;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>

;;; Copyright © 2017 Leo Famulari <leo@famulari.name>

;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe@gmail.com>

;;; Copyright © 2019, 2020 Miguel Ángel Arruga Vivas <rosen644835@gmail.com>

;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>

;;; Copyright © 2020 Stefan <stefan-guix@vodafonemail.de>

#:use-module (guix gexp)

#:use-module (gnu artwork)

#:use-module (gnu bootloader)

#:use-module (gnu system uuid)

#:use-module (gnu system file-systems)

#:use-module (gnu system keyboard)

#:use-module (ice-9 regex)

#:use-module (srfi srfi-1)

#:use-module (srfi srfi-2)

#:export (grub-theme

grub-theme?

grub-theme-image

((or #f (? string?))

#~(format #f "search --file --set ~a" #$file)))))

(define* (make-grub-configuration grub config entries

#:key

(locale #f)

;; IDE driver ("hdX") and those understood by rumpdisk ("wdX"

;; in the "noide" case).

(disk (if (member "noide" arguments) "w" "h"))

#~(format port "

menuentry ~s {

}~%"

#$label

#$kernel

(string-join (list #$@arguments) " " 'prefix)

(string-join (map string-join '#$modules)

"\n module " 'prefix))))

diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm

index 41e1c9e282..6fd9f95093 100644

;;; Copyright © 2022 Oleg Pykhalov <go.wigust@gmail.com>

;;; Copyright © 2024 Nicolas Graves <ngraves@ngraves.fr>

;;; Copyright © 2024 Richard Sent <richard@freakingpenguin.com>

;;;

;;; This file is part of GNU Guix.

;;;

find-partition-by-luks-uuid

canonicalize-device-spec

read-partition-label

read-partition-uuid

read-luks-partition-uuid

(or (file-system-mount-may-fail? fs)

(apply throw args))))))

;;; file-systems.scm ends here

--

Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org

Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com

index 99c58f3812..7989b183ad 100644

;;; Copyright © 2017, 2019 Mathieu Othacehe <m.othacehe@gmail.com>

;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>

;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>

;;; Copyright © 2020 Julien Lepiller <julien@lepiller.eu>

;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>

;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>

#:autoload (guix progress) (progress-reporter/bar

call-with-progress-reporter)

#:use-module ((guix docker) #:select (%docker-image-max-layers))

#:use-module (gnu build image)

#:use-module (gnu build install)

#:autoload (gnu build file-systems)

(delete-file-recursively state)))

(chmod target #o755)

(let ((os-dir (derivation->output-path os-drv))

(format (lift format %store-monad))

(populate (lift2 populate-root-file-system %store-monad)))

--

Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org

Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com

index d87e494348..d33dfa6ca7 100644

;;; GNU Guix --- Functional package management for GNU

;;; Copyright © 2017 Ryan Moe <ryan.moe@gmail.com>

;;; Copyright © 2018, 2020-2024 Ludovic Courtès <ludo@gnu.org>

;;; Copyright © 2021 Timotej Lazar <timotej.lazar@araneo.si>

;;; Copyright © 2022 Oleg Pykhalov <go.wigust@gmail.com>

;;; Copyright © 2022 Leo Nikkilä <hello@lnikki.la>

;; /etc/guix/acl file in the childhurd. Thus, clear

;; 'authorize-key?' so that it's not overridden at activation

;; time.

(guix-service-type config =>

(guix-configuration

(inherit config)

diff --git a/gnu/system/examples/bare-hurd.tmpl b/gnu/system/examples/bare-hurd.tmpl

index 463c7ee798..68c6d3c166 100644

;; -*-scheme-*-

;; This is an operating system configuration template

;; To build a disk image for a virtual machine, do

;;

(permit-root-login #t)

(allow-empty-passwords? #t)

(password-authentication? #t)))

%hurd-os

diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm

index 6d6a20cf57..283bae6f10 100644

;;; GNU Guix --- Functional package management for GNU

;;; Copyright © 2020-2024 Ludovic Courtès <ludo@gnu.org>

;;;

;;; This file is part of GNU Guix.

;;;

#:use-module (gnu system vm)

#:export (%base-packages/hurd

%base-services/hurd

%hurd-default-operating-system

%hurd-default-operating-system-kernel

%setuid-programs/hurd))

(define %base-services/hurd

(append (list (service hurd-console-service-type

(hurd-console-configuration (hurd hurd)))

(service guix-service-type

(guix-configuration

(extra-options '("--disable-chroot"

(tty (string-append "tty" (number->string n))))))

(iota 6 1))))

(define %setuid-programs/hurd

;; Default set of setuid-root programs.

(map file-like->setuid-program

diff --git a/gnu/system/images/hurd.scm b/gnu/system/images/hurd.scm

index 9b618f7dc6..01c422a54f 100644

(permit-root-login #t)

(allow-empty-passwords? #t)

(password-authentication? #t)))

(define hurd-initialize-root-partition

#~(lambda* (#:rest args)

--

Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org

Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com

index d0a57a8807..6201dea4b8 100644

#:autoload (guix diagnostics) (warning formatted-message &fix-hint)

#:autoload (guix i18n) (G_)

#:use-module (guix combinators)

#:use-module (gnu services)

#:use-module (gnu services admin)

#:use-module (gnu services shepherd)

(with-imported-modules (source-module-closure '((gnu build file-systems)))

(shepherd-service

(provision (list (swap->shepherd-service-name swap)))

(documentation "Enable the given swap space.")

(modules `((gnu build file-systems)

,@%default-modules))

(let ((device #$device-lookup))

(and device

(begin

#t)))))

(stop #~(lambda _

(let ((device #$device-lookup))

(when device

#f)))

(respawn? #f))))

(description "Turn on the virtual memory swap area.")))

diff --git a/gnu/system.scm b/gnu/system.scm

index c19730b331..533a4154d6 100644

(let ((host-name (operating-system-host-name os))

(hosts-file (%operating-system-hosts-file os))

(entries (operating-system-directory-base-entries os)))

(service user-processes-service-type)

;; Make sure that privileged-programs activation script

(list `("hosts" ,hosts-file)))

(service hosts-service-type

(local-host-entries host-name)))

(define* (operating-system-services os)

"Return all the services of OS, including \"essential\" services."

--

Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org

Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com

index daf4fb41ab..23ace25d4f 100644

(let* ((args (command-line))

(system (find-long-option "gnu.system" args))

(unless (file-exists? "/servers/startup")

(format #t "Creating essential device nodes...\n")

(make-hurd-device-nodes))

(format #t "Setting-up essential translators...\n")

(set-hurd-device-translators)

(format #t "Starting pager...\n")

--

Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org

Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com

index 1040b3927b..872e55eb41 100644

%D%/packages/patches/hubbub-sort-entities.patch \

%D%/packages/patches/hueplusplus-mbedtls.patch \

%D%/packages/patches/hurd-rumpdisk-no-hd.patch \

%D%/packages/patches/hwloc-1-test-btrfs.patch \

%D%/packages/patches/i7z-gcc-10.patch \

%D%/packages/patches/icecat-makeicecat.patch \

diff --git a/gnu/packages/hurd.scm b/gnu/packages/hurd.scm

index e6ea920714..9c1681f236 100644

(name "hurd")

(source (origin

(inherit (package-source hurd-headers))

(version (package-version hurd-headers))

(arguments

`(#:tests? #f ;no "check" target

# Note: this /hurd/ gets substituted

settrans --create /servers/socket/1 /hurd/pflocal

# parse multiboot arguments

for i in \"$@\"; do

case $i in

diff --git a/gnu/packages/patches/hurd-startup.patch b/gnu/packages/patches/hurd-startup.patch

new file mode 100644

index 0000000000..0b0dcc9537

--

Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org

Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com

index 27e1d62566..ccd6268461 100644

"mumi"

"nss-certs"

"openssl" ;required if using 'smtpEncryption = tls'

--

Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org

Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com

index d75a640519..53e440fd60 100644

#:use-module (ice-9 match)

#:use-module (srfi srfi-34)

#:use-module (srfi srfi-35)

#:export (run-ethernet-page))

(define (ethernet-services)

diff --git a/gnu/installer/newt/keymap.scm b/gnu/installer/newt/keymap.scm

index c5d4be6792..109ec55e0a 100644

#:use-module (gnu installer newt page)

#:use-module (guix i18n)

#:use-module (guix records)

#:use-module (srfi srfi-1)

#:use-module (srfi srfi-26)

#:use-module (srfi srfi-34)

diff --git a/gnu/installer/newt/locale.scm b/gnu/installer/newt/locale.scm

index 01171e253f..a226b39ba6 100644

#:use-module (gnu installer steps)

#:use-module (gnu installer newt page)

#:use-module (guix i18n)

#:use-module (srfi srfi-1)

#:use-module (srfi srfi-26)

#:use-module (srfi srfi-34)

diff --git a/gnu/installer/newt/parameters.scm b/gnu/installer/newt/parameters.scm

index 8fb1aa3abb..7c61266e4d 100644

#:use-module (guix build syscalls)

#:use-module (guix i18n)

#:use-module (ice-9 match)

#:export (run-parameters-page))

(define (run-proxy-page)

diff --git a/gnu/installer/newt/services.scm b/gnu/installer/newt/services.scm

index b22024602c..d1035b6524 100644

#:use-module (guix i18n)

#:use-module (srfi srfi-34)

#:use-module (srfi srfi-35)

#:export (run-services-page))

(define (run-desktop-environments-cbt-page)

--

Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org

Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com