From 75aeee263207f2578d82f7e717b0fa7251f0f50b Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 24 Apr 2021 18:35:44 -0700 Subject: postpone preprocessing the child host for the chroot deploy Preprocess the host later so that we can do things like appending to its propspec. Properties which will pass host values on to CHROOT:OS-BOOTSTRAPPED-FOR can create private preprocessed copies of host values for the purpose of looking at hostattrs. Signed-off-by: Sean Whitton --- src/property/chroot.lisp | 31 ++++++++++++++----------------- 1 file changed, 14 insertions(+), 17 deletions(-) (limited to 'src/property/chroot.lisp') diff --git a/src/property/chroot.lisp b/src/property/chroot.lisp index 5b6471c..341b791 100644 --- a/src/property/chroot.lisp +++ b/src/property/chroot.lisp @@ -58,32 +58,29 @@ `(os:host-etypecase ,host (debian (%debootstrapped ,root ,host ,@options))))) -(defun make-child-host-for-chroot-deploy (propspec) - "Return a preprocessed child host with properties as specified by PROPSPEC, -additionally set up such that deploying the host will not start up any -services." - (preprocess-host - (make-child-host - :propspec (make-propspec - :systems (propspec-systems propspec) - :propspec `(service:without-starting-services - ,(propspec-props propspec)))))) - (defproplist os-bootstrapped-for :lisp - (options root host &aux (host (preprocess-host host))) + (options root host + &aux + (child-host + (make-child-host + :hostattrs (hostattrs host) + :propspec (make-propspec + :systems (propspec-systems (host-propspec host)) + :propspec `(service:without-starting-services + ,(propspec-props (host-propspec host)))))) + (child-host* (preprocess-host child-host))) "Bootstrap an OS for HOST into ROOT and apply the properties of HOST. OPTIONS is a plist of values to pass to the OS-specific bootstrapping property." (:desc (declare (ignore options)) #?"Built chroot for ${(car (getf (hostattrs host) :hostname))} @ ${root}") - (%os-bootstrapper-installed host) - (%os-bootstrapped options root host) - (deploys `((:chroot :into ,root)) host)) + (%os-bootstrapper-installed child-host*) + (%os-bootstrapped options root child-host*) + (deploys `((:chroot :into ,root)) child-host)) (defproplist os-bootstrapped :lisp (options root properties) "Bootstrap an OS into ROOT and apply PROPERTIES. OPTIONS is a plist of values to pass to the OS-specific bootstrapping property." (:desc (declare (ignore options properties)) #?"Built chroot @ ${root}") - (os-bootstrapped-for - options root (make-child-host-for-chroot-deploy properties))) + (os-bootstrapped-for options root (make-host :propspec properties))) -- cgit v1.2.3