summaryrefslogtreecommitdiff
path: root/gnu/system
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/system')
-rw-r--r--gnu/system/install.scm27
-rw-r--r--gnu/system/uuid.scm2
-rw-r--r--gnu/system/vm.scm70
3 files changed, 64 insertions, 35 deletions
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index 3a34df26c3..78f2bf3a13 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -30,6 +30,7 @@
#:use-module (gnu packages admin)
#:use-module (gnu packages bash)
#:use-module (gnu packages bootloaders)
+ #:use-module (gnu packages guile)
#:use-module (gnu packages linux)
#:use-module (gnu packages ssh)
#:use-module (gnu packages cryptsetup)
@@ -187,13 +188,13 @@ the user's target storage device rather than on the RAM disk."
(define %installation-services
;; List of services of the installation system.
(let ((motd (plain-file "motd" "
-Welcome to the installation of the Guix System Distribution!
+\x1b[1;37mWelcome to the installation of the Guix System Distribution!\x1b[0m
-There is NO WARRANTY, to the extent permitted by law. In particular, you may
+\x1b[2mThere is NO WARRANTY, to the extent permitted by law. In particular, you may
LOSE ALL YOUR DATA as a side effect of the installation process. Furthermore,
it is 'beta' software, so it may contain bugs.
-You have been warned. Thanks for being so brave.
+You have been warned. Thanks for being so brave.\x1b[0m
")))
(define (normal-tty tty)
(mingetty-service (mingetty-configuration (tty tty)
@@ -244,10 +245,12 @@ You have been warned. Thanks for being so brave.
;; since it takes the installation directory as an argument.
(cow-store-service)
- ;; Install Unicode support and a suitable font.
+ ;; Install Unicode support and a suitable font. Use a font that
+ ;; doesn't have more than 256 glyphs so that we can use colors with
+ ;; varying brightness levels (see note in setfont(8)).
(service console-font-service-type
(map (lambda (tty)
- (cons tty %default-console-font))
+ (cons tty "lat9u-16"))
'("tty1" "tty2" "tty3" "tty4" "tty5" "tty6")))
;; To facilitate copy/paste.
@@ -275,15 +278,21 @@ You have been warned. Thanks for being so brave.
"/bin/sh"))))
;; Keep a reference to BARE-BONES-OS to make sure it can be
- ;; installed without downloading/building anything.
- (service gc-root-service-type (list bare-bones-os)))))
+ ;; installed without downloading/building anything. Also keep the
+ ;; things needed by 'profile-derivation' to minimize the amount of
+ ;; download.
+ (service gc-root-service-type
+ (list bare-bones-os
+ glibc-utf8-locales
+ texinfo
+ (canonical-package guile-2.2))))))
(define %issue
;; Greeting.
"
-This is an installation image of the GNU system. Welcome.
+\x1b[1;37mThis is an installation image of the GNU system. Welcome.\x1b[0m
-Use Alt-F2 for documentation.
+\x1b[1;33mUse Alt-F2 for documentation.\x1b[0m
")
(define installation-os
diff --git a/gnu/system/uuid.scm b/gnu/system/uuid.scm
index eaddfaed05..73695ddeb8 100644
--- a/gnu/system/uuid.scm
+++ b/gnu/system/uuid.scm
@@ -237,7 +237,7 @@ corresponding bytevector; otherwise return #f."
;; This is necessary to serialize bytevectors with the right printer in some
;; circumstances. For instance, GRUB "search --fs-uuid" command compares the
;; string representation of UUIDs, not the raw bytes; thus, when emitting a
-;; GRUB 'search' command, we need to procedure the right string representation
+;; GRUB 'search' command, we need to produce the right string representation
;; (see <https://debbugs.gnu.org/cgi/bugreport.cgi?msg=52;att=0;bug=27735>).
(define-record-type <uuid>
(make-uuid type bv)
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 44246083b3..d754ac76f0 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -29,6 +29,7 @@
#:use-module (guix monads)
#:use-module (guix records)
#:use-module (guix modules)
+ #:use-module (guix utils)
#:use-module ((gnu build vm)
#:select (qemu-command))
@@ -277,7 +278,8 @@ the image."
#~(begin
(use-modules (gnu build vm)
(guix build utils)
- (srfi srfi-26))
+ (srfi srfi-26)
+ (ice-9 binary-ports))
(let ((inputs
'#$(append (list qemu parted e2fsprogs dosfstools)
@@ -312,26 +314,35 @@ the image."
graphs)))
(- disk-image-size
(* 50 (expt 2 20)))))
- (partitions (list (partition
- (size root-size)
- (label #$file-system-label)
- (uuid #$(and=> file-system-uuid
- uuid-bytevector))
- (file-system #$file-system-type)
- (flags '(boot))
- (initializer initialize))
- ;; Append a small EFI System Partition for
- ;; use with UEFI bootloaders.
- (partition
- ;; The standalone grub image is about 10MiB, but
- ;; leave some room for custom or multiple images.
- (size (* 40 (expt 2 20)))
- (label "GNU-ESP") ;cosmetic only
- ;; Use "vfat" here since this property is used
- ;; when mounting. The actual FAT-ness is based
- ;; on filesystem size (16 in this case).
- (file-system "vfat")
- (flags '(esp))))))
+ (partitions
+ (append
+ (list (partition
+ (size root-size)
+ (label #$file-system-label)
+ (uuid #$(and=> file-system-uuid
+ uuid-bytevector))
+ (file-system #$file-system-type)
+ (flags '(boot))
+ (initializer initialize)))
+ ;; Append a small EFI System Partition for use with UEFI
+ ;; bootloaders if we are not targeting ARM because UEFI
+ ;; support in U-Boot is experimental.
+ ;;
+ ;; FIXME: ‘target-arm32?’ may be not operate on the right
+ ;; system/target values. Rewrite using ‘let-system’ when
+ ;; available.
+ (if #$(target-arm32?)
+ '()
+ (list (partition
+ ;; The standalone grub image is about 10MiB, but
+ ;; leave some room for custom or multiple images.
+ (size (* 40 (expt 2 20)))
+ (label "GNU-ESP") ;cosmetic only
+ ;; Use "vfat" here since this property is used
+ ;; when mounting. The actual FAT-ness is based
+ ;; on filesystem size (16 in this case).
+ (file-system "vfat")
+ (flags '(esp))))))))
(initialize-hard-disk "/dev/vda"
#:partitions partitions
#:grub-efi #$grub-efi
@@ -423,7 +434,8 @@ to USB sticks meant to be read-only."
;; install QEMU networking or anything like that. Assume USB
;; mass storage devices (usb-storage.ko) are available.
(initrd (lambda (file-systems . rest)
- (apply base-initrd file-systems
+ (apply (operating-system-initrd os)
+ file-systems
#:volatile-root? #t
rest)))
@@ -488,7 +500,8 @@ of the GNU system as described by OS."
(let ((os (operating-system (inherit os)
;; Use an initrd with the whole QEMU shebang.
(initrd (lambda (file-systems . rest)
- (apply base-initrd file-systems
+ (apply (operating-system-initrd os)
+ file-systems
#:virtio? #t
rest)))
@@ -552,7 +565,13 @@ environment with the store shared with the host. MAPPINGS is a list of
(or (string=? target (%store-prefix))
(string=? target "/")
(and (eq? 'device (file-system-title fs))
- (string-prefix? "/dev/" source)))))
+ (string-prefix? "/dev/" source))
+
+ ;; Labels and UUIDs are necessarily invalid in the VM.
+ (and (file-system-mount? fs)
+ (or (eq? 'label (file-system-title fs))
+ (eq? 'uuid (file-system-title fs))
+ (uuid? source))))))
(operating-system-file-systems os)))
(define virtual-file-systems
@@ -574,7 +593,8 @@ environment with the store shared with the host. MAPPINGS is a list of
(target "/dev/vda")))
(initrd (lambda (file-systems . rest)
- (apply base-initrd file-systems
+ (apply (operating-system-initrd os)
+ file-systems
#:volatile-root? #t
#:virtio? #t
rest)))
generated by cgit v1.2.3 (git 2.25.4) at 2024-11-04 21:18:58 +0000