No longer call into cmd.exe to execute a posix shell on windows

.depend

@@ -499,8 +499,10 @@ src/ocaml_utils.cmi : \
 src/ocamlbuild_config.cmo :
 src/ocamlbuild_config.cmx :
 src/ocamlbuild_executor.cmo : \
+    src/my_std.cmi \
     src/ocamlbuild_executor.cmi
 src/ocamlbuild_executor.cmx : \
+    src/my_std.cmx \
     src/ocamlbuild_executor.cmi
 src/ocamlbuild_executor.cmi :
 src/ocamlbuild_where.cmo : \

src/command.ml

@@ -145,7 +145,8 @@ let search_in_path cmd =
 
 (*** string_of_command_spec{,_with_calls *)
 let string_of_command_spec_with_calls call_with_tags call_with_target resolve_virtuals spec =
-  let rec aux b spec =
+  let rec aux spec =
+    let b = Buffer.create 256 in
     let first = ref true in
     let put_space () =
       if !first then
@@ -166,21 +167,12 @@ let string_of_command_spec_with_calls call_with_tags call_with_target resolve_vi
                else (put_space (); Printf.bprintf b "<virtual %s>" (Shell.quote_filename_if_needed v))
       | S l -> List.iter do_spec l
       | T tags -> call_with_tags tags; do_spec (!tag_handler tags)
-      | Quote s ->
-        put_space ();
-        let buf = Buffer.create 256 in
-        aux buf s;
-        put_filename (Buffer.contents buf)
+      | Quote s -> put_space (); put_filename (aux s)
     in
-    do_spec spec
+    do_spec spec;
+    Buffer.contents b
   in
-  let b = Buffer.create 256 in
-  (* The best way to prevent bash from switching to its windows-style
-   * quote-handling is to prepend an empty string before the command name. *)
-  if Sys.win32 then
-    Buffer.add_string b "''";
-  aux b spec;
-  Buffer.contents b
+  aux spec
 
 let string_of_command_spec x = string_of_command_spec_with_calls ignore ignore false x
 

src/log.ml

@@ -79,3 +79,5 @@ let finish ?how () =
   | Some d -> Display.finish ?how d
 
 (*let () = My_unix.at_exit_once finish*)
+
+let () = My_std.log3 := (fun s -> dprintf 3 "%s\n%!" s)

src/my_std.ml

@@ -275,13 +275,80 @@ let sys_file_exists x =
       try Array.iter (fun x -> if x = basename then raise Exit) a; false
       with Exit -> true
 
+(* https://github.com/ocaml/opam/blame/master/src/core/opamStd.ml *)
+let split_quoted path sep =
+    let length = String.length path in
+    let rec f acc index current last normal =
+      if (index : int) = length then
+        let current = current ^ String.sub path last (index - last) in
+        List.rev (if current <> "" then current::acc else acc)
+      else
+      let c = path.[index]
+      and next = succ index in
+      if (c : char) = sep && normal || c = '"' then
+        let current = current ^ String.sub path last (index - last) in
+        if c = '"' then
+          f acc next current next (not normal)
+        else
+        let acc = if current = "" then acc else current::acc in
+        f acc next "" next true
+      else
+        f acc next current last normal in
+    f [] 0 "" 0 true
+
+(* Here to break the circular dep *)
+let log3 = ref (fun _ -> failwith "My_std.log3 not initialized")
+
+let windows_shell = lazy begin
+  let rec iter = function
+  | [] -> raise Not_found
+  | hd::tl ->
+    let dash = Filename.concat hd "dash.exe" in
+    if Sys.file_exists dash then [|dash|] else
+    let bash = Filename.concat hd "bash.exe" in
+    if not (Sys.file_exists bash) then iter tl else
+    (* if sh.exe and bash.exe exist in the same dir, choose sh.exe *)
+    let sh = Filename.concat hd "sh.exe" in
+    if Sys.file_exists sh then [|sh|] else [|bash ; "--norc" ; "--noprofile"|]
+  in
+  let paths = split_quoted (try Sys.getenv "PATH" with Not_found -> "") ';' in
+  let shell =
+    try
+      let path =
+        List.find (fun path ->
+            Sys.file_exists (Filename.concat path "cygcheck.exe")) paths
+      in
+      iter [path]
+    with Not_found ->
+      (try iter paths with Not_found -> failwith "no posix shell found in PATH")
+  in
+  !log3 (Printf.sprintf "Using shell %s" (Array.to_list shell |> String.concat " "));
+  shell
+end
+
+let prepare_command_for_windows cmd =
+  (* The best way to prevent bash from switching to its windows-style
+   * quote-handling is to prepend an empty string before the command name. *)
+  let cmd = "''" ^ cmd in
+  Array.append (Lazy.force windows_shell) [|"-c"; cmd|]
+
+let sys_command_win32 cmd =
+  let args = prepare_command_for_windows cmd in
+  let oc = Unix.open_process_args_out args.(0) args in
+  match Unix.close_process_out oc with
+  | WEXITED x -> x
+  | WSIGNALED _ -> 2 (* like OCaml's uncaught exceptions *)
+  | WSTOPPED _ -> 127
+
 let sys_command =
-  match Sys.win32 with
-  | true -> fun cmd ->
-      if cmd = "" then 0 else
-      let cmd = "bash --norc -c " ^ Filename.quote cmd in
-      Sys.command cmd
-  | false -> fun cmd -> if cmd = "" then 0 else Sys.command cmd
+  if Sys.win32 then
+    sys_command_win32
+  else
+    Sys.command
+
+let sys_command cmd =
+  if cmd = "" then 0 else
+  sys_command cmd
 
 (* FIXME warning fix and use Filename.concat *)
 let filename_concat x y =

src/my_std.mli

@@ -69,3 +69,8 @@ val lexbuf_of_string : ?name:string -> string -> Lexing.lexbuf
 
 val split_ocaml_version : (int * int * int * string) option
 (** (major, minor, patchlevel, rest) *)
+
+val prepare_command_for_windows : string -> string array
+
+(*/*)
+val log3 : (string -> unit) ref

src/my_unix.ml

@@ -58,15 +58,12 @@ let at_exit_once callback =
   end
 
 let run_and_open s kont =
-  let s =
-    (* Be consistent! My_unix.run_and_open uses My_std.sys_command and
-       sys_command uses bash. *)
-    if Sys.win32 then
-      "bash --norc -c " ^ Filename.quote s
-    else
-      s
-  in
-  let ic = Unix.open_process_in s in
+  let ic =
+    if Sys.win32
+    then
+      let args = My_std.prepare_command_for_windows s in
+      Unix.open_process_args_in args.(0) args
+    else Unix.open_process_in s in
   let close () =
     match Unix.close_process_in ic with
     | Unix.WEXITED 0 -> ()

src/ocamlbuild_executor.ml

@@ -136,13 +136,13 @@ let execute
   (* ***)
   (*** add_job *)
   let add_job cmd rest result id =
-    let cmd =
-      if Sys.win32
-      then "bash --norc -c " ^ Filename.quote cmd
-      else cmd
-    in
     (*display begin fun oc -> fp oc "Job %a is %s\n%!" print_job_id id cmd; end;*)
-    let (stdout', stdin', stderr') = open_process_full cmd env in
+    let (stdout', stdin', stderr') =
+      if Sys.win32
+      then
+        let args = My_std.prepare_command_for_windows cmd in
+        open_process_args_full args.(0) args (Unix.environment ())
+      else open_process_full cmd env in
     incr jobs_active;
     if not Sys.win32 then begin
       set_nonblock (doi stdout');