From 472e13164a150af1a010179fc94558c6305836d3 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 21 Aug 2021 15:15:39 -0700 Subject: MOUNT:UNMOUNTED-BELOW-AND-REMOVED: don't unmount DIR itself If DIR is itself a mount point then previously we would never delete its contents because the unmounting is done first. This meant that when MOUNT:UNMOUNTED-BELOW-AND-REMOVED was used to remove the root filesystem of a container or virtual machine, for example, then whether the contents of the root filesystem was actually deleted depended upon whether DIR happened to be a mount point. This change ensures that the deletion is always done. Signed-off-by: Sean Whitton --- src/connection.lisp | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'src/connection.lisp') diff --git a/src/connection.lisp b/src/connection.lisp index 9159a02..782160a 100644 --- a/src/connection.lisp +++ b/src/connection.lisp @@ -481,6 +481,11 @@ subclass to the :HOSTATTRS subroutine of properties calling this." "Recursively delete each of PATHS." (mrun "rm" "-rf" paths)) +(defun empty-remote-directory (directory) + "Recursively delete the contents of DIRECTORY, but not DIRECTORY itself." + (let ((d (escape-sh-token (drop-trailing-slash (unix-namestring directory))))) + (mrun (format nil "rm -rf -- ~A/* ~A/.[!.]* ~A/..?*" d d d)))) + (defun remote-exists-p (&rest paths) "Does each of PATHS exists? PATH may be any kind of file, including directories." -- cgit v1.2.3