From 8fa130526050c4d3bdfa5465e06180f813a71f3c Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 7 May 2021 18:38:58 -0700 Subject: 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 --- src/property/installer.lisp | 105 ++++++++++++++++++++++++++++---------------- 1 file changed, 66 insertions(+), 39 deletions(-) (limited to 'src/property/installer.lisp') diff --git a/src/property/installer.lisp b/src/property/installer.lisp index ed36631..c270bdf 100644 --- a/src/property/installer.lisp +++ b/src/property/installer.lisp @@ -20,21 +20,49 @@ ;;;; Bootloaders -(defgeneric install-bootloader (bootloader-type volume running-on-target &key) - (:documentation "Install bootloader of type BOOTLOADER-TYPE to VOLUME. +(defgeneric install-bootloader-propspec + (bootloader-type volume running-on-target &key) + (:documentation + "Return a propspec expression which installs bootloader of type +BOOTLOADER-TYPE to VOLUME. +The propapp yielded by the propspec may be of type :POSIX or of type :LISP. 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.")) +out.")) -(defgeneric install-bootloader-binaries (bootloader-type volume &key) +(defgeneric install-bootloader-binaries-propspec (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.")) + "Return a propspec expression evaluating to a :POSIX propapp which +fetches/installs whatever binaries/packages need to be available to install +BOOTLOADER-TYPE to VOLUME.")) + +(defun get-propspecs (volumes running-on-target) + (loop for volume in (mapcan #'all-subvolumes volumes) + when (slot-boundp volume 'volume-bootloader) + collect (destructuring-bind (type . args) (volume-bootloader volume) + (apply #'install-bootloader-propspec + type volume running-on-target args)))) + +;; At :HOSTATTRS time we don't have the OPENED-VOLUME values required by the +;; :APPLY subroutines which actually install the bootloaders. So we call +;; GET-PROPSPECS twice: (in CHROOT-INSTALLED-TO-VOLUMES) at :HOSTATTRS time to +;; generate propspecs for the sake of running :HOSTATTRS subroutines, and then +;; at :APPLY time where we can get at the OPENED-VOLUME values, we ignore the +;; previously generated propspecs and call GET-PROPSPECS again. This approach +;; should work for any sensible VOLUME<->OPENED-VOLUME pairs. +(define-function-property-combinator + %install-bootloaders (running-on-target &rest propapps) + (:retprop + :type :lisp + :hostattrs (lambda () (mapc #'propappattrs propapps)) + :apply + (lambda () + (mapc #'consfigure + (get-propspecs (get-connattr :opened-volumes) running-on-target)) + (mrun "sync")))) ;;;; Properties @@ -52,15 +80,6 @@ need to be available to install BOOTLOADER-TYPE to VOLUME.")) (strcat (unix-namestring chroot) "/") (strcat (unix-namestring target) "/")))) -(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 @@ -75,33 +94,41 @@ Also update the fstab and crypttab, and try to install bootloader(s)." ".target")))) `(with-these-open-volumes (,volumes :mount-below ,target) (%update-target-from-chroot ,chroot ,target) - ,(propapp - (chroot:deploys-these. target host - (os:etypecase - (debianlike - (file:lacks-lines "/etc/fstab" - "# UNCONFIGURED FSTAB FOR BASE SYSTEM") - ;; These will overwrite any custom mount options, etc., with - ;; values from VOLUMES. Possibly it would be better to use - ;; properties which only update the fs-spec/source fields. - ;; However, given that VOLUMES ultimately comes from the - ;; volumes the user has declared for the host, it is unlikely - ;; there are other properties setting mount options etc. which - ;; are in conflict with VOLUMES. - (fstab:entries-for-opened-volumes) - (crypttab:entries-for-opened-volumes))) - (%install-bootloaders running-on-target)))))) + (chroot:deploys-these + ,target ,host + ,(make-propspec + :propspec + `(eseqprops + ,(propapp + (os:etypecase + (debianlike + (file:lacks-lines + "/etc/fstab" "# UNCONFIGURED FSTAB FOR BASE SYSTEM") + ;; These will overwrite any custom mount options, etc., + ;; with values from VOLUMES. Possibly it would be better + ;; to use properties which only update the fs-spec/source + ;; fields. However, given that VOLUMES ultimately comes + ;; from the volumes the user has declared for the host, it + ;; is unlikely there are other properties setting mount + ;; options etc. which are in conflict with VOLUMES. + (fstab:entries-for-opened-volumes) + (crypttab:entries-for-opened-volumes)))) + (%install-bootloaders + ,running-on-target + ,@(get-propspecs (get-hostattrs :volumes) 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") +bootloaders to its volumes from within that host. For example, this might +install a package providing /usr/sbin/grub-install, but it won't execute it." + (: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 + (apply #'install-bootloader-binaries-propspec type volume args)) + into propspecs finally - (setq propapps (delete-duplicates propapps :test #'tree-equal)) - (return (if (cdr propapps) (cons 'eseqprops propapps) (car propapps))))) + (setq propspecs (delete-duplicates propspecs :test #'tree-equal)) + (return + (if (cdr propspecs) (cons 'eseqprops propspecs) (car propspecs))))) -- cgit v1.2.3