aboutsummaryrefslogtreecommitdiff
path: root/gnu/system
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/system')
-rw-r--r--gnu/system/examples/bare-bones.tmpl5
-rw-r--r--gnu/system/examples/desktop.tmpl4
-rw-r--r--gnu/system/examples/lightweight-desktop.tmpl6
-rw-r--r--gnu/system/examples/plasma.tmpl5
-rw-r--r--gnu/system/examples/raspberry-pi-64-nfs-root.tmpl6
-rw-r--r--gnu/system/examples/raspberry-pi-64.tmpl6
-rw-r--r--gnu/system/examples/vm-image.tmpl4
-rw-r--r--gnu/system/images/orangepi-r1-plus-lts-rk3328.scm4
-rw-r--r--gnu/system/images/pine64.scm3
-rw-r--r--gnu/system/install.scm5
-rw-r--r--gnu/system/linux-initrd.scm36
-rw-r--r--gnu/system/mapped-devices.scm19
-rw-r--r--gnu/system/vm.scm47
13 files changed, 79 insertions, 71 deletions
diff --git a/gnu/system/examples/bare-bones.tmpl b/gnu/system/examples/bare-bones.tmpl
index dc6aff5273..7b6a4b09b0 100644
--- a/gnu/system/examples/bare-bones.tmpl
+++ b/gnu/system/examples/bare-bones.tmpl
@@ -4,9 +4,6 @@
(use-modules (gnu))
(use-service-modules networking ssh)
-;; If you want to use HTTPS, you most likely want to include
-;; "certs" in the line below. Also read the comment about
-;; "nss-certs" later in this file.
(use-package-modules screen ssh)
(operating-system
@@ -46,8 +43,6 @@
%base-user-accounts))
;; Globally-installed packages.
- ;; Add "nss-certs" for Mozilla's approved CA certs. You would
- ;; have to have included "certs" in use-package-modules above.
(packages (cons screen %base-packages))
;; Add services to the baseline: a DHCP client and an SSH
diff --git a/gnu/system/examples/desktop.tmpl b/gnu/system/examples/desktop.tmpl
index 10d0e54fa7..2d65f22294 100644
--- a/gnu/system/examples/desktop.tmpl
+++ b/gnu/system/examples/desktop.tmpl
@@ -5,7 +5,7 @@
(use-modules (gnu) (gnu system nss) (guix utils))
(use-service-modules desktop sddm xorg)
-(use-package-modules certs gnome)
+(use-package-modules gnome)
(operating-system
(host-name "antelope")
@@ -65,8 +65,6 @@
;; This is where we specify system-wide packages.
(packages (append (list
- ;; for HTTPS access
- nss-certs
;; for user mounts
gvfs)
%base-packages))
diff --git a/gnu/system/examples/lightweight-desktop.tmpl b/gnu/system/examples/lightweight-desktop.tmpl
index 4cb3c38311..c061284ba8 100644
--- a/gnu/system/examples/lightweight-desktop.tmpl
+++ b/gnu/system/examples/lightweight-desktop.tmpl
@@ -5,7 +5,7 @@
(use-modules (gnu) (gnu system nss))
(use-service-modules desktop)
-(use-package-modules bootloaders certs emacs emacs-xyz ratpoison suckless wm
+(use-package-modules bootloaders emacs emacs-xyz ratpoison suckless wm
xorg)
(operating-system
@@ -47,9 +47,7 @@
ratpoison i3-wm i3status dmenu
emacs emacs-exwm emacs-desktop-environment
;; terminal emulator
- xterm
- ;; for HTTPS access
- nss-certs)
+ xterm)
%base-packages))
;; Use the "desktop" services, which include the X11
diff --git a/gnu/system/examples/plasma.tmpl b/gnu/system/examples/plasma.tmpl
index 6395991125..c3850ffe37 100644
--- a/gnu/system/examples/plasma.tmpl
+++ b/gnu/system/examples/plasma.tmpl
@@ -3,7 +3,7 @@
(use-modules (gnu) (gnu system nss) (srfi srfi-1))
(use-service-modules desktop sddm xorg ssh)
-(use-package-modules certs gnome ssh admin fonts)
+(use-package-modules gnome ssh admin fonts)
(use-package-modules qt xorg tmux linux)
(operating-system
@@ -32,8 +32,7 @@
%base-user-accounts))
;; This is where we specify system-wide packages.
- (packages (cons* nss-certs ;for HTTPS access
- neofetch
+ (packages (cons* neofetch
htop
tmux
xprop
diff --git a/gnu/system/examples/raspberry-pi-64-nfs-root.tmpl b/gnu/system/examples/raspberry-pi-64-nfs-root.tmpl
index 2203375270..1baca02491 100644
--- a/gnu/system/examples/raspberry-pi-64-nfs-root.tmpl
+++ b/gnu/system/examples/raspberry-pi-64-nfs-root.tmpl
@@ -17,8 +17,7 @@
avahi
networking
ssh)
-(use-package-modules certs
- linux
+(use-package-modules linux
raspberry-pi
ssh)
@@ -56,8 +55,7 @@
(supplementary-groups '("wheel" "netdev" "audio" "video"))
(home-directory "/home/pi"))
%base-user-accounts))
- (packages (cons* nss-certs
- openssh
+ (packages (cons* openssh
%base-packages))
(services (cons* (service avahi-service-type)
(service dhcp-client-service-type)
diff --git a/gnu/system/examples/raspberry-pi-64.tmpl b/gnu/system/examples/raspberry-pi-64.tmpl
index 185d25c412..414d8ac7a5 100644
--- a/gnu/system/examples/raspberry-pi-64.tmpl
+++ b/gnu/system/examples/raspberry-pi-64.tmpl
@@ -16,8 +16,7 @@
avahi
networking
ssh)
-(use-package-modules certs
- linux
+(use-package-modules linux
raspberry-pi
ssh)
@@ -60,8 +59,7 @@
(supplementary-groups '("wheel" "netdev" "audio" "video"))
(home-directory "/home/pi"))
%base-user-accounts))
- (packages (cons* nss-certs
- openssh
+ (packages (cons* openssh
%base-packages))
(services (cons* (service avahi-service-type)
(service dhcp-client-service-type)
diff --git a/gnu/system/examples/vm-image.tmpl b/gnu/system/examples/vm-image.tmpl
index dc9a7542a5..589de493b1 100644
--- a/gnu/system/examples/vm-image.tmpl
+++ b/gnu/system/examples/vm-image.tmpl
@@ -7,7 +7,7 @@
(use-modules (gnu) (guix) (srfi srfi-1))
(use-service-modules desktop mcron networking spice ssh xorg sddm)
-(use-package-modules bootloaders certs fonts
+(use-package-modules bootloaders fonts
package-management xdisorg xorg)
(define vm-image-motd (plain-file "motd" "
@@ -66,7 +66,7 @@ root ALL=(ALL) ALL
%wheel ALL=NOPASSWD: ALL\n"))
(packages
- (append (list font-bitstream-vera nss-certs
+ (append (list font-bitstream-vera
;; Auto-started script providing SPICE dynamic resizing for
;; Xfce (see:
;; https://gitlab.xfce.org/xfce/xfce4-settings/-/issues/142).
diff --git a/gnu/system/images/orangepi-r1-plus-lts-rk3328.scm b/gnu/system/images/orangepi-r1-plus-lts-rk3328.scm
index eaaa12ba78..6ec644f113 100644
--- a/gnu/system/images/orangepi-r1-plus-lts-rk3328.scm
+++ b/gnu/system/images/orangepi-r1-plus-lts-rk3328.scm
@@ -21,7 +21,6 @@
#:use-module (gnu bootloader u-boot)
#:use-module (gnu image)
#:use-module (gnu packages linux)
- #:use-module (gnu packages certs)
#:use-module (guix platforms arm)
#:use-module (gnu services)
#:use-module (gnu services base)
@@ -55,8 +54,7 @@
(term "vt100")
(tty "ttyS2")))
(service dhcp-client-service-type)
- (service ntp-service-type) %base-services))
- (packages (cons nss-certs %base-packages))))
+ (service ntp-service-type) %base-services))))
(define orangepi-r1-plus-lts-rk3328-image-type
(image-type (name 'orangepi-r1-plus-lts-rk3328-raw)
diff --git a/gnu/system/images/pine64.scm b/gnu/system/images/pine64.scm
index 3feb69764d..457ff4345f 100644
--- a/gnu/system/images/pine64.scm
+++ b/gnu/system/images/pine64.scm
@@ -59,8 +59,7 @@
(tty "ttyS0")))
(service dhcp-client-service-type)
(service ntp-service-type)
- %base-services))
- (packages (cons nss-certs %base-packages))))
+ %base-services))))
(define pine64-image-type
(image-type
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index 371bfc2a63..0195a0804d 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -548,11 +548,10 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m
(base-pam-services #:allow-empty-passwords? #t))
(packages (append
- (list glibc ; for 'tzselect' & co.
+ (list glibc ; for 'tzselect' & co.
fontconfig
font-dejavu font-gnu-unifont
- grub ; mostly so xrefs to its manual work
- nss-certs) ; To access HTTPS, use git, etc.
+ grub) ; mostly so xrefs to its manual work
%installer-disk-utilities
%base-packages))))
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 6236d25b9d..40ff2dc808 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013-2020, 2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2017, 2019 Mathieu Othacehe <m.othacehe@gmail.com>
@@ -134,18 +134,23 @@ MODULES and taken from LINUX."
(guix build utils)
(rnrs io ports)
(srfi srfi-1)
- (srfi srfi-26))
+ (srfi srfi-26)
+ (ice-9 match))
(define module-dir
(string-append #$linux "/lib/modules"))
(define builtin-modules
- (call-with-input-file
- (first (find-files module-dir "modules.builtin$"))
- (lambda (port)
- (map file-name->module-name
- (string-tokenize
- (get-string-all port))))))
+ (match (find-files module-dir (lambda (file stat)
+ (string=? (basename file)
+ "modules.builtin")))
+ ((file . _)
+ (call-with-input-file file
+ (lambda (port)
+ (map file-name->module-name
+ (string-tokenize (get-string-all port))))))
+ (_
+ '())))
(define modules-to-lookup
(lset-difference string=? '#$modules builtin-modules))
@@ -252,12 +257,10 @@ upon error."
(srfi srfi-1) ;for lvm-device-mapping
(srfi srfi-26)
- ;; FIXME: The following modules are for
- ;; LUKS-DEVICE-MAPPING. We should instead propagate
- ;; this info via gexps.
- ((gnu build file-systems)
- #:select (find-partition-by-luks-uuid))
- (rnrs bytevectors))
+ ;; Load extra modules needed by the mapped device code.
+ #$@(append-map (compose mapped-device-kind-modules
+ mapped-device-type)
+ mapped-devices))
(with-output-to-port (%make-void-port "w")
(lambda ()
@@ -363,7 +366,10 @@ FILE-SYSTEMS."
`("ahci" ;for SATA controllers
"usb-storage" "uas" ;for the installation image etc.
- "usbhid" "hid-generic" "hid-apple" ;keyboards during early boot
+ "usbhid" "hid-generic" ;keyboards during early boot
+ ,@(if (target-riscv64? system)
+ '()
+ '("hid-apple"))
"dm-crypt" "xts" "serpent_generic" "wp512" ;for encrypted root partitions
"nls_iso8859-1" ;for `mkfs.fat`, et.al
,@(if (string-match "^(x86_64|i[3-6]86)-" system)
diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm
index c19a818453..e56ead9e5e 100644
--- a/gnu/system/mapped-devices.scm
+++ b/gnu/system/mapped-devices.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014-2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014-2022, 2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2017, 2018 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2024 Tomas Volf <~@wolfsden.cz>
@@ -57,6 +57,7 @@
mapped-device-kind?
mapped-device-kind-open
mapped-device-kind-close
+ mapped-device-kind-modules
mapped-device-kind-check
device-mapping-service-type
@@ -112,6 +113,8 @@ specifications to 'targets'."
(open mapped-device-kind-open) ;source target -> gexp
(close mapped-device-kind-close ;source target -> gexp
(default (const #~(const #f))))
+ (modules mapped-device-kind-modules ;list of module names
+ (default '()))
(check mapped-device-kind-check ;source -> Boolean
(default (const #t))))
@@ -125,13 +128,14 @@ specifications to 'targets'."
'device-mapping
(match-lambda
(($ <mapped-device> source targets
- ($ <mapped-device-type> open close))
+ ($ <mapped-device-type> open close modules))
(shepherd-service
(provision (list (symbol-append 'device-mapping- (string->symbol (string-join targets "-")))))
(requirement '(udev))
(documentation "Map a device node using Linux's device mapper.")
(start #~(lambda () #$(open source targets)))
(stop #~(lambda _ (not #$(close source targets))))
+ (modules (append %default-modules modules))
(respawn? #f))))
(description "Map a device node using Linux's device mapper.")))
@@ -202,12 +206,6 @@ option of @command{guix system}.\n")
(uuid-bytevector source)
source))
(keyfile #$key-file))
- ;; XXX: 'use-modules' should be at the top level.
- (use-modules (rnrs bytevectors) ;bytevector?
- ((gnu build file-systems)
- #:select (find-partition-by-luks-uuid
- system*/tty))
- ((guix build utils) #:select (mkdir-p)))
;; Create '/run/cryptsetup/' if it does not exist, as device locking
;; is mandatory for LUKS2.
@@ -283,7 +281,10 @@ option of @command{guix system}.\n")
(mapped-device-kind
(open open-luks-device)
(close close-luks-device)
- (check check-luks-device)))
+ (check check-luks-device)
+ (modules '((rnrs bytevectors) ;bytevector?
+ ((gnu build file-systems)
+ #:select (find-partition-by-luks-uuid system*/tty))))))
(define* (luks-device-mapping-with-options #:key key-file)
"Return a luks-device-mapping object with open modified to pass the arguments
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index fcfd1cdb48..a2743453e7 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -5,6 +5,7 @@
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
+;;; Copyright © 2024 Zheng Junjie <873216071@qq.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -51,6 +52,7 @@
#:use-module (gnu bootloader)
#:use-module (gnu bootloader grub)
+ #:use-module (gnu bootloader u-boot)
#:use-module (gnu image)
#:use-module (gnu system image)
#:use-module (gnu system linux-container)
@@ -136,7 +138,9 @@
(define* (virtualized-operating-system os
#:optional (mappings '())
- #:key (full-boot? #f) volatile?)
+ #:key (full-boot? #f) volatile?
+ (system (%current-system))
+ (target (%current-target-system)))
"Return an operating system based on OS suitable for use in a virtualized
environment with the store shared with the host. MAPPINGS is a list of
<file-system-mapping> to realize in the virtualized OS."
@@ -166,15 +170,18 @@ environment with the store shared with the host. MAPPINGS is a list of
(append (map mapping->file-system mappings)
user-file-systems)))
- (operating-system (inherit os)
-
+ (operating-system
+ (inherit os)
;; XXX: Until we run QEMU with UEFI support (with the OVMF firmware),
;; force the traditional i386/BIOS method.
;; See <https://bugs.gnu.org/28768>.
(bootloader (bootloader-configuration
- (inherit (operating-system-bootloader os))
- (bootloader grub-bootloader)
- (targets '("/dev/vda"))))
+ (inherit (operating-system-bootloader os))
+ (bootloader
+ (if (target-riscv64? (or target system))
+ u-boot-qemu-riscv64-bootloader
+ grub-bootloader))
+ (targets '("/dev/vda"))))
(initrd (lambda (file-systems . rest)
(apply (operating-system-initrd os)
@@ -203,7 +210,9 @@ environment with the store shared with the host. MAPPINGS is a list of
virtual-file-systems)))))
(define* (common-qemu-options image shared-fs
- #:key rw-image?)
+ #:key
+ rw-image?
+ (target (%current-target-system)))
"Return the a string-value gexp with the common QEMU options to boot IMAGE,
with '-virtfs' options for the host file systems listed in SHARED-FS."
@@ -214,7 +223,7 @@ with '-virtfs' options for the host file systems listed in SHARED-FS."
#~(;; Only enable kvm if we see /dev/kvm exists.
;; This allows users without hardware virtualization to still use these
;; commands.
- #$@(if (file-exists? "/dev/kvm")
+ #$@(if (and (not target) (file-exists? "/dev/kvm"))
'("-enable-kvm")
'())
@@ -258,7 +267,9 @@ useful when FULL-BOOT? is true."
(mlet* %store-monad ((os -> (virtualized-operating-system
os mappings
#:full-boot? full-boot?
- #:volatile? volatile?))
+ #:volatile? volatile?
+ #:system system
+ #:target target))
(base-image -> (system-image
(image
(inherit
@@ -270,14 +281,17 @@ useful when FULL-BOOT? is true."
(volatile-root? volatile?)))))
(define kernel-arguments
#~(list #$@(if graphic? #~() #~("console=ttyS0"))
- #+@(operating-system-kernel-arguments os "/dev/vda1")))
+ #$@(operating-system-kernel-arguments os "/dev/vda1")))
(define rw-image
#~(format #f "/tmp/guix-image-~a" (basename #$base-image)))
(define qemu-exec
- #~(list #+(file-append qemu "/bin/"
- (qemu-command (or target system)))
+ #~(list #+(with-parameters ((%current-system %system)
+ (%current-target-system #f))
+ ;; Override %CURRENT-SYSTEM to always use a native emulator.
+ (file-append qemu "/bin/"
+ (qemu-command (or target system))))
;; Tells qemu to use the terminal it was started in for IO.
#$@(if graphic? '() #~("-nographic"))
#$@(if full-boot?
@@ -286,10 +300,15 @@ useful when FULL-BOOT? is true."
"-initrd" #$(file-append os "/initrd")
(format #f "-append ~s"
(string-join #$kernel-arguments " "))))
+ ;; Default qemu-riscv64 have not PCI, virt have it, so we set it.
+ #$@(if (target-riscv64? (or target system))
+ #~("-M" "virt")
+ #~())
#$@(common-qemu-options (if volatile? base-image rw-image)
(map file-system-mapping-source
(cons %store-mapping mappings))
- #:rw-image? (not volatile?))
+ #:rw-image? (not volatile?)
+ #:target target)
"-m " (number->string #$memory-size)
#$@options))
@@ -340,7 +359,7 @@ host."
(define kernel-arguments
#~(list #$@(if graphic? #~() #~("console=ttyS0"))
- #+@(operating-system-kernel-arguments os "/dev/vda1")))
+ #$@(operating-system-kernel-arguments os "/dev/vda1")))
#~`(#+(file-append qemu "/bin/"
(qemu-command (or target system)))
generated by cgit v1.2.3 (git 2.25.4) at 2024-06-10 03:37:53 +0000