bugfix: Both dkml/with-dkml need guards

+ Do not set --yes when creating playground
>> Gives user the chance
to look at the build directory
on failures

diskuv/dkml-installer-ocaml#82

src/dkml-exe/cmd_init.ml

@@ -116,6 +116,10 @@ let create_local_switch ~system_cfg ~scripts_dir_fp ~yes ~non_system_compiler
 
 let run f_setup localdir_fp_opt yes non_system_compiler system_only
     enable_imprecise_c99_float_ops disable_sandboxing =
+  let ( let* ) = Result.bind in
+  let* (_has_dkml_mutating_ancestor_process : bool) =
+    Dkml_runtimelib.Dkml_environment.mark_dkml_mutating_ancestor_process ()
+  in
   let enable_imprecise_c99_float_ops =
     if enable_imprecise_c99_float_ops then Some () else None
   in

src/dkml-exe/dkml_exe_lib.ml

@@ -22,7 +22,7 @@ let setup () =
   Rresult.R.error_to_msg ~pp_error:Fmt.string
     (Dkml_c_probe.C_abi.V2.get_abi_name ())
   >>= fun target_platform_name ->
-  Dkml_runtimelib.Dkml_environment.set_msys2_entries ~minimize_sideeffects:false
+  Dkml_runtimelib.Dkml_environment.set_msys2_entries ~has_dkml_mutating_ancestor_process:false
     target_platform_name
   >>= fun () ->
   (* Diagnostics *)

src/runtimelib/dkml_environment.ml

@@ -3,6 +3,30 @@ open Dkml_context
 open Bos
 open Astring
 
+let guard_envname = "DKML_GUARD"
+
+(** Marks this process as a DkML environment mutating process if there is no
+    such process as an ancestor. 
+
+    DkML environment mutations are:
+    - setting DkML compiler environment variables like INCLUDE and LIB for MSVC
+    - initializing the DkML system (OCaml compiler, opam root, etc.)
+
+    Returns true if and only if an ancestor (either ["dkml.exe"] or ["with-dkml.exe"])
+    had been marked as DkML environment mutating. *)
+let mark_dkml_mutating_ancestor_process () =
+  let guard_value = OS.Env.opt_var guard_envname ~absent:"0" in
+  let pid_str = Int.to_string (Unix.getpid ()) in
+  let has_ancestor =
+    (not (String.equal guard_value "0"))
+    && not (String.equal guard_value pid_str)
+  in
+  if has_ancestor then Ok true
+  else
+    let ( let* ) = Result.bind in
+    let* () = OS.Env.set_var guard_envname (Some pid_str) in
+    Ok false
+
 let platform_path_norm s =
   match Dkml_c_probe.C_abi.V2.get_os () with
   | Ok IOS | Ok OSX | Ok Windows -> String.Ascii.lowercase s
@@ -34,7 +58,7 @@ let prune_path_of_msys2 prefix =
 (** Set the MSYSTEM environment variable to MSYS and place MSYS2 binaries at the front of the PATH.
     Any existing MSYS2 binaries in the PATH will be removed.
   *)
-let set_msys2_entries ~minimize_sideeffects target_platform_name =
+let set_msys2_entries ~has_dkml_mutating_ancestor_process target_platform_name =
   Lazy.force get_msys2_dir_opt >>= function
   | None -> R.ok ()
   | Some msys2_dir ->
@@ -116,12 +140,12 @@ let set_msys2_entries ~minimize_sideeffects target_platform_name =
       OS.Env.set_var "MSYS2_ARG_CONV_EXCL" (Some "*") >>= fun () ->
       (* 3. Remove MSYS2 entries, if any, from PATH
             _unless_ we are minimizing side-effects *)
-      (if minimize_sideeffects then Ok ()
+      (if has_dkml_mutating_ancestor_process then Ok ()
        else prune_path_of_msys2 msystem_prefix)
       >>= fun () ->
       (* 4. Add MSYS2 <prefix>/bin and /usr/bin to front of PATH
             _unless_ we are minimizing side-effects. *)
-      if minimize_sideeffects then Ok ()
+      if has_dkml_mutating_ancestor_process then Ok ()
       else
         OS.Env.req_var "PATH" >>= fun path ->
         OS.Env.set_var "PATH"

src/runtimelib/init_system.ml

@@ -28,7 +28,6 @@ let create_playground_switch ~system_cfg ~ocaml_home_fp ~opamroot_dir_fp =
           Fpath.to_string create_switch_fp;
           "-p";
           system_cfg.target_abi;
-          "-y";
           "-w";
           "-n";
           "playground";

src/with-dkml/cmdline.ml

@@ -311,7 +311,7 @@ let init_nativecode_system_if_necessary () =
     3. ["../lib/ocaml/stublibs"] and ["../share/bc/lib/stublibs"] are added to
     the PATH on Windows (or LD_LIBRARY_PATH on Unix) if the directories exist.
 *)
-let create_and_setenv_if_necessary () =
+let create_and_setenv_if_necessary ~has_dkml_mutating_ancestor_process () =
   let ( let* ) = Rresult.R.( >>= ) in
   let ( let+ ) = Rresult.R.( >>| ) in
   let* env_exe_wrapper = Dkml_runtimelib.Dkml_environment.env_exe_wrapper () in
@@ -436,7 +436,12 @@ let create_and_setenv_if_necessary () =
               setup_nativecode_env ~abs_cmd_p
         in
         let* () =
