aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gnu/build/install.scm36
-rw-r--r--gnu/build/vm.scm17
-rw-r--r--gnu/system/vm.scm36
3 files changed, 44 insertions, 45 deletions
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index 5cb6055a0c..9e30c0d23e 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -22,8 +22,7 @@
#:use-module (guix build store-copy)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
- #:export (install-grub
- install-grub-config
+ #:export (install-boot-config
evaluate-populate-directive
populate-root-file-system
reset-timestamps
@@ -39,36 +38,17 @@
;;;
;;; Code:
-(define (install-grub grub.cfg device mount-point)
- "Install GRUB with GRUB.CFG on DEVICE, which is assumed to be mounted on
-MOUNT-POINT.
-
-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."
- (install-grub-config grub.cfg mount-point)
-
- ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or root
- ;; partition.
- (setenv "GRUB_ENABLE_CRYPTODISK" "y")
-
- (unless (zero? (system* "grub-install" "--no-floppy"
- "--boot-directory"
- (string-append mount-point "/boot")
- device))
- (error "failed to install GRUB")))
-
-(define (install-grub-config grub.cfg mount-point)
- "Atomically copy GRUB.CFG into boot/grub/grub.cfg on the MOUNT-POINT. 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"))
+(define (install-boot-config bootcfg bootcfg-location mount-point)
+ "Atomically copy BOOTCFG into BOOTCFG-LOCATION on the MOUNT-POINT. Note
+that the caller must make sure that BOOTCFG is registered as a GC root so
+that the fonts, background images, etc. referred to by BOOTCFG are not GC'd."
+ (let* ((target (string-append mount-point bootcfg-location))
(pivot (string-append target ".new")))
(mkdir-p (dirname target))
- ;; Copy GRUB.CFG instead of just symlinking it, because symlinks won't
+ ;; Copy BOOTCFG 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)
+ (copy-file bootcfg pivot)
(rename-file pivot target)))
(define (evaluate-populate-directive directive target)
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index 1eb9a4c45e..9a77bee72d 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -285,15 +285,18 @@ SYSTEM-DIRECTORY is the name of the directory of the 'system' derivation."
(unless register-closures?
(reset-timestamps target))))
-(define (register-grub.cfg-root target bootcfg)
+(define (register-bootcfg-root target bootcfg)
"On file system TARGET, register BOOTCFG as a GC root."
(let ((directory (string-append target "/var/guix/gcroots")))
(mkdir-p directory)
- (symlink bootcfg (string-append directory "/grub.cfg"))))
+ (symlink bootcfg (string-append directory "/bootcfg"))))
(define* (initialize-hard-disk device
#:key
- grub.cfg
+ bootloader-package
+ bootcfg
+ bootcfg-location
+ bootloader-installer
(partitions '()))
"Initialize DEVICE as a disk containing all the <partition> objects listed
in PARTITIONS, and using BOOTCFG as its bootloader configuration file.
@@ -311,10 +314,12 @@ 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-boot-config bootcfg bootcfg-location target)
+ (when bootloader-installer
+ (bootloader-installer bootloader-package device target))
- ;; Register GRUB.CFG as a GC root.
- (register-grub.cfg-root target grub.cfg)
+ ;; Register BOOTCFG as a GC root.
+ (register-bootcfg-root target bootcfg)
(umount target)))
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 080014cde4..2ee5c2b1e7 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -46,6 +46,7 @@
#:select (%guile-static-stripped))
#:use-module (gnu packages admin)
+ #:use-module (gnu bootloader)
#:use-module (gnu system shadow)
#:use-module (gnu system pam)
#:use-module (gnu system linux-initrd)
@@ -176,8 +177,9 @@ made available under the /xchg CIFS share."
(disk-image-format "qcow2")
(file-system-type "ext4")
file-system-label
- os-derivation
- grub-configuration
+ os-drv
+ bootcfg-drv
+ bootloader
(register-closures? #t)
(inputs '())
copy-inputs?)
@@ -201,7 +203,7 @@ the image."
(guix build utils))
(let ((inputs
- '#$(append (list qemu parted grub e2fsprogs)
+ '#$(append (list qemu parted e2fsprogs)
(map canonical-package
(list sed grep coreutils findutils gawk))
(if register-closures? (list guix) '())))
@@ -223,7 +225,7 @@ the image."
#:closures graphs
#:copy-closures? #$copy-inputs?
#:register-closures? #$register-closures?
- #:system-directory #$os-derivation))
+ #:system-directory #$os-drv))
(partitions (list (partition
(size #$(- disk-image-size
(* 10 (expt 2 20))))
@@ -233,7 +235,13 @@ the image."
(initializer initialize)))))
(initialize-hard-disk "/dev/vda"
#:partitions partitions
- #:grub.cfg #$grub-configuration)
+ #:bootloader-package
+ #$(bootloader-package bootloader)
+ #:bootcfg #$bootcfg-drv
+ #:bootcfg-location
+ #$(bootloader-configuration-file bootloader)
+ #:bootloader-installer
+ #$(bootloader-installer bootloader))
(reboot)))))
#:system system
#:make-disk-image? #t
@@ -287,8 +295,10 @@ to USB sticks meant to be read-only."
(mlet* %store-monad ((os-drv (operating-system-derivation os))
(bootcfg (operating-system-bootcfg os)))
(qemu-image #:name name
- #:os-derivation os-drv
- #:grub-configuration bootcfg
+ #:os-drv os-drv
+ #:bootcfg-drv bootcfg
+ #:bootloader (bootloader-configuration-bootloader
+ (operating-system-bootloader os))
#:disk-image-size disk-image-size
#:disk-image-format "raw"
#:file-system-type file-system-type
@@ -330,8 +340,10 @@ of the GNU system as described by OS."
(mlet* %store-monad
((os-drv (operating-system-derivation os))
(bootcfg (operating-system-bootcfg os)))
- (qemu-image #:os-derivation os-drv
- #:grub-configuration bootcfg
+ (qemu-image #:os-drv os-drv
+ #:bootcfg-drv bootcfg
+ #:bootloader (bootloader-configuration-bootloader
+ (operating-system-bootloader os))
#:disk-image-size disk-image-size
#:file-system-type file-system-type
#:inputs `(("system" ,os-drv)
@@ -429,8 +441,10 @@ bootloader refers to: OS kernel, initrd, bootloader data, etc."
;; BOOTCFG 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-configuration bootcfg
+ (qemu-image #:os-drv os-drv
+ #:bootcfg-drv bootcfg
+ #:bootloader (bootloader-configuration-bootloader
+ (operating-system-bootloader os))
#:disk-image-size disk-image-size
#:inputs (if full-boot?
`(("bootcfg" ,bootcfg))