diff options
author | Sean Whitton <spwhitton@spwhitton.name> | 2021-08-08 18:53:01 -0700 |
---|---|---|
committer | Sean Whitton <spwhitton@spwhitton.name> | 2021-08-22 13:25:50 -0700 |
commit | 21ebb981f5ed2d84640b1ed7e19318c2fa9dff88 (patch) | |
tree | d0085850979d52a0bcd3a21a465cd648693b8658 | |
parent | e4a27593009b650b7f7b17cd8775997fedb1fffa (diff) | |
download | consfigurator-21ebb981f5ed2d84640b1ed7e19318c2fa9dff88.tar.gz |
make LIBVIRT:KVM-BOOTS-CHROOT{,-FOR} unapplicable
Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
-rw-r--r-- | src/package.lisp | 1 | ||||
-rw-r--r-- | src/property/libvirt.lisp | 70 |
2 files changed, 42 insertions, 29 deletions
diff --git a/src/package.lisp b/src/package.lisp index adb6182..d5aed60 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -669,6 +669,7 @@ #:default-network-autostarted #:defined #:started + #:destroyed #:when-started #:kvm-boots-chroot-for #:kvm-boots-chroot-for. diff --git a/src/property/libvirt.lisp b/src/property/libvirt.lisp index d07073c..54e7991 100644 --- a/src/property/libvirt.lisp +++ b/src/property/libvirt.lisp @@ -101,6 +101,12 @@ is a HOST value, start the libvirt domain whose name is HOST's hostname.)" (:check (host-domain-started-p host)) (:apply (mrun "virsh" "start" (get-hostname host)))) +(defprop destroyed :posix (host) + "Ensure the libvirt domain for the host designated by HOST is destroyed." + (:desc #?"libvirt domain ${(get-hostname host)} destroyed") + (:check (not (host-domain-started-p host))) + (:apply (mrun "virsh" "destroy" (get-hostname host)))) + (defmacro when-started (host &body propapps) "Apply PROPAPPS only when the libvirt domain for the host designated by HOST is already running. @@ -258,37 +264,43 @@ your preferred VM networking setup and corresponding DEPLOYS propapp." "/etc/initramfs-tools/modules" "virtiofs")) (cmd:single "update-initramfs" "-u")))))))) options - `(eseqprops - (installed) - (file:contains-conf-equals "/etc/libvirt/qemu.conf" - "memory_backing_dir" #?'"/dev/shm"') - ,@(if always-deploys - `((chroot:os-bootstrapped-for - ,chroot-options ,chroot ,host ,additional-properties) - ;; Create the flagfile anyway in case ALWAYS-DEPLOYS is - ;; changed t->nil right after this deploy. - (file:has-content ,flagfile "")) - `((with-flagfile ,flagfile - (chroot:os-bootstrapped-for - ,chroot-options ,chroot ,host ,additional-properties)))) - (defined ,host* - ,(format nil "--vcpus=~D" vcpus) ,(format nil "--memory=~D" memory) - "--filesystem" - ,(format - nil + `(with-unapply + (installed) + (file:contains-conf-equals "/etc/libvirt/qemu.conf" + "memory_backing_dir" #?'"/dev/shm"') + ,@(if always-deploys + `((chroot:os-bootstrapped-for + ,chroot-options ,chroot ,host ,additional-properties) + ;; Create the flagfile anyway in case ALWAYS-DEPLOYS is + ;; changed t->nil right after this deploy. + (file:has-content ,flagfile "")) + `((with-flagfile ,flagfile + (chroot:os-bootstrapped-for + ,chroot-options ,chroot ,host ,additional-properties)))) + (defined ,host* + ,(format nil "--vcpus=~D" vcpus) ,(format nil "--memory=~D" memory) + "--filesystem" + ,(format + nil "type=mount,accessmode=passthrough,driver.type=virtiofs,source.dir=~A,target.dir=rootfs" - chroot) - "--boot" - ,(format - nil + chroot) + "--boot" + ,(format + nil "kernel=~A,initrd=~A,kernel_args=\"root=rootfs rootfstype=virtiofs rw~:[~; ~:*~A~]\"" - (ensure-pathname kernel :defaults chroot :ensure-absolute t) - (ensure-pathname initrd :defaults chroot :ensure-absolute t) - append) - "--memorybacking=access.mode=shared" - ,@(and autostart '("--autostart")) - ,@virt-options) - ,@(and autostart `((started ,host)))))) + (ensure-pathname kernel :defaults chroot :ensure-absolute t) + (ensure-pathname initrd :defaults chroot :ensure-absolute t) + append) + "--memorybacking=access.mode=shared" + ,@(and autostart '("--autostart")) + ,@virt-options) + ,@(and autostart `((started ,host))) + :unapply + (destroyed ,host*) + (unapply (defined ,host*)) + (unapply (with-flagfile ,flagfile + (chroot:os-bootstrapped-for + ,chroot-options ,chroot ,host ,additional-properties)))))) (defproplist kvm-boots-chroot :lisp (options properties) "Like LIBVIRT:KVM-BOOTS-CHROOT-FOR but define a new host using PROPERTIES." |