Fix sandboxing when the build directory is absolute
Fix #979 Signed-off-by: Jeremie Dimino <jeremie@dimino.org>
This commit is contained in:
parent
f46de28e8d
commit
0ed758ef8a
|
@ -790,12 +790,7 @@ let rec compile_rule t ?(copy_source=false) pre_rule =
|
||||||
match sandbox_dir with
|
match sandbox_dir with
|
||||||
| Some sandbox_dir ->
|
| Some sandbox_dir ->
|
||||||
Path.rm_rf sandbox_dir;
|
Path.rm_rf sandbox_dir;
|
||||||
let sandboxed path =
|
let sandboxed path = Path.sandbox_managed_paths ~sandbox_dir path in
|
||||||
if Path.is_managed path then
|
|
||||||
Path.append sandbox_dir path
|
|
||||||
else
|
|
||||||
path
|
|
||||||
in
|
|
||||||
make_local_parent_dirs t all_deps ~map_path:sandboxed;
|
make_local_parent_dirs t all_deps ~map_path:sandboxed;
|
||||||
make_local_parent_dirs t targets ~map_path:sandboxed;
|
make_local_parent_dirs t targets ~map_path:sandboxed;
|
||||||
Action.sandbox action
|
Action.sandbox action
|
||||||
|
|
|
@ -764,6 +764,15 @@ let drop_optional_build_context t =
|
||||||
| None -> t
|
| None -> t
|
||||||
| Some (_, t) -> t
|
| Some (_, t) -> t
|
||||||
|
|
||||||
|
let local_src = Local.of_string "src"
|
||||||
|
let local_build = Local.of_string "build"
|
||||||
|
|
||||||
|
let sandbox_managed_paths ~sandbox_dir t =
|
||||||
|
match t with
|
||||||
|
| External _ -> t
|
||||||
|
| In_source_tree p -> append_local sandbox_dir (Local.append local_src p)
|
||||||
|
| In_build_dir p -> append_local sandbox_dir (Local.append local_build p)
|
||||||
|
|
||||||
let split_first_component t =
|
let split_first_component t =
|
||||||
match kind t, is_root t with
|
match kind t, is_root t with
|
||||||
| Local t, false ->
|
| Local t, false ->
|
||||||
|
|
|
@ -103,6 +103,10 @@ val drop_build_context_exn : t -> t
|
||||||
(** Drop the "_build/blah" prefix if present, return [t] otherwise *)
|
(** Drop the "_build/blah" prefix if present, return [t] otherwise *)
|
||||||
val drop_optional_build_context : t -> t
|
val drop_optional_build_context : t -> t
|
||||||
|
|
||||||
|
(** Transform managed paths so that they are descedant of
|
||||||
|
[sandbox_dir]. *)
|
||||||
|
val sandbox_managed_paths : sandbox_dir:t -> t -> t
|
||||||
|
|
||||||
val explode : t -> string list option
|
val explode : t -> string list option
|
||||||
val explode_exn : t -> string list
|
val explode_exn : t -> string list
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue