diff options
| author | Sean Whitton <spwhitton@spwhitton.name> | 2021-08-21 15:15:13 -0700 |
|---|---|---|
| committer | Sean Whitton <spwhitton@spwhitton.name> | 2021-08-22 13:33:38 -0700 |
| commit | 034c65c8063f6e9ca05f73ae854bf567eaada6ae (patch) | |
| tree | d76d732fb56785d33f69b5bc662523c37a190fda | |
| parent | 21ebb981f5ed2d84640b1ed7e19318c2fa9dff88 (diff) | |
| download | consfigurator-034c65c8063f6e9ca05f73ae854bf567eaada6ae.tar.gz | |
MOUNT:UNMOUNTED-BELOW: add :AND-AT argument
Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
| -rw-r--r-- | src/property/mount.lisp | 10 |
1 files changed, 7 insertions, 3 deletions
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)) |