From 034c65c8063f6e9ca05f73ae854bf567eaada6ae Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 21 Aug 2021 15:15:13 -0700 Subject: MOUNT:UNMOUNTED-BELOW: add :AND-AT argument Signed-off-by: Sean Whitton --- src/property/mount.lisp | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) (limited to 'src/property/mount.lisp') diff --git a/src/property/mount.lisp b/src/property/mount.lisp index e0c3430..c00ed23 100644 --- a/src/property/mount.lisp +++ b/src/property/mount.lisp @@ -29,8 +29,8 @@ the mount is not actually active." (file:directory-exists target) (mrun "mount" target))) -(defprop unmounted-below :posix (dir) - "Unmount anything mounted at or below DIR. +(defprop unmounted-below :posix (dir &key (and-at t)) + "Unmount anything mounted below DIR, and when AND-AT, anything mounted at DIR. Not aware of shared subtrees, so you might need to use the --make-rslave option to mount(8) first. For example, if you did 'mount --rbind /dev @@ -66,7 +66,11 @@ this property will empty /dev, breaking all kinds of things." ;; /proc, and the second can't be removed until the bind mount is ;; removed. (This situation arises because :CHROOT.FORK connections bind ;; mount the chroot on itself if it is not already a mount point.) - (loop with sorted = (all-mounts dir) + (loop with sorted + = (if and-at + (all-mounts dir) + (delete (ensure-directory-pathname dir) (all-mounts dir) + :test #'pathname-equal)) as next = (pop sorted) while next do (loop while (subpathp (car sorted) next) do (pop sorted)) -- cgit v1.2.3