From 55f2aaa94be3d82754741cfd3ab9931d2fa35e52 Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Tue, 28 May 2019 16:43:52 +0100
Subject: [PATCH 01/43] add sandbox_config types

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 src/action.ml                                 | 22 +++++++++--
 src/action.mli                                |  1 +
 src/build_system.ml                           | 39 ++++++++++++++-----
 src/compilation_context.ml                    | 12 ++++--
 src/compilation_context.mli                   |  4 +-
 src/lib_rules.ml                              | 12 ++++--
 src/module_compilation.ml                     |  5 ++-
 src/rule.ml                                   |  6 ++-
 src/rule.mli                                  |  4 +-
 src/sandbox_config.ml                         | 23 +++++++++++
 src/sandbox_config.mli                        | 28 +++++++++++++
 src/sandbox_mode.ml                           |  5 +++
 src/sandbox_mode.mli                          |  6 +++
 src/super_context.mli                         |  6 +--
 .../test-cases/allow_approximate_merlin/run.t |  2 +-
 15 files changed, 144 insertions(+), 31 deletions(-)
 create mode 100644 src/sandbox_config.ml
 create mode 100644 src/sandbox_config.mli
 create mode 100644 src/sandbox_mode.ml
 create mode 100644 src/sandbox_mode.mli

diff --git a/src/action.ml b/src/action.ml
index bda351a68d3..546de1578bc 100644
--- a/src/action.ml
+++ b/src/action.ml
@@ -173,7 +173,7 @@ let chdirs =
   in
   fun t -> loop Path.Set.empty t
 
-let symlink_managed_paths sandboxed deps ~eval_pred =
+let prepare_managed_paths ~link ~sandboxed deps ~eval_pred =
   let steps =
     Path.Set.fold (Dep.Set.paths deps ~eval_pred) ~init:[]
       ~f:(fun path acc ->
@@ -181,18 +181,32 @@ let symlink_managed_paths sandboxed deps ~eval_pred =
         | None ->
           assert (not (Path.is_in_source_tree path));
           acc
-        | Some p -> Symlink (path, sandboxed p) :: acc)
+        | Some p -> link path (sandboxed p) :: acc)
   in
   Progn steps
 
+let link_function ~(mode : Sandbox_mode.some) : path -> target -> t =
+  match mode with
+  | Symlink ->
+    if Sys.win32 then
+      Code_error.raise
+        "Don't have symlinks on win32, but [Symlink] sandboxing \
+         mode was selected. To use emulation via copy, the [Copy] sandboxing \
+         mode should be selected." []
+    else
+      (fun a b -> Symlink (a, b))
+  | Copy ->
+    (fun a b -> Copy (a, b))
+
 let maybe_sandbox_path f p =
   match Path.as_in_build_dir p with
   | None -> p
   | Some p -> Path.build (f p)
 
-let sandbox t ~sandboxed ~deps ~targets ~eval_pred : t =
+let sandbox t ~sandboxed ~mode ~deps ~targets ~eval_pred : t =
+  let link = link_function ~mode in
   Progn
-    [ symlink_managed_paths sandboxed deps ~eval_pred
+    [ prepare_managed_paths ~sandboxed ~link deps ~eval_pred
     ; map t
         ~dir:Path.root
         ~f_string:(fun ~dir:_ x -> x)
diff --git a/src/action.mli b/src/action.mli
index 801d33bd7a7..71c4c9974ab 100644
--- a/src/action.mli
+++ b/src/action.mli
@@ -84,6 +84,7 @@ end with type action := t
 val sandbox
   :  t
   -> sandboxed:(Path.Build.t -> Path.Build.t)
+  -> mode:Sandbox_mode.some
   -> deps:Dep.Set.t
   -> targets:Path.Build.t list
   -> eval_pred:Dep.eval_pred
diff --git a/src/build_system.ml b/src/build_system.ml
index 3813ee4f58e..47e34afa4d0 100644
--- a/src/build_system.ml
+++ b/src/build_system.ml
@@ -120,7 +120,7 @@ module Internal_rule = struct
       ; info             : Rule.Info.t
       ; dir              : Path.Build.t
       ; env              : Env.t option
-      ; sandbox          : bool
+      ; sandbox          : Sandbox_config.t
       ; locks            : Path.t list
       ; (* Reverse dependencies discovered so far, labelled by the
            requested target *)
@@ -166,7 +166,7 @@ module Internal_rule = struct
     ; info        = Internal
     ; dir         = Path.Build.root
     ; env         = None
-    ; sandbox     = false
+    ; sandbox     = Sandbox_config.no_special_requirements
     ; locks       = []
     ; rev_deps    = []
     ; transitive_rev_deps = Id.Set.empty
@@ -1366,6 +1366,23 @@ end = struct
   let evaluate_action_and_dynamic_deps =
     Memo.exec evaluate_action_and_dynamic_deps_memo
 
+  let select_sandbox_mode (config : Sandbox_config.t) : Sandbox_mode.t =
+    (* TODO: this function' behavior should become configurable *)
+    match config with
+    | { none = true; _ } -> None
+    | { symlink = true; copy = true; _ } ->
+      Some (if Sys.win32 then Copy else Symlink)
+    | { symlink = false; copy = true; _ } ->
+      Some Copy
+    | { symlink = true; copy = false; _ } ->
+      Code_error.raise
+        "This rule requires sandboxing with symlinks, but that won't \
+         work on Windows." []
+    | { none = false; copy = false; symlink = false } ->
+      Code_error.raise
+        "This rule forbids all sandboxing \
+         modes (but it also requires sandboxing)" []
+
   let evaluate_rule (rule : Internal_rule.t) =
     let* static_deps = Fiber.Once.get rule.static_deps in
     let+ (action, dynamic_action_deps) = evaluate_action_and_dynamic_deps rule in
@@ -1429,6 +1446,7 @@ end = struct
     let targets_as_list  = Path.Build.Set.to_list targets  in
     let head_target = List.hd targets_as_list in
     let prev_trace = Trace.get (Path.build head_target) in
+    let sandbox_mode = select_sandbox_mode sandbox in
     let rule_digest =
       let env =
         match env, context with
@@ -1441,6 +1459,7 @@ end = struct
         , List.map targets_as_list ~f:(fun p -> Path.to_string (Path.build p))
         , Option.map context ~f:(fun c -> c.name)
         , Action.for_shell action
+        , (sandbox_mode : Sandbox_mode.t)
         )
       in
       Digest.generic trace
@@ -1451,11 +1470,12 @@ end = struct
       | l -> Some (Digest.generic l)
       | exception (Unix.Unix_error _ | Sys_error _) -> None
     in
-    let sandbox_dir =
-      if sandbox then
+    let sandbox =
+      match sandbox_mode with
+      | Some mode ->
         let digest = Digest.to_string rule_digest in
-        Some (Path.Build.relative sandbox_dir digest)
-      else
+        Some (Path.Build.relative sandbox_dir digest, mode)
+      | None ->
         None
     in
     let force =
@@ -1476,10 +1496,10 @@ end = struct
         pending_targets := Path.Build.Set.union targets !pending_targets;
         let loc = Rule.Info.loc info in
         let action =
-          match sandbox_dir with
+          match sandbox with
           | None ->
             action
-          | Some sandbox_dir ->
+          | Some (sandbox_dir, sandbox_mode) ->
             Path.rm_rf (Path.build sandbox_dir);
             let sandboxed path : Path.Build.t =
               Path.Build.append_local sandbox_dir
@@ -1493,6 +1513,7 @@ end = struct
             Fs.mkdir_p (sandboxed dir);
             Action.sandbox action
               ~sandboxed
+              ~mode:sandbox_mode
               ~deps
               ~targets:targets_as_list
               ~eval_pred
@@ -1503,7 +1524,7 @@ end = struct
           with_locks locks ~f:(fun () ->
             Action_exec.exec ~context ~env ~targets action)
         in
-        Option.iter sandbox_dir ~f:(fun p -> Path.rm_rf (Path.build p));
+        Option.iter sandbox ~f:(fun (p, _mode) -> Path.rm_rf (Path.build p));
         (* All went well, these targets are no longer pending *)
         pending_targets := Path.Build.Set.diff !pending_targets targets;
         let targets_digest =
diff --git a/src/compilation_context.ml b/src/compilation_context.ml
index 5de14abcb38..4ff85a2954e 100644
--- a/src/compilation_context.ml
+++ b/src/compilation_context.ml
@@ -59,7 +59,7 @@ type t =
   ; stdlib               : Dune_file.Library.Stdlib.t option
   ; js_of_ocaml          : Dune_file.Js_of_ocaml.t option
   ; dynlink              : bool
-  ; sandbox              : bool option
+  ; sandbox              : Sandbox_config.t option
   ; package              : Package.t option
   ; vimpl                : Vimpl.t option
   }
@@ -128,9 +128,13 @@ let for_alias_module t =
   let sandbox =
     let ctx = Super_context.context t.super_context in
     (* If the compiler reads the cmi for module alias even with [-w -49
-    -no-alias-deps], we must sandbox the build of the alias module since the
-    modules it references are built after. *)
-    Ocaml_version.always_reads_alias_cmi ctx.version
+       -no-alias-deps], we must sandbox the build of the alias module since the
+       modules it references are built after. *)
+    if Ocaml_version.always_reads_alias_cmi ctx.version
+    then
+      Sandbox_config.needs_sandboxing
+    else
+      Sandbox_config.no_special_requirements
   in
   { t with
     flags =
diff --git a/src/compilation_context.mli b/src/compilation_context.mli
index 5a06cc841ef..40c37252dc1 100644
--- a/src/compilation_context.mli
+++ b/src/compilation_context.mli
@@ -29,7 +29,7 @@ val create
   -> ?stdlib               : Dune_file.Library.Stdlib.t
   -> ?js_of_ocaml          : Dune_file.Js_of_ocaml.t
   -> dynlink               : bool
-  -> ?sandbox              : bool
+  -> ?sandbox              : Sandbox_config.t
   -> package               : Package.t option
   -> ?vimpl                : Vimpl.t
   -> unit
@@ -56,7 +56,7 @@ val opaque               : t -> bool
 val stdlib               : t -> Dune_file.Library.Stdlib.t option
 val js_of_ocaml          : t -> Dune_file.Js_of_ocaml.t option
 val dynlink              : t -> bool
-val sandbox              : t -> bool option
+val sandbox              : t -> Sandbox_config.t option
 val package              : t -> Package.t option
 val vimpl                : t -> Vimpl.t option
 
diff --git a/src/lib_rules.ml b/src/lib_rules.ml
index 2a36a0778fb..c31eab197d4 100644
--- a/src/lib_rules.ml
+++ b/src/lib_rules.ml
@@ -183,12 +183,18 @@ module Gen (P : sig val sctx : Super_context.t end) = struct
       (* If we build for both modes and support dynlink, use a
          single invocation to build both the static and dynamic
          libraries *)
-      ocamlmklib ~sandbox:false ~custom:false ~targets:[static; dynamic]
+      (* CR-someday aalekseyev: why [no_sandboxing]? *)
+      ocamlmklib
+        ~sandbox:Sandbox_config.no_sandboxing
+        ~custom:false ~targets:[static; dynamic]
     end else begin
-      ocamlmklib ~sandbox:false ~custom:true ~targets:[static];
+      (* CR-someday aalekseyev: why [no_sandboxing]? *)
+      ocamlmklib ~sandbox:Sandbox_config.no_sandboxing ~custom:true ~targets:[static];
       (* We can't tell ocamlmklib to build only the dll, so we
          sandbox the action to avoid overriding the static archive *)
-      ocamlmklib ~sandbox:true ~custom:false ~targets:[dynamic]
+      ocamlmklib
+        ~sandbox:Sandbox_config.needs_sandboxing
+        ~custom:false ~targets:[dynamic]
     end
 
   let build_o_files lib ~(c_sources : C.Sources.t)
diff --git a/src/module_compilation.ml b/src/module_compilation.ml
index d2132b54531..371b3bd3db0 100644
--- a/src/module_compilation.ml
+++ b/src/module_compilation.ml
@@ -46,7 +46,10 @@ let build_cm cctx ~dep_graphs ~precompiled_cmi ~cm_kind (m : Module.t) =
         (* symlink the .cmi into the public interface directory *)
         if Module.visibility m <> Visibility.Private
         && (Obj_dir.need_dedicated_public_dir obj_dir) then
-          SC.add_rule sctx ~sandbox:false ~dir
+          SC.add_rule sctx
+            (* CR-someday aalekseyev: why do we have [no_sandboxing] here? *)
+            ~sandbox:Sandbox_config.no_sandboxing
+            ~dir
             (Build.symlink
                ~src:(Path.build (Obj_dir.Module.cm_file_unsafe obj_dir m ~kind:Cmi))
                ~dst:(Obj_dir.Module.cm_public_file_unsafe obj_dir m ~kind:Cmi)
diff --git a/src/rule.ml b/src/rule.ml
index 76636c38af4..64eb9caa04f 100644
--- a/src/rule.ml
+++ b/src/rule.ml
@@ -22,14 +22,16 @@ type t =
   ; env      : Env.t option
   ; build    : (unit, Action.t) Build.t
   ; targets  : Path.Build.Set.t
-  ; sandbox  : bool
+  ; sandbox  : Sandbox_config.t
   ; mode     : Dune_file.Rule.Mode.t
   ; locks    : Path.t list
   ; info     : Info.t
   ; dir      : Path.Build.t
   }
 
-let make ?(sandbox=false) ?(mode=Dune_file.Rule.Mode.Standard)
+let make
+      ?(sandbox=Sandbox_config.default)
+      ?(mode=Dune_file.Rule.Mode.Standard)
       ~context ~env ?(locks=[]) ?(info=Info.Internal) build =
   let targets = Build.targets build in
   let dir =
diff --git a/src/rule.mli b/src/rule.mli
index d781252ed11..4ce0f33d60f 100644
--- a/src/rule.mli
+++ b/src/rule.mli
@@ -19,7 +19,7 @@ type t =
   ; env      : Env.t option
   ; build    : (unit, Action.t) Build.t
   ; targets  : Path.Build.Set.t
-  ; sandbox  : bool
+  ; sandbox  : Sandbox_config.t
   ; mode     : Dune_file.Rule.Mode.t
   ; locks    : Path.t list
   ; info     : Info.t
@@ -28,7 +28,7 @@ type t =
   }
 
 val make
-  :  ?sandbox:bool
+  :  ?sandbox:Sandbox_config.t
   -> ?mode:Dune_file.Rule.Mode.t
   -> context:Context.t option
   -> env:Env.t option
diff --git a/src/sandbox_config.ml b/src/sandbox_config.ml
new file mode 100644
index 00000000000..f53314d1d96
--- /dev/null
+++ b/src/sandbox_config.ml
@@ -0,0 +1,23 @@
+open! Stdune
+
+type t = {
+  none : bool;
+  symlink : bool;
+  copy : bool;
+}
+
+let of_function (f : Sandbox_mode.t -> _) = {
+  none = f None;
+  symlink = f (Some Symlink);
+  copy = f (Some Copy);
+}
+
+let no_special_requirements = of_function (fun _ -> true)
+
+let no_sandboxing =
+  of_function Option.is_none
+
+let needs_sandboxing =
+  of_function Option.is_some
+
+let default = no_sandboxing
diff --git a/src/sandbox_config.mli b/src/sandbox_config.mli
new file mode 100644
index 00000000000..0c1af57f868
--- /dev/null
+++ b/src/sandbox_config.mli
@@ -0,0 +1,28 @@
+open! Stdune
+
+(** A function [Sandbox_mode.t -> bool] returning true if the rule is expected
+    to work correctly (respecting its specified dependencies) in this mode. *)
+
+type t = {
+  none : bool;
+  symlink : bool;
+  copy : bool;
+}
+
+val no_special_requirements : t
+
+val no_sandboxing : t
+
+val needs_sandboxing : t
+
+(** The default sandboxing config for actions that don't bother specifying it.
+
+    Often this means that they don't have special requirements, but it also
+    often means that we're not sure and there might be some requirements
+    that we didn't yet discover because we never tried sandboxing it.
+
+    Currently we have [default = no_sandboxing] to be consistent with the old
+    dune behavior, but we'd like to change it to
+    [default = no_special_requirements].
+*)
+val default : t
diff --git a/src/sandbox_mode.ml b/src/sandbox_mode.ml
new file mode 100644
index 00000000000..f7c7a94c0e1
--- /dev/null
+++ b/src/sandbox_mode.ml
@@ -0,0 +1,5 @@
+type some =
+  | Symlink
+  | Copy
+
+type t = some option
diff --git a/src/sandbox_mode.mli b/src/sandbox_mode.mli
new file mode 100644
index 00000000000..4cd3c48ff4c
--- /dev/null
+++ b/src/sandbox_mode.mli
@@ -0,0 +1,6 @@
+
+type some =
+  | Symlink
+  | Copy
+
+type t = some option
diff --git a/src/super_context.mli b/src/super_context.mli
index 327b9420308..d84a4677ee7 100644
--- a/src/super_context.mli
+++ b/src/super_context.mli
@@ -76,7 +76,7 @@ val dir_is_vendored : t -> Path.Source.t -> bool
 
 val add_rule
   :  t
-  -> ?sandbox:bool
+  -> ?sandbox:Sandbox_config.t
   -> ?mode:Dune_file.Rule.Mode.t
   -> ?locks:Path.t list
   -> ?loc:Loc.t
@@ -85,7 +85,7 @@ val add_rule
   -> unit
 val add_rule_get_targets
   :  t
-  -> ?sandbox:bool
+  -> ?sandbox:Sandbox_config.t
   -> ?mode:Dune_file.Rule.Mode.t
   -> ?locks:Path.t list
   -> ?loc:Loc.t
@@ -94,7 +94,7 @@ val add_rule_get_targets
   -> Path.Build.Set.t
 val add_rules
   :  t
-  -> ?sandbox:bool
+  -> ?sandbox:Sandbox_config.t
   -> dir:Path.Build.t
   -> (unit, Action.t) Build.t list
   -> unit
diff --git a/test/blackbox-tests/test-cases/allow_approximate_merlin/run.t b/test/blackbox-tests/test-cases/allow_approximate_merlin/run.t
index e60b01772c9..a0bf80bd1ca 100644
--- a/test/blackbox-tests/test-cases/allow_approximate_merlin/run.t
+++ b/test/blackbox-tests/test-cases/allow_approximate_merlin/run.t
@@ -17,7 +17,7 @@ For lang >= 1.9, a warning is printed:
 
 Indeed, adding this will suppress the warning:
 
-  $ echo '(lang dune 1.9)\n(allow_approximate_merlin)' > dune-project
+  $ echo -e '(lang dune 1.9)\n(allow_approximate_merlin)' > dune-project
   $ dune build @check
 
 However, the warning is not emitted if it is not fixable (#2399).

From c8c15d5f5ab08170f513a702f27b2c37d5c007e5 Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Tue, 28 May 2019 17:23:04 +0100
Subject: [PATCH 02/43] add sandboxing_preference to config file

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 bin/common.ml        |  1 +
 bin/subst.ml         |  1 +
 src/config.ml        | 23 ++++++++++++++++++++++-
 src/config.mli       |  5 +++++
 src/main.ml          |  2 ++
 src/sandbox_mode.ml  | 14 ++++++++++++++
 src/sandbox_mode.mli |  5 +++++
 7 files changed, 50 insertions(+), 1 deletion(-)

diff --git a/bin/common.ml b/bin/common.ml
index d82a27c5da1..8998c644a9b 100644
--- a/bin/common.ml
+++ b/bin/common.ml
@@ -462,6 +462,7 @@ let term =
     Config.merge config
       { display
       ; concurrency
+      ; sandboxing_preference = None
       }
   in
   let config =
diff --git a/bin/subst.ml b/bin/subst.ml
index 0c7f5d46193..62e8d723b35 100644
--- a/bin/subst.ml
+++ b/bin/subst.ml
@@ -66,6 +66,7 @@ let term =
     let config : Config.t =
       { display     = Quiet
       ; concurrency = Fixed 1
+      ; sandboxing_preference = []
       }
     in
     Path.set_root (Path.External.cwd ());
diff --git a/src/config.ml b/src/config.ml
index 1a2962f0fcb..c5998bf3be0 100644
--- a/src/config.ml
+++ b/src/config.ml
@@ -75,12 +75,25 @@ module Concurrency = struct
     | Fixed n -> string_of_int n
 end
 
+module Sandboxing_preference = struct
+  type t = Sandbox_mode.t list
+
+  let decode =
+    repeat (
+      plain_string (fun ~loc s ->
+        match Sandbox_mode.of_string s with
+        | Error m -> of_sexp_errorf loc "%s" m
+        | Ok s -> s))
+
+end
+
 module type S = sig
   type 'a field
 
   type t =
     { display     : Display.t     field
     ; concurrency : Concurrency.t field
+    ; sandboxing_preference : Sandboxing_preference.t field
     }
 end
 
@@ -95,20 +108,28 @@ let merge t (partial : Partial.t) =
   in
   { display     = field t.display     partial.display
   ; concurrency = field t.concurrency partial.concurrency
+  ; sandboxing_preference =
+      field t.sandboxing_preference partial.sandboxing_preference
   }
 
 let default =
   { display     = if inside_dune then Quiet   else Progress
   ; concurrency = if inside_dune then Fixed 1 else Auto
+  ; sandboxing_preference = []
   }
 
 let decode =
   let+ display = field "display" Display.decode ~default:default.display
-  and+ concurrency = field "jobs" Concurrency.decode ~default:default.concurrency
+  and+ concurrency =
+    field "jobs" Concurrency.decode ~default:default.concurrency
+  and+ sandboxing_preference =
+    field "sandboxing_preference"
+      Sandboxing_preference.decode ~default:default.sandboxing_preference
   and+ () = Versioned_file.no_more_lang
   in
   { display
   ; concurrency
+  ; sandboxing_preference
   }
 
 let decode = fields decode
diff --git a/src/config.mli b/src/config.mli
index c06d4f8dd78..0843a623388 100644
--- a/src/config.mli
+++ b/src/config.mli
@@ -54,12 +54,17 @@ module Concurrency : sig
   val to_string : t -> string
 end
 
+module Sandboxing_preference : sig
+  type t = Sandbox_mode.t list
+end
+
 module type S = sig
   type 'a field
 
   type t =
     { display     : Display.t     field
     ; concurrency : Concurrency.t field
+    ; sandboxing_preference : Sandboxing_preference.t field
     }
 end
 
diff --git a/src/main.ml b/src/main.ml
index 025e35ac4e0..42198dbfa23 100644
--- a/src/main.ml
+++ b/src/main.ml
@@ -173,6 +173,7 @@ let bootstrap () =
       let config : Config.t =
         { display     = Quiet
         ; concurrency = Fixed 1
+        ; sandboxing_preference = []
         }
       in
       Scheduler.go ~config Watermarks.subst;
@@ -216,6 +217,7 @@ let bootstrap () =
       Config.merge config
         { display     = !display
         ; concurrency = !concurrency
+        ; sandboxing_preference = None
         }
     in
     let config =
diff --git a/src/sandbox_mode.ml b/src/sandbox_mode.ml
index f7c7a94c0e1..e82bdba1caa 100644
--- a/src/sandbox_mode.ml
+++ b/src/sandbox_mode.ml
@@ -1,5 +1,19 @@
+open! Stdune
+
 type some =
   | Symlink
   | Copy
 
 type t = some option
+
+(* these should be listed in the default order of preference *)
+let all = [None; Some Symlink; Some Copy]
+
+let error =
+  Error "invalid sandboxing mode, must be 'none', 'symlink' or 'copy'"
+
+let of_string = function
+  | "none" -> Ok None
+  | "symlink" -> Ok (Some Symlink : t)
+  | "copy" -> Ok (Some Copy)
+  | _ -> error
diff --git a/src/sandbox_mode.mli b/src/sandbox_mode.mli
index 4cd3c48ff4c..f439d6b2ebe 100644
--- a/src/sandbox_mode.mli
+++ b/src/sandbox_mode.mli
@@ -1,6 +1,11 @@
+open! Stdune
 
 type some =
   | Symlink
   | Copy
 
 type t = some option
+
+val all : t list
+
+val of_string : string -> (t, string) Result.t

From 541e81d65f07c3a65efe4e96ed963142798f6998 Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Tue, 28 May 2019 17:52:03 +0100
Subject: [PATCH 03/43] propagate config to the actual logic

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 bin/import.ml        |  1 +
 src/build_system.ml  | 39 ++++++++++++++++++++++++---------------
 src/build_system.mli |  1 +
 src/config.ml        |  3 ++-
 src/main.ml          | 12 +++++++++---
 src/main.mli         |  1 +
 6 files changed, 38 insertions(+), 19 deletions(-)

diff --git a/bin/import.ml b/bin/import.ml
index cb8f1420c3b..adf1bbb1393 100644
--- a/bin/import.ml
+++ b/bin/import.ml
@@ -48,6 +48,7 @@ module Main = struct
     let open Fiber.O in
     scan_workspace ~log common
     >>= init_build_system
+          ~sandboxing_preference:(common.config.sandboxing_preference)
           ?external_lib_deps_mode
           ?only_packages:common.only_packages
 end
diff --git a/src/build_system.ml b/src/build_system.ml
index 47e34afa4d0..18c38443a9c 100644
--- a/src/build_system.ml
+++ b/src/build_system.ml
@@ -420,6 +420,7 @@ type t =
   ; hook : hook -> unit
   ; (* Package files are part of *)
     packages : (Path.Build.t -> Package.Name.Set.t) Fdecl.t
+  ; sandboxing_preference : Sandbox_mode.t list
   }
 
 let t = ref None
@@ -1366,22 +1367,27 @@ end = struct
   let evaluate_action_and_dynamic_deps =
     Memo.exec evaluate_action_and_dynamic_deps_memo
 
-  let select_sandbox_mode (config : Sandbox_config.t) : Sandbox_mode.t =
-    (* TODO: this function' behavior should become configurable *)
-    match config with
-    | { none = true; _ } -> None
-    | { symlink = true; copy = true; _ } ->
-      Some (if Sys.win32 then Copy else Symlink)
-    | { symlink = false; copy = true; _ } ->
-      Some Copy
-    | { symlink = true; copy = false; _ } ->
-      Code_error.raise
-        "This rule requires sandboxing with symlinks, but that won't \
-         work on Windows." []
-    | { none = false; copy = false; symlink = false } ->
+  let select_sandbox_mode (config : Sandbox_config.t) ~sandboxing_preference =
+    match
+      List.find_map sandboxing_preference ~f:(fun preference ->
+        match (preference, config) with
+        | None, { none = true; _ } ->
+          Some None
+        | Some Sandbox_mode.Copy, { copy = true; _ } ->
+          Some (Some Sandbox_mode.Copy)
+        | Some Symlink, { symlink = true; copy; _ } ->
+          (if copy then
+             Some (Some (if Sys.win32 then Copy else Symlink))
+           else
+             Code_error.raise
+               "This rule requires sandboxing with symlinks, but that won't \
+                work on Windows." [])
+        | _, _ -> None) with
+    | None ->
       Code_error.raise
         "This rule forbids all sandboxing \
          modes (but it also requires sandboxing)" []
+    | Some choice -> choice
 
   let evaluate_rule (rule : Internal_rule.t) =
     let* static_deps = Fiber.Once.get rule.static_deps in
@@ -1446,7 +1452,9 @@ end = struct
     let targets_as_list  = Path.Build.Set.to_list targets  in
     let head_target = List.hd targets_as_list in
     let prev_trace = Trace.get (Path.build head_target) in
-    let sandbox_mode = select_sandbox_mode sandbox in
+    let sandbox_mode =
+      select_sandbox_mode sandbox ~sandboxing_preference:t.sandboxing_preference
+    in
     let rule_digest =
       let env =
         match env, context with
@@ -1972,7 +1980,7 @@ let load_dir_and_produce_its_rules ~dir =
 
 let load_dir ~dir = load_dir_and_produce_its_rules ~dir
 
-let init ~contexts ~file_tree ~hook =
+let init ~contexts ~file_tree ~hook ~sandboxing_preference =
   let contexts =
     List.map contexts ~f:(fun c -> (c.Context.name, c))
     |> String.Map.of_list_exn
@@ -1985,6 +1993,7 @@ let init ~contexts ~file_tree ~hook =
     ; gen_rules = Fdecl.create ()
     ; init_rules = Fdecl.create ()
     ; hook
+    ; sandboxing_preference = sandboxing_preference @ Sandbox_mode.all
     }
   in
   set t
diff --git a/src/build_system.mli b/src/build_system.mli
index bf08cb8bfc2..0f5fd7793d9 100644
--- a/src/build_system.mli
+++ b/src/build_system.mli
@@ -16,6 +16,7 @@ val init
   :  contexts:Context.t list
   -> file_tree:File_tree.t
   -> hook:(hook -> unit)
+  -> sandboxing_preference:Sandbox_mode.t list
   -> unit
 
 val reset : unit -> unit
diff --git a/src/config.ml b/src/config.ml
index c5998bf3be0..450efec4db0 100644
--- a/src/config.ml
+++ b/src/config.ml
@@ -82,7 +82,8 @@ module Sandboxing_preference = struct
     repeat (
       plain_string (fun ~loc s ->
         match Sandbox_mode.of_string s with
-        | Error m -> of_sexp_errorf loc "%s" m
+        | Error m ->
+          User_error.raise ~loc [ Pp.text m ]
         | Ok s -> s))
 
 end
diff --git a/src/main.ml b/src/main.ml
index 42198dbfa23..d93c104376b 100644
--- a/src/main.ml
+++ b/src/main.ml
@@ -72,7 +72,8 @@ let scan_workspace ?(log=Log.no_log)
   ; env
   }
 
-let init_build_system ?only_packages ?external_lib_deps_mode w =
+let init_build_system
+      ?only_packages ?external_lib_deps_mode ~sandboxing_preference w =
   Option.iter only_packages ~f:(fun set ->
     Package.Name.Set.iter set ~f:(fun pkg ->
       if not (Package.Name.Map.mem w.conf.packages pkg) then
@@ -99,7 +100,9 @@ let init_build_system ?only_packages ?external_lib_deps_mode w =
     | Rule_completed -> incr rule_done
   in
   Build_system.reset ();
-  Build_system.init ~contexts:w.contexts ~file_tree:w.conf.file_tree ~hook;
+  Build_system.init
+    ~sandboxing_preference
+    ~contexts:w.contexts ~file_tree:w.conf.file_tree ~hook;
   Scheduler.set_status_line_generator gen_status_line;
   let+ scontexts =
     Gen_rules.gen w.conf
@@ -234,7 +237,10 @@ let bootstrap () =
             ?profile:!profile ~ancestor_vcs:None
             ()
          in
-         let* _ = init_build_system workspace in
+         let* _ =
+           init_build_system
+             ~sandboxing_preference:config.sandboxing_preference workspace
+         in
          Build_system.do_build
            ~request:(Build.path (
              Path.relative Path.build_dir "default/dune.install")))
diff --git a/src/main.mli b/src/main.mli
index d9480a28a99..0310b1f3c3a 100644
--- a/src/main.mli
+++ b/src/main.mli
@@ -31,6 +31,7 @@ val scan_workspace
 val init_build_system
   :  ?only_packages:Package.Name.Set.t
   -> ?external_lib_deps_mode:bool
+  -> sandboxing_preference:Sandbox_mode.t list
   -> workspace
   -> build_system Fiber.t
 

From e65d010c21b2707777073dda7fb005f46bad5091 Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Tue, 28 May 2019 19:28:59 +0100
Subject: [PATCH 04/43] Annotate all the call sites that clearly rely on
 no-sandboxing. (guided by test failures)

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 src/build_system.ml    |  2 ++
 src/exe.ml             |  4 +++
 src/lib_rules.ml       | 59 +++++++++++++++++++++++++-----------------
 src/odoc.ml            |  9 +++++--
 src/opam_create.ml     |  3 ++-
 src/preprocessing.ml   | 16 ++++++++++--
 src/rule.ml            |  2 +-
 src/sandbox_config.ml  |  4 ++-
 src/sandbox_config.mli | 14 ++++++----
 src/simple_rules.ml    | 13 +++++++---
 10 files changed, 87 insertions(+), 39 deletions(-)

diff --git a/src/build_system.ml b/src/build_system.ml
index 18c38443a9c..5dfaa92464c 100644
--- a/src/build_system.ml
+++ b/src/build_system.ml
@@ -826,6 +826,8 @@ end = struct
                       in
                       let rule =
                         Pre_rule.make ~locks ~context:(Some context) ~env
+                          (* [no_sandboxing] here is necessary for some reason *)
+                          ~sandbox:Sandbox_config.no_sandboxing
                           ~info:(Rule.Info.of_loc_opt loc)
                           (Build.progn [ action; Build.create_file path ])
                       in
diff --git a/src/exe.ml b/src/exe.ml
index 3cdb2fd3cf6..f6b90d5c2e5 100644
--- a/src/exe.ml
+++ b/src/exe.ml
@@ -146,6 +146,10 @@ let link_exe
   in
   let top_sorted_cms = Cm_files.top_sorted_cms cm_files ~mode in
   SC.add_rule sctx ~loc ~dir
+    (* Breaks with sandboxing with errors like:
+       gcc: error: .main_auto.eobjs/native/findlib_initl$ext_obj: No such file or directory
+    *)
+    ~sandbox:Sandbox_config.no_sandboxing
     ~mode:(match promote with
       | None -> Standard
       | Some p -> Promote p)
diff --git a/src/lib_rules.ml b/src/lib_rules.ml
index c31eab197d4..2af02c141d4 100644
--- a/src/lib_rules.ml
+++ b/src/lib_rules.ml
@@ -104,7 +104,11 @@ module Gen (P : sig val sctx : Super_context.t end) = struct
 
   let build_c_file (lib : Library.t) ~dir ~expander ~includes (loc, src, dst) =
     let c_flags = (SC.c_flags sctx ~dir ~expander ~flags:lib.c_flags).c in
-    SC.add_rule sctx ~loc ~dir
+    (* With sandboxing we get errors like:
+       bar.c:2:19: fatal error: foo.cxx: No such file or directory
+       #include "foo.cxx"
+    *)
+    SC.add_rule ~sandbox:Sandbox_config.no_sandboxing sctx ~loc ~dir
       (
         let src = Path.build (C.Source.path src) in
         Command.run
@@ -129,20 +133,25 @@ module Gen (P : sig val sctx : Super_context.t end) = struct
       else
         [A "-o"; Target dst]
     in
-    let cxx_flags = (SC.c_flags sctx ~dir ~expander ~flags:lib.c_flags).cxx in
-    SC.add_rule sctx ~loc ~dir (
-      let src = Path.build (C.Source.path src) in
-      Command.run
-        (* We have to execute the rule in the library directory as
-           the .o is produced in the current directory *)
-        ~dir:(Path.build dir)
-        (SC.resolve_program ~loc:None ~dir sctx ctx.c_compiler)
-        ([ Command.Args.S [A "-I"; Path ctx.stdlib_dir]
-         ; includes
-         ; Command.Args.dyn cxx_flags
-         ] @ output_param @
-         [ A "-c"; Dep src
-         ]));
+    let cxx_flags = (SC.c_flags sctx ~dir
+                       ~expander ~flags:lib.c_flags).cxx in
+    (* this seems to work with sandboxing, but for symmetry with [build_c_file]
+       disabling that here too *)
+    SC.add_rule ~sandbox:Sandbox_config.no_sandboxing sctx ~loc ~dir
+      (
+        let src = Path.build (C.Source.path src) in
+        Command.run
+          (* We have to execute the rule in the library directory as
+             the .o is produced in the current directory *)
+          ~dir:(Path.build dir)
+          (SC.resolve_program ~loc:None ~dir
+             sctx ctx.c_compiler)
+          ([ Command.Args.S [A "-I"; Path ctx.stdlib_dir]
+           ; includes
+           ; Command.Args.dyn cxx_flags
+           ] @ output_param @
+           [ A "-c"; Dep src
+           ]));
     dst
 
   let ocamlmklib (lib : Library.t) ~dir ~expander ~o_files ~sandbox ~custom
@@ -189,7 +198,8 @@ module Gen (P : sig val sctx : Super_context.t end) = struct
         ~custom:false ~targets:[static; dynamic]
     end else begin
       (* CR-someday aalekseyev: why [no_sandboxing]? *)
-      ocamlmklib ~sandbox:Sandbox_config.no_sandboxing ~custom:true ~targets:[static];
+      ocamlmklib
+        ~sandbox:Sandbox_config.no_sandboxing ~custom:true ~targets:[static];
       (* We can't tell ocamlmklib to build only the dll, so we
          sandbox the action to avoid overriding the static archive *)
       ocamlmklib
@@ -210,14 +220,15 @@ module Gen (P : sig val sctx : Super_context.t end) = struct
               acc))
     in
     let includes =
-      Command.Args.S [ Hidden_deps (Dep.Set.of_files h_files)
-        ; Command.of_result_map requires ~f:(fun libs ->
-            S [ Lib.L.c_include_flags libs
-              ; Hidden_deps (
-                  Lib_file_deps.deps libs
-                    ~groups:[Lib_file_deps.Group.Header])
-              ])
-        ]
+      Command.Args.S [
+        Hidden_deps (Dep.Set.of_files h_files)
+      ; Command.of_result_map requires ~f:(fun libs ->
+          S [ Lib.L.c_include_flags libs
+            ; Hidden_deps (
+                Lib_file_deps.deps libs
+                  ~groups:[Lib_file_deps.Group.Header])
+            ])
+      ]
     in
     let build_x_files build_x files =
       String.Map.to_list files
diff --git a/src/odoc.ml b/src/odoc.ml
index 59ede290982..9cd698536b1 100644
--- a/src/odoc.ml
+++ b/src/odoc.ml
@@ -165,7 +165,10 @@ let module_deps (m : Module.t) ~obj_dir
 let compile_module sctx ~obj_dir (m : Module.t) ~includes:(file_deps, iflags)
       ~dep_graphs ~pkg_or_lnu =
   let odoc_file = Obj_dir.Module.odoc obj_dir m in
