aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSean Whitton <spwhitton@spwhitton.name>2021-03-10 12:37:21 -0700
committerSean Whitton <spwhitton@spwhitton.name>2021-03-10 12:37:21 -0700
commit91929df713ce578ffc3f7de14eeca7688430d696 (patch)
tree69a7bfe83931880345b73caf936e24fccda4535a
parent2d0153e65f6439ac593ae48fd92de95af09dc5f0 (diff)
downloadconsfigurator-91929df713ce578ffc3f7de14eeca7688430d696.tar.gz
shallow copy host in a few more places to preserve consfig values
Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
-rw-r--r--src/deployment.lisp13
1 files changed, 9 insertions, 4 deletions
diff --git a/src/deployment.lisp b/src/deployment.lisp
index 7b42d7a..91b46a8 100644
--- a/src/deployment.lisp
+++ b/src/deployment.lisp
@@ -38,8 +38,7 @@ connections in CONNECTIONS have been both normalised and preprocessed."
;; make a partial own-copy of HOST so that connections can add new pieces
;; of required prerequisite data; specifically, so that they can request
;; the source code of ASDF systems
- (let ((*host* (make-instance 'host :props (host-propspec host)
- :attrs (copy-list (hostattrs host)))))
+ (let ((*host* (shallow-copy-host host)))
(connect (if (eq :local (caar connections))
connections
(cons '(:local) connections))))))
@@ -55,7 +54,8 @@ DEFDEPLOY-THESE, etc., rather than calling this function directly. However,
code which programmatically constructs deployments will need to call this."
(%consfigure (preprocess-connections connections)
(if additional-properties
- (%union-propspec-into-host host additional-properties)
+ (%union-propspec-into-host (shallow-copy-host host)
+ additional-properties)
host)))
(defun deploy-these* (connections host &optional properties)
@@ -68,7 +68,8 @@ in the same way that later entries in the list of properties specified in
DEFHOST forms can override earlier entries (see DEFHOST's docstring)."
(%consfigure (preprocess-connections connections)
(if properties
- (%replace-propspec-into-host host properties)
+ (%replace-propspec-into-host (shallow-copy-host host)
+ properties)
host)))
(defun continue-deploy* (remaining-connections)
@@ -164,6 +165,10 @@ PROPERTIES, like DEPLOY-THESE."
collect (apply #'preprocess-connection-args
(ensure-cons connection))))
+(defun shallow-copy-host (host)
+ (make-instance 'host :props (host-propspec host)
+ :attrs (copy-list (hostattrs host))))
+
(defun %propagate-hostattrs (host)
(dolist (system (propspec-systems (host-propspec host)))
(pushnew system (slot-value (host-propspec *host*) 'systems)))