summaryrefslogtreecommitdiff
path: root/gnu/system
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/system')
-rw-r--r--gnu/system/examples/asus-c201.tmpl2
-rw-r--r--gnu/system/examples/bare-bones.tmpl2
-rw-r--r--gnu/system/examples/bare-hurd.tmpl2
-rw-r--r--gnu/system/examples/beaglebone-black.tmpl2
-rw-r--r--gnu/system/examples/desktop.tmpl2
-rw-r--r--gnu/system/examples/docker-image.tmpl2
-rw-r--r--gnu/system/examples/lightweight-desktop.tmpl2
-rw-r--r--gnu/system/examples/vm-image.tmpl28
-rw-r--r--gnu/system/examples/yggdrasil.tmpl2
-rw-r--r--gnu/system/file-systems.scm66
-rw-r--r--gnu/system/hurd.scm22
-rw-r--r--gnu/system/images/hurd.scm2
-rw-r--r--gnu/system/images/novena.scm2
-rw-r--r--gnu/system/images/pine64.scm2
-rw-r--r--gnu/system/images/pinebook-pro.scm4
-rw-r--r--gnu/system/images/rock64.scm2
-rw-r--r--gnu/system/install.scm10
-rw-r--r--gnu/system/linux-initrd.scm23
-rw-r--r--gnu/system/locale.scm4
-rw-r--r--gnu/system/pam.scm21
-rw-r--r--gnu/system/setuid.scm57
-rw-r--r--gnu/system/uuid.scm9
-rw-r--r--gnu/system/vm.scm11
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 <[email protected]>
;;; Copyright © 2020 Google LLC
;;; Copyright © 2020 Jakub Kądziołka <[email protected]>
-;;; Copyright © 2020 Maxim Cournoyer <[email protected]>
+;;; Copyright © 2020, 2021 Maxim Cournoyer <[email protected]>
+;;; Copyright © 2021 Tobias Geerinckx-Rice <[email protected]>
;;;
;;; 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 <[email protected]>
+;;; Copyright © 2020, 2021 Ludovic Courtès <[email protected]>
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <[email protected]>
;;;
;;; 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 <[email protected]>
+;;; Copyright © 2014, 2015, 2016, 2017, 2019, 2020, 2021 Ludovic Courtès <[email protected]>
;;; Copyright © 2018 Mark H Weaver <[email protected]>
;;;
;;; 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 <[email protected]>
+;;;
+;;; 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 <[email protected]>
-;;; Copyright © 2016 Christopher Allan Webber <[email protected]>
+;;; Copyright © 2016 Christine Lemmer-Webber <[email protected]>
;;; Copyright © 2016, 2017 Leo Famulari <[email protected]>
;;; Copyright © 2017 Mathieu Othacehe <[email protected]>
;;; Copyright © 2017 Marius Bakke <[email protected]>
@@ -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
generated by cgit v1.2.3 (git 2.45.2) at 2025-06-14 05:06:13 +0000