-  add_rule sctx
+  (* sandboxing breaks with errors like:
+     Error: exception Sys_error("_build/.sandbox/c6c6d243cda677ac18f785bc647e343c/build/.aliases/default/_doc/_odoc/pkg/foo/.odoc-all-00000000000000000000000000000000: No such file or directory"
+  *)
+  add_rule ~sandbox:Sandbox_config.no_sandboxing sctx
     (file_deps
      >>>
      module_deps m ~obj_dir ~dep_graphs
@@ -221,7 +224,9 @@ let setup_html sctx (odoc_file : odoc) ~pkg ~requires =
         Build.create_file (odoc_file.html_dir ++ Config.dune_keep_fname) in
       odoc_file.html_dir, [dune_keep]
   in
-  add_rule sctx
+  (* Sandboxing fails with errors like:
+     Error: exception Sys_error("_build/.sandbox/f04b07b43dff46d0376c51d684c93380/build/.aliases/default/_doc/_odoc/pkg/foo/.odoc-all-00000000000000000000000000000000: No such file or directory") *)
+  add_rule ~sandbox:Sandbox_config.no_sandboxing sctx
     (deps
      >>>
      Build.progn (
diff --git a/src/opam_create.ml b/src/opam_create.ml
index dfb19f69b13..2c8539b191c 100644
--- a/src/opam_create.ml
+++ b/src/opam_create.ml
@@ -181,7 +181,8 @@ let add_rule sctx ~project ~pkg =
       ; only = None
       }
   in
-  Super_context.add_rule sctx ~mode ~dir opam_rule;
+  Super_context.add_rule
+    sctx ~mode ~dir opam_rule;
   let aliases =
     [ Alias.install ~dir
     ; Alias.runtest ~dir
diff --git a/src/preprocessing.ml b/src/preprocessing.ml
index 1cdf380103e..feac840ec2c 100644
--- a/src/preprocessing.ml
+++ b/src/preprocessing.ml
@@ -414,13 +414,20 @@ let build_ppx_driver sctx ~dep_kind ~target ~dir_kind ~pps ~pp_names =
      and for all at the point where the driver is defined. *)
   let dir = Path.Build.parent_exn target in
   let ml = Path.Build.relative dir "_ppx.ml" in
-  let add_rule = SC.add_rule sctx ~dir in
+  let add_rule ~sandbox = SC.add_rule ~sandbox sctx ~dir in
   add_rule
+    ~sandbox:Sandbox_config.default
     (Build.of_result_map driver_and_libs ~f:(fun (driver, _) ->
        Build.return (sprintf "let () = %s ()\n" driver.info.main))
      >>>
      Build.write_file_dyn ml);
   add_rule
+    (* Sandboxing breaks with an error like this:
+
+       File ".ppx/foo.ppx_rewriter_dune/ppx.ml", line 1, characters 9-35:
+       Error: Unbound module Foo_ppx_rewriter_dune
+       [1] *)
+    ~sandbox:Sandbox_config.no_sandboxing
     (Build.S.seqs
        [Build.record_lib_deps
           (Lib_deps.info ~kind:dep_kind (Lib_deps.of_pps pp_names));
@@ -798,7 +805,12 @@ let make sctx ~dir ~expander ~dep_kind ~lint ~preprocess
            let ast = setup_dialect_rules sctx ~dir ~dep_kind ~expander m in
            if lint then lint_module ~ast ~source:m;
            pped_module ast ~f:(fun ml_kind src dst ->
-             SC.add_rule sctx ~loc ~dir
+             (* Sandboxing breaks with an error like this:
+                Error: rename: _build/.sandbox/d9599ccb22f1fc9fc448f0d987648907/build/default/driveruser.pp.ml: No such file or directory
+
+                instead of the expected "rule failed to generate targets"
+             *)
+             SC.add_rule ~sandbox:Sandbox_config.no_sandboxing sctx ~loc ~dir
                (promote_correction ~suffix:corrected_suffix
                   (Option.value_exn (Module.file m ~ml_kind))
                   (preprocessor_deps >>^ ignore
diff --git a/src/rule.ml b/src/rule.ml
index 64eb9caa04f..901b63b8301 100644
--- a/src/rule.ml
+++ b/src/rule.ml
@@ -30,7 +30,7 @@ type t =
   }
 
 let make
-      ?(sandbox=Sandbox_config.default)
+      ?(sandbox = Sandbox_config.default)
       ?(mode=Dune_file.Rule.Mode.Standard)
       ~context ~env ?(locks=[]) ?(info=Info.Internal) build =
   let targets = Build.targets build in
diff --git a/src/sandbox_config.ml b/src/sandbox_config.ml
index f53314d1d96..91e6bedb34a 100644
--- a/src/sandbox_config.ml
+++ b/src/sandbox_config.ml
@@ -20,4 +20,6 @@ let no_sandboxing =
 let needs_sandboxing =
   of_function Option.is_some
 
-let default = no_sandboxing
+let default = no_special_requirements
+
+let user_rule = no_sandboxing
diff --git a/src/sandbox_config.mli b/src/sandbox_config.mli
index 0c1af57f868..c8160d67118 100644
--- a/src/sandbox_config.mli
+++ b/src/sandbox_config.mli
@@ -18,11 +18,15 @@ val needs_sandboxing : t
 (** The default sandboxing config for actions that don't bother specifying it.
 
     Often this means that they don't have special requirements, but it also
-    often means that we're not sure and there might be some requirements
-    that we didn't yet discover because we never tried sandboxing it.
+    often means that we're not quite sure.
 
-    Currently we have [default = no_sandboxing] to be consistent with the old
-    dune behavior, but we'd like to change it to
-    [default = no_special_requirements].
+    Currently we have [default = no_special_requirements].
 *)
 val default : t
+
+(** The default sandboxing config for user rules.
+
+    We currently assume that user rules must not be sandboxed, but that's a
+    terrible assumption.
+*)
+val user_rule : t
diff --git a/src/simple_rules.ml b/src/simple_rules.ml
index 4d7a6546d3d..3687b331979 100644
--- a/src/simple_rules.ml
+++ b/src/simple_rules.ml
@@ -63,7 +63,9 @@ let user_rule sctx ?extra_bindings ~dir ~expander (rule : Rule.t) =
     in
     let bindings = dep_bindings ~extra_bindings rule.deps in
     let expander = Expander.add_bindings expander ~bindings in
-    SC.add_rule_get_targets sctx ~dir ~mode:rule.mode ~loc:rule.loc
+    SC.add_rule_get_targets sctx
+      ~sandbox:(Sandbox_config.user_rule)
+      ~dir ~mode:rule.mode ~loc:rule.loc
       ~locks:(interpret_locks ~expander rule.locks)
       (SC.Deps.interpret_named sctx ~expander rule.deps
        >>>
@@ -74,7 +76,8 @@ let user_rule sctx ?extra_bindings ~dir ~expander (rule : Rule.t) =
          ~expander
          ~dep_kind:Required
          ~targets
-         ~targets_dir:dir)
+         ~targets_dir:dir
+      )
   end else
     Path.Build.Set.empty
 
@@ -112,7 +115,11 @@ let copy_files sctx ~dir ~expander ~src_dir (def: Copy_files.t) =
   Path.Set.map files ~f:(fun file_src ->
     let basename = Path.basename file_src in
     let file_dst = Path.Build.relative dir basename in
-    SC.add_rule sctx ~loc ~dir
+    (* with sandboxing, some expect test fails with:
+       -  #line 1 "include/bar.h"
+       +  #line 1 "1a0210e62c0acf83a7b2119b6ab36462/build/default/include/bar.h"
+    *)
+    SC.add_rule ~sandbox:Sandbox_config.no_sandboxing sctx ~loc ~dir
       ((if def.add_line_directive
         then Build.copy_and_add_line_directive
         else Build.copy)

From 535aea5b3b4df0699e02b0168c45de84ba900ecb Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Wed, 29 May 2019 15:04:30 +0100
Subject: [PATCH 05/43] cli

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 bin/common.ml        | 24 +++++++++++++++++++++++-
 src/sandbox_mode.ml  |  5 +++++
 src/sandbox_mode.mli |  1 +
 3 files changed, 29 insertions(+), 1 deletion(-)

diff --git a/bin/common.ml b/bin/common.ml
index 8998c644a9b..d200440f276 100644
--- a/bin/common.ml
+++ b/bin/common.ml
@@ -327,6 +327,27 @@ let term =
          & info ["j"] ~docs ~docv:"JOBS"
              ~doc:{|Run no more than $(i,JOBS) commands simultaneously.|}
         )
+  and+ sandboxing_preference =
+    let arg =
+      Arg.conv
+        ((fun s ->
+           Result.map_error (Dune.Sandbox_mode.of_string s)
+             ~f:(fun s -> `Msg s)),
+         (fun pp x ->
+            Format.pp_print_string pp (Dune.Sandbox_mode.to_string x)))
+    in
+    Arg.(value
+         & opt (some arg) None
+         & info ["sandbox"]
+             ~doc:(
+               Printf.sprintf
+                 "Sandboxing mode to use by default. Some actions require \
+                  a certain sandboxing mode, so they will ignore this \
+                  setting. The allowed values are: %s."
+                 (String.concat ~sep: ", " (
+                    List.map Dune.Sandbox_mode.all
+                      ~f:Dune.Sandbox_mode.to_string))
+             ))
   and+ debug_dep_path =
     Arg.(value
          & flag
@@ -462,7 +483,8 @@ let term =
     Config.merge config
       { display
       ; concurrency
-      ; sandboxing_preference = None
+      ; sandboxing_preference =
+          Option.map sandboxing_preference ~f:(fun x -> [x])
       }
   in
   let config =
diff --git a/src/sandbox_mode.ml b/src/sandbox_mode.ml
index e82bdba1caa..8cfb9f3ec90 100644
--- a/src/sandbox_mode.ml
+++ b/src/sandbox_mode.ml
@@ -17,3 +17,8 @@ let of_string = function
   | "symlink" -> Ok (Some Symlink : t)
   | "copy" -> Ok (Some Copy)
   | _ -> error
+
+let to_string = function
+  | None -> "none"
+  | Some Symlink -> "symlink"
+  | Some Copy -> "copy"
diff --git a/src/sandbox_mode.mli b/src/sandbox_mode.mli
index f439d6b2ebe..d048c097b51 100644
--- a/src/sandbox_mode.mli
+++ b/src/sandbox_mode.mli
@@ -9,3 +9,4 @@ type t = some option
 val all : t list
 
 val of_string : string -> (t, string) Result.t
+val to_string : t -> string

From 3b02538a820e40b2ad759fef60ea057f42616d07 Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Wed, 29 May 2019 15:35:15 +0100
Subject: [PATCH 06/43] discovered another breakage with ocaml platform

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 src/action.ml               |  2 ++
 src/build_system.ml         |  6 +++++-
 src/compilation_context.ml  | 15 ++++++++++++---
 src/compilation_context.mli |  3 +--
 src/module_compilation.ml   |  8 +++++---
 5 files changed, 25 insertions(+), 9 deletions(-)

diff --git a/src/action.ml b/src/action.ml
index 546de1578bc..41e2ebbb481 100644
--- a/src/action.ml
+++ b/src/action.ml
@@ -179,6 +179,8 @@ let prepare_managed_paths ~link ~sandboxed deps ~eval_pred =
       ~f:(fun path acc ->
         match Path.as_in_build_dir path with
         | None ->
+          (* This can actually raise if we try to sandbox the "copy from
+             source dir" rules. There is no reason to do that though. *)
           assert (not (Path.is_in_source_tree path));
           acc
         | Some p -> link path (sandboxed p) :: acc)
diff --git a/src/build_system.ml b/src/build_system.ml
index 5dfaa92464c..16ef1c2ec67 100644
--- a/src/build_system.ml
+++ b/src/build_system.ml
@@ -761,7 +761,11 @@ end = struct
     |> List.map ~f:(fun path ->
       let ctx_path = Path.Build.append_source ctx_dir path in
       let build = Build.copy ~src:(Path.source path) ~dst:ctx_path in
-      Pre_rule.make build ~context:None ~env:None ~info:Source_file_copy)
+      Pre_rule.make
+        (* There's an [assert false] in [prepare_managed_paths] that blows up
+           if we try to sandbox this. *)
+        ~sandbox:Sandbox_config.no_sandboxing
+        build ~context:None ~env:None ~info:Source_file_copy)
 
   let compile_rules ~dir rules =
     List.concat_map rules ~f:(fun rule ->
diff --git a/src/compilation_context.ml b/src/compilation_context.ml
index 4ff85a2954e..b2fd4315471 100644
--- a/src/compilation_context.ml
+++ b/src/compilation_context.ml
@@ -59,7 +59,7 @@ type t =
   ; stdlib               : Dune_file.Library.Stdlib.t option
   ; js_of_ocaml          : Dune_file.Js_of_ocaml.t option
   ; dynlink              : bool
-  ; sandbox              : Sandbox_config.t option
+  ; sandbox              : Sandbox_config.t
   ; package              : Package.t option
   ; vimpl                : Vimpl.t option
   }
@@ -91,13 +91,22 @@ let create ~super_context ~scope ~expander ~obj_dir
       ?(dir_kind=Dune_lang.File_syntax.Dune)
       ~modules ~flags ~requires_compile ~requires_link
       ?(preprocessing=Preprocessing.dummy) ?(no_keep_locs=false)
-      ~opaque ?stdlib ?js_of_ocaml ~dynlink ?sandbox ~package ?vimpl () =
+      ~opaque ?stdlib ?js_of_ocaml ~dynlink ~package ?vimpl () =
   let requires_compile =
     if Dune_project.implicit_transitive_deps (Scope.project scope) then
       Lazy.force requires_link
     else
       requires_compile
   in
+  let sandbox =
+    (* With sandboxing, there are a few build errors in ocaml platform
+       1162238ae like:
+       File "ocaml_modules/ocamlgraph/src/pack.ml", line 1:
+       Error: The implementation ocaml_modules/ocamlgraph/src/pack.ml
+       does not match the interface ocaml_modules/ocamlgraph/src/.graph.objs/byte/graph__Pack.cmi:
+    *)
+    Sandbox_config.no_sandboxing
+  in
   { super_context
   ; scope
   ; expander
@@ -142,7 +151,7 @@ let for_alias_module t =
         ["-w"; "-49"; "-nopervasives"; "-nostdlib"]
   ; includes     = Includes.empty
   ; stdlib       = None
-  ; sandbox      = Some sandbox
+  ; sandbox      = sandbox
   }
 
 let for_wrapped_compat t =
diff --git a/src/compilation_context.mli b/src/compilation_context.mli
index 40c37252dc1..e6833d82052 100644
--- a/src/compilation_context.mli
+++ b/src/compilation_context.mli
@@ -29,7 +29,6 @@ val create
   -> ?stdlib               : Dune_file.Library.Stdlib.t
   -> ?js_of_ocaml          : Dune_file.Js_of_ocaml.t
   -> dynlink               : bool
-  -> ?sandbox              : Sandbox_config.t
   -> package               : Package.t option
   -> ?vimpl                : Vimpl.t
   -> unit
@@ -56,7 +55,7 @@ val opaque               : t -> bool
 val stdlib               : t -> Dune_file.Library.Stdlib.t option
 val js_of_ocaml          : t -> Dune_file.Js_of_ocaml.t option
 val dynlink              : t -> bool
-val sandbox              : t -> Sandbox_config.t option
+val sandbox              : t -> Sandbox_config.t
 val package              : t -> Package.t option
 val vimpl                : t -> Vimpl.t option
 
diff --git a/src/module_compilation.ml b/src/module_compilation.ml
index 371b3bd3db0..5b699de9dcc 100644
--- a/src/module_compilation.ml
+++ b/src/module_compilation.ml
@@ -116,11 +116,13 @@ let build_cm cctx ~dep_graphs ~precompiled_cmi ~cm_kind (m : Module.t) =
           |> Path.Build.relative dir
         in
         SC.add_rule sctx ~dir
+          ~sandbox
           (Build.symlink ~src:(Path.build dst) ~dst:old_dst);
         List.iter other_targets ~f:(fun in_obj_dir ->
           let in_dir = Path.Build.relative dir
                          (Path.Build.basename in_obj_dir) in
           SC.add_rule sctx ~dir
+            ~sandbox
             (Build.symlink ~src:(Path.build in_obj_dir) ~dst:in_dir))
       end;
       let opaque_arg =
@@ -154,7 +156,7 @@ let build_cm cctx ~dep_graphs ~precompiled_cmi ~cm_kind (m : Module.t) =
           flags @ pp_flags
       in
       let modules = Compilation_context.modules cctx in
-      SC.add_rule sctx ?sandbox ~dir
+      SC.add_rule sctx ~sandbox ~dir
         (Build.S.seqs [Build.paths extra_deps; other_cm_files]
            (Command.run ~dir:(Path.build dir) (Ok compiler)
               [ Command.Args.dyn flags
@@ -193,7 +195,7 @@ let build_module ~dep_graphs ?(precompiled_cmi=false) cctx m =
     let obj_dir = CC.obj_dir cctx in
     let src = Obj_dir.Module.cm_file_unsafe obj_dir m ~kind:Cm_kind.Cmo in
     let target = Path.Build.extend_basename src ~suffix:".js" in
-    SC.add_rules sctx ~dir
+    SC.add_rules ~sandbox:Sandbox_config.no_sandboxing sctx ~dir
       (Js_of_ocaml_rules.build_cm cctx ~js_of_ocaml ~src ~target))
 
 let ocamlc_i ?(flags=[]) ~dep_graphs cctx (m : Module.t) ~output =
@@ -213,7 +215,7 @@ let ocamlc_i ?(flags=[]) ~dep_graphs cctx (m : Module.t) ~output =
   in
   let ocaml_flags = Ocaml_flags.get_for_cm (CC.flags cctx) ~cm_kind:Cmo in
   let modules = Compilation_context.modules cctx in
-  SC.add_rule sctx ?sandbox ~dir
+  SC.add_rule sctx ~sandbox ~dir
     (Build.S.seq cm_deps
        (Build.S.map ~f:(Action.with_stdout_to output)
           (Command.run (Ok ctx.ocamlc) ~dir:(Path.build ctx.build_dir)

From 66625d793e6fa3e6bf55566f4122c59cf2bfd845 Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Tue, 23 Jul 2019 11:28:37 +0100
Subject: [PATCH 07/43] this bit seems unnecessary

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 src/module_compilation.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/module_compilation.ml b/src/module_compilation.ml
index 5b699de9dcc..4e9fc424a0a 100644
--- a/src/module_compilation.ml
+++ b/src/module_compilation.ml
@@ -195,7 +195,7 @@ let build_module ~dep_graphs ?(precompiled_cmi=false) cctx m =
     let obj_dir = CC.obj_dir cctx in
     let src = Obj_dir.Module.cm_file_unsafe obj_dir m ~kind:Cm_kind.Cmo in
     let target = Path.Build.extend_basename src ~suffix:".js" in
-    SC.add_rules ~sandbox:Sandbox_config.no_sandboxing sctx ~dir
+    SC.add_rules sctx ~dir
       (Js_of_ocaml_rules.build_cm cctx ~js_of_ocaml ~src ~target))
 
 let ocamlc_i ?(flags=[]) ~dep_graphs cctx (m : Module.t) ~output =

From 081e4b256630c70ae28bf9224c59f7df47b5c9b5 Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Wed, 29 May 2019 15:47:23 +0100
Subject: [PATCH 08/43] changelog entry

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 CHANGES.md | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/CHANGES.md b/CHANGES.md
index 1dda534b6f8..4e69ba23a29 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -15,6 +15,12 @@
   is done to prevent the accidental collision with library dependencies of the
   executable. (#2364, fixes #2292, @rgrinberg)
 
+- Add a new config option sandboxing_preference and the corresponding cli
+  argument `--sandbox`, which lets the user control the level of sandboxing 
+  dune does by default. The individual build rules can override this setting. 
+  The rules  defined in `dune` files are currently not sandboxed. 
+  (#2213, @aalekseyev)
+
 1.11.0 (unreleased)
 -------------------
 

From 61882e315645814cebc227a0a0462d58a80d5303 Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Fri, 19 Jul 2019 18:47:49 +0100
Subject: [PATCH 09/43] explore an idea: why not treat sandbox requirement as
 one of the dependencies

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 src/build_system.ml    |  16 +++----
 src/dep.ml             |  57 +++++++++++++++++++---
 src/dep.mli            |   7 ++-
 src/dune_file.ml       |  39 ++++++++-------
 src/dune_file.mli      |   6 +++
 src/rule.ml            |   5 +-
 src/rule.mli           |   1 -
 src/sandbox_config.ml  | 106 +++++++++++++++++++++++++++++++++++++++--
 src/sandbox_config.mli |  43 ++++++++++++++---
 src/super_context.ml   |   3 ++
 10 files changed, 237 insertions(+), 46 deletions(-)

diff --git a/src/build_system.ml b/src/build_system.ml
index 16ef1c2ec67..19068ecd27b 100644
--- a/src/build_system.ml
+++ b/src/build_system.ml
@@ -120,7 +120,6 @@ module Internal_rule = struct
       ; info             : Rule.Info.t
       ; dir              : Path.Build.t
       ; env              : Env.t option
-      ; sandbox          : Sandbox_config.t
       ; locks            : Path.t list
       ; (* Reverse dependencies discovered so far, labelled by the
            requested target *)
@@ -166,7 +165,6 @@ module Internal_rule = struct
     ; info        = Internal
     ; dir         = Path.Build.root
     ; env         = None
-    ; sandbox     = Sandbox_config.no_special_requirements
     ; locks       = []
     ; rev_deps    = []
     ; transitive_rev_deps = Id.Set.empty
@@ -721,7 +719,6 @@ end = struct
         ; env
         ; build
         ; targets
-        ; sandbox
         ; mode
         ; locks
         ; info
@@ -739,7 +736,6 @@ end = struct
       ; build
       ; context
       ; env
-      ; sandbox
       ; locks
       ; mode
       ; info
@@ -1348,7 +1344,9 @@ end = struct
       | File f -> build_file f
       | Glob g -> Pred.build g
       | Universe
-      | Env _ -> Fiber.return ())
+      | Env _ -> Fiber.return ()
+      | Sandbox_config _ -> Fiber.return ()
+    )
 
   let eval_pred = Pred.eval
 
@@ -1442,7 +1440,6 @@ end = struct
         ; env
         ; context
         ; mode
-        ; sandbox
         ; locks
         ; id = _
         ; static_deps = _
@@ -1459,7 +1456,9 @@ end = struct
     let head_target = List.hd targets_as_list in
     let prev_trace = Trace.get (Path.build head_target) in
     let sandbox_mode =
-      select_sandbox_mode sandbox ~sandboxing_preference:t.sandboxing_preference
+      select_sandbox_mode
+        (Dep.Set.sandbox_config deps)
+        ~sandboxing_preference:t.sandboxing_preference
     in
     let rule_digest =
       let env =
@@ -1469,11 +1468,10 @@ end = struct
         | None, Some c -> c.env
       in
       let trace =
-        ( Dep.Set.trace deps ~env ~eval_pred
+        ( Dep.Set.trace deps ~sandbox_mode ~env ~eval_pred
         , List.map targets_as_list ~f:(fun p -> Path.to_string (Path.build p))
         , Option.map context ~f:(fun c -> c.name)
         , Action.for_shell action
-        , (sandbox_mode : Sandbox_mode.t)
         )
       in
       Digest.generic trace
diff --git a/src/dep.ml b/src/dep.ml
index b884d8443a4..d4f8d409e10 100644
--- a/src/dep.ml
+++ b/src/dep.ml
@@ -1,7 +1,10 @@
 open Stdune
 
 module Trace = struct
-  type t = (string * Digest.t) list
+  type t = {
+    sandbox_mode : Sandbox_mode.t;
+    files : (string * Digest.t) list;
+  }
 end
 
 module T = struct
@@ -11,12 +14,14 @@ module T = struct
     | Alias of Alias.t
     | Glob of File_selector.t
     | Universe
+    | Sandbox_config of Sandbox_config.t
 
   let env e = Env e
   let file f = File f
   let alias a = Alias a
   let universe = Universe
   let glob g = Glob g
+  let sandbox_config config = Sandbox_config config
 
   let compare x y =
     match x, y with
@@ -33,12 +38,16 @@ module T = struct
     | Glob _, _ -> Lt
     | _, Glob _ -> Gt
     | Universe, Universe -> Ordering.Eq
+    | Universe, _ -> Lt
+    | _, Universe -> Gt
+    | Sandbox_config x, Sandbox_config y ->
+      Sandbox_config.compare x y
 
   let unset = lazy (Digest.string "unset")
 
   let trace_file fn = (Path.to_string fn, Cached_digest.file fn)
 
-  let trace t ~env ~eval_pred =
+  let trace t ~sandbox_mode ~env ~eval_pred =
     match t with
     | Universe -> ["universe", Digest.string "universe"]
     | File fn -> [trace_file fn]
@@ -55,15 +64,36 @@ module T = struct
         end
       in
       [var, value]
+    | Sandbox_config config ->
+      assert (Sandbox_config.mem config sandbox_mode);
+      (* recorded globally for the whole dep set *)
+      []
 
   let encode t =
     let open Dune_lang.Encoder in
+    let sandbox_mode (mode : Sandbox_mode.t) =
+      match mode with
+      | None -> "none"
+      | Some Copy -> "copy"
+      | Some Symlink -> "symlink"
+    in
+    let sandbox_config (config : Sandbox_config.t) =
+      list (fun x -> x) (
+        List.filter_map Sandbox_mode.all ~f:(fun mode ->
+          if not (Sandbox_config.mem config mode)
+          then
+            Some (pair string string ("disallow", sandbox_mode mode))
+          else
+            None))
+    in
     match t with
     | Glob g -> pair string File_selector.encode ("glob", g)
     | Env e -> pair string string ("Env", e)
     | File f -> pair string Dpath.encode ("File", f)
     | Alias a -> pair string Alias.encode ("Alias", a)
     | Universe -> string "Universe"
+    | Sandbox_config config ->
+      pair string sandbox_config ("Sandbox_config", config)
 
   let to_dyn _ = Dyn.opaque
 end
@@ -78,13 +108,26 @@ module Set = struct
 
   let has_universe t = mem t Universe
 
+  let sandbox_config t =
+    List.fold_left (to_list t) ~init:(Sandbox_config.no_special_requirements)
+      ~f:(fun acc x -> match x with
+        | Glob _ | Env _ | File _ | Alias _ | Universe -> acc
+        | Sandbox_config config ->
+          Sandbox_config.inter acc config)
+
   let of_files = List.fold_left ~init:empty ~f:(fun acc f -> add acc (file f))
 
   let of_files_set =
     Path.Set.fold ~init:empty ~f:(fun f acc -> add acc (file f))
 
-  let trace t ~env ~eval_pred =
-    List.concat_map (to_list t) ~f:(trace ~env ~eval_pred)
+  let trace t ~sandbox_mode ~env ~eval_pred =
+    let files =
+      List.concat_map (to_list t) ~f:(trace ~sandbox_mode ~env ~eval_pred)
+    in
+    { Trace.
+      files;
+      sandbox_mode;
+    }
 
   let add_paths t paths =
     Path.Set.fold paths ~init:t ~f:(fun p set -> add set (File p))
@@ -98,7 +141,8 @@ module Set = struct
       | File f -> Path.Set.add acc f
       | Glob g -> Path.Set.union acc (eval_pred g)
       | Universe
-      | Env _ -> acc)
+      | Env _ -> acc
+      | Sandbox_config _ -> acc)
 
   let parallel_iter t ~f = Fiber.parallel_iter ~f (to_list t)
 
@@ -114,7 +158,8 @@ module Set = struct
       | Glob g -> Path.Set.add acc (File_selector.dir g)
       | File f -> Path.Set.add acc (Path.parent_exn f)
       | Universe
-      | Env _ -> acc)
+      | Env _ -> acc
+      | Sandbox_config _ -> acc)
 end
 
 type eval_pred = File_selector.t -> Path.Set.t
diff --git a/src/dep.mli b/src/dep.mli
index 51c7c1e3b7f..e259f45e227 100644
--- a/src/dep.mli
+++ b/src/dep.mli
@@ -6,12 +6,14 @@ type t = private
   | Alias of Alias.t
   | Glob of File_selector.t
   | Universe
+  | Sandbox_config of Sandbox_config.t
 
 val file : Path.t -> t
 val env : Env.Var.t -> t
 val universe : t
 val glob : File_selector.t -> t
 val alias : Alias.t -> t
+val sandbox_config : Sandbox_config.t -> t
 
 val compare : t -> t -> Ordering.t
 
@@ -26,6 +28,8 @@ module Set : sig
 
   val has_universe : t -> bool
 
+  val sandbox_config : t -> Sandbox_config.t
+
   val of_files : Path.t list -> t
 
   val of_files_set : Path.Set.t -> t
@@ -34,7 +38,8 @@ module Set : sig
 
   val encode : t -> Dune_lang.t
 
-  val trace : t -> env:Env.t -> eval_pred:eval_pred -> Trace.t
+  val trace :
+    t -> sandbox_mode:Sandbox_mode.t -> env:Env.t -> eval_pred:eval_pred -> Trace.t
 
   val add_paths : t -> Path.Set.t -> t
 
diff --git a/src/dune_file.ml b/src/dune_file.ml
index 25806c44312..3e449cf62b8 100644
--- a/src/dune_file.ml
+++ b/src/dune_file.ml
@@ -236,6 +236,7 @@ module Dep_conf = struct
     | Package of String_with_vars.t
     | Universe
     | Env_var of String_with_vars.t
+    | Sandbox_config of Sandbox_config.t
 
   let remove_locs = function
     | File sw -> File (String_with_vars.remove_locs sw)
@@ -246,6 +247,7 @@ module Dep_conf = struct
     | Package sw -> Package (String_with_vars.remove_locs sw)
     | Universe -> Universe
     | Env_var sw -> Env_var sw
+    | Sandbox_config s -> Sandbox_config s
 
   let decode =
     let decode =
@@ -298,6 +300,11 @@ module Dep_conf = struct
     | Env_var t ->
       List [ Dune_lang.unsafe_atom_of_string "env_var"
            ; String_with_vars.encode t]
+    | Sandbox_config config ->
+      if Sandbox_config.equal config Sandbox_config.no_special_requirements
+      then
+        List []
+      else Code_error.raise "There's no syntax for [Sandbox_config] yet" []
 
   let to_dyn t = Dune_lang.to_dyn (encode t)
 end
@@ -434,7 +441,7 @@ module Per_module = struct
             let+ x =
               repeat
                 (let+ (pp, names) = pair a (list module_name) in
-                (names, pp))
+                 (names, pp))
             in
             of_mapping x ~default
             |> function
@@ -442,7 +449,7 @@ module Per_module = struct
             | Error (name, _, _) ->
               User_error.raise ~loc
                 [ Pp.textf "module %s present in two different sets"
-                (Module.Name.to_string name) ]
+                    (Module.Name.to_string name) ]
           ]
     | _ -> a >>| for_all
 end
@@ -536,7 +543,7 @@ module Lib_dep = struct
             Option.iter (Lib_name.Set.choose common) ~f:(fun name ->
               User_error.raise ~loc
                 [ Pp.textf "library %S is both required and forbidden in this clause"
-                (Lib_name.to_string name) ]);
+                    (Lib_name.to_string name) ]);
             { required
             ; forbidden
             ; file
@@ -593,19 +600,19 @@ module Lib_deps = struct
         match kind, kind' with
         | Required, Required ->
           User_error.raise ~loc [ Pp.textf "library %S is present twice"
-            (Lib_name.to_string name) ]
+                                    (Lib_name.to_string name) ]
         | (Optional|Forbidden), (Optional|Forbidden) ->
           acc
         | Optional, Required | Required, Optional ->
           User_error.raise ~loc
             [ Pp.textf "library %S is present both as an optional \
-             and required dependency"
-            (Lib_name.to_string name) ]
+                        and required dependency"
+                (Lib_name.to_string name) ]
         | Forbidden, Required | Required, Forbidden ->
           User_error.raise ~loc
             [ Pp.textf "library %S is present both as a forbidden \
-             and required dependency"
-            (Lib_name.to_string name) ]
+                        and required dependency"
+                (Lib_name.to_string name) ]
     in
     ignore (
       List.fold_left t ~init:Lib_name.Map.empty ~f:(fun acc x ->
@@ -1434,16 +1441,16 @@ module Executables = struct
           else
             User_error.raise ~loc
               [ Pp.textf "%s field may not be omitted before dune version %s"
-              (pluralize ~multi "name")
-              (Syntax.Version.to_string allow_omit_names_version) ]
+                  (pluralize ~multi "name")
+                  (Syntax.Version.to_string allow_omit_names_version) ]
         | None, None ->
           if dune_syntax >= allow_omit_names_version then
             User_error.raise ~loc [ Pp.textf "either the %s or the %s field must be present"
-              (pluralize ~multi "name")
-              (pluralize ~multi "public_name") ]
+                                      (pluralize ~multi "name")
+                                      (pluralize ~multi "public_name") ]
           else
             User_error.raise ~loc [ Pp.textf "field %s is missing"
-              (pluralize ~multi "name") ]
+                                      (pluralize ~multi "name") ]
       in
       let public =
         match package, public_names with
@@ -1587,7 +1594,7 @@ module Executables = struct
              (mem t native_shared_object && mem t shared_object) then
             User_error.raise ~loc
               [ Pp.textf "It is not allowed use both native and best \
-               for the same binary kind." ]
+                          for the same binary kind." ]
           else
             t
 
@@ -1616,7 +1623,7 @@ module Executables = struct
   let common =
     let+ buildable = Buildable.decode
     and+ (_ : bool) = field "link_executables" ~default:true
-                       (Syntax.deleted_in Stanza.syntax (1, 0) >>> bool)
+                        (Syntax.deleted_in Stanza.syntax (1, 0) >>> bool)
     and+ link_deps = field "link_deps" (list Dep_conf.decode) ~default:[]
     and+ link_flags = field_oslu "link_flags"
     and+ modes = field "modes" Link_mode.Set.decode ~default:Link_mode.Set.default
@@ -2203,7 +2210,7 @@ module Tests = struct
        and+ package = field_o "package" Pkg.decode
        and+ locks = field "locks" (list String_with_vars.decode) ~default:[]
        and+ modes = field "modes" Executables.Link_mode.Set.decode
-                     ~default:Executables.Link_mode.Set.default
+                      ~default:Executables.Link_mode.Set.default
        and+ deps =
          field "deps" (Bindings.decode Dep_conf.decode) ~default:Bindings.empty
        and+ enabled_if = enabled_if ~since:(Some (1, 4))
diff --git a/src/dune_file.mli b/src/dune_file.mli
index dcc7822c43c..78950f81960 100644
--- a/src/dune_file.mli
+++ b/src/dune_file.mli
@@ -112,6 +112,12 @@ module Dep_conf : sig
     | Package of String_with_vars.t
     | Universe
     | Env_var of String_with_vars.t
+    (* [Sandbox_config] is a way to declare that your action also depends
+       on there being a clean filesystem around its deps.
+       (or, if you require [no_sandboxing], it's that your action depends on
+       something undeclared (e.g. absolute path of cwd) and you want to
+       allow it) *)
+    | Sandbox_config of Sandbox_config.t
 
   val remove_locs : t -> t
 
diff --git a/src/rule.ml b/src/rule.ml
index 901b63b8301..8db7a1198dd 100644
--- a/src/rule.ml
+++ b/src/rule.ml
@@ -22,7 +22,6 @@ type t =
   ; env      : Env.t option
   ; build    : (unit, Action.t) Build.t
   ; targets  : Path.Build.Set.t
-  ; sandbox  : Sandbox_config.t
   ; mode     : Dune_file.Rule.Mode.t
   ; locks    : Path.t list
   ; info     : Info.t
@@ -33,6 +32,9 @@ let make
       ?(sandbox = Sandbox_config.default)
       ?(mode=Dune_file.Rule.Mode.Standard)
       ~context ~env ?(locks=[]) ?(info=Info.Internal) build =
+  let build =
+    Build.S.seq (Build.dep (Dep.sandbox_config sandbox)) build
+  in
   let targets = Build.targets build in
   let dir =
     match Path.Build.Set.choose targets with
@@ -66,7 +68,6 @@ let make
   ; env
   ; build
   ; targets
-  ; sandbox
   ; mode
   ; locks
   ; info
diff --git a/src/rule.mli b/src/rule.mli
index 4ce0f33d60f..fee123631e6 100644
--- a/src/rule.mli
+++ b/src/rule.mli
@@ -19,7 +19,6 @@ type t =
   ; env      : Env.t option
   ; build    : (unit, Action.t) Build.t
   ; targets  : Path.Build.Set.t
-  ; sandbox  : Sandbox_config.t
   ; mode     : Dune_file.Rule.Mode.t
   ; locks    : Path.t list
   ; info     : Info.t
diff --git a/src/sandbox_config.ml b/src/sandbox_config.ml
index 91e6bedb34a..ead598885ce 100644
--- a/src/sandbox_config.ml
+++ b/src/sandbox_config.ml
@@ -1,11 +1,28 @@
 open! Stdune
 
-type t = {
-  none : bool;
-  symlink : bool;
-  copy : bool;
+type 'a gen = {
+  none : 'a;
+  symlink : 'a;
+  copy : 'a;
 }
 
+type t = bool gen
+
+let compare_gen compare x y =
+  let compare_k a b k =
+    match compare a b with
+    | Eq -> k ()
+    | Lt -> Lt
+    | Gt -> Gt
+  in
+  compare_k x.none y.none (fun () ->
+    compare_k x.symlink y.symlink (fun () ->
+      compare x.copy y.copy
+    )
+  )
+
+let compare = compare_gen Bool.compare
+
 let of_function (f : Sandbox_mode.t -> _) = {
   none = f None;
   symlink = f (Some Symlink);
@@ -23,3 +40,84 @@ let needs_sandboxing =
 let default = no_special_requirements
 
 let user_rule = no_sandboxing
+
+type conflict = Conflict
+
+
+module Partial = struct
+  type t = bool option gen
+
+  let get_unique eq l =
+    match l with
+    | [] -> Ok None
+    | x :: xs ->
+      if List.for_all xs ~f:(eq x)
+      then
+        Ok (Some x)
+      else
+        Error Conflict
+
+  (** [merge] behaves like [inter] when there is no error, but it can
+      detect a nonsensical configuration where [inter] can't. *)
+  let merge ~loc items =
+    let merge_field field_name field =
+      match
+        get_unique Bool.equal
+          (List.filter_map items ~f:field)
+      with
+      | Error Conflict ->
+        User_error.raise ~loc [ Pp.text (
+          sprintf "Inconsistent sandboxing configuration. Sandboxing mode \
+                   %s is both allowed and disallowed" field_name)
+        ]
+      | Ok None ->
+        (* allowed if not forbidden *)
+        true
+      | Ok (Some v) -> v
+    in
+    let none = merge_field "none" (fun t -> t.none) in
+    let symlink = merge_field "symlink" (fun t -> t.symlink) in
+    let copy = merge_field "copy" (fun t -> t.copy) in
+    { none; symlink; copy }
+
+  let no_special_requirements = {
+    none = Some true;
+    symlink = Some true;
+    copy = Some true;
+  }
+
+  let no_sandboxing = {
+    none = Some true;
+    symlink = Some false;
+    copy = Some false;
+  }
+
+  let needs_sandboxing = {
+    none = Some false;
+    symlink = None;
+    copy = None;
+  }
+end
+
+let disallow (t : Sandbox_mode.t) = match t with
+  | None ->
+    { no_special_requirements with none = false }
+  | Some Copy ->
+    { no_special_requirements with copy = false }
+  | Some Symlink ->
+    { no_special_requirements with symlink = false }
+
+let inter x y = {
+  none = x.none && y.none;
+  copy = x.copy && y.copy;
+  symlink = x.symlink && y.symlink;
+}
+
+let mem t (mode : Sandbox_mode.t) = match mode with
+  | None -> t.none
+  | Some Copy -> t.copy
+  | Some Symlink -> t.symlink
+
+let equal x y = match compare x y with
+  | Eq -> true
+  | Lt | Gt -> false
diff --git a/src/sandbox_config.mli b/src/sandbox_config.mli
index c8160d67118..f6d3c4308ce 100644
--- a/src/sandbox_config.mli
+++ b/src/sandbox_config.mli
@@ -1,14 +1,22 @@
 open! Stdune
 
-(** A function [Sandbox_mode.t -> bool] returning true if the rule is expected
-    to work correctly (respecting its specified dependencies) in this mode. *)
-
-type t = {
-  none : bool;
-  symlink : bool;
-  copy : bool;
+type 'a gen = {
+  none : 'a;
+  symlink : 'a;
+  copy : 'a;
 }
 
+(** A set of sandbox modes in which the rule is expected
+    to work correctly. *)
+type t = bool gen
+
+val compare : t -> t -> Ordering.t
+
+val equal : t -> t -> bool
+
+(** Computes the intersection of allowed sandbox modes *)
+val inter : t -> t -> t
+
 val no_special_requirements : t
 
 val no_sandboxing : t
@@ -30,3 +38,24 @@ val default : t
     terrible assumption.
 *)
 val user_rule : t
+
+val disallow : Sandbox_mode.t -> t
+
+val mem : t -> Sandbox_mode.t -> bool
+
+module Partial : sig
+  type t = bool option gen
+
+  (** [merge] distributes across [inter] when there is no error, but it can
+      detect a nonsensical configuration where [inter] can't.
+
+      Can raise a User_error.
+  *)
+  val merge : loc:Loc.t -> t list -> bool gen
+
+  val no_special_requirements : t
+
+  val no_sandboxing : t
+
+  val needs_sandboxing : t
+end
diff --git a/src/super_context.ml b/src/super_context.ml
index 4bbe7200311..535b7951a3b 100644
--- a/src/super_context.ml
+++ b/src/super_context.ml
@@ -617,6 +617,9 @@ module Deps = struct
       let var = Expander.expand_str expander var_sw in
       Build.env_var var
       >>^ fun () -> []
+    | Sandbox_config sandbox_config ->
+      Build.dep (Dep.sandbox_config sandbox_config)
+      >>^ fun () -> []
 
   let make_interpreter ~f t ~expander l =
     let forms = Expander.Resolved_forms.empty () in

From 0543de24b1147fa5227bdf79f5a9fb6a38a4e50b Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Mon, 22 Jul 2019 11:43:38 +0100
Subject: [PATCH 10/43] the parsing layer

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 src/dune_file.ml                               | 10 ++++++++++
 src/sandbox_config.ml                          | 18 +++++++++++++-----
 src/sandbox_config.mli                         |  3 +++
 src/sandbox_mode.ml                            |  4 ++++
 src/sandbox_mode.mli                           |  4 ++++
 .../test-cases/allow_approximate_merlin/run.t  |  2 +-
 6 files changed, 35 insertions(+), 6 deletions(-)

diff --git a/src/dune_file.ml b/src/dune_file.ml
index 3e449cf62b8..7011b094d46 100644
--- a/src/dune_file.ml
+++ b/src/dune_file.ml
@@ -249,6 +249,15 @@ module Dep_conf = struct
     | Env_var sw -> Env_var sw
     | Sandbox_config s -> Sandbox_config s
 
+  let decode_sandbox_config =
+    located (list (sum [
+      "none", return Sandbox_config.Partial.no_sandboxing;
+      "always", return Sandbox_config.Partial.needs_sandboxing;
+      "preserve_file_kind",
+      return (Sandbox_config.Partial.disallow Sandbox_mode.symlink);
+    ]))
+    >>| fun (loc, x) -> Sandbox_config.Partial.merge ~loc x
+
   let decode =
     let decode =
       let sw = String_with_vars.decode in
@@ -269,6 +278,7 @@ module Dep_conf = struct
            and+ x = sw in
            Source_tree x)
         ; "env_var", (sw >>| fun x -> Env_var x)
+        ; "sandbox", (decode_sandbox_config >>| fun x -> Sandbox_config x)
         ]
     in
     if_list
diff --git a/src/sandbox_config.ml b/src/sandbox_config.ml
index ead598885ce..81532631590 100644
--- a/src/sandbox_config.ml
+++ b/src/sandbox_config.ml
@@ -1,5 +1,6 @@
 open! Stdune
 
+(* ['a t] represents a total map from [Sandbox_mode.t] to ['a] *)
 type 'a gen = {
   none : 'a;
   symlink : 'a;
@@ -80,6 +81,8 @@ module Partial = struct
     let copy = merge_field "copy" (fun t -> t.copy) in
     { none; symlink; copy }
 
+  let no_information = { none = None; symlink = None; copy = None }
+
   let no_special_requirements = {
     none = Some true;
     symlink = Some true;
@@ -92,11 +95,16 @@ module Partial = struct
     copy = Some false;
   }
 
-  let needs_sandboxing = {
-    none = Some false;
-    symlink = None;
-    copy = None;
-  }
+  let needs_sandboxing = { no_information with none = Some false; }
+
+  let disallow (mode : Sandbox_mode.t) =
+    match mode with
+    | None ->
+      { no_information with none = Some false }
+    | Some Symlink ->
+      { no_information with symlink = Some false }
+    | Some Copy ->
+      { no_information with copy = Some false }
 end
 
 let disallow (t : Sandbox_mode.t) = match t with
diff --git a/src/sandbox_config.mli b/src/sandbox_config.mli
index f6d3c4308ce..723b9bc64ed 100644
--- a/src/sandbox_config.mli
+++ b/src/sandbox_config.mli
@@ -58,4 +58,7 @@ module Partial : sig
   val no_sandboxing : t
 
   val needs_sandboxing : t
+
+  val disallow : Sandbox_mode.t -> t
+
 end
diff --git a/src/sandbox_mode.ml b/src/sandbox_mode.ml
index 8cfb9f3ec90..763c5008876 100644
--- a/src/sandbox_mode.ml
+++ b/src/sandbox_mode.ml
@@ -9,6 +9,10 @@ type t = some option
 (* these should be listed in the default order of preference *)
 let all = [None; Some Symlink; Some Copy]
 
+let none = None
+let symlink = Some Symlink
+let copy = Some Copy
+
 let error =
   Error "invalid sandboxing mode, must be 'none', 'symlink' or 'copy'"
 
diff --git a/src/sandbox_mode.mli b/src/sandbox_mode.mli
index d048c097b51..eb4bc6146b6 100644
--- a/src/sandbox_mode.mli
+++ b/src/sandbox_mode.mli
@@ -8,5 +8,9 @@ type t = some option
 
 val all : t list
 
+val none : t
+val symlink : t
+val copy : t
+
 val of_string : string -> (t, string) Result.t
 val to_string : t -> string
diff --git a/test/blackbox-tests/test-cases/allow_approximate_merlin/run.t b/test/blackbox-tests/test-cases/allow_approximate_merlin/run.t
index a0bf80bd1ca..810f55d7fe5 100644
--- a/test/blackbox-tests/test-cases/allow_approximate_merlin/run.t
+++ b/test/blackbox-tests/test-cases/allow_approximate_merlin/run.t
@@ -17,7 +17,7 @@ For lang >= 1.9, a warning is printed:
 
 Indeed, adding this will suppress the warning:
 
-  $ echo -e '(lang dune 1.9)\n(allow_approximate_merlin)' > dune-project
+  $ printf '(lang dune 1.9)\n(allow_approximate_merlin)\n' > dune-project
   $ dune build @check
 
 However, the warning is not emitted if it is not fixable (#2399).

From d242a16b3362e0b4a8c4544ff60fc6a246c92beb Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Mon, 22 Jul 2019 11:49:42 +0100
Subject: [PATCH 11/43] require dune 1.11 and update the changelog

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 CHANGES.md       |  8 ++++----
 src/dune_file.ml | 15 +++++++++------
 2 files changed, 13 insertions(+), 10 deletions(-)

diff --git a/CHANGES.md b/CHANGES.md
index 4e69ba23a29..457888c37a9 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -15,10 +15,10 @@
   is done to prevent the accidental collision with library dependencies of the
   executable. (#2364, fixes #2292, @rgrinberg)
 
-- Add a new config option sandboxing_preference and the corresponding cli
-  argument `--sandbox`, which lets the user control the level of sandboxing 
-  dune does by default. The individual build rules can override this setting. 
-  The rules  defined in `dune` files are currently not sandboxed. 
+- Add a new config option `sandboxing_preference`, the cli argument `--sandbox`,
+  and the dep spec `sandbox` in dune language. These let the user control the level of
+  sandboxing done by dune per rule and globally. The rule specification takes precedence.
+  The global configuration merely specifies the default. 
   (#2213, @aalekseyev)
 
 1.11.0 (unreleased)
diff --git a/src/dune_file.ml b/src/dune_file.ml
index 7011b094d46..8ebf97cfb5a 100644
--- a/src/dune_file.ml
+++ b/src/dune_file.ml
@@ -250,13 +250,16 @@ module Dep_conf = struct
     | Sandbox_config s -> Sandbox_config s
 
   let decode_sandbox_config =
-    located (list (sum [
-      "none", return Sandbox_config.Partial.no_sandboxing;
-      "always", return Sandbox_config.Partial.needs_sandboxing;
-      "preserve_file_kind",
+    let+ () = Syntax.since Stanza.syntax (1, 11)
+    and+ (loc, x) =
+      located (list (sum [
+        "none", return Sandbox_config.Partial.no_sandboxing;
+        "always", return Sandbox_config.Partial.needs_sandboxing;
+        "preserve_file_kind",
       return (Sandbox_config.Partial.disallow Sandbox_mode.symlink);
-    ]))
-    >>| fun (loc, x) -> Sandbox_config.Partial.merge ~loc x
+      ]))
+    in
+    Sandbox_config.Partial.merge ~loc x
 
   let decode =
     let decode =

From f83d45cb193bd9e940c7ba637d252b5f7aba10f3 Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Mon, 22 Jul 2019 15:38:06 +0100
Subject: [PATCH 12/43] test

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 test/blackbox-tests/dune.inc                  | 10 ++++
 .../test-cases/sandboxing/run.t               | 50 +++++++++++++++++++
 2 files changed, 60 insertions(+)
 create mode 100644 test/blackbox-tests/test-cases/sandboxing/run.t

diff --git a/test/blackbox-tests/dune.inc b/test/blackbox-tests/dune.inc
index d1f221421e0..7f0c70bc5dd 100644
--- a/test/blackbox-tests/dune.inc
+++ b/test/blackbox-tests/dune.inc
@@ -1314,6 +1314,14 @@
    test-cases/rule-target-external
    (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
+(alias
+ (name sandboxing)
+ (deps (package dune) (source_tree test-cases/sandboxing))
+ (action
+  (chdir
+   test-cases/sandboxing
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+
 (alias
  (name scope-bug)
  (deps (package dune) (source_tree test-cases/scope-bug))
@@ -1800,6 +1808,7 @@
   (alias redirections)
   (alias reporting-of-cycles)
   (alias rule-target-external)
+  (alias sandboxing)
   (alias scope-bug)
   (alias scope-ppx-bug)
   (alias select)
@@ -1980,6 +1989,7 @@
   (alias redirections)
   (alias reporting-of-cycles)
   (alias rule-target-external)
+  (alias sandboxing)
   (alias scope-bug)
   (alias select)
   (alias several-packages)
diff --git a/test/blackbox-tests/test-cases/sandboxing/run.t b/test/blackbox-tests/test-cases/sandboxing/run.t
new file mode 100644
index 00000000000..96f43083ecf
--- /dev/null
+++ b/test/blackbox-tests/test-cases/sandboxing/run.t
@@ -0,0 +1,50 @@
+Reproduction case for #1560: by default, `dune` files inside the .git
+directory should be ignored
+
+  $ echo '(lang dune 1.11)' > dune-project
+  $ true > dune
+  $ echo '(rule (target a) (deps) (action (bash "echo a > a; echo a > b")))' >> dune
+  $ echo '(rule (target b) (deps) (action (bash "echo a > a; echo a > b")))' >> dune
+  $ echo '(rule (target c) (deps a b) (action (bash "cat a b > c")))' >> dune
+  $ dune build c
+  $ cat _build/default/c
+  a
+  a
+
+If an action does not respect the dependency specification, it results in a broken
+build. Dune fails to detect that.
+
+Some day, we should use the mtimes check from jenga to detect it.
+
+  $ rm -rf _build
+  $ true > dune
+  $ echo '(rule (target a) (deps (sandbox always)) (action (bash "echo a > a; echo a > b")))' >> dune
+  $ echo '(rule (target b) (deps (sandbox always)) (action (bash "echo a > a; echo a > b")))' >> dune
+  $ echo '(rule (target c) (deps a b) (action (bash "cat a b > c")))' >> dune
+  $ dune build c
+  Internal error, please report upstream including the contents of _build/log.
+  Description:
+  ("This rule forbids all sandboxing modes (but it also requires sandboxing)",
+  {})
+  Backtrace:
+  Raised at file "src/stdune/code_error.ml", line 9, characters 2-29
+  Called from file "src/build_system.ml", line 1459, characters 6-118
+  Called from file "src/fiber/fiber.ml", line 112, characters 7-12
+  Re-raised at file "src/stdune/exn.ml", line 39, characters 38-65
+  Called from file "src/fiber/fiber.ml", line 82, characters 8-15
+  Re-raised at file "src/stdune/exn.ml", line 39, characters 38-65
+  Called from file "src/fiber/fiber.ml", line 82, characters 8-15
+  Re-raised at file "src/stdune/exn.ml", line 39, characters 38-65
+  Called from file "src/fiber/fiber.ml", line 82, characters 8-15
+  
+  I must not segfault.  Uncertainty is the mind-killer.  Exceptions are
+  the little-death that brings total obliteration.  I will fully express
+  my cases.  Execution will pass over me and through me.  And when it
+  has gone past, I will unwind the stack along its path.  Where the
+  cases are handled there will be nothing.  Only I will remain.
+  [1]
+  $ cat _build/default/c
+  cat: _build/default/c: No such file or directory
+  [1]
+
+# CR aalekseyev: fix this!

From 52de19943bb6883dcc23bff6d193547152a50dbd Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Mon, 22 Jul 2019 16:15:21 +0100
Subject: [PATCH 13/43] fix bug

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 src/build_system.ml                           | 15 ++++++--
 src/sandbox_config.ml                         |  2 -
 src/sandbox_config.mli                        |  7 ----
 src/simple_rules.ml                           |  5 ++-
 .../test-cases/sandboxing/run.t               | 37 +++++++++----------
 5 files changed, 32 insertions(+), 34 deletions(-)

diff --git a/src/build_system.ml b/src/build_system.ml
index 19068ecd27b..04cc308c3d3 100644
--- a/src/build_system.ml
+++ b/src/build_system.ml
@@ -1371,7 +1371,8 @@ end = struct
   let evaluate_action_and_dynamic_deps =
     Memo.exec evaluate_action_and_dynamic_deps_memo
 
-  let select_sandbox_mode (config : Sandbox_config.t) ~sandboxing_preference =
+  let select_sandbox_mode
+        (config : Sandbox_config.t) ~loc ~sandboxing_preference =
     match
       List.find_map sandboxing_preference ~f:(fun preference ->
         match (preference, config) with
@@ -1388,9 +1389,14 @@ end = struct
                 work on Windows." [])
         | _, _ -> None) with
     | None ->
-      Code_error.raise
-        "This rule forbids all sandboxing \
-         modes (but it also requires sandboxing)" []
+      (* This is not trivial to reach because the user rules are checked
+         at parse time and [sandboxing_preference] always includes all possible
+         modes. However, it can still be reached if multiple sandbox config
+         specs are combined into an unsatisfiable one. *)
+      User_error.raise
+        ~loc
+        [ Pp.text "This rule forbids all sandboxing \
+                   modes (but it also requires sandboxing)" ]
     | Some choice -> choice
 
   let evaluate_rule (rule : Internal_rule.t) =
@@ -1457,6 +1463,7 @@ end = struct
     let prev_trace = Trace.get (Path.build head_target) in
     let sandbox_mode =
       select_sandbox_mode
+        ~loc:(rule_loc ~file_tree:t.file_tree ~info ~dir)
         (Dep.Set.sandbox_config deps)
         ~sandboxing_preference:t.sandboxing_preference
     in
diff --git a/src/sandbox_config.ml b/src/sandbox_config.ml
index 81532631590..4d1d4ebad49 100644
--- a/src/sandbox_config.ml
+++ b/src/sandbox_config.ml
@@ -40,8 +40,6 @@ let needs_sandboxing =
 
 let default = no_special_requirements
 
-let user_rule = no_sandboxing
-
 type conflict = Conflict
 
 
diff --git a/src/sandbox_config.mli b/src/sandbox_config.mli
index 723b9bc64ed..320c5fc1ad4 100644
--- a/src/sandbox_config.mli
+++ b/src/sandbox_config.mli
@@ -32,13 +32,6 @@ val needs_sandboxing : t
 *)
 val default : t
 
-(** The default sandboxing config for user rules.
-
-    We currently assume that user rules must not be sandboxed, but that's a
-    terrible assumption.
-*)
-val user_rule : t
-
 val disallow : Sandbox_mode.t -> t
 
 val mem : t -> Sandbox_mode.t -> bool
diff --git a/src/simple_rules.ml b/src/simple_rules.ml
index 3687b331979..5a1ef125b4b 100644
--- a/src/simple_rules.ml
+++ b/src/simple_rules.ml
@@ -64,7 +64,10 @@ let user_rule sctx ?extra_bindings ~dir ~expander (rule : Rule.t) =
     let bindings = dep_bindings ~extra_bindings rule.deps in
     let expander = Expander.add_bindings expander ~bindings in
     SC.add_rule_get_targets sctx
-      ~sandbox:(Sandbox_config.user_rule)
+      (* user rules may have extra requirements, in which case they will be
+         specified as a part of rule.deps, which will be correctly taken care of
+         by the build arrow *)
+      ~sandbox:Sandbox_config.no_special_requirements
       ~dir ~mode:rule.mode ~loc:rule.loc
       ~locks:(interpret_locks ~expander rule.locks)
       (SC.Deps.interpret_named sctx ~expander rule.deps
diff --git a/test/blackbox-tests/test-cases/sandboxing/run.t b/test/blackbox-tests/test-cases/sandboxing/run.t
index 96f43083ecf..3413367db4e 100644
--- a/test/blackbox-tests/test-cases/sandboxing/run.t
+++ b/test/blackbox-tests/test-cases/sandboxing/run.t
@@ -22,26 +22,23 @@ Some day, we should use the mtimes check from jenga to detect it.
   $ echo '(rule (target b) (deps (sandbox always)) (action (bash "echo a > a; echo a > b")))' >> dune
   $ echo '(rule (target c) (deps a b) (action (bash "cat a b > c")))' >> dune
   $ dune build c
-  Internal error, please report upstream including the contents of _build/log.
-  Description:
-  ("This rule forbids all sandboxing modes (but it also requires sandboxing)",
-  {})
-  Backtrace:
-  Raised at file "src/stdune/code_error.ml", line 9, characters 2-29
-  Called from file "src/build_system.ml", line 1459, characters 6-118
-  Called from file "src/fiber/fiber.ml", line 112, characters 7-12
-  Re-raised at file "src/stdune/exn.ml", line 39, characters 38-65
-  Called from file "src/fiber/fiber.ml", line 82, characters 8-15
-  Re-raised at file "src/stdune/exn.ml", line 39, characters 38-65
-  Called from file "src/fiber/fiber.ml", line 82, characters 8-15
-  Re-raised at file "src/stdune/exn.ml", line 39, characters 38-65
-  Called from file "src/fiber/fiber.ml", line 82, characters 8-15
-  
-  I must not segfault.  Uncertainty is the mind-killer.  Exceptions are
-  the little-death that brings total obliteration.  I will fully express
-  my cases.  Execution will pass over me and through me.  And when it
-  has gone past, I will unwind the stack along its path.  Where the
-  cases are handled there will be nothing.  Only I will remain.
+  $ cat _build/default/c
+  a
+  a
+
+Errors
+
+  $ rm -rf _build
+  $ true > dune
+  $ echo '(rule (target a) (deps (sandbox always none)) (action (bash "echo a > a")))' >> dune
+  $ dune build a
+  File "dune", line 1, characters 23-44:
+  1 | (rule (target a) (deps (sandbox always none)) (action (bash "echo a > a")))
+                             ^^^^^^^^^^^^^^^^^^^^^
+  Error: Inconsistent sandboxing configuration. Sandboxing mode none is both
+  allowed and disallowed
+  Hint: dune files require fewer parentheses than jbuild files.
+  If you just converted this file from a jbuild file, try removing these parentheses.
   [1]
   $ cat _build/default/c
   cat: _build/default/c: No such file or directory

From dd0f137bdc007e1a0ded1b4f9131149733ab7803 Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Mon, 22 Jul 2019 16:24:15 +0100
Subject: [PATCH 14/43] fix test

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 .../test-cases/sandboxing/run.t               | 31 +++++++++----------
 1 file changed, 14 insertions(+), 17 deletions(-)

diff --git a/test/blackbox-tests/test-cases/sandboxing/run.t b/test/blackbox-tests/test-cases/sandboxing/run.t
index 3413367db4e..fc25bdc8b17 100644
--- a/test/blackbox-tests/test-cases/sandboxing/run.t
+++ b/test/blackbox-tests/test-cases/sandboxing/run.t
@@ -1,32 +1,34 @@
-Reproduction case for #1560: by default, `dune` files inside the .git
-directory should be ignored
+If an action does not respect the dependency specification, it results in a broken
+build. Dune fails to detect that:
 
   $ echo '(lang dune 1.11)' > dune-project
   $ true > dune
-  $ echo '(rule (target a) (deps) (action (bash "echo a > a; echo a > b")))' >> dune
-  $ echo '(rule (target b) (deps) (action (bash "echo a > a; echo a > b")))' >> dune
+  $ echo '(rule (target a) (deps) (action (bash "echo a | tee a > b")))' >> dune
+  $ echo '(rule (target b) (deps) (action (bash "echo b | tee a > b")))' >> dune
   $ echo '(rule (target c) (deps a b) (action (bash "cat a b > c")))' >> dune
   $ dune build c
   $ cat _build/default/c
-  a
-  a
+  b
+  b
 
-If an action does not respect the dependency specification, it results in a broken
-build. Dune fails to detect that.
+(the correct result is "a" followed by "b")
 
 Some day, we should use the mtimes check from jenga to detect it.
 
+These rules clearly depend on sandboxing. Specifying that makes the build
+well-behaved:
+
   $ rm -rf _build
   $ true > dune
-  $ echo '(rule (target a) (deps (sandbox always)) (action (bash "echo a > a; echo a > b")))' >> dune
-  $ echo '(rule (target b) (deps (sandbox always)) (action (bash "echo a > a; echo a > b")))' >> dune
+  $ echo '(rule (target a) (deps (sandbox always)) (action (bash "echo a | tee a > b")))' >> dune
+  $ echo '(rule (target b) (deps (sandbox always)) (action (bash "echo b | tee a > b")))' >> dune
   $ echo '(rule (target c) (deps a b) (action (bash "cat a b > c")))' >> dune
   $ dune build c
   $ cat _build/default/c
   a
-  a
+  b
 
-Errors
+Some errors:
 
   $ rm -rf _build
   $ true > dune
@@ -40,8 +42,3 @@ Errors
   Hint: dune files require fewer parentheses than jbuild files.
   If you just converted this file from a jbuild file, try removing these parentheses.
   [1]
-  $ cat _build/default/c
-  cat: _build/default/c: No such file or directory
-  [1]
-
-# CR aalekseyev: fix this!

From 3b5f8347627f39afd6ff7a78cb2ee101decfdcb5 Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Mon, 22 Jul 2019 16:30:31 +0100
Subject: [PATCH 15/43] add to the test

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 test/blackbox-tests/test-cases/sandboxing/run.t | 14 ++++++++++++--
 1 file changed, 12 insertions(+), 2 deletions(-)

diff --git a/test/blackbox-tests/test-cases/sandboxing/run.t b/test/blackbox-tests/test-cases/sandboxing/run.t
index fc25bdc8b17..b2aceef4ef5 100644
--- a/test/blackbox-tests/test-cases/sandboxing/run.t
+++ b/test/blackbox-tests/test-cases/sandboxing/run.t
@@ -11,9 +11,19 @@ build. Dune fails to detect that:
   b
   b
 
-(the correct result is "a" followed by "b")
+  $ true > dune
+  $ echo '(rule (target a) (deps) (action (bash "echo a > a")))' >> dune
+  $ echo '(rule (target b) (deps) (action (bash "echo b > b")))' >> dune
+  $ echo '(rule (target c) (deps a b) (action (bash "cat a b > c")))' >> dune
+  $ dune build c
+  $ cat _build/default/c
+  b
+  b
+
+(it's not obvious what the correct result is on the first invocation, but the second
+invocation is clearly broken (it uses a wrongly cached result))
 
-Some day, we should use the mtimes check from jenga to detect it.
+Some day, we should use the mtimes check from jenga to detect this.
 
 These rules clearly depend on sandboxing. Specifying that makes the build
 well-behaved:

From bcff36f8410dc4595d1d570c06c75c2f6d3c8323 Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Mon, 22 Jul 2019 16:44:19 +0100
Subject: [PATCH 16/43] test preserve_file_kind

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 .../test-cases/sandboxing/run.t               | 23 +++++++++++++++++++
 1 file changed, 23 insertions(+)

diff --git a/test/blackbox-tests/test-cases/sandboxing/run.t b/test/blackbox-tests/test-cases/sandboxing/run.t
index b2aceef4ef5..1b47aadcc32 100644
--- a/test/blackbox-tests/test-cases/sandboxing/run.t
+++ b/test/blackbox-tests/test-cases/sandboxing/run.t
@@ -52,3 +52,26 @@ Some errors:
   Hint: dune files require fewer parentheses than jbuild files.
   If you just converted this file from a jbuild file, try removing these parentheses.
   [1]
+
+When we don't pass [preserve_file_kind], the rules can observe the file kind changing based on sandbox mode chosen:
+
+  $ rm -rf _build
+  $ echo text-file > text-file
+  $ true > dune
+  $ echo '(rule (target t) (deps text-file) (action (bash "find text-file -printf '%y' > t")))' >> dune
+
+  $ dune build t --sandbox symlink
+  $ cat _build/default/t
+  l
+
+  $ dune build t --sandbox none
+  $ cat _build/default/t
+  f
+
+When we pass [preserve_file_kind], the file type seen by the rule is preserved:
+
+  $ true > dune
+  $ echo '(rule (target t) (deps text-file (sandbox preserve_file_kind)) (action (bash "find text-file -printf '%y' > t")))' >> dune
+  $ dune build t --sandbox symlink
+  $ cat _build/default/t
+  f

From 67d04946a382a6e1676fb4b60afb1fecddfb6bb9 Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Mon, 22 Jul 2019 16:50:03 +0100
Subject: [PATCH 17/43] it's not clear what the solution is

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 test/blackbox-tests/test-cases/sandboxing/run.t | 2 --
 1 file changed, 2 deletions(-)

diff --git a/test/blackbox-tests/test-cases/sandboxing/run.t b/test/blackbox-tests/test-cases/sandboxing/run.t
index 1b47aadcc32..bc798999b01 100644
--- a/test/blackbox-tests/test-cases/sandboxing/run.t
+++ b/test/blackbox-tests/test-cases/sandboxing/run.t
@@ -23,8 +23,6 @@ build. Dune fails to detect that:
 (it's not obvious what the correct result is on the first invocation, but the second
 invocation is clearly broken (it uses a wrongly cached result))
 
-Some day, we should use the mtimes check from jenga to detect this.
-
 These rules clearly depend on sandboxing. Specifying that makes the build
 well-behaved:
 

From 6b0cd6e5cbbebf6c783ee9e4e403b281c77b9cd9 Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Tue, 23 Jul 2019 13:50:49 +0100
Subject: [PATCH 18/43] fix alias stamp file dir sandboxing

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 src/alias.ml  | 11 +++++++----
 src/alias.mli |  1 +
 src/dep.ml    |  2 +-
 3 files changed, 9 insertions(+), 5 deletions(-)

diff --git a/src/alias.ml b/src/alias.ml
index 3daea0bdfb5..e19cd2dd391 100644
--- a/src/alias.ml
+++ b/src/alias.ml
@@ -61,15 +61,18 @@ let suffix = "-" ^ String.make 32 '0'
 let name t = t.name
 let dir  t = t.dir
 
-let fully_qualified_name t = Path.Build.relative t.dir t.name
-
 (* Where we store stamp files for aliases *)
 let alias_dir = Path.Build.(relative root ".aliases")
 
-let stamp_file t =
+let stamp_file_dir t =
   let local = Path.Build.local t.dir in
+  Path.Build.append_local alias_dir local
+
+let fully_qualified_name t = Path.Build.relative t.dir t.name
+
+let stamp_file t =
   Path.Build.relative
-    (Path.Build.append_local alias_dir local)
+    (stamp_file_dir t)
     (t.name ^ suffix)
 
 let find_dir_specified_on_command_line ~dir ~file_tree =
diff --git a/src/alias.mli b/src/alias.mli
index dec2f8776e4..0f4fbd8c0c0 100644
--- a/src/alias.mli
+++ b/src/alias.mli
@@ -18,6 +18,7 @@ val make : string -> dir:Path.Build.t -> t
 *)
 val name : t -> string
 val dir : t -> Path.Build.t
+val stamp_file_dir : t -> Path.Build.t
 
 val to_dyn : t -> Dyn.t
 
diff --git a/src/dep.ml b/src/dep.ml
index d4f8d409e10..de4fe67fa97 100644
--- a/src/dep.ml
+++ b/src/dep.ml
@@ -154,7 +154,7 @@ module Set = struct
   let dirs t =
     fold t ~init:Path.Set.empty ~f:(fun f acc ->
       match f with
-      | Alias a -> Path.Set.add acc (Path.build (Alias.dir a))
+      | Alias a -> Path.Set.add acc (Path.build (Alias.stamp_file_dir a))
       | Glob g -> Path.Set.add acc (File_selector.dir g)
       | File f -> Path.Set.add acc (Path.parent_exn f)
       | Universe

From 5e6ba9c5f3a1af2c491109cc49f23f01a7810005 Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Tue, 23 Jul 2019 15:34:46 +0100
Subject: [PATCH 19/43] sandbox aliases, fix some sandboxed actions

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 src/build_system.ml          | 1 -
 test/blackbox-tests/cram.mll | 2 +-
 test/expect-tests/dune       | 7 ++++++-
 test/unit-tests/dune         | 7 ++++++-
 4 files changed, 13 insertions(+), 4 deletions(-)

diff --git a/src/build_system.ml b/src/build_system.ml
index 04cc308c3d3..95c52b83936 100644
--- a/src/build_system.ml
+++ b/src/build_system.ml
@@ -827,7 +827,6 @@ end = struct
                       let rule =
                         Pre_rule.make ~locks ~context:(Some context) ~env
                           (* [no_sandboxing] here is necessary for some reason *)
-                          ~sandbox:Sandbox_config.no_sandboxing
                           ~info:(Rule.Info.of_loc_opt loc)
                           (Build.progn [ action; Build.create_file path ])
                       in
diff --git a/test/blackbox-tests/cram.mll b/test/blackbox-tests/cram.mll
index 8f22396af01..5ca4ef313ae 100644
--- a/test/blackbox-tests/cram.mll
+++ b/test/blackbox-tests/cram.mll
@@ -16,7 +16,7 @@ let eol = '\n' | eof
 
 let ext = '.' ['a'-'z' 'A'-'Z' '0'-'9']+
 
-let abs_path = '/' ['a'-'z' 'A'-'Z' '0'-'9' '-' '_' '/']+
+let abs_path = '/' ['a'-'z' 'A'-'Z' '0'-'9' '.' '-' '_' '/']+
 
 rule file = parse
  | eof { [] }
diff --git a/test/expect-tests/dune b/test/expect-tests/dune
index 14515c65adc..94c92cdded8 100644
--- a/test/expect-tests/dune
+++ b/test/expect-tests/dune
@@ -3,7 +3,12 @@
  (inline_tests
   (deps
    (source_tree ../unit-tests/findlib-db)
-   (source_tree ../unit-tests/toolchain.d)))
+   (source_tree ../unit-tests/toolchain.d)
+   ;; *.ml needed for expect tests
+   ;; CR-someday aalekseyev: maybe ppx_expect should somehow tell
+   ;; dune about this
+   (glob_files *.ml)
+   ))
  (libraries stdune dune wp_dune
             ;; This is because of the (implicit_transitive_deps false)
             ;; in dune-project
diff --git a/test/unit-tests/dune b/test/unit-tests/dune
index 4d4f818b3c3..8c7b4233d64 100644
--- a/test/unit-tests/dune
+++ b/test/unit-tests/dune
@@ -82,6 +82,7 @@
  (name runtest)
  (deps (:t sexp.mlt)
   (glob_files %{project_root}/src/.dune.objs/byte/*.cmi)
+  (glob_files %{project_root}/src/dune_lang/.dune_lang.objs/byte/*.cmi)
   (glob_files %{project_root}/src/stdune/.stdune.objs/byte/*.cmi))
  (action (chdir %{project_root}
           (progn
@@ -92,6 +93,7 @@
  (name runtest)
  (deps (:t dune_file.mlt)
   (glob_files %{project_root}/src/.dune.objs/byte/*.cmi)
+  (glob_files %{project_root}/src/dune_lang/.dune_lang.objs/byte/*.cmi)
   (glob_files %{project_root}/src/stdune/.stdune.objs/byte/*.cmi))
  (action (chdir %{project_root}
           (progn
@@ -122,9 +124,11 @@
  (name runtestmem)
  (deps (:t memoize.mlt)
   (glob_files %{project_root}/src/.dune.objs/byte/*.cmi)
+  (glob_files %{project_root}/src/dune_lang/.dune_lang.objs/byte/*.cmi)
   (glob_files %{project_root}/src/stdune/.stdune.objs/byte/*.cmi)
   (glob_files %{project_root}/src/memo/.memo.objs/byte/*.cmi)
-  (glob_files %{project_root}/src/fiber/.fiber.objs/byte/*.cmi))
+  (glob_files %{project_root}/src/fiber/.fiber.objs/byte/*.cmi)
+  )
  (action (chdir %{project_root}
           (progn
            (run %{exe:expect_test.exe} %{t})
@@ -164,6 +168,7 @@
 (alias
  (name runtest)
  (deps (:t vcs.mlt)
+  (glob_files %{project_root}/src/fiber/.fiber.objs/byte/*.cmi)
   (glob_files %{project_root}/src/.dune.objs/byte/*.cmi)
   (glob_files %{project_root}/src/memo/.memo.objs/byte/*.cmi)
   (glob_files %{project_root}/src/stdune/.stdune.objs/byte/*.cmi))

From cbf17ea37630cc8865de05d3801161c5adc0b064 Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Tue, 23 Jul 2019 16:16:00 +0100
Subject: [PATCH 20/43] introduce Sandbox_mode.Dict.t

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 src/sandbox_config.ml  | 117 +++++++++++------------------------------
 src/sandbox_config.mli |  12 ++---
 src/sandbox_mode.ml    |  65 +++++++++++++++++++++++
 src/sandbox_mode.mli   |  32 +++++++++++
 4 files changed, 132 insertions(+), 94 deletions(-)

diff --git a/src/sandbox_config.ml b/src/sandbox_config.ml
index 4d1d4ebad49..1fd51588bf5 100644
--- a/src/sandbox_config.ml
+++ b/src/sandbox_config.ml
@@ -1,50 +1,19 @@
 open! Stdune
 
-(* ['a t] represents a total map from [Sandbox_mode.t] to ['a] *)
-type 'a gen = {
-  none : 'a;
-  symlink : 'a;
-  copy : 'a;
-}
+include Sandbox_mode.Set
 
-type t = bool gen
+let no_special_requirements = of_func (fun _ -> true)
 
-let compare_gen compare x y =
-  let compare_k a b k =
-    match compare a b with
-    | Eq -> k ()
-    | Lt -> Lt
-    | Gt -> Gt
-  in
-  compare_k x.none y.none (fun () ->
-    compare_k x.symlink y.symlink (fun () ->
-      compare x.copy y.copy
-    )
-  )
-
-let compare = compare_gen Bool.compare
-
-let of_function (f : Sandbox_mode.t -> _) = {
-  none = f None;
-  symlink = f (Some Symlink);
-  copy = f (Some Copy);
-}
-
-let no_special_requirements = of_function (fun _ -> true)
+let no_sandboxing = of_func Option.is_none
 
-let no_sandboxing =
-  of_function Option.is_none
-
-let needs_sandboxing =
-  of_function Option.is_some
+let needs_sandboxing = of_func Option.is_some
 
 let default = no_special_requirements
 
 type conflict = Conflict
 
-
 module Partial = struct
-  type t = bool option gen
+  type t = bool option Sandbox_mode.Dict.t
 
   let get_unique eq l =
     match l with
@@ -59,71 +28,49 @@ module Partial = struct
   (** [merge] behaves like [inter] when there is no error, but it can
       detect a nonsensical configuration where [inter] can't. *)
   let merge ~loc items =
-    let merge_field field_name field =
+    let merge_field field =
       match
         get_unique Bool.equal
-          (List.filter_map items ~f:field)
+          (List.filter_map
+             items ~f:(fun item -> Sandbox_mode.Dict.get item field))
       with
       | Error Conflict ->
         User_error.raise ~loc [ Pp.text (
           sprintf "Inconsistent sandboxing configuration. Sandboxing mode \
-                   %s is both allowed and disallowed" field_name)
+                   %s is both allowed and disallowed"
+            (Sandbox_mode.to_string field))
         ]
       | Ok None ->
         (* allowed if not forbidden *)
         true
       | Ok (Some v) -> v
     in
-    let none = merge_field "none" (fun t -> t.none) in
-    let symlink = merge_field "symlink" (fun t -> t.symlink) in
-    let copy = merge_field "copy" (fun t -> t.copy) in
-    { none; symlink; copy }
-
-  let no_information = { none = None; symlink = None; copy = None }
+    Sandbox_mode.Set.of_func (fun mode ->
+      merge_field mode)
 
-  let no_special_requirements = {
-    none = Some true;
-    symlink = Some true;
-    copy = Some true;
-  }
+  let no_special_requirements =
+    Sandbox_mode.Dict.of_func (fun _ -> Some true)
 
-  let no_sandboxing = {
-    none = Some true;
-    symlink = Some false;
-    copy = Some false;
-  }
+  let no_sandboxing =
+    Sandbox_mode.Dict.of_func (function
+      | None -> Some true
+      | Some _ -> Some false
+    )
 
-  let needs_sandboxing = { no_information with none = Some false; }
+  let needs_sandboxing =
+    Sandbox_mode.Dict.of_func (function
+      | None -> Some false
+      | _ -> None)
 
   let disallow (mode : Sandbox_mode.t) =
-    match mode with
-    | None ->
-      { no_information with none = Some false }
-    | Some Symlink ->
-      { no_information with symlink = Some false }
-    | Some Copy ->
-      { no_information with copy = Some false }
+    Sandbox_mode.Dict.of_func (fun mode' ->
+      if Sandbox_mode.equal mode mode'
+      then
+        Some false
+      else
+        None)
 end
 
-let disallow (t : Sandbox_mode.t) = match t with
-  | None ->
-    { no_special_requirements with none = false }
-  | Some Copy ->
-    { no_special_requirements with copy = false }
-  | Some Symlink ->
-    { no_special_requirements with symlink = false }
-
-let inter x y = {
-  none = x.none && y.none;
-  copy = x.copy && y.copy;
-  symlink = x.symlink && y.symlink;
-}
-
-let mem t (mode : Sandbox_mode.t) = match mode with
-  | None -> t.none
-  | Some Copy -> t.copy
-  | Some Symlink -> t.symlink
-
-let equal x y = match compare x y with
-  | Eq -> true
-  | Lt | Gt -> false
+let disallow (mode : Sandbox_mode.t) =
+  Sandbox_mode.Dict.of_func (fun mode' ->
+    not (Sandbox_mode.equal mode mode'))
diff --git a/src/sandbox_config.mli b/src/sandbox_config.mli
index 320c5fc1ad4..611011c3996 100644
--- a/src/sandbox_config.mli
+++ b/src/sandbox_config.mli
@@ -1,14 +1,8 @@
 open! Stdune
 
-type 'a gen = {
-  none : 'a;
-  symlink : 'a;
-  copy : 'a;
-}
-
 (** A set of sandbox modes in which the rule is expected
     to work correctly. *)
-type t = bool gen
+type t = Sandbox_mode.Set.t
 
 val compare : t -> t -> Ordering.t
 
@@ -37,14 +31,14 @@ val disallow : Sandbox_mode.t -> t
 val mem : t -> Sandbox_mode.t -> bool
 
 module Partial : sig
-  type t = bool option gen
+  type t = bool option Sandbox_mode.Dict.t
 
   (** [merge] distributes across [inter] when there is no error, but it can
       detect a nonsensical configuration where [inter] can't.
 
       Can raise a User_error.
   *)
-  val merge : loc:Loc.t -> t list -> bool gen
+  val merge : loc:Loc.t -> t list -> Sandbox_mode.Set.t
 
   val no_special_requirements : t
 
diff --git a/src/sandbox_mode.ml b/src/sandbox_mode.ml
index 763c5008876..5e63d789e4f 100644
--- a/src/sandbox_mode.ml
+++ b/src/sandbox_mode.ml
@@ -4,8 +4,73 @@ type some =
   | Symlink
   | Copy
 
+let compare_some a b = match (a, b) with
+  | Symlink, Symlink -> Eq
+  | Symlink, _ -> Lt
+  | _, Symlink -> Gt
+  | Copy, Copy -> Eq
+
 type t = some option
 
+let compare = Option.compare compare_some
+
+let equal a b = match compare a b with
+  | Eq -> true
+  | Lt | Gt -> false
+
+module Dict = struct
+  type key = t
+  type 'a t = {
+    none : 'a;
+    symlink : 'a;
+    copy : 'a;
+  }
+
+  let compare compare x y =
+    let compare_k a b k =
+      match compare a b with
+      | Eq -> k ()
+      | Lt -> Lt
+      | Gt -> Gt
+    in
+    compare_k x.none y.none (fun () ->
+      compare_k x.symlink y.symlink (fun () ->
+        compare x.copy y.copy
+      )
+    )
+
+  let of_func (f : key -> _) = {
+    none = f None;
+    symlink = f (Some Symlink);
+    copy = f (Some Copy);
+  }
+
+  let get { none; symlink; copy } (key : key) = match key with
+    | None -> none
+    | Some Copy -> copy
+    | Some Symlink -> symlink
+
+end
+
+module Set = struct
+  type key = t
+  type t = bool Dict.t
+
+  let compare = Dict.compare Bool.compare
+  let equal a b = match compare a b with
+    | Eq -> true
+    | Lt | Gt -> false
+
+  let of_func = Dict.of_func
+  let mem = Dict.get
+
+  let inter (x : t) (y : t) : t = {
+    none = x.none && y.none;
+    copy = x.copy && y.copy;
+    symlink = x.symlink && y.symlink;
+  }
+end
+
 (* these should be listed in the default order of preference *)
 let all = [None; Some Symlink; Some Copy]
 
diff --git a/src/sandbox_mode.mli b/src/sandbox_mode.mli
index eb4bc6146b6..f5b37f6d6cd 100644
--- a/src/sandbox_mode.mli
+++ b/src/sandbox_mode.mli
@@ -6,6 +6,38 @@ type some =
 
 type t = some option
 
+val compare : t -> t -> Ordering.t
+val equal : t -> t -> bool
+
+module Dict : sig
+  type key = t
+
+  type 'a t = {
+    none : 'a;
+    symlink : 'a;
+    copy : 'a;
+  }
+
+  val compare : ('a -> 'a -> Ordering.t) -> 'a t -> 'a t -> Ordering.t
+
+  val of_func : (key -> 'a) -> 'a t
+  val get : 'a t -> (key -> 'a)
+end
+
+module Set : sig
+  type key = t
+  type t = bool Dict.t
+
+  val equal : t -> t -> bool
+  val compare : t -> t -> Ordering.t
+
+  val of_func : (key -> bool) -> t
+  val mem : t -> (key -> bool)
+
+  val inter : t -> t -> t
+end
+
+
 val all : t list
 
 val none : t

From 76a885899839a7eee2b288ce281dae3d08440aa8 Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Tue, 23 Jul 2019 16:24:32 +0100
Subject: [PATCH 21/43] improve error message, and make code easier to follow

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 src/build_system.ml | 28 +++++++++++++++-------------
 1 file changed, 15 insertions(+), 13 deletions(-)

diff --git a/src/build_system.ml b/src/build_system.ml
index 95c52b83936..1578592f8ca 100644
--- a/src/build_system.ml
+++ b/src/build_system.ml
@@ -1374,19 +1374,21 @@ end = struct
         (config : Sandbox_config.t) ~loc ~sandboxing_preference =
     match
       List.find_map sandboxing_preference ~f:(fun preference ->
-        match (preference, config) with
-        | None, { none = true; _ } ->
-          Some None
-        | Some Sandbox_mode.Copy, { copy = true; _ } ->
-          Some (Some Sandbox_mode.Copy)
-        | Some Symlink, { symlink = true; copy; _ } ->
-          (if copy then
-             Some (Some (if Sys.win32 then Copy else Symlink))
-           else
-             Code_error.raise
-               "This rule requires sandboxing with symlinks, but that won't \
-                work on Windows." [])
-        | _, _ -> None) with
+        match Sandbox_mode.Set.mem config preference with
+        | false -> None
+        | true ->
+          match preference with
+          | Some Symlink ->
+            if Sandbox_mode.Set.mem config Sandbox_mode.copy then
+              Some
+                (if Sys.win32 then Sandbox_mode.copy else Sandbox_mode.symlink)
+            else
+              User_error.raise ~loc
+                [ Pp.text "This rule requires sandboxing with symlinks, but \
+                           that won't work on Windows." ]
+          | _ ->
+            Some preference
+      ) with
     | None ->
       (* This is not trivial to reach because the user rules are checked
          at parse time and [sandboxing_preference] always includes all possible

From 206b6dfeeb49fdc418c79cb3679a8402fe105c5c Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Tue, 23 Jul 2019 16:26:35 +0100
Subject: [PATCH 22/43] remove no_sandboxing that will become unnecessary soon

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 src/module_compilation.ml | 2 --
 1 file changed, 2 deletions(-)

diff --git a/src/module_compilation.ml b/src/module_compilation.ml
index 4e9fc424a0a..a5b2a40426f 100644
--- a/src/module_compilation.ml
+++ b/src/module_compilation.ml
@@ -47,8 +47,6 @@ let build_cm cctx ~dep_graphs ~precompiled_cmi ~cm_kind (m : Module.t) =
         if Module.visibility m <> Visibility.Private
         && (Obj_dir.need_dedicated_public_dir obj_dir) then
           SC.add_rule sctx
-            (* CR-someday aalekseyev: why do we have [no_sandboxing] here? *)
-            ~sandbox:Sandbox_config.no_sandboxing
             ~dir
             (Build.symlink
                ~src:(Path.build (Obj_dir.Module.cm_file_unsafe obj_dir m ~kind:Cmi))

From 77bf41eee0fa2aeee40bf159ce377130b7e6dcd3 Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Tue, 23 Jul 2019 16:30:28 +0100
Subject: [PATCH 23/43] too late for 1.11

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 src/dune_file.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/dune_file.ml b/src/dune_file.ml
index 8ebf97cfb5a..2f3e5322a92 100644
--- a/src/dune_file.ml
+++ b/src/dune_file.ml
@@ -250,7 +250,7 @@ module Dep_conf = struct
     | Sandbox_config s -> Sandbox_config s
 
   let decode_sandbox_config =
-    let+ () = Syntax.since Stanza.syntax (1, 11)
+    let+ () = Syntax.since Stanza.syntax (1, 12)
     and+ (loc, x) =
       located (list (sum [
         "none", return Sandbox_config.Partial.no_sandboxing;

From 85b4035abddb284c3b635f757f5f5672ba470e77 Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Tue, 23 Jul 2019 16:52:03 +0100
Subject: [PATCH 24/43] do not sandbox actions that have nothing to sandbox

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 src/action.ml                                 | 38 +++++++++++++++++++
 src/action.mli                                |  6 +++
 src/build_system.ml                           | 11 ++++--
 src/stanza.ml                                 |  2 +-
 .../test-cases/sandboxing/run.t               |  2 +-
 5 files changed, 53 insertions(+), 6 deletions(-)

diff --git a/src/action.ml b/src/action.ml
index 41e2ebbb481..42a74812981 100644
--- a/src/action.ml
+++ b/src/action.ml
@@ -219,3 +219,41 @@ let sandbox t ~sandboxed ~mode ~deps ~targets ~eval_pred : t =
     ; Progn (List.filter_map targets ~f:(fun path ->
         Some (Rename (sandboxed path, path))))
     ]
+
+type is_useful_to_sandbox =
+  | Clearly_not
+  | Maybe
+
+let is_useful_to_sandbox =
+  let rec loop t =
+    match t with
+    | Chdir (_, t) ->
+      loop t
+    | Setenv (_, _, t) ->
+      loop t
+    | Redirect (_, _, t) ->
+      loop t
+    | Ignore (_, t) ->
+      loop t
+    | Progn l -> List.exists l ~f:loop
+    | Echo _ -> false
+    | Cat _ -> false
+    | Copy _ -> false
+    | Symlink _ -> false
+    | Copy_and_add_line_directive _ -> false
+    | Write_file _ -> false
+    | Rename _ -> false
+    | Remove_tree _ -> false
+    | Diff _ -> false
+    | Mkdir _ -> false
+    | Digest_files _ -> false
+    | Merge_files_into _ -> false
+    | Run _ -> true
+    | System _ -> true
+    | Bash _ -> true
+  in
+  fun t -> match loop t with
+    | true ->
+      Maybe
+    | false ->
+      Clearly_not
diff --git a/src/action.mli b/src/action.mli
index 71c4c9974ab..aae0adca21b 100644
--- a/src/action.mli
+++ b/src/action.mli
@@ -89,3 +89,9 @@ val sandbox
   -> targets:Path.Build.t list
   -> eval_pred:Dep.eval_pred
   -> t
+
+type is_useful_to_sandbox =
+  | Clearly_not
+  | Maybe
+
+val is_useful_to_sandbox : t -> is_useful_to_sandbox
diff --git a/src/build_system.ml b/src/build_system.ml
index 1578592f8ca..01a0353e79f 100644
--- a/src/build_system.ml
+++ b/src/build_system.ml
@@ -1463,10 +1463,13 @@ end = struct
     let head_target = List.hd targets_as_list in
     let prev_trace = Trace.get (Path.build head_target) in
     let sandbox_mode =
-      select_sandbox_mode
-        ~loc:(rule_loc ~file_tree:t.file_tree ~info ~dir)
-        (Dep.Set.sandbox_config deps)
-        ~sandboxing_preference:t.sandboxing_preference
+      match Action.is_useful_to_sandbox action with
+      | Clearly_not -> Sandbox_mode.none
+      | Maybe ->
+        select_sandbox_mode
+          ~loc:(rule_loc ~file_tree:t.file_tree ~info ~dir)
+          (Dep.Set.sandbox_config deps)
+          ~sandboxing_preference:t.sandboxing_preference
     in
     let rule_digest =
       let env =
diff --git a/src/stanza.ml b/src/stanza.ml
index 7900343de1d..5887bfca8ed 100644
--- a/src/stanza.ml
+++ b/src/stanza.ml
@@ -6,7 +6,7 @@ module Parser = struct
   type nonrec t = string * t list Dune_lang.Decoder.t
 end
 
-let latest_version = (1, 11)
+let latest_version = (1, 12)
 
 let syntax =
   Syntax.create ~name:"dune" ~desc:"the dune language"
diff --git a/test/blackbox-tests/test-cases/sandboxing/run.t b/test/blackbox-tests/test-cases/sandboxing/run.t
index bc798999b01..3cf1d7b191b 100644
--- a/test/blackbox-tests/test-cases/sandboxing/run.t
+++ b/test/blackbox-tests/test-cases/sandboxing/run.t
@@ -1,7 +1,7 @@
 If an action does not respect the dependency specification, it results in a broken
 build. Dune fails to detect that:
 
-  $ echo '(lang dune 1.11)' > dune-project
+  $ echo '(lang dune 1.12)' > dune-project
   $ true > dune
   $ echo '(rule (target a) (deps) (action (bash "echo a | tee a > b")))' >> dune
   $ echo '(rule (target b) (deps) (action (bash "echo b | tee a > b")))' >> dune

From db7959a4d81ee03f4d24fd1934dbf7aa2100f0da Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Tue, 23 Jul 2019 18:19:34 +0100
Subject: [PATCH 25/43] swap changelog entries

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 CHANGES.md | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/CHANGES.md b/CHANGES.md
index fd3b0599183..1b5d4aa87ce 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -15,14 +15,14 @@
   is done to prevent the accidental collision with library dependencies of the
   executable. (#2364, fixes #2292, @rgrinberg)
 
+- Enable `(explicit_js_mode)` by default. (#1941, @nojb)
+
 - Add a new config option `sandboxing_preference`, the cli argument `--sandbox`,
   and the dep spec `sandbox` in dune language. These let the user control the level of
   sandboxing done by dune per rule and globally. The rule specification takes precedence.
   The global configuration merely specifies the default. 
   (#2213, @aalekseyev)
 
-- Enable `(explicit_js_mode)` by default. (#1941, @nojb)
-
 1.11.0 (unreleased)
 -------------------
 

From b0204460d852046611bb0fef97a3014e5aaffcc1 Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Wed, 24 Jul 2019 14:07:06 +0100
Subject: [PATCH 26/43] fix tests

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 dune-project                     |  2 +-
 test/blackbox-tests/dune.inc     |  2 +-
 test/blackbox-tests/gen_tests.ml | 26 +++++++++++++++++++-------
 test/expect-tests/catapult/dune  |  2 +-
 test/expect-tests/dag/dune       |  2 +-
 test/expect-tests/dune           |  2 +-
 test/expect-tests/dune_lang/dune |  2 +-
 test/expect-tests/fiber/dune     |  2 +-
 test/expect-tests/memo/dune      |  2 +-
 test/expect-tests/stdune/dune    |  4 +++-
 10 files changed, 30 insertions(+), 16 deletions(-)

diff --git a/dune-project b/dune-project
index 12417bafbff..1407b828651 100644
--- a/dune-project
+++ b/dune-project
@@ -1,4 +1,4 @@
-(lang dune 1.11)
+(lang dune 1.12)
 (name dune)
 
 (implicit_transitive_deps false)
diff --git a/test/blackbox-tests/dune.inc b/test/blackbox-tests/dune.inc
index bc48bfb9df9..1aa8253da87 100644
--- a/test/blackbox-tests/dune.inc
+++ b/test/blackbox-tests/dune.inc
@@ -379,7 +379,7 @@
 
 (alias
  (name env-bins)
- (deps (package dune) (source_tree test-cases/env-bins))
+ (deps (package dune) (source_tree test-cases/env-bins) (sandbox none))
  (action
   (chdir
    test-cases/env-bins
diff --git a/test/blackbox-tests/gen_tests.ml b/test/blackbox-tests/gen_tests.ml
index ced5bd8e9de..0a4166bf229 100644
--- a/test/blackbox-tests/gen_tests.ml
+++ b/test/blackbox-tests/gen_tests.ml
@@ -63,10 +63,12 @@ module Test = struct
     ; js             : bool
     ; coq            : bool
     ; external_deps  : bool
+    ; disable_sandboxing : bool
     }
 
-  let make ?env ?skip_ocaml ?(skip_platforms=[]) ?(enabled=true) ?(js=false) ?(coq=false)
-        ?(external_deps=false) name =
+  let make
+        ?env ?skip_ocaml ?(skip_platforms=[]) ?(enabled=true) ?(js=false) ?(coq=false)
+        ?(external_deps=false) ?(disable_sandboxing=false) name =
     { name
     ; env
     ; skip_ocaml
@@ -75,6 +77,7 @@ module Test = struct
     ; enabled
     ; js
     ; coq
+    ; disable_sandboxing
     }
 
   let pp_sexp fmt t =
@@ -98,7 +101,6 @@ module Test = struct
                       (skip_version @ ["-test"; "run.t"])))
             ; Sexp.strings ["diff?"; "run.t"; "run.t.corrected"]
             ]
-
         ]
     in
     let action =
@@ -112,10 +114,17 @@ module Test = struct
     alias t.name
       ?enabled_if
       ~deps:(
-        [ Sexp.strings ["package"; "dune"]
-        ; Sexp.strings [ "source_tree"
-                       ; sprintf "test-cases/%s" t.name]
-        ]
+        (List.concat  [
+           [ Sexp.strings ["package"; "dune"]
+           ; Sexp.strings [ "source_tree"
+                          ; sprintf "test-cases/%s" t.name]
+           ];
+           (if t.disable_sandboxing then [
+              Sexp.strings ["sandbox"; "none"]
+            ]
+            else
+              []);
+         ])
       ) ~action
     |> Dune_lang.pp Dune
     |> Pp.render_ignore_tags fmt
@@ -166,6 +175,9 @@ let exclusions =
   ; make "env-cflags" ~skip_ocaml:"<4.06.0"
   ; make "wrapped-transition" ~skip_ocaml:"<4.06.0"
   ; make "explicit_js_mode" ~external_deps:true ~js:true
+  (* for the following tests sandboxing is disabled because absolute paths end up
+     appearing in the output if we sandbox *)
+  ; make "env-bins" ~disable_sandboxing:true
   ]
 
 let all_tests = lazy (
diff --git a/test/expect-tests/catapult/dune b/test/expect-tests/catapult/dune
index 7455b0898e3..ba0f0ab60f5 100644
--- a/test/expect-tests/catapult/dune
+++ b/test/expect-tests/catapult/dune
@@ -1,6 +1,6 @@
 (library
  (name dune_catapult_tests)
- (inline_tests)
+ (inline_tests (deps (glob_files *.ml)))
  (libraries dune_tests_common stdune catapult
             ;; This is because of the (implicit_transitive_deps false)
             ;; in dune-project
diff --git a/test/expect-tests/dag/dune b/test/expect-tests/dag/dune
index a3db0c26a50..5cafdd3e4b1 100644
--- a/test/expect-tests/dag/dune
+++ b/test/expect-tests/dag/dune
@@ -1,6 +1,6 @@
 (library
  (name dune_dag_unit_tests)
- (inline_tests)
+ (inline_tests (deps (glob_files *.ml)))
  (libraries dune_tests_common stdune dag
             ;; This is because of the (implicit_transitive_deps false)
             ;; in dune-project
diff --git a/test/expect-tests/dune b/test/expect-tests/dune
index 8319a2a859b..84b08fc666d 100644
--- a/test/expect-tests/dune
+++ b/test/expect-tests/dune
@@ -7,7 +7,7 @@
     ;; *.ml needed for expect tests
     ;; CR-someday aalekseyev: maybe ppx_expect should somehow tell
     ;; dune about this
-    (glob_files *.ml)   
+    (glob_files *.ml)
    ))
  (libraries dune_tests_common stdune dune wp_dune fiber dune_lang memo
             ;; This is because of the (implicit_transitive_deps false)
diff --git a/test/expect-tests/dune_lang/dune b/test/expect-tests/dune_lang/dune
index cdb1f99331f..15a6aaf9bcd 100644
--- a/test/expect-tests/dune_lang/dune
+++ b/test/expect-tests/dune_lang/dune
@@ -1,6 +1,6 @@
 (library
  (name dune_lang_unit_tests)
- (inline_tests)
+ (inline_tests (deps (glob_files *.ml)))
  (libraries dune_tests_common stdune dune_lang
             ;; This is because of the (implicit_transitive_deps false)
             ;; in dune-project
diff --git a/test/expect-tests/fiber/dune b/test/expect-tests/fiber/dune
index d85714b3795..c6cf59678c7 100644
--- a/test/expect-tests/fiber/dune
+++ b/test/expect-tests/fiber/dune
@@ -1,6 +1,6 @@
 (library
  (name dune_fiber_tests)
- (inline_tests)
+ (inline_tests (deps (glob_files *.ml)))
  (libraries dune_tests_common stdune fiber dune wp_dune
             ;; This is because of the (implicit_transitive_deps false)
             ;; in dune-project
diff --git a/test/expect-tests/memo/dune b/test/expect-tests/memo/dune
index b28a8685eee..2695a237ab7 100644
--- a/test/expect-tests/memo/dune
+++ b/test/expect-tests/memo/dune
@@ -1,6 +1,6 @@
 (library
  (name dune_memo_unit_tests)
- (inline_tests)
+ (inline_tests (deps (glob_files *.ml)))
  (libraries dune_tests_common stdune dune_lang fiber memo
             ;; This is because of the (implicit_transitive_deps false)
             ;; in dune-project
diff --git a/test/expect-tests/stdune/dune b/test/expect-tests/stdune/dune
index c7fa1b58e9c..b9684b2bc83 100644
--- a/test/expect-tests/stdune/dune
+++ b/test/expect-tests/stdune/dune
@@ -3,7 +3,9 @@
  (inline_tests
   (deps
    (source_tree ../unit-tests/findlib-db)
-   (source_tree ../unit-tests/toolchain.d)))
+   (source_tree ../unit-tests/toolchain.d)
+   (glob_files *.ml)
+   ))
  (libraries stdune dune_tests_common
             ;; This is because of the (implicit_transitive_deps false)
             ;; in dune-project

From 2f3a821e88c1ae0d1a646134ecf69e0fef98ee01 Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Wed, 24 Jul 2019 16:50:25 +0100
Subject: [PATCH 27/43] remove stale comment, remove seemingly unnecessary
 no_sandboxing annotations

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 src/build_system.ml | 1 -
 src/lib_rules.ml    | 6 ++----
 2 files changed, 2 insertions(+), 5 deletions(-)

diff --git a/src/build_system.ml b/src/build_system.ml
index 01a0353e79f..a0b9c8e772c 100644
--- a/src/build_system.ml
+++ b/src/build_system.ml
@@ -826,7 +826,6 @@ end = struct
                       in
                       let rule =
                         Pre_rule.make ~locks ~context:(Some context) ~env
-                          (* [no_sandboxing] here is necessary for some reason *)
                           ~info:(Rule.Info.of_loc_opt loc)
                           (Build.progn [ action; Build.create_file path ])
                       in
diff --git a/src/lib_rules.ml b/src/lib_rules.ml
index 89c3bff88f3..59dcd2e77de 100644
--- a/src/lib_rules.ml
+++ b/src/lib_rules.ml
@@ -192,13 +192,11 @@ let build_self_stubs lib ~sctx ~expander ~dir ~o_files =
        single invocation to build both the static and dynamic
        libraries *)
     ocamlmklib
-      (* CR-someday aalekseyev: why [no_sandboxing]? *)
-      ~sandbox:Sandbox_config.no_sandboxing
+      ~sandbox:Sandbox_config.no_special_requirements
       ~custom:false ~targets:[static; dynamic]
   end else begin
     ocamlmklib
-      (* CR-someday aalekseyev: why [no_sandboxing]? *)
-      ~sandbox:Sandbox_config.no_sandboxing
+      ~sandbox:Sandbox_config.no_special_requirements
       ~custom:true ~targets:[static];
     (* We can't tell ocamlmklib to build only the dll, so we
        sandbox the action to avoid overriding the static archive *)

From daab63a981c21bc701b8e9b37184de80b13a8922 Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Wed, 24 Jul 2019 18:11:47 +0100
Subject: [PATCH 28/43] make promotion work with sandboxing

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 src/action_exec.ml  | 10 ++++++----
 src/print_diff.ml   |  4 ++--
 src/stdune/path.ml  | 28 ++++++++++++++++++++++++++++
 src/stdune/path.mli |  3 +++
 4 files changed, 39 insertions(+), 6 deletions(-)

diff --git a/src/action_exec.ml b/src/action_exec.ml
index a05442e11be..1f365f415d5 100644
--- a/src/action_exec.ml
+++ b/src/action_exec.ml
@@ -142,15 +142,17 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to =
       Fiber.return ()
     else begin
       let is_copied_from_source_tree file =
-        match Path.drop_build_context file with
+        match Path.extract_build_context_dir_maybe_sandboxed file with
         | None -> false
-        | Some file -> Path.exists (Path.source file)
+        | Some (_, file) -> Path.exists (Path.source file)
       in
       if is_copied_from_source_tree file1 &&
          not (is_copied_from_source_tree file2) then begin
         Promotion.File.register
-          { src = Path.as_in_build_dir_exn file2
-          ; dst = Option.value_exn (Path.drop_build_context file1)
+          { src = snd (Path.Build.split_sandbox_root (
+              Path.as_in_build_dir_exn file2))
+          ; dst = snd (Option.value_exn (
+              Path.extract_build_context_dir_maybe_sandboxed file1))
           }
       end;
       if mode = Binary then
diff --git a/src/print_diff.ml b/src/print_diff.ml
index c6cd8367631..14b40670057 100644
--- a/src/print_diff.ml
+++ b/src/print_diff.ml
@@ -6,8 +6,8 @@ open Fiber.O
 let print ?(skip_trailing_cr=Sys.win32) path1 path2 =
   let dir, file1, file2 =
     match
-      Path.extract_build_context_dir path1,
-      Path.extract_build_context_dir path2
+      Path.extract_build_context_dir_maybe_sandboxed path1,
+      Path.extract_build_context_dir_maybe_sandboxed path2
     with
     | Some (dir1, f1), Some (dir2, f2) when Path.equal dir1 dir2 ->
       (dir1, Path.source f1, Path.source f2)
diff --git a/src/stdune/path.ml b/src/stdune/path.ml
index b14e8f10688..95daf1f0865 100644
--- a/src/stdune/path.ml
+++ b/src/stdune/path.ml
@@ -652,6 +652,27 @@ module Build = struct
         )
     end
 
+  let split_sandbox_root t_original =
+    match split_first_component t_original with
+    | Some (".sandbox", t) ->
+      (match split_first_component t with
+       | Some (sandbox_name, t) ->
+         Some (of_string (".sandbox" ^ "/" ^ sandbox_name)), t
+       | None -> None, t_original
+      )
+    | Some _ | None -> None, t_original
+
+  let extract_build_context_dir_maybe_sandboxed t =
+    let sandbox_root, t = split_sandbox_root t in
+    Option.map (extract_build_context_dir t)
+      ~f:(fun (ctx_dir, src_dir) ->
+        let ctx_dir =
+          match sandbox_root with
+          | None -> ctx_dir
+          | Some root -> append root ctx_dir
+        in
+        (ctx_dir, src_dir))
+
   let extract_build_context_dir_exn t =
     match extract_build_context_dir t with
     | Some t -> t
@@ -995,6 +1016,13 @@ let extract_build_context_dir = function
     Option.map (Build.extract_build_context_dir t)
       ~f:(fun (base, rest) -> in_build_dir base, rest)
 
+let extract_build_context_dir_maybe_sandboxed = function
+  | In_source_tree _
+  | External _ -> None
+  | In_build_dir t ->
+    Option.map (Build.extract_build_context_dir_maybe_sandboxed t)
+      ~f:(fun (base, rest) -> in_build_dir base, rest)
+
 let extract_build_context_dir_exn t =
   match extract_build_context_dir t with
   | Some t -> t
diff --git a/src/stdune/path.mli b/src/stdune/path.mli
index eb1eb97c9f0..159fbab05b6 100644
--- a/src/stdune/path.mli
+++ b/src/stdune/path.mli
@@ -154,6 +154,8 @@ module Build : sig
   (** set the build directory. Can only be called once and must be done before
       paths are converted to strings elsewhere. *)
   val set_build_dir : Kind.t -> unit
+
+  val split_sandbox_root : t -> t option * t
 end
 
 type t = private
@@ -217,6 +219,7 @@ val extract_build_dir_first_component     : t -> (string * Local.t) option
     ]}
 *)
 val extract_build_context_dir     : t -> (t * Source.t) option
+val extract_build_context_dir_maybe_sandboxed : t -> (t * Source.t) option
 val extract_build_context_dir_exn : t -> (t * Source.t)
 
 (** Drop the "_build/blah" prefix *)

From 7ff667c2b6c5e5320d2f39e43b56c5762e4009f6 Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Wed, 24 Jul 2019 18:20:21 +0100
Subject: [PATCH 29/43] odoc seems fine now

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 src/odoc.ml | 9 ++-------
 1 file changed, 2 insertions(+), 7 deletions(-)

diff --git a/src/odoc.ml b/src/odoc.ml
index c62b278828b..aa60f733a36 100644
--- a/src/odoc.ml
+++ b/src/odoc.ml
@@ -165,10 +165,7 @@ let module_deps (m : Module.t) ~obj_dir
 let compile_module sctx ~obj_dir (m : Module.t) ~includes:(file_deps, iflags)
       ~dep_graphs ~pkg_or_lnu =
   let odoc_file = Obj_dir.Module.odoc obj_dir m in
-  (* sandboxing breaks with errors like:
-     Error: exception Sys_error("_build/.sandbox/c6c6d243cda677ac18f785bc647e343c/build/.aliases/default/_doc/_odoc/pkg/foo/.odoc-all-00000000000000000000000000000000: No such file or directory"
-  *)
-  add_rule ~sandbox:Sandbox_config.no_sandboxing sctx
+  add_rule sctx
     (file_deps
      >>>
      module_deps m ~obj_dir ~dep_graphs
@@ -224,9 +221,7 @@ let setup_html sctx (odoc_file : odoc) ~pkg ~requires =
         Build.create_file (odoc_file.html_dir ++ Config.dune_keep_fname) in
       odoc_file.html_dir, [dune_keep]
   in
-  (* Sandboxing fails with errors like:
-     Error: exception Sys_error("_build/.sandbox/f04b07b43dff46d0376c51d684c93380/build/.aliases/default/_doc/_odoc/pkg/foo/.odoc-all-00000000000000000000000000000000: No such file or directory") *)
-  add_rule ~sandbox:Sandbox_config.no_sandboxing sctx
+  add_rule sctx
     (deps
      >>>
      Build.progn (

From 1568d00716ccea9497f73186649f14bd9bdf6c94 Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Wed, 24 Jul 2019 18:24:14 +0100
Subject: [PATCH 30/43] make copy_and_add_line_directive work well with
 sandboxing

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 src/action_exec.ml  | 2 +-
 src/simple_rules.ml | 6 +-----
 src/stdune/path.ml  | 5 +++++
 src/stdune/path.mli | 1 +
 4 files changed, 8 insertions(+), 6 deletions(-)

diff --git a/src/action_exec.ml b/src/action_exec.ml
index 1f365f415d5..150375c2058 100644
--- a/src/action_exec.ml
+++ b/src/action_exec.ml
@@ -94,7 +94,7 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to =
     Io.with_file_in src ~f:(fun ic ->
       Path.build dst
       |> Io.with_file_out ~f:(fun oc ->
-        let fn = Path.drop_optional_build_context src in
+        let fn = Path.drop_optional_build_context_maybe_sandboxed src in
         output_string oc
           (Utils.line_directive
              ~filename:(Path.to_string fn)
diff --git a/src/simple_rules.ml b/src/simple_rules.ml
index 5a1ef125b4b..e61d2e8294d 100644
--- a/src/simple_rules.ml
+++ b/src/simple_rules.ml
@@ -118,11 +118,7 @@ let copy_files sctx ~dir ~expander ~src_dir (def: Copy_files.t) =
   Path.Set.map files ~f:(fun file_src ->
     let basename = Path.basename file_src in
     let file_dst = Path.Build.relative dir basename in
-    (* with sandboxing, some expect test fails with:
-       -  #line 1 "include/bar.h"
-       +  #line 1 "1a0210e62c0acf83a7b2119b6ab36462/build/default/include/bar.h"
-    *)
-    SC.add_rule ~sandbox:Sandbox_config.no_sandboxing sctx ~loc ~dir
+    SC.add_rule sctx ~loc ~dir
       ((if def.add_line_directive
         then Build.copy_and_add_line_directive
         else Build.copy)
diff --git a/src/stdune/path.ml b/src/stdune/path.ml
index 95daf1f0865..4d53a506a3f 100644
--- a/src/stdune/path.ml
+++ b/src/stdune/path.ml
@@ -1042,6 +1042,11 @@ let drop_optional_build_context t =
   | None -> t
   | Some (_, t) -> in_source_tree t
 
+let drop_optional_build_context_maybe_sandboxed t =
+  match extract_build_context_dir_maybe_sandboxed t with
+  | None -> t
+  | Some (_, t) -> in_source_tree t
+
 let drop_optional_build_context_src_exn t =
   match t with
   | External _ ->
diff --git a/src/stdune/path.mli b/src/stdune/path.mli
index 159fbab05b6..a4f728dbad4 100644
--- a/src/stdune/path.mli
+++ b/src/stdune/path.mli
@@ -228,6 +228,7 @@ val drop_build_context_exn : t -> Source.t
 
 (** Drop the "_build/blah" prefix if present, return [t] otherwise *)
 val drop_optional_build_context : t -> t
+val drop_optional_build_context_maybe_sandboxed : t -> t
 
 (** Drop the "_build/blah" prefix if present, return [t] if it's a source file,
     otherwise fail. *)

From 3675518b54ae723504915b09435d8fa784136024 Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Wed, 24 Jul 2019 18:38:20 +0100
Subject: [PATCH 31/43] add doc

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 doc/dune-files.rst | 10 +++++++---
 1 file changed, 7 insertions(+), 3 deletions(-)

diff --git a/doc/dune-files.rst b/doc/dune-files.rst
index cee27469a2f..69571f6fbbe 100644
--- a/doc/dune-files.rst
+++ b/doc/dune-files.rst
@@ -1413,8 +1413,7 @@ introduced in 4.08, allowing the user to define custom let operators.
 Dependency specification
 ------------------------
 
-Dependencies in ``dune`` files can be specified using one of the following
-syntax:
+Dependencies in ``dune`` files can be specified using one of the following:
 
 - ``(:name <dependencies>)`` will bind the the list of dependencies to the
   ``name`` variable. This variable will be available as ``%{name}`` in actions.
@@ -1429,7 +1428,6 @@ syntax:
   :ref:`glob <glob>` for details
 
 .. _source_tree:
-
 - ``(source_tree <dir>)``: depend on all source files in the subtree with root
   ``<dir>``
 
@@ -1445,6 +1443,12 @@ syntax:
 - ``(env_var <var>)``: depend on the value of the environment variable ``<var>``.
   If this variable becomes set, becomes unset, or changes value, the target
   will be rebuilt.
+- ``(sandbox <config>)``: require a particular sandboxing configuration.
+  Config can be one (or many) of:
+  - ``always``: the action requires a clean environment.
+  - ``none``: the action must run in the build directory.
+  - ``preserve_file_kind``: the action needs the files it reads to look
+    like normal files (so dune won't use symlinks for sandboxing)
 
 In all these cases, the argument supports `Variables expansion`_.
 

From 16ea040371b419ba6d4e40c6defea53d1fb0a7a5 Mon Sep 17 00:00:00 2001
From: Jeremie Dimino <jeremie@dimino.org>
Date: Thu, 25 Jul 2019 11:04:10 +0100
Subject: [PATCH 32/43] doc

Signed-off-by: Jeremie Dimino <jeremie@dimino.org>
---
 src/sandbox_config.mli | 10 ++++++++++
 src/sandbox_mode.mli   | 10 ++++++++++
 2 files changed, 20 insertions(+)

diff --git a/src/sandbox_config.mli b/src/sandbox_config.mli
index 611011c3996..f0a2802206e 100644
--- a/src/sandbox_config.mli
+++ b/src/sandbox_config.mli
@@ -1,3 +1,13 @@
+(** Sandboxing configuration of build rules *)
+
+(** This module manages the sandboxing configuration written by the
+    user in dune files or inside the build arrow.
+
+    The sandboxing configuration of a build rule represent what the
+    rule expects in terms of sandboxing. For instance, a rule might not
+    work correctly when it is not sandboxed, or the opposite.
+*)
+
 open! Stdune
 
 (** A set of sandbox modes in which the rule is expected
diff --git a/src/sandbox_mode.mli b/src/sandbox_mode.mli
index f5b37f6d6cd..79018e0801f 100644
--- a/src/sandbox_mode.mli
+++ b/src/sandbox_mode.mli
@@ -1,3 +1,13 @@
+(** How to sandbox actions *)
+
+(** This module describes the method used to sandbox actions. Choices
+   include:
+
+    - not sandboxing
+    - sandboxing by symlinking dependencies
+    - sandboxing by copying dependencies
+ *)
+
 open! Stdune
 
 type some =

From 1d1da0cea565d15fb9ab70eaa9f10db1e87e266c Mon Sep 17 00:00:00 2001
From: Jeremie Dimino <jeremie@dimino.org>
Date: Thu, 25 Jul 2019 11:17:25 +0100
Subject: [PATCH 33/43] Add missing .ml dependencies for expect tests

Signed-off-by: Jeremie Dimino <jeremie@dimino.org>
---
 src/inline_tests.ml              | 52 +++++++++++++++++---------------
 test/expect-tests/catapult/dune  |  2 +-
 test/expect-tests/dag/dune       |  2 +-
 test/expect-tests/dune           |  7 +----
 test/expect-tests/dune_lang/dune |  2 +-
 test/expect-tests/fiber/dune     |  2 +-
 test/expect-tests/memo/dune      |  2 +-
 test/expect-tests/stdune/dune    |  4 +--
 8 files changed, 34 insertions(+), 39 deletions(-)

diff --git a/src/inline_tests.ml b/src/inline_tests.ml
index 6bcc993ecab..8d7185c26b2 100644
--- a/src/inline_tests.ml
+++ b/src/inline_tests.ml
@@ -322,11 +322,15 @@ include Sub_system.Register_end_point(
             backend.Backend.info.flags) @ [info.flags]
         in
         let expander = Expander.add_bindings expander ~bindings in
-        List.map flags ~f:(
-          Expander.expand_and_eval_set expander ~standard:(Build.return []))
-        |> Build.all
-        >>^ List.concat
+        let open Build.S.O in
+        let+ l =
+          List.map flags ~f:(
+            Expander.expand_and_eval_set expander ~standard:(Build.return []))
+          |> Build.all
+        in
+        Command.Args.As (List.concat l)
       in
+      let source_files = List.concat_map source_modules ~f:Module.sources in
       Mode_conf.Set.iter info.modes ~f:(fun (mode : Mode_conf.t) ->
         let ext = match mode with
           | Native | Best -> ".exe"
@@ -341,30 +345,28 @@ include Sub_system.Register_end_point(
           ~loc:(Some info.loc)
           (Alias.runtest ~dir)
           ~stamp:("ppx-runner", name)
-          (let module A = Action in
-           let exe =
-             Path.Build.relative inline_test_dir (name ^ ext)
-             |> Path.build
+          (let exe =
+             Path.build (Path.Build.relative inline_test_dir (name ^ ext))
            in
-           Build.path exe >>>
-           Build.fanout
-             (Super_context.Deps.interpret sctx info.deps ~expander)
-             flags
-           >>^ fun (_deps, flags) ->
-           let exe, runner_args = match custom_runner with
-             | None -> Ok exe, []
+           let exe, runner_args =
+             match custom_runner with
+             | None -> Ok exe, Command.Args.As []
              | Some runner ->
-               Super_context.resolve_program ~dir sctx ~loc:(Some loc) runner
-             , [ Path.reach ~from:(Path.build dir) exe ]
+               (Super_context.resolve_program ~dir sctx ~loc:(Some loc) runner,
+                Dep exe)
            in
-           A.chdir (Path.build dir)
-             (A.progn
-                (A.run exe (runner_args @ flags) ::
-                 (List.concat_map source_modules ~f:(fun m ->
-                    Module.sources m
-                    |> List.map ~f:(fun fn ->
-                      A.diff ~optional:true
-                        fn (Path.extend_basename fn ~suffix:".corrected"))))))))
+           Super_context.Deps.interpret sctx info.deps ~expander
+           >>^ ignore
+           >>>
+           Build.progn
+             (Command.run exe ~dir:(Path.build dir)
+                [ runner_args
+                ; Dyn flags
+                ]
+              :: List.map source_files ~f:(fun fn ->
+                Build.return
+                  (Action.diff ~optional:true
+                     fn (Path.extend_basename fn ~suffix:".corrected"))))))
   end)
 
 let linkme = ()
diff --git a/test/expect-tests/catapult/dune b/test/expect-tests/catapult/dune
index ba0f0ab60f5..7455b0898e3 100644
--- a/test/expect-tests/catapult/dune
+++ b/test/expect-tests/catapult/dune
@@ -1,6 +1,6 @@
 (library
  (name dune_catapult_tests)
- (inline_tests (deps (glob_files *.ml)))
+ (inline_tests)
  (libraries dune_tests_common stdune catapult
             ;; This is because of the (implicit_transitive_deps false)
             ;; in dune-project
diff --git a/test/expect-tests/dag/dune b/test/expect-tests/dag/dune
index 5cafdd3e4b1..a3db0c26a50 100644
--- a/test/expect-tests/dag/dune
+++ b/test/expect-tests/dag/dune
@@ -1,6 +1,6 @@
 (library
  (name dune_dag_unit_tests)
- (inline_tests (deps (glob_files *.ml)))
+ (inline_tests)
  (libraries dune_tests_common stdune dag
             ;; This is because of the (implicit_transitive_deps false)
             ;; in dune-project
diff --git a/test/expect-tests/dune b/test/expect-tests/dune
index 84b08fc666d..308f331ae87 100644
--- a/test/expect-tests/dune
+++ b/test/expect-tests/dune
@@ -3,12 +3,7 @@
  (inline_tests
   (deps
    (source_tree ../unit-tests/findlib-db)
-   (source_tree ../unit-tests/toolchain.d)
-    ;; *.ml needed for expect tests
-    ;; CR-someday aalekseyev: maybe ppx_expect should somehow tell
-    ;; dune about this
-    (glob_files *.ml)
-   ))
+   (source_tree ../unit-tests/toolchain.d)))
  (libraries dune_tests_common stdune dune wp_dune fiber dune_lang memo
             ;; This is because of the (implicit_transitive_deps false)
             ;; in dune-project
diff --git a/test/expect-tests/dune_lang/dune b/test/expect-tests/dune_lang/dune
index 15a6aaf9bcd..cdb1f99331f 100644
--- a/test/expect-tests/dune_lang/dune
+++ b/test/expect-tests/dune_lang/dune
@@ -1,6 +1,6 @@
 (library
  (name dune_lang_unit_tests)
- (inline_tests (deps (glob_files *.ml)))
+ (inline_tests)
  (libraries dune_tests_common stdune dune_lang
             ;; This is because of the (implicit_transitive_deps false)
             ;; in dune-project
diff --git a/test/expect-tests/fiber/dune b/test/expect-tests/fiber/dune
index c6cf59678c7..d85714b3795 100644
--- a/test/expect-tests/fiber/dune
+++ b/test/expect-tests/fiber/dune
@@ -1,6 +1,6 @@
 (library
  (name dune_fiber_tests)
- (inline_tests (deps (glob_files *.ml)))
+ (inline_tests)
  (libraries dune_tests_common stdune fiber dune wp_dune
             ;; This is because of the (implicit_transitive_deps false)
             ;; in dune-project
diff --git a/test/expect-tests/memo/dune b/test/expect-tests/memo/dune
index 2695a237ab7..b28a8685eee 100644
--- a/test/expect-tests/memo/dune
+++ b/test/expect-tests/memo/dune
@@ -1,6 +1,6 @@
 (library
  (name dune_memo_unit_tests)
- (inline_tests (deps (glob_files *.ml)))
+ (inline_tests)
  (libraries dune_tests_common stdune dune_lang fiber memo
             ;; This is because of the (implicit_transitive_deps false)
             ;; in dune-project
diff --git a/test/expect-tests/stdune/dune b/test/expect-tests/stdune/dune
index b9684b2bc83..c7fa1b58e9c 100644
--- a/test/expect-tests/stdune/dune
+++ b/test/expect-tests/stdune/dune
@@ -3,9 +3,7 @@
  (inline_tests
   (deps
    (source_tree ../unit-tests/findlib-db)
-   (source_tree ../unit-tests/toolchain.d)
-   (glob_files *.ml)
-   ))
+   (source_tree ../unit-tests/toolchain.d)))
  (libraries stdune dune_tests_common
             ;; This is because of the (implicit_transitive_deps false)
             ;; in dune-project

From 20077866343e71a25d2dd993e2631ec9aba4d176 Mon Sep 17 00:00:00 2001
From: Jeremie Dimino <jeremie@dimino.org>
Date: Thu, 25 Jul 2019 11:24:07 +0100
Subject: [PATCH 34/43] Fix dependencies of inline tests

Signed-off-by: Jeremie Dimino <jeremie@dimino.org>
---
 src/inline_tests.ml | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/src/inline_tests.ml b/src/inline_tests.ml
index 8d7185c26b2..8fe8e1d1b81 100644
--- a/src/inline_tests.ml
+++ b/src/inline_tests.ml
@@ -355,7 +355,9 @@ include Sub_system.Register_end_point(
                (Super_context.resolve_program ~dir sctx ~loc:(Some loc) runner,
                 Dep exe)
            in
-           Super_context.Deps.interpret sctx info.deps ~expander
+           Build.fanout
+             (Super_context.Deps.interpret sctx info.deps ~expander)
+             (Build.paths source_files)
            >>^ ignore
            >>>
            Build.progn

From 8375ed263f1aa0b6f9ae914d352cec9529fe1de7 Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Thu, 25 Jul 2019 12:16:10 +0100
Subject: [PATCH 35/43] better error if targets are missing when you move them
 from sandbox

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 src/action.ml                                 |  4 +--
 src/action.mli                                |  5 ++--
 src/build_system.ml                           | 26 ++++++++++++++++---
 src/preprocessing.ml                          |  8 ++----
 .../test-cases/sandboxing/run.t               | 12 +++++++++
 5 files changed, 40 insertions(+), 15 deletions(-)

diff --git a/src/action.ml b/src/action.ml
index 42a74812981..6b8373f4672 100644
--- a/src/action.ml
+++ b/src/action.ml
@@ -205,7 +205,7 @@ let maybe_sandbox_path f p =
   | None -> p
   | Some p -> Path.build (f p)
 
-let sandbox t ~sandboxed ~mode ~deps ~targets ~eval_pred : t =
+let sandbox t ~sandboxed ~mode ~deps ~eval_pred : t =
   let link = link_function ~mode in
   Progn
     [ prepare_managed_paths ~sandboxed ~link deps ~eval_pred
@@ -216,8 +216,6 @@ let sandbox t ~sandboxed ~mode ~deps ~targets ~eval_pred : t =
         ~f_target:(fun ~dir:_ -> sandboxed)
         ~f_program:(fun ~dir:_ ->
           Result.map ~f:(maybe_sandbox_path sandboxed))
-    ; Progn (List.filter_map targets ~f:(fun path ->
-        Some (Rename (sandboxed path, path))))
     ]
 
 type is_useful_to_sandbox =
diff --git a/src/action.mli b/src/action.mli
index aae0adca21b..4b0bb5c4993 100644
--- a/src/action.mli
+++ b/src/action.mli
@@ -80,13 +80,14 @@ module Unresolved : sig
   val resolve : t -> f:(Loc.t option -> string -> Path.t) -> action
 end with type action := t
 
-(** Return a sandboxed version of an action *)
+(** Return a sandboxed version of an action.
+    It takes care of preparing deps in the sandbox, but it does not copy the
+    targets back out. It's the responsibility of the caller to do that. *)
 val sandbox
   :  t
   -> sandboxed:(Path.Build.t -> Path.Build.t)
   -> mode:Sandbox_mode.some
   -> deps:Dep.Set.t
-  -> targets:Path.Build.t list
   -> eval_pred:Dep.eval_pred
   -> t
 
diff --git a/src/build_system.ml b/src/build_system.ml
index a0b9c8e772c..4620f610187 100644
--- a/src/build_system.ml
+++ b/src/build_system.ml
@@ -1438,6 +1438,16 @@ end = struct
   let start_rule t _rule =
     t.hook Rule_started
 
+  let rename_optional_file ~src ~dst =
+    let src = (Path.Build.to_string src) in
+    let dst = (Path.Build.to_string dst) in
+    match Unix.rename src dst with
+    | () -> ()
+    | exception Unix.Unix_error ((ENOENT | ENOTDIR), _, _) ->
+      (match Unix.unlink dst with
+       | exception Unix.Unix_error (ENOENT, _, _) -> ()
+       | () -> ())
+
   let execute_rule_impl rule =
     let t = t () in
     let { Internal_rule.
@@ -1517,10 +1527,10 @@ end = struct
           Path.unlink_no_err (Path.build p));
         pending_targets := Path.Build.Set.union targets !pending_targets;
         let loc = Rule.Info.loc info in
-        let action =
+        let sandboxed, action =
           match sandbox with
           | None ->
-            action
+            None, action
           | Some (sandbox_dir, sandbox_mode) ->
             Path.rm_rf (Path.build sandbox_dir);
             let sandboxed path : Path.Build.t =
@@ -1533,18 +1543,26 @@ end = struct
                | None -> Fs.assert_exists ~loc p
                | Some p -> Fs.mkdir_p (sandboxed p));
             Fs.mkdir_p (sandboxed dir);
+            Some sandboxed,
             Action.sandbox action
               ~sandboxed
               ~mode:sandbox_mode
               ~deps
-              ~targets:targets_as_list
               ~eval_pred
         in
         let chdirs = Action.chdirs action in
         Path.Set.iter chdirs ~f:Fs.(mkdir_p_or_check_exists ~loc);
         let+ () =
           with_locks locks ~f:(fun () ->
-            Action_exec.exec ~context ~env ~targets action)
+            Fiber.map (Action_exec.exec ~context ~env ~targets action)
+              ~f:(fun () ->
+                match sandboxed with
+                | None -> ()
+                | Some sandboxed ->
+                  List.iter targets_as_list ~f:(fun target ->
+                    rename_optional_file ~src:(sandboxed target) ~dst:target)
+              )
+          )
         in
         Option.iter sandbox ~f:(fun (p, _mode) -> Path.rm_rf (Path.build p));
         (* All went well, these targets are no longer pending *)
diff --git a/src/preprocessing.ml b/src/preprocessing.ml
index feac840ec2c..312b05b3e38 100644
--- a/src/preprocessing.ml
+++ b/src/preprocessing.ml
@@ -805,12 +805,8 @@ let make sctx ~dir ~expander ~dep_kind ~lint ~preprocess
            let ast = setup_dialect_rules sctx ~dir ~dep_kind ~expander m in
            if lint then lint_module ~ast ~source:m;
            pped_module ast ~f:(fun ml_kind src dst ->
-             (* Sandboxing breaks with an error like this:
-                Error: rename: _build/.sandbox/d9599ccb22f1fc9fc448f0d987648907/build/default/driveruser.pp.ml: No such file or directory
-
-                instead of the expected "rule failed to generate targets"
-             *)
-             SC.add_rule ~sandbox:Sandbox_config.no_sandboxing sctx ~loc ~dir
+             SC.add_rule
+               ~sandbox:Sandbox_config.no_special_requirements sctx ~loc ~dir
                (promote_correction ~suffix:corrected_suffix
                   (Option.value_exn (Module.file m ~ml_kind))
                   (preprocessor_deps >>^ ignore
diff --git a/test/blackbox-tests/test-cases/sandboxing/run.t b/test/blackbox-tests/test-cases/sandboxing/run.t
index 3cf1d7b191b..2c8a73b5b6b 100644
--- a/test/blackbox-tests/test-cases/sandboxing/run.t
+++ b/test/blackbox-tests/test-cases/sandboxing/run.t
@@ -73,3 +73,15 @@ When we pass [preserve_file_kind], the file type seen by the rule is preserved:
   $ dune build t --sandbox symlink
   $ cat _build/default/t
   f
+
+If rule fails to generate targets, we give a good error message, even with sandboxing:
+
+  $ true > dune
+  $ echo '(rule (target t) (deps (sandbox always)) (action (bash ":")))' >> dune
+  $ dune build t
+  File "dune", line 1, characters 0-61:
+  1 | (rule (target t) (deps (sandbox always)) (action (bash ":")))
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+  Error: Rule failed to generate the following targets:
+  - t
+  [1]

From 0c4a65eee1a64d62fe434a0def1f6424d24cd48f Mon Sep 17 00:00:00 2001
From: Jeremie Dimino <jeremie@dimino.org>
Date: Thu, 25 Jul 2019 13:15:32 +0100
Subject: [PATCH 36/43] Fix deps of ppx.exe

Signed-off-by: Jeremie Dimino <jeremie@dimino.org>
---
 src/preprocessing.ml | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/src/preprocessing.ml b/src/preprocessing.ml
index feac840ec2c..6f90450a731 100644
--- a/src/preprocessing.ml
+++ b/src/preprocessing.ml
@@ -422,12 +422,7 @@ let build_ppx_driver sctx ~dep_kind ~target ~dir_kind ~pps ~pp_names =
      >>>
      Build.write_file_dyn ml);
   add_rule
-    (* Sandboxing breaks with an error like this:
-
-       File ".ppx/foo.ppx_rewriter_dune/ppx.ml", line 1, characters 9-35:
-       Error: Unbound module Foo_ppx_rewriter_dune
-       [1] *)
-    ~sandbox:Sandbox_config.no_sandboxing
+    ~sandbox:Sandbox_config.no_special_requirements
     (Build.S.seqs
        [Build.record_lib_deps
           (Lib_deps.info ~kind:dep_kind (Lib_deps.of_pps pp_names));
@@ -438,7 +433,12 @@ let build_ppx_driver sctx ~dep_kind ~target ~dir_kind ~pps ~pp_names =
           ; A "-w"; A "-24"
           ; Command.of_result
               (Result.map driver_and_libs ~f:(fun (_driver, libs) ->
-                 Lib.L.compile_and_link_flags ~mode ~compile:libs ~link:libs))
+                 Command.Args.S
+                   [ Lib.L.compile_and_link_flags ~mode ~compile:libs ~link:libs
+                   ; Hidden_deps
+                       (Lib_file_deps.deps libs
+                          ~groups:[Cmi; Cmx])
+                   ]))
           ; Dep (Path.build ml)
           ]))
 

From b280639771a9adfb6fff5785a64548b3dacf4e5d Mon Sep 17 00:00:00 2001
From: Jeremie Dimino <jeremie@dimino.org>
Date: Thu, 25 Jul 2019 13:31:36 +0100
Subject: [PATCH 37/43] doc

Signed-off-by: Jeremie Dimino <jeremie@dimino.org>
---
 src/build_system.ml | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/src/build_system.ml b/src/build_system.ml
index 4620f610187..ab6634075c5 100644
--- a/src/build_system.ml
+++ b/src/build_system.ml
@@ -1438,6 +1438,8 @@ end = struct
   let start_rule t _rule =
     t.hook Rule_started
 
+  (* Same as [rename] except that if the source doesn't exist we
+     delete the destination *)
   let rename_optional_file ~src ~dst =
     let src = (Path.Build.to_string src) in
     let dst = (Path.Build.to_string dst) in

From 32d280bbb3e07987ad9133887d548d75c2ad541e Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Thu, 25 Jul 2019 13:41:08 +0100
Subject: [PATCH 38/43] move archive_files handling to
 [Lib.Lib_and_module.link_flags]

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 src/exe.ml | 29 +++++++++++++----------------
 src/lib.ml |  6 +++++-
 2 files changed, 18 insertions(+), 17 deletions(-)

diff --git a/src/exe.ml b/src/exe.ml
index ffea1b3d094..e3a8ab4135b 100644
--- a/src/exe.ml
+++ b/src/exe.ml
@@ -140,7 +140,6 @@ let link_exe
   let sctx     = CC.super_context cctx in
   let ctx      = SC.context       sctx in
   let dir      = CC.dir           cctx in
-  let requires = CC.requires_link cctx in
   let mode = linkage.mode in
   let exe = exe_path_from_name cctx ~name ~linkage in
   let compiler = Option.value_exn (Context.compiler ctx mode) in
@@ -171,21 +170,19 @@ let link_exe
      in
      prefix
      >>>
-     Build.S.seq (Build.of_result_map requires ~f:(fun libs ->
-       Build.paths (Lib.L.archive_files libs ~mode)))
-       (Command.run ~dir:(Path.build ctx.build_dir)
-          (Ok compiler)
-          [ Command.Args.dyn ocaml_flags
-          ; A "-o"; Target exe
-          ; As linkage.flags
-          ; Command.Args.dyn link_flags
-          ; Command.of_result_map link_time_code_gen
-              ~f:(fun { Link_time_code_gen.to_link; force_linkall } ->
-                S [ As (if force_linkall then ["-linkall"] else [])
-                  ; Lib.Lib_and_module.L.link_flags to_link ~mode
-                  ])
-          ; Dyn (Build.S.map top_sorted_cms ~f:(fun x -> Command.Args.Deps x))
-          ]))
+     (Command.run ~dir:(Path.build ctx.build_dir)
+        (Ok compiler)
+        [ Command.Args.dyn ocaml_flags
+        ; A "-o"; Target exe
+        ; As linkage.flags
+        ; Command.Args.dyn link_flags
+        ; Command.of_result_map link_time_code_gen
+            ~f:(fun { Link_time_code_gen.to_link; force_linkall } ->
+              S [ As (if force_linkall then ["-linkall"] else [])
+                ; Lib.Lib_and_module.L.link_flags to_link ~mode
+                ])
+        ; Dyn (Build.S.map top_sorted_cms ~f:(fun x -> Command.Args.Deps x))
+        ]))
 
 let link_js ~name ~cm_files ~promote cctx =
   let sctx     = CC.super_context cctx in
diff --git a/src/lib.ml b/src/lib.ml
index ad7c0622775..96ce5a4f362 100644
--- a/src/lib.ml
+++ b/src/lib.ml
@@ -504,7 +504,11 @@ module Lib_and_module = struct
          List.map ts ~f:(function
            | Lib t ->
              let archives = Lib_info.archives t.info in
-             Command.Args.Deps (Mode.Dict.get archives mode)
+             let archive_files = L.archive_files [t] ~mode in
+             Command.Args.S [
+               Command.Args.Deps (Mode.Dict.get archives mode);
+               Command.Args.Hidden_deps (Dep.Set.of_files archive_files);
+             ]
            | Module (obj_dir, m) ->
              Dep (Obj_dir.Module.cm_file_unsafe obj_dir m
                     ~kind:(Mode.cm_kind mode))

From 56df7fadb6f64e1b64cfed0cbb485db18f7e0179 Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Thu, 25 Jul 2019 14:03:37 +0100
Subject: [PATCH 39/43] fix another missing dependency

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 src/exe.ml      |  7 ++-----
 src/lib.ml      | 13 ++++++++++---
 src/lib.mli     |  3 ++-
 src/obj_dir.ml  |  3 +++
 src/obj_dir.mli |  1 +
 5 files changed, 18 insertions(+), 9 deletions(-)

diff --git a/src/exe.ml b/src/exe.ml
index e3a8ab4135b..eb650e36b26 100644
--- a/src/exe.ml
+++ b/src/exe.ml
@@ -145,10 +145,6 @@ let link_exe
   let compiler = Option.value_exn (Context.compiler ctx mode) in
   let top_sorted_cms = Cm_files.top_sorted_cms cm_files ~mode:linkage.mode in
   SC.add_rule sctx ~loc ~dir
-    (* Breaks with sandboxing with errors like:
-       gcc: error: .main_auto.eobjs/native/findlib_initl$ext_obj: No such file or directory
-    *)
-    ~sandbox:Sandbox_config.no_sandboxing
     ~mode:(match promote with
       | None -> Standard
       | Some p -> Promote p)
@@ -179,7 +175,8 @@ let link_exe
         ; Command.of_result_map link_time_code_gen
             ~f:(fun { Link_time_code_gen.to_link; force_linkall } ->
               S [ As (if force_linkall then ["-linkall"] else [])
-                ; Lib.Lib_and_module.L.link_flags to_link ~mode
+                ; Lib.Lib_and_module.L.link_flags
+                    to_link ~lib_config:ctx.lib_config ~mode
                 ])
         ; Dyn (Build.S.map top_sorted_cms ~f:(fun x -> Command.Args.Deps x))
         ]))
diff --git a/src/lib.ml b/src/lib.ml
index 96ce5a4f362..a770df65b43 100644
--- a/src/lib.ml
+++ b/src/lib.ml
@@ -495,7 +495,8 @@ module Lib_and_module = struct
   module L = struct
     type nonrec t = t list
 
-    let link_flags ts ~mode =
+    let link_flags ts ~(lib_config : Lib_config.t) ~mode =
+      ignore lib_config;
       let libs = List.filter_map ts ~f:(function
         | Lib lib -> Some lib
         | Module _ -> None) in
@@ -510,8 +511,14 @@ module Lib_and_module = struct
                Command.Args.Hidden_deps (Dep.Set.of_files archive_files);
              ]
            | Module (obj_dir, m) ->
-             Dep (Obj_dir.Module.cm_file_unsafe obj_dir m
-                    ~kind:(Mode.cm_kind mode))
+             Command.Args.S [
+               Dep (Obj_dir.Module.cm_file_unsafe obj_dir m
+                      ~kind:(Mode.cm_kind mode));
+               Command.Args.Hidden_deps (Dep.Set.of_files [
+                 Obj_dir.Module.o_file_unsafe
+                   obj_dir m ~ext_obj:lib_config.ext_obj
+               ]);
+             ]
          ))
 
     let of_libs l = List.map l ~f:(fun x -> Lib x)
diff --git a/src/lib.mli b/src/lib.mli
index 0fcebe39906..a55dc27ca66 100644
--- a/src/lib.mli
+++ b/src/lib.mli
@@ -92,7 +92,8 @@ module Lib_and_module : sig
   module L : sig
     type nonrec t = t list
     val of_libs : lib list -> t
-    val link_flags : t -> mode:Mode.t -> _ Command.Args.t
+    val link_flags :
+      t -> lib_config:Lib_config.t -> mode:Mode.t -> _ Command.Args.t
   end
 end with type lib := t
 
diff --git a/src/obj_dir.ml b/src/obj_dir.ml
index f0c1f2d914f..36acbb2f427 100644
--- a/src/obj_dir.ml
+++ b/src/obj_dir.ml
@@ -314,6 +314,9 @@ module Module = struct
     let ext = Cm_kind.ext kind in
     obj_file t m ~kind ~ext
 
+  let o_file_unsafe t m ~ext_obj =
+    obj_file t m ~kind:Cmx ~ext:ext_obj
+
   let cm_file t m ~(kind : Cm_kind.t) =
     let has_impl = Module.has m ~ml_kind:Impl in
     match kind with
diff --git a/src/obj_dir.mli b/src/obj_dir.mli
index 712bb352cb3..36c8afe9c11 100644
--- a/src/obj_dir.mli
+++ b/src/obj_dir.mli
@@ -100,6 +100,7 @@ module Module : sig
   (** Same as [cm_file] but doesn't raise if [cm_kind] is [Cmo] or [Cmx] and the
       module has no implementation.*)
   val cm_file_unsafe : 'path t -> Module.t -> kind:Cm_kind.t -> 'path
+  val o_file_unsafe : 'path t -> Module.t -> ext_obj:string -> 'path
   val cm_public_file_unsafe : 'path t -> Module.t -> kind:Cm_kind.t -> 'path
 
   (** Either the .cmti, or .cmt if the module has no interface *)

From ca1d6cfd36a001cdcdec89800c747516db50e527 Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Thu, 25 Jul 2019 14:15:34 +0100
Subject: [PATCH 40/43] add DUNE_SANDBOX env var

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 bin/common.ml | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/bin/common.ml b/bin/common.ml
index d200440f276..f1c3a3b4aef 100644
--- a/bin/common.ml
+++ b/bin/common.ml
@@ -339,6 +339,10 @@ let term =
     Arg.(value
          & opt (some arg) None
          & info ["sandbox"]
+             ~env:(
+               Arg.env_var
+                 ~doc:"Sandboxing mode to use by default. (see --sandbox)"
+                 "DUNE_SANDBOX")
              ~doc:(
                Printf.sprintf
                  "Sandboxing mode to use by default. Some actions require \

From 0a9fd35bb75ab1c0119e987f1a1702549f0297e6 Mon Sep 17 00:00:00 2001
From: Jeremie Dimino <jeremie@dimino.org>
Date: Thu, 25 Jul 2019 15:31:07 +0100
Subject: [PATCH 41/43] Remove unused ignore

Signed-off-by: Jeremie Dimino <jeremie@dimino.org>
---
 src/lib.ml | 1 -
 1 file changed, 1 deletion(-)

diff --git a/src/lib.ml b/src/lib.ml
index a770df65b43..ce708ecd7b4 100644
--- a/src/lib.ml
+++ b/src/lib.ml
@@ -496,7 +496,6 @@ module Lib_and_module = struct
     type nonrec t = t list
 
     let link_flags ts ~(lib_config : Lib_config.t) ~mode =
-      ignore lib_config;
       let libs = List.filter_map ts ~f:(function
         | Lib lib -> Some lib
         | Module _ -> None) in

From d8b25716cbe39383922799fd6e50388ed72727bd Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Thu, 25 Jul 2019 15:34:58 +0100
Subject: [PATCH 42/43] improve exception

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 src/action.ml | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/src/action.ml b/src/action.ml
index 6b8373f4672..cf43232a7b9 100644
--- a/src/action.ml
+++ b/src/action.ml
@@ -181,7 +181,11 @@ let prepare_managed_paths ~link ~sandboxed deps ~eval_pred =
         | None ->
           (* This can actually raise if we try to sandbox the "copy from
              source dir" rules. There is no reason to do that though. *)
-          assert (not (Path.is_in_source_tree path));
+          if (Path.is_in_source_tree path)
+          then
+            Code_error.raise
+              "Action depends on source tree. All actions should depend on the \
+               copies in build directory instead" ["path", Path.to_dyn path];
           acc
         | Some p -> link path (sandboxed p) :: acc)
   in

From 12ea213e9f093b81eab7dcf614a808d01b76e25a Mon Sep 17 00:00:00 2001
From: Arseniy Alekseyev <aalekseyev@janestreet.com>
Date: Mon, 29 Jul 2019 16:04:20 +0100
Subject: [PATCH 43/43] credit jdimino

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>
---
 CHANGES.md | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/CHANGES.md b/CHANGES.md
index aebf224ffd6..0bde6b6808a 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -60,7 +60,7 @@
   and the dep spec `sandbox` in dune language. These let the user control the level of
   sandboxing done by dune per rule and globally. The rule specification takes precedence.
   The global configuration merely specifies the default. 
-  (#2213, @aalekseyev)
+  (#2213, @aalekseyev, @jdimino)
 
 1.11.0 (23/07/2019)
 -------------------