From c6c6f60334a63c1cf539c374342e7bf2c1f9197a Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Wed, 27 Apr 2022 18:20:38 -0700 Subject: replace RUNNING-ON-TARGET parameters with contained factors Signed-off-by: Sean Whitton --- src/property/grub.lisp | 34 +++++++++++++++++----------------- src/property/installer.lisp | 35 ++++++++++++++++------------------- src/property/u-boot.lisp | 10 ++++------ 3 files changed, 37 insertions(+), 42 deletions(-) (limited to 'src/property') diff --git a/src/property/grub.lisp b/src/property/grub.lisp index 7ce6403..d8fd67e 100644 --- a/src/property/grub.lisp +++ b/src/property/grub.lisp @@ -19,9 +19,8 @@ (named-readtables:in-readtable :consfigurator) (defmethod install-bootloader-propspec - ((type (eql 'grub)) volume running-on-target - &rest args &key &allow-other-keys) - `(grub-installed ,volume ,running-on-target ,@args)) + ((type (eql 'grub)) volume &rest args &key &allow-other-keys) + `(grub-installed ,volume ,@args)) (defmethod install-bootloader-binaries-propspec ((type (eql 'grub)) volume &key (target "i386-pc") &allow-other-keys) @@ -35,20 +34,21 @@ ("arm64-efi" "grub-efi-arm64")))))) (defprop grub-installed :posix - (volume running-on-target &key (target "i386-pc") force-extra-removable) + (volume &key (target "i386-pc") force-extra-removable) "Use grub-install(8) to install grub to VOLUME." (:desc "GRUB installed") (:apply - (assert-remote-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)))) + (let ((running-on-target (container:contained-p :efi-nvram))) + (assert-remote-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") running-on-target + "--no-nvram") + (and force-extra-removable "--force-extra-removable") + (device-file volume))))) diff --git a/src/property/installer.lisp b/src/property/installer.lisp index 813ad10..3ad58ae 100644 --- a/src/property/installer.lisp +++ b/src/property/installer.lisp @@ -20,18 +20,19 @@ ;;;; Bootloaders -(defgeneric install-bootloader-propspec - (bootloader-type volume running-on-target &key) +(defgeneric install-bootloader-propspec (bootloader-type volume &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.")) +The property can call CONTAINER:CONTAINED-P with relevant factors to determine +whether the host to which we are connected is the host the bootloader will +boot. For example, (container:contained-p :efi-nvram) returns NIL when +building disk images, and T when installing a host from a live environment. +Bootloader installation might behave differently when certain factors are not +contained, or error out. For examples, see GRUB:GRUB-INSTALLED and +U-BOOT:INSTALLED-ROCKCHIP.")) (defgeneric install-bootloader-binaries-propspec (bootloader-type volume &key) (:documentation @@ -39,14 +40,14 @@ out.")) fetches/installs whatever binaries/packages need to be available to install BOOTLOADER-TYPE to VOLUME.")) -(defun get-propspecs (volumes running-on-target) +(defun get-propspecs (volumes) (loop for volume in (mapcan #'all-subvolumes volumes) when (slot-boundp volume 'volume-bootloaders) nconc (loop with bls = (volume-bootloaders volume) for bootloader in (if (listp (car bls)) bls (list bls)) collect (destructuring-bind (type . args) bootloader (apply #'install-bootloader-propspec - type volume running-on-target args))))) + type volume 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 @@ -55,15 +56,13 @@ BOOTLOADER-TYPE to VOLUME.")) ;; 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) +(define-function-property-combinator %install-bootloaders (&rest propapps) (:retprop :type :lisp :hostattrs (lambda () (mapc #'propapp-attrs propapps)) :apply (lambda () - (mapc #'consfigure - (get-propspecs (get-connattr :opened-volumes) running-on-target)) + (mapc #'consfigure (get-propspecs (get-connattr :opened-volumes))) (mrun "sync")))) @@ -82,8 +81,7 @@ BOOTLOADER-TYPE to VOLUME.")) (strcat (unix-namestring chroot) "/") (strcat (unix-namestring target) "/")))) -(defpropspec chroot-installed-to-volumes-for :lisp - (host chroot volumes &key running-on-target) +(defpropspec chroot-installed-to-volumes-for :lisp (host chroot volumes) "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 bootloader(s)." @@ -116,8 +114,7 @@ Also update the fstab and crypttab, and try to install bootloader(s)." (fstab:has-entries-for-opened-volumes) (crypttab:has-entries-for-opened-volumes)))) (%install-bootloaders - ,running-on-target - ,@(get-propspecs (get-hostattrs :volumes) running-on-target)))))))) + ,@(get-propspecs (get-hostattrs :volumes))))))))) (defpropspec bootloader-binaries-installed :posix () "Install whatever binaries/packages need to be available to install the host's @@ -138,14 +135,14 @@ install a package providing /usr/sbin/grub-install, but it won't execute it." (return (if (cdr propspecs) (cons 'eseqprops propspecs) (car propspecs))))) -(defpropspec bootloaders-installed :lisp (&key (running-on-target t)) +(defpropspec bootloaders-installed :lisp () "Install the host's bootloaders to its volumes. Intended to be attached to properties like INSTALLER:CLEANLY-INSTALLED-ONCE using a combinator like ON-CHANGE, or applied manually with DEPLOY-THESE." (:desc "Bootloaders installed") `(eseqprops (bootloader-binaries-installed) - ,@(get-propspecs (get-hostattrs :volumes) running-on-target))) + ,@(get-propspecs (get-hostattrs :volumes)))) ;;;; Live replacement of GNU/Linux distributions diff --git a/src/property/u-boot.lisp b/src/property/u-boot.lisp index 467c062..4ca9546 100644 --- a/src/property/u-boot.lisp +++ b/src/property/u-boot.lisp @@ -23,9 +23,8 @@ ;; these available instead. (defmethod install-bootloader-propspec - ((type (eql 'install-rockchip)) volume running-on-target - &rest args &key &allow-other-keys) - `(installed-rockchip ,volume ,running-on-target ,@args)) + ((type (eql 'install-rockchip)) volume &rest args &key &allow-other-keys) + `(installed-rockchip ,volume ,@args)) (defmethod install-bootloader-binaries-propspec ((type (eql 'install-rockchip)) volume &key &allow-other-keys) @@ -33,15 +32,14 @@ (debianlike (apt:installed "u-boot-rockchip")))) -(defprop installed-rockchip :posix (volume running-on-target &key target) +(defprop installed-rockchip :posix (volume &key target) (:desc "Installed U-Boot using Debian scripts") (:hostattrs (os:required 'os:debianlike) - (or running-on-target target + (or (container:contained-p :physical-disks) target (inapplicable-property "Must specify TARGET for u-boot-install-rockchip(8) unless running on device."))) (:apply - (declare (ignore running-on-target)) (let ((args (list "u-boot-install-rockchip" (device-file volume)))) (if target (apply #'mrun :env `(:TARGET ,target) args) -- cgit v1.2.3