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>

1 files changed, 66 insertions, 39 deletions

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)))))