diff options
author | Sean Whitton <spwhitton@spwhitton.name> | 2022-07-23 15:19:08 -0700 |
---|---|---|
committer | Sean Whitton <spwhitton@spwhitton.name> | 2022-07-23 16:40:16 -0700 |
commit | b8ca88da57e0eaa8f9c789c5fc630586b983e4fd (patch) | |
tree | 9c5b10e1555f463d596e7671da28854904970a2f | |
parent | d356d175f5ee9a844816cb593ec8f1fe7ceee2f0 (diff) | |
download | consfigurator-b8ca88da57e0eaa8f9c789c5fc630586b983e4fd.tar.gz |
DISK:WITH-OPENED-VOLUMES: add support for leaving the volumes open
Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
-rw-r--r-- | src/property/disk.lisp | 15 |
1 files changed, 9 insertions, 6 deletions
diff --git a/src/property/disk.lisp b/src/property/disk.lisp index 980c268..e2597c1 100644 --- a/src/property/disk.lisp +++ b/src/property/disk.lisp @@ -751,11 +751,12 @@ populate /etc/fstab and /etc/crypttab. Do not modify this list." (mapc #'close-volume ,opened-volumes))))) (defmacro with-opened-volumes - ((volumes &key (mount-below nil mount-below-supplied-p)) &body propapps) + ((volumes &key (mount-below nil mount-below-supplied-p) leave-open) + &body propapps) "Macro property combinator. Where each of VOLUMES is a VOLUME which may be opened by calling OPEN-VOLUME with NIL as the second argument, recursively -open each of VOLUMES and any contents thereof, apply PROPAPPS, and close all -volumes that were opened. +open each of VOLUMES and any contents thereof, apply PROPAPPS, and, unless +LEAVE-OPEN, close all volumes that were opened. MOUNT-BELOW specifies a pathname to prefix to mount points when opening FILESYSTEM volumes. During the application of PROPAPPS, all @@ -765,10 +766,11 @@ volumes; the former must not be modified." `(with-opened-volumes* ',volumes ,(if (cdr propapps) `(eseqprops ,@propapps) (car propapps)) - ,@(and mount-below-supplied-p `(:mount-below ,mount-below)))) + ,@(and mount-below-supplied-p `(:mount-below ,mount-below)) + :leave-open ,leave-open)) (define-function-property-combinator with-opened-volumes* - (volumes propapp &key (mount-below nil mount-below-supplied-p)) + (volumes propapp &key (mount-below nil mount-below-supplied-p) leave-open) (:retprop :type (propapp-type propapp) :hostattrs (lambda-ignoring-args @@ -784,7 +786,8 @@ volumes; the former must not be modified." 'opened-volume-parents parents) (unwind-protect (apply-propapp propapp) (mrun "sync") - (mapc #'close-volume (get-connattr 'opened-volumes)))))) + (unless leave-open + (mapc #'close-volume (get-connattr 'opened-volumes))))))) :args (cdr propapp))) (defun create-volumes-and-contents (volumes &optional files) |