diff options
author | Sean Whitton <spwhitton@spwhitton.name> | 2021-05-28 14:17:47 -0700 |
---|---|---|
committer | Sean Whitton <spwhitton@spwhitton.name> | 2021-05-29 08:43:57 -0700 |
commit | 19d02c44af576e8c43229091308f5ef218917c28 (patch) | |
tree | 088a74a7d74747866017777814acf45704055764 /src/property | |
parent | 451b63e0481090813d060d231a0fee30c125eb30 (diff) | |
download | consfigurator-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.lisp | 4 | ||||
-rw-r--r-- | src/property/disk.lisp | 6 | ||||
-rw-r--r-- | src/property/libvirt.lisp | 11 | ||||
-rw-r--r-- | src/property/live-build.lisp | 2 | ||||
-rw-r--r-- | src/property/os.lisp | 2 |
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) |