diff options
author | Sean Whitton <spwhitton@spwhitton.name> | 2021-05-07 18:38:58 -0700 |
---|---|---|
committer | Sean Whitton <spwhitton@spwhitton.name> | 2021-05-09 12:21:56 -0700 |
commit | 8fa130526050c4d3bdfa5465e06180f813a71f3c (patch) | |
tree | 820ead2c6b33e12337bc6d3e453ff7b2c4b2f8bf /src/property/grub.lisp | |
parent | 9cc2fd8af9b974c28534aaa40c736503bdef98d6 (diff) | |
download | consfigurator-8fa130526050c4d3bdfa5465e06180f813a71f3c.tar.gz |
rework bootloader installation so can use property-defining macros
It is better to have the code which installs bootloaders to volumes in
property definitions rather than in plain functions, as then we can specify
that it's :POSIX or :LISP, specify the OS required for it to run, and similar.
This commit enables that by replacing INSTALL-BOOTLOADER with a different
generic which returns propspecs.
Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
Diffstat (limited to 'src/property/grub.lisp')
-rw-r--r-- | src/property/grub.lisp | 43 |
1 files changed, 25 insertions, 18 deletions
diff --git a/src/property/grub.lisp b/src/property/grub.lisp index 45b19cd..9ef4761 100644 --- a/src/property/grub.lisp +++ b/src/property/grub.lisp @@ -18,24 +18,12 @@ (in-package :consfigurator.property.grub) (named-readtables:in-readtable :consfigurator) -(defmethod install-bootloader - ((type (eql 'grub)) (volume opened-volume) running-on-target - &key (target "i386-pc") force-extra-removable) - (mrun :inform "update-initramfs" "-u") - (let ((os-prober (and (not running-on-target) - (remote-exists-p "/etc/grub.d/30_os-prober")))) - ;; work around Debian bug #802717 - (when os-prober (file:has-mode "/etc/grub.d/30_os-prober" #o644)) - (mrun :inform "update-grub") - (when os-prober (file:has-mode "/etc/grub.d/30_os-prober" #o755))) - (mrun :inform "grub-install" (strcat "--target=" target) - (and (string-suffix-p target "-efi") (not running-on-target) - "--no-nvram") - (and force-extra-removable "--force-extra-removable") - (device-file volume)) - (mrun "sync")) - -(defmethod install-bootloader-binaries +(defmethod install-bootloader-propspec + ((type (eql 'grub)) volume running-on-target + &rest args &key &allow-other-keys) + `(grub-installed ,volume ,running-on-target ,@args)) + +(defmethod install-bootloader-binaries-propspec ((type (eql 'grub)) volume &key (target "i386-pc") &allow-other-keys) `(os:etypecase (debianlike @@ -44,3 +32,22 @@ ,(eswitch (target :test #'string=) ("i386-pc" "grub-pc") ("x86_64-efi" "grub-efi-amd64")))))) + +(defprop grub-installed :posix + (volume running-on-target &key (target "i386-pc") force-extra-removable) + "Use grub-install(8) to install grub to VOLUME." + (:desc "GRUB installed") + (:apply + (assert-euid-root) + (mrun :inform "update-initramfs" "-u") + (let ((os-prober (and (not running-on-target) + (remote-exists-p "/etc/grub.d/30_os-prober")))) + ;; work around Debian bug #802717 + (when os-prober (file:has-mode "/etc/grub.d/30_os-prober" #o644)) + (mrun :inform "update-grub") + (when os-prober (file:has-mode "/etc/grub.d/30_os-prober" #o755))) + (mrun :inform "grub-install" (strcat "--target=" target) + (and (string-suffix-p target "-efi") (not running-on-target) + "--no-nvram") + (and force-extra-removable "--force-extra-removable") + (device-file volume)))) |