aboutsummaryrefslogtreecommitdiff
path: root/src/property
diff options
context:
space:
mode:
authorSean Whitton <spwhitton@spwhitton.name>2021-05-28 14:17:47 -0700
committerSean Whitton <spwhitton@spwhitton.name>2021-05-29 08:43:57 -0700
commit19d02c44af576e8c43229091308f5ef218917c28 (patch)
tree088a74a7d74747866017777814acf45704055764 /src/property
parent451b63e0481090813d060d231a0fee30c125eb30 (diff)
downloadconsfigurator-19d02c44af576e8c43229091308f5ef218917c28.tar.gz
add optional HOST arg to some accessors for hostattrs
Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
Diffstat (limited to 'src/property')
-rw-r--r--src/property/chroot.lisp4
-rw-r--r--src/property/disk.lisp6
-rw-r--r--src/property/libvirt.lisp11
-rw-r--r--src/property/live-build.lisp2
-rw-r--r--src/property/os.lisp2
5 files changed, 11 insertions, 14 deletions
diff --git a/src/property/chroot.lisp b/src/property/chroot.lisp
index 2ffa879..cdff3d0 100644
--- a/src/property/chroot.lisp
+++ b/src/property/chroot.lisp
@@ -28,7 +28,7 @@
(progn (delete-remote-trees root) nil)
(remote-exists-p (merge-pathnames "usr/lib/os-release" root))))
(:apply
- (let* ((os (car (getf (hostattrs host) :os)))
+ (let* ((os (get-hostattrs-car :os host))
(args (list "debootstrap"
(plist-to-cmd-args options)
(strcat "--arch=" (os:debian-architecture os))
@@ -92,7 +92,7 @@ starting services in the chroot, and set up access to parent hostattrs."
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}")
+ #?"Built chroot for ${(get-hostname host)} @ ${root}")
(%os-bootstrapper-installed child-host*)
(%os-bootstrapped options root child-host*)
(consfigurator:deploys `((:chroot :into ,root)) child-host))
diff --git a/src/property/disk.lisp b/src/property/disk.lisp
index 29e163d..f82460e 100644
--- a/src/property/disk.lisp
+++ b/src/property/disk.lisp
@@ -851,15 +851,13 @@ least the following:
Unless REBUILD, the image will not be repartitioned even if the specification
of the host's volumes changes, although the contents of the image's
filesystems will be incrementally updated when other properties change."
- (:desc (declare (ignore options rebuild))
- (let ((hostname (car (getf (hostattrs host) :hostname))))
- #?"Built image for ${hostname} @ ${image-pathname}"))
+ (:desc #?"Built image for ${(get-hostname host)} @ ${image-pathname}")
(let ((chroot (ensure-directory-pathname
(strcat (unix-namestring image-pathname) ".chroot")))
(volumes
(loop
with found
- for volume in (getf (hostattrs (preprocess-host host)) :volumes)
+ for volume in (get-hostattrs :volumes (preprocess-host host))
for physical-disk-p = (subtypep (type-of volume) 'physical-disk)
if (and physical-disk-p (not found)
(slot-boundp volume 'volume-contents))
diff --git a/src/property/libvirt.lisp b/src/property/libvirt.lisp
index 1e7d41f..9c15625 100644
--- a/src/property/libvirt.lisp
+++ b/src/property/libvirt.lisp
@@ -65,9 +65,7 @@ On Debian, it is not started by default after installation of libvirt."
(defmethod os-variant (os))
-(defprop defined :posix
- (host &rest arguments
- &aux (hostname (car (getf (hostattrs host) :hostname))))
+(defprop defined :posix (host &rest arguments)
"Define a libvirt domain for HOST by providing ARGUMENTS to virt-install(1).
With the current implementation, if ARGUMENTS changes, virt-install(1) will
not be run again. You will need to either unapply and reapply this property,
@@ -76,7 +74,7 @@ or use virt-xml(1) to perform a modification.
Unapplying this property when the domain is running will use the 'undefine'
subcommand of virsh(1) to convert the running domain into a transient domain."
(:check (declare (ignore arguments))
- (remote-exists-p (merge-pathnames (strcat hostname ".xml")
+ (remote-exists-p (merge-pathnames (strcat (get-hostname host) ".xml")
"/etc/libvirt/qemu/")))
(:apply
(with-remote-temporary-file (file)
@@ -84,11 +82,12 @@ subcommand of virsh(1) to convert the running domain into a transient domain."
(format
nil
"virt-install --print-xml -n ~A~:[~; --os-variant=~:*~A~]~{ ~A~} >~S"
- hostname (os-variant host) (mapcar #'escape-sh-token arguments) file))
+ (get-hostname host) (os-variant host)
+ (mapcar #'escape-sh-token arguments) file))
(mrun "virsh" "define" file)))
(:unapply
(declare (ignore arguments))
- (mrun "virsh" "undefine" hostname)))
+ (mrun "virsh" "undefine" (get-hostname host))))
(defun virsh-get-columns (&rest arguments)
"Run a virsh command that is expected to yield tabular output, with the given
diff --git a/src/property/live-build.lisp b/src/property/live-build.lisp
index c83050e..e729234 100644
--- a/src/property/live-build.lisp
+++ b/src/property/live-build.lisp
@@ -99,7 +99,7 @@ and might undo some of their effects. For example, to configure
(merge-pathnames "config/" dir))
'("binary" "bootstrap" "chroot" "common" "source")))
(host (make-host :propspec properties))
- (host-os (car (getf (hostattrs (preprocess-host host)) :os))))
+ (host-os (get-hostattrs-car :os (preprocess-host host))))
(when-let ((mirror (get-hostattrs-car :apt.mirror)))
(setq config (list* "-m" mirror config)))
(setq config (list* "-a" (os:debian-architecture host-os)
diff --git a/src/property/os.lisp b/src/property/os.lisp
index 42d0c5c..cec032d 100644
--- a/src/property/os.lisp
+++ b/src/property/os.lisp
@@ -85,7 +85,7 @@
(defun typecase-host (host)
(class-of (if host
- (car (getf (hostattrs host) :os))
+ (get-hostattrs-car :os host)
(get-hostattrs-car :os))))
(defun typecase-choose (host cases)