From bf65d1cbab5af97c761df7f9f0ac3a7737e58930 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Thu, 6 May 2021 11:55:46 -0700 Subject: implement installing GRUB Signed-off-by: Sean Whitton --- src/property/installer.lisp | 54 ++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 49 insertions(+), 5 deletions(-) (limited to 'src/property/installer.lisp') diff --git a/src/property/installer.lisp b/src/property/installer.lisp index 04bccfb..ed36631 100644 --- a/src/property/installer.lisp +++ b/src/property/installer.lisp @@ -18,6 +18,27 @@ (in-package :consfigurator.property.installer) (named-readtables:in-readtable :consfigurator) +;;;; Bootloaders + +(defgeneric install-bootloader (bootloader-type volume running-on-target &key) + (:documentation "Install bootloader of type BOOTLOADER-TYPE to VOLUME. + +RUNNING-ON-TARGET indicates whether the host to which we are connected is the +host the bootloader will boot. For example, it is NIL when building disk +images, and T when installing a host from a live environment. Bootloader +installation might behave differently when RUNNING-ON-TARGET is NIL, or error +out. + +Only :LISP property :APPLY subroutines will call this function.")) + +(defgeneric install-bootloader-binaries (bootloader-type volume &key) + (:documentation + "Return a :POSIX propapp which fetches/installs whatever binaries/packages +need to be available to install BOOTLOADER-TYPE to VOLUME.")) + + +;;;; Properties + (defprop %update-target-from-chroot :posix (chroot target) (:desc #?"Updated ${target} from ${chroot}") (:apply @@ -31,10 +52,20 @@ (strcat (unix-namestring chroot) "/") (strcat (unix-namestring target) "/")))) -(defpropspec chroot-installed-to-volumes :lisp (host chroot volumes) +(defprop %install-bootloaders :lisp (running-on-target) + (:desc #?"Installed host bootloaders") + (:apply + (assert-euid-root) + (dolist (volume (mapcan #'all-subvolumes (get-connattr :opened-volumes))) + (when (slot-boundp volume 'volume-bootloader) + (destructuring-bind (type . args) (volume-bootloader volume) + (apply #'install-bootloader type volume running-on-target args)))))) + +(defpropspec chroot-installed-to-volumes :lisp + (host chroot volumes &key running-on-target) "Where CHROOT contains the root filesystem of HOST and VOLUMES is a list of volumes, recursively open the volumes and rsync in the contents of CHROOT. -Also update the fstab and crypttab, and try to install a bootloader." +Also update the fstab and crypttab, and try to install bootloader(s)." (:desc #?"${chroot} installed to volumes") (let ((target (ensure-directory-pathname @@ -58,6 +89,19 @@ Also update the fstab and crypttab, and try to install a bootloader." ;; there are other properties setting mount options etc. which ;; are in conflict with VOLUMES. (fstab:entries-for-opened-volumes) - (crypttab:entries-for-opened-volumes))))) - ;; TODO Install bootloader - ))) + (crypttab:entries-for-opened-volumes))) + (%install-bootloaders running-on-target)))))) + +(defpropspec bootloader-binaries-installed :posix () + "Install whatever binaries/packages need to be available to install the host's +bootloaders to its volumes from within that host." + (:desc #?"Bootloader binaries installed") + (loop + for volume in (mapcan #'all-subvolumes (get-hostattrs :volumes)) + when (slot-boundp volume 'volume-bootloader) + collect (destructuring-bind (type . args) (volume-bootloader volume) + (apply #'install-bootloader-binaries type volume args)) + into propapps + finally + (setq propapps (delete-duplicates propapps :test #'tree-equal)) + (return (if (cdr propapps) (cons 'eseqprops propapps) (car propapps))))) -- cgit v1.2.3