Fix #119: add force flag to delete-tree (#120)

CHANGELOG.md

@@ -6,6 +6,7 @@ Babashka [fs](https://github.com/babashka/fs): file system utility library for C
 
 ## Unreleased
 
+- [#119](https://github.com/babashka/fs/issues/119): `fs/delete-tree`: add `:force` flag to delete read-only directories/files. Set the flag to true in  `fs/with-temp-dir`.
 - [#102](https://github.com/babashka/fs/issues/102): add `gzip` and `gunzip` functions
 - [#113](https://github.com/babashka/fs/issues/113): `fs/glob`: enable `:hidden` (when not already set) when `pattern` starts with dot ([@eval](https://github.com/eval)).
 - [#117](https://github.com/babashka/fs/issues/117): fix `fs/match` and `fs/glob` not finding files in root-folder ([@eval](https://github.com/eval)).

src/babashka/fs.cljc

@@ -13,8 +13,9 @@
             StandardCopyOption
             LinkOption Path
             FileVisitor]
-           [java.nio.file.attribute BasicFileAttributes FileAttribute FileTime PosixFilePermissions]
+           [java.nio.file.attribute BasicFileAttributes FileAttribute FileTime PosixFilePermissions PosixFilePermission]
            [java.nio.charset Charset]
+           [java.util HashSet]
            [java.util.zip GZIPInputStream GZIPOutputStream ZipInputStream ZipOutputStream ZipEntry]
            [java.io File BufferedInputStream FileInputStream FileOutputStream]))
 
@@ -558,17 +559,40 @@
   [f]
   (Files/isSymbolicLink (as-path f)))
 
+(declare posix-file-permissions)
+(declare set-posix-file-permissions)
+
+(defn- u+wx
+  [f]
+  (if win?
+    (.setWritable (file f) true)
+    (let [^HashSet perms (posix-file-permissions f)
+          p1 (.add perms PosixFilePermission/OWNER_WRITE)
+          p2 (.add perms PosixFilePermission/OWNER_EXECUTE)]
+      (when (or p1 p2)
+        (set-posix-file-permissions f perms)))))
+
 (defn delete-tree
-  "Deletes a file tree using `walk-file-tree`. Similar to `rm -rf`. Does not follow symlinks."
-  [root]
-  (when (exists? root)
-    (walk-file-tree root
-                    {:visit-file (fn [path _]
-                                   (delete path)
-                                   :continue)
-                     :post-visit-dir (fn [path _]
-                                       (delete path)
-                                       :continue)})))
+  "Deletes a file tree using `walk-file-tree`. Similar to `rm -rf`. Does not follow symlinks.
+   `force` ensures read-only directories/files are deleted. Similar to `chmod -R +wx` + `rm -rf`"
+  ;; See delete-permission-assumptions-test
+  ;; Implementation with the force flag is based on those assumptions
+  ([root] (delete-tree root nil))
+  ([root {:keys [force]}]
+   (when (exists? root)
+     (walk-file-tree root
+                     {:visit-file (fn [path _]
+                                    (when (and win? force)
+                                      (.setWritable (file path) true))
+                                    (delete path)
+                                    :continue)
+                      :pre-visit-dir (fn [path _]
+                                       (when force
+                                         (u+wx path))
+                                       :continue)
+                      :post-visit-dir (fn [path _]
+                                        (delete path)
+                                        :continue)}))))
 
 (defn create-file
   "Creates empty file using `Files#createFile`."
@@ -1078,7 +1102,7 @@
      (try
        ~@body
        (finally
-         (delete-tree ~binding-name)))))
+         (delete-tree ~binding-name {:force true})))))
 
 (def ^:private cached-home-dir
   (delay (path (System/getProperty "user.home"))))

test/babashka/fs_test.clj

@@ -228,6 +228,43 @@
   (let [paths (map str (fs/list-dir (fs/real-path ".") "*.clj"))]
     (is (pos? (count paths)))))
 
