From 7580b8e16fc2b62b7937ade22b79f07e346149d7 Mon Sep 17 00:00:00 2001
From: Rudi Grinberg <rudi.grinberg@gmail.com>
Date: Sat, 12 May 2018 08:37:34 +0700
Subject: [PATCH] Detect circular sym links

Fix #764
---
 src/file_tree.ml | 16 +++++++++++++---
 1 file changed, 13 insertions(+), 3 deletions(-)

diff --git a/src/file_tree.ml b/src/file_tree.ml
index 58844479..eb3c8ae0 100644
--- a/src/file_tree.ml
+++ b/src/file_tree.ml
@@ -156,7 +156,16 @@ let ignore_file fn ~is_directory =
   (fn.[0] = '.' && fn.[1] = '#')
 
 let load ?(extra_ignored_subtrees=Path.Set.empty) path =
-  let rec walk path ~project ~ignored : Dir.t =
+  let rec walk seen_real_paths path ~project ~ignored : Dir.t =
+    let realpath =
+      try Path.of_string (Unix.readlink (Path.to_string path))
+      with Unix.Unix_error (_, _, _) -> path
+    in
+    if List.mem realpath ~set:seen_real_paths then
+      die "Path %s has already been scanned. \
+           Cannot scan it again through symlink %s"
+        (Path.to_string_maybe_quoted realpath)
+        (Path.to_string_maybe_quoted path);
     let contents = lazy (
       let files, sub_dirs =
         Path.readdir path
@@ -209,7 +218,8 @@ let load ?(extra_ignored_subtrees=Path.Set.empty) path =
             || String.Set.mem ignored_subdirs fn
             || Path.Set.mem extra_ignored_subtrees path
           in
-          String.Map.add acc fn (walk path ~project ~ignored))
+          String.Map.add acc fn
+            (walk (realpath :: seen_real_paths) path ~project ~ignored))
       in
       { Dir. files; sub_dirs; dune_file; project })
     in
@@ -218,7 +228,7 @@ let load ?(extra_ignored_subtrees=Path.Set.empty) path =
     ; ignored
     }
   in
-  let root = walk path ~ignored:false ~project:None in
+  let root = walk [] path ~ignored:false ~project:None in
   let dirs = Hashtbl.create 1024      in
   Hashtbl.add dirs Path.root root;
   { root; dirs }