diff options
Diffstat (limited to 'gnu/system')
| -rw-r--r-- | gnu/system/file-systems.scm | 5 | ||||
| -rw-r--r-- | gnu/system/hurd.scm | 2 | ||||
| -rw-r--r-- | gnu/system/image.scm | 68 | ||||
| -rw-r--r-- | gnu/system/images/hurd.scm | 2 | ||||
| -rw-r--r-- | gnu/system/images/novena.scm | 2 | ||||
| -rw-r--r-- | gnu/system/images/pine64.scm | 2 | ||||
| -rw-r--r-- | gnu/system/images/pinebook-pro.scm | 2 | ||||
| -rw-r--r-- | gnu/system/images/rock64.scm | 2 | ||||
| -rw-r--r-- | gnu/system/install.scm | 256 | ||||
| -rw-r--r-- | gnu/system/linux-container.scm | 3 | ||||
| -rw-r--r-- | gnu/system/mapped-devices.scm | 53 |
11 files changed, 220 insertions, 177 deletions
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm index 437f8da898..f8f4276283 100644 --- a/gnu/system/file-systems.scm +++ b/gnu/system/file-systems.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013-2021 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013-2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2020 Google LLC ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net> ;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com> @@ -272,7 +272,8 @@ flags are found." ;; Note: If we have (guix store database) in the search path and we do *not* ;; have (guix store) proper, 'resolve-module' returns an empty (guix store) ;; with one sub-module. - (cond ((and=> (resolve-module '(guix store) #:ensure #f) + (cond ((and=> (parameterize ((current-warning-port (%make-void-port "w0"))) + (resolve-module '(guix store) #:ensure #f)) (lambda (store) (module-variable store '%store-prefix))) => diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm index 8e95d0a16c..4bc32d9bd1 100644 --- a/gnu/system/hurd.scm +++ b/gnu/system/hurd.scm @@ -119,7 +119,7 @@ (bootloader grub-minimal-bootloader) (targets '("/dev/vda")))) (initrd #f) - (initrd-modules (lambda _ '())) + (initrd-modules '()) (firmware '()) (host-name "guixygnu") (file-systems '()) diff --git a/gnu/system/image.scm b/gnu/system/image.scm index 42e215f614..f02f6e0b8c 100644 --- a/gnu/system/image.scm +++ b/gnu/system/image.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2020, 2021 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> +;;; Copyright © 2022 Pavel Shlyak <p.shlyak@pantherx.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -31,7 +32,7 @@ #:use-module (gnu bootloader) #:use-module (gnu bootloader grub) #:use-module (gnu image) - #:use-module (gnu platform) + #:use-module (guix platform) #:use-module (gnu services) #:use-module (gnu services base) #:use-module (gnu system) @@ -218,7 +219,8 @@ set to the given OS." #$(partition-file-system-options partition) #$(partition-label partition) #$(and=> (partition-uuid partition) - uuid-bytevector))) + uuid-bytevector) + #$(partition-flags partition))) (define gcrypt-sqlite3&co ;; Guile-Gcrypt, Guile-SQLite3, and their propagated inputs. @@ -295,27 +297,49 @@ used in the image." ;; the hdimage format (raw disk-image) is supported. (cond ((memq format '(disk-image compressed-qcow2)) "hdimage") - (else - (raise (condition - (&message - (message - (format #f (G_ "Unsupported image type ~a~%.") format)))))))) + (else + (raise (condition + (&message + (message + (format #f (G_ "unsupported image type: ~a") + format)))))))) (define (partition->dos-type partition) ;; Return the MBR partition type corresponding to the given PARTITION. ;; See: https://en.wikipedia.org/wiki/Partition_type. - (let ((flags (partition-flags partition))) + (let ((flags (partition-flags partition)) + (file-system (partition-file-system partition))) (cond ((member 'esp flags) "0xEF") - (else "0x83")))) + ((string-prefix? "ext" file-system) "0x83") + ((or (string=? file-system "vfat") + (string=? file-system "fat16")) "0x0E") + ((string=? file-system "fat32") "0x0C") + (else + (raise (condition + (&message + (message + (format #f (G_ "unsupported partition type: ~a") + file-system))))))))) (define (partition->gpt-type partition) - ;; Return the genimage GPT partition type code corresponding to PARTITION. - ;; See https://github.com/pengutronix/genimage/blob/master/README.rst - (let ((flags (partition-flags partition))) + ;; Return the genimage GPT partition type code corresponding to the + ;; given PARTITION. See: + ;; https://github.com/pengutronix/genimage/blob/master/README.rst + (let ((flags (partition-flags partition)) + (file-system (partition-file-system partition))) (cond - ((member 'esp flags) "U") - (else "L")))) + ((member 'esp flags) "U") + ((string-prefix? "ext" file-system) "L") + ((or (string=? file-system "vfat") + (string=? file-system "fat16") + (string=? file-system "fat32")) "F") + (else + (raise (condition + (&message + (message + (format #f (G_ "unsupported partition type: ~a") + file-system))))))))) (define (partition-image partition) ;; Return as a file-like object, an image of the given PARTITION. A @@ -382,24 +406,28 @@ used in the image." (partition-type-values image partition))) (let ((label (partition-label partition)) (image (partition-image partition)) - (offset (partition-offset partition))) + (offset (partition-offset partition)) + (bootable (if (memq 'boot (partition-flags partition)) + "true" "false" ))) #~(format #f "~/partition ~a { ~/~/~a = ~a ~/~/image = \"~a\" ~/~/offset = \"~a\" + ~/~/bootable = \"~a\" ~/}" #$label #$partition-type-attribute #$partition-type-value #$image - #$offset)))) + #$offset + #$bootable)))) (define (genimage-type-options image-type image) (cond - ((equal? image-type "hdimage") - (format #f "~%~/~/gpt = ~a~%~/" - (if (gpt-image? image) "true" "false"))) - (else ""))) + ((equal? image-type "hdimage") + (format #f "~%~/~/gpt = ~a~%~/" + (if (gpt-image? image) "true" "false"))) + (else ""))) (let* ((format (image-format image)) (image-type (format->image-type format)) diff --git a/gnu/system/images/hurd.scm b/gnu/system/images/hurd.scm index 4c38c46a89..6da09b855a 100644 --- a/gnu/system/images/hurd.scm +++ b/gnu/system/images/hurd.scm @@ -23,7 +23,7 @@ #:use-module (gnu bootloader grub) #:use-module (gnu image) #:use-module (gnu packages ssh) - #:use-module (gnu platforms hurd) + #:use-module (guix platforms x86) #:use-module (gnu services) #:use-module (gnu services ssh) #:use-module (gnu system) diff --git a/gnu/system/images/novena.scm b/gnu/system/images/novena.scm index 5b625e56c5..b9ff6dcfea 100644 --- a/gnu/system/images/novena.scm +++ b/gnu/system/images/novena.scm @@ -22,7 +22,7 @@ #:use-module (gnu bootloader u-boot) #:use-module (gnu image) #:use-module (gnu packages linux) - #:use-module (gnu platforms arm) + #:use-module (guix platforms arm) #:use-module (gnu services) #:use-module (gnu services base) #:use-module (gnu system) diff --git a/gnu/system/images/pine64.scm b/gnu/system/images/pine64.scm index aaec458766..99c4ed6ceb 100644 --- a/gnu/system/images/pine64.scm +++ b/gnu/system/images/pine64.scm @@ -21,7 +21,7 @@ #:use-module (gnu bootloader u-boot) #:use-module (gnu image) #:use-module (gnu packages linux) - #:use-module (gnu platforms arm) + #:use-module (guix platforms arm) #:use-module (gnu services) #:use-module (gnu services base) #:use-module (gnu system) diff --git a/gnu/system/images/pinebook-pro.scm b/gnu/system/images/pinebook-pro.scm index 1bfac7a8bb..7e8910427e 100644 --- a/gnu/system/images/pinebook-pro.scm +++ b/gnu/system/images/pinebook-pro.scm @@ -21,7 +21,7 @@ #:use-module (gnu bootloader u-boot) #:use-module (gnu image) #:use-module (gnu packages linux) - #:use-module (gnu platforms arm) + #:use-module (guix platforms arm) #:use-module (gnu services) #:use-module (gnu services base) #:use-module (gnu system) diff --git a/gnu/system/images/rock64.scm b/gnu/system/images/rock64.scm index d25d55e528..68cb65f115 100644 --- a/gnu/system/images/rock64.scm +++ b/gnu/system/images/rock64.scm @@ -21,7 +21,7 @@ #:use-module (gnu bootloader u-boot) #:use-module (gnu image) #:use-module (gnu packages linux) - #:use-module (gnu platforms arm) + #:use-module (guix platforms arm) #:use-module (gnu services) #:use-module (gnu services base) #:use-module (gnu services networking) diff --git a/gnu/system/install.scm b/gnu/system/install.scm index 073d7df1db..a3646b1d54 100644 --- a/gnu/system/install.scm +++ b/gnu/system/install.scm @@ -1,11 +1,12 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014-2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2016 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com> ;;; Copyright © 2017, 2019 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de> ;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il> +;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz> ;;; ;;; This file is part of GNU Guix. ;;; @@ -31,8 +32,10 @@ #:use-module (guix store) #:use-module (guix monads) #:use-module (guix modules) - #:use-module ((guix packages) #:select (package-version)) + #:use-module ((guix packages) #:select (package-version supported-package?)) + #:use-module (guix platform) #:use-module ((guix store) #:select (%store-prefix)) + #:use-module (guix utils) #:use-module (gnu installer) #:use-module (gnu system locale) #:use-module (gnu services avahi) @@ -252,7 +255,9 @@ the user's target storage device rather than on the RAM disk." (service-type (name 'configuration-template) (extensions (list (service-extension etc-service-type - /etc/configuration-files))))) + /etc/configuration-files))) + (description "Install the operating system configuration file +templates under @file{/etc/configuration}."))) (define %configuration-template-service (service configuration-template-service-type #t)) @@ -281,11 +286,7 @@ the user's target storage device rather than on the RAM disk." (provision '(maybe-uvesafb)) (requirement '(file-systems)) (start #~(lambda () - ;; uvesafb is only supported on x86 and x86_64. - (or (not (and (string-suffix? "linux-gnu" %host-type) - (or (string-prefix? "x86_64" %host-type) - (string-prefix? "i686" %host-type)))) - (file-exists? "/dev/fb0") + (or (file-exists? "/dev/fb0") (invoke #+(file-append kmod "/bin/modprobe") "uvesafb" (string-append "v86d=" #$v86d "/sbin/v86d") @@ -303,7 +304,10 @@ the user's target storage device rather than on the RAM disk." "Load the @code{uvesafb} kernel module with the right options.") (default-value #t))) -(define %installation-services +(define* (%installation-services #:key (system (or (and=> + (%current-target-system) + platform-target->system) + (%current-system)))) ;; List of services of the installation system. (let ((motd (plain-file "motd" " \x1b[1;37mWelcome to the installation of GNU Guix!\x1b[0m @@ -320,119 +324,125 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m (define bare-bones-os (load "examples/bare-bones.tmpl")) - (list (service virtual-terminal-service-type) - - (service kmscon-service-type - (kmscon-configuration - (virtual-terminal "tty1") - (login-program (installer-program)))) - - (login-service (login-configuration - (motd motd))) - - ;; Documentation. The manual is in UTF-8, but - ;; 'console-font-service' sets up Unicode support and loads a font - ;; with all the useful glyphs like em dash and quotation marks. - (service documentation-service-type "tty2") - - ;; Documentation add-on. - %configuration-template-service - - ;; A bunch of 'root' ttys. - (normal-tty "tty3") - (normal-tty "tty4") - (normal-tty "tty5") - (normal-tty "tty6") - - ;; The usual services. - (syslog-service) - - ;; Use the Avahi daemon to discover substitute servers on the local - ;; network. It can be faster than fetching from remote servers. - (service avahi-service-type) - - ;; The build daemon. Register the default substitute server key(s) - ;; as trusted to allow the installation process to use substitutes by - ;; default. - (service guix-service-type - (guix-configuration (authorize-key? #t))) - - ;; Start udev so that useful device nodes are available. - ;; Use device-mapper rules for cryptsetup & co; enable the CRDA for - ;; regulations-compliant WiFi access. - (udev-service #:rules (list lvm2 crda)) - - ;; Add the 'cow-store' service, which users have to start manually - ;; since it takes the installation directory as an argument. - (cow-store-service) - - ;; Install Unicode support and a suitable font. - (service console-font-service-type - (map (match-lambda - ("tty2" - ;; Use a font that contains characters such as - ;; curly quotes as found in the manual. - '("tty2" . "LatGrkCyr-8x16")) - (tty - ;; Use a font that doesn't have more than 256 - ;; glyphs so that we can use colors with varying - ;; brightness levels (see note in setfont(8)). - `(,tty . "lat9u-16"))) - '("tty1" "tty2" "tty3" "tty4" "tty5" "tty6"))) - - ;; To facilitate copy/paste. - (service gpm-service-type) - - ;; Add an SSH server to facilitate remote installs. - (service openssh-service-type - (openssh-configuration - (port-number 22) - (permit-root-login #t) - ;; The root account is passwordless, so make sure - ;; a password is set before allowing logins. - (allow-empty-passwords? #f) - (password-authentication? #t) - - ;; Don't start it upfront. - (%auto-start? #f))) - - ;; Since this is running on a USB stick with a overlayfs as the root - ;; file system, use an appropriate cache configuration. - (nscd-service (nscd-configuration - (caches %nscd-minimal-caches))) - - ;; Having /bin/sh is a good idea. In particular it allows Tramp - ;; connections to this system to work. - (service special-files-service-type - `(("/bin/sh" ,(file-append bash "/bin/sh")))) - - ;; Loopback device, needed by OpenSSH notably. - (service static-networking-service-type - (list %loopback-static-networking)) - - (service wpa-supplicant-service-type) - (dbus-service) - (service connman-service-type - (connman-configuration - (disable-vpn? #t))) - - ;; Keep a reference to BARE-BONES-OS to make sure it can be - ;; installed without downloading/building anything. Also keep the - ;; things needed by 'profile-derivation' to minimize the amount of - ;; download. - (service gc-root-service-type - (append - (list bare-bones-os - glibc-utf8-locales - texinfo - guile-3.0) - %default-locale-libcs)) - - ;; Machines without Kernel Mode Setting (those with many old and - ;; current AMD GPUs, SiS GPUs, ...) need uvesafb to show the GUI - ;; installer. Some may also need a kernel parameter like nomodeset - ;; or vga=793, but we leave that for the user to specify in GRUB. - (service uvesafb-service-type)))) + (append + ;; Generic services + (list (service virtual-terminal-service-type) + + (service kmscon-service-type + (kmscon-configuration + (virtual-terminal "tty1") + (login-program (installer-program)))) + + (login-service (login-configuration + (motd motd))) + + ;; Documentation. The manual is in UTF-8, but + ;; 'console-font-service' sets up Unicode support and loads a font + ;; with all the useful glyphs like em dash and quotation marks. + (service documentation-service-type "tty2") + + ;; Documentation add-on. + %configuration-template-service + + ;; A bunch of 'root' ttys. + (normal-tty "tty3") + (normal-tty "tty4") + (normal-tty "tty5") + (normal-tty "tty6") + + ;; The usual services. + (syslog-service) + + ;; Use the Avahi daemon to discover substitute servers on the local + ;; network. It can be faster than fetching from remote servers. + (service avahi-service-type) + + ;; The build daemon. Register the default substitute server key(s) + ;; as trusted to allow the installation process to use substitutes by + ;; default. + (service guix-service-type + (guix-configuration (authorize-key? #t))) + + ;; Start udev so that useful device nodes are available. + ;; Use device-mapper rules for cryptsetup & co; enable the CRDA for + ;; regulations-compliant WiFi access. + (udev-service #:rules (list lvm2 crda)) + + ;; Add the 'cow-store' service, which users have to start manually + ;; since it takes the installation directory as an argument. + (cow-store-service) + + ;; Install Unicode support and a suitable font. + (service console-font-service-type + (map (match-lambda + ("tty2" + ;; Use a font that contains characters such as + ;; curly quotes as found in the manual. + '("tty2" . "LatGrkCyr-8x16")) + (tty + ;; Use a font that doesn't have more than 256 + ;; glyphs so that we can use colors with varying + ;; brightness levels (see note in setfont(8)). + `(,tty . "lat9u-16"))) + '("tty1" "tty2" "tty3" "tty4" "tty5" "tty6"))) + + ;; To facilitate copy/paste. + (service gpm-service-type) + + ;; Add an SSH server to facilitate remote installs. + (service openssh-service-type + (openssh-configuration + (port-number 22) + (permit-root-login #t) + ;; The root account is passwordless, so make sure + ;; a password is set before allowing logins. + (allow-empty-passwords? #f) + (password-authentication? #t) + + ;; Don't start it upfront. + (%auto-start? #f))) + + ;; Since this is running on a USB stick with a overlayfs as the root + ;; file system, use an appropriate cache configuration. + (nscd-service (nscd-configuration + (caches %nscd-minimal-caches))) + + ;; Having /bin/sh is a good idea. In particular it allows Tramp + ;; connections to this system to work. + (service special-files-service-type + `(("/bin/sh" ,(file-append bash "/bin/sh")))) + + ;; Loopback device, needed by OpenSSH notably. + (service static-networking-service-type + (list %loopback-static-networking)) + + (service wpa-supplicant-service-type) + (dbus-service) + (service connman-service-type + (connman-configuration + (disable-vpn? #t))) + + ;; Keep a reference to BARE-BONES-OS to make sure it can be + ;; installed without downloading/building anything. Also keep the + ;; things needed by 'profile-derivation' to minimize the amount of + ;; download. + (service gc-root-service-type + (append + (list bare-bones-os + glibc-utf8-locales + texinfo + guile-3.0) + %default-locale-libcs))) + + ;; Specific system services + + ;; Machines without Kernel Mode Setting (those with many old and + ;; current AMD GPUs, SiS GPUs, ...) need uvesafb to show the GUI + ;; installer. Some may also need a kernel parameter like nomodeset + ;; or vga=793, but we leave that for the user to specify in GRUB. + `(,@(if (supported-package? v86d system) + (list (service uvesafb-service-type)) + '()))))) (define %issue ;; Greeting. @@ -496,7 +506,7 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m (comment "Guest of GNU")))) (issue %issue) - (services %installation-services) + (services (%installation-services)) ;; We don't need setuid programs, except for 'passwd', which can be handy ;; if one is to allow remote SSH login to the machine being installed. diff --git a/gnu/system/linux-container.scm b/gnu/system/linux-container.scm index eeb0f68c02..24077e347a 100644 --- a/gnu/system/linux-container.scm +++ b/gnu/system/linux-container.scm @@ -129,8 +129,7 @@ containerized OS. EXTRA-FILE-SYSTEMS is a list of file systems to add to OS." static-networking-service-type dhcp-client-service-type network-manager-service-type - connman-service-type - wicd-service-type) + connman-service-type) (list)))) (define services-to-add diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm index 96a381d5fe..e6b8970c12 100644 --- a/gnu/system/mapped-devices.scm +++ b/gnu/system/mapped-devices.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014-2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2017, 2018 Mark H Weaver <mhw@netris.org> ;;; @@ -202,7 +202,8 @@ option of @command{guix system}.\n") ;; XXX: 'use-modules' should be at the top level. (use-modules (rnrs bytevectors) ;bytevector? ((gnu build file-systems) - #:select (find-partition-by-luks-uuid)) + #:select (find-partition-by-luks-uuid + system*/tty)) ((guix build utils) #:select (mkdir-p))) ;; Create '/run/cryptsetup/' if it does not exist, as device locking @@ -211,28 +212,32 @@ option of @command{guix system}.\n") ;; Use 'cryptsetup-static', not 'cryptsetup', to avoid pulling the ;; whole world inside the initrd (for when we're in an initrd). - (zero? (system* #$(file-append cryptsetup-static "/sbin/cryptsetup") - "open" "--type" "luks" - - ;; Note: We cannot use the "UUID=source" syntax here - ;; because 'cryptsetup' implements it by searching the - ;; udev-populated /dev/disk/by-id directory but udev may - ;; be unavailable at the time we run this. - (if (bytevector? source) - (or (let loop ((tries-left 10)) - (and (positive? tries-left) - (or (find-partition-by-luks-uuid source) - ;; If the underlying partition is - ;; not found, try again after - ;; waiting a second, up to ten - ;; times. FIXME: This should be - ;; dealt with in a more robust way. - (begin (sleep 1) - (loop (- tries-left 1)))))) - (error "LUKS partition not found" source)) - source) - - #$target))))))) + ;; 'cryptsetup open' requires standard input to be a tty to allow + ;; for interaction but shepherd sets standard input to /dev/null; + ;; thus, explicitly request a tty. + (zero? (system*/tty + #$(file-append cryptsetup-static "/sbin/cryptsetup") + "open" "--type" "luks" + + ;; Note: We cannot use the "UUID=source" syntax here + ;; because 'cryptsetup' implements it by searching the + ;; udev-populated /dev/disk/by-id directory but udev may + ;; be unavailable at the time we run this. + (if (bytevector? source) + (or (let loop ((tries-left 10)) + (and (positive? tries-left) + (or (find-partition-by-luks-uuid source) + ;; If the underlying partition is + ;; not found, try again after + ;; waiting a second, up to ten + ;; times. FIXME: This should be + ;; dealt with in a more robust way. + (begin (sleep 1) + (loop (- tries-left 1)))))) + (error "LUKS partition not found" source)) + source) + + #$target))))))) (define (close-luks-device source targets) "Return a gexp that closes TARGET, a LUKS device." |