diff --git a/src/clojure_mcp/utils/valid_paths.clj b/src/clojure_mcp/utils/valid_paths.clj index cd5a4ed..909f822 100644 --- a/src/clojure_mcp/utils/valid_paths.clj +++ b/src/clojure_mcp/utils/valid_paths.clj @@ -58,16 +58,51 @@ (defn path-exists? [path] (.exists (io/file path))) +(defn- clojure-source-ext? + "Returns true if the file path has a Clojure source extension (.clj, .cljs, .cljc, .cljd) + that follows the dash-to-underscore filename convention." + [file-path] + (when file-path + (let [lower-path (str/lower-case file-path)] + (or (str/ends-with? lower-path ".clj") + (str/ends-with? lower-path ".cljs") + (str/ends-with? lower-path ".cljc") + (str/ends-with? lower-path ".cljd"))))) + +(defn- try-dash-to-underscore-correction + "When a validated path doesn't exist and has a Clojure source extension, + tries replacing dashes with underscores in the filename part only + (not directory components). Returns the re-validated corrected path + if the file exists, nil otherwise." + [validated-path current-dir allowed-dirs] + (when (clojure-source-ext? validated-path) + (let [file (io/file validated-path) + parent (.getParentFile file) + filename (.getName file) + corrected-filename (str/replace filename "-" "_")] + (when (not= filename corrected-filename) + (let [corrected-file (if parent + (io/file parent corrected-filename) + (io/file corrected-filename)) + corrected-path (.getPath corrected-file)] + (when (path-exists? corrected-path) + ;; Re-validate for defense-in-depth (symlink protection) + (validate-path corrected-path current-dir allowed-dirs))))))) + (defn validate-path-with-client "Validates a path using settings from the nrepl-client. - + Parameters: - path: The path to validate (can be relative or absolute) - nrepl-client-map: The nREPL client map (dereferenced atom) - + Returns: - The normalized absolute path if valid - - Throws an exception if the path is invalid or if required settings are missing" + - Throws an exception if the path is invalid or if required settings are missing + + When the validated path doesn't exist and has a Clojure source extension + (.clj, .cljs, .cljc, .cljd), tries replacing dashes with underscores in the + filename (not directory components) and returns the corrected path if it exists." [path nrepl-client] (let [current-dir (config/get-nrepl-user-dir nrepl-client) allowed-dirs (config/get-allowed-directories nrepl-client)] @@ -80,7 +115,11 @@ (throw (ex-info "Missing allowed-directories in config" {:client-keys (keys nrepl-client)}))) - (validate-path path current-dir allowed-dirs))) + (let [validated (validate-path path current-dir allowed-dirs)] + (if (path-exists? validated) + validated + (or (try-dash-to-underscore-correction validated current-dir allowed-dirs) + validated))))) (defn- babashka-shebang? [file-path] diff --git a/test/clojure_mcp/tools/unified_read_file/tool_test.clj b/test/clojure_mcp/tools/unified_read_file/tool_test.clj index 9753ab3..e92b07b 100644 --- a/test/clojure_mcp/tools/unified_read_file/tool_test.clj +++ b/test/clojure_mcp/tools/unified_read_file/tool_test.clj @@ -5,7 +5,8 @@ [clojure-mcp.tools.unified-read-file.tool :as unified-read-file-tool] [clojure-mcp.tool-system :as tool-system] [clojure-mcp.config :as config] - [clojure.java.io :as io])) + [clojure.java.io :as io] + [clojure.string :as str])) ;; Setup test fixtures (test-utils/apply-fixtures *ns*) @@ -27,9 +28,10 @@ (try (f) (finally - ;; Clean up + ;; Clean up all files recursively (when (.exists test-dir) - (.delete test-dir))))))) + (doseq [file (reverse (file-seq test-dir))] + (.delete file)))))))) (use-fixtures :each setup-test-files-fixture) @@ -93,3 +95,88 @@ formatted-str (first formatted)] (is (not (re-find #"truncated" formatted-str)) "Should not show truncation message when not truncated")))) + +;; --- Dash-to-underscore filename correction integration tests --- +;; The core correction logic is tested in valid_paths_test.clj. +;; These tests verify the read_file tool pipeline works with the correction. + +(deftest dash-to-underscore-correction-test + (testing "File with dashes requested, underscore version exists - reads successfully" + (let [underscore-file (io/file *test-dir* "core_stuff.clj") + _ (spit underscore-file "(ns core-stuff)\n(defn hello [] :world)") + tool-instance (unified-read-file-tool/create-unified-read-file-tool *nrepl-client-atom*) + dash-path (.getAbsolutePath (io/file *test-dir* "core-stuff.clj")) + validated (tool-system/validate-inputs tool-instance {:path dash-path}) + result (tool-system/execute-tool tool-instance validated) + formatted (tool-system/format-results tool-instance result)] + (is (not (:error formatted)) "Should successfully read the corrected file") + (is (some #(str/includes? % "core-stuff") (:result formatted)) + "Should contain the file content") + (.delete underscore-file))) + + (testing "File with underscores requested directly - reads successfully" + (let [underscore-file (io/file *test-dir* "core_stuff.clj") + _ (spit underscore-file "(ns core-stuff)\n(defn hello [] :world)") + tool-instance (unified-read-file-tool/create-unified-read-file-tool *nrepl-client-atom*) + underscore-path (.getAbsolutePath underscore-file) + validated (tool-system/validate-inputs tool-instance {:path underscore-path}) + result (tool-system/execute-tool tool-instance validated) + formatted (tool-system/format-results tool-instance result)] + (is (not (:error formatted)) "Should successfully read the file") + (.delete underscore-file))) + + (testing "Neither dash nor underscore version exists - returns normal error" + (let [tool-instance (unified-read-file-tool/create-unified-read-file-tool *nrepl-client-atom*) + non-existent-path (.getAbsolutePath (io/file *test-dir* "no-such-file.clj"))] + (is (thrown-with-msg? clojure.lang.ExceptionInfo + #"does not exist" + (tool-system/validate-inputs tool-instance {:path non-existent-path})) + "Should throw an error when neither file version exists"))) + + (testing "Non-Clojure files (.java) - do NOT auto-correct" + (let [underscore-file (io/file *test-dir* "core_stuff.java") + _ (spit underscore-file "public class core_stuff {}") + tool-instance (unified-read-file-tool/create-unified-read-file-tool *nrepl-client-atom*) + dash-path (.getAbsolutePath (io/file *test-dir* "core-stuff.java"))] + (is (thrown-with-msg? clojure.lang.ExceptionInfo + #"does not exist" + (tool-system/validate-inputs tool-instance {:path dash-path})) + "Should NOT auto-correct non-Clojure file extensions") + (.delete underscore-file))) + + (testing "Directory components with dashes - only filename corrected" + (let [dashed-dir (io/file *test-dir* "my-cool-dir") + _ (.mkdirs dashed-dir) + underscore-file (io/file dashed-dir "my_file.clj") + _ (spit underscore-file "(ns my-cool-dir.my-file)") + tool-instance (unified-read-file-tool/create-unified-read-file-tool *nrepl-client-atom*) + dash-path (.getAbsolutePath (io/file dashed-dir "my-file.clj")) + validated (tool-system/validate-inputs tool-instance {:path dash-path}) + result (tool-system/execute-tool tool-instance validated) + formatted (tool-system/format-results tool-instance result)] + (is (not (:error formatted)) "Should read file with dashed directory and corrected filename") + (is (str/includes? (:path validated) "my-cool-dir") + "Directory dashes should be preserved") + (.delete underscore-file) + (.delete dashed-dir))) + + (testing "Full pipeline through make-tool-tester with dash correction" + (let [underscore-file (io/file *test-dir* "pipeline_test.clj") + _ (spit underscore-file "(ns pipeline-test)\n(defn greet [name] (str \"Hello \" name))") + tool-instance (unified-read-file-tool/create-unified-read-file-tool *nrepl-client-atom*) + tool-fn (test-utils/make-tool-tester tool-instance) + dash-path (.getAbsolutePath (io/file *test-dir* "pipeline-test.clj")) + result (tool-fn {:path dash-path})] + (is (not (:error? result)) "Full pipeline should succeed with dash correction") + (.delete underscore-file))) + + (testing "Babashka (.bb) files - do NOT auto-correct" + (let [underscore-file (io/file *test-dir* "my_script.bb") + _ (spit underscore-file "(println :hello)") + tool-instance (unified-read-file-tool/create-unified-read-file-tool *nrepl-client-atom*) + dash-path (.getAbsolutePath (io/file *test-dir* "my-script.bb"))] + (is (thrown-with-msg? clojure.lang.ExceptionInfo + #"does not exist" + (tool-system/validate-inputs tool-instance {:path dash-path})) + "Should NOT auto-correct .bb files") + (.delete underscore-file)))) diff --git a/test/clojure_mcp/utils/valid_paths_test.clj b/test/clojure_mcp/utils/valid_paths_test.clj index b0799d6..8cf6b63 100644 --- a/test/clojure_mcp/utils/valid_paths_test.clj +++ b/test/clojure_mcp/utils/valid_paths_test.clj @@ -1,6 +1,7 @@ (ns clojure-mcp.utils.valid-paths-test (:require [clojure.test :refer [deftest is testing]] [clojure.java.io :as io] + [clojure.string :as str] [clojure-mcp.utils.valid-paths :as valid-paths])) (deftest extract-paths-from-bash-command-test @@ -120,6 +121,128 @@ (is (not (valid-paths/clojure-file? (.getPath tmp)))) (.delete tmp)))) +(deftest dash-to-underscore-correction-test + (let [test-dir (io/file (System/getProperty "java.io.tmpdir") "valid-paths-dash-test") + canonical-dir (.getCanonicalPath test-dir) + make-client (fn [] + {:clojure-mcp.config/config + {:nrepl-user-dir canonical-dir + :allowed-directories [canonical-dir]}})] + (try + (.mkdirs test-dir) + + (testing "Clojure file with dashes corrected to underscores when underscore version exists" + (let [underscore-file (io/file test-dir "core_stuff.clj") + _ (spit underscore-file "(ns core-stuff)") + dash-path (.getAbsolutePath (io/file test-dir "core-stuff.clj")) + result (valid-paths/validate-path-with-client dash-path (make-client))] + (is (= (.getCanonicalPath underscore-file) result)) + (.delete underscore-file))) + + (testing "Non-Clojure files (.java) do NOT get corrected" + (let [underscore-file (io/file test-dir "core_stuff.java") + _ (spit underscore-file "public class core_stuff {}") + dash-path (.getAbsolutePath (io/file test-dir "core-stuff.java")) + result (valid-paths/validate-path-with-client dash-path (make-client))] + (is (not= (.getCanonicalPath underscore-file) result)) + (.delete underscore-file))) + + (testing "Non-Clojure files (.py) do NOT get corrected" + (let [underscore-file (io/file test-dir "my_module.py") + _ (spit underscore-file "def hello(): pass") + dash-path (.getAbsolutePath (io/file test-dir "my-module.py")) + result (valid-paths/validate-path-with-client dash-path (make-client))] + (is (not= (.getCanonicalPath underscore-file) result)) + (.delete underscore-file))) + + (testing "File where dashed version exists is returned as-is" + (let [dash-file (io/file test-dir "core-stuff.clj") + _ (spit dash-file "(ns core-stuff)") + dash-path (.getAbsolutePath dash-file) + result (valid-paths/validate-path-with-client dash-path (make-client))] + (is (= (.getCanonicalPath dash-file) result)) + (.delete dash-file))) + + (testing "Directory components with dashes are NOT changed, only filename" + (let [dashed-dir (io/file test-dir "my-cool-dir") + _ (.mkdirs dashed-dir) + underscore-file (io/file dashed-dir "my_file.clj") + _ (spit underscore-file "(ns my-cool-dir.my-file)") + dash-path (.getAbsolutePath (io/file dashed-dir "my-file.clj")) + result (valid-paths/validate-path-with-client dash-path (make-client))] + (is (= (.getCanonicalPath underscore-file) result)) + (is (str/includes? result "my-cool-dir") + "Directory dashes should be preserved") + (.delete underscore-file) + (.delete dashed-dir))) + + (testing ".cljs extension works" + (let [underscore-file (io/file test-dir "my_component.cljs") + _ (spit underscore-file "(ns my-component)") + dash-path (.getAbsolutePath (io/file test-dir "my-component.cljs")) + result (valid-paths/validate-path-with-client dash-path (make-client))] + (is (= (.getCanonicalPath underscore-file) result)) + (.delete underscore-file))) + + (testing ".cljc extension works" + (let [underscore-file (io/file test-dir "shared_utils.cljc") + _ (spit underscore-file "(ns shared-utils)") + dash-path (.getAbsolutePath (io/file test-dir "shared-utils.cljc")) + result (valid-paths/validate-path-with-client dash-path (make-client))] + (is (= (.getCanonicalPath underscore-file) result)) + (.delete underscore-file))) + + (testing ".cljd extension works" + (let [underscore-file (io/file test-dir "my_widget.cljd") + _ (spit underscore-file "(ns my-widget)") + dash-path (.getAbsolutePath (io/file test-dir "my-widget.cljd")) + result (valid-paths/validate-path-with-client dash-path (make-client))] + (is (= (.getCanonicalPath underscore-file) result)) + (.delete underscore-file))) + + (testing ".bb files are NOT corrected" + (let [underscore-file (io/file test-dir "my_script.bb") + _ (spit underscore-file "(println :hello)") + dash-path (.getAbsolutePath (io/file test-dir "my-script.bb")) + result (valid-paths/validate-path-with-client dash-path (make-client))] + (is (not= (.getCanonicalPath underscore-file) result)) + (.delete underscore-file))) + + (testing "When neither dashed nor underscored file exists, returns original validated path" + (let [dash-path (.getAbsolutePath (io/file test-dir "no-such-file.clj")) + result (valid-paths/validate-path-with-client dash-path (make-client))] + (is (string? result)) + (is (not (valid-paths/path-exists? result))))) + + (testing "Case-insensitive extension matching" + (let [underscore-file (io/file test-dir "MY_THING.CLJ") + _ (spit underscore-file "(ns my-thing)") + dash-path (.getAbsolutePath (io/file test-dir "MY-THING.CLJ")) + result (valid-paths/validate-path-with-client dash-path (make-client))] + (is (= (.getCanonicalPath underscore-file) result)) + (.delete underscore-file))) + + (testing "Reverse direction: underscore requested, only dash exists - should NOT correct" + (let [dash-file (io/file test-dir "core-stuff.clj") + _ (spit dash-file "(ns core-stuff)") + underscore-path (.getAbsolutePath (io/file test-dir "core_stuff.clj")) + result (valid-paths/validate-path-with-client underscore-path (make-client))] + (is (not= (.getCanonicalPath dash-file) result)) + (.delete dash-file))) + + (testing "Mixed dashes and underscores in filename - corrects all dashes" + (let [underscore-file (io/file test-dir "my_cool_thing.clj") + _ (spit underscore-file "(ns my-cool-thing)") + dash-path (.getAbsolutePath (io/file test-dir "my-cool_thing.clj")) + result (valid-paths/validate-path-with-client dash-path (make-client))] + (is (= (.getCanonicalPath underscore-file) result)) + (.delete underscore-file))) + + (finally + (when (.exists test-dir) + (doseq [file (reverse (file-seq test-dir))] + (.delete file))))))) + (deftest validate-bash-command-paths-test (let [test-dir (.getCanonicalPath (io/file (System/getProperty "java.io.tmpdir"))) home-dir (System/getProperty "user.home")]