From 195f95efd1d28523eee9fdebd316501a87c163c7 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 31 May 2021 14:16:56 -0700 Subject: add DISK:HOST-LOGICAL-VOLUMES-EXIST Signed-off-by: Sean Whitton --- src/property/disk.lisp | 41 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 41 insertions(+) (limited to 'src/property/disk.lisp') diff --git a/src/property/disk.lisp b/src/property/disk.lisp index 436116f..5afd4e3 100644 --- a/src/property/disk.lisp +++ b/src/property/disk.lisp @@ -490,6 +490,35 @@ We do not specify what logical volumes it contains.")) (mrun :inform "vgextend" (volume-group volume) file) (mrun :inform "vgcreate" "--systemid" "" (volume-group volume) file))) +(defprop host-lvm-logical-volumes-exist :posix () + (:desc "Host LVM logical volumes all exist") + (:apply + (loop initially (assert-euid-root) + with existing-lvs + = (loop for (lv vg) in (mapcar #'words (cdr (runlines "lvs"))) + collect (cons lv vg)) + ;; We assume that the VGs are already active. + with vgs + = (loop for volume in (get-hostattrs :volumes) + when (subtypep (class-of volume) 'lvm-volume-group) + collect (make-opened-volume volume nil)) + + for vg in vgs + for new-contents + = (loop for lv in (volume-contents vg) + unless (member (cons (volume-label lv) (volume-label vg)) + existing-lvs :test #'equal) + collect lv) + when new-contents + do (setf (volume-contents vg) new-contents) + and collect vg into to-create + + ;; Here we rely on how CREATE-VOLUMES-AND-CONTENTS won't try to close + ;; OPENED-VOLUMEs. + finally (return (if to-create + (create-volumes-and-contents to-create) + :no-change))))) + ;;;; Filesystems @@ -899,6 +928,18 @@ Do not apply in DEFHOST. Apply with DEPLOY-THESE/HOSTDEPLOY-THESE." (:desc "Host volumes created") (:apply (create-volumes-and-contents (get-hostattrs :volumes)))) +;; TODO Possibly we want (a version of) this to not fail, but just do nothing, +;; if the relevant volume groups etc. are inactive? +(defproplist host-logical-volumes-exist :lisp () + "Create missing logical volumes, like LVM logical volumes and BTRFS +subvolumes, as specified by DISK:HAS-VOLUMES. Does not delete or overwrite +anything. Intended to make it easy to add new logical volumes by just editing +the volumes specification. + +Currently only creation of LVM logical volumes is implemented." + (:desc "Host logical volumes all exist") + (host-lvm-logical-volumes-exist)) + ;;;; Utilities -- cgit v1.2.3