diff options
author | Maxim Cournoyer <maxim.cournoyer@gmail.com> | 2021-10-01 17:10:49 -0400 |
---|---|---|
committer | Maxim Cournoyer <maxim.cournoyer@gmail.com> | 2021-10-01 17:10:49 -0400 |
commit | 2e65e4834a226c570866f2e8976ed7f252b45cd1 (patch) | |
tree | 21d625bce8d03627680214df4a6622bf8eb79dc9 /gnu/system | |
parent | 9c68ecb24dd1660ce736cdcdea0422a73ec318a2 (diff) | |
parent | f1a3c11407b52004e523ec5de20d326c5661681f (diff) |
Merge remote-tracking branch 'origin/master' into staging
With resolved conflicts in:
gnu/packages/bittorrent.scm
gnu/packages/databases.scm
gnu/packages/geo.scm
gnu/packages/gnupg.scm
gnu/packages/gstreamer.scm
gnu/packages/gtk.scm
gnu/packages/linux.scm
gnu/packages/python-xyz.scm
gnu/packages/xorg.scm
guix/build/qt-utils.scm
Diffstat (limited to 'gnu/system')
-rw-r--r-- | gnu/system/examples/asus-c201.tmpl | 2 | ||||
-rw-r--r-- | gnu/system/examples/bare-bones.tmpl | 2 | ||||
-rw-r--r-- | gnu/system/examples/bare-hurd.tmpl | 2 | ||||
-rw-r--r-- | gnu/system/examples/beaglebone-black.tmpl | 2 | ||||
-rw-r--r-- | gnu/system/examples/desktop.tmpl | 2 | ||||
-rw-r--r-- | gnu/system/examples/docker-image.tmpl | 2 | ||||
-rw-r--r-- | gnu/system/examples/lightweight-desktop.tmpl | 2 | ||||
-rw-r--r-- | gnu/system/examples/vm-image.tmpl | 28 | ||||
-rw-r--r-- | gnu/system/examples/yggdrasil.tmpl | 2 | ||||
-rw-r--r-- | gnu/system/file-systems.scm | 66 | ||||
-rw-r--r-- | gnu/system/hurd.scm | 22 | ||||
-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 | 4 | ||||
-rw-r--r-- | gnu/system/images/rock64.scm | 2 | ||||
-rw-r--r-- | gnu/system/install.scm | 10 | ||||
-rw-r--r-- | gnu/system/linux-initrd.scm | 23 | ||||
-rw-r--r-- | gnu/system/locale.scm | 4 | ||||
-rw-r--r-- | gnu/system/pam.scm | 21 | ||||
-rw-r--r-- | gnu/system/setuid.scm | 57 | ||||
-rw-r--r-- | gnu/system/uuid.scm | 9 | ||||
-rw-r--r-- | gnu/system/vm.scm | 11 |
23 files changed, 206 insertions, 73 deletions
diff --git a/gnu/system/examples/asus-c201.tmpl b/gnu/system/examples/asus-c201.tmpl index c08f85367f..6b6aa706fa 100644 --- a/gnu/system/examples/asus-c201.tmpl +++ b/gnu/system/examples/asus-c201.tmpl @@ -14,7 +14,7 @@ ;; "my-root" is the label of the target root file system. (bootloader (bootloader-configuration (bootloader depthcharge-bootloader) - (target "/dev/mmcblk0p1"))) + (targets '("/dev/mmcblk0p1")))) ;; The ASUS C201PA requires a very particular kernel to boot, ;; as well as the following arguments. diff --git a/gnu/system/examples/bare-bones.tmpl b/gnu/system/examples/bare-bones.tmpl index 1035ab1d60..387e4b12ba 100644 --- a/gnu/system/examples/bare-bones.tmpl +++ b/gnu/system/examples/bare-bones.tmpl @@ -15,7 +15,7 @@ ;; root file system. (bootloader (bootloader-configuration (bootloader grub-bootloader) - (target "/dev/sdX"))) + (targets '("/dev/sdX")))) (file-systems (cons (file-system (device (file-system-label "my-root")) (mount-point "/") diff --git a/gnu/system/examples/bare-hurd.tmpl b/gnu/system/examples/bare-hurd.tmpl index 135ed23cb6..f0dd0cf742 100644 --- a/gnu/system/examples/bare-hurd.tmpl +++ b/gnu/system/examples/bare-hurd.tmpl @@ -32,7 +32,7 @@ (inherit %hurd-default-operating-system) (bootloader (bootloader-configuration (bootloader grub-minimal-bootloader) - (target "/dev/sdX"))) + (targets '("/dev/sdX")))) (file-systems (cons (file-system (device (file-system-label "my-root")) (mount-point "/") diff --git a/gnu/system/examples/beaglebone-black.tmpl b/gnu/system/examples/beaglebone-black.tmpl index def05e807d..90dab62062 100644 --- a/gnu/system/examples/beaglebone-black.tmpl +++ b/gnu/system/examples/beaglebone-black.tmpl @@ -14,7 +14,7 @@ ;; the label of the target root file system. (bootloader (bootloader-configuration (bootloader u-boot-beaglebone-black-bootloader) - (target "/dev/mmcblk1"))) + (targets '("/dev/mmcblk1")))) ;; This module is required to mount the SD card. (initrd-modules (cons "omap_hsmmc" %base-initrd-modules)) diff --git a/gnu/system/examples/desktop.tmpl b/gnu/system/examples/desktop.tmpl index 716b9feb8d..c928008c92 100644 --- a/gnu/system/examples/desktop.tmpl +++ b/gnu/system/examples/desktop.tmpl @@ -19,7 +19,7 @@ ;; Partition mounted on /boot/efi. (bootloader (bootloader-configuration (bootloader grub-efi-bootloader) - (target "/boot/efi") + (targets '("/boot/efi")) (keyboard-layout keyboard-layout))) ;; Specify a mapped device for the encrypted root partition. diff --git a/gnu/system/examples/docker-image.tmpl b/gnu/system/examples/docker-image.tmpl index ca633cc838..bdc6afa6f0 100644 --- a/gnu/system/examples/docker-image.tmpl +++ b/gnu/system/examples/docker-image.tmpl @@ -35,7 +35,7 @@ ;; This will be ignored. (bootloader (bootloader-configuration (bootloader grub-bootloader) - (target "does-not-matter"))) + (targets '("does-not-matter")))) ;; This will be ignored, too. (file-systems (list (file-system (device "does-not-matter") diff --git a/gnu/system/examples/lightweight-desktop.tmpl b/gnu/system/examples/lightweight-desktop.tmpl index d5a63dc457..d4330ecc8e 100644 --- a/gnu/system/examples/lightweight-desktop.tmpl +++ b/gnu/system/examples/lightweight-desktop.tmpl @@ -16,7 +16,7 @@ ;; Partition mounted on /boot/efi. (bootloader (bootloader-configuration (bootloader grub-efi-bootloader) - (target "/boot/efi"))) + (targets '("/boot/efi")))) ;; Assume the target root file system is labelled "my-root", ;; and the EFI System Partition has UUID 1234-ABCD. diff --git a/gnu/system/examples/vm-image.tmpl b/gnu/system/examples/vm-image.tmpl index bcb2ba614c..a59d91587b 100644 --- a/gnu/system/examples/vm-image.tmpl +++ b/gnu/system/examples/vm-image.tmpl @@ -5,7 +5,7 @@ ;; (use-modules (gnu) (guix) (srfi srfi-1)) -(use-service-modules desktop networking ssh xorg) +(use-service-modules desktop mcron networking spice ssh xorg) (use-package-modules bootloaders certs fonts nvi package-management wget xorg) @@ -24,6 +24,18 @@ Run '\x1b[1;37minfo guix\x1b[0m' to browse documentation. accounts.\x1b[0m ")) +;;; XXX: Xfce does not implement what is needed for the SPICE dynamic +;;; resolution to work (see: +;;; https://gitlab.xfce.org/xfce/xfce4-settings/-/issues/142). Workaround it +;;; by manually invoking xrandr every second. +(define auto-update-resolution-crutch + #~(job '(next-second) + (lambda () + (setenv "DISPLAY" ":0.0") + (setenv "XAUTHORITY" "/home/guest/.Xauthority") + (execl (string-append #$xrandr "/bin/xrandr") "xrandr" "-s" "0")) + #:user "guest")) + (operating-system (host-name "gnu") (timezone "Etc/UTC") @@ -39,7 +51,7 @@ accounts.\x1b[0m ;; Adjust as needed. (bootloader (bootloader-configuration (bootloader grub-bootloader) - (target "/dev/vda") + (targets '("/dev/vda")) (terminal-outputs '(console)))) (file-systems (cons (file-system (mount-point "/") @@ -75,11 +87,23 @@ root ALL=(ALL) ALL (default-user "guest") (xorg-configuration (xorg-configuration + ;; The QXL virtual GPU driver is added to provide + ;; a better SPICE experience. + (modules (cons xf86-video-qxl + %default-xorg-modules)) (keyboard-layout keyboard-layout))))) ;; Uncomment the line below to add an SSH server. ;;(service openssh-service-type) + ;; Add support for the SPICE protocol, which enables dynamic + ;; resizing of the guest screen resolution, clipboard + ;; integration with the host, etc. + (service spice-vdagent-service-type) + + (simple-service 'cron-jobs mcron-service-type + (list auto-update-resolution-crutch)) + ;; Use the DHCP client service rather than NetworkManager. (service dhcp-client-service-type)) diff --git a/gnu/system/examples/yggdrasil.tmpl b/gnu/system/examples/yggdrasil.tmpl index be80bf4de9..4d34f49b54 100644 --- a/gnu/system/examples/yggdrasil.tmpl +++ b/gnu/system/examples/yggdrasil.tmpl @@ -15,7 +15,7 @@ ;; root file system. (bootloader (bootloader-configuration (bootloader grub-bootloader) - (target "/dev/sdX"))) + (targets '("/dev/sdX")))) (file-systems (cons (file-system (device (file-system-label "my-root")) (mount-point "/") diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm index 464e87cb18..e69cfd06e6 100644 --- a/gnu/system/file-systems.scm +++ b/gnu/system/file-systems.scm @@ -2,7 +2,8 @@ ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2020 Google LLC ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net> -;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com> +;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com> +;;; Copyright © 2021 Tobias Geerinckx-Rice <me@tobias.gr> ;;; ;;; This file is part of GNU Guix. ;;; @@ -51,6 +52,8 @@ file-system-mount? file-system-mount-may-fail? file-system-check? + file-system-skip-check-if-clean? + file-system-repair file-system-create-mount-point? file-system-dependencies file-system-location @@ -123,6 +126,10 @@ (default #f)) (check? file-system-check? ; Boolean (default #t)) + (skip-check-if-clean? file-system-skip-check-if-clean? ; Boolean + (default #t)) + (repair file-system-repair ; symbol or #f + (default 'preen)) (create-mount-point? file-system-create-mount-point? ; Boolean (default #f)) (dependencies file-system-dependencies ; list of <file-system> @@ -231,8 +238,11 @@ (char-set-complement (char-set #\/))) (define (file-prefix? file1 file2) - "Return #t if FILE1 denotes the name of a file that is a parent of FILE2, -where both FILE1 and FILE2 are absolute file name. For example: + "Return #t if FILE1 denotes the name of a file that is a parent of FILE2. +FILE1 and FILE2 must both be either absolute or relative file names, else #f +is returned. + +For example: (file-prefix? \"/gnu\" \"/gnu/store\") => #t @@ -240,19 +250,27 @@ where both FILE1 and FILE2 are absolute file name. For example: (file-prefix? \"/gn\" \"/gnu/store\") => #f " - (and (string-prefix? "/" file1) - (string-prefix? "/" file2) - (let loop ((file1 (string-tokenize file1 %not-slash)) - (file2 (string-tokenize file2 %not-slash))) - (match file1 - (() - #t) - ((head1 tail1 ...) - (match file2 - ((head2 tail2 ...) - (and (string=? head1 head2) (loop tail1 tail2))) - (() - #f))))))) + (define (absolute? file) + (string-prefix? "/" file)) + + (if (or (every absolute? (list file1 file2)) + (every (negate absolute?) (list file1 file2))) + (let loop ((file1 (string-tokenize file1 %not-slash)) + (file2 (string-tokenize file2 %not-slash))) + (match file1 + (() + #t) + ((head1 tail1 ...) + (match file2 + ((head2 tail2 ...) + (and (string=? head1 head2) (loop tail1 tail2))) + (() + #f))))) + ;; FILE1 and FILE2 are a mix of absolute and relative file names. + #f)) + +(define (file-name-depth file-name) + (length (string-tokenize file-name %not-slash))) (define* (file-system-device->string device #:key uuid-type) "Return the string representations of the DEVICE field of a <file-system> @@ -307,19 +325,22 @@ store--e.g., if FS is the root file system." initrd code." (match fs (($ <file-system> device mount-point type flags options mount? - mount-may-fail? needed-for-boot? check?) + mount-may-fail? needed-for-boot? + check? skip-check-if-clean? repair) ;; Note: Add new fields towards the end for compatibility. (list (cond ((uuid? device) `(uuid ,(uuid-type device) ,(uuid-bytevector device))) ((file-system-label? device) `(file-system-label ,(file-system-label->string device))) (else device)) - mount-point type flags options mount-may-fail? check?)))) + mount-point type flags options mount-may-fail? + check? skip-check-if-clean? repair)))) (define (spec->file-system sexp) "Deserialize SEXP, a list, to the corresponding <file-system> object." (match sexp - ((device mount-point type flags options mount-may-fail? check? + ((device mount-point type flags options mount-may-fail? + check? skip-check-if-clean? repair _ ...) ;placeholder for new fields (file-system (device (match device @@ -332,7 +353,9 @@ initrd code." (mount-point mount-point) (type type) (flags flags) (options options) (mount-may-fail? mount-may-fail?) - (check? check?))))) + (check? check?) + (skip-check-if-clean? skip-check-if-clean?) + (repair repair))))) (define (specification->file-system-mapping spec writable?) "Read the SPEC and return the corresponding <file-system-mapping>. SPEC is @@ -624,9 +647,6 @@ store is located, else #f." s (string-append "/" s))) - (define (file-name-depth file-name) - (length (string-tokenize file-name %not-slash))) - (and-let* ((btrfs-subvolume-fs (filter btrfs-subvolume? file-systems)) (btrfs-subvolume-fs* (sort btrfs-subvolume-fs diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm index 8f3a27834b..e976494d74 100644 --- a/gnu/system/hurd.scm +++ b/gnu/system/hurd.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020, 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> ;;; ;;; This file is part of GNU Guix. @@ -39,6 +39,7 @@ #:use-module (gnu services hurd) #:use-module (gnu services shepherd) #:use-module (gnu system) + #:use-module (gnu system setuid) #:use-module (gnu system shadow) #:use-module (gnu system vm) #:export (%base-packages/hurd @@ -92,14 +93,15 @@ (define %setuid-programs/hurd ;; Default set of setuid-root programs. - (list (file-append shadow "/bin/passwd") - (file-append shadow "/bin/sg") - (file-append shadow "/bin/su") - (file-append shadow "/bin/newgrp") - (file-append shadow "/bin/newuidmap") - (file-append shadow "/bin/newgidmap") - (file-append sudo "/bin/sudo") - (file-append sudo "/bin/sudoedit"))) + (map file-like->setuid-program + (list (file-append shadow "/bin/passwd") + (file-append shadow "/bin/sg") + (file-append shadow "/bin/su") + (file-append shadow "/bin/newgrp") + (file-append shadow "/bin/newuidmap") + (file-append shadow "/bin/newgidmap") + (file-append sudo "/bin/sudo") + (file-append sudo "/bin/sudoedit")))) (define %hurd-default-operating-system (operating-system @@ -108,7 +110,7 @@ (hurd hurd) (bootloader (bootloader-configuration (bootloader grub-minimal-bootloader) - (target "/dev/vda"))) + (targets '("/dev/vda")))) (initrd #f) (initrd-modules (lambda _ '())) (firmware '()) diff --git a/gnu/system/images/hurd.scm b/gnu/system/images/hurd.scm index eac5b7f7e6..fc2dbe3209 100644 --- a/gnu/system/images/hurd.scm +++ b/gnu/system/images/hurd.scm @@ -42,7 +42,7 @@ (inherit %hurd-default-operating-system) (bootloader (bootloader-configuration (bootloader grub-minimal-bootloader) - (target "/dev/sdX"))) + (targets '("/dev/sdX")))) (file-systems (cons (file-system (device (file-system-label "my-root")) (mount-point "/") diff --git a/gnu/system/images/novena.scm b/gnu/system/images/novena.scm index 1cd724ff88..63227af509 100644 --- a/gnu/system/images/novena.scm +++ b/gnu/system/images/novena.scm @@ -39,7 +39,7 @@ (locale "en_US.utf8") (bootloader (bootloader-configuration (bootloader u-boot-novena-bootloader) - (target "/dev/vda"))) + (targets '("/dev/vda")))) (initrd-modules '("sdhci-esdhc-imx" "ahci_imx" "i2c-dev")) ;(kernel linux-libre-arm-generic) (kernel-arguments '("console=ttymxc1,115200")) diff --git a/gnu/system/images/pine64.scm b/gnu/system/images/pine64.scm index 613acd5cfd..808c71295f 100644 --- a/gnu/system/images/pine64.scm +++ b/gnu/system/images/pine64.scm @@ -38,7 +38,7 @@ (locale "en_US.utf8") (bootloader (bootloader-configuration (bootloader u-boot-pine64-lts-bootloader) - (target "/dev/vda"))) + (targets '("/dev/vda")))) (initrd-modules '()) (kernel linux-libre-arm64-generic) (file-systems (cons (file-system diff --git a/gnu/system/images/pinebook-pro.scm b/gnu/system/images/pinebook-pro.scm index b56a7ea409..b6b844cef6 100644 --- a/gnu/system/images/pinebook-pro.scm +++ b/gnu/system/images/pinebook-pro.scm @@ -38,7 +38,7 @@ (locale "en_US.utf8") (bootloader (bootloader-configuration (bootloader u-boot-pinebook-pro-rk3399-bootloader) - (target "/dev/vda"))) + (targets '("/dev/vda")))) (initrd-modules '()) (kernel linux-libre-arm64-generic) (file-systems (cons (file-system @@ -49,7 +49,7 @@ (services (cons (service agetty-service-type (agetty-configuration (extra-options '("-L")) ; no carrier detect - (baud-rate "115200") + (baud-rate "1500000") (term "vt100") (tty "ttyS2"))) %base-services)))) diff --git a/gnu/system/images/rock64.scm b/gnu/system/images/rock64.scm index 3f193e8528..68d3742adc 100644 --- a/gnu/system/images/rock64.scm +++ b/gnu/system/images/rock64.scm @@ -39,7 +39,7 @@ (locale "en_US.utf8") (bootloader (bootloader-configuration (bootloader u-boot-rock64-rk3328-bootloader) - (target "/dev/sda"))) + (targets '("/dev/sda")))) (initrd-modules '()) (kernel linux-libre-arm64-generic) (file-systems (cons (file-system diff --git a/gnu/system/install.scm b/gnu/system/install.scm index 7fa5c15324..7b394184ad 100644 --- a/gnu/system/install.scm +++ b/gnu/system/install.scm @@ -25,6 +25,7 @@ (define-module (gnu system install) #:use-module (gnu) #:use-module (gnu system) + #:use-module (gnu system setuid) #:use-module (gnu bootloader u-boot) #:use-module (guix gexp) #:use-module (guix store) @@ -453,7 +454,7 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m (name-service-switch %mdns-host-lookup-nss) (bootloader (bootloader-configuration (bootloader grub-bootloader) - (target "/dev/sda"))) + (targets '("/dev/sda")))) (label (string-append "GNU Guix installation " (package-version guix))) @@ -502,7 +503,8 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m ;; 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. - (setuid-programs (list (file-append shadow "/bin/passwd"))) + (setuid-programs (list (setuid-program + (program (file-append shadow "/bin/passwd"))))) (pam-services ;; Explicitly allow for empty passwords. @@ -528,7 +530,7 @@ operating-system's kernel-arguments (\"console=ttyS0\" or similar)." (bootloader (bootloader-configuration (bootloader (bootloader (inherit u-boot-bootloader) (package (make-u-boot-package board triplet)))) - (target bootloader-target))))) + (targets (list bootloader-target)))))) (define* (embedded-installation-os bootloader bootloader-target tty #:key (extra-modules '())) @@ -540,7 +542,7 @@ The bootloader BOOTLOADER is installed to BOOTLOADER-TARGET." (inherit installation-os) (bootloader (bootloader-configuration (bootloader bootloader) - (target bootloader-target))) + (targets (list bootloader-target)))) (kernel linux-libre) (kernel-arguments (cons (string-append "console=" tty) diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index c6ba9bb560..a083292fcf 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -36,7 +36,7 @@ #:use-module ((gnu packages xorg) #:select (console-setup xkeyboard-config)) #:use-module ((gnu packages make-bootstrap) - #:select (%guile-3.0-static-stripped)) + #:select (%guile-static-stripped)) #:use-module (gnu system file-systems) #:use-module (gnu system mapped-devices) #:use-module (gnu system keyboard) @@ -62,7 +62,7 @@ (define* (expression->initrd exp #:key - (guile %guile-3.0-static-stripped) + (guile %guile-static-stripped) (gzip gzip) (name "guile-initrd") (system (%current-system))) @@ -210,6 +210,16 @@ upon error." (open source targets))) mapped-devices)) + (define file-system-scan-commands + ;; File systems like btrfs need help to assemble multi-device file systems + ;; but do not use manually-specified <mapped-devices>. + (let ((file-system-types (map file-system-type file-systems))) + (if (member "btrfs" file-system-types) + ;; Ignore errors: if the system manages to boot anyway, the better. + #~((system* (string-append #$btrfs-progs/static "/bin/btrfs") + "device" "scan")) + #~()))) + (define kodir (flat-linux-module-directory linux linux-modules)) @@ -245,7 +255,8 @@ upon error." (map spec->file-system '#$(map file-system->spec file-systems)) #:pre-mount (lambda () - (and #$@device-mapping-commands)) + (and #$@device-mapping-commands + #$@file-system-scan-commands)) #:linux-modules '#$linux-modules #:linux-module-directory '#$kodir #:keymap-file #+(and=> keyboard-layout @@ -269,7 +280,7 @@ FILE-SYSTEMS." (list fatfsck/static) '()) ,@(if (find (file-system-type-predicate "bcachefs") file-systems) - (list bcachefs-tools/static) + (list bcachefs/static) '()) ,@(if (find (file-system-type-predicate "btrfs") file-systems) (list btrfs-progs/static) @@ -279,6 +290,9 @@ FILE-SYSTEMS." '()) ,@(if (find (file-system-type-predicate "f2fs") file-systems) (list f2fs-fsck/static) + '()) + ,@(if (find (file-system-type-predicate "xfs") file-systems) + (list xfs_repair/static) '()))) (define-syntax vhash ;TODO: factorize @@ -311,6 +325,7 @@ FILE-SYSTEMS." ("iso9660" => '("isofs")) ("jfs" => '("jfs")) ("f2fs" => '("f2fs" "crc32_generic")) + ("xfs" => '("xfs")) (else '()))) (define (file-system-modules file-systems) diff --git a/gnu/system/locale.scm b/gnu/system/locale.scm index 689d238d1a..18bbe5ba32 100644 --- a/gnu/system/locale.scm +++ b/gnu/system/locale.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015, 2016, 2017, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Mark H Weaver <mhw@netris.org> ;;; ;;; This file is part of GNU Guix. @@ -148,7 +148,7 @@ data format changes between libc versions." (define %default-locale-libcs ;; The libcs for which we build locales by default. ;; List the previous and current libc to ease transition. - (list glibc-2.29 glibc)) + (list glibc)) (define %default-locale-definitions ;; Arbitrary set of locales that are built by default. They are here mostly diff --git a/gnu/system/pam.scm b/gnu/system/pam.scm index ad02586be8..a31daada59 100644 --- a/gnu/system/pam.scm +++ b/gnu/system/pam.scm @@ -27,6 +27,7 @@ #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module ((guix utils) #:select (%current-system)) + #:use-module (gnu packages linux) #:export (pam-service pam-service-name pam-service-account @@ -207,14 +208,16 @@ dumped in /etc/pam.d/NAME, where NAME is the name of SERVICE." (env (pam-entry ; to honor /etc/environment. (control "required") (module "pam_env.so")))) - (lambda* (name #:key allow-empty-passwords? (allow-root? #f) motd - login-uid?) + (lambda* (name #:key allow-empty-passwords? allow-root? motd + login-uid? gnupg?) "Return a standard Unix-style PAM service for NAME. When ALLOW-EMPTY-PASSWORDS? is true, allow empty passwords. When ALLOW-ROOT? is true, allow root to run the command without authentication. When MOTD is true, it should be a file-like object used as the message-of-the-day. When LOGIN-UID? is true, require the 'pam_loginuid' module; that module sets -/proc/self/loginuid, which the libc 'getlogin' function relies on." +/proc/self/loginuid, which the libc 'getlogin' function relies on. When +GNUPG? is true, require the 'pam_gnupg.so' module; that module hands over +the login password to 'gpg-agent'." ;; See <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-example.html>. (pam-service (name name) @@ -229,7 +232,12 @@ When LOGIN-UID? is true, require the 'pam_loginuid' module; that module sets (control "required") (module "pam_unix.so") (arguments '("nullok"))) - unix)))) + unix)) + (if gnupg? + (list (pam-entry + (control "required") + (module (file-append pam-gnupg "/lib/security/pam_gnupg.so")))) + '()))) (password (list (pam-entry (control "required") (module "pam_unix.so") @@ -247,6 +255,11 @@ When LOGIN-UID? is true, require the 'pam_loginuid' module; that module sets (control "required") (module "pam_loginuid.so"))) '()) + ,@(if gnupg? + (list (pam-entry + (control "required") + (module (file-append pam-gnupg "/lib/security/pam_gnupg.so")))) + '()) ,env ,unix)))))) (define (rootok-pam-service command) diff --git a/gnu/system/setuid.scm b/gnu/system/setuid.scm new file mode 100644 index 0000000000..83111d932c --- /dev/null +++ b/gnu/system/setuid.scm @@ -0,0 +1,57 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (gnu system setuid) + #:use-module (guix records) + #:export (setuid-program + setuid-program? + setuid-program-program + setuid-program-setuid? + setuid-program-setgid? + setuid-program-user + setuid-program-group + + file-like->setuid-program)) + +;;; Commentary: +;;; +;;; Data structures representing setuid/setgid programs. This is meant to be +;;; used both on the host side and at run time--e.g., in activation snippets. +;;; +;;; Code: + +(define-record-type* <setuid-program> + setuid-program make-setuid-program + setuid-program? + ;; Path to program to link with setuid permissions + (program setuid-program-program) ;file-like + ;; Whether to set user setuid bit + (setuid? setuid-program-setuid? ;boolean + (default #t)) + ;; Whether to set group setgid bit + (setgid? setuid-program-setgid? ;boolean + (default #f)) + ;; The user this should be set to (defaults to root) + (user setuid-program-user ;integer or string + (default 0)) + ;; Group we want to set this to (defaults to root) + (group setuid-program-group ;integer or string + (default 0))) + +(define (file-like->setuid-program program) + (setuid-program (program program))) diff --git a/gnu/system/uuid.scm b/gnu/system/uuid.scm index f4c4be6e2b..a95dc1b7d1 100644 --- a/gnu/system/uuid.scm +++ b/gnu/system/uuid.scm @@ -47,6 +47,7 @@ string->fat-uuid string->jfs-uuid string->ntfs-uuid + string->xfs-uuid iso9660-uuid->string ;; XXX: For lack of a better place. @@ -239,7 +240,9 @@ ISO9660 UUID representation." (define string->ext4-uuid string->dce-uuid) (define string->bcachefs-uuid string->dce-uuid) (define string->btrfs-uuid string->dce-uuid) +(define string->f2fs-uuid string->dce-uuid) (define string->jfs-uuid string->dce-uuid) +(define string->xfs-uuid string->dce-uuid) (define-syntax vhashq (syntax-rules (=>) @@ -253,14 +256,16 @@ ISO9660 UUID representation." (define %uuid-parsers (vhashq - ('dce 'ext2 'ext3 'ext4 'bcachefs 'btrfs 'jfs 'luks => string->dce-uuid) + ('dce 'ext2 'ext3 'ext4 'bcachefs 'btrfs 'f2fs 'jfs 'xfs 'luks + => string->dce-uuid) ('fat32 'fat16 'fat => string->fat-uuid) ('ntfs => string->ntfs-uuid) ('iso9660 => string->iso9660-uuid))) (define %uuid-printers (vhashq - ('dce 'ext2 'ext3 'ext4 'bcachefs 'btrfs 'jfs 'luks => dce-uuid->string) + ('dce 'ext2 'ext3 'ext4 'bcachefs 'btrfs 'f2fs 'jfs 'xfs 'luks + => dce-uuid->string) ('iso9660 => iso9660-uuid->string) ('fat32 'fat16 'fat => fat-uuid->string) ('ntfs => ntfs-uuid->string))) diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 97adfa12fa..1e2d8b47c2 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> -;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org> +;;; Copyright © 2016 Christine Lemmer-Webber <cwebber@dustycloud.org> ;;; Copyright © 2016, 2017 Leo Famulari <leo@famulari.name> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com> @@ -45,17 +45,12 @@ #:autoload (gnu packages gnupg) (guile-gcrypt) #:use-module (gnu packages gawk) #:use-module (gnu packages bash) - #:use-module (gnu packages less) #:use-module (gnu packages virtualization) #:use-module (gnu packages disk) - #:use-module (gnu packages zile) #:use-module (gnu packages linux) - #:use-module (gnu packages admin) #:use-module (gnu bootloader) #:use-module (gnu bootloader grub) - #:use-module (gnu system shadow) - #:use-module (gnu system pam) #:use-module (gnu system linux-container) #:use-module (gnu system linux-initrd) #:use-module (gnu bootloader) @@ -635,7 +630,7 @@ environment with the store shared with the host. MAPPINGS is a list of (bootloader (bootloader-configuration (inherit (operating-system-bootloader os)) (bootloader grub-bootloader) - (target "/dev/vda"))) + (targets '("/dev/vda")))) (initrd (lambda (file-systems . rest) (apply (operating-system-initrd os) @@ -718,7 +713,7 @@ with '-virtfs' options for the host file systems listed in SHARED-FS." #$@(map virtfs-option shared-fs) "-vga std" - (format #f "-drive file=~a,if=virtio,cache=writeback,werror=report,readonly" + (format #f "-drive file=~a,if=virtio,cache=writeback,werror=report,readonly=on" #$image))) (define* (system-qemu-image/shared-store-script os |