add cycle and max depth to symlink following

src/file_tree.ml

@@ -157,7 +157,16 @@ let ignore_file fn ~is_directory =
 
 let load ?(extra_ignored_subtrees=Path.Set.empty) path =
   let rec walk seen_real_paths path ~project ~ignored : Dir.t =
-    let realpath = Path.follow_symlink path in
+    let realpath =
+      Path.follow_symlink path
+      |> Result.map_error ~f:(function
+        | `Maximum_depth_exceeded ->
+          die "maximum symlink depth exceeded while scanning %s"
+            (Path.to_string_maybe_quoted path)
+        | `Cycle_detected ->
+          die "cycle detected while scanning %s"
+            (Path.to_string_maybe_quoted path))
+      |> Result.ok_exn in
     if List.mem realpath ~set:seen_real_paths then
       die "Path %s has already been scanned. \
            Cannot scan it again through symlink %s"

src/stdune/path.ml

@@ -522,13 +522,27 @@ let extension = Filename.extension
 let pp ppf t = Format.pp_print_string ppf (to_string t)
 
 let follow_symlink p =
-  match (
-    match Unix.readlink (to_string p) with
-    | p -> Some p
-    | exception Unix.Unix_error (Unix.EINVAL, "readlink", _) -> None
-  ) with
-  | None -> p
-  | Some realpath ->
+  let readlink fn =
+    match Unix.readlink fn with
+    | exception Unix.Unix_error ((EINVAL | ENOENT), "readlink", _) -> None
+    | p -> Some p in
+  match readlink p with
+  | None -> Result.Ok p
+  | Some p ->
+    let rec follow n fn =
+      if n = 0 then
+        Result.Error `Maximum_depth_exceeded
+      else
+        match readlink fn with
+        | None -> Result.Ok fn
+        | Some p ->
+          if p = fn then
+            Result.Error `Cycle_detected
+          else
+            follow (pred n) p
+    in
+    let open Result.O in
+    follow 256 (to_string p) >>| fun realpath ->
     if not (is_local realpath) then
       of_string realpath
     else

src/stdune/path.mli

@@ -144,4 +144,6 @@ val build_dir_exists : unit -> bool
 
 val ensure_build_dir_exists : unit -> unit
 
-val follow_symlink : t -> t
+val follow_symlink
+  :  t
+  -> (t, [ `Cycle_detected | `Maximum_depth_exceeded ]) Result.t