diff options
Diffstat (limited to 'gnu/system')
| -rw-r--r-- | gnu/system/examples/bare-hurd.tmpl | 31 | ||||
| -rw-r--r-- | gnu/system/examples/bare-hurd64.tmpl | 70 | ||||
| -rw-r--r-- | gnu/system/examples/devel-hurd.tmpl | 92 | ||||
| -rw-r--r-- | gnu/system/examples/devel-hurd64.tmpl | 65 | ||||
| -rw-r--r-- | gnu/system/file-systems.scm | 59 | ||||
| -rw-r--r-- | gnu/system/hurd.scm | 48 | ||||
| -rw-r--r-- | gnu/system/image.scm | 14 | ||||
| -rw-r--r-- | gnu/system/images/hurd.scm | 74 | ||||
| -rw-r--r-- | gnu/system/images/visionfive2.scm | 122 | ||||
| -rw-r--r-- | gnu/system/images/wsl2.scm | 2 | ||||
| -rw-r--r-- | gnu/system/install.scm | 38 | ||||
| -rw-r--r-- | gnu/system/linux-initrd.scm | 11 | ||||
| -rw-r--r-- | gnu/system/locale.scm | 65 | ||||
| -rw-r--r-- | gnu/system/mapped-devices.scm | 3 | ||||
| -rw-r--r-- | gnu/system/privilege.scm | 66 | ||||
| -rw-r--r-- | gnu/system/setuid.scm | 50 | ||||
| -rw-r--r-- | gnu/system/uuid.scm | 8 |
17 files changed, 664 insertions, 154 deletions
diff --git a/gnu/system/examples/bare-hurd.tmpl b/gnu/system/examples/bare-hurd.tmpl index 463c7ee798..9bfa776769 100644 --- a/gnu/system/examples/bare-hurd.tmpl +++ b/gnu/system/examples/bare-hurd.tmpl @@ -1,25 +1,28 @@ ;; -*-scheme-*- ;; This is an operating system configuration template -;; for a "bare bones" setup, with no X11 display server. +;; for a "bare bones" QEMU setup, with no X11 display server. -;; To build a disk image for a virtual machine, do +;; To build a disk image for a virtual machine, do: ;; -;; ./pre-inst-env guix system image --image-type=hurd-raw \ +;; ./pre-inst-env guix system image --image-type=hurd-qcow2 \ ;; gnu/system/examples/bare-hurd.tmpl ;; -;; You may run it like so +;; You may run it like so: ;; -;; guix shell qemu -- qemu-system-i386 -enable-kvm -m 2048 \ -;; -device rtl8139,netdev=net0 -netdev user,id=net0,hostfwd=tcp:127.0.0.1:10022-:2222 \ -;; -snapshot -hda <the-image> +;; guix shell qemu -- qemu-system-i386 -m 2048 \ +;; --enable-kvm \ +;; --device e1000,netdev=net0 \ +;; --netdev user,id=net0,hostfwd=tcp:127.0.0.1:10022-:2222 \ +;; --snapshot +;; --hda /gnu/store/...-disk-image ;; -;; and use it like +;; and use it like: ;; ;; ssh -p 10022 root@localhost ;; guix build -e '(@@ (gnu packages commencement) gnu-make-boot0)' ;; -;; or even (if you use --image-size=3G) +;; or even, if you build the image with at least --image-size=3G: ;; ;; guix build hello @@ -34,7 +37,7 @@ (bootloader grub-minimal-bootloader) (targets '("/dev/sdX")))) (file-systems (cons (file-system - (device (file-system-label "my-root")) + (device (file-system-label "hurd")) (mount-point "/") (type "ext2")) %base-file-systems)) @@ -54,6 +57,12 @@ (permit-root-login #t) (allow-empty-passwords? #t) (password-authentication? #t))) - %base-services/hurd)))) + ;; For installing on a real (non-QEMU) machine, use: + ;; (static-networking-service-type + ;; (list %loopback-static-networking + ;; (static-networking + ;; ...))) + ;; %base-services/hurd + %base-services+qemu-networking/hurd)))) %hurd-os diff --git a/gnu/system/examples/bare-hurd64.tmpl b/gnu/system/examples/bare-hurd64.tmpl new file mode 100644 index 0000000000..89811e458a --- /dev/null +++ b/gnu/system/examples/bare-hurd64.tmpl @@ -0,0 +1,70 @@ +;; -*-scheme-*- + +;; This is an operating system configuration template +;; for a "bare bones" QEMU setup, with no X11 display server. + +;; To build a disk image for a virtual machine, do: +;; +;; ./pre-inst-env guix system image --image-type=hurd64-qcow2 \ +;; gnu/system/examples/bare-hurd64.tmpl +;; +;; You may run it like so: +;; +;; guix shell qemu@7 -- qemu-system-x86_64 -m 2048 \ +;; --machine q35 \ +;; --enable-kvm \ +;; --device e1000,netdev=net0 \ +;; --netdev user,id=net0,hostfwd=tcp:127.0.0.1:10022-:2222 \ +;; --snapshot +;; --hda /gnu/store/...-disk-image +;; +;; and use it like: +;; +;; ssh -p 10022 root@localhost +;; guix build -e '(@@ (gnu packages commencement) gnu-make-boot0)' +;; +;; or even, if you build the image with at least --image-size=3G: +;; +;; guix build hello + +(use-modules (gnu) (gnu system hurd) (guix utils)) +(use-service-modules ssh) +(use-package-modules ssh) + +(define %hurd64-os + (operating-system + (inherit %hurd64-default-operating-system) + (bootloader (bootloader-configuration + (bootloader grub-minimal-bootloader) + (targets '("/dev/sdX")))) + (kernel-arguments '("noide")) ;use rumpdisk + (file-systems (cons (file-system + (device (file-system-label "hurd")) + (mount-point "/") + (type "ext2")) + %base-file-systems)) + (host-name "guixygnu64") + (timezone "Europe/Amsterdam") + (users (cons (user-account + (name "guix") + (comment "Anonymous Hurd Hacker") + (group "users") + (supplementary-groups '("wheel"))) + %base-user-accounts)) + (packages (cons openssh-sans-x %base-packages/hurd)) + (services (cons (service openssh-service-type + (openssh-configuration + (openssh openssh-sans-x) + (port-number 2222) + (permit-root-login #t) + (allow-empty-passwords? #t) + (password-authentication? #t))) + ;; For installing on a real (non-QEMU) machine, use: + ;; (static-networking-service-type + ;; (list %loopback-static-networking + ;; (static-networking + ;; ...))) + ;; %base-services/hurd + %base-services+qemu-networking/hurd)))) + +%hurd64-os diff --git a/gnu/system/examples/devel-hurd.tmpl b/gnu/system/examples/devel-hurd.tmpl new file mode 100644 index 0000000000..066bdfe9d8 --- /dev/null +++ b/gnu/system/examples/devel-hurd.tmpl @@ -0,0 +1,92 @@ +;; -*-scheme-*- + +;; This is an operating system configuration template for a "bare bones +;; development" setup, with no X11 display server. + +;; To build a disk image for a virtual machine, do something like: +;; +;; ./pre-inst-env guix system image --image-type=hurd-qcow2 --image-size=6G \ +;; --no-offload gnu/system/examples/devel-hurd.tmpl +;; +;; You may run it like so +;; +;; cp /gnu/store/.../disk-image devel-hurd.img +;; guix shell qemu -- qemu-system-i386 -m 4096 \ +;; --enable-kvm \ +;; --device e1000,netdev=net0 \ +;; --netdev user,id=net0,hostfwd=tcp:127.0.0.1:10022-:2222 \ +;; --hda devel-hurd.img +;; +;; ssh -p 10022 root@localhost +;; guix build -e '(@@ (gnu packages commencement) gnu-make-boot0)' +;; +;; or even: +;; +;; guix build hello +;; +;; For Guix hacking, do something like: +;; +;; guix shell --boostrap -D guix +;; mkdir -p ~/src/guix +;; cd src/guix +;; git clone https://git.savannah.gnu.org/git/guix.git master +;; cd master +;; ./bootstrap +;; ./configure +;; make + +(include "bare-hurd.tmpl") + +(use-modules (srfi srfi-1) + (ice-9 match) + (gnu system hurd) + (guix packages) + (guix store)) + +(use-package-modules base compression file gawk gdb hurd less m4 + package-management ssh version-control) + +(define (input->package input) + "Return the INPUT as package, or #f." + (match input + ((label (and (? package?) package)) + package) + ((label (and (? package?) package . output)) + (cons package output)) + (_ #f))) + +(define guix-packages + (filter-map input->package + (fold alist-delete (package-direct-inputs guix) + ;; These are not essential and do not build yet. + '("graphviz" "guile-avahi" "po4a")))) + +(define hurd-packages + (filter-map input->package + (fold alist-delete (package-direct-inputs hurd) + ;; These are not essential, rumpkernel is very big. + '("dde-sources" "parted" "rumpkernel" "util-linux" + "texinfo")))) + +(define %hurd-devel-os + (operating-system + (inherit %hurd-os) + (bootloader (bootloader-configuration + (bootloader grub-minimal-bootloader) + (targets '("/dev/sdX")) + (timeout 0))) + (timezone "Europe/Berlin") + (swap-devices (list (swap-space + (target "/swapfile")))) + (packages (cons* + gdb-minimal + git-minimal + gnu-make + m4 + openssh-sans-x + (append + guix-packages + hurd-packages + %base-packages/hurd))))) + +%hurd-devel-os diff --git a/gnu/system/examples/devel-hurd64.tmpl b/gnu/system/examples/devel-hurd64.tmpl new file mode 100644 index 0000000000..146a35adcf --- /dev/null +++ b/gnu/system/examples/devel-hurd64.tmpl @@ -0,0 +1,65 @@ +;; -*-scheme-*- + +;; This is an operating system configuration template +;; for a "bare bones" QEMU setup, with no X11 display server. + +;; To build a disk image for a virtual machine, do: +;; +;; ./pre-inst-env guix system image --image-type=hurd-qcow2 --image-size=6G \ +;; --no-offload gnu/system/examples/devel-hurd64.tmpl +;; +;; You may run it like so: +;; +;; cp /gnu/store/.../disk-image devel-hurd.img +;; guix shell qemu@7 -- qemu-system-x86_64 -m 4096 \ +;; --machine q35 \ +;; --enable-kvm \ +;; --device e1000,netdev=net0 \ +;; --netdev user,id=net0,hostfwd=tcp:127.0.0.1:10022-:2222 \ +;; --hda devel-hurd.img +;; +;; and use it like: +;; +;; ssh -p 10022 root@localhost +;; guix build -e '(@@ (gnu packages commencement) gnu-make-boot0)' +;; +;; or even: +;; +;; guix build hello +;; +;; For Guix hacking, do something like: +;; +;; guix shell --boostrap -D guix +;; mkdir -p ~/src/guix +;; cd src/guix +;; git clone git clone git://git.savannah.gnu.org/guix +;; cd master +;; ./bootstrap +;; ./configure +;; make + +(include "devel-hurd.tmpl") +(include "bare-hurd64.tmpl") + +(define %hurd64-devel-os + (operating-system + (inherit %hurd64-os) + (bootloader (bootloader-configuration + (bootloader grub-minimal-bootloader) + (targets '("/dev/sdX")) + (timeout 0))) + (timezone "Europe/Berlin") + (swap-devices (list (swap-space + (target "/swapfile")))) + (packages (cons* + gdb-minimal-15 + git-minimal + gnu-make + m4 + openssh-sans-x + (append + guix-packages + hurd-packages + %base-packages/hurd))))) + +%hurd64-devel-os diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm index af0567bd3e..4ea8237c70 100644 --- a/gnu/system/file-systems.scm +++ b/gnu/system/file-systems.scm @@ -57,6 +57,7 @@ file-system-repair file-system-create-mount-point? file-system-dependencies + file-system-shepherd-requirements file-system-location file-system-type-predicate @@ -161,33 +162,35 @@ flags are found." (define-record-type* <file-system> file-system make-file-system file-system? - (device file-system-device) ; string | <uuid> | <file-system-label> - (mount-point file-system-mount-point) ; string - (type file-system-type) ; string - (flags file-system-flags ; list of symbols - (default '()) - (sanitize validate-file-system-flags)) - (options file-system-options ; string or #f - (default #f)) - (mount? file-system-mount? ; Boolean - (default #t)) - (mount-may-fail? file-system-mount-may-fail? ; Boolean - (default #f)) - (needed-for-boot? %file-system-needed-for-boot? ; Boolean - (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> - (default '())) ; or <mapped-device> - (location file-system-location - (default (current-source-location)) - (innate))) + (device file-system-device) ; string | <uuid> | <file-system-label> + (mount-point file-system-mount-point) ; string + (type file-system-type) ; string + (flags file-system-flags ; list of symbols + (default '()) + (sanitize validate-file-system-flags)) + (options file-system-options ; string or #f + (default #f)) + (mount? file-system-mount? ; Boolean + (default #t)) + (mount-may-fail? file-system-mount-may-fail? ; Boolean + (default #f)) + (needed-for-boot? %file-system-needed-for-boot? ; Boolean + (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> + (default '())) ; or <mapped-device> + (shepherd-requirements file-system-shepherd-requirements ; list of symbols + (default '())) + (location file-system-location + (default (current-source-location)) + (innate))) ;; A file system label for use in the 'device' field. (define-record-type <file-system-label> @@ -369,7 +372,7 @@ TARGET in the other system." ;; List of know pseudo file system types. This is used when validating file ;; system definitions. '("binfmt_misc" "cgroup" "cgroup2" "debugfs" "devpts" "devtmpfs" "efivarfs" "fusectl" - "hugetlbfs" "overlay" "proc" "securityfs" "sysfs" "tmpfs" "tracefs" "xenfs")) + "hugetlbfs" "overlay" "proc" "securityfs" "sysfs" "tmpfs" "tracefs" "virtiofs" "xenfs")) (define %fuse-control-file-system ;; Control file system for Linux' file systems in user-space (FUSE). diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm index cbe0081382..c9df366f24 100644 --- a/gnu/system/hurd.scm +++ b/gnu/system/hurd.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2020-2023 Ludovic Courtès <ludo@gnu.org> -;;; Copyright © 2020, 2023 Janneke Nieuwenhuizen <janneke@gnu.org> +;;; Copyright © 2020-2024 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020, 2023, 2024 Janneke Nieuwenhuizen <janneke@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -18,6 +18,7 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (gnu system hurd) + #:use-module (ice-9 match) #:use-module (guix gexp) #:use-module (guix profiles) #:use-module (guix utils) @@ -47,8 +48,12 @@ #:use-module (gnu system vm) #:export (%base-packages/hurd %base-services/hurd + %base-services+qemu-networking/hurd + %desktop-services/hurd %hurd-default-operating-system %hurd-default-operating-system-kernel + %hurd64-default-operating-system + %hurd64-default-operating-system-kernel %setuid-programs/hurd)) ;;; Commentary: @@ -66,11 +71,19 @@ (%current-target-system #f)) gnumach))) +(define %hurd64-default-operating-system-kernel + (if (system-hurd?) + gnumach + ;; A cross-built GNUmach does not work + (with-parameters ((%current-system "x86_64-linux") + (%current-target-system #f)) + gnumach))) + (define %base-packages/hurd ;; Note: the Shepherd comes before the Hurd, not just because its duty is to ;; shepherd the herd, but also because we want its 'halt' and 'reboot' ;; commands to take precedence. - (list shepherd-0.10 hurd netdde bash coreutils file findutils grep sed + (list shepherd-1.0 hurd netdde bash coreutils file findutils grep sed diffutils patch gawk tar gzip bzip2 xz lzip guile-3.0-latest guile-colorized guile-readline net-base nss-certs inetutils less procps shadow sudo which @@ -79,14 +92,6 @@ (define %base-services/hurd (append (list (service hurd-console-service-type (hurd-console-configuration (hurd hurd))) - (service static-networking-service-type - (list %loopback-static-networking - - ;; QEMU user-mode networking. To get "eth0", you need - ;; QEMU to emulate a device for which Mach has an - ;; in-kernel driver, for instance with: - ;; --device rtl8139,netdev=net0 --netdev user,id=net0 - %qemu-static-networking)) (service guix-service-type (guix-configuration (extra-options '("--disable-chroot" @@ -102,6 +107,20 @@ (tty (string-append "tty" (number->string n)))))) (iota 6 1)))) +(define %base-services+qemu-networking/hurd + (cons + (service static-networking-service-type + (list %loopback-static-networking + + ;; QEMU user-mode networking. To get "eth0", you need + ;; QEMU to emulate a device for which Mach has an + ;; in-kernel driver, for instance with: + ;; --device rtl8139,netdev=net0 --netdev user,id=net0 + %qemu-static-networking)) + %base-services/hurd)) + +(define %desktop-services/hurd %base-services/hurd) + (define %setuid-programs/hurd ;; Default set of setuid-root programs. (map file-like->setuid-program @@ -132,4 +151,11 @@ (locale-libcs (list glibc/hurd)) (name-service-switch #f) (essential-services (hurd-default-essential-services this-operating-system)) + (privileged-programs '()) (setuid-programs %setuid-programs/hurd))) + +(define %hurd64-default-operating-system + (operating-system + (inherit %hurd-default-operating-system) + (kernel %hurd64-default-operating-system-kernel))) + diff --git a/gnu/system/image.scm b/gnu/system/image.scm index 3082bcff46..af0f3eb354 100644 --- a/gnu/system/image.scm +++ b/gnu/system/image.scm @@ -402,7 +402,8 @@ used in the image." (file-system (partition-file-system partition))) (cond ((member 'esp flags) "0xEF") - ((string-prefix? "ext" file-system) "0x83") + ((or (string=? file-system "btrfs") + (string-prefix? "ext" file-system)) "0x83") ((or (string=? file-system "vfat") (string=? file-system "fat16")) "0x0E") ((string=? file-system "fat32") "0x0C") @@ -421,7 +422,8 @@ used in the image." (file-system (partition-file-system partition))) (cond ((member 'esp flags) "U") - ((string-prefix? "ext" file-system) "L") + ((or (string=? file-system "btrfs") + (string-prefix? "ext" file-system)) "L") ((or (string=? file-system "vfat") (string=? file-system "fat16") (string=? file-system "fat32")) "F") @@ -453,6 +455,8 @@ used in the image." (let ((initializer (or #$(partition-initializer partition) initialize-root-partition)) (inputs '#+(cond + ((string=? type "btrfs") + (list btrfs-progs fakeroot)) ((string-prefix? "ext" type) (list e2fsprogs fakeroot)) ((or (string=? type "vfat") @@ -534,10 +538,10 @@ used in the image." (image-partition-table-type image))) (else ""))) - (when (and (gpt-image? image) + (when (and (memq (bootloader-name bootloader) + '(grub-efi grub-efi32 grub-efi-removable-bootloader)) (not - (memq (bootloader-name bootloader) - '(grub-efi grub-efi32 grub-efi-removable-bootloader)))) + (gpt-image? image))) (raise (formatted-message (G_ "EFI bootloader required with GPT partitioning")))) diff --git a/gnu/system/images/hurd.scm b/gnu/system/images/hurd.scm index 9b618f7dc6..67815aeb9b 100644 --- a/gnu/system/images/hurd.scm +++ b/gnu/system/images/hurd.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com> -;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> +;;; Copyright © 2020, 2024 Janneke Nieuwenhuizen <janneke@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -36,7 +36,14 @@ hurd-image-type hurd-qcow2-image-type hurd-barebones-disk-image - hurd-barebones-qcow2-image)) + hurd-barebones-qcow2-image + + hurd64-barebones-os + hurd64-disk-image + hurd6-image-type + hurd64-qcow2-image-type + hurd64-barebones-disk-image + hurd64-barebones-qcow2-image)) (define hurd-barebones-os (operating-system @@ -60,7 +67,31 @@ (permit-root-login #t) (allow-empty-passwords? #t) (password-authentication? #t))) - %base-services/hurd)))) + %base-services+qemu-networking/hurd)))) + +(define hurd64-barebones-os + (operating-system + (inherit %hurd64-default-operating-system) + (bootloader (bootloader-configuration + (bootloader grub-minimal-bootloader) + (targets '("/dev/sdX")))) + (file-systems (cons (file-system + (device (file-system-label "my-root")) + (mount-point "/") + (type "ext2")) + %base-file-systems)) + (host-name "guixygnu") + (timezone "Europe/Amsterdam") + (packages (cons openssh-sans-x %base-packages/hurd)) + (services (cons (service openssh-service-type + (openssh-configuration + (openssh openssh-sans-x) + (use-pam? #f) + (port-number 2222) + (permit-root-login #t) + (allow-empty-passwords? #t) + (password-authentication? #t))) + %base-services+qemu-networking/hurd)))) (define hurd-initialize-root-partition #~(lambda* (#:rest args) @@ -115,5 +146,42 @@ #:type hurd-qcow2-image-type)) (name 'hurd-barebones.qcow2))) + +;;; +;;; 64bit Hurd +;;; +(define hurd64-disk-image + (image + (inherit hurd-disk-image) + (platform x86_64-gnu))) + +(define hurd64-image-type + (image-type + (name 'hurd64-raw) + (constructor (cut image-with-os hurd64-disk-image <>)))) + +(define hurd64-qcow2-image-type + (image-type + (name 'hurd64-qcow2) + (constructor (lambda (os) + (image + (inherit hurd64-disk-image) + (format 'compressed-qcow2) + (operating-system os)))))) + +(define hurd64-barebones-disk-image + (image + (inherit + (os+platform->image hurd64-barebones-os x86_64-gnu + #:type hurd64-image-type)) + (name 'hurd64-barebones-disk-image))) + +(define hurd64-barebones-qcow2-image + (image + (inherit + (os+platform->image hurd64-barebones-os x86_64-gnu + #:type hurd64-qcow2-image-type)) + (name 'hurd64-barebones.qcow2))) + ;; Return the default image. hurd-barebones-qcow2-image diff --git a/gnu/system/images/visionfive2.scm b/gnu/system/images/visionfive2.scm new file mode 100644 index 0000000000..26f70afbc1 --- /dev/null +++ b/gnu/system/images/visionfive2.scm @@ -0,0 +1,122 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2024 Zheng Junjie <873216071@qq.com> +;;; +;;; 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 images visionfive2) + #:use-module (gnu bootloader) + #:use-module (gnu bootloader u-boot) + #:use-module (gnu services dbus) + #:use-module (gnu services dns) + #:use-module (gnu services avahi) + #:use-module (gnu services shepherd) + #:use-module (gnu services ssh) + #:use-module (gnu services networking) + #:use-module (gnu image) + #:use-module (gnu packages linux) + #:use-module (guix packages) + + #:use-module (gnu packages ssh) + #:use-module (gnu packages guile-xyz) + #:use-module (gnu packages admin) + #:use-module (gnu services) + #:use-module (gnu services base) + #:use-module (gnu services networking) + #:use-module (gnu system) + #:use-module (gnu system file-systems) + #:use-module (gnu system image) + #:use-module (guix platforms riscv) + #:use-module (srfi srfi-26) + #:export (visionfive2-barebones-os + visionfive2-image-type + visionfive2-barebones-raw-image)) + +;;; Commentary: +;;; +;;; VisionFive2 can boot from MMC1 (SPI flash) or MMC2 (SD card) selected +;;; by DIP switches MSEL[1:0], you may want boot from MMC2 to use the +;;; U-Boot from Guix System instead of the vendor U-Boot in MMC1. Before +;;; doing so, make sure you have a correct 'fdtfile' in the environment: +;;; +;;; uboot> setenv fdtfile starfive/jh7110-starfive-visionfive-2-v1.3b.dtb +;;; uboot> saveenv +;;; +;;; Code: + +(define visionfive2-barebones-os + (operating-system + (host-name "visionfive2") + (timezone "Etc/UTC") + (locale "en_US.utf8") + (bootloader (bootloader-configuration + (bootloader u-boot-starfive-visionfive2-bootloader) + (targets '("/dev/mmcblk0")))) + (file-systems (cons (file-system + (device (file-system-label "Guix_image")) + (mount-point "/") + (type "ext4")) + %base-file-systems)) + (kernel-arguments (list "earlycon" "clk_ignore_unused")) + (firmware '()) + (packages (append (list cloud-utils neofetch) %base-packages)) + (services + (append (list (service openssh-service-type + (openssh-configuration + (openssh openssh-sans-x) + (permit-root-login #t) + (allow-empty-passwords? #t))) + (service agetty-service-type + (agetty-configuration + (extra-options '("-L")) + (baud-rate "115200") + (term "vt100") + (tty "ttyS0"))) + (service dhcp-client-service-type)) + %base-services)))) + +(define visionfive2-disk-image + (image-without-os + (format 'disk-image) + (partition-table-type 'gpt) + (partitions (list + (partition + (size (* 1 (expt 2 20))) + (label "spl") + (offset (* 34 512)) + (file-system "unformatted") + (uuid (uuid "2E54B353-1271-4842-806F-E436D6AF6985"))) + (partition + (size (* 4 (expt 2 20))) + (label "uboot") + (offset (* 2082 512)) + (file-system "unformatted") + (uuid (uuid "BC13C2FF-59E6-4262-A352-B275FD6F7172"))) + root-partition)))) + +(define visionfive2-image-type + (image-type + (name 'visionfive2-raw) + (constructor (cut image-with-os visionfive2-disk-image <>)))) + +(define visionfive2-barebones-raw-image + (image + (inherit + (os+platform->image visionfive2-barebones-os riscv64-linux + #:type visionfive2-image-type)) + (name 'visionfive2-barebones-raw-image))) + +;; Return the default image. +visionfive2-barebones-raw-image diff --git a/gnu/system/images/wsl2.scm b/gnu/system/images/wsl2.scm index d9aaa1a271..b772d7b635 100644 --- a/gnu/system/images/wsl2.scm +++ b/gnu/system/images/wsl2.scm @@ -86,7 +86,7 @@ USER." (setenv "WSLPATH" (getenv "PATH")) ;; /run is mounted with the nosuid flag by WSL. This prevents - ;; running the /run/setuid-programs. Remount it without this flag + ;; /run/privileged/bin from working. Remount it without this flag ;; as a workaround. See: ;; https://github.com/microsoft/WSL/issues/8716. (mount #f "/run" #f diff --git a/gnu/system/install.scm b/gnu/system/install.scm index 0195a0804d..4de903c59b 100644 --- a/gnu/system/install.scm +++ b/gnu/system/install.scm @@ -1,10 +1,10 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014-2022 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014-2022, 2024 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, 2024 Florian Pelz <pelzflorian@pelzflorian.de> ;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz> ;;; Copyright © 2023 Herman Rimm <herman@rimm.ee> @@ -27,15 +27,13 @@ (define-module (gnu system install) #:use-module (gnu) #:use-module (gnu system) - #:use-module (gnu system setuid) + #:use-module (gnu system privilege) #:use-module (gnu bootloader u-boot) #:use-module (guix gexp) #:use-module (guix store) - #:use-module (guix monads) #:use-module (guix modules) #: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) @@ -47,7 +45,6 @@ #:use-module (gnu packages admin) #:use-module (gnu packages bash) #:use-module (gnu packages bootloaders) - #:use-module (gnu packages certs) #:use-module (gnu packages compression) #:use-module (gnu packages cryptsetup) #:use-module (gnu packages disk) @@ -60,7 +57,6 @@ #:use-module (gnu packages texinfo) #:use-module (gnu packages xorg) #:use-module (ice-9 match) - #:use-module (srfi srfi-26) #:export (installation-os a20-olinuxino-lime-installation-os a20-olinuxino-lime2-emmc-installation-os @@ -100,7 +96,9 @@ ("en" . "System Installation") ("es" . "Instalación del sistema") ("fr" . "Installation du système") - ("ru" . "Установка системы"))) + ("pt_BR" . "Instalação do sistema") + ("ru" . "Установка системы") + ("zh_CN" . "系统安装"))) (define (log-to-info tty user) "Return a script that spawns the Info reader on the right section of the @@ -111,13 +109,22 @@ manual." (locale (cadr (command-line))) (language (string-take locale (string-index locale #\_))) + (with-region (string-take locale + (string-index + locale + (char-set #\. #\/ #\@)))) (infodir "/run/current-system/profile/share/info") - (per-lang (string-append infodir "/guix." language - ".info.gz")) - (file (if (file-exists? per-lang) - per-lang - (string-append infodir "/guix.info"))) + (per-lang (lambda (code) + (string-append infodir "/guix." code + ".info.gz"))) + (file ((@ (srfi srfi-1) find) file-exists? + (list (per-lang with-region) + (per-lang language) + (string-append infodir + "/guix.info.gz")))) (node (or (assoc-ref '#$%installation-node-names + with-region) + (assoc-ref '#$%installation-node-names language) "System Installation"))) (redirect-port tty (current-output-port)) @@ -540,8 +547,9 @@ 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 (setuid-program - (program (file-append shadow "/bin/passwd"))))) + (privileged-programs (list (privileged-program + (program (file-append shadow "/bin/passwd")) + (setuid? #t)))) (pam-services ;; Explicitly allow for empty passwords. diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index 40ff2dc808..dc08edc791 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-static-stripped)) + #:select (%guile-static-initrd)) #:use-module (gnu system file-systems) #:use-module (gnu system mapped-devices) #:use-module (gnu system keyboard) @@ -49,6 +49,7 @@ %base-initrd-modules raw-initrd file-system-packages + file-system-modules base-initrd)) @@ -62,7 +63,7 @@ (define* (expression->initrd exp #:key - (guile %guile-static-stripped) + (guile %guile-static-initrd) (gzip gzip) (name "guile-initrd") (system (%current-system))) @@ -128,7 +129,7 @@ MODULES and taken from LINUX." (define build-exp (with-imported-modules imported-modules - (with-extensions (list guile-zlib) + (with-extensions (list guile-zlib guile-zstd) #~(begin (use-modules (gnu build linux-modules) (guix build utils) @@ -168,7 +169,9 @@ MODULES and taken from LINUX." ;; is already gzipped as a whole. (cond ((string-contains file ".ko.gz") - (invoke #+(file-append gzip "/bin/gunzip") file)))) + (invoke #+(file-append gzip "/bin/gunzip") file)) + ((string-contains file ".ko.zst") + (invoke #+(file-append zstd "/bin/zstd") "-d" file)))) (mkdir #$output) (for-each (lambda (module) diff --git a/gnu/system/locale.scm b/gnu/system/locale.scm index bc572baeb9..8087744e59 100644 --- a/gnu/system/locale.scm +++ b/gnu/system/locale.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014-2017, 2019-2021, 2023 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014-2017, 2019-2021, 2023-2024 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2023 Janneke Nieuwenhuizen <jannek@gnu.org> ;;; @@ -148,14 +148,13 @@ data format changes between libc versions." (define %default-locale-libcs ;; The libcs for which we build locales by default. - (if (system-hurd?) - (list glibc/hurd) - (list glibc-2.33 glibc))) + (list glibc glibc-2.35)) (define %default-locale-definitions - ;; Arbitrary set of locales that are built by default. They are here mostly - ;; to facilitate first-time use to some people, while others may have to add - ;; a specific <locale-definition>. + ;; Arbitrary set of locales that are built by default. They come as a + ;; "bonus" in addition to that specified in the 'locale' field of the + ;; operating system, for the user's convenience, so they shouldn't take too + ;; much space. (letrec-syntax ((utf8-locale (syntax-rules () ((_ name*) (locale-definition @@ -167,44 +166,18 @@ data format changes between libc versions." (utf8-locales (syntax-rules () ((_ name ...) (list (utf8-locale name) ...))))) - ;; Add "en_US.UTF-8" for compatibility with Guix 0.8. - (cons (locale-definition - (name "en_US.UTF-8") - (source "en_US") - (charset "UTF-8")) - (utf8-locales "ca_ES" - "cs_CZ" - "da_DK" - "de_DE" - "el_GR" - "en_AU" - "en_CA" - "en_GB" - "en_US" - "es_AR" - "es_CL" - "es_ES" - "es_MX" - "fi_FI" - "fr_BE" - "fr_CA" - "fr_CH" - "fr_FR" - "ga_IE" - "it_IT" - "ja_JP" - "ko_KR" - "nb_NO" - "nl_NL" - "pl_PL" - "pt_PT" - "ro_RO" - "ru_RU" - "sv_SE" - "tr_TR" - "uk_UA" - "vi_VN" - "zh_CN")))) + ;; The six UN official languages plus Portuguese, with at most two + ;; variants per language. + (utf8-locales "ar_DZ" + "en_GB" + "en_US" + "es_AR" + "es_ES" + "fr_FR" + "pt_BR" + "pt_PT" + "ru_RU" + "zh_CN"))) ;;; @@ -230,7 +203,7 @@ locale supported by GLIBC." (setenv "PATH" (string-append #+(file-append tar "/bin") ":" - #+(file-append xz "/bin") ":" + #+(file-append zstd "/bin") ":" #+(file-append gzip "/bin"))) (unpack #:source #+(package-source glibc)) diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm index e56ead9e5e..931c371425 100644 --- a/gnu/system/mapped-devices.scm +++ b/gnu/system/mapped-devices.scm @@ -353,6 +353,7 @@ TARGET (e.g., \"/dev/md0\"), using 'mdadm'." (define lvm-device-mapping (mapped-device-kind (open open-lvm-device) - (close close-lvm-device))) + (close close-lvm-device) + (modules '((srfi srfi-1))))) ;;; mapped-devices.scm ends here diff --git a/gnu/system/privilege.scm b/gnu/system/privilege.scm new file mode 100644 index 0000000000..fe6e60ad7c --- /dev/null +++ b/gnu/system/privilege.scm @@ -0,0 +1,66 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re> +;;; Copyright © 2022 Tobias Geerinckx-Rice <me@tobias.gr> +;;; +;;; 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 privilege) + #:use-module (guix records) + #:export (privileged-program + privileged-program? + privileged-program-program + privileged-program-setuid? + privileged-program-setgid? + privileged-program-user + privileged-program-group + privileged-program-capabilities + + file-like->setuid-program)) + +;;; Commentary: +;;; +;;; Data structures representing privileged programs: binaries with additional +;;; permissions such as setuid/setgid, or POSIX capabilities. This is meant to +;;; be used both on the host side and at run time--e.g., in activation snippets. +;;; +;;; Code: + +(define-record-type* <privileged-program> + privileged-program make-privileged-program + privileged-program? + ;; File name of the program to assign elevated privileges. + (program privileged-program-program) ;file-like + ;; Whether to set the setuid (‘set user ID’) bit. + (setuid? privileged-program-setuid? ;boolean + (default #f)) + ;; Whether to set the setgid (‘set group ID’) bit. + (setgid? privileged-program-setgid? ;boolean + (default #f)) + ;; The user name or ID this should be set to (defaults to root's). + (user privileged-program-user ;integer or string + (default 0)) + ;; The group name or ID we want to set this to (defaults to root's). + (group privileged-program-group ;integer or string + (default 0)) + ;; POSIX capabilities in cap_from_text(3) form (defaults to #f: none). + (capabilities privileged-program-capabilities ;string or #f + (default #f))) + +(define (file-like->setuid-program program) + "Simple wrapper to facilitate MAPping over a list of file-like objects and +make them setuid, a pattern just common enough to justify a special helper." + (privileged-program (program program) + (setuid? #t))) diff --git a/gnu/system/setuid.scm b/gnu/system/setuid.scm index 83111d932c..097797ce8d 100644 --- a/gnu/system/setuid.scm +++ b/gnu/system/setuid.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re> +;;; Copyright © 2022 Tobias Geerinckx-Rice <me@tobias.gr> ;;; ;;; This file is part of GNU Guix. ;;; @@ -17,41 +18,40 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (gnu system setuid) - #:use-module (guix records) + #:use-module (gnu system privilege) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:re-export (file-like->setuid-program) #:export (setuid-program setuid-program? setuid-program-program setuid-program-setuid? setuid-program-setgid? setuid-program-user - setuid-program-group - - file-like->setuid-program)) + setuid-program-group)) ;;; 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. +;;; Do not use this module in new code. It used to define data structures +;;; representing setuid/setgid programs, but is now a mere compatibility shim +;;; wrapping a subset of (gnu system privilege). ;;; ;;; 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-syntax setuid-program + (lambda (fields) + (syntax-case fields () + ((_ (field value) ...) + #`(privileged-program + (setuid? (match (assoc-ref '((field value) ...) 'setuid?) + ((#f) #f) + (_ #t))) + #,@(remove (match-lambda ((f _) (eq? (syntax->datum f) 'setuid?))) + #'((field value) ...))))))) -(define (file-like->setuid-program program) - (setuid-program (program program))) +(define setuid-program? privileged-program?) +(define setuid-program-program privileged-program-program) +(define setuid-program-setuid? privileged-program-setuid?) +(define setuid-program-setgid? privileged-program-setgid?) +(define setuid-program-user privileged-program-user) +(define setuid-program-group privileged-program-group) diff --git a/gnu/system/uuid.scm b/gnu/system/uuid.scm index 8f967387ad..e6add06aba 100644 --- a/gnu/system/uuid.scm +++ b/gnu/system/uuid.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017 Danny Milosavljevic <dannym@scratchpost.org> -;;; Copyright © 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr> +;;; Copyright © 2019–2020, 2024 Tobias Geerinckx-Rice <me@tobias.gr> ;;; ;;; This file is part of GNU Guix. ;;; @@ -169,7 +169,7 @@ ISO9660 UUID representation." ;;; -;;; FAT32/FAT16. +;;; exFAT/FAT32/FAT16. ;;; (define-syntax %fat-endianness @@ -258,7 +258,7 @@ ISO9660 UUID representation." (vhashq ('dce 'ext2 'ext3 'ext4 'bcachefs 'btrfs 'f2fs 'jfs 'xfs 'luks => string->dce-uuid) - ('fat32 'fat16 'fat => string->fat-uuid) + ('exfat 'fat32 'fat16 'fat => string->fat-uuid) ('ntfs => string->ntfs-uuid) ('iso9660 => string->iso9660-uuid))) @@ -267,7 +267,7 @@ ISO9660 UUID representation." ('dce 'ext2 'ext3 'ext4 'bcachefs 'btrfs 'f2fs 'jfs 'xfs 'luks => dce-uuid->string) ('iso9660 => iso9660-uuid->string) - ('fat32 'fat16 'fat => fat-uuid->string) + ('exfat 'fat32 'fat16 'fat => fat-uuid->string) ('ntfs => ntfs-uuid->string))) (define* (string->uuid str #:optional (type 'dce)) |