diff --git a/gnu.scm b/gnu.scm index 932e4cd..9207e38 100644 --- a/gnu.scm +++ b/gnu.scm @@ -35,6 +35,7 @@ (gnu system mapped-devices) (gnu system file-systems) (gnu system grub) ; 'grub-configuration' + (gnu system u-boot) ; 'u-boot-configuration' (gnu system pam) (gnu system shadow) ; 'user-account' (gnu system linux-initrd) diff --git a/gnu/build/install.scm b/gnu/build/install.scm index 7431a09..92740d5 100644 --- a/gnu/build/install.scm +++ b/gnu/build/install.scm @@ -21,7 +21,7 @@ #:use-module (guix build store-copy) #:use-module (srfi srfi-26) #:use-module (ice-9 match) - #:export (install-grub + #:export (install-bootloader populate-root-file-system reset-timestamps register-closure @@ -36,28 +36,49 @@ ;;; ;;; Code: -(define* (install-grub grub.cfg device mount-point) +(define* (install-bootloader-config source target) + (let* ((pivot (string-append target ".new"))) + (mkdir-p (dirname target)) + + ;; Copy bootloader config file instead of just symlinking it, because symlinks won't + ;; work when /boot is on a separate partition. Do that atomically. + (copy-file source pivot) + (rename-file pivot target))) + +(define* (install-grub grub-name grub.cfg device mount-point) "Install GRUB with GRUB.CFG on DEVICE, which is assumed to be mounted on -MOUNT-POINT. +MOUNT-POINT. FIXME is that correct? Note that the caller must make sure that GRUB.CFG is registered as a GC root so that the fonts, background images, etc. referred to by GRUB.CFG are not GC'd." - (let* ((target (string-append mount-point "/boot/grub/grub.cfg")) - (pivot (string-append target ".new"))) - (mkdir-p (dirname target)) - - ;; Copy GRUB.CFG instead of just symlinking it, because symlinks won't - ;; work when /boot is on a separate partition. Do that atomically. - (copy-file grub.cfg pivot) - (rename-file pivot target) - + (let ((target (string-append mount-point "/boot/grub/grub.cfg"))) + (install-bootloader-config grub.cfg target) (unless (zero? (system* "grub-install" "--no-floppy" "--boot-directory" (string-append mount-point "/boot") device)) (error "failed to install GRUB")))) +(define* (install-u-boot u-boot-name extlinux.conf device mount-point) + "Install U-Boot with EXTLINUX.CONF on DEVICE, which is assumed to be mounted on +MOUNT-POINT. FIXME is that correct?" + (install-bootloader-config extlinux.conf + (string-append mount-point + "/extlinux.conf")) + (unless (zero? (system* (string-append u-boot-name "/bin/u-boot-install") + (string-append "--boot-directory=" mount-point) + device)) + (error "failed to install U-Boot"))) + +(define* (install-bootloader package-output-name config-filename device mount-point) + "Install bootloader with CONFIG-FILENAME on DEVICE, which is assumed to be +mounted on MOUNT-POINT." + (let* ((grub? (string-contains package-output-name "grub")) + (bootloader-installer (if grub? install-grub + install-u-boot))) + (bootloader-installer package-output-name config-filename device mount-point))) + (define (evaluate-populate-directive directive target) "Evaluate DIRECTIVE, an sexp describing a file or directory to create under directory TARGET." diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm index cc5cf45..2e2079e 100644 --- a/gnu/build/vm.scm +++ b/gnu/build/vm.scm @@ -295,6 +295,7 @@ SYSTEM-DIRECTORY is the name of the directory of the 'system' derivation." (define* (initialize-hard-disk device #:key + grub grub.cfg (partitions '())) "Initialize DEVICE as a disk containing all the objects listed @@ -313,7 +314,7 @@ passing it a directory name where it is mounted." (display "mounting root partition...\n") (mkdir-p target) (mount (partition-device root) target (partition-file-system root)) - (install-grub grub.cfg device target) + (install-bootloader grub grub.cfg device target) ;; Register GRUB.CFG as a GC root. (register-grub.cfg-root target grub.cfg) diff --git a/gnu/system.scm b/gnu/system.scm index 0802010..24e4e15 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -47,6 +47,7 @@ #:use-module (gnu services shepherd) #:use-module (gnu services base) #:use-module (gnu system grub) + #:use-module (gnu system u-boot) #:use-module (gnu system shadow) #:use-module (gnu system nss) #:use-module (gnu system locale) @@ -89,6 +90,7 @@ operating-system-derivation operating-system-profile + operating-system-grub operating-system-grub.cfg operating-system-etc-directory operating-system-locale-directory @@ -703,6 +705,13 @@ listed in OS. The C library expects to find it under "Return the file system that contains the store of OS." (store-file-system (operating-system-file-systems os))) +(define (operating-system-grub os) + (match (operating-system-bootloader os) + ((? grub-configuration? config) + (grub-configuration-package config)) + ((? u-boot-configuration? config) + (u-boot-configuration-package config)))) + (define* (operating-system-grub.cfg os #:optional (old-entries '())) "Return the GRUB configuration file for OS. Use OLD-ENTRIES to populate the \"old entries\" menu." diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm index 45b46ca..4c9da8c 100644 --- a/gnu/system/grub.scm +++ b/gnu/system/grub.scm @@ -49,6 +49,7 @@ grub-configuration grub-configuration? + grub-configuration-package grub-configuration-device menu-entry @@ -141,6 +142,9 @@ (system* (string-append #$imagemagick "/bin/convert") "-resize" #$size #$image #$output))))) +(define (grub-configuration-package config) + grub) + (define* (grub-background-image config #:key (width 1024) (height 768)) "Return the GRUB background image defined in CONFIG with a ratio of WIDTH/HEIGHT, or #f if none was found." diff --git a/gnu/system/u-boot.scm b/gnu/system/u-boot.scm index acc529a..00a0165 100644 --- a/gnu/system/u-boot.scm +++ b/gnu/system/u-boot.scm @@ -35,7 +35,7 @@ #:export (u-boot-configuration u-boot-configuration? u-boot-configuration-board - u-boot-configuration-u-boot + u-boot-configuration-package u-boot-configuration-device u-boot-configuration-file)) @@ -61,6 +61,10 @@ +(define (u-boot-configuration-package config) + (or (u-boot-configuration-u-boot config) + (make-u-boot-package (u-boot-configuration-board config)))) + ;;; ;;; Configuration file. ;;; diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 4c53edc..e04d8fc 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -175,6 +175,7 @@ made available under the /xchg CIFS share." (file-system-type "ext4") file-system-label os-derivation + grub grub-configuration (register-closures? #t) (inputs '()) @@ -231,6 +232,7 @@ the image." (initializer initialize))))) (initialize-hard-disk "/dev/vda" #:partitions partitions + #:grub #$grub #:grub.cfg #$grub-configuration) (reboot))))) #:system system @@ -283,9 +285,11 @@ to USB sticks meant to be read-only." file-systems-to-keep))))) (mlet* %store-monad ((os-drv (operating-system-derivation os)) + (grub (operating-system-grub os)) (grub.cfg (operating-system-grub.cfg os))) (qemu-image #:name name #:os-derivation os-drv + #:grub grub #:grub-configuration grub.cfg #:disk-image-size disk-image-size #:disk-image-format "raw" @@ -330,6 +334,7 @@ of the GNU system as described by OS." ((os-drv (operating-system-derivation os)) (grub.cfg (operating-system-grub.cfg os))) (qemu-image #:os-derivation os-drv + #:grub grub #:grub-configuration grub.cfg #:disk-image-size disk-image-size #:file-system-type file-system-type @@ -416,12 +421,14 @@ When FULL-BOOT? is true, return an image that does a complete boot sequence, bootloaded included; thus, make a disk image that contains everything the bootloader refers to: OS kernel, initrd, bootloader data, etc." (mlet* %store-monad ((os-drv (operating-system-derivation os)) + (grub (operating-system-grub os)) (grub.cfg (operating-system-grub.cfg os))) ;; XXX: When FULL-BOOT? is true, we end up creating an image that contains ;; GRUB.CFG and all its dependencies, including the output of OS-DRV. ;; This is more than needed (we only need the kernel, initrd, GRUB for its ;; font, and the background image), but it's hard to filter that. (qemu-image #:os-derivation os-drv + #:grub grub #:grub-configuration grub.cfg #:disk-image-size disk-image-size #:inputs (if full-boot? diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 953c624..738fa6b 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -126,7 +126,7 @@ TARGET, and register them." (map (cut copy-item <> target #:log-port log-port) to-copy)))) -(define (install-grub* grub.cfg device target) +(define (install-bootloader* grub grub.cfg device target) "This is a variant of 'install-grub' with error handling, lifted in %STORE-MONAD" (let* ((gc-root (string-append target %gc-roots-directory @@ -140,7 +140,7 @@ TARGET, and register them." ;; 'install-grub' completes (being a bit paranoid.) (make-symlink temp-gc-root grub.cfg) - (munless (false-if-exception (install-grub grub.cfg device target)) + (munless (false-if-exception (install-bootloader grub grub.cfg device target)) (delete-file temp-gc-root) (leave (_ "failed to install GRUB on device '~a'~%") device)) @@ -150,7 +150,7 @@ TARGET, and register them." (define* (install os-drv target #:key (log-port (current-output-port)) - grub? grub.cfg device) + grub grub? grub.cfg device) "Copy the closure of GRUB.CFG, which includes the output of OS-DRV, to directory TARGET. TARGET must be an absolute directory name since that's what 'guix-register' expects. @@ -193,7 +193,7 @@ the ownership of '~a' may be incorrect!~%") (populate os-dir target) (mwhen grub? - (install-grub* grub.cfg device target))))) + (install-bootloader* grub grub.cfg device target))))) ;;; @@ -598,13 +598,15 @@ building anything." (mbegin %store-monad (switch-to-system os) (mwhen grub? - (install-grub* (derivation->output-path grub.cfg) - device "/")))) + (install-bootloader* (derivation->output-path grub) + (derivation->output-path grub.cfg) + device "/")))) ((init) (newline) (format #t (_ "initializing operating system under '~a'...~%") target) (install sys (canonicalize-path target) + #:grub grub #:grub? grub? #:grub.cfg (derivation->output-path grub.cfg) #:device device))