Refactor symlink following
Correctly resolve relative symlinks and add better error handling. Also move the logic to the path module.
This commit is contained in:
parent
c1f81bef64
commit
540a22315b
|
@ -157,10 +157,7 @@ let ignore_file fn ~is_directory =
|
||||||
|
|
||||||
let load ?(extra_ignored_subtrees=Path.Set.empty) path =
|
let load ?(extra_ignored_subtrees=Path.Set.empty) path =
|
||||||
let rec walk seen_real_paths path ~project ~ignored : Dir.t =
|
let rec walk seen_real_paths path ~project ~ignored : Dir.t =
|
||||||
let realpath =
|
let realpath = Path.follow_symlink path in
|
||||||
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
|
if List.mem realpath ~set:seen_real_paths then
|
||||||
die "Path %s has already been scanned. \
|
die "Path %s has already been scanned. \
|
||||||
Cannot scan it again through symlink %s"
|
Cannot scan it again through symlink %s"
|
||||||
|
|
|
@ -521,3 +521,21 @@ let extension = Filename.extension
|
||||||
|
|
||||||
let pp ppf t = Format.pp_print_string ppf (to_string t)
|
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 ->
|
||||||
|
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,3 +143,5 @@ val pp : Format.formatter -> t -> unit
|
||||||
val build_dir_exists : unit -> bool
|
val build_dir_exists : unit -> bool
|
||||||
|
|
||||||
val ensure_build_dir_exists : unit -> unit
|
val ensure_build_dir_exists : unit -> unit
|
||||||
|
|
||||||
|
val follow_symlink : t -> t
|
||||||
|
|
Loading…
Reference in New Issue