diff options
Diffstat (limited to 'gnu/system')
| -rw-r--r-- | gnu/system/install.scm | 27 | ||||
| -rw-r--r-- | gnu/system/uuid.scm | 2 | ||||
| -rw-r--r-- | gnu/system/vm.scm | 70 |
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))) |