aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSean Whitton <spwhitton@spwhitton.name>2021-05-29 14:59:42 -0700
committerSean Whitton <spwhitton@spwhitton.name>2021-05-30 10:03:03 -0700
commitdc396f800b11fc9aa4bae07df268ad51a2740d8b (patch)
tree47d292422b9b65e23ebda86732903a3fa5b1efc3
parentfb89c160bad4fff16e54812b60ddc74f3c957fef (diff)
downloadconsfigurator-dc396f800b11fc9aa4bae07df268ad51a2740d8b.tar.gz
hostattrs accessors: call PREPROCESS-HOST in some situations
Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
-rw-r--r--src/host.lisp7
-rw-r--r--src/property.lisp14
2 files changed, 19 insertions, 2 deletions
diff --git a/src/host.lisp b/src/host.lisp
index acda791..a449d3c 100644
--- a/src/host.lisp
+++ b/src/host.lisp
@@ -80,6 +80,10 @@ attributes, so that implementations of ESTABLISH-CONNECTION can push new
attributes (typically to request prerequisite data) without disturbing host
values higher up the call stack."))
+(defparameter *preprocessing-host* nil
+ "HOST value currently being preprocessed.
+Used by GET-HOSTATTRS to break infinite loops.")
+
(defmethod preprocess-host ((host preprocessed-host))
(shallow-copy-host host))
@@ -87,7 +91,8 @@ values higher up the call stack."))
(let ((*host* (make-instance
'preprocessed-host
:hostattrs (copy-list (hostattrs host))
- :propspec (preprocess-propspec (host-propspec host)))))
+ :propspec (preprocess-propspec (host-propspec host))))
+ (*preprocessing-host* host))
(propappattrs (eval-propspec (host-propspec *host*)))
*host*))
diff --git a/src/property.lisp b/src/property.lisp
index 2abb5e9..c3a6a5d 100644
--- a/src/property.lisp
+++ b/src/property.lisp
@@ -457,7 +457,19 @@ install an apt package but the host is FreeBSD.")
"Retrieve the list of static informational attributes of type KEY.
Called by property :HOSTATTRS, :APPLY and :UNAPPLY subroutines."
- (getf (slot-value host 'hostattrs) k))
+ ;; Ensure the host is preprocessed so the desired hostattrs are actually
+ ;; there, assuming we're not already preprocessing it. Avoid calling
+ ;; PREPROCESS-HOST on PREPROCESSED-HOST values to avoid pointless copying.
+ ;;
+ ;; This is just to improve readability for some property definitions and
+ ;; avoid confusing situations where hostattrs appear to be missing (for
+ ;; example, if the hostname is not set until HOSTNAME:IS); properties which
+ ;; will look up multiple hostattrs by supplying a value for HOST should call
+ ;; PREPROCESS-HOST on that value themselves.
+ (let ((host (if (and (subtypep (class-of host) 'unpreprocessed-host)
+ (not (eql host *preprocessing-host*)))
+ (preprocess-host host) host)))
+ (getf (slot-value host 'hostattrs) k)))
(defun get-hostattrs-car (k &optional (host *host*))
(car (get-hostattrs k host)))