diff options
Diffstat (limited to 'gnu/system')
| -rw-r--r-- | gnu/system/examples/lightweight-desktop.tmpl | 2 | ||||
| -rw-r--r-- | gnu/system/file-systems.scm | 1 | ||||
| -rw-r--r-- | gnu/system/grub.scm | 72 | ||||
| -rw-r--r-- | gnu/system/install.scm | 16 | ||||
| -rw-r--r-- | gnu/system/linux-initrd.scm | 25 | ||||
| -rw-r--r-- | gnu/system/mapped-devices.scm | 5 | ||||
| -rw-r--r-- | gnu/system/vm.scm | 23 |
7 files changed, 73 insertions, 71 deletions
diff --git a/gnu/system/examples/lightweight-desktop.tmpl b/gnu/system/examples/lightweight-desktop.tmpl index 7cb461f2b9..91e7d0b562 100644 --- a/gnu/system/examples/lightweight-desktop.tmpl +++ b/gnu/system/examples/lightweight-desktop.tmpl @@ -24,7 +24,7 @@ (users (cons (user-account (name "alice") - (comment "Bob's brother") + (comment "Bob's sister") (group "users") (supplementary-groups '("wheel" "netdev" "audio" "video")) diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm index 0dc472e3c7..b51d57f079 100644 --- a/gnu/system/file-systems.scm +++ b/gnu/system/file-systems.scm @@ -47,6 +47,7 @@ %binary-format-file-system %shared-memory-file-system %pseudo-terminal-file-system + %tty-gid %immutable-store %control-groups %elogind-file-systems diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm index 45b46cae6f..ead48f0e32 100644 --- a/gnu/system/grub.scm +++ b/gnu/system/grub.scm @@ -62,6 +62,17 @@ ;;; ;;; Code: +(define (strip-mount-point fs file) + "Strip the mount point of FS from FILE, which is a gexp or other lowerable +object denoting a file name." + (let ((mount-point (file-system-mount-point fs))) + (if (string=? mount-point "/") + file + #~(let ((file #$file)) + (if (string-prefix? #$mount-point file) + (substring #$file #$(string-length mount-point)) + file))))) + (define-record-type* <grub-image> grub-image make-grub-image grub-image? @@ -183,7 +194,8 @@ the store is. SYSTEM must be the target system string---e.g., (symbol->string (assoc-ref colors 'bg))))) (define font-file - #~(string-append #$grub "/share/grub/unicode.pf2")) + (strip-mount-point root-fs + (file-append grub "/share/grub/unicode.pf2"))) (mlet* %store-monad ((image (grub-background-image config))) (return (and image @@ -209,7 +221,7 @@ fi~%" #$(grub-root-search root-fs font-file) #$font-file - #$image + #$(strip-mount-point root-fs image) #$(theme-colors grub-theme-color-normal) #$(theme-colors grub-theme-color-highlight)))))) @@ -222,18 +234,23 @@ fi~%" "Return the GRUB 'search' command to look for ROOT-FS, which contains FILE, a gexp. The result is a gexp that can be inserted in the grub.cfg-generation code." - (case (file-system-title root-fs) - ;; Preferably refer to ROOT-FS by its UUID or label. This is more - ;; efficient and less ambiguous, see <>. - ((uuid) - (format #f "search --fs-uuid --set ~a" - (uuid->string (file-system-device root-fs)))) - ((label) - (format #f "search --label --set ~a" - (file-system-device root-fs))) - (else - ;; As a last resort, look for any device containing FILE. - #~(format #f "search --file --set ~a" #$file)))) + ;; Usually FILE is a file name gexp like "/gnu/store/…-linux/vmlinuz", but + ;; it can also be something like "(hd0,msdos1)/vmlinuz" in the case of + ;; custom menu entries. In the latter case, don't emit a 'search' command. + (if (and (string? file) (not (string-prefix? "/" file))) + "" + (case (file-system-title root-fs) + ;; Preferably refer to ROOT-FS by its UUID or label. This is more + ;; efficient and less ambiguous, see <>. + ((uuid) + (format #f "search --fs-uuid --set ~a" + (uuid->string (file-system-device root-fs)))) + ((label) + (format #f "search --label --set ~a" + (file-system-device root-fs))) + (else + ;; As a last resort, look for any device containing FILE. + #~(format #f "search --file --set ~a" #$file))))) (define* (grub-configuration-file config store-fs entries #:key @@ -243,33 +260,34 @@ code." <grub-configuration> object, and where the store is available at STORE-FS, a <file-system> object. OLD-ENTRIES is taken to be a list of menu entries corresponding to old generations of the system." - (define linux-image-name - (if (string-prefix? "mips" system) - "vmlinuz" - "bzImage")) - (define all-entries (append entries (grub-configuration-menu-entries config))) (define entry->gexp (match-lambda (($ <menu-entry> label linux arguments initrd) - #~(format port "menuentry ~s { + ;; Use the right file names for LINUX and STORE-FS in case STORE-FS is + ;; not the "/" file system. + (let ((linux (strip-mount-point store-fs linux)) + (initrd (strip-mount-point store-fs initrd))) + #~(format port "menuentry ~s { ~a - linux ~a/~a ~a + linux ~a ~a initrd ~a }~%" - #$label - #$(grub-root-search store-fs - #~(string-append #$linux "/" - #$linux-image-name)) - #$linux #$linux-image-name (string-join (list #$@arguments)) - #$initrd)))) + #$label + #$(grub-root-search store-fs linux) + #$linux (string-join (list #$@arguments)) + #$initrd))))) (mlet %store-monad ((sugar (eye-candy config store-fs system #~port))) (define builder #~(call-with-output-file #$output (lambda (port) + (format port + "# This file was generated from your GuixSD configuration. Any changes +# will be lost upon reconfiguration. +") #$sugar (format port " set default=~a diff --git a/gnu/system/install.scm b/gnu/system/install.scm index 5acfa2c65b..dfa003f256 100644 --- a/gnu/system/install.scm +++ b/gnu/system/install.scm @@ -268,21 +268,21 @@ You have been warned. Thanks for being so brave. "))) (define (normal-tty tty) (mingetty-service (mingetty-configuration (tty tty) - (motd motd) (auto-login "root") (login-pause? #t)))) (list (mingetty-service (mingetty-configuration (tty "tty1") - (motd motd) (auto-login "root"))) + (login-service (login-configuration + (motd motd))) + ;; Documentation. The manual is in UTF-8, but ;; 'console-font-service' sets up Unicode support and loads a font ;; with all the useful glyphs like em dash and quotation marks. (mingetty-service (mingetty-configuration (tty "tty2") - (motd motd) (auto-login "guest") (login-program (log-to-info)))) @@ -313,12 +313,10 @@ You have been warned. Thanks for being so brave. (cow-store-service) ;; Install Unicode support and a suitable font. - (console-font-service "tty1") - (console-font-service "tty2") - (console-font-service "tty3") - (console-font-service "tty4") - (console-font-service "tty5") - (console-font-service "tty6") + (service console-font-service-type + (map (lambda (tty) + (cons tty %default-console-font)) + '("tty1" "tty2" "tty3" "tty4" "tty5" "tty6"))) ;; To facilitate copy/paste. (gpm-service) diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index bbaa5c0f89..174239a566 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -27,6 +27,7 @@ #:select (%store-prefix)) #:use-module ((guix derivations) #:select (derivation->output-path)) + #:use-module (guix modules) #:use-module (gnu packages compression) #:use-module (gnu packages linux) #:use-module (gnu packages guile) @@ -66,10 +67,8 @@ the derivations referenced by EXP are automatically copied to the initrd." (mlet %store-monad ((init (gexp->script "init" exp #:guile guile))) (define builder - (with-imported-modules '((guix cpio) - (guix build utils) - (guix build store-copy) - (gnu build linux-initrd)) + (with-imported-modules (source-module-closure + '((gnu build linux-initrd))) #~(begin (use-modules (gnu build linux-initrd)) @@ -88,9 +87,9 @@ the derivations referenced by EXP are automatically copied to the initrd." "Return a flat directory containing the Linux kernel modules listed in MODULES and taken from LINUX." (define build-exp - (with-imported-modules '((guix build utils) - (guix elf) - (gnu build linux-modules)) + (with-imported-modules (source-module-closure + '((guix build utils) + (gnu build linux-modules))) #~(begin (use-modules (ice-9 match) (ice-9 regex) (srfi srfi-1) @@ -223,13 +222,11 @@ loaded at boot time in the order in which they appear." (mlet %store-monad ((kodir (flat-linux-module-directory linux linux-modules))) (expression->initrd - (with-imported-modules '((guix build bournish) - (guix build utils) - (guix build syscalls) - (gnu build linux-boot) - (gnu build linux-modules) - (gnu build file-systems) - (guix elf)) + (with-imported-modules (source-module-closure + '((gnu build linux-boot) + (guix build utils) + (guix build bournish) + (gnu build file-systems))) #~(begin (use-modules (gnu build linux-boot) (guix build utils) diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm index 7b91fcfc41..2ce35eaa07 100644 --- a/gnu/system/mapped-devices.scm +++ b/gnu/system/mapped-devices.scm @@ -20,6 +20,7 @@ (define-module (gnu system mapped-devices) #:use-module (guix gexp) #:use-module (guix records) + #:use-module (guix modules) #:use-module (gnu services) #:use-module (gnu services shepherd) #:autoload (gnu packages cryptsetup) (cryptsetup) @@ -95,8 +96,8 @@ (define (open-luks-device source target) "Return a gexp that maps SOURCE to TARGET as a LUKS device, using 'cryptsetup'." - (with-imported-modules '((gnu build file-systems) - (guix build bournish)) + (with-imported-modules (source-module-closure + '((gnu build file-systems))) #~(let ((source #$source)) ;; XXX: 'use-modules' should be at the top level. (use-modules (rnrs bytevectors) ;bytevector? diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index c31e3a80ef..03f7d6c913 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -26,6 +26,7 @@ #:use-module (guix packages) #:use-module (guix monads) #:use-module (guix records) + #:use-module (guix modules) #:use-module ((gnu build vm) #:select (qemu-command)) @@ -90,21 +91,6 @@ (options "trans=virtio") (check? #f)))) -(define %vm-module-closure - ;; The closure of (gnu build vm), roughly. - ;; FIXME: Compute it automatically. - '((gnu build vm) - (gnu build install) - (gnu build linux-boot) - (gnu build linux-modules) - (gnu build file-systems) - (guix elf) - (guix records) - (guix build utils) - (guix build syscalls) - (guix build bournish) - (guix build store-copy))) - (define* (expression->derivation-in-linux-vm name exp #:key (system (%current-system)) @@ -148,7 +134,8 @@ made available under the /xchg CIFS share." (define builder ;; Code that launches the VM that evaluates EXP. - (with-imported-modules %vm-module-closure + (with-imported-modules (source-module-closure '((guix build utils) + (gnu build vm))) #~(begin (use-modules (guix build utils) (gnu build vm)) @@ -205,7 +192,8 @@ register INPUTS in the store database of the image so that Guix can be used in the image." (expression->derivation-in-linux-vm name - (with-imported-modules %vm-module-closure + (with-imported-modules (source-module-closure '((gnu build vm) + (guix build utils))) #~(begin (use-modules (gnu build vm) (guix build utils)) @@ -462,7 +450,6 @@ with '-virtfs' options for the host file systems listed in SHARED-FS." "") " -no-reboot -net nic,model=virtio \ " #$@(map virtfs-option shared-fs) " \ - -net user \ -vga std \ -drive file=" #$image ",if=virtio,cache=writeback,werror=report,readonly \ |