matthieu
/
dune
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Detect circular sym links 

Fix #764
This commit is contained in:
Rudi Grinberg 2018-05-12 08:37:34 +07:00
parent 60c7f6fde4
commit 7580b8e16f
1 changed files with 13 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/file_tree.ml
View File

@ -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 }