diff options
author | Sean Whitton <spwhitton@spwhitton.name> | 2021-03-06 15:05:36 -0700 |
---|---|---|
committer | Sean Whitton <spwhitton@spwhitton.name> | 2021-03-06 15:57:19 -0700 |
commit | 88d1bf3abac5529cfb1950cb49ec0d61e2384382 (patch) | |
tree | cd5c9733047c895046bfa0b13a576f88b35b48ae | |
parent | 3fe7f29bd7ac5f775be23fcff20d1393e2804c25 (diff) | |
download | consfigurator-88d1bf3abac5529cfb1950cb49ec0d61e2384382.tar.gz |
introduce GET-HOSTATTRS-CAR
Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
-rw-r--r-- | src/package.lisp | 1 | ||||
-rw-r--r-- | src/property.lisp | 5 | ||||
-rw-r--r-- | src/property/os.lisp | 2 |
3 files changed, 6 insertions, 2 deletions
diff --git a/src/package.lisp b/src/package.lisp index b9eb11c..8b0d0eb 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -87,6 +87,7 @@ #:defproplist #:inapplicable-property #:get-hostattrs + #:get-hostattrs-car #:push-hostattrs #:get-hostname #:require-data diff --git a/src/property.lisp b/src/property.lisp index 421df15..5fc5f56 100644 --- a/src/property.lisp +++ b/src/property.lisp @@ -180,6 +180,9 @@ subroutines at the right time." Called by property :HOSTATTRS, :APPLY and :UNAPPLY subroutines." (getf (slot-value *host* 'hostattrs) k)) +(defun get-hostattrs-car (k) + (car (get-hostattrs k))) + (defun push-hostattrs (k &rest vs) "Push new static informational attributes VS of type KEY. @@ -198,4 +201,4 @@ Called by property :HOSTATTRS subroutines." "Get the hostname of the host to which properties are being applied. Called by property subroutines." - (car (get-hostattrs :hostname))) + (get-hostattrs-car :hostname)) diff --git a/src/property/os.lisp b/src/property/os.lisp index 937e3c5..fb5ef44 100644 --- a/src/property/os.lisp +++ b/src/property/os.lisp @@ -22,7 +22,7 @@ "Error out if the OS of the host being deployed is not of type TYPE. Used in property :HOSTATTRS subroutines." - (let ((os (class-of (car (get-hostattrs :os))))) + (let ((os (class-of (get-hostattrs-car :os)))) (unless (and os (subtypep os type)) (error 'inapplicable-property :text #?"Property requires OS of type ${type}")))) |