+(deftest delete-permission-assumptions-test
+  (let [tmp-dir (temp-dir)
+        dir (fs/path tmp-dir "my-dir")
+        file (fs/path tmp-dir "my-dir" "my-file")
+        _ (fs/create-dir dir)]
+    (when (not windows?)
+      (testing "On Unix, read-only files can be deleted"
+        (fs/create-file file)
+        (fs/set-posix-file-permissions file "r--r--r--")
+        (is (nil? (fs/delete file))))
+      (testing "On Unix, files in a read-only directory cannot be deleted"
+        (fs/create-file file)
+        (fs/set-posix-file-permissions dir "r--------")
+        (is (thrown? java.nio.file.AccessDeniedException (fs/delete file)))
+        (fs/set-posix-file-permissions dir "--x------")
+        (is (thrown? java.nio.file.AccessDeniedException (fs/delete file)))
+        (fs/set-posix-file-permissions dir "r-x------")
+        (is (thrown? java.nio.file.AccessDeniedException (fs/delete file)))
+        (fs/set-posix-file-permissions dir "rwx------")
+        (is (nil? (fs/delete file)))))
+    (when windows?
+      (testing "On Windows, .setWritable is idempotent"
+        (fs/create-file file)
+        (.setWritable (fs/file file) true)
+        (.setWritable (fs/file file) true)
+        (is (nil? (fs/delete file))))
+      (testing "On Windows, read-only files can't be deleted"
+        (fs/create-file file)
+        (.setWritable (fs/file file) false)
+        (is (thrown? Exception (fs/delete file)))
+        (.setWritable (fs/file file) true)
+        (is (nil? (fs/delete file))))
+      (testing "On Windows, files in a read-only directory can be deleted"
+        (fs/create-file file)
+        (.setWritable (fs/file dir) false)
+        (is (nil? (fs/delete file)))))))
+
 (deftest delete-tree-test
   (let [tmp-dir1 (temp-dir)
         nested-dir (fs/file tmp-dir1 "foo" "bar" "baz")
@@ -254,7 +291,25 @@
         (is (not (fs/exists? link)))
         (is (fs/exists? tmp-file))
         (is (fs/exists? tmp-dir2))
-        (is (not (fs/exists? tmp-dir1)))))))
+        (is (not (fs/exists? tmp-dir1)))))
+
+    (testing "delete-tree force deletes read-only directories and files"
+      (let [tmp-dir (temp-dir)
+            dir (fs/path tmp-dir "my-dir")
+            file (fs/path tmp-dir "my-dir" "my-file")
+            _ (fs/create-dir dir)
+            _ (fs/create-file file)]
+        (if windows?
+          (do
+            (.setWritable (fs/file file) false)
+            (.setWritable (fs/file dir) false))
+          (do
+            (fs/set-posix-file-permissions file "r--r--r--")
+            (fs/set-posix-file-permissions dir "r--r--r--")))
+        (is (fs/exists? dir))
+        (fs/delete-tree tmp-dir {:force true})
+        (is (not (fs/exists? tmp-dir)))
+        (is (not (fs/exists? dir)))))))
 
 (deftest move-test
   (let [src-dir (fs/create-temp-dir)
@@ -338,7 +393,7 @@
           (is (= [(fs/path "./off-path/foo.foo") (fs/path "./on-path/foo.foo")]
                  (fs/which-all "foo.foo" {:paths ["./off-path" "./on-path"]})))
           (is (= (fs/path "./off-path/foo.foo")
-                 (fs/which "foo.foo" {:paths ["./off-path" "./on-path"]})))          )))
+                 (fs/which "foo.foo" {:paths ["./off-path" "./on-path"]}))))))
     (testing "'which' shouldn't find directories"
       (is (nil? (fs/which "path-subdir"))))
     (testing "'which' shouldn't find non executables"
@@ -577,6 +632,26 @@
         (is (not (fs/exists? (fs/path @capture-dir "xx"))))
         (is (not (fs/exists? @capture-dir)))))))
 
+(deftest with-temp-dir-read-only-test
+  (let [capture-dir (volatile! nil)]
+    (fs/with-temp-dir [tmp-dir {:prefix "with-temp-dir-read-only-test"}]
+      (vreset! capture-dir tmp-dir)
+      (let [dir (fs/path tmp-dir "my-dir")
+            file (fs/path tmp-dir "my-dir" "my-file")
+            _ (fs/create-dir dir)
+            _ (fs/create-file file)]
+        (if windows?
+          (do
+            (.setWritable (fs/file file) false)
+            (.setWritable (fs/file dir) false))
+          (do
+            (fs/set-posix-file-permissions file "r--r--r--")
+            (fs/set-posix-file-permissions dir "r--r--r--")))))
+    (testing "deletes its directory and contents (read-only) on exit from the scope"
+      (is (not (fs/exists? (fs/path @capture-dir "my-dir" "my-file"))))
+      (is (not (fs/exists? (fs/path @capture-dir "my-dir")))
+        (is (not (fs/exists? @capture-dir)))))))
+
 (deftest home-test
   (let [user-home (fs/path (System/getProperty "user.home"))
         user-dir (fs/parent user-home)]
@@ -740,3 +815,4 @@
                 fs/delete-on-exit)
           file-in-dir (fs/create-temp-file {:dir dir})]
       (is (= (str (fs/owner dir)) (str (fs/owner file-in-dir)))))))
+