Use dev/inode to detect loops
This commit is contained in:
parent
3a2e136e5c
commit
2192a549f4
|
@ -155,33 +155,46 @@ let ignore_file fn ~is_directory =
|
|||
(is_directory && (fn.[0] = '.' || fn.[0] = '_')) ||
|
||||
(fn.[0] = '.' && fn.[1] = '#')
|
||||
|
||||
module File = struct
|
||||
type t =
|
||||
{ ino : int
|
||||
; dev : int
|
||||
}
|
||||
|
||||
let compare a b =
|
||||
match Int.compare a.ino b.ino with
|
||||
| Eq -> Int.compare a.dev b.dev
|
||||
| ne -> ne
|
||||
|
||||
let dummy = { ino = 0; dev = 0 }
|
||||
|
||||
let of_stats (st : Unix.stats) =
|
||||
{ ino = st.st_ino
|
||||
; dev = st.st_dev
|
||||
}
|
||||
end
|
||||
|
||||
module File_map = Map.Make(File)
|
||||
|
||||
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
|
||||
|> 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"
|
||||
(Path.to_string_maybe_quoted realpath)
|
||||
(Path.to_string_maybe_quoted path);
|
||||
let rec walk path ~dirs_visited ~project ~ignored : Dir.t =
|
||||
let contents = lazy (
|
||||
let files, sub_dirs =
|
||||
Path.readdir path
|
||||
|> List.filter_partition_map ~f:(fun fn ->
|
||||
let path = Path.relative path fn in
|
||||
let is_directory = Path.is_directory path in
|
||||
let is_directory, file =
|
||||
match Unix.stat (Path.to_string path) with
|
||||
| exception _ -> (false, File.dummy)
|
||||
| { st_kind = S_DIR; _ } as st ->
|
||||
(true, File.of_stats st)
|
||||
| _ ->
|
||||
(false, File.dummy)
|
||||
in
|
||||
if ignore_file fn ~is_directory then
|
||||
Skip
|
||||
else if is_directory then
|
||||
Right (fn, path)
|
||||
Right (fn, path, file)
|
||||
else
|
||||
Left fn)
|
||||
in
|
||||
|
@ -218,14 +231,27 @@ let load ?(extra_ignored_subtrees=Path.Set.empty) path =
|
|||
(dune_file, ignored_subdirs)
|
||||
in
|
||||
let sub_dirs =
|
||||
List.fold_left sub_dirs ~init:String.Map.empty ~f:(fun acc (fn, path) ->
|
||||
List.fold_left sub_dirs ~init:String.Map.empty
|
||||
~f:(fun acc (fn, path, file) ->
|
||||
let dirs_visited =
|
||||
if Sys.win32 then
|
||||
dirs_visited
|
||||
else
|
||||
match File_map.find dirs_visited file with
|
||||
| None -> File_map.add dirs_visited file path
|
||||
| Some first_path ->
|
||||
die "Path %s has already been scanned. \
|
||||
Cannot scan it again through symlink %s"
|
||||
(Path.to_string_maybe_quoted first_path)
|
||||
(Path.to_string_maybe_quoted path)
|
||||
in
|
||||
let ignored =
|
||||
ignored
|
||||
|| String.Set.mem ignored_subdirs fn
|
||||
|| Path.Set.mem extra_ignored_subtrees path
|
||||
in
|
||||
String.Map.add acc fn
|
||||
(walk (realpath :: seen_real_paths) path ~project ~ignored))
|
||||
(walk path ~dirs_visited ~project ~ignored))
|
||||
in
|
||||
{ Dir. files; sub_dirs; dune_file; project })
|
||||
in
|
||||
|
@ -234,7 +260,14 @@ let load ?(extra_ignored_subtrees=Path.Set.empty) path =
|
|||
; ignored
|
||||
}
|
||||
in
|
||||
let root = walk [] path ~ignored:false ~project:None in
|
||||
let root =
|
||||
walk path
|
||||
~dirs_visited:(File_map.singleton
|
||||
(File.of_stats (Unix.stat (Path.to_string path)))
|
||||
path)
|
||||
~ignored:false
|
||||
~project:None
|
||||
in
|
||||
let dirs = Hashtbl.create 1024 in
|
||||
Hashtbl.add dirs Path.root root;
|
||||
{ root; dirs }
|
||||
|
|
|
@ -520,36 +520,3 @@ let change_extension ~ext t =
|
|||
let extension = Filename.extension
|
||||
|
||||
let pp ppf t = Format.pp_print_string ppf (to_string t)
|
||||
|
||||
let follow_symlink p =
|
||||
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
|
||||
match parent p with
|
||||
| Some p -> relative p realpath
|
||||
| None ->
|
||||
Exn.code_error "follow_symlink: p cannot be a symlink to root"
|
||||
[ "p", sexp_of_t p
|
||||
; "realpath", sexp_of_t realpath ]
|
||||
|
||||
|
|
|
@ -143,7 +143,3 @@ val pp : Format.formatter -> t -> unit
|
|||
val build_dir_exists : unit -> bool
|
||||
|
||||
val ensure_build_dir_exists : unit -> unit
|
||||
|
||||
val follow_symlink
|
||||
: t
|
||||
-> (t, [ `Cycle_detected | `Maximum_depth_exceeded ]) Result.t
|
||||
|
|
|
@ -24,12 +24,12 @@
|
|||
$ cd symlink-outside-root2 && ln -s ../a other/b/x
|
||||
$ cd symlink-outside-root2 && ln -s ../other root/src
|
||||
$ cd symlink-outside-root2/root && dune build
|
||||
Path b has already been scanned. Cannot scan it again through symlink src/a/x/x/x
|
||||
Path src/a has already been scanned. Cannot scan it again through symlink src/a/x/x
|
||||
[1]
|
||||
|
||||
$ mkdir -p symlink-outside-root3/{root,other}
|
||||
$ cd symlink-outside-root3 && ln -s ../other root/src
|
||||
$ cd symlink-outside-root3 && ln -s ../other other/foo
|
||||
$ cd symlink-outside-root3/root && dune build
|
||||
Path other has already been scanned. Cannot scan it again through symlink src/foo
|
||||
Path src has already been scanned. Cannot scan it again through symlink src/foo
|
||||
[1]
|
||||
|
|
Loading…
Reference in New Issue