diff --git a/src/file_tree.ml b/src/file_tree.ml index cc993f00..1e7455bb 100644 --- a/src/file_tree.ml +++ b/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" diff --git a/src/stdune/path.ml b/src/stdune/path.ml index 6794bb5f..cda051d2 100644 --- a/src/stdune/path.ml +++ b/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 diff --git a/src/stdune/path.mli b/src/stdune/path.mli index 53e34816..a5854b9e 100644 --- a/src/stdune/path.mli +++ b/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