From c85b361044c1621b2d48597da36e427618aabc67 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 3 Apr 2022 09:41:01 -0700 Subject: add PUSH-HOSTATTR, don't use &rest in PUSH-HOSTATTRS & fix docstring Signed-off-by: Sean Whitton --- src/deployment.lisp | 2 +- src/host.lisp | 2 +- src/package.lisp | 1 + src/property.lisp | 10 ++++++++-- src/property/container.lisp | 2 +- src/property/disk.lisp | 2 +- src/property/hostname.lisp | 2 +- src/property/os.lisp | 20 ++++++++++---------- src/property/postgres.lisp | 2 +- src/property/schroot.lisp | 4 ++-- src/property/service.lisp | 2 +- src/property/sshd.lisp | 2 +- src/property/timezone.lisp | 2 +- 13 files changed, 30 insertions(+), 23 deletions(-) diff --git a/src/deployment.lisp b/src/deployment.lisp index b28fc69..52e0eda 100644 --- a/src/deployment.lisp +++ b/src/deployment.lisp @@ -331,7 +331,7 @@ Connection attributes, by contrast, are propagated as usual." collect (car cell) into accum finally (if (eql k :data) (pushnew-hostattrs :data (nreverse accum)) - (apply #'push-hostattrs k (nreverse accum))))) + (push-hostattrs k (nreverse accum))))) (dolist (system (propspec-systems (host-propspec host))) (pushnew system (slot-value (host-propspec *host*) 'systems))) (setf (getf properties :host) host))) diff --git a/src/host.lisp b/src/host.lisp index 0f4106f..c8c882c 100644 --- a/src/host.lisp +++ b/src/host.lisp @@ -197,4 +197,4 @@ entries." (defprop has-hostattrs :posix (k &rest vs) "Push hostattrs VS of type K." (:desc (format nil "Has hostattr~P ~A ~{~A~^, ~}" (length vs) k vs)) - (:hostattrs (apply #'push-hostattrs k vs))) + (:hostattrs (push-hostattrs k vs))) diff --git a/src/package.lisp b/src/package.lisp index 953732a..6ddb49a 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -208,6 +208,7 @@ #:get-hostattrs-car #:get-parent-hostattrs #:get-parent-hostattrs-car + #:push-hostattr #:push-hostattrs #:pushnew-hostattr #:pushnew-hostattrs diff --git a/src/property.lisp b/src/property.lisp index 10d9cf2..804f4cb 100644 --- a/src/property.lisp +++ b/src/property.lisp @@ -517,8 +517,14 @@ Called by property :HOSTATTRS, :APPLY and :UNAPPLY subroutines." (defun get-parent-hostattrs-car (k &optional (host *host*)) (car (get-parent-hostattrs k host))) -(defun push-hostattrs (k &rest vs) - "Push new static informational attributes VS of type KEY. +(defun push-hostattr (k v) + "Push new static informational attribute V of type K. + +Called by property :HOSTATTRS subroutines." + (push v (getf (slot-value *host* 'hostattrs) k))) + +(defun push-hostattrs (k vs) + "Push new static informational attributes VS of type K. Called by property :HOSTATTRS subroutines." (setf (getf (slot-value *host* 'hostattrs) k) diff --git a/src/property/container.lisp b/src/property/container.lisp index b23d3df..a269b91 100644 --- a/src/property/container.lisp +++ b/src/property/container.lisp @@ -39,7 +39,7 @@ This property is usually set by properties which establish containers, like CHROOT:OS-BOOTSTRAPPED, rather than being added to DEFHOST forms." (:desc (format nil "~{~(~S~)~^, ~} ~:*~1{~#[are~;is~:;are~]~} contained" contained)) - (:hostattrs (apply #'push-hostattrs 'iscontained contained))) + (:hostattrs (push-hostattrs 'iscontained contained))) (defmacro when-contained ((&rest contained) &body propapps) "Macro property combinator. Apply each of PROPAPPS only when outside of any diff --git a/src/property/disk.lisp b/src/property/disk.lisp index 52a9047..582bcf5 100644 --- a/src/property/disk.lisp +++ b/src/property/disk.lisp @@ -818,7 +818,7 @@ the LVM physical volumes corresponding to those volume groups." (:desc "Has specified volumes.") (:hostattrs (os:required 'os:linux) - (apply #'push-hostattrs :volumes volumes))) + (push-hostattrs :volumes volumes))) ;; TODO This should probably be in another package, and exported from there. (defproplist caches-cleaned :posix () diff --git a/src/property/hostname.lisp b/src/property/hostname.lisp index da1610e..f4d4d8e 100644 --- a/src/property/hostname.lisp +++ b/src/property/hostname.lisp @@ -28,7 +28,7 @@ Useful for hosts implicitly defined inline using dotted propapp notation. Unlikely to be useful for hosts defined using DEFHOST." (:desc #?"Hostname is ${hostname}") - (:hostattrs (push-hostattrs :hostname hostname))) + (:hostattrs (push-hostattr :hostname hostname))) (defpropspec configured :posix (&optional (hostname (get-hostname) hostname-supplied-p) diff --git a/src/property/os.lisp b/src/property/os.lisp index 65fdc6a..7fd5f25 100644 --- a/src/property/os.lisp +++ b/src/property/os.lisp @@ -30,7 +30,7 @@ (defprop linux :posix (architecture) (:desc "Host kernel is Linux") - (:hostattrs (push-hostattrs :os (make-instance 'linux :arch architecture)))) + (:hostattrs (push-hostattr :os (make-instance 'linux :arch architecture)))) (define-simple-print-object linux) @@ -53,9 +53,9 @@ (declare (ignore architecture)) #?{Host is Debian "${suite}"}) (:hostattrs - (push-hostattrs :os - (make-instance 'debian-stable - :arch architecture :suite suite)))) + (push-hostattr :os + (make-instance 'debian-stable + :arch architecture :suite suite)))) (defclass debian-testing (debian) ((suite :initform "testing"))) @@ -68,9 +68,9 @@ (declare (ignore architecture)) "Host is Debian testing") (:hostattrs - (push-hostattrs :os - (make-instance 'debian-testing - :arch architecture)))) + (push-hostattr :os + (make-instance 'debian-testing + :arch architecture)))) (defclass debian-unstable (debian) ((suite :initform "unstable"))) @@ -83,9 +83,9 @@ (declare (ignore architecture)) "Host is Debian unstable") (:hostattrs - (push-hostattrs :os - (make-instance 'debian-unstable - :arch architecture)))) + (push-hostattr :os + (make-instance 'debian-unstable + :arch architecture)))) (defclass debian-experimental (debian) ((suite :initform "experimental"))) diff --git a/src/property/postgres.lisp b/src/property/postgres.lisp index dae00e7..4eb4dcd 100644 --- a/src/property/postgres.lisp +++ b/src/property/postgres.lisp @@ -28,7 +28,7 @@ "Record Postgres superuser" (:desc "postgres superuser is ${name}") (:hostattrs - (push-hostattrs 'postgres-superuser name))) + (push-hostattr 'postgres-superuser name))) (defprop %psql :posix (sql &key unless) (:check diff --git a/src/property/schroot.lisp b/src/property/schroot.lisp index 2e6cb40..0851e9b 100644 --- a/src/property/schroot.lisp +++ b/src/property/schroot.lisp @@ -31,7 +31,7 @@ Adding this property does not actually ensure that the line 'union-type=overlay' is present in any schroot config files. See SBUILD:BUILT for example usage, via SCHROOT:OVERLAYS-IN-TMPFS." (:desc "schroots on host use union-type=overlay") - (:hostattrs (push-hostattrs 'uses-overlays t))) + (:hostattrs (push-hostattr 'uses-overlays t))) (defprop overlays-in-tmpfs :posix () "Configure schroot(1) such that all schroots with 'union-type=overlay' in @@ -43,7 +43,7 @@ Implicitly sets SCHROOT:USES-OVERLAYS. Shell script from ." (:desc "schroot overlays in tmpfs") - (:hostattrs (push-hostattrs 'uses-overlays t)) + (:hostattrs (push-hostattr 'uses-overlays t)) (:apply (file:has-content "/etc/schroot/setup.d/04tmpfs" #>EOF>#!/bin/sh diff --git a/src/property/service.lisp b/src/property/service.lisp index 6650244..3074103 100644 --- a/src/property/service.lisp +++ b/src/property/service.lisp @@ -28,7 +28,7 @@ (defprop %no-services :posix () (:hostattrs - (push-hostattrs :no-services t))) + (push-hostattr :no-services t))) (defprop %policy-rc.d :posix () (:apply diff --git a/src/property/sshd.lisp b/src/property/sshd.lisp index ba224e0..7f35195 100644 --- a/src/property/sshd.lisp +++ b/src/property/sshd.lisp @@ -54,7 +54,7 @@ refuses to proceed if root has no authorized_keys." (defprop has-host-public-key :posix (type public-key) "Records an SSH public key of type TYPE as identifying this host." (:desc #?"Has SSH host key of type ${type}") - (:hostattrs (push-hostattrs 'host-public-key (cons type public-key)))) + (:hostattrs (push-hostattr 'host-public-key (cons type public-key)))) (defproplist has-host-key :posix (type public-key) "Installs the host key whose public part is PUBLIC-KEY and is of type TYPE. diff --git a/src/property/timezone.lisp b/src/property/timezone.lisp index 6474b3d..c3a5a32 100644 --- a/src/property/timezone.lisp +++ b/src/property/timezone.lisp @@ -21,7 +21,7 @@ (defproplist configured :posix (timezone) "Set the system timezone. TIMEZONE is a relative path under /usr/share/zoneinfo, e.g. \"Europe/London\"." - (:hostattrs (push-hostattrs 'timezone timezone)) + (:hostattrs (push-hostattr 'timezone timezone)) (os:etypecase (linux (file:symlinked :from "/etc/localtime" -- cgit v1.2.3