From 9cbcb3cf16124192dac20f2e83e677b71c491ac2 Mon Sep 17 00:00:00 2001
From: Jonah Beckford <9566106-jonahbeckford@users.noreply.gitlab.com>
Date: Sat, 30 Nov 2024 18:43:30 -0800
Subject: [PATCH] Presence of .merlin.skip-if-not-cwd skips config in dir

Mitigation for https://github.com/ocaml/merlin/issues/1869
---
 src/kernel/mconfig_dot.ml  | 31 +++++++++++++++++++++----------
 src/kernel/mconfig_dot.mli | 10 +++++++++-
 2 files changed, 30 insertions(+), 11 deletions(-)

diff --git a/src/kernel/mconfig_dot.ml b/src/kernel/mconfig_dot.ml
index 13ad8eba99..ca71d3076f 100644
--- a/src/kernel/mconfig_dot.ml
+++ b/src/kernel/mconfig_dot.ml
@@ -403,26 +403,37 @@ let find_project_context start_dir =
         Sys.file_exists fname && not (Sys.is_directory fname)) fnames
       then Some dir else None
   in
+  let cwd = Sys.getcwd () in
+  let cwd = Misc.canonicalize_filename ~cwd cwd in
 
   let rec loop workdir dir =
     try
       Some (
         List.find_map [
+            ".merlin.skip-if-not-cwd";
             ".merlin"; "dune-project"; "dune-workspace"
           ]
           ~f:(fun f ->
             let fname = Filename.concat dir f in
             if Sys.file_exists fname && not (Sys.is_directory fname)
-            then
-              (* When starting [dot-merlin-reader] from [dir]
-                the workdir is always [dir] *)
-              let workdir = if f = ".merlin" then None else workdir in
-              let workdir = Option.value ~default:dir workdir in
-              Some ({
-                workdir;
-                process_dir = dir;
-                configurator = Option.get (Configurator.of_string_opt f)
-              }, fname)
+            then (
+              (* Special case:
+                 1. exists .merlin.skip-if-not-cwd
+                 2. not cwd (aka. `cwd <> dir`) *)
+              if f = ".merlin.skip-if-not-cwd" then (
+                if cwd <> Misc.canonicalize_filename ~cwd dir then
+                  raise Not_found
+                else None)
+              else
+                (* When starting [dot-merlin-reader] from [dir]
+                  the workdir is always [dir] *)
+                let workdir = if f = ".merlin" then None else workdir in
+                let workdir = Option.value ~default:dir workdir in
+                Some ({
+                  workdir;
+                  process_dir = dir;
+                  configurator = Option.get (Configurator.of_string_opt f)
+                }, fname))
             else None
           )
     )
diff --git a/src/kernel/mconfig_dot.mli b/src/kernel/mconfig_dot.mli
index 7e1ad9a1e3..198294936a 100644
--- a/src/kernel/mconfig_dot.mli
+++ b/src/kernel/mconfig_dot.mli
@@ -57,5 +57,13 @@ val find_project_context : string -> (context * string) option
     - dune-project
     - dune-workspace
 
-    They are detected in that order. [dune] and [jbuild] file do not need to be taken into account because any project using a recent version of dune should have a dune-project file which is even auto-generated when it is missing. And only recent versions of dune will stop writing .merlin files.
+    They are detected in that order. [dune] and [jbuild] file do not need to
+    be taken into account because any project using a recent version of dune
+    should have a dune-project file which is even auto-generated when it is
+    missing. And only recent versions of dune will stop writing .merlin files.
+
+    The presence of the file [".merlin.skip-if-not-cwd"] in a directory means
+    that the three (3) project configuration files are {b not} checked if the
+    directory containing [".merlin.skip-if-not-cwd"] is not the current
+    working directory.
 *)