-          if bytecode_exe then Ok () else init_nativecode_system_if_necessary ()
+          match (has_dkml_mutating_ancestor_process, bytecode_exe) with
+          | true, _ ->
+              (* never init system when perhaps we are already initting system *)
+              Ok ()
+          | false, true -> Ok ()
+          | false, false -> init_nativecode_system_if_necessary ()
         in
         Ok (env_exe_wrapper @ [ Fpath.to_string real_exe ] @ args)
     | _ ->

src/with-dkml/with_dkml.ml

@@ -519,45 +519,49 @@ let set_3p_program_entries cache_keys =
 
 let main_with_result () =
   let ( let* ) = R.( >>= ) in
+
+  (* ZEROTH, check and set a recursion guard so that only one set
+     of environment mutations is performed.
+
+     The following env mutations will still happen:
+     1. [create_and_setenv_if_necessary ()] like initializing the DkML system
+     2. On Windows, [set_msys2_entries ()] like MSYSTEM
+  *)
+  let* has_dkml_mutating_ancestor_process =
+    mark_dkml_mutating_ancestor_process ()
+  in
+
   (* Setup logging *)
   Fmt_tty.setup_std_outputs ();
   Logs.set_reporter (Logs_fmt.reporter ());
-  let dbt = OS.Env.value "DKML_BUILD_TRACE" OS.Env.string ~absent:"OFF" in
-  if
-    dbt = "ON"
-    && OS.Env.value "DKML_BUILD_TRACE_LEVEL" int_parser ~absent:0 >= 2
-  then Logs.set_level (Some Logs.Debug)
-  else if dbt = "ON" then Logs.set_level (Some Logs.Info)
-  else Logs.set_level (Some Logs.Warning);
-
-  (* ZEROTH, check and set a recursion guard so that only one environment
-     modification is performed.
-
-     The following env modifications will still happen:
-     1. create_and_setenv_if_necessary ()
-     2. msystem
-  *)
-  let original_guard = OS.Env.opt_var "WITHDKML_GUARD" ~absent:"0" in
-  OS.Env.set_var "WITHDKML_GUARD" (Some "1") >>= fun () ->
-  let minimize_sideeffects = "1" = original_guard in
-  if minimize_sideeffects then
-    Logs.debug (fun l ->
-        l
-          "Skipping most environment variable configuration because we are in \
-           subprocess of some with-dkml.exe");
-
-  Lazy.force get_dkmlversion_or_default >>= fun dkmlversion ->
-  Lazy.force get_dkmlmode_or_default >>= fun dkmlmode ->
-  Rresult.R.error_to_msg ~pp_error:Fmt.string
-    (Dkml_c_probe.C_abi.V2.get_abi_name ())
-  >>= fun target_abi ->
+  (if has_dkml_mutating_ancestor_process then
+     (* Incredibly important that we do not print unexpected output.
+        For example, [opam install ocaml-system] -> [ocamlc -vnum]
+        the [ocamlc -vnum] must print 4.14.0 (or whatever the version is).
+        It must not print any logs, even to standard error. *)
+     Logs.set_level (Some Logs.Error)
+   else
+     let dbt = OS.Env.value "DKML_BUILD_TRACE" OS.Env.string ~absent:"OFF" in
+     if
+       dbt = "ON"
+       && OS.Env.value "DKML_BUILD_TRACE_LEVEL" int_parser ~absent:0 >= 2
+     then Logs.set_level (Some Logs.Debug)
+     else if dbt = "ON" then Logs.set_level (Some Logs.Info)
+     else Logs.set_level (Some Logs.Warning));
+
+  let* dkmlversion = Lazy.force get_dkmlversion_or_default in
+  let* dkmlmode = Lazy.force get_dkmlmode_or_default in
+  let* target_abi =
+    Rresult.R.error_to_msg ~pp_error:Fmt.string
+      (Dkml_c_probe.C_abi.V2.get_abi_name ())
+  in
   let cache_keys = [ dkmlversion ] in
   (* FIRST, set DKML_TARGET_ABI, which may be overridden by DKML_TARGET_PLATFORM_OVERRIDE *)
   let target_abi =
     OS.Env.opt_var "DKML_TARGET_PLATFORM_OVERRIDE" ~absent:target_abi
   in
   let* () =
-    if minimize_sideeffects then Ok ()
+    if has_dkml_mutating_ancestor_process then Ok ()
     else OS.Env.set_var "DKML_TARGET_ABI" (Some target_abi)
   in
   let cache_keys = target_abi :: cache_keys in
@@ -570,11 +574,12 @@ let main_with_result () =
   *)
   let* () =
     match dkmlmode with
-    | Nativecode -> set_msys2_entries ~minimize_sideeffects target_abi
+    | Nativecode ->
+        set_msys2_entries ~has_dkml_mutating_ancestor_process target_abi
     | Bytecode -> Ok ()
   in
   let* () =
-    if minimize_sideeffects then Ok ()
+    if has_dkml_mutating_ancestor_process then Ok ()
     else
       (* THIRD, set temporary variables *)
       set_tempvar_entries cache_keys >>= fun cache_keys ->
@@ -594,9 +599,12 @@ let main_with_result () =
   (* SEVENTH, Create a command line like `...\usr\bin\env.exe CMD [ARGS...]`.
      More environment entries can be made, but this is at the end where
      there is no need to cache the environment. *)
-  let* cmd = Cmdline.create_and_setenv_if_necessary () in
+  let* cmd =
+    Cmdline.create_and_setenv_if_necessary ~has_dkml_mutating_ancestor_process
+      ()
+  in
   let* () =
-    if minimize_sideeffects then Ok ()
+    if has_dkml_mutating_ancestor_process then Ok ()
     else
       (* EIGHTH, stop tracing variables from propagating. *)
       let* () = OS.Env.set_var "DKML_BUILD_TRACE" None in