Partial implementation of fix for :clean-targets sanity checking (issue

technomancy#1458)

src/leiningen/clean.clj

@@ -2,7 +2,8 @@
   "Remove all files from project's target-path."
   (:require [clojure.java.io :as io]
             [leiningen.core.eval :as eval]
-            [leiningen.core.utils :as utils]))
+            [leiningen.core.utils :as utils])
+  (:import [java.io IOException]))
 
 (defn real-directory?
   "Returns true if this file is a real directory, false if it is a symlink or a
@@ -24,6 +25,40 @@ Raise an exception if any deletion fails unless silently is true."
     (.setWritable f true)
     (io/delete-file f silently)))
 
+(defn ancestor?
+  "Is a and ancestor of b?"
+  [a b]
+  (let [hypothetical-ancestor (.getCanonicalPath (io/file a))
+        hypothetical-descendant (.getCanonicalPath (io/file b))]
+    (and (.startsWith hypothetical-descendant hypothetical-ancestor)
+         (not (= hypothetical-descendant hypothetical-ancestor)))))
+
+(defn protected-paths
+  "Returns a set of leiningen project source directories and important files."
+  [project]
+  (->> [:source-paths :java-source-paths :test-paths :resource-paths]
+     (select-keys project)
+     vals
+     flatten
+     (cons "doc")
+     (cons "project.clj")
+     (map io/file)
+     set))
+
+(defn protected-path?
+  "Is dir one of the leiningen project directories (which we expect to be version controlled)?"
+  [project dir]
+  ((protected-paths project) (io/file dir)))
+
+(defn sanity-check
+  "Ensure that a clean-target string refers to a directory that is sensible to delete."
+  [project clean-target]
+  (when (string? clean-target)
+    (cond (not (ancestor? (:root project) clean-target))
+          (throw (IOException. "Deleting the project root directory or its ancestors is not allowed."))
+          (protected-path? project clean-target)
+          (throw (IOException. "Deleting non-target project directories is not allowed.")))))
+
 (defn clean
   "Remove all files from paths in project's clean-targets."
   [project]
@@ -32,7 +67,5 @@ Raise an exception if any deletion fails unless silently is true."
                             (keyword? target-key) (target-key project)
                             (string? target-key) target-key)]
       (doseq [f (flatten [target])]
+        (sanity-check project f)
         (delete-file-recursively f :silently)))))
-
-
-

test/leiningen/test/clean.clj

@@ -20,7 +20,7 @@
                         (.createNewFile (file target-dir "foo.tmp")))
                       (f)))
 
-;; TODO test explicit :clean-targets with ancestor string path "..","/"
+;; TODO test explicit :clean-targets with ancestor string path "../xyz","/"
 ;; TODO test explicit :clean-targets with src dir string paths.
 
 (deftest test-default-clean-target
@@ -54,21 +54,29 @@
     (is (not (.exists (file target-3))))))
 
 (comment
-  ;; this test is not yet safe to run
+  ;; this test may not safe to run
+  ;; screw this up and you may be deleting important files on your system
  (deftest test-explicit-clean-targets-with-invalid-string-paths
-   (testing "ancestor paths of the project root"
-     (doseq [ancestor ["../../xyz" "/xyz"]]
+   (testing "ancestor paths of the project root and project dirs"
+     (doseq [ancestor ["../../xyz" "/xyz"
+                       "src" "test" "doc" "resources"]]
        (let [modified-project
              (assoc sample-project
                :clean-targets [ancestor])]
          (is (thrown? java.io.IOException)
              (clean modified-project))
-         (is (.exists (file target-1))))))
+         (is (.exists (file ancestor))))))
 
-   (testing "standard lein project dir paths (non-target)"
-     )))
+   (sort (keys sample-project))
 
 
+   (->> [:source-paths :java-source-paths :test-paths :resource-paths]
+        (select-keys sample-project)
+        vals
+        flatten
+        (map file)
+        set)
+   ))
 
-#_(run-tests)
 
+#_(run-